--- gforth/struct.fs 1997/06/06 17:27:58 1.11 +++ gforth/struct.fs 1997/07/31 16:17:11 1.12 @@ -18,21 +18,9 @@ \ along with this program; if not, write to the Free Software \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -\ Usage example: -\ -\ struct -\ 1 cells: field search-method -\ 1 cells: field reveal-method -\ end-struct wordlist-map -\ -\ The structure can then be extended in the following way -\ wordlist-map -\ 1 cells: field enum-method -\ end-struct ext-wordlist-map \ with the fields search-method,...,enum-method - -: nalign ( addr1 n -- addr2 ) -\ addr2 is the aligned version of addr1 wrt the alignment size n +: nalign ( addr1 n -- addr2 ) \ gforth +\g @code{addr2} is the aligned version of @code{addr1} wrt the +\g alignment @code{n}. 1- tuck + swap invert and ; : dozerofield ( -- ) @@ -43,12 +31,19 @@ if immediate then -does> ( -- ) +does> ( name execution: -- ) drop ; -: field ( offset1 align1 size align "name" -- offset2 align2 ) \ gforth +: field, ( align1 offset1 align size -- align2 offset2 ) + rot dup , ( align1 align size offset1 ) + + >r nalign r> ; + +: create-field ( align1 offset1 align size -- align2 offset2 ) + create field, ; + +: field ( align1 offset1 align size "name" -- align2 offset2 ) \ gforth \G name execution: ( addr1 -- addr2 ) - >r rot r@ nalign dup + 2 pick if \ field offset <> 0 [IFDEF] (Field) (Field) @@ -57,50 +52,52 @@ does> ( -- ) [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 ) -\ @ + ; - -\ I don't really like the "type:" syntax. Any other ideas? - anton -\ Also, this seems to be somewhat general. It probably belongs to some -\ other place -: cells: ( n -- size align ) - cells cell ; - -: doubles: ( n -- size align ) - 2* cells cell ; - -: chars: ( n -- size align ) - chars 1 chars ; - -: floats: ( n -- size align ) - floats 1 floats ; - -: dfloats: ( n -- size align ) - dfloats 1 dfloats ; - -: sfloats: ( n -- size align ) - sfloats 1 sfloats ; - -: struct-align ( size align -- ) - dp @ swap nalign dp ! - drop ; + then + field, ; -: struct-allot ( size align -- addr ) - over swap struct-align +: end-struct ( align size "name" -- ) \ gforth +\g @code{name} execution: @code{addr1 -- addr1+offset1}@* +\g create a field @code{name} with offset @code{offset1}, and the type +\g given by @code{size align}. @code{offset2} is the offset of the +\g next field, and @code{align2} is the alignment of all fields. + over nalign \ pad size to full alignment + 2constant ; + +1 chars 0 end-struct struct ( -- align size ) \ gforth +\g an empty structure, used to start a structure definition. + +\ type descriptors +1 aligned 1 cells 2constant cell% ( -- align size ) \ gforth +1 chars 1 chars 2constant char% ( -- align size ) \ gforth +1 faligned 1 floats 2constant float% ( -- align size ) \ gforth +1 dfaligned 1 dfloats 2constant dfloat% ( -- align size ) \ gforth +1 sfaligned 1 sfloats 2constant sfloat% ( -- align size ) \ gforth +cell% 2* 2constant double% ( -- align size ) \ gforth + +\ memory allocation words +' drop alias %alignment ( align size -- align ) \ gforth +\g the alignment of the structure +' nip alias %size ( align size -- size ) \ gforth +\g the size of the structure + +: %align ( align size -- ) \ gforth + \G align the data space pointer to the alignment @code{align}. + drop here swap nalign here - allot ; + +: %allot ( align size -- addr ) \ gforth + \g allot @code{size} address units of data space with alignment + \g @code{align}; the resulting block of data is found at + \g @code{addr}. + tuck %align here swap allot ; -: struct-allocate ( size align -- addr ior ) - drop allocate ; - -: struct-alloc ( size align -- addr ) - struct-allocate throw ; +: %allocate ( align size -- addr ior ) \ gforth + \g allocate @code{size} address units with alignment @code{align}, + \g similar to @code{allocate}. + nip allocate ; + +: %alloc ( size align -- addr ) \ gforth + \g allocate @code{size} address units with alignment @code{align}, + \g giving a data block at @code{addr}; @code{throw}s an ior code + \g if not successful. + %allocate throw ;