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

finish FFI scribbling

Browse Source 
svn: r7944
This commit is contained in:
Matthew Flatt 2007-12-11 00:32:41 +00:00
parent 39866addc2
commit d7e8371254
13 changed files with 423 additions and 294 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
collects/mzlib/foreign.ss
View File

@ -1,9 +1,10 @@
#lang scheme/base
;; Foreign Scheme interface ;; Foreign Scheme interface
(require '#%foreign
(module foreign mzscheme (lib "dirs.ss" "setup")
(for-syntax scheme/base
(require '#%foreign (lib "dirs.ss" "setup")) (lib "stx.ss" "syntax")))
(require-for-syntax (lib "stx.ss" "syntax"))
;; This module is full of unsafe bindings that are not provided to requiring ;; This module is full of unsafe bindings that are not provided to requiring
;; modules. Instead, an `unsafe!' binding is provided that makes these unsafe ;; modules. Instead, an `unsafe!' binding is provided that makes these unsafe
@ -28,8 +29,8 @@
(with-syntax ([(p ...) provides]) #'(provide p ...))) (with-syntax ([(p ...) provides]) #'(provide p ...)))
(syntax-case (car ps) (unsafe) (syntax-case (car ps) (unsafe)
[(unsafe u) [(unsafe u)
(syntax-case #'u (rename) (syntax-case #'u (rename-out)
[(rename from to) [(rename-out [from to])
(loop provides (cons (cons #'from #'to) unsafes) (cdr ps))] (loop provides (cons (cons #'from #'to) unsafes) (cdr ps))]
[id (identifier? #'id) [id (identifier? #'id)
(loop provides (cons (cons #'id #'id) unsafes) (cdr ps))] (loop provides (cons (cons #'id #'id) unsafes) (cdr ps))]
@ -45,10 +46,10 @@
[(id ...) (generate-temporaries unsafe-bindings)]) [(id ...) (generate-temporaries unsafe-bindings)])
(set! unsafe-bindings '()) (set! unsafe-bindings '())
#'(begin #'(begin
(provide (protect unsafe)) (provide (protect-out unsafe))
(define-syntax (unsafe stx) (define-syntax (unsafe stx)
(syntax-case stx () (syntax-case stx ()
[(_) (with-syntax ([(id ...) (list (datum->syntax-object [(_) (with-syntax ([(id ...) (list (datum->syntax
stx 'to stx) stx 'to stx)
...)]) ...)])
#'(begin (define-syntax id #'(begin (define-syntax id
@ -58,6 +59,7 @@
(provide* ctype-sizeof ctype-alignof compiler-sizeof (provide* ctype-sizeof ctype-alignof compiler-sizeof
(unsafe malloc) (unsafe free) end-stubborn-change (unsafe malloc) (unsafe free) end-stubborn-change
cpointer? ptr-equal? ptr-add (unsafe ptr-ref) (unsafe ptr-set!) cpointer? ptr-equal? ptr-add (unsafe ptr-ref) (unsafe ptr-set!)
ptr-offset ptr-add! offset-ptr? set-ptr-offset!
ctype? make-ctype make-cstruct-type make-sized-byte-string ctype? make-ctype make-cstruct-type make-sized-byte-string
_void _int8 _uint8 _int16 _uint16 _int32 _uint32 _int64 _uint64 _void _int8 _uint8 _int16 _uint16 _int32 _uint32 _int64 _uint64
_fixint _ufixint _fixnum _ufixnum _fixint _ufixint _fixnum _ufixnum
@ -136,7 +138,7 @@
(define lib-suffix (bytes->string/latin-1 (subbytes (system-type 'so-suffix) 1))) (define lib-suffix (bytes->string/latin-1 (subbytes (system-type 'so-suffix) 1)))
(define lib-suffix-re (regexp (string-append "\\." lib-suffix "$"))) (define lib-suffix-re (regexp (string-append "\\." lib-suffix "$")))
(provide (rename get-ffi-lib ffi-lib) (provide (rename-out [get-ffi-lib ffi-lib])
ffi-lib? ffi-lib-name) ffi-lib? ffi-lib-name)
(define get-ffi-lib (define get-ffi-lib
(case-lambda (case-lambda
@ -161,9 +163,9 @@
(if (or (not v) (zero? (string-length v))) (if (or (not v) (zero? (string-length v)))
"" (string-append "." v))) "" (string-append "." v)))
versions)] versions)]
[fullpath (lambda (p) (path->complete-path (expand-path p)))] [fullpath (lambda (p) (path->complete-path (cleanse-path p)))]
[absolute? (absolute-path? name)] [absolute? (absolute-path? name)]
[name0 (path->string (expand-path name))] ; orig name [name0 (path->string (cleanse-path name))] ; orig name
[names (map (if (regexp-match lib-suffix-re name0) ; name+suffix [names (map (if (regexp-match lib-suffix-re name0) ; name+suffix
(lambda (v) (string-append name0 v)) (lambda (v) (string-append name0 v))
(lambda (v) (string-append name0 "." lib-suffix v))) (lambda (v) (string-append name0 "." lib-suffix v)))
@ -371,7 +373,7 @@
body))) body)))
(define (custom-type->keys type err) (define (custom-type->keys type err)
(define stops (map (lambda (s) (datum->syntax-object type s #f)) (define stops (map (lambda (s) (datum->syntax type s #f))
'(#%app #%top #%datum))) '(#%app #%top #%datum)))
;; Expand `type' using expand-fun-syntax/fun ;; Expand `type' using expand-fun-syntax/fun
(define orig (expand-fun-syntax/fun type)) (define orig (expand-fun-syntax/fun type))
@ -639,7 +641,7 @@
#,output-expr)))] #,output-expr)))]
;; if there is a string 'ffi-name property, use it as a name ;; if there is a string 'ffi-name property, use it as a name
[body (let ([n (cond [(syntax-property stx 'ffi-name) [body (let ([n (cond [(syntax-property stx 'ffi-name)
=> syntax-object->datum] => syntax->datum]
[else #f])]) [else #f])])
(if (string? n) (if (string? n)
(syntax-property (syntax-property
@ -703,7 +705,7 @@
(provide _path) (provide _path)
;; `file' type: path-expands a path string, provide _path too. ;; `file' type: path-expands a path string, provide _path too.
(define* _file (make-ctype _path expand-path #f)) (define* _file (make-ctype _path cleanse-path #f))
;; `string/eof' type: converts an output #f (NULL) to an eof-object. ;; `string/eof' type: converts an output #f (NULL) to an eof-object.
(define string-type->string/eof-type (define string-type->string/eof-type
@ -935,7 +937,7 @@
;; be just like _bytes since the string carries its size information (so there ;; be just like _bytes since the string carries its size information (so there
;; is no real need for the `o', but it's there for consistency with the above ;; is no real need for the `o', but it's there for consistency with the above
;; macros). ;; macros).
(provide (rename _bytes* _bytes)) (provide (rename-out [_bytes* _bytes]))
(define-fun-syntax _bytes* (define-fun-syntax _bytes*
(syntax-id-rules (o) (syntax-id-rules (o)
[(_ o n) (type: _bytes [(_ o n) (type: _bytes
@ -952,7 +954,7 @@
(provide* cvector? cvector-length cvector-type (provide* cvector? cvector-length cvector-type
;; make-cvector* is a dangerous operation ;; make-cvector* is a dangerous operation
(unsafe (rename make-cvector make-cvector*))) (unsafe (rename-out [make-cvector make-cvector*])))
(define _cvector* ; used only as input types (define _cvector* ; used only as input types
(make-ctype _pointer cvector-ptr (make-ctype _pointer cvector-ptr
@ -976,13 +978,13 @@
[(_ . xs) (_cvector* . xs)] [(_ . xs) (_cvector* . xs)]
[_ _cvector*])) [_ _cvector*]))
(provide (rename allocate-cvector make-cvector)) (provide (rename-out [allocate-cvector make-cvector]))
(define (allocate-cvector type len) (define (allocate-cvector type len)
(make-cvector (if (zero? len) #f ; 0 => NULL (make-cvector (if (zero? len) #f ; 0 => NULL
(malloc len type)) (malloc len type))
type len)) type len))
(provide (rename cvector-args cvector)) (provide (rename-out [cvector-args cvector]))
(define (cvector-args type . args) (define (cvector-args type . args)
(list->cvector args type)) (list->cvector args type))
@ -1019,10 +1021,10 @@
(syntax-case stx () (syntax-case stx ()
[(_ TAG type more ...) (identifier? #'TAG) [(_ TAG type more ...) (identifier? #'TAG)
(let ([name (string-append (let ([name (string-append
(symbol->string (syntax-object->datum #'TAG)) (symbol->string (syntax->datum #'TAG))
"vector")]) "vector")])
(define (make-TAG-id prefix suffix) (define (make-TAG-id prefix suffix)
(datum->syntax-object #'TAG (datum->syntax #'TAG
(string->symbol (string->symbol
(string-append prefix name suffix)) (string-append prefix name suffix))
#'TAG)) #'TAG))
@ -1052,20 +1054,20 @@
bindings)) bindings))
(syntax-case #'(more ...) () (syntax-case #'(more ...) ()
[(X? X-length make-X X X-ref X-set! X->list list->X _X) [(X? X-length make-X X X-ref X-set! X->list list->X _X)
#'(provide (rename X? TAG? ) #'(provide (rename-out [X? TAG? ]
(rename X-length TAG-length) [X-length TAG-length]
(rename make-X make-TAG ) [make-X make-TAG ]
(rename X TAG ) [X TAG ]
(rename X-ref TAG-ref ) [X-ref TAG-ref ]
(rename X-set! TAG-set! ) [X-set! TAG-set! ]
(rename X->list TAG->list ) [X->list TAG->list ]
(rename list->X list->TAG ) [list->X list->TAG ]
(rename _X _TAG ))] [_X _TAG ]))]
[() [()
#'(begin #'(begin
(define-struct TAG (ptr length)) (define-struct TAG (ptr length))
(provide TAG? TAG-length) (provide TAG? TAG-length)
(provide (rename allocate-TAG make-TAG)) (provide (rename-out [allocate-TAG make-TAG]))
(define (allocate-TAG n . init) (define (allocate-TAG n . init)
(let* ([p (if (eq? n 0) #f (malloc n type))] (let* ([p (if (eq? n 0) #f (malloc n type))]
[v (make-TAG p n)]) [v (make-TAG p n)])
@ -1076,7 +1078,7 @@
(ptr-set! p type i init) (ptr-set! p type i init)
(loop (sub1 i)))))) (loop (sub1 i))))))
v)) v))
(provide (rename TAG* TAG)) (provide (rename-out [TAG* TAG]))
(define (TAG* . vals) (define (TAG* . vals)
(list->TAG vals)) (list->TAG vals))
(define* (TAG-ref v i) (define* (TAG-ref v i)
@ -1245,7 +1247,7 @@
(let ([name (cadr (regexp-match #rx"^_(.+)$" (let ([name (cadr (regexp-match #rx"^_(.+)$"
(symbol->string (syntax-e #'_TYPE))))]) (symbol->string (syntax-e #'_TYPE))))])
(define (id . strings) (define (id . strings)
(datum->syntax-object (datum->syntax
#'_TYPE (string->symbol (apply string-append strings)) #'_TYPE)) #'_TYPE (string->symbol (apply string-append strings)) #'_TYPE))
(with-syntax ([name-string name] (with-syntax ([name-string name]
[TYPE? (id name "?")] [TYPE? (id name "?")]
@ -1314,17 +1316,17 @@
(define 1st-type (define 1st-type
(let ([xs (syntax->list slot-types-stx)]) (and (pair? xs) (car xs)))) (let ([xs (syntax->list slot-types-stx)]) (and (pair? xs) (car xs))))
(define (id . strings) (define (id . strings)
(datum->syntax-object (datum->syntax
_TYPE-stx (string->symbol (apply string-append strings)) _TYPE-stx)) _TYPE-stx (string->symbol (apply string-append strings)) _TYPE-stx))
(define (ids name-func) (define (ids name-func)
(map (lambda (s) (map (lambda (s)
(datum->syntax-object (datum->syntax
_TYPE-stx _TYPE-stx
(string->symbol (apply string-append (name-func s))) (string->symbol (apply string-append (name-func s)))
_TYPE-stx)) _TYPE-stx))
slot-names)) slot-names))
(define (safe-id=? x y) (define (safe-id=? x y)
(and (identifier? x) (identifier? y) (module-identifier=? x y))) (and (identifier? x) (identifier? y) (free-identifier=? x y)))
(with-syntax (with-syntax
([has-super? has-super?] ([has-super? has-super?]
[name-string name] [name-string name]
@ -1468,7 +1470,7 @@
(make-syntax #'_TYPE #f #'(slot ...) #'(slot-type ...))] (make-syntax #'_TYPE #f #'(slot ...) #'(slot-type ...))]
[(_ (_TYPE _SUPER) ([slot slot-type] ...)) [(_ (_TYPE _SUPER) ([slot slot-type] ...))
(and (_-identifier? #'_TYPE) (identifiers? #'(slot ...))) (and (_-identifier? #'_TYPE) (identifiers? #'(slot ...)))
(with-syntax ([super (datum->syntax-object #'_TYPE 'super #'_TYPE)]) (with-syntax ([super (datum->syntax #'_TYPE 'super #'_TYPE)])
(make-syntax #'_TYPE #t #'(super slot ...) #'(_SUPER slot-type ...)))])) (make-syntax #'_TYPE #t #'(super slot ...) #'(_SUPER slot-type ...)))]))
;; helper for the above: keep runtime information on structs ;; helper for the above: keep runtime information on structs
@ -1563,4 +1565,3 @@
(will-register killer-executor obj finalizer)) (will-register killer-executor obj finalizer))
(define-unsafer unsafe!) (define-unsafer unsafe!)
)

4
collects/scribblings/foreign/foreign.scrbl
View File

@ -13,6 +13,9 @@ interface}. Furthermore, since most APIs consist mostly of functions,
the foreign interface is sometimes called a @defterm{foreign function the foreign interface is sometimes called a @defterm{foreign function
interface}, abbreviated @deftech{FFI}. interface}, abbreviated @deftech{FFI}.
@bold{Important:} Most of the bindings documented here are available
only after an @scheme[(unsafe!)] declaration in the importing module.
@table-of-contents[] @table-of-contents[]
@include-section["intro.scrbl"] @include-section["intro.scrbl"]
@ -22,5 +25,6 @@ interface}, abbreviated @deftech{FFI}.
@include-section["misc.scrbl"] @include-section["misc.scrbl"]
@include-section["derived.scrbl"] @include-section["derived.scrbl"]
@include-section["unexported.scrbl"] @include-section["unexported.scrbl"]
@include-section["unsafe.scrbl"]
@index-section[] @index-section[]

1
collects/scribblings/foreign/info.ss
View File

@ -1,4 +1,3 @@
(module info setup/infotab (module info setup/infotab
(define name "Scribblings: FFI") (define name "Scribblings: FFI")
(define scribblings '(("foreign.scrbl" (multi-page main-doc))))) (define scribblings '(("foreign.scrbl" (multi-page main-doc)))))

8
collects/scribblings/foreign/intro.scrbl
View File

@ -28,13 +28,5 @@ macro should be considered as a declaration that your code is itself
unsafe, therefore can lead to serious problems in case of bugs: it is unsafe, therefore can lead to serious problems in case of bugs: it is
your responsibility to provide a safe interface. your responsibility to provide a safe interface.
In rare cases, you might want to provide an @italic{unsafe} interface
hat builds on the unsafe features of the FFI. In such cases, use the
@indexed-scheme[provide*] macro with @scheme[unsafe] bindings, and use
@indexed-scheme[define-unsafer] to provide an @scheme[unsafe!]-like macro
that will make these bindings available to importers of your library.
Providing users with unsafe operations without using this facility
should be considered a bug in your code.
For examples of common FFI usage patterns, see the defined interfaces For examples of common FFI usage patterns, see the defined interfaces
in the @filepath{ffi} collection. in the @filepath{ffi} collection.

427
collects/scribblings/foreign/pointers.scrbl
View File

@ -3,282 +3,363 @@
@title[#:tag "foreign:pointer-funcs"]{Pointer Functions} @title[#:tag "foreign:pointer-funcs"]{Pointer Functions}
@;{
@defproc[(cpointer? [v any/c]) boolean?]{ @defproc[(cpointer? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a C pointer or a value that can Returns @scheme[#t] if @scheme[v] is a C pointer or a value that can
be used as a pointer: @scheme[#f] (used as a @cpp{NULL} pointer), byte be used as a pointer: @scheme[#f] (used as a @cpp{NULL} pointer), byte
strings (used as memory blocks), some additional internal objects strings (used as memory blocks), some additional internal objects
(@scheme[ffi-obj]s and callbacks, see @secref["c-only"]). Returns (@scheme[ffi-obj]s and callbacks, see @secref["foreign:c-only"]).
@scheme[#f] for other values.} Returns @scheme[#f] for other values.}
\scmutilsectionO{ptr-ref}{cptr ctype}{\Optional{'abs} offset}{procedure} @defproc*[([(ptr-ref [cptr cpointer?]
[type ctype?]
[offset exact-nonnegative-integer? 0])
any]
[(ptr-ref [cptr cpointer?]
[type ctype?]
[abs-tag (one-of/c 'abs)]
[offset exact-nonnegative-integer?])
any]
[(ptr-set! [cptr cpointer?]
[type ctype?]
[val any/c])
void?]
[(ptr-set! [cptr cpointer?]
[type ctype?]
[offset exact-nonnegative-integer?]
[val any/c])
void?]
[(ptr-set! [cptr cpointer?]
[type ctype?]
[abs-tag (one-of/c 'abs)]
[offset exact-nonnegative-integer?]
[val any/c])
void?])]{
\scmutilsection{ptr-set!}{cptr ctype \Optional{\Optional{'abs} offset} value}{procedure} The @scheme[ptr-ref] procedure returns the object referenced by
@scheme[cptr], using the given @scheme[type]. The @scheme[ptr-set!]
procedure stores the @scheme[val] in the memory @scheme[cptr] points
to, using the given @scheme[type] for the conversion.
The @scheme[pre-ref] procedure return the object referenced by In each case, @scheme[offset] defaults to @scheme[0] (which is the
@var{cptr}, using the given @var{ctype}. The @scheme[ptr-set!]\ only value that should be used with @scheme[ffi-obj] objects, see
procedure stores the @var{value} in the memory @var{cptr} points to, using @secref["foreign:c-only"]). If an @scheme[offset] index is
the given @var{ctype} for the conversion, and returns @|void-const|. non-@scheme[0], the value is read or stored at that location,
considering the pointer as a vector of @scheme[type]s --- so the
actual address is the pointer plus the size of @scheme[type]
multiplied by @scheme[offset]. In addition, a @scheme['abs] flag can
be used to use the @scheme[offset] as counting bytes rather then
increments of the specified @scheme[type].
In each case, @var{offset} defaults to $0$ (which is the only value Beware that the @scheme[ptr-ref] and @scheme[ptr-set!] procedure do
that should be used with @scheme[ffi-obj] objects, see
section~\ref{foreign:c-only}). If an @var{offset} index is given, the
value is stored at that location, considering the pointer as a vector
of @var{ctype}s --- so the actual address is the pointer plus the size
of @var{ctype} multiplied by @var{offset}. In addition, a @var{'abs}
flag can be used to use the @var{offset} as counting bytes rather then
increments of the specified @var{ctype}.
Beware that the @scheme[ptr-ref] and @scheme[ptr-set!]\ procedure do
not keep any meta-information on how pointers are used. It is the not keep any meta-information on how pointers are used. It is the
programmer's responsibility to use this facility only when programmer's responsibility to use this facility only when
appropriate. For example, on a little-endian machine: appropriate. For example, on a little-endian machine:
%
@schemeblock[ @schemeblock[
> (define block (malloc _int 5)) > (define block (malloc _int 5))
> (ptr-set! block _int 0 196353) > (ptr-set! block _int 0 196353)
> (map (lambda (i) (ptr-ref block _byte i)) '(0 1 2 3)) > (map (lambda (i) (ptr-ref block _byte i)) '(0 1 2 3))
(1 255 2 0) @,(schemeresultfont "(1 255 2 0)")
] ]
%
In addition, @scheme[ptr-ref] and @scheme[ptr-set!]\ cannot detect
when offsets are beyond an object's memory bounds; out-of-bounds
access can easily lead to a segmentation fault or memory corruption.
@defproc[(ptr-equal? [cptr$_1$ any/c][cptr$_2$ any/c]) any] In addition, @scheme[ptr-ref] and @scheme[ptr-set!] cannot detect when
offsets are beyond an object's memory bounds; out-of-bounds access can
easily lead to a segmentation fault or memory corruption.}
Compares the values of the two pointers. (Note that two different Scheme
pointer objects can contain the same pointer.)
@defproc[(ptr-add [cptr any/c][offset-k nonnegative-exact-integer?][ctype any/c #f]) any] @defproc[(ptr-equal? [cptr1 cpointer?][cptr2 cpointer?]) boolean?]{
Returns a cpointer that is like @var{cptr} offset by @var{offset-k} Compares the values of the two pointers. Two different Scheme
instances of @var{ctype}. If @var{ctype} is not provided, @var{cptr} pointer objects can contain the same pointer.}
is offset by @var{offset-k} bytes.
The resulting cpointer keeps the base pointer and offset separate. The two
pieces are combined at the last minute before any operation on the pointer,
such as supplying the pointer to a foreign function. In particular, the pointer
and offset are not combined until after all allocation leading up to a
foreign-function call; if the called function does not itself call anything
that can trigger a garbage collection, it can safey use pointers that are
offset into the middle of a GCable object.
@defproc[(offset-ptr? [cptr any/c]) any] @defproc[(ptr-add [cptr cpointer?][offset exact-integer?][type ctype? _byte])
cpointer?]{
A predicate for cpointers that have an offset, such as pointers that were Returns a cpointer that is like @scheme[cptr] offset by
created using @scheme[ptr-add]. Returns @scheme[#t] even if such an offset @scheme[offset] instances of @scheme[ctype].
happens to be 0. Returns @scheme[#f] for other cpointers and non-cpointers.
@defproc[(ptr-offset [cptr any/c]) any] The resulting cpointer keeps the base pointer and offset separate. The
two pieces are combined at the last minute before any operation on the
pointer, such as supplying the pointer to a foreign function. In
particular, the pointer and offset are not combined until after all
allocation leading up to a foreign-function call; if the called
function does not itself call anything that can trigger a garbage
collection, it can safey use pointers that are offset into the middle
of a GCable object.}
Returns the offset of a pointer that has an offset. (The resulting offset is
always in bytes.)
@defproc[(set-ptr-offset! [cptr any/c][offset-k nonnegative-exact-integer?][ctype any/c #f]) any] @defproc[(offset-ptr? [cptr cpointer?]) boolean?]{
Sets the offset component of an offset pointer. The arguments are used in the A predicate for cpointers that have an offset, such as pointers that
same way as @scheme[ptr-add]. Raises an error if it is given a pointer that were created using @scheme[ptr-add]. Returns @scheme[#t] even if such
has no offset. an offset happens to be 0. Returns @scheme[#f] for other cpointers
and non-cpointers.}
@defproc[(ptr-add! [cptr any/c][offset-k nonnegative-exact-integer?][ctype any/c #f]) any]
Like @scheme[ptr-add], but destructively modifies the offset contained in a @defproc[(ptr-offset [cptr cpointer?]) exact-integer?]{
pointer. (This can also be done using @scheme[ptr-offset] and
@scheme[set-ptr-offset!].)
@defproc[(cpointer-tag [cptr any/c]) any] Returns the offset of a pointer that has an offset. The resulting
offset is always in bytes.}
Returns the Scheme object that is the tag of the given @var{cptr} pointer.
@defproc[(set-cpointer-tag! [cptr any/c][tag any/c]) any] @defproc[(set-ptr-offset! [cptr cpointer?][offset exact-integer?][ctype ctype? _byte])
void?]{
Sets the tag of the given @var{cptr}. The @var{tag} argument can be Sets the offset component of an offset pointer. The arguments are
any arbitrary value; other pointer operations ignore it. When a used in the same way as @scheme[ptr-add]. If @scheme[cptr] has no
offset, the @scheme[exn:fail:contract] exception is raised.}
@defproc[(ptr-add! [cptr cpointer?][offset exact-integer?][ctype ctype? _byte])
void?]{
Like @scheme[ptr-add], but destructively modifies the offset contained
in a pointer. The same operation could be performed using
@scheme[ptr-offset] and @scheme[set-ptr-offset!].}
@defproc[(cpointer-tag [cptr cpointer?]) any]{
Returns the Scheme object that is the tag of the given @scheme[cptr]
pointer.}
@defproc[(set-cpointer-tag! [cptr cpointer?][tag any/c]) void?]{
Sets the tag of the given @scheme[cptr]. The @scheme[tag] argument can
be any arbitrary value; other pointer operations ignore it. When a
cpointer value is printed, its tag is shown if it is a symbol, a byte cpointer value is printed, its tag is shown if it is a symbol, a byte
string, a string. In addition, if the tag is a pair holding one of string, a string. In addition, if the tag is a pair holding one of
these in its @scheme[car], the @scheme[car] is shown (so that the tag these in its @scheme[car], the @scheme[car] is shown (so that the tag
can contain other information). can contain other information).}
\scmutilsection{memmove}{cptr \Optional{offset-k}
src-cptr \Optional{src-offset-k}
count-k \Optional{ctype}}
Copies to @var{cptr} from @var{src-cptr}. The destination pointer can be @defproc*[([(memmove [cptr cpointer?]
offset by an optional @var{offset-k}, which is in bytes if @var{ctype} [src-cptr cpointer?]
is not supplied, or in @var{ctype} instances when supplied. [count nonnegative-exact-integer?]
The source pointer can be similarly offset by @var{src-offset-k}. [type ctype? _byte])
The number of bytes copied from source to destination is determined by @var{count-k}, void?]
which is also in bytes if @var{ctype} is not supplied, or in @var{ctype} [(memmove [cptr cpointer?]
instances when supplied. [offset exact-integer?]
[src-cptr cpointer?]
[count nonnegative-exact-integer?]
[type ctype? _byte])
void?]
[(memmove [cptr cpointer?]
[offset exact-integer?]
[src-cptr cpointer?]
[src-offset exact-integer?]
[count nonnegative-exact-integer?]
[type ctype? _byte])
void?])]{
\scmutilsection{memcpy}{cptr \Optional{offset-k} Copies to @scheme[cptr] from @scheme[src-cptr]. The destination
src-cptr \Optional{src-offset-k} pointer can be offset by an optional @scheme[offset], which is in
count-k \Optional{count-ctype}} @scheme[type] instances. The source pointer can be similarly offset
by @scheme[src-offset]. The number of bytes copied from source to
destination is determined by @scheme[count], which is in @scheme[type]
instances when supplied.}
Like @scheme[memmove], but the result is @defproc*[([(memcpy [cptr cpointer?]
undefined if the destination and source overlap. [src-cptr cpointer?]
[count nonnegative-exact-integer?]
[type ctype? _byte])
void?]
[(memcpy [cptr cpointer?]
[offset exact-integer?]
[src-cptr cpointer?]
[count nonnegative-exact-integer?]
[type ctype? _byte])
void?]
[(memcpy [cptr cpointer?]
[offset exact-integer?]
[src-cptr cpointer?]
[src-offset exact-integer?]
[count nonnegative-exact-integer?]
[type ctype? _byte])
void?])]{
\scmutilsection{memset}{cptr \Optional{offset-k} Like @scheme[memmove], but the result is undefined if the destination
byte and source overlap.}
count-k \Optional{count-ctype}}
Similar to @scheme[memmove], but the destination is uniformly filled with @defproc*[([(memset [cptr cpointer?]
@var{byte} (i.e., an exact integer between 0 and 255 includive). [byte byte?]
[count nonnegative-exact-integer?]
[type ctype? _byte])
void?]
[(memset [cptr cpointer?]
[offset exact-integer?]
[byte byte?]
[count nonnegative-exact-integer?]
[type ctype? _byte])
void?])]{
%------------------------------------------------------------ Similar to @scheme[memmove], but the destination is uniformly filled
with @scheme[byte] (i.e., an exact integer between 0 and 255
inclusive).}
@; ------------------------------------------------------------
@section{Memory Management} @section{Memory Management}
For general information on C-level memory management with MzScheme, see For general information on C-level memory management with PLT Scheme,
{\InsideMzSchemeManual}. see @|InsideMzScheme|.
\scmutilsection{malloc}{bytes-or-type @defproc[(malloc [bytes-or-type (or/c exact-nonnegative-integer? ctype?)]
\Optional{type-or-bytes} [type-or-bytes (or/c exact-nonnegative-integer? ctype?) #, @elem{absent}]
\Optional{cptr} [cptr cpointer? #, @elem{absent}]
\Optional{mode} \Optional{'fail-ok}}{procedure} [mode (one-of/c 'nonatomic 'stubborn 'uncollectable
'eternal 'interior 'atomic-interior
'raw)
#, @elem{absent}]
[fail-mode (one-of/c 'failok) #, @elem{absent}])
cpointer?]{
Allocates a memory block of a specified size using a specified
allocation. The result is a @scheme[cpointer] to the allocated
memory. Alhough not reflected above, the four arguments can appear in
any order since they are all different types of Scheme objects; a size
specification is required at minimum:
Allocates a memory block of a specified size using a specified allocation. The result is a
@scheme[cpointer] to the allocated memory. The four arguments can appear in
any order since they are all different types of Scheme objects; a
size specification is required at minimum:
@itemize{ @itemize{
@item{If a C type @var{bytes-or-type} is given, its size is used to the block
allocation size.} @item{If a C type @scheme[bytes-or-type] is given, its size is used
@item{If an integer @var{bytes-or-type} is given, it specifies the required to the block allocation size.}
size in bytes.}
@item{If both @var{bytes-or-type} and @var{type-or-bytes} are given, then the @item{If an integer @scheme[bytes-or-type] is given, it specifies the
required size in bytes.}
@item{If both @scheme[bytes-or-type] and @scheme[type-or-bytes] are given, then the
allocated size is for a vector of values (the multiplication of the size of allocated size is for a vector of values (the multiplication of the size of
the C type and the integer).} the C type and the integer).}
@item{If a @var{cptr} pointer is given, its contents is copied to the new
block, it is expected to be able to do so.} @item{If a @scheme[cptr] pointer is given, its content is copied to
@item{A symbol @var{mode} argument can be given, which specifies what the new block.}
allocation function to use. It should be one of @indexed-scheme['nonatomic] (uses
@cpp{scheme_malloc} from MzScheme's C API), @indexed-scheme['atomic] (@cpp{scheme_malloc_atomic}), @item{A symbol @scheme[mode] argument can be given, which specifies
@indexed-scheme['stubborn] (@cpp{scheme_malloc_stubborn}), @indexed-scheme['uncollectable] what allocation function to use. It should be one of
(@cpp{scheme_malloc_uncollectable}), @indexed-scheme['eternal] ({\tt @indexed-scheme['nonatomic] (uses @cpp{scheme_malloc} from PLT
scheme_malloc_eternal}), @indexed-scheme['interior] Scheme's C API), @indexed-scheme['atomic]
(@cpp{scheme_malloc_allow_interior}), @indexed-scheme['atomic-interior] (@cpp{scheme_malloc_atomic}), @indexed-scheme['stubborn]
(@cpp{scheme_malloc_atomic_allow_interior}), or @indexed-scheme['raw] (uses the (@cpp{scheme_malloc_stubborn}), @indexed-scheme['uncollectable]
operating system's @cpp{malloc}, creating a GC-invisible block).} (@cpp{scheme_malloc_uncollectable}), @indexed-scheme['eternal]
@item{If an additional @indexed-scheme['failok] flag is given, then {\tt (@cpp{scheme_malloc_eternal}), @indexed-scheme['interior]
scheme_malloc_fail_ok} is used to wrap the call.} (@cpp{scheme_malloc_allow_interior}),
@indexed-scheme['atomic-interior]
(@cpp{scheme_malloc_atomic_allow_interior}), or
@indexed-scheme['raw] (uses the operating system's @cpp{malloc},
creating a GC-invisible block).} @item{If an additional
@indexed-scheme['failok] flag is given, then
@cpp{scheme_malloc_fail_ok} is used to wrap the call.}
} }
If no mode is specified, then @scheme['nonatomic] allocation is used If no mode is specified, then @scheme['nonatomic] allocation is used
when the type is any pointer-based type, and @scheme['atomic] when the type is any pointer-based type, and @scheme['atomic]
allocation is used otherwise. allocation is used otherwise.}
@defproc[(free [cpointer any/c]) any]
@defproc[(free [cptr cpointer?]) void]{
Uses the operating system's @cpp{free} function for Uses the operating system's @cpp{free} function for
@scheme['raw]-allocated pointers, and for pointers that a foreign @scheme['raw]-allocated pointers, and for pointers that a foreign
library allocated and we should free. Note that this is useful as library allocated and we should free. Note that this is useful as
part of a finalizer (see below) procedure hook (e.g., on the Scheme part of a finalizer (see below) procedure hook (e.g., on the Scheme
pointer object, freeing the memory when the pointer object is pointer object, freeing the memory when the pointer object is
collected, but beware of aliasing). collected, but beware of aliasing).}
@defproc[(end-stubborn-change [cpointer any/c]) any]
@defproc[(end-stubborn-change [cptr cpointer?]) void?]{
Uses @cpp{scheme_end_stubborn_change} on the given stubborn-allocated Uses @cpp{scheme_end_stubborn_change} on the given stubborn-allocated
pointer (see {\InsideMzSchemeManual}). pointer.}
@defproc[(malloc-immobile-cell [v any/c]) any]
@defproc[(malloc-immobile-cell [v any/c]) cpointer?]{
Allocates memory large enough to hold one arbitrary (collectable) Allocates memory large enough to hold one arbitrary (collectable)
Scheme value, but that is not itself collectable or moved by the Scheme value, but that is not itself collectable or moved by the
memory manager. The cell is initialized with @var{v}; use the type memory manager. The cell is initialized with @scheme[v]; use the type
@scheme[_scheme] with @scheme[ptr-ref] and @scheme[ptr-set!] to get @scheme[_scheme] with @scheme[ptr-ref] and @scheme[ptr-set!] to get
or set the cell's value. The cell must be explicitly freed with or set the cell's value. The cell must be explicitly freed with
@scheme[free-immobile-cell]. @scheme[free-immobile-cell].}
@defproc[(free-immobile-cell [cpointer any/c]) any]
Frees an immobile cell created by @scheme[malloc-immobile-cell]. @defproc[(free-immobile-cell [cptr cpointer?]) void?]{
%% *** Documentation for the disabled C code. A Scheme impl. is used now. Frees an immobile cell created by @scheme[malloc-immobile-cell].}
%% @defproc[(register-finalizer [cptr any/c][finalizer any/c]['pointer any/c #f]) any]
%%
%% Registers a finalizer procedure @var{finalizer-proc} with the given @var{cptr}
%% object. The finalizer is called by the primitive GC finalizer mechanism, make
%% sure no references to the object are recreated. Using @scheme[#f] for
%% @var{finalizer-proc} means erase the existing finalizer, if any. The finalizer
%% is registered for the Scheme pointer object --- be careful with aliasing.
%%
%% If an optional @var{'pointer} symbol argument is used, the finalizer is
%% registered with the actual pointer rather than the Scheme object. The
%% procedure gets a new C pointer object that points to the collected pointer.
%% This should be used only with pointers that the GC can access.
@defproc[(register-finalizer [obj any/c][finalizer any/c]) any]
Registers a finalizer procedure @var{finalizer-proc} with the given @var{obj} @defproc[(register-finalizer [obj any/c][finalizer (any/c . -> . any)]) void?]{
which can be any Scheme (GC-able) object. The finalizer is registered with a
will executor (see \MzSecRef{willexecutor}); it is invoked when @var{obj} is
about to be collected. (This is done by a thread that is in charge of
triggering these will executors.)
This is mostly intended to be used with cpointer objects (for freeing Registers a finalizer procedure @scheme[finalizer-proc] with the given
unused memory that is not under GC control), but it can be used with @scheme[obj], which can be any Scheme (GC-able) object. The finalizer
any Scheme object --- even ones that have nothing to do with foreign is registered with a will executor; see
code. Note, however, that the finalizer is registered for the @scheme[make-will-executor]. The finalizer is invoked when
@italic{Scheme} object. If you intend to free a pointer object, then you @scheme[obj] is about to be collected. (This is done by a thread that
must be careful to not register finalizers for two cpointers that is in charge of triggering these will executors.)
Finalizers are mostly intended to be used with cpointer objects (for
freeing unused memory that is not under GC control), but it can be
used with any Scheme object---even ones that have nothing to do with
foreign code. Note, however, that the finalizer is registered for the
@italic{Scheme} object. If you intend to free a pointer object, then
you must be careful to not register finalizers for two cpointers that
point to the same address. Also, be careful to not make the finalizer point to the same address. Also, be careful to not make the finalizer
a closure that holds on to the object. a closure that holds on to the object.
For example, suppose that you're dealing with a foreign function that returns a C For example, suppose that you're dealing with a foreign function that returns a C
string that you should free. Here is an attempt at creating a suitable type: string that you should free. Here is an attempt at creating a suitable type:
%
@schemeblock[ @schemeblock[
(define _bytes/free (define bytes/free
(make-ctype _pointer (make-ctype _pointer
#f ; a Scheme bytes can be used as a pointer #f (code:comment #, @t{a Scheme bytes can be used as a pointer})
(lambda (x) (lambda (x)
(let ([b (make-byte-string x)]) (let ([b (make-byte-string x)])
(register-finalizer x free) (register-finalizer x free)
b)))) b))))
] ]
%
This is wrong: the finalizer is registered for @scheme[x], which is no longer The above code is wrong: the finalizer is registered for @scheme[x],
needed once the byte string is created. Changing this to register the which is no longer needed once the byte string is created. Changing
finalizer for @scheme[b] correct this problem, but then @scheme[free] will be this to register the finalizer for @scheme[b] correct this problem,
invoked on it instead of on @scheme[x]. In an attempt to fix this, we will be but then @scheme[free] will be invoked on it instead of on @scheme[x].
careful and print out a message for debugging: In an attempt to fix this, we will be careful and print out a message
% for debugging:
@schemeblock[ @schemeblock[
(define _bytes/free (define bytes/free
(make-ctype _pointer (make-ctype _pointer
#f ; a Scheme bytes can be used as a pointer #f (code:comment #, @t{a Scheme bytes can be used as a pointer})
(lambda (x) (lambda (x)
(let ([b (make-byte-string x)]) (let ([b (make-byte-string x)])
(register-finalizer b (register-finalizer b
(lambda (_) (lambda (ignored)
(printf "Releasing ~s\n" b) (printf "Releasing ~s\n" b)
(free x))) (free x)))
b)))) b))))
] ]
%
but we never see any printout --- the problem is that the finalizer is a
closure that keeps a reference to @scheme[b]. To fix this, you should use the
input argument to the finalizer. Simply changing the @scheme[_] to @scheme[b]
will solve this problem. (Removing the debugging message also avoids the problem,
since the finalization procedure would then not close over @scheme[b].)
@defproc[(make-sized-byte-string [cptr any/c][length any/c]) any] but we never see any printout. The problem is that the finalizer is a
closure that keeps a reference to @scheme[b]. To fix this, you should
use the input argument to the finalizer. Simply changing
@scheme[ignored] to @scheme[b] will solve this problem. (Removing the
debugging message also avoids the problem, since the finalization
procedure would then not close over @scheme[b].)}
Returns a byte string made of the given pointer and the given
length. No copying is done. This can be used as an alternative to make @defproc[(make-sized-byte-string [cptr cpointer?][length exact-nonnegative-integer?])
bytes?]{
Returns a byte string made of the given pointer and the given length.
No copying is done. This can be used as an alternative to make
pointer values accessible in Scheme when the size is known. pointer values accessible in Scheme when the size is known.
If @var{cptr} is an offset pointer created by @scheme[ptr-add], the If @scheme[cptr] is an offset pointer created by @scheme[ptr-add], the
offset is immediately added to the pointer. Thus, this function cannot offset is immediately added to the pointer. Thus, this function cannot
be used with @scheme[ptr-add] to create a substring of a Scheme byte be used with @scheme[ptr-add] to create a substring of a Scheme byte
string, because the offset pointer would be to the middle of a string, because the offset pointer would be to the middle of a
collectable object (which is not allowed). collectable object (which is not allowed).}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
}

4
collects/scribblings/foreign/types.scrbl
View File

@ -237,8 +237,8 @@ value of @cpp{NULL} is translated to a Scheme @scheme[eof] value.}
Corresponds to Scheme ``C pointer'' objects. These pointers can have Corresponds to Scheme ``C pointer'' objects. These pointers can have
an arbitrary Scheme object attached as a type tag. The tag is ignored an arbitrary Scheme object attached as a type tag. The tag is ignored
by built-in functionality; it is intended to be used by interfaces. by built-in functionality; it is intended to be used by interfaces.
See @secref["tagged-pointers"] for creating pointer types that use See @secref["foreign:tagged-pointers"] for creating pointer types that
these tags for safety.} use these tags for safety.}
@defthing[_scheme ctype?]{ @defthing[_scheme ctype?]{

29
collects/scribblings/foreign/unsafe.scrbl Normal file
View File

@ -0,0 +1,29 @@
#lang scribble/doc
@(require "utils.ss")
@title{Macros for Unsafety}
@defform[(unsafe!)]{
Makes most of the bindings documented in this module available. See
@secref["intro"] for information on why this declaration is required.}
@defform/subs[#:literals (unsafe rename-out)
(provide* provide-star-spec ...)
([provide-star-spec (unsafe id)
(unsafe (rename-out [id external-id]))
provide-spec])]{
Like @scheme[provide], but @scheme[id]s under @scheme[unsafe] are not
actually provided. Instead, they are collected for introduction into
an importing module via a macro created by @scheme[define-unsafer].
Providing users with unsafe operations without using this facility
should be considered a bug in your code.}
@defform[(define-unsafer id)]{
Cooperates with @scheme[provide*] to define @scheme[id] as a
@scheme[unsafe!]-like form that introduces definitions for each
binding provided as @scheme[unsafe].}

2
collects/scribblings/foreign/utils.ss
View File

@ -3,6 +3,7 @@
(require scribble/manual (require scribble/manual
scribble/struct scribble/struct
scribble/decode scribble/decode
(only-in "../inside/utils.ss" cpp)
(for-syntax scheme/base) (for-syntax scheme/base)
(for-label scheme/base (for-label scheme/base
scheme/contract scheme/contract
@ -15,7 +16,6 @@
scheme/contract scheme/contract
"unsafe-foreign.ss"))) "unsafe-foreign.ss")))
(define cpp tt)
(define InsideMzScheme (define InsideMzScheme
(italic (secref #:doc '(lib "scribblings/inside/inside.scrbl") (italic (secref #:doc '(lib "scribblings/inside/inside.scrbl")

16
collects/scribblings/inside/hooks.scrbl
View File

@ -26,13 +26,13 @@ embedded:
messages that possibly contain non-terminating nuls. The default is messages that possibly contain non-terminating nuls. The default is
@var{NULL}.} @var{NULL}.}
@item{@cppdef{scheme_check_for_break} --- \index{user breaks} This @item{@cppdef{scheme_check_for_break} --- This points to a function
points to a function of no arguments that returns an integer. It is of no arguments that returns an integer. It is used as the default
used as the default user-break polling procedure in the main user-break polling procedure in the main thread. A non-zero return
thread. A non-zero return value indicates a user break, and each time value indicates a user break, and each time the function returns a
the function returns a non-zero value, it counts as a new break non-zero value, it counts as a new break signal (though the break
signal (though the break signal may be ignored if a previous signal signal may be ignored if a previous signal is still pending). The
is still pending). The default is @cpp{NULL}.} default is @cpp{NULL}.}
@item{@cppdef{scheme_case_sensitive} --- If this flag is set to a @item{@cppdef{scheme_case_sensitive} --- If this flag is set to a
non-zero value before @cppi{scheme_basic_env} is called, then non-zero value before @cppi{scheme_basic_env} is called, then
@ -41,7 +41,7 @@ embedded:
set. The default is zero.} set. The default is zero.}
@item{@cppdef{scheme_allow_set_undefined} --- This flag determines @item{@cppdef{scheme_allow_set_undefined} --- This flag determines
the initial value of \scmi{compile-allow-set!-undefined}. The default the initial value of @scheme[compile-allow-set!-undefined]. The default
is zero.} is zero.}
@item{@cppdef{scheme_console_printf} --- This function pointer was @item{@cppdef{scheme_console_printf} --- This function pointer was

8
collects/scribblings/inside/inside.scrbl
View File

@ -9,9 +9,11 @@ interpreter to be extended by a dynamically-loaded library, or
embedded within an arbitrary C/C++ program. The manual assumes embedded within an arbitrary C/C++ program. The manual assumes
familiarity with PLT Scheme as described in @|MzScheme|. familiarity with PLT Scheme as described in @|MzScheme|.
For an alternative way of dealing with foreign code, see ..., which For an alternative way of dealing with foreign code, see
describes the @schememodname[scheme/foreign] module for manipulating @italic{@secref[#:doc '(lib "scribblings/foreign/foreign.scrbl")
low-level libraries and structures purely through Scheme code. "top"]}, which describes the @schememodname[scheme/foreign] module for
manipulating low-level libraries and structures purely through Scheme
code.
@table-of-contents[] @table-of-contents[]

60
collects/scribblings/inside/params.scrbl
View File

@ -23,52 +23,52 @@ Parameter values for built-in parameters are obtained and modified
through the following indices: through the following indices:
@itemize{ @itemize{
@item{@cppi{MZCONFIG_ENV} --- @scheme[current-namespace] (use @cppi{scheme_get_env})} @item{@cppdef{MZCONFIG_ENV} --- @scheme[current-namespace] (use @cpp{scheme_get_env})}
@item{@cppi{MZCONFIG_INPUT_PORT} --- @scheme[current-input-port]} @item{@cppdef{MZCONFIG_INPUT_PORT} --- @scheme[current-input-port]}
@item{@cppi{MZCONFIG_OUTPUT_PORT} --- @scheme[current-output-port]} @item{@cppdef{MZCONFIG_OUTPUT_PORT} --- @scheme[current-output-port]}
@item{@cppi{MZCONFIG_ERROR_PORT} --- @scheme[current-error-port]} @item{@cppdef{MZCONFIG_ERROR_PORT} --- @scheme[current-error-port]}
@item{@cppi{MZCONFIG_ERROR_DISPLAY_HANDLER} --- @scheme[error-display-handler]} @item{@cppdef{MZCONFIG_ERROR_DISPLAY_HANDLER} --- @scheme[error-display-handler]}
@item{@cppi{MZCONFIG_ERROR_PRINT_VALUE_HANDLER} --- @scheme[error-value->string-handler]} @item{@cppdef{MZCONFIG_ERROR_PRINT_VALUE_HANDLER} --- @scheme[error-value->string-handler]}
@item{@cppi{MZCONFIG_EXIT_HANDLER} --- @scheme[exit-handler]} @item{@cppdef{MZCONFIG_EXIT_HANDLER} --- @scheme[exit-handler]}
@item{@cppi{MZCONFIG_INIT_EXN_HANDLER} --- @scheme[uncaught-exception-handler]} @item{@cppdef{MZCONFIG_INIT_EXN_HANDLER} --- @scheme[uncaught-exception-handler]}
@item{@cppi{MZCONFIG_EVAL_HANDLER} --- @scheme[current-eval]} @item{@cppdef{MZCONFIG_EVAL_HANDLER} --- @scheme[current-eval]}
@item{@cppi{MZCONFIG_LOAD_HANDLER} --- @scheme[current-load]} @item{@cppdef{MZCONFIG_LOAD_HANDLER} --- @scheme[current-load]}
@item{@cppi{MZCONFIG_PRINT_HANDLER} --- @scheme[current-print]} @item{@cppdef{MZCONFIG_PRINT_HANDLER} --- @scheme[current-print]}
@item{@cppi{MZCONFIG_PROMPT_READ_HANDLER} --- @scheme[current-prompt-read]} @item{@cppdef{MZCONFIG_PROMPT_READ_HANDLER} --- @scheme[current-prompt-read]}
@item{@cppi{MZCONFIG_CAN_READ_GRAPH} --- @scheme[read-accept-graph]} @item{@cppdef{MZCONFIG_CAN_READ_GRAPH} --- @scheme[read-accept-graph]}
@item{@cppi{MZCONFIG_CAN_READ_COMPILED} --- @scheme[read-accept-compiled]} @item{@cppdef{MZCONFIG_CAN_READ_COMPILED} --- @scheme[read-accept-compiled]}
@item{@cppi{MZCONFIG_CAN_READ_BOX} --- @scheme[read-accept-box]} @item{@cppdef{MZCONFIG_CAN_READ_BOX} --- @scheme[read-accept-box]}
@item{@cppi{MZCONFIG_CAN_READ_PIPE_QUOTE} --- @scheme[read-accept-bar-quote]} @item{@cppdef{MZCONFIG_CAN_READ_PIPE_QUOTE} --- @scheme[read-accept-bar-quote]}
@item{@cppi{MZCONFIG_PRINT_GRAPH} --- @scheme[print-graph]} @item{@cppdef{MZCONFIG_PRINT_GRAPH} --- @scheme[print-graph]}
@item{@cppi{MZCONFIG_PRINT_STRUCT} --- @scheme[print-struct]} @item{@cppdef{MZCONFIG_PRINT_STRUCT} --- @scheme[print-struct]}
@item{@cppi{MZCONFIG_PRINT_BOX} --- @scheme[print-box]} @item{@cppdef{MZCONFIG_PRINT_BOX} --- @scheme[print-box]}
@item{@cppi{MZCONFIG_CASE_SENS} --- @scheme[read-case-sensitive]} @item{@cppdef{MZCONFIG_CASE_SENS} --- @scheme[read-case-sensitive]}
@item{@cppi{MZCONFIG_SQUARE_BRACKETS_ARE_PARENS} --- @scheme[read-square-brackets-as-parens]} @item{@cppdef{MZCONFIG_SQUARE_BRACKETS_ARE_PARENS} --- @scheme[read-square-brackets-as-parens]}
@item{@cppi{MZCONFIG_CURLY_BRACES_ARE_PARENS} --- @scheme[read-curly-braces-as-parens]} @item{@cppdef{MZCONFIG_CURLY_BRACES_ARE_PARENS} --- @scheme[read-curly-braces-as-parens]}
@item{@cppi{MZCONFIG_ERROR_PRINT_WIDTH} --- @scheme[error-print-width]} @item{@cppdef{MZCONFIG_ERROR_PRINT_WIDTH} --- @scheme[error-print-width]}
@item{@cppi{MZCONFIG_ALLOW_SET_UNDEFINED} --- @scheme[allow-compile-set!-undefined]} @item{@cppdef{MZCONFIG_ALLOW_SET_UNDEFINED} --- @scheme[allow-compile-set!-undefined]}
@item{@cppi{MZCONFIG_CUSTODIAN} --- @scheme[current-custodian]} @item{@cppdef{MZCONFIG_CUSTODIAN} --- @scheme[current-custodian]}
@item{@cppi{MZCONFIG_USE_COMPILED_KIND} --- @scheme[use-compiled-file-paths]} @item{@cppdef{MZCONFIG_USE_COMPILED_KIND} --- @scheme[use-compiled-file-paths]}
@item{@cppi{MZCONFIG_LOAD_DIRECTORY} --- @scheme[current-load-relative-directory]} @item{@cppdef{MZCONFIG_LOAD_DIRECTORY} --- @scheme[current-load-relative-directory]}
@item{@cppi{MZCONFIG_COLLECTION_PATHS} --- @scheme[current-library-collection-paths]} @item{@cppdef{MZCONFIG_COLLECTION_PATHS} --- @scheme[current-library-collection-paths]}
@item{@cppi{MZCONFIG_PORT_PRINT_HANDLER} --- @scheme[global-port-print-handler]} @item{@cppdef{MZCONFIG_PORT_PRINT_HANDLER} --- @scheme[global-port-print-handler]}
@item{@cppi{MZCONFIG_LOAD_EXTENSION_HANDLER} --- @scheme[current-load-extension]} @item{@cppdef{MZCONFIG_LOAD_EXTENSION_HANDLER} --- @scheme[current-load-extension]}
} }

29
collects/scribblings/inside/utils.ss
View File

@ -13,11 +13,16 @@
(except-out (all-from-out scribble/manual) var) (except-out (all-from-out scribble/manual) var)
(for-label (all-from-out scheme/base))) (for-label (all-from-out scheme/base)))
(define (as-cpp-defn name s)
(make-target-element #f
(list (as-index s))
`(cpp ,(format "~a" name))))
(define-syntax (function stx) (define-syntax (function stx)
(syntax-case stx () (syntax-case stx ()
[(_ (ret name [type arg] ...) . body) [(_ (ret name [type arg] ...) . body)
#'(*function (cpp/sym 'ret) #'(*function (cpp/sym 'ret)
(as-index (cpp/sym 'name)) (as-cpp-defn 'name (cpp/sym 'name))
(list (type/sym 'type) ...) (list (type/sym 'type) ...)
(list (var/sym 'arg) ...) (list (var/sym 'arg) ...)
(lambda () (lambda ()
@ -125,9 +130,25 @@
(define (var/sym s) (define (var/sym s)
(*var (symbol->string s))) (*var (symbol->string s)))
(define cpp tt) (define cpp
(define cppi tt) (case-lambda
(define cppdef (lambda (x) (as-index (tt x)))) [(x)
(if (string? x)
(let ([e (tt x)])
(make-delayed-element
(lambda (r part ri)
(let ([d (resolve-get/tentative part ri `(cpp ,x))])
(list
(if d
(make-link-element "schemesyntaxlink" (list e) `(cpp ,x))
e))))
(lambda () e)
(lambda () e)))
(tt x))]
[more (apply tt more)]))
(define cppi cpp)
(define cppdef (lambda (x) (as-cpp-defn x (as-index (cpp x)))))
(define *var italic) (define *var italic)
(define mzc (exec "mzc")) (define mzc (exec "mzc"))

10
collects/scribblings/inside/values.scrbl
View File

@ -240,16 +240,16 @@ The following are additional number predicates:
@itemize{ @itemize{
@item{@cppi{SCHEME_NUMBERP} --- all numerical types} @item{@cppdef{SCHEME_NUMBERP} --- all numerical types}
@item{@cppi{SCHEME_REALP} --- all non-complex numerical types, plus @item{@cppdef{SCHEME_REALP} --- all non-complex numerical types, plus
@cpp{scheme_complex_izi_type}} @cpp{scheme_complex_izi_type}}
@item{@cppi{SCHEME_EXACT_INTEGERP} --- fixnums and bignums} @item{@cppdef{SCHEME_EXACT_INTEGERP} --- fixnums and bignums}
@item{@cppi{SCHEME_EXACT_REALP} --- fixnums, bignums, and rationals} @item{@cppdef{SCHEME_EXACT_REALP} --- fixnums, bignums, and rationals}
@item{@cppi{SCHEME_FLOATP} --- both single-precision (when enabled) @item{@cppdef{SCHEME_FLOATP} --- both single-precision (when enabled)
and double-precision flonums} and double-precision flonums}
} }