Annotation of gforth/struct.fs, revision 1.11
1.8 anton 1: \ data structures (like C structs)
2:
1.11 ! anton 3: \ Copyright (C) 1995, 1997 Free Software Foundation, Inc.
1.8 anton 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:
1.1 anton 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:
1.11 ! anton 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 ;
1.1 anton 62:
63: : end-struct ( size align -- )
64: 2constant ;
65:
66: 0 1 chars end-struct struct
67:
1.3 pazsan 68: \ : field ( offset1 align1 size align -- offset2 align2 )
69: \ create-field
70: \ does> ( addr1 -- addr2 )
71: \ @ + ;
1.1 anton 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:
1.5 pazsan 88: : dfloats: ( n -- size align )
89: dfloats 1 dfloats ;
1.2 anton 90:
1.5 pazsan 91: : sfloats: ( n -- size align )
92: sfloats 1 sfloats ;
93:
1.2 anton 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:
1.5 pazsan 102: : struct-allocate ( size align -- addr ior )
1.2 anton 103: drop allocate ;
1.11 ! anton 104:
! 105: : struct-alloc ( size align -- addr )
! 106: struct-allocate throw ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>