suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

allow mixing exceptions with ffi/unsafe/alloc

Browse Source 
Use call-as-atomic that can handle exceptions instead of dynamic-winding
start-atomic and end-atomic. Exceptions can be found in the functions's
result wrapper such as:

    (define-lib find-some-object
                (_fun (name : _string/utf-8)
                      (object : (_ptr o _some-object-pointer))
                      --> (result : _int)
                      --> (begin
                            (when (negative? result)
                              (error 'find-some-object "unknown name"))
                            object))
                #:wrap (allocator free-some-object))

Signed-off-by: Jan Dvořák <mordae@anilinux.org>
This commit is contained in:
Jan Dvořák 2014-07-17 12:14:05 +02:00 committed by Matthew Flatt
parent a32160c6f4
commit 8bd5aa38b1
2 changed files with 33 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/racket-pkgs/racket-doc/scribblings/foreign/alloc.scrbl
View File

@ -15,9 +15,9 @@ Produces a procedure that behaves like @racket[alloc], but the result
of @racket[alloc] is given a finalizer that calls @racket[dealloc] on of @racket[alloc] is given a finalizer that calls @racket[dealloc] on
the result if it is not otherwise freed through a deallocator (as the result if it is not otherwise freed through a deallocator (as
designated with @racket[deallocator]). In addition, @racket[alloc] is designated with @racket[deallocator]). In addition, @racket[alloc] is
called in atomic mode (see @racket[start-atomic]); its result is called in @tech{atomic mode} (see @racket[call-as-atomic]); its result is
received and registered in atomic mode, so that the result is reliably received and registered in atomic mode, so that the result is reliably
freed. freed as long as no exception is raised.
The @racket[dealloc] procedure itself need not be specifically The @racket[dealloc] procedure itself need not be specifically
designated a deallocator (via @racket[deallocator]). If a deallocator designated a deallocator (via @racket[deallocator]). If a deallocator
@ -31,11 +31,11 @@ is called explicitly, it need not be the same as @racket[dealloc].}
)]{ )]{
Produces a procedure that behaves like @racket[dealloc]. The Produces a procedure that behaves like @racket[dealloc]. The
@racket[dealloc] procedure is called in atomic mode (see @racket[dealloc] procedure is called in @tech{atomic mode} (see
@racket[start-atomic]), and the reference count on one of its @racket[call-as-atomic]), and the reference count on one of its
arguments is decremented; if the reference count reaches zero, no arguments is decremented; if the reference count reaches zero, no
finalizer associated by an @racket[allocator]- or finalizer associated by an @racket[allocator]- or
@racket[referencer]-wrapped procedure is invoked when the value @racket[retainer]-wrapped procedure is invoked when the value
becomes inaccessible. becomes inaccessible.
The optional @racket[get-arg] procedure determines which of The optional @racket[get-arg] procedure determines which of
@ -53,11 +53,11 @@ The @racket[releaser] procedure is a synonym for
procedure?]{ procedure?]{
Produces a procedure that behaves like @racket[retain]. The procedure Produces a procedure that behaves like @racket[retain]. The procedure
is called in atomic mode (see @racket[start-atomic]), and the is called in @tech{atomic mode} (see @racket[call-as-atomic]), and the
reference count on one of its arguments is incremented, with reference count on one of its arguments is incremented, with
@racket[release] recorded as the corresponding release procedure to be @racket[release] recorded as the corresponding release procedure to be
called by the finalizer on the retained object (unless some called by the finalizer on the retained object (unless some
deallocator, as wrapped by @racket[deallocate], is explicitly called deallocator, as wrapped by @racket[deallocator], is explicitly called
first). first).
The optional @racket[get-arg] procedure determines which of The optional @racket[get-arg] procedure determines which of

18
racket/collects/ffi/unsafe/alloc.rkt
View File

@ -19,22 +19,19 @@
(define ((allocator d) proc) (define ((allocator d) proc)
(rename (rename
(lambda args (lambda args
(dynamic-wind (call-as-atomic
start-atomic
(lambda () (lambda ()
(let ([v (apply proc args)]) (let ([v (apply proc args)])
(when v (when v
(hash-set! allocated v (list d)) (hash-set! allocated v (list d))
(register-finalizer v deallocate)) (register-finalizer v deallocate))
v)) v))))
end-atomic))
proc)) proc))
(define ((deallocator [get-arg car]) proc) (define ((deallocator [get-arg car]) proc)
(rename (rename
(lambda args (lambda args
(dynamic-wind (call-as-atomic
start-atomic
(lambda () (lambda ()
(apply proc args) (apply proc args)
(let ([v (get-arg args)]) (let ([v (get-arg args)])
@ -42,22 +39,19 @@
(when ds (when ds
(if (null? (cdr ds)) (if (null? (cdr ds))
(hash-remove! allocated v) (hash-remove! allocated v)
(hash-set! allocated v (cdr ds))))))) (hash-set! allocated v (cdr ds)))))))))
end-atomic))
proc)) proc))
(define ((retainer d [get-arg car]) proc) (define ((retainer d [get-arg car]) proc)
(rename (rename
(lambda args (lambda args
(dynamic-wind (call-as-atomic
start-atomic
(lambda () (lambda ()
(begin0 (begin0
(apply proc args) (apply proc args)
(let ([v (get-arg args)]) (let ([v (get-arg args)])
(let ([ds (hash-ref allocated v null)]) (let ([ds (hash-ref allocated v null)])
(hash-set! allocated v (cons d ds)))))) (hash-set! allocated v (cons d ds))))))))
end-atomic))
proc)) proc))
(define (rename new orig) (define (rename new orig)