--- gforth/struct.fs	1994/02/11 16:30:47	1.1
+++ gforth/struct.fs	1997/06/06 17:27:58	1.11
@@ -1,4 +1,23 @@
-\ $Id: struct.fs,v 1.1 1994/02/11 16:30:47 anton Exp $
+\ data structures (like C structs)
+
+\ Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+
+\ This file is part of Gforth.
+
+\ Gforth is free software; you can redistribute it and/or
+\ modify it under the terms of the GNU General Public License
+\ as published by the Free Software Foundation; either version 2
+\ of the License, or (at your option) any later version.
+
+\ This program is distributed in the hope that it will be useful,
+\ but WITHOUT ANY WARRANTY; without even the implied warranty of
+\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+\ GNU General Public License for more details.
+
+\ You should have received a copy of the GNU General Public License
+\ along with this program; if not, write to the Free Software
+\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
 
 \ Usage example:
 \
@@ -12,34 +31,44 @@
 \     1 cells: field enum-method
 \ end-struct ext-wordlist-map \ with the fields search-method,...,enum-method
 
-\ 2, 2constant and nalign should be somewhere else
-: 2, ( w1 w2 -- )
- here 2 cells allot 2! ;
-
-: 2constant ( w1 w2 -- )
-    create 2,
-    does>  ( -- w1 w2 )
-	2@ ;
-
 : nalign ( addr1 n -- addr2 )
 \ addr2 is the aligned version of addr1 wrt the alignment size n
  1- tuck +  swap invert and ;
 
-: create-field ( offset1 align1 size align -- offset2 align2 )
-\ note: this version uses local variables
-     create
-	>r rot r@ nalign  dup ,  ( align1 size offset )
-	+ swap r> nalign ;
+: dozerofield ( -- )
+    \ a field that makes no change
+    \ to enable accessing the offset with "['] <field> >body @" this
+    \ is not implemented with "['] noop alias"
+    last @
+    if
+	immediate
+    then
+does> ( -- )
+    drop ;
+
+: field ( offset1 align1 size align "name" -- offset2 align2 ) \ gforth
+    \G name execution: ( addr1 -- addr2 )
+    >r rot r@ nalign dup
+    if \ field offset <> 0
+	[IFDEF]  (Field)
+	    (Field)
+	[ELSE]
+	    Header reveal dofield: cfa,
+	[THEN]
+    else
+	create dozerofield
+    then ( align1 size offset )
+    dup , + swap r> nalign ;
 
 : end-struct ( size align -- )
  2constant ;
 
 0 1 chars end-struct struct
 
-: field  ( offset1 align1 size align -- offset2 align2 )
-    create-field
-    does> ( addr1 -- addr2 )
-	@ + ;
+\ : field  ( offset1 align1 size align -- offset2 align2 )
+\    create-field
+\    does> ( addr1 -- addr2 )
+\	@ + ;
 
 \ I don't really like the "type:" syntax. Any other ideas? - anton
 \ Also, this seems to be somewhat general. It probably belongs to some
@@ -56,9 +85,22 @@
 : floats: ( n -- size align )
     floats 1 floats ;
 
-\ dfoats and sfloats is not yet defined
-\ : dfloats: ( n -- size align )
-\     dfloats 1 dfloats ;
-\ 
-\ : sfloats: ( n -- size align )
-\     sfloats 1 sfloats ;
\ No newline at end of file
+: dfloats: ( n -- size align )
+    dfloats 1 dfloats ;
+
+: sfloats: ( n -- size align )
+    sfloats 1 sfloats ;
+
+: struct-align ( size align -- )
+    dp @ swap nalign dp !
+    drop ;
+
+: struct-allot ( size align -- addr )
+    over swap struct-align
+    here swap allot ;
+
+: struct-allocate ( size align -- addr ior )
+    drop allocate ;
+
+: struct-alloc ( size align -- addr )
+    struct-allocate throw ;