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