File:  [gforth] / gforth / struct.fs
Revision 1.5: download - view: text, annotated - select for diffs
Tue Aug 29 21:07:39 1995 UTC (25 years, 8 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD
Added multibuffering in blocks and a simple block editor
(in a block file, load with include blockedit.fb after loading
blocks.fs).
Made DOS port work (you must change .gforth-history to
gforth-history by hand still!)

    1: \ $Id: struct.fs,v 1.5 1995/08/29 21:07:39 pazsan 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 -7 ( [ :dostruc ] Literal ) 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>