72 lines
2.1 KiB
Factor
72 lines
2.1 KiB
Factor
! Copyright (C) 2004, 2006 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
IN: alien
|
|
USING: generator errors generic hashtables kernel
|
|
kernel-internals math namespaces parser sequences strings words
|
|
;
|
|
|
|
! Some code for interfacing with C structures.
|
|
|
|
: define-getter ( offset type name -- )
|
|
#! Define a word with stack effect ( alien -- obj ) in the
|
|
#! current 'in' vocabulary.
|
|
create-in >r c-getter swap add* r> swap define-compound ;
|
|
|
|
: define-setter ( offset type name -- )
|
|
#! Define a word with stack effect ( obj alien -- ) in the
|
|
#! current 'in' vocabulary.
|
|
"set-" swap append create-in >r c-setter swap add* r>
|
|
swap define-compound ;
|
|
|
|
: parse-c-decl ( string -- count name )
|
|
"[]" split "" swap remove unclip
|
|
>r
|
|
dup empty? [ drop 1 ] [ [ string>number ] map product ] if
|
|
r> over 1 > [ "[]" append ] when ;
|
|
|
|
: define-field ( offset type name -- offset )
|
|
>r parse-c-decl [ c-type c-type-align ] keep
|
|
>r swapd align r> r>
|
|
"struct-name" get swap "-" swap 3append
|
|
3dup define-getter 3dup define-setter
|
|
drop heap-size rot * + ;
|
|
|
|
: define-member ( max type -- max )
|
|
heap-size max ;
|
|
|
|
TUPLE: struct-type ;
|
|
|
|
: if-value-structs? ( ctype true false -- )
|
|
value-structs?
|
|
[ drop call ] [ >r 2drop "void*" r> call ] if ; inline
|
|
|
|
M: struct-type unbox-parameter
|
|
[ c-type-size %unbox-struct ]
|
|
[ unbox-parameter ]
|
|
if-value-structs? ;
|
|
|
|
M: struct-type unbox-return f swap c-type-size %unbox-struct ;
|
|
|
|
M: struct-type box-parameter
|
|
[ c-type-size %box-struct ]
|
|
[ box-parameter ]
|
|
if-value-structs? ;
|
|
|
|
M: struct-type box-return f swap c-type-size %box-struct ;
|
|
|
|
M: struct-type stack-size
|
|
[ c-type-size ] [ stack-size ] if-value-structs? ;
|
|
|
|
C: struct-type ( width -- type )
|
|
<c-type> over set-delegate
|
|
bootstrap-cell over set-c-type-align
|
|
[ swap <displaced-alien> ] over set-c-type-getter
|
|
[ set-c-type-size ] keep ;
|
|
|
|
: define-struct-type ( width -- )
|
|
#! Define inline and pointer type for the struct. Pointer
|
|
#! type is exactly like void*.
|
|
<struct-type> "struct-name" get in get define-c-type ;
|
|
|
|
: c-struct? ( type -- ? ) c-types get hash struct-type? ;
|