add `ffi/unsafe/custodian'

This commit is contained in:
Matthew Flatt 2012-08-12 11:05:19 -06:00
parent 5116f51503
commit 42ef79c2ad
16 changed files with 179 additions and 5 deletions

View File

@ -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))

View File

@ -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].}

View File

@ -10,6 +10,7 @@
@include-section["cpointer.scrbl"] @include-section["cpointer.scrbl"]
@include-section["define.scrbl"] @include-section["define.scrbl"]
@include-section["alloc.scrbl"] @include-section["alloc.scrbl"]
@include-section["custodian.scrbl"]
@include-section["atomic.scrbl"] @include-section["atomic.scrbl"]
@include-section["try-atomic.scrbl"] @include-section["try-atomic.scrbl"]
@include-section["objc.scrbl"] @include-section["objc.scrbl"]

View File

@ -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 refers to the deallocator, so that the deallocator can be run if
necessary by a finalizer. 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} @section{More Examples}

View File

@ -1,5 +1,6 @@
#lang scribble/doc #lang scribble/doc
@(require "utils.rkt") @(require "utils.rkt"
(for-label ffi/unsafe/custodian))
@title[#:tag "foreign:pointer-funcs"]{Pointer Functions} @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 @racket[obj], which can be any Racket (GC-able) object. The finalizer
is registered with a will executor; see is registered with a will executor; see
@racket[make-will-executor]. The finalizer is invoked when @racket[make-will-executor]. The finalizer is invoked when
@racket[obj] is about to be collected. (This is done by a thread that @racket[obj] is about to be collected. (The finalizer is invoked in a
is in charge of triggering these will executors.) 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 Finalizers are mostly intended to be used with cpointer objects (for
freeing unused memory that is not under GC control), but it can be freeing unused memory that is not under GC control), but it can be

View File

@ -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 down, then @var{f} is called immediately, and the result is
@cpp{NULL}.} @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 @function[(void scheme_custodian_check_available
[Scheme_Custodian* m] [Scheme_Custodian* m]
[const-char* name] [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 At-exit functions are run in reverse of the order that they are
added. An at-exit function is initially registered (and therefore runs 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 An at-exit function should not necessarily apply the closer function
for every object that it is given. In particular, shutting down a for every object that it is given. In particular, shutting down a

View File

@ -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"))

View File

@ -65,6 +65,7 @@ EXPORTS
scheme_tls_get scheme_tls_get
scheme_make_custodian scheme_make_custodian
scheme_add_managed scheme_add_managed
scheme_add_managed_close_on_exit
scheme_custodian_check_available scheme_custodian_check_available
scheme_custodian_is_available scheme_custodian_is_available
scheme_remove_managed scheme_remove_managed

View File

@ -65,6 +65,7 @@ EXPORTS
scheme_tls_get scheme_tls_get
scheme_make_custodian scheme_make_custodian
scheme_add_managed scheme_add_managed
scheme_add_managed_close_on_exit
scheme_custodian_check_available scheme_custodian_check_available
scheme_custodian_is_available scheme_custodian_is_available
scheme_remove_managed scheme_remove_managed

View File

@ -63,6 +63,7 @@ scheme_tls_set
scheme_tls_get scheme_tls_get
scheme_make_custodian scheme_make_custodian
scheme_add_managed scheme_add_managed
scheme_add_managed_close_on_exit
scheme_custodian_check_available scheme_custodian_check_available
scheme_custodian_is_available scheme_custodian_is_available
scheme_remove_managed scheme_remove_managed

View File

@ -63,6 +63,7 @@ scheme_tls_set
scheme_tls_get scheme_tls_get
scheme_make_custodian scheme_make_custodian
scheme_add_managed scheme_add_managed
scheme_add_managed_close_on_exit
scheme_custodian_check_available scheme_custodian_check_available
scheme_custodian_is_available scheme_custodian_is_available
scheme_remove_managed scheme_remove_managed

View File

@ -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, MZ_EXTERN Scheme_Custodian_Reference *scheme_add_managed(Scheme_Custodian *m, Scheme_Object *o,
Scheme_Close_Custodian_Client *f, void *data, Scheme_Close_Custodian_Client *f, void *data,
int strong); 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 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 int scheme_custodian_is_available(Scheme_Custodian *m);
MZ_EXTERN void scheme_remove_managed(Scheme_Custodian_Reference *m, Scheme_Object *o); MZ_EXTERN void scheme_remove_managed(Scheme_Custodian_Reference *m, Scheme_Object *o);

View File

@ -107,6 +107,8 @@ Scheme_Custodian *(*scheme_make_custodian)(Scheme_Custodian *);
Scheme_Custodian_Reference *(*scheme_add_managed)(Scheme_Custodian *m, Scheme_Object *o, Scheme_Custodian_Reference *(*scheme_add_managed)(Scheme_Custodian *m, Scheme_Object *o,
Scheme_Close_Custodian_Client *f, void *data, Scheme_Close_Custodian_Client *f, void *data,
int strong); 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); void (*scheme_custodian_check_available)(Scheme_Custodian *m, const char *who, const char *what);
int (*scheme_custodian_is_available)(Scheme_Custodian *m); int (*scheme_custodian_is_available)(Scheme_Custodian *m);
void (*scheme_remove_managed)(Scheme_Custodian_Reference *m, Scheme_Object *o); void (*scheme_remove_managed)(Scheme_Custodian_Reference *m, Scheme_Object *o);

View File

@ -71,6 +71,7 @@
scheme_extension_table->scheme_tls_get = scheme_tls_get; scheme_extension_table->scheme_tls_get = scheme_tls_get;
scheme_extension_table->scheme_make_custodian = scheme_make_custodian; scheme_extension_table->scheme_make_custodian = scheme_make_custodian;
scheme_extension_table->scheme_add_managed = scheme_add_managed; 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_check_available = scheme_custodian_check_available;
scheme_extension_table->scheme_custodian_is_available = scheme_custodian_is_available; scheme_extension_table->scheme_custodian_is_available = scheme_custodian_is_available;
scheme_extension_table->scheme_remove_managed = scheme_remove_managed; scheme_extension_table->scheme_remove_managed = scheme_remove_managed;

View File

@ -71,6 +71,7 @@
#define scheme_tls_get (scheme_extension_table->scheme_tls_get) #define scheme_tls_get (scheme_extension_table->scheme_tls_get)
#define scheme_make_custodian (scheme_extension_table->scheme_make_custodian) #define scheme_make_custodian (scheme_extension_table->scheme_make_custodian)
#define scheme_add_managed (scheme_extension_table->scheme_add_managed) #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_check_available (scheme_extension_table->scheme_custodian_check_available)
#define scheme_custodian_is_available (scheme_extension_table->scheme_custodian_is_available) #define scheme_custodian_is_available (scheme_extension_table->scheme_custodian_is_available)
#define scheme_remove_managed (scheme_extension_table->scheme_remove_managed) #define scheme_remove_managed (scheme_extension_table->scheme_remove_managed)

View File

@ -872,7 +872,7 @@ static void ensure_custodian_space(Scheme_Custodian *m, int k)
m->alloc += k; m->alloc += k;
naya_boxes = MALLOC_N(Scheme_Object**, m->alloc); 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_data = MALLOC_N(void*, m->alloc);
naya_mrefs = MALLOC_N(Scheme_Custodian_Reference*, 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; 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) void scheme_remove_managed(Scheme_Custodian_Reference *mr, Scheme_Object *o)
{ {
/* Is this a good idea? I'm not sure: */ /* 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); 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) void scheme_run_atexit_closers_on_all(Scheme_Exit_Closer_Func alt)