From 3e51bde4845d429ed7e462643985f8f7e158e29c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 29 Aug 2009 22:40:13 -0500
Subject: [PATCH] change malloc-struct to initialize struct from initial
 values; add (malloc-struct) and (struct) words that leave their memory
 uninitialized

---
 basis/classes/struct/struct-docs.factor  | 21 ++++++++++++++++++++-
 basis/classes/struct/struct-tests.factor |  2 +-
 basis/classes/struct/struct.factor       | 17 +++++++++++------
 3 files changed, 32 insertions(+), 8 deletions(-)

diff --git a/basis/classes/struct/struct-docs.factor b/basis/classes/struct/struct-docs.factor
index bcc77f1b25..787f03423e 100644
--- a/basis/classes/struct/struct-docs.factor
+++ b/basis/classes/struct/struct-docs.factor
@@ -9,6 +9,15 @@ HELP: <struct-boa>
 }
 { $description "This macro implements " { $link boa } " for " { $link struct } " classes. A struct of the given class is constructed, and its slots are initialized using values off the top of the datastack." } ;
 
+HELP: (struct)
+{ $values
+    { "class" class }
+    { "struct" struct }
+}
+{ $description "Allocates garbage-collected heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are left uninitialized; in most cases, the " { $link <struct> } " word, which initializes the struct's slots with their initial values, should be used instead." } ;
+
+{ (struct) (malloc-struct) } related-words
+
 HELP: <struct>
 { $values
     { "class" class }
@@ -55,7 +64,14 @@ HELP: malloc-struct
     { "class" class }
     { "struct" struct }
 }
-{ $description "Allocates unmanaged C heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are zeroed out. The struct should be " { $link free } "d when it is no longer needed." } ;
+{ $description "Allocates unmanaged C heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are initialized to their initial values. The struct should be " { $link free } "d when it is no longer needed." } ;
+
+HELP: (malloc-struct)
+{ $values
+    { "class" class }
+    { "struct" struct }
+}
+{ $description "Allocates unmanaged C heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are left uninitialized; to initialize the allocated memory with the slots' initial values, use " { $link malloc-struct } ". The struct should be " { $link free } "d when it is no longer needed." } ;
 
 HELP: memory>struct
 { $values
@@ -80,6 +96,9 @@ ARTICLE: "classes.struct" "Struct classes"
 { $subsection <struct-boa> }
 { $subsection malloc-struct }
 { $subsection memory>struct }
+"When the contents of a struct will be immediately reset, faster primitive words are available that will create a struct without initializing its contents:"
+{ $subsection (struct) }
+{ $subsection (malloc-struct) }
 "Structs have literal syntax like tuples:"
 { $subsection POSTPONE: S{ }
 "Union structs are also supported, which behave like structs but share the same memory for all the type's slots."
diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index 2995e9d6d6..52e766a682 100644
--- a/basis/classes/struct/struct-tests.factor
+++ b/basis/classes/struct/struct-tests.factor
@@ -63,7 +63,7 @@ UNION-STRUCT: struct-test-float-and-bits
 [ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
 [ 4 ] [ struct-test-float-and-bits heap-size ] unit-test
 
-[ ] [ [ struct-test-foo malloc-struct &free drop ] with-destructors ] unit-test
+[ 123 ] [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test
 
 STRUCT: struct-test-string-ptr
     { x char* } ;
diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 45ad3c62bb..94eebca081 100644
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -37,6 +37,8 @@ M: struct equal?
         [ [ >c-ptr ] [ [ >c-ptr ] [ byte-length ] bi ] bi* memory= ]
     } 2&& ;
 
+: struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
+
 : memory>struct ( ptr class -- struct )
     [ 1array ] dip slots>tuple ;
 
@@ -44,17 +46,20 @@ M: struct equal?
     dup struct-class? [ '[ _ boa ] ] [ drop f ] if
 ] 1 define-partial-eval
 
+: (init-struct) ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien )
+    '[ dup struct-prototype _ _ ?if ] keep memory>struct ; inline
+
+: (malloc-struct) ( class -- struct )
+    [ heap-size malloc ] keep memory>struct ; inline
+
 : malloc-struct ( class -- struct )
-    [ 1 swap heap-size calloc ] keep memory>struct ; inline
+    [ >c-ptr malloc-byte-array ] [ 1 swap heap-size calloc ] (init-struct) ;
 
 : (struct) ( class -- struct )
-    [ heap-size <byte-array> ] keep memory>struct ; inline
-
-: struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
+    [ heap-size (byte-array) ] keep memory>struct ; inline
 
 : <struct> ( class -- struct )
-    dup struct-prototype
-    [ >c-ptr clone swap memory>struct ] [ (struct) ] if* ; inline
+    [ >c-ptr clone ] [ heap-size <byte-array> ] (init-struct) ;
 
 MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
     [