--- gforth/compat/struct.fs	1996/11/11 17:00:07	1.1
+++ gforth/compat/struct.fs	1997/06/06 17:28:13	1.2
@@ -31,19 +31,46 @@
 \     1 cells: field enum-method
 \ end-struct ext-wordlist-map \ with the fields search-method,...,enum-method
 
+\ This is an ANS Forth program with an environmental dependency on
+\ alignments that are powers of 2 (rewrite nalign for other systems)
+\ and with an environmental dependence on case insensitivity (convert
+\ everything to upper case for state sensitive systems).
+
+\ The program uses the following words
+\ !!
+
 : nalign ( addr1 n -- addr2 )
 \ addr2 is the aligned version of addr1 wrt the alignment size n
  1- tuck +  swap invert and ;
 
-: field ( offset1 align1 size align -- offset2 align2 )
-    create
-    >r rot r@ nalign  dup ,  ( align1 size offset )
-    + swap r> nalign
-does> ( addr1 -- addr2 )
+: dofield ( -- )
+does> ( name execution: addr1 -- addr2 )
     @ + ;
 
+: dozerofield ( -- )
+    immediate
+does> ( name execution: -- )
+    drop ;
+
+: create-field ( offset1 align1 size align "name" -- offset2 align2 )
+    create
+    >r rot r@ nalign  dup ,  ( align1 size offset  R: align )
+    + swap r> nalign ;
+
+: field ( offset1 align1 size align "name" -- offset2 align2 )
+    \ name execution: addr1 -- addr2
+    3 pick >r \ this uglyness is just for optimizing with dozerofield
+    create-field
+    r>
+    dup if
+	dofield
+    else
+	dozerofield
+    then ;
+
 : end-struct ( size align -- )
- 2constant ;
+    tuck nalign swap \ pad size to full alignment
+    2constant ;
 
 0 1 chars end-struct struct
 
@@ -51,22 +78,22 @@ does> ( addr1 -- addr2 )
 \ Also, this seems to be somewhat general. It probably belongs to some
 \ other place
 : cells: ( n -- size align )
-    cells 1 cells ;
+    cells 1 aligned ;
 
 : doubles: ( n -- size align )
-    2* cells 1 cells ;
+    2* cells 1 aligned ;
 
 : chars: ( n -- size align )
     chars 1 chars ;
 
 : floats: ( n -- size align )
-    floats 1 floats ;
+    floats 1 faligned ;
 
 : dfloats: ( n -- size align )
-    dfloats 1 dfloats ;
+    dfloats 1 dfaligned ;
 
 : sfloats: ( n -- size align )
-    sfloats 1 sfloats ;
+    sfloats 1 sfaligned ;
 
 : struct-align ( size align -- )
     here swap nalign here - allot
@@ -78,3 +105,6 @@ does> ( addr1 -- addr2 )
 
 : struct-allocate ( size align -- addr ior )
     drop allocate ;
+
+: struct-alloc ( size align -- addr )
+    struct-allocate throw ;