2 \ ** ficl/softwords/classes.fr
3 \ ** F I C L 2 . 0 C L A S S E S
11 \ REF subclass holds a pointer to an object. It's
12 \ mainly for aggregation to help in making data structures.
18 : get ( inst class -- refinst refclass )
20 : set ( refinst refclass inst class -- )
24 object subclass c-byte
31 object subclass c-2byte
38 object subclass c-4byte
46 object subclass c-cell
55 \ Base class for pointers to scalars (not objects).
56 \ Note: use c-ref to make references to objects. C-ptr
57 \ subclasses refer to untyped quantities of various sizes.
59 \ Derived classes must specify the size of the thing
60 \ they point to, and supply get and set methods.
62 \ All derived classes must define the @size method:
63 \ @size ( inst class -- addr-units )
64 \ Returns the size in address units of the thing the pointer
69 \ get the value of the pointer
70 : get-ptr ( inst class -- addr )
75 \ set the pointer to address supplied
76 : set-ptr ( addr inst class -- )
81 \ force the pointer to be null
83 0 -rot c-ptr => .addr c-cell => set
86 \ return flag indicating null-ness
87 : ?null ( inst class -- flag )
91 \ increment the pointer in place
92 : inc-ptr ( inst class -- )
93 2dup 2dup ( i c i c i c )
94 c-ptr => get-ptr -rot ( i c addr i c )
95 --> @size + -rot ( addr' i c )
99 \ decrement the pointer in place
100 : dec-ptr ( inst class -- )
101 2dup 2dup ( i c i c i c )
102 c-ptr => get-ptr -rot ( i c addr i c )
103 --> @size - -rot ( addr' i c )
107 \ index the pointer in place
108 : index-ptr { index 2:this -- }
109 this --> get-ptr ( addr )
110 this --> @size index * + ( addr' )
117 \ ** C - C E L L P T R
118 \ Models a pointer to cell (a 32 or 64 bit scalar).
119 c-ptr subclass c-cellPtr
120 : @size 2drop 1 cells ;
121 \ fetch and store through the pointer
122 : get ( inst class -- cell )
125 : set ( value inst class -- )
131 \ ** C - 4 B Y T E P T R
132 \ Models a pointer to a quadbyte scalar
133 c-ptr subclass c-4bytePtr
135 \ fetch and store through the pointer
136 : get ( inst class -- value )
139 : set ( value inst class -- )
144 \ ** C - 2 B Y T E P T R
145 \ Models a pointer to a 16 bit scalar
146 c-ptr subclass c-2bytePtr
148 \ fetch and store through the pointer
149 : get ( inst class -- value )
152 : set ( value inst class -- )
158 \ ** C - B Y T E P T R
159 \ Models a pointer to an 8 bit scalar
160 c-ptr subclass c-bytePtr
162 \ fetch and store through the pointer
163 : get ( inst class -- value )
166 : set ( value inst class -- )