Return to struct.fs CVS log

Up to [gforth] / gforth

Environmental query "gforth" now returns the version-string
dictionary-end and unused moved into the kernel/basics.fs
Minor gforth.el bug fixes
Major rewrite of objects.fs (not yet done)
fixed -trailing bug (with test in test/other.fs)
optimization of fields with offset 0 in struct.fs and compat/struct.fs
other changes in compat/struct.fs (not yet done)
added ansreports to compat/*.fs
documentation changes
allot now checks for dict overflow
named [IS] (compilation semantics of IS).
minor changes

    1: \ data structures (like C structs)
    2: 
    3: \ Copyright (C) 1995, 1997 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation; either version 2
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program; if not, write to the Free Software
   19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   20: 
   21: 
   22: \ Usage example:
   23: \
   24: \ struct
   25: \     1 cells: field search-method
   26: \     1 cells: field reveal-method
   27: \ end-struct wordlist-map
   28: \
   29: \ The structure can then be extended in the following way
   30: \ wordlist-map
   31: \     1 cells: field enum-method
   32: \ end-struct ext-wordlist-map \ with the fields search-method,...,enum-method
   33: 
   34: : nalign ( addr1 n -- addr2 )
   35: \ addr2 is the aligned version of addr1 wrt the alignment size n
   36:  1- tuck +  swap invert and ;
   37: 
   38: : dozerofield ( -- )
   39:     \ a field that makes no change
   40:     \ to enable accessing the offset with "['] <field> >body @" this
   41:     \ is not implemented with "['] noop alias"
   42:     last @
   43:     if
   44: 	immediate
   45:     then
   46: does> ( -- )
   47:     drop ;
   48: 
   49: : field ( offset1 align1 size align "name" -- offset2 align2 ) \ gforth
   50:     \G name execution: ( addr1 -- addr2 )
   51:     >r rot r@ nalign dup
   52:     if \ field offset <> 0
   53: 	[IFDEF]  (Field)
   54: 	    (Field)
   55: 	[ELSE]
   56: 	    Header reveal dofield: cfa,
   57: 	[THEN]
   58:     else
   59: 	create dozerofield
   60:     then ( align1 size offset )
   61:     dup , + swap r> nalign ;
   62: 
   63: : end-struct ( size align -- )
   64:  2constant ;
   65: 
   66: 0 1 chars end-struct struct
   67: 
   68: \ : field  ( offset1 align1 size align -- offset2 align2 )
   69: \    create-field
   70: \    does> ( addr1 -- addr2 )
   71: \	@ + ;
   72: 
   73: \ I don't really like the "type:" syntax. Any other ideas? - anton
   74: \ Also, this seems to be somewhat general. It probably belongs to some
   75: \ other place
   76: : cells: ( n -- size align )
   77:     cells cell ;
   78: 
   79: : doubles: ( n -- size align )
   80:     2* cells cell ;
   81: 
   82: : chars: ( n -- size align )
   83:     chars 1 chars ;
   84: 
   85: : floats: ( n -- size align )
   86:     floats 1 floats ;
   87: 
   88: : dfloats: ( n -- size align )
   89:     dfloats 1 dfloats ;
   90: 
   91: : sfloats: ( n -- size align )
   92:     sfloats 1 sfloats ;
   93: 
   94: : struct-align ( size align -- )
   95:     dp @ swap nalign dp !
   96:     drop ;
   97: 
   98: : struct-allot ( size align -- addr )
   99:     over swap struct-align
  100:     here swap allot ;
  101: 
  102: : struct-allocate ( size align -- addr ior )
  103:     drop allocate ;
  104: 
  105: : struct-alloc ( size align -- addr )
  106:     struct-allocate throw ;