[gforth] / gforth / struct.fs  

gforth: gforth/struct.fs


1 : anton 1.1 \ $Id: struct.fs,v 1.1 1993/11/11 18:09:58 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 ;

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help