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

ffi/unsafe: add #:malloc-mode to define-cstruct and _list-cstruct

Browse Source
This commit is contained in:
Matthew Flatt 2014-04-05 06:34:51 -06:00
parent 887a906bd2
commit b065d1f868
3 changed files with 61 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/racket-pkgs/racket-doc/scribblings/foreign/pointers.scrbl
View File

@ -233,9 +233,9 @@ see @|InsideRacket|.
ctype?)
@#,elem{absent}]
[cptr cpointer? @#,elem{absent}]
[mode (one-of/c 'nonatomic 'stubborn 'uncollectable
'eternal 'interior 'atomic-interior
'raw)
[mode (one-of/c 'raw 'atomic 'nonatomic
'atomic-interior 'interior
'stubborn 'uncollectable 'eternal)
@#,elem{absent}]
[fail-mode (one-of/c 'failok) @#,elem{absent}])
cpointer?]{

43
pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl
View File

@ -976,24 +976,37 @@ members.}
@defproc[(_list-struct [#:alignment alignment (or/c #f 1 2 4 8 16) #f]
[#:malloc-mode malloc-mode
(one-of/c 'raw 'atomic 'nonatomic
'atomic-interior 'interior
'stubborn 'uncollectable 'eternal)
'atomic]
[type ctype?] ...+)
ctype?]{
A type constructor that builds a struct type using
@racket[make-cstruct-type] function and wraps it in a type that
marshals a struct as a list of its components. Note that space for
structs must to be allocated; the converter for a
structs must to be allocated using @racket[malloc] with @racket[malloc-mode]; the converter for a
@racket[_list-struct] type immediately allocates and uses a list from
the allocated space, so it is inefficient. Use @racket[define-cstruct]
below for a more efficient approach.}
below for a more efficient approach.
@history[#:changed "6.0.0.6" @elem{Added @racket[#:malloc-mode].}]}
@defform/subs[(define-cstruct id/sup ([field-id type-expr] ...) property ...)
[(id/sup _id
(_id _super-id))
(property (code:line #:alignment alignment-expr)
(code:line #:property prop-expr val-expr)
#:no-equal)]]{
@defform[(define-cstruct id/sup ([field-id type-expr] ...) property ...)
#:grammar [(id/sup _id
(_id _super-id))
(property (code:line #:alignment alignment-expr)
(code:line #:malloc-mode malloc-mode-expr)
(code:line #:property prop-expr val-expr)
#:no-equal)]
#:contracts ([alignment-expr (or/c #f 1 2 4 8 16)]
[malloc-mode-expr (one-of/c 'raw 'atomic 'nonatomic
'atomic-interior 'interior
'stubborn 'uncollectable 'eternal)]
[prop-expr struct-type-property?])]{
Defines a new C struct type, but unlike @racket[_list-struct], the
resulting type deals with C structs in binary form, rather than
@ -1001,8 +1014,8 @@ marshaling them to Racket values. The syntax is similar to
@racket[define-struct], providing accessor functions for raw struct
values (which are pointer objects); the @racket[_id]
must start with @litchar{_}, and at most one @racket[#:alignment]
can be supplied. If no @racket[_super-id] is provided, then at least one
field must be specified.
or @racket[#:malloc-mode] can be supplied. If no @racket[_super-id]
is provided, then at least one field must be specified.
The resulting bindings are as follows:
@ -1106,8 +1119,10 @@ arguments for each of @racketidfont{_}@racket[super-id]'s fields, in
addition for the new fields. This adjustment of the constructor is,
again, in analogy to using a supertype with @racket[define-struct].
Structs are allocated as atomic blocks, which means that the
garbage collector ignores their content. Thus, struct fields can hold
Structs are allocated using @racket[malloc] with the result of
@racket[malloc-mode-expr], which default to @racket['atomic].
The default allocation of @racket['atomic] means that the
garbage collector ignores the content of a struct; thus, struct fields can hold
only non-pointer values, pointers to memory outside the GC's control,
and otherwise-reachable pointers to immobile GC-managed values (such
as those allocated with @racket[malloc] and @racket['internal] or
@ -1223,7 +1238,9 @@ expects arguments for both the super fields and the new ones:
@racketblock[
(define-cstruct (#,(racketidfont "_B") #,(racketidfont "_A")) ([z _int]))
(define b (make-B 1 2 3))
]}
]
@history[#:changed "6.0.0.6" @elem{Added @racket[#:malloc-mode].}]}
@; ------------------------------------------------------------

40
racket/collects/ffi/unsafe.rkt
View File

@ -1317,7 +1317,9 @@
;; Simple structs: call this with a list of types, and get a type that marshals
;; C structs to/from Scheme lists.
(define* (_list-struct #:alignment [alignment #f] type . types)
(define* (_list-struct #:alignment [alignment #f]
#:malloc-mode [malloc-mode 'atomic]
type . types)
(let* ([types (cons type types)]
[stype (make-cstruct-type types #f alignment)]
[offsets (compute-offsets types alignment)]
@ -1331,7 +1333,7 @@
"expected length" len
"list length" (length vals)
"list" vals))
(let ([block (malloc stype)])
(let ([block (malloc stype malloc-mode)])
(for-each (lambda (type ofs val) (ptr-set! block type 'abs ofs val))
types offsets vals)
block))
@ -1359,7 +1361,7 @@
(provide define-cstruct)
(define-syntax (define-cstruct stx)
(define (make-syntax _TYPE-stx has-super? slot-names-stx slot-types-stx
alignment-stx property-stxes property-binding-stxes
alignment-stx malloc-mode-stx property-stxes property-binding-stxes
no-equal?)
(define name
(cadr (regexp-match #rx"^_(.+)$" (symbol->string (syntax-e _TYPE-stx)))))
@ -1410,7 +1412,8 @@
[(set-TYPE-SLOT! ...) (ids (lambda (s) `("set-",name"-",s"!")))]
[(offset ...) (generate-temporaries
(ids (lambda (s) `(,s"-offset"))))]
[alignment alignment-stx])
[alignment alignment-stx]
[malloc-mode (or malloc-mode-stx #'(quote atomic))])
(with-syntax ([get-super-info
;; the 1st-type might be a pointer to this type
(if (or (safe-id=? 1st-type #'_TYPE-pointer/null)
@ -1524,7 +1527,7 @@
;; init using all slots
(lambda vals
(if (= (length vals) (length all-types))
(let ([block (make-wrap-TYPE (malloc _TYPE*))])
(let ([block (make-wrap-TYPE (malloc _TYPE* malloc-mode))])
(set-cpointer-tag! block all-tags)
(for-each (lambda (type ofs value)
(ptr-set! block type 'abs ofs value))
@ -1534,7 +1537,7 @@
(length all-types) (length vals) vals)))
;; normal initializer
(lambda (slot ...)
(let ([block (make-wrap-TYPE (malloc _TYPE*))])
(let ([block (make-wrap-TYPE (malloc _TYPE* malloc-mode))])
(set-cpointer-tag! block all-tags)
(ptr-set! block stype 'abs offset slot)
...
@ -1545,7 +1548,7 @@
(cond
[(TYPE? vals) vals]
[(= (length vals) (length all-types))
(let ([block (malloc _TYPE*)])
(let ([block (malloc _TYPE* malloc-mode)])
(set-cpointer-tag! block all-tags)
(for-each
(lambda (type ofs value)
@ -1597,21 +1600,32 @@
(syntax-case #'type ()
[(t s) (values #'t #'s)]
[_ (values #'type #f)])]
[(alignment properties property-bindings no-equal?)
[(alignment malloc-mode properties property-bindings no-equal?)
(let loop ([more #'more]
[alignment #f]
[malloc-mode #f]
[properties null]
[property-bindings null]
[no-equal? #f])
(define (head) (syntax-case more () [(x . _) #'x]))
(syntax-case more ()
[() (values alignment (reverse properties) (reverse property-bindings) no-equal?)]
[() (values alignment
malloc-mode
(reverse properties)
(reverse property-bindings)
no-equal?)]
[(#:alignment) (err "missing expression for #:alignment" (head))]
[(#:alignment a . rest)
(not alignment)
(loop #'rest #'a properties property-bindings no-equal?)]
(loop #'rest #'a malloc-mode properties property-bindings no-equal?)]
[(#:alignment a . rest)
(err "multiple specifications of #:alignment" (head))]
[(#:malloc-mode) (err "missing expression for #:malloc-mode" (head))]
[(#:malloc-mode m . rest)
(not malloc-mode)
(loop #'rest alignment #'m properties property-bindings no-equal?)]
[(#:alignment m . rest)
(err "multiple specifications of #:malloc-mode" (head))]
[(#:property) (err "missing property expression for #:property" (head))]
[(#:property prop) (err "missing value expression for #:property" (head))]
[(#:property prop val . rest)
@ -1620,6 +1634,7 @@
(define val-id (car (generate-temporaries '(prop-val))))
(loop #'rest
alignment
malloc-mode
(list* #`(cons #,prop-id #,val-id) properties)
(list* (list (list val-id) #'val)
(list (list prop-id) #'(check-is-property prop))
@ -1628,7 +1643,7 @@
[(#:no-equal . rest)
(if no-equal?
(err "multiple specifications of #:no-equal" (head))
(loop #'rest alignment properties property-bindings #t))]
(loop #'rest alignment malloc-mode properties property-bindings #t))]
[(x . _) (err (if (keyword? (syntax-e #'x))
"unknown keyword" "unexpected form")
#'x)]
@ -1646,11 +1661,12 @@
#`(#,(datum->syntax _TYPE 'super _TYPE) slot ...)
#`(#,_SUPER slot-type ...)
alignment
malloc-mode
properties
property-bindings
no-equal?)
(make-syntax _TYPE #f #'(slot ...) #`(slot-type ...)
alignment properties property-bindings no-equal?)))]
alignment malloc-mode properties property-bindings no-equal?)))]
[(_ type () . more)
(identifier? #'type)
(err "must have either a supertype or at least one field")]