File:  [gforth] / gforth / struct.fs
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Fri Feb 11 16:30:48 1994 UTC (27 years, 9 months ago) by anton
Branches: no-vendor
CVS tags: alpha
The GNU Forth Project

    1: \ $Id: struct.fs,v 1.1.1.1 1994/02/11 16:30:48 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: \ 2, 2constant and nalign should be somewhere else
   16: : 2, ( w1 w2 -- )
   17:  here 2 cells allot 2! ;
   18: 
   19: : 2constant ( w1 w2 -- )
   20:     create 2,
   21:     does>  ( -- w1 w2 )
   22: 	2@ ;
   23: 
   24: : nalign ( addr1 n -- addr2 )
   25: \ addr2 is the aligned version of addr1 wrt the alignment size n
   26:  1- tuck +  swap invert and ;
   27: 
   28: : create-field ( offset1 align1 size align -- offset2 align2 )
   29: \ note: this version uses local variables
   30:      create
   31: 	>r rot r@ nalign  dup ,  ( align1 size offset )
   32: 	+ swap r> nalign ;
   33: 
   34: : end-struct ( size align -- )
   35:  2constant ;
   36: 
   37: 0 1 chars end-struct struct
   38: 
   39: : field  ( offset1 align1 size align -- offset2 align2 )
   40:     create-field
   41:     does> ( addr1 -- addr2 )
   42: 	@ + ;
   43: 
   44: \ I don't really like the "type:" syntax. Any other ideas? - anton
   45: \ Also, this seems to be somewhat general. It probably belongs to some
   46: \ other place
   47: : cells: ( n -- size align )
   48:     cells cell ;
   49: 
   50: : doubles: ( n -- size align )
   51:     2* cells cell ;
   52: 
   53: : chars: ( n -- size align )
   54:     chars 1 chars ;
   55: 
   56: : floats: ( n -- size align )
   57:     floats 1 floats ;
   58: 
   59: \ dfoats and sfloats is not yet defined
   60: \ : dfloats: ( n -- size align )
   61: \     dfloats 1 dfloats ;
   62: \ 
   63: \ : sfloats: ( n -- size align )
   64: \     sfloats 1 sfloats ;

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