]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorSlava Pestov <slava@shill.local>
Thu, 24 Sep 2009 01:23:32 +0000 (20:23 -0500)
committerSlava Pestov <slava@shill.local>
Thu, 24 Sep 2009 01:23:32 +0000 (20:23 -0500)
basis/classes/struct/struct.factor
basis/vm/vm.factor

index 7e993286525d94a7275c207404c1ea17ea6ff6c4..63f2ad282eb4b1c30dca09a00d5401f474c0bf53 100755 (executable)
@@ -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) ]
index ab5a98ab3cadbdcbc2dbc26309e94bef16995f63..3ea501b561a5205ff745a7b661cdbd313b6aa0e6 100644 (file)
@@ -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 ;
\ No newline at end of file
+: vm-field-offset ( field -- offset ) vm offset-of ; inline