classes.fr revision 61149 
1\ ** ficl/softwords/classes.fr
2\ ** F I C L   2 . 0   C L A S S E S
3\ john sadler  1 sep 98
4\ Needs oop.fr
5\
6\ $FreeBSD: head/sys/boot/ficl/softwords/classes.fr 61149 2000-06-01 18:10:44Z dcs $
7
8.( loading ficl utility classes ) cr
9also oop definitions
10
11\ REF subclass holds a pointer to an object. It's
12\ mainly for aggregation to help in making data structures.
13\
14object subclass c-ref
15    cell: .class
16    cell: .instance
17
18	: get   ( inst class -- refinst refclass )
19		drop 2@ ;
20	: set   ( refinst refclass inst class -- )
21		drop 2! ;
22end-class
23
24object subclass c-byte
25	char: .payload
26
27	: get  drop c@ ;
28	: set  drop c! ;
29end-class
30
31object subclass c-2byte
32	2 chars: .payload
33
34	: get  drop w@ ;
35	: set  drop w! ;
36end-class
37
38object subclass c-4byte
39	4 chars: .payload
40
41	: get  drop i@ ;
42	: set  drop i! ;
43end-class
44
45object subclass c-cell
46	cell: .payload
47
48	: get  drop @ ;
49	: set  drop ! ;
50end-class
51
52
53\ ** C - P T R 
54\ Base class for pointers to scalars (not objects).
55\ Note: use c-ref to make references to objects. C-ptr
56\ subclasses refer to untyped quantities of various sizes.
57
58\ Derived classes must specify the size of the thing
59\ they point to, and supply get and set methods.
60
61\ All derived classes must define the @size method:
62\ @size ( inst class -- addr-units )
63\ Returns the size in address units of the thing the pointer
64\ refers to.
65object subclass c-ptr
66    c-cell obj: .addr
67
68    \ get the value of the pointer
69    : get-ptr   ( inst class -- addr )
70        c-ptr  => .addr  
71        c-cell => get  
72    ;
73
74    \ set the pointer to address supplied
75    : set-ptr   ( addr inst class -- )
76        c-ptr  => .addr  
77        c-cell => set  
78    ;
79
80    \ force the pointer to be null
81	: clr-ptr
82	    0 -rot  c-ptr => .addr  c-cell => set
83	;
84
85    \ return flag indicating null-ness
86	: ?null     ( inst class -- flag )
87	    c-ptr => get-ptr 0= 
88	;
89
90    \ increment the pointer in place
91    : inc-ptr   ( inst class -- )
92        2dup 2dup                   ( i c i c i c )
93        c-ptr => get-ptr  -rot      ( i c addr i c )
94        --> @size  +  -rot          ( addr' i c )
95        c-ptr => set-ptr
96    ;
97
98    \ decrement the pointer in place
99    : dec-ptr    ( inst class -- )
100        2dup 2dup                   ( i c i c i c )
101        c-ptr => get-ptr  -rot      ( i c addr i c )
102        --> @size  -  -rot          ( addr' i c )
103        c-ptr => set-ptr
104    ;
105
106    \ index the pointer in place
107    : index-ptr   ( index inst class -- )
108        locals| class inst index |
109        inst class  c-ptr => get-ptr        ( addr )
110        inst class --> @size  index *  +    ( addr' )
111        inst class  c-ptr => set-ptr
112    ;
113
114end-class
115
116
117\ ** C - C E L L P T R 
118\ Models a pointer to cell (a 32 or 64 bit scalar). 
119c-ptr subclass c-cellPtr
120    : @size   2drop  1 cells ;
121    \ fetch and store through the pointer
122	: get   ( inst class -- cell )
123        c-ptr => get-ptr @  
124    ;
125	: set   ( value inst class -- )
126        c-ptr => get-ptr !  
127    ;
128end-class
129
130
131\ ** C - I N T P T R
132\ Models a pointer to an int (a 32 bit scalar).
133c-ptr subclass c-4bytePtr
134    : @size   2drop  4  ;
135    \ fetch and store through the pointer
136	: get   ( inst class -- value )
137        c-ptr => get-ptr i@  
138    ;
139	: set   ( value inst class -- )
140        c-ptr => get-ptr i!  
141    ;
142end-class
143
144
145\ ** C - 2 B Y T E P T R 
146\ Models a pointer to a 16 bit scalar
147c-ptr subclass c-2bytePtr
148    : @size   2drop  2  ;
149    \ fetch and store through the pointer
150	: get   ( inst class -- value )
151        c-ptr => get-ptr w@  
152    ;
153	: set   ( value inst class -- )
154        c-ptr => get-ptr w!  
155    ;
156end-class
157
158
159\ ** C - B Y T E P T R 
160\ Models a pointer to an 8 bit scalar
161c-ptr subclass c-bytePtr
162    : @size   2drop  1  ;
163    \ fetch and store through the pointer
164	: get   ( inst class -- value )
165        c-ptr => get-ptr c@  
166    ;
167	: set   ( value inst class -- )
168        c-ptr => get-ptr c!  
169    ;
170end-class
171
172
173previous definitions
174