64 lines
2.0 KiB
Factor
64 lines
2.0 KiB
Factor
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
||
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
||
|
|
IN: alien
|
||
|
|
USING: assembler compiler errors hashtables kernel lists math
|
||
|
|
namespaces parser 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
|
||
|
|
[ "getter" get ] bind cons r> swap define-compound ;
|
||
|
|
|
||
|
|
: define-setter ( offset type name -- )
|
||
|
|
#! Define a word with stack effect ( obj alien -- ) in the
|
||
|
|
#! current 'in' vocabulary.
|
||
|
|
"set-" swap cat2 create-in >r
|
||
|
|
[ "setter" get ] bind cons r> swap define-compound ;
|
||
|
|
|
||
|
|
: define-field ( offset type name -- offset )
|
||
|
|
>r c-type dup >r [ "align" get ] bind align r> r>
|
||
|
|
"struct-name" get swap "-" swap cat3
|
||
|
|
( offset type name -- )
|
||
|
|
3dup define-getter 3dup define-setter
|
||
|
|
drop [ "width" get ] bind + ;
|
||
|
|
|
||
|
|
: define-member ( max type -- max )
|
||
|
|
c-type [ "width" get ] bind max ;
|
||
|
|
|
||
|
|
: define-constructor ( width -- )
|
||
|
|
#! Make a word <foo> where foo is the structure name that
|
||
|
|
#! allocates a Factor heap-local instance of this structure.
|
||
|
|
#! Used for C functions that expect you to pass in a struct.
|
||
|
|
[ <byte-array> ] cons
|
||
|
|
[ "<" , "struct-name" get , ">" , ] make-string
|
||
|
|
create-in swap
|
||
|
|
define-compound ;
|
||
|
|
|
||
|
|
: define-struct-type ( width -- )
|
||
|
|
#! Define inline and pointer type for the struct. Pointer
|
||
|
|
#! type is exactly like void*.
|
||
|
|
[ "width" set ] "struct-name" get define-c-type
|
||
|
|
"void*" c-type "struct-name" get "*" cat2
|
||
|
|
c-types get set-hash ;
|
||
|
|
|
||
|
|
: BEGIN-STRUCT: ( -- offset )
|
||
|
|
scan "struct-name" set 0 ; parsing
|
||
|
|
|
||
|
|
: FIELD: ( offset -- offset )
|
||
|
|
scan scan define-field ; parsing
|
||
|
|
|
||
|
|
: END-STRUCT ( length -- )
|
||
|
|
dup define-constructor define-struct-type ; parsing
|
||
|
|
|
||
|
|
: BEGIN-UNION: ( -- max )
|
||
|
|
scan "struct-name" set 0 ; parsing
|
||
|
|
|
||
|
|
: MEMBER: ( max -- max )
|
||
|
|
scan define-member ; parsing
|
||
|
|
|
||
|
|
: END-UNION ( max -- )
|
||
|
|
dup define-constructor define-struct-type ; parsing
|