[gforth] / gforth / struct.fs  

gforth: gforth/struct.fs


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

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help