1#lang racket/base 2(require ffi/unsafe 3 ffi/unsafe/objc 4 ffi/unsafe/atomic 5 "utils.rkt" 6 "const.rkt" 7 "types.rkt") 8 9(provide 10 (protect-out queue-autorelease-flush 11 autorelease-flush)) 12 13(import-class NSAutoreleasePool) 14 15;; This pool manages all objects that would otherwise not 16;; have a pool: 17(define pool (tell (tell NSAutoreleasePool alloc) init)) 18 19;; We need to periodically flush the main pool, otherwise 20;; object autoreleased through the pool live until the 21;; end of execution: 22(define (autorelease-flush) 23 (start-atomic) 24 (tellv pool drain) 25 (set! pool (tell (tell NSAutoreleasePool alloc) init)) 26 (end-atomic)) 27 28(define queued? #f) 29(define autorelease-evt (make-semaphore)) 30 31(define (queue-autorelease-flush) 32 (start-atomic) 33 (unless queued? 34 (semaphore-post autorelease-evt) 35 (set! queued? #t)) 36 (end-atomic)) 37 38;; Create a thread to periodically flush: 39(void 40 (thread (lambda () 41 (let loop () 42 (sync autorelease-evt) 43 (set! queued? #f) 44 (autorelease-flush) 45 (loop))))) 46