steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-09-23 20:23:32 -05:00
parent dfc9fd071e 0845ffaf39
commit 735a093152
2 changed files with 40 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
basis/classes/struct/struct.factor
View File

@ -103,6 +103,8 @@ M: struct-class boa>object
[ <struct> ] [ struct-slots ] bi [ <struct> ] [ struct-slots ] bi
[ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ; [ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ;
M: struct-class initial-value* <struct> ; inline
! Struct slot accessors ! Struct slot accessors
GENERIC: struct-slot-values ( struct -- sequence ) GENERIC: struct-slot-values ( struct -- sequence )
@ -113,6 +115,9 @@ M: struct-class reader-quot
M: struct-class writer-quot M: struct-class writer-quot
nip (writer-quot) ; nip (writer-quot) ;
: offset-of ( field struct -- offset )
struct-slots slot-named offset>> ; inline
! c-types ! c-types
TUPLE: struct-c-type < abstract-c-type TUPLE: struct-c-type < abstract-c-type
@ -202,7 +207,20 @@ M: struct byte-length class "struct-size" word-prop ; foldable
! class definition ! class definition
<PRIVATE <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 ) : make-struct-prototype ( class -- prototype )
dup struct-needs-prototype? [
[ "struct-size" word-prop <byte-array> ] [ "struct-size" word-prop <byte-array> ]
[ memory>struct ] [ memory>struct ]
[ struct-slots ] tri [ struct-slots ] tri
@ -210,7 +228,8 @@ M: struct byte-length class "struct-size" word-prop ; foldable
[ initial>> ] [ initial>> ]
[ (writer-quot) ] bi [ (writer-quot) ] bi
over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
] each ; ] each
] [ drop f ] if ;
: (struct-methods) ( class -- ) : (struct-methods) ( class -- )
[ (define-struct-slot-values-method) ] [ (define-struct-slot-values-method) ]

28
basis/vm/vm.factor
View File

@ -1,23 +1,21 @@
! Copyright (C) 2009 Phil Dawes. ! Copyright (C) 2009 Phil Dawes.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.structs alien.syntax ; USING: classes.struct alien.syntax ;
IN: vm IN: vm
TYPEDEF: void* cell TYPEDEF: void* cell
C-STRUCT: zone STRUCT: zone
{ "cell" "start" } { start cell }
{ "cell" "here" } { here cell }
{ "cell" "size" } { size cell }
{ "cell" "end" } { end cell } ;
;
C-STRUCT: vm STRUCT: vm
{ "context*" "stack_chain" } { stack_chain context* }
{ "zone" "nursery" } { nursery zone }
{ "cell" "cards_offset" } { cards_offset cell }
{ "cell" "decks_offset" } { decks_offset cell }
{ "cell[70]" "userenv" } { userenv cell[70] } ;
;
: vm-field-offset ( field -- offset ) "vm" offset-of ; : vm-field-offset ( field -- offset ) vm offset-of ; inline