Merge branch 'master' of git://factorcode.org/git/factor
commit
735a093152
|
@ -103,6 +103,8 @@ M: struct-class boa>object
|
|||
[ <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 )
|
||||
|
@ -113,6 +115,9 @@ M: struct-class reader-quot
|
|||
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
|
||||
|
@ -202,15 +207,29 @@ M: struct byte-length class "struct-size" word-prop ; foldable
|
|||
! 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) ]
|
||||
|
|
|
@ -1,23 +1,21 @@
|
|||
! 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 ;
|
||||
: vm-field-offset ( field -- offset ) vm offset-of ; inline
|
||||
|
|
Loading…
Reference in New Issue