File:  [gforth] / gforth / struct.fs
Revision 1.7: download - view: text, annotated - select for diffs
Sat Oct 7 17:38:20 1995 UTC (25 years, 7 months ago) by anton
Branches: MAIN
CVS tags: HEAD
added code.fs (code, ;code, end-code, assembler)
renamed dostruc to dofield
made index and doc-entries nicer
Only words containing 'e' or 'E' are converted to FP numbers.
added many wordset comments
added flush-icache primitive and FLUSH_ICACHE macro
added +DO, U+DO, -DO, U-DO and -LOOP
added code address labels (`docol:' etc.)
fixed sparc cache_flush

    1: \ $Id: struct.fs,v 1.7 1995/10/07 17:38:20 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: : field ( offset1 align1 size align -- offset2 align2 )
   20: \ note: this version uses local variables
   21:      Header reveal dofield: cfa,
   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: : dfloats: ( n -- size align )
   51:     dfloats 1 dfloats ;
   52: 
   53: : sfloats: ( n -- size align )
   54:     sfloats 1 sfloats ;
   55: 
   56: : struct-align ( size align -- )
   57:     dp @ swap nalign dp !
   58:     drop ;
   59: 
   60: : struct-allot ( size align -- addr )
   61:     over swap struct-align
   62:     here swap allot ;
   63: 
   64: : struct-allocate ( size align -- addr ior )
   65:     drop allocate ;

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