[gforth] / gforth / compat / struct.fs  

gforth: gforth/compat/struct.fs


1 : anton 1.1 \ data structures (like C structs)
2 :    
3 :     \ Copyright (C) 1995 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 :     : field ( offset1 align1 size align -- offset2 align2 )
39 :     create
40 :     >r rot r@ nalign dup , ( align1 size offset )
41 :     + swap r> nalign
42 :     does> ( addr1 -- addr2 )
43 :     @ + ;
44 :    
45 :     : end-struct ( size align -- )
46 :     2constant ;
47 :    
48 :     0 1 chars end-struct struct
49 :    
50 :     \ I don't really like the "type:" syntax. Any other ideas? - anton
51 :     \ Also, this seems to be somewhat general. It probably belongs to some
52 :     \ other place
53 :     : cells: ( n -- size align )
54 :     cells 1 cells ;
55 :    
56 :     : doubles: ( n -- size align )
57 :     2* cells 1 cells ;
58 :    
59 :     : chars: ( n -- size align )
60 :     chars 1 chars ;
61 :    
62 :     : floats: ( n -- size align )
63 :     floats 1 floats ;
64 :    
65 :     : dfloats: ( n -- size align )
66 :     dfloats 1 dfloats ;
67 :    
68 :     : sfloats: ( n -- size align )
69 :     sfloats 1 sfloats ;
70 :    
71 :     : struct-align ( size align -- )
72 :     here swap nalign here - allot
73 :     drop ;
74 :    
75 :     : struct-allot ( size align -- addr )
76 :     over swap struct-align
77 :     here swap allot ;
78 :    
79 :     : struct-allocate ( size align -- addr ior )
80 :     drop allocate ;

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help