Return to struct.fs CVS log

Up to [gforth] / gforth

Minor changes: adapted locals to the changed wordlists, some deletions
and additions to struct.fs and gforth.el

    1: \ $Id: struct.fs,v 1.2 1994/07/29 11:16:26 anton Exp $
    2: 
    3: \ Usage example:
    4: \
    5: \ struct
    6: \     1 cells: field search-method
    7: \     1 cells: field reveal-method
    8: \ end-struct wordlist-map
    9: \
   10: \ The structure can then be extended in the following way
   11: \ wordlist-map
   12: \     1 cells: field enum-method
   13: \ end-struct ext-wordlist-map \ with the fields search-method,...,enum-method
   14: 
   15: : nalign ( addr1 n -- addr2 )
   16: \ addr2 is the aligned version of addr1 wrt the alignment size n
   17:  1- tuck +  swap invert and ;
   18: 
   19: : create-field ( offset1 align1 size align -- offset2 align2 )
   20: \ note: this version uses local variables
   21:      create
   22: 	>r rot r@ nalign  dup ,  ( align1 size offset )
   23: 	+ swap r> nalign ;
   24: 
   25: : end-struct ( size align -- )
   26:  2constant ;
   27: 
   28: 0 1 chars end-struct struct
   29: 
   30: : field  ( offset1 align1 size align -- offset2 align2 )
   31:     create-field
   32:     does> ( addr1 -- addr2 )
   33: 	@ + ;
   34: 
   35: \ I don't really like the "type:" syntax. Any other ideas? - anton
   36: \ Also, this seems to be somewhat general. It probably belongs to some
   37: \ other place
   38: : cells: ( n -- size align )
   39:     cells cell ;
   40: 
   41: : doubles: ( n -- size align )
   42:     2* cells cell ;
   43: 
   44: : chars: ( n -- size align )
   45:     chars 1 chars ;
   46: 
   47: : floats: ( n -- size align )
   48:     floats 1 floats ;
   49: 
   50: \ dfoats and sfloats is not yet defined
   51: \ : dfloats: ( n -- size align )
   52: \     dfloats 1 dfloats ;
   53: \ 
   54: \ : sfloats: ( n -- size align )
   55: \     sfloats 1 sfloats ;
   56: 
   57: : struct-align ( size align -- )
   58:     dp @ swap nalign dp !
   59:     drop ;
   60: 
   61: : struct-allot ( size align -- addr )
   62:     over swap struct-align
   63:     here swap allot ;
   64: 
   65: : struct-allocate ( size align -- addr )
   66:     drop allocate ;