1 ! Copyright (C) 2004, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs generic hashtables kernel kernel.private
4 math namespaces parser sequences strings words libc fry
5 alien.c-types alien.structs.fields cpu.architecture math.order
6 quotations byte-arrays ;
9 TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
11 M: struct-type c-type ;
13 M: struct-type c-type-stack-align? drop f ;
15 : if-value-struct ( ctype true false -- )
16 [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
18 M: struct-type unbox-parameter
19 [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
21 M: struct-type box-parameter
22 [ %box-large-struct ] [ box-parameter ] if-value-struct ;
24 : if-small-struct ( c-type true false -- ? )
25 [ dup return-struct-in-registers? ] 2dip '[ f swap @ ] if ; inline
27 M: struct-type unbox-return
28 [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ;
30 M: struct-type box-return
31 [ %box-small-struct ] [ %box-large-struct ] if-small-struct ;
33 M: struct-type stack-size
34 [ heap-size ] [ stack-size ] if-value-struct ;
36 : c-struct? ( type -- ? ) (c-type) struct-type? ;
38 : (define-struct) ( name size align fields class -- )
39 [ [ align ] keep ] 2dip new
41 byte-array >>boxed-class
47 : make-fields ( name vocab fields -- fields )
48 [ first2 <field-spec> ] with with map ;
50 : compute-struct-align ( types -- n )
51 [ c-type-align ] [ max ] map-reduce ;
53 : define-struct ( name vocab fields -- )
54 [ 2drop ] [ make-fields ] 3bi
55 [ struct-offsets ] keep
56 [ [ type>> ] map compute-struct-align ] keep
57 [ struct-type (define-struct) ] keep
58 [ define-field ] each ; deprecated
60 : define-union ( name members -- )
61 [ [ heap-size ] [ max ] map-reduce ] keep
62 compute-struct-align f struct-type (define-struct) ; deprecated
64 : offset-of ( field struct -- offset )
65 c-types get at fields>>
66 [ name>> = ] with find nip offset>> ;
69 "specialized-arrays" require