core/compiler/alien/structs.factor

   1 ! Copyright (C) 2004, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: alien
   4 USING: assembler compiler errors generic
   5 hashtables kernel kernel-internals math namespaces parser
   6 sequences strings words ;
   7
   8 ! Some code for interfacing with C structures.
   9
  10 : c-getter* ( name -- quot )
  11     c-getter [
  12         [ "Cannot read struct fields with type" throw ]
  13     ] unless* ;
  14
  15 : define-getter ( offset type name -- )
  16     #! Define a word with stack effect ( alien -- obj ) in the
  17     #! current 'in' vocabulary.
  18     create-in >r c-getter* swap add* r> swap define-compound ;
  19
  20 : c-setter* ( name -- quot )
  21     c-setter [
  22         [ "Cannot write struct fields with type" throw ]
  23     ] unless* ;
  24
  25 : define-setter ( offset type name -- )
  26     #! Define a word with stack effect ( obj alien -- ) in the
  27     #! current 'in' vocabulary.
  28     "set-" swap append create-in >r c-setter* swap add* r>
  29     swap define-compound ;
  30
  31 : parse-c-decl ( string -- count name )
  32     "[]" split "" swap remove unclip
  33     >r
  34     dup empty? [ drop 1 ] [ [ string>number ] map product ] if
  35     r> over 1 > [ "[]" append ] when ;
  36
  37 : define-field ( offset type name -- offset )
  38     >r parse-c-decl [ c-type c-type-align ] keep
  39     >r swapd align r> r>
  40     "struct-name" get swap "-" swap 3append
  41     3dup define-getter 3dup define-setter
  42     drop c-size rot * + ;
  43
  44 : define-member ( max type -- max )
  45     c-size max ;
  46
  47 TUPLE: struct-type ;
  48
  49 M: struct-type c-type-unbox c-type-size %unbox-struct ;
  50
  51 M: struct-type c-type-box c-type-size %box-struct ;
  52
  53 C: struct-type ( width -- type )
  54     <c-type> over set-delegate
  55     bootstrap-cell over set-c-type-align
  56     [ swap <displaced-alien> ] over set-c-type-getter
  57     [ set-c-type-size ] keep ;
  58
  59 : define-struct-type ( width -- )
  60     #! Define inline and pointer type for the struct. Pointer
  61     #! type is exactly like void*.
  62     <struct-type> "struct-name" get in get define-c-type ;
  63
  64 : c-struct? ( type -- ? ) c-types get hash struct-type? ;