Annotation of gforth/compat/struct.fs, revision 1.4
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.1 anton 26: : nalign ( addr1 n -- addr2 )
27: \ addr2 is the aligned version of addr1 wrt the alignment size n
28: 1- tuck + swap invert and ;
29:
1.2 anton 30: : dofield ( -- )
31: does> ( name execution: addr1 -- addr2 )
32: @ + ;
33:
34: : dozerofield ( -- )
35: immediate
36: does> ( name execution: -- )
37: drop ;
38:
1.3 anton 39: : create-field ( align1 offset1 align size "name" -- align2 offset2 )
40: create rot dup , ( align1 align size offset1 )
41: + >r nalign r> ;
1.2 anton 42:
1.3 anton 43: : field ( align1 offset1 align size "name" -- align2 offset2 )
1.2 anton 44: \ name execution: addr1 -- addr2
1.3 anton 45: 2 pick >r \ this uglyness is just for optimizing with dozerofield
1.2 anton 46: create-field
1.3 anton 47: r> if \ offset<>0
1.2 anton 48: dofield
49: else
50: dozerofield
51: then ;
1.1 anton 52:
1.3 anton 53: : end-struct ( align size "name" -- )
54: over nalign \ pad size to full alignment
1.2 anton 55: 2constant ;
1.1 anton 56:
1.3 anton 57: \ an empty struct
58: 1 chars 0 end-struct struct
1.1 anton 59:
1.3 anton 60: \ type descriptors, all ( -- align size )
61: 1 aligned 1 cells 2constant cell%
62: 1 chars 1 chars 2constant char%
63: 1 faligned 1 floats 2constant float%
64: 1 dfaligned 1 dfloats 2constant dfloat%
65: 1 sfaligned 1 sfloats 2constant sfloat%
66: cell% 2* 2constant double%
67:
68: \ memory allocation words
1.4 ! anton 69: : %alignment ( align size -- align )
! 70: drop ;
! 71:
! 72: : %size ( align size -- size )
! 73: nip ;
! 74:
1.3 anton 75: : %align ( align size -- )
76: drop here swap nalign here - allot ;
1.1 anton 77:
1.3 anton 78: : %allot ( align size -- addr )
79: tuck %align
1.1 anton 80: here swap allot ;
81:
1.3 anton 82: : %allocate ( align size -- addr ior )
83: nip allocate ;
1.2 anton 84:
1.3 anton 85: : %alloc ( size align -- addr )
86: %allocate throw ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>