2 \ ** ficl/softwords/classes.fr
3 \ ** F I C L 2 . 0 C L A S S E S
7 \ $FreeBSD: src/sys/boot/ficl/softwords/classes.fr,v 1.4 2001/04/29 02:36:35 dcs Exp $
8 \ $DragonFly: src/sys/boot/ficl/softwords/classes.fr,v 1.3 2003/11/10 06:08:34 dillon Exp $
12 \ REF subclass holds a pointer to an object. It's
13 \ mainly for aggregation to help in making data structures.
19 : get ( inst class -- refinst refclass )
21 : set ( refinst refclass inst class -- )
25 object subclass c-byte
32 object subclass c-2byte
39 object subclass c-4byte
47 object subclass c-cell
56 \ Base class for pointers to scalars (not objects).
57 \ Note: use c-ref to make references to objects. C-ptr
58 \ subclasses refer to untyped quantities of various sizes.
60 \ Derived classes must specify the size of the thing
61 \ they point to, and supply get and set methods.
63 \ All derived classes must define the @size method:
64 \ @size ( inst class -- addr-units )
65 \ Returns the size in address units of the thing the pointer
70 \ get the value of the pointer
71 : get-ptr ( inst class -- addr )
76 \ set the pointer to address supplied
77 : set-ptr ( addr inst class -- )
82 \ force the pointer to be null
84 0 -rot c-ptr => .addr c-cell => set
87 \ return flag indicating null-ness
88 : ?null ( inst class -- flag )
92 \ increment the pointer in place
93 : inc-ptr ( inst class -- )
94 2dup 2dup ( i c i c i c )
95 c-ptr => get-ptr -rot ( i c addr i c )
96 --> @size + -rot ( addr' i c )
100 \ decrement the pointer in place
101 : dec-ptr ( inst class -- )
102 2dup 2dup ( i c i c i c )
103 c-ptr => get-ptr -rot ( i c addr i c )
104 --> @size - -rot ( addr' i c )
108 \ index the pointer in place
109 : index-ptr { index 2:this -- }
110 this --> get-ptr ( addr )
111 this --> @size index * + ( addr' )
118 \ ** C - C E L L P T R
119 \ Models a pointer to cell (a 32 or 64 bit scalar).
120 c-ptr subclass c-cellPtr
121 : @size 2drop 1 cells ;
122 \ fetch and store through the pointer
123 : get ( inst class -- cell )
126 : set ( value inst class -- )
132 \ ** C - 4 B Y T E P T R
133 \ Models a pointer to a quadbyte scalar
134 c-ptr subclass c-4bytePtr
136 \ fetch and store through the pointer
137 : get ( inst class -- value )
140 : set ( value inst class -- )
145 \ ** C - 2 B Y T E P T R
146 \ Models a pointer to a 16 bit scalar
147 c-ptr subclass c-2bytePtr
149 \ fetch and store through the pointer
150 : get ( inst class -- value )
153 : set ( value inst class -- )
159 \ ** C - B Y T E P T R
160 \ Models a pointer to an 8 bit scalar
161 c-ptr subclass c-bytePtr
163 \ fetch and store through the pointer
164 : get ( inst class -- value )
167 : set ( value inst class -- )