diff --git a/collects/ffi/unsafe/custodian.rkt b/collects/ffi/unsafe/custodian.rkt new file mode 100644 index 0000000000..3b1ecac455 --- /dev/null +++ b/collects/ffi/unsafe/custodian.rkt @@ -0,0 +1,41 @@ +#lang racket/base +(require ffi/unsafe) + +(provide (protect-out register-custodian-shutdown + unregister-custodian-shutdown)) + +(define _Scheme_Custodian_Reference-pointer + (_gcable (_cpointer 'Scheme_Custodian_Reference))) + +(define scheme_add_managed + (get-ffi-obj 'scheme_add_managed #f + (_fun _racket _racket _fpointer _racket _int + -> _Scheme_Custodian_Reference-pointer))) +(define scheme_add_managed_close_on_exit + (get-ffi-obj 'scheme_add_managed_close_on_exit #f + (_fun _racket _racket _fpointer _racket + -> _Scheme_Custodian_Reference-pointer))) + +(define scheme_remove_managed + (get-ffi-obj 'scheme_remove_managed #f + (_fun _Scheme_Custodian_Reference-pointer _racket -> _void))) + +(define (shutdown-callback impl proc+self) + ((car proc+self) impl)) +(define shutdown_callback + (cast shutdown-callback (_fun #:atomic? #t _racket _racket -> _void) _fpointer)) + +(define (register-custodian-shutdown obj proc [custodian (current-custodian)] + #:atexit? [atexit? #f] + #:weak? [weak? #f]) + (define proc+self (cons proc + shutdown-callback)) ; proc as data -> ffi callback retained + (if atexit? + (scheme_add_managed_close_on_exit custodian + obj shutdown_callback proc+self) + (scheme_add_managed custodian + obj shutdown_callback proc+self + (if weak? 0 1)))) + +(define (unregister-custodian-shutdown obj mref) + (scheme_remove_managed mref obj)) diff --git a/collects/scribblings/foreign/custodian.scrbl b/collects/scribblings/foreign/custodian.scrbl new file mode 100644 index 0000000000..4ce8370b5e --- /dev/null +++ b/collects/scribblings/foreign/custodian.scrbl @@ -0,0 +1,46 @@ +#lang scribble/doc +@(require "utils.rkt" + (for-label ffi/unsafe/custodian)) + +@title{Custodian Shutdown Registration} + +@defmodule[ffi/unsafe/custodian]{The +@racketmodname[ffi/unsafe/custodian] library provides utilities for +registering shutdown callbacks with custodians.} + +@defproc[(register-custodian-shutdown [v any/c] + [callback (any/c . -> . any)] + [custodian custodian? (current-custodian)] + [#:atexit? atexit? any/c #f] + [#:weak? weak? any/c #f]) + cpointer?]{ + +Registers @racket[callback] to be applied (in atomic mode and an +unspecified Racket thread) to @racket[v] when @racket[custodian] is +shutdown. The result is a pointer that can be supplied to +@racket[unregister-custodian-shutdown] to remove the registration. + +If @racket[atexit?] is true, then @racket[callback] is applied when +Racket exits, even if the custodian is not explicitly shut down. + +If @racket[weak?] is true, then @racket[callback] may not be called +if @racket[v] is determined to be unreachable during garbage +collection. The value @racket[v] is always weakly held by the +custodian, even if @racket[weak?] is @racket[#f]; see +@cpp{scheme_add_managed} for more information. + +Normally, @racket[weak?] should be false. To trigger actions based on +finalization or custodian shutdown---whichever happens first---leave +@racket[weak?] as @racket[#f] and have a finalizer cancel the shutdown +action via @racket[unregister-custodian-shutdown]. Otherwise, a +not-yet-run finalizer may remain pending after the custodian is +shutdown.} + + +@defproc[(unregister-custodian-shutdown [v any/c] + [registration _cpointer]) + void?]{ + +Cancels a custodian-shutdown registration, where @racket[registration] +is a previous result from @racket[register-custodian-shutdown] applied +to @racket[v].} diff --git a/collects/scribblings/foreign/derived.scrbl b/collects/scribblings/foreign/derived.scrbl index 0b21c6396a..cb9a6e5ee1 100644 --- a/collects/scribblings/foreign/derived.scrbl +++ b/collects/scribblings/foreign/derived.scrbl @@ -10,6 +10,7 @@ @include-section["cpointer.scrbl"] @include-section["define.scrbl"] @include-section["alloc.scrbl"] +@include-section["custodian.scrbl"] @include-section["atomic.scrbl"] @include-section["try-atomic.scrbl"] @include-section["objc.scrbl"] diff --git a/collects/scribblings/foreign/intro.scrbl b/collects/scribblings/foreign/intro.scrbl index b6d8b0d287..4428a8d19f 100644 --- a/collects/scribblings/foreign/intro.scrbl +++ b/collects/scribblings/foreign/intro.scrbl @@ -504,6 +504,11 @@ finalizer for the function's argument. An @racket[allocator] wrapper refers to the deallocator, so that the deallocator can be run if necessary by a finalizer. +If a resource is scarce or visible to end users, then @tech[#:doc +reference.scrbl]{custodian} management is more appropriate than +mere finalization as implemented by @racket[allocator]. See the +@racketmodname[ffi/unsafe/custodian] library. + @; ------------------------------------------------------------ @section{More Examples} diff --git a/collects/scribblings/foreign/pointers.scrbl b/collects/scribblings/foreign/pointers.scrbl index 888059a853..a6fe74f247 100644 --- a/collects/scribblings/foreign/pointers.scrbl +++ b/collects/scribblings/foreign/pointers.scrbl @@ -1,5 +1,6 @@ #lang scribble/doc -@(require "utils.rkt") +@(require "utils.rkt" + (for-label ffi/unsafe/custodian)) @title[#:tag "foreign:pointer-funcs"]{Pointer Functions} @@ -313,8 +314,9 @@ Registers a finalizer procedure @racket[finalizer-proc] with the given @racket[obj], which can be any Racket (GC-able) object. The finalizer is registered with a will executor; see @racket[make-will-executor]. The finalizer is invoked when -@racket[obj] is about to be collected. (This is done by a thread that -is in charge of triggering these will executors.) +@racket[obj] is about to be collected. (The finalizer is invoked in a +thread that is in charge of triggering these will executors.) +See also @racket[register-custodian-shutdown]. Finalizers are mostly intended to be used with cpointer objects (for freeing unused memory that is not under GC control), but it can be diff --git a/collects/scribblings/inside/custodians.scrbl b/collects/scribblings/inside/custodians.scrbl index 85ff38b571..ade86fce00 100644 --- a/collects/scribblings/inside/custodians.scrbl +++ b/collects/scribblings/inside/custodians.scrbl @@ -64,6 +64,16 @@ If @var{m} (or the current custodian if @var{m} is @cpp{NULL})is shut down, then @var{f} is called immediately, and the result is @cpp{NULL}.} +@function[(Scheme_Custodian_Reference* scheme_add_managed_close_on_exit + [Scheme_Custodian* m] + [Scheme_Object* o] + [Scheme_Close_Custodian_Client* f] + [void* data])]{ + +Like @cpp{scheme_add_managed} with a @cpp{1} final argument, but also +causes @var{f} to be called when Racket exists without an explicit +custodian shutdown.} + @function[(void scheme_custodian_check_available [Scheme_Custodian* m] [const-char* name] @@ -107,7 +117,8 @@ where @var{d} is the second argument for @var{f}. At-exit functions are run in reverse of the order that they are added. An at-exit function is initially registered (and therefore runs -last) that flushes each file-stream output port. +last) that flushes each file-stream output port and calls every +function registered with @cpp{scheme_add_managed_close_on_exit}. An at-exit function should not necessarily apply the closer function for every object that it is given. In particular, shutting down a diff --git a/collects/tests/racket/ffi-custodian.rkt b/collects/tests/racket/ffi-custodian.rkt new file mode 100644 index 0000000000..1cb840ccef --- /dev/null +++ b/collects/tests/racket/ffi-custodian.rkt @@ -0,0 +1,24 @@ +#lang racket/base +(require ffi/unsafe/custodian) + +(define c (make-custodian)) + +(define done? #f) + +(define val (cons 1 2)) + +(define (reg) + (register-custodian-shutdown val + (lambda (x) + (when done? (error "duplicate!")) + (set! done? (equal? x '(1 . 2)))) + c + #:atexit? #t)) + +(unregister-custodian-shutdown val (reg)) +(void (reg)) + +(custodian-shutdown-all c) + +(unless done? + (error "shutdown didn't work")) diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index 6dadd5e1db..a8d4011820 100644 --- a/src/racket/include/mzwin.def +++ b/src/racket/include/mzwin.def @@ -65,6 +65,7 @@ EXPORTS scheme_tls_get scheme_make_custodian scheme_add_managed + scheme_add_managed_close_on_exit scheme_custodian_check_available scheme_custodian_is_available scheme_remove_managed diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index 75cff8565e..877161be5c 100644 --- a/src/racket/include/mzwin3m.def +++ b/src/racket/include/mzwin3m.def @@ -65,6 +65,7 @@ EXPORTS scheme_tls_get scheme_make_custodian scheme_add_managed + scheme_add_managed_close_on_exit scheme_custodian_check_available scheme_custodian_is_available scheme_remove_managed diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index c0ab4f95f8..2bfe3c31e4 100644 --- a/src/racket/include/racket.exp +++ b/src/racket/include/racket.exp @@ -63,6 +63,7 @@ scheme_tls_set scheme_tls_get scheme_make_custodian scheme_add_managed +scheme_add_managed_close_on_exit scheme_custodian_check_available scheme_custodian_is_available scheme_remove_managed diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index 4f497457df..29cc2db156 100644 --- a/src/racket/include/racket3m.exp +++ b/src/racket/include/racket3m.exp @@ -63,6 +63,7 @@ scheme_tls_set scheme_tls_get scheme_make_custodian scheme_add_managed +scheme_add_managed_close_on_exit scheme_custodian_check_available scheme_custodian_is_available scheme_remove_managed diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index ab9c9a615b..2b84c0d61c 100644 --- a/src/racket/src/schemef.h +++ b/src/racket/src/schemef.h @@ -153,6 +153,9 @@ MZ_EXTERN Scheme_Custodian *scheme_make_custodian(Scheme_Custodian *); MZ_EXTERN Scheme_Custodian_Reference *scheme_add_managed(Scheme_Custodian *m, Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *data, int strong); +MZ_EXTERN Scheme_Custodian_Reference *scheme_add_managed_close_on_exit(Scheme_Custodian *m, Scheme_Object *o, + Scheme_Close_Custodian_Client *f, void *data); + MZ_EXTERN void scheme_custodian_check_available(Scheme_Custodian *m, const char *who, const char *what); MZ_EXTERN int scheme_custodian_is_available(Scheme_Custodian *m); MZ_EXTERN void scheme_remove_managed(Scheme_Custodian_Reference *m, Scheme_Object *o); diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index d5ff4e8743..5226fd5e6d 100644 --- a/src/racket/src/schemex.h +++ b/src/racket/src/schemex.h @@ -107,6 +107,8 @@ Scheme_Custodian *(*scheme_make_custodian)(Scheme_Custodian *); Scheme_Custodian_Reference *(*scheme_add_managed)(Scheme_Custodian *m, Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *data, int strong); +Scheme_Custodian_Reference *(*scheme_add_managed_close_on_exit)(Scheme_Custodian *m, Scheme_Object *o, + Scheme_Close_Custodian_Client *f, void *data); void (*scheme_custodian_check_available)(Scheme_Custodian *m, const char *who, const char *what); int (*scheme_custodian_is_available)(Scheme_Custodian *m); void (*scheme_remove_managed)(Scheme_Custodian_Reference *m, Scheme_Object *o); diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index 55f14830a2..94c2ec8f63 100644 --- a/src/racket/src/schemex.inc +++ b/src/racket/src/schemex.inc @@ -71,6 +71,7 @@ scheme_extension_table->scheme_tls_get = scheme_tls_get; scheme_extension_table->scheme_make_custodian = scheme_make_custodian; scheme_extension_table->scheme_add_managed = scheme_add_managed; + scheme_extension_table->scheme_add_managed_close_on_exit = scheme_add_managed_close_on_exit; scheme_extension_table->scheme_custodian_check_available = scheme_custodian_check_available; scheme_extension_table->scheme_custodian_is_available = scheme_custodian_is_available; scheme_extension_table->scheme_remove_managed = scheme_remove_managed; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index 2f47fed2d3..705f940f5b 100644 --- a/src/racket/src/schemexm.h +++ b/src/racket/src/schemexm.h @@ -71,6 +71,7 @@ #define scheme_tls_get (scheme_extension_table->scheme_tls_get) #define scheme_make_custodian (scheme_extension_table->scheme_make_custodian) #define scheme_add_managed (scheme_extension_table->scheme_add_managed) +#define scheme_add_managed_close_on_exit (scheme_extension_table->scheme_add_managed_close_on_exit) #define scheme_custodian_check_available (scheme_extension_table->scheme_custodian_check_available) #define scheme_custodian_is_available (scheme_extension_table->scheme_custodian_is_available) #define scheme_remove_managed (scheme_extension_table->scheme_remove_managed) diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 1ef5f75863..d7475a646d 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -872,7 +872,7 @@ static void ensure_custodian_space(Scheme_Custodian *m, int k) m->alloc += k; naya_boxes = MALLOC_N(Scheme_Object**, m->alloc); - naya_closers = MALLOC_N(Scheme_Close_Custodian_Client*, m->alloc); + naya_closers = MALLOC_N_ATOMIC(Scheme_Close_Custodian_Client*, m->alloc); naya_data = MALLOC_N(void*, m->alloc); naya_mrefs = MALLOC_N(Scheme_Custodian_Reference*, m->alloc); @@ -1222,6 +1222,36 @@ Scheme_Custodian_Reference *scheme_add_managed(Scheme_Custodian *m, Scheme_Objec return mr; } +static void chain_close_at_exit(Scheme_Object *o, void *_data) +/* This closer is recognized specially in scheme_run_atexit_closers() */ +{ + Scheme_Object *data = (Scheme_Object *)_data; + Scheme_Close_Custodian_Client *f; + void **fp; + + fp = (void **)SCHEME_CAR(data); + + if (fp) { + f = (Scheme_Close_Custodian_Client *)*fp; + SCHEME_CAR(data) = NULL; + f(o, SCHEME_CDR(data)); + } +} + +Scheme_Custodian_Reference *scheme_add_managed_close_on_exit(Scheme_Custodian *m, Scheme_Object *o, + Scheme_Close_Custodian_Client *f, void *data) +{ + void **p; + + p = (void **)scheme_malloc_atomic(sizeof(void *)); + *p = f; + + return scheme_add_managed(m, o, + chain_close_at_exit, scheme_make_raw_pair((Scheme_Object *)p, + (Scheme_Object *)data), + 1); +} + void scheme_remove_managed(Scheme_Custodian_Reference *mr, Scheme_Object *o) { /* Is this a good idea? I'm not sure: */ @@ -1704,6 +1734,9 @@ void scheme_run_atexit_closers(Scheme_Object *o, Scheme_Close_Custodian_Client * cf(o, f, data); } } + + if (f == chain_close_at_exit) + f(o, data); } void scheme_run_atexit_closers_on_all(Scheme_Exit_Closer_Func alt)