Annotation of gforth/compat/struct.fs, revision 1.6
1.1 anton 1: \ data structures (like C structs)
2:
1.3 anton 3: \ This file is in the public domain. NO WARRANTY.
1.1 anton 4:
1.3 anton 5: \ This program uses the following words
6: \ from CORE :
7: \ : 1- + swap invert and ; DOES> @ immediate drop Create rot dup , >r
8: \ r> IF ELSE THEN over chars aligned cells 2* here - allot
9: \ from CORE-EXT :
10: \ tuck pick nip
11: \ from BLOCK-EXT :
12: \ \
13: \ from DOUBLE :
14: \ 2Constant
15: \ from EXCEPTION :
16: \ throw
17: \ from FILE :
18: \ (
19: \ from FLOAT :
20: \ faligned floats
21: \ from FLOAT-EXT :
22: \ dfaligned dfloats sfaligned sfloats
23: \ from MEMORY :
24: \ allocate
1.2 anton 25:
1.6 ! anton 26: : naligned ( addr1 n -- addr2 )
! 27: \ addr2 is the aligned version of addr1 wrt the alignment size n
! 28: 1- tuck + swap invert and ;
! 29:
! 30: : nalign naligned ; \ old name, obsolete
1.1 anton 31:
1.2 anton 32: : dofield ( -- )
33: does> ( name execution: addr1 -- addr2 )
34: @ + ;
35:
36: : dozerofield ( -- )
37: immediate
38: does> ( name execution: -- )
39: drop ;
40:
1.3 anton 41: : create-field ( align1 offset1 align size "name" -- align2 offset2 )
1.5 anton 42: create swap rot over nalign dup , ( align1 size align offset )
43: rot + >r nalign r> ;
1.2 anton 44:
1.3 anton 45: : field ( align1 offset1 align size "name" -- align2 offset2 )
1.2 anton 46: \ name execution: addr1 -- addr2
1.3 anton 47: 2 pick >r \ this uglyness is just for optimizing with dozerofield
1.2 anton 48: create-field
1.3 anton 49: r> if \ offset<>0
1.2 anton 50: dofield
51: else
52: dozerofield
53: then ;
1.1 anton 54:
1.3 anton 55: : end-struct ( align size "name" -- )
56: over nalign \ pad size to full alignment
1.2 anton 57: 2constant ;
1.1 anton 58:
1.3 anton 59: \ an empty struct
60: 1 chars 0 end-struct struct
1.1 anton 61:
1.3 anton 62: \ type descriptors, all ( -- align size )
63: 1 aligned 1 cells 2constant cell%
64: 1 chars 1 chars 2constant char%
65: 1 faligned 1 floats 2constant float%
66: 1 dfaligned 1 dfloats 2constant dfloat%
67: 1 sfaligned 1 sfloats 2constant sfloat%
68: cell% 2* 2constant double%
69:
70: \ memory allocation words
1.4 anton 71: : %alignment ( align size -- align )
72: drop ;
73:
74: : %size ( align size -- size )
75: nip ;
76:
1.3 anton 77: : %align ( align size -- )
78: drop here swap nalign here - allot ;
1.1 anton 79:
1.3 anton 80: : %allot ( align size -- addr )
81: tuck %align
1.1 anton 82: here swap allot ;
83:
1.3 anton 84: : %allocate ( align size -- addr ior )
85: nip allocate ;
1.2 anton 86:
1.3 anton 87: : %alloc ( size align -- addr )
88: %allocate throw ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>