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
the result if it is not otherwise freed through a deallocator (as
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
freed.
freed as long as no exception is raised.
The @racket[dealloc] procedure itself need not be specifically
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
@racket[dealloc] procedure is called in atomic mode (see
@racket[start-atomic]), and the reference count on one of its
@racket[dealloc] procedure is called in @tech{atomic mode} (see
@racket[call-as-atomic]), and the reference count on one of its
arguments is decremented; if the reference count reaches zero, no
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.
The optional @racket[get-arg] procedure determines which of
@ -53,11 +53,11 @@ The @racket[releaser] procedure is a synonym for
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
@racket[release] recorded as the corresponding release procedure to be
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).
The optional @racket[get-arg] procedure determines which of

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

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