[BACK]Return to struct.fs CVS log [TXT] [DIR] Up to [gforth] / gforth / compat

Diff for /gforth/compat/struct.fs between versions 1.1 and 1.2

version 1.1, 1996/11/11 17:00:07 version 1.2, 1997/06/06 17:28:13
Line 31 Line 31
 \     1 cells: field enum-method  \     1 cells: field enum-method
 \ end-struct ext-wordlist-map \ with the fields search-method,...,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 )  : nalign ( addr1 n -- addr2 )
 \ addr2 is the aligned version of addr1 wrt the alignment size n  \ addr2 is the aligned version of addr1 wrt the alignment size n
  1- tuck +  swap invert and ;   1- tuck +  swap invert and ;
   
 : field ( offset1 align1 size align -- offset2 align2 )  : dofield ( -- )
     create  does> ( name execution: addr1 -- addr2 )
     >r rot r@ nalign  dup ,  ( align1 size offset )  
     + swap r> nalign  
 does> ( 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 -- )  : end-struct ( size align -- )
  2constant ;      tuck nalign swap \ pad size to full alignment
       2constant ;
   
 0 1 chars end-struct struct  0 1 chars end-struct struct
   
Line 51  does> ( addr1 -- addr2 ) Line 78  does> ( addr1 -- addr2 )
 \ Also, this seems to be somewhat general. It probably belongs to some  \ Also, this seems to be somewhat general. It probably belongs to some
 \ other place  \ other place
 : cells: ( n -- size align )  : cells: ( n -- size align )
     cells 1 cells ;      cells 1 aligned ;
   
 : doubles: ( n -- size align )  : doubles: ( n -- size align )
     2* cells 1 cells ;      2* cells 1 aligned ;
   
 : chars: ( n -- size align )  : chars: ( n -- size align )
     chars 1 chars ;      chars 1 chars ;
   
 : floats: ( n -- size align )  : floats: ( n -- size align )
     floats 1 floats ;      floats 1 faligned ;
   
 : dfloats: ( n -- size align )  : dfloats: ( n -- size align )
     dfloats 1 dfloats ;      dfloats 1 dfaligned ;
   
 : sfloats: ( n -- size align )  : sfloats: ( n -- size align )
     sfloats 1 sfloats ;      sfloats 1 sfaligned ;
   
 : struct-align ( size align -- )  : struct-align ( size align -- )
     here swap nalign here - allot      here swap nalign here - allot
Line 78  does> ( addr1 -- addr2 ) Line 105  does> ( addr1 -- addr2 )
   
 : struct-allocate ( size align -- addr ior )  : struct-allocate ( size align -- addr ior )
     drop allocate ;      drop allocate ;
   
   : struct-alloc ( size align -- addr )
       struct-allocate throw ;
Removed from v.1.1  
changed lines
  Added in v.1.2

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>