[ <struct> ] [ struct-slots ] bi
[ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ;
+M: struct-class initial-value* <struct> ; inline
+
! Struct slot accessors
GENERIC: struct-slot-values ( struct -- sequence )
M: struct-class writer-quot
nip (writer-quot) ;
+: offset-of ( field struct -- offset )
+ struct-slots slot-named offset>> ; inline
+
! c-types
TUPLE: struct-c-type < abstract-c-type
! class definition
<PRIVATE
+GENERIC: binary-zero? ( value -- ? )
+
+M: object binary-zero? drop f ;
+M: f binary-zero? drop t ;
+M: number binary-zero? zero? ;
+M: struct binary-zero?
+ [ byte-length iota ] [ >c-ptr ] bi
+ [ <displaced-alien> *uchar zero? ] curry all? ;
+
+: struct-needs-prototype? ( class -- ? )
+ struct-slots [ initial>> binary-zero? ] all? not ;
+
: make-struct-prototype ( class -- prototype )
- [ "struct-size" word-prop <byte-array> ]
- [ memory>struct ]
- [ struct-slots ] tri
- [
- [ initial>> ]
- [ (writer-quot) ] bi
- over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
- ] each ;
+ dup struct-needs-prototype? [
+ [ "struct-size" word-prop <byte-array> ]
+ [ memory>struct ]
+ [ struct-slots ] tri
+ [
+ [ initial>> ]
+ [ (writer-quot) ] bi
+ over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
+ ] each
+ ] [ drop f ] if ;
: (struct-methods) ( class -- )
[ (define-struct-slot-values-method) ]
! Copyright (C) 2009 Phil Dawes.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.structs alien.syntax ;
+USING: classes.struct alien.syntax ;
IN: vm
TYPEDEF: void* cell
-C-STRUCT: zone
- { "cell" "start" }
- { "cell" "here" }
- { "cell" "size" }
- { "cell" "end" }
- ;
+STRUCT: zone
+ { start cell }
+ { here cell }
+ { size cell }
+ { end cell } ;
-C-STRUCT: vm
- { "context*" "stack_chain" }
- { "zone" "nursery" }
- { "cell" "cards_offset" }
- { "cell" "decks_offset" }
- { "cell[70]" "userenv" }
- ;
+STRUCT: vm
+ { stack_chain context* }
+ { nursery zone }
+ { cards_offset cell }
+ { decks_offset cell }
+ { userenv cell[70] } ;
-: vm-field-offset ( field -- offset ) "vm" offset-of ;
\ No newline at end of file
+: vm-field-offset ( field -- offset ) vm offset-of ; inline