add `ffi/unsafe/custodian'
This commit is contained in:
parent
5116f51503
commit
42ef79c2ad
41
collects/ffi/unsafe/custodian.rkt
Normal file
41
collects/ffi/unsafe/custodian.rkt
Normal 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))
|
46
collects/scribblings/foreign/custodian.scrbl
Normal file
46
collects/scribblings/foreign/custodian.scrbl
Normal 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].}
|
|
@ -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"]
|
||||||
|
|
|
@ -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}
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
24
collects/tests/racket/ffi-custodian.rkt
Normal file
24
collects/tests/racket/ffi-custodian.rkt
Normal 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"))
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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);
|
||||||
|
|
|
@ -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);
|
||||||
|
|
|
@ -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;
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user