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