-
Notifications
You must be signed in to change notification settings - Fork 2
/
TokenSet.32bit.mod
330 lines (248 loc) · 9.31 KB
/
TokenSet.32bit.mod
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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
(*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *)
IMPLEMENTATION MODULE TokenSet; (* requires 32-bit CARDINAL *)
(* Token Set ADT for Modula-2 R10 Bootstrap Kernel *)
IMPORT Console;
FROM Token IMPORT TokenT; (* alias for Token.Token *)
FROM CardMath IMPORT pow2;
FROM SYSTEM IMPORT TSIZE;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
CONST
Bitwidth = 32;
SegCount = Bitwidth ORD(MAX(TokenT)) DIV Bitwidth;
(* --------------------------------------------------------------------------
* TokenSet type
* ----------------------------------------------------------------------- *)
TYPE TokenSet = POINTER TO Descriptor;
TYPE Descriptor = RECORD
count : CARDINAL;
segment : ARRAY [0..SegCount-1] OF CARDINAL
END; (* Descriptor *)
(* Operations *)
(* --------------------------------------------------------------------------
* procedure NewFromRawData(set, segment2, segment1, segment0)
* --------------------------------------------------------------------------
* Passes a newly allocated and initialised TokenSet instance back in set.
* The set is initalised from parameters segment2 to segment0 as follows:
*
* bit 127 bit 0
* v v
* [<------------set----------->]
* [segment2][segment1][segment0]
* ^ ^ ^
* bit 31 bit 31 bit 31
*
* The bits in set correspond to the token values of type Token.
* ----------------------------------------------------------------------- *)
PROCEDURE NewFromRawData
( VAR set : TokenSet; segment2, segment1, segment0 : CARDINAL );
VAR
token : TokenT;
newSet : TokenSetT;
mask, highBitInSeg2, bit, segIndex : CARDINAL;
BEGIN
(* allocate new set *)
ALLOCATE(newSet, TSIZE(Descriptor));
(* initialise segment0 and segment1 as passed in *)
newSet^segment[0] := segment0;
newSet^segment[1] := segment1;
(* initialise segment2 by clearing unused higher bits *)
(* determine highest token bit in segment2 *)
highBitInSeg2 := ORD(MAX(TokenT)) MOD Bitwidth;
(* shift lower bits out to the right *)
mask := segment2 DIV (highBitInSeg2 + 1);
(* shift them back, thereby clearing the low bits to obtain a mask *)
mask := mask * pow2[highBitInSeg2 + 1];
(* subtract the mask, thereby clearing the bits above the highest bit *)
newSet^segment[2] := segment2 - mask;
(* count total number of bits to initialise counter *)
newSet^.count := 0;
FOR segIndex := 0 TO SegCount-1 DO
FOR bit := 0 TO Bitwidth-1 DO
IF ODD(segment[segIndex] DIV pow2(bit)) THEN
newSet^.count := newSet^.count + 1
END (* IF *)
END (* FOR *)
END (* FOR *)
(* pass back new set *)
set := newSet
END NewFromRawData;
(* --------------------------------------------------------------------------
* procedure NewFromArray(set, tokenList)
* --------------------------------------------------------------------------
* Passes a newly allocated and initialised TokenSet instance back in set.
* The set is initialised with the tokens passed in the tokenList array.
* Passes back NIL if allocation is unsuccessful.
* ----------------------------------------------------------------------- *)
PROCEDURE NewFromArray
( VAR set : TokenSet; tokenList : ARRAY OF Token );
BEGIN
(* allocate new set *)
ALLOCATE(newSet, TSIZE(Descriptor));
(* initialise as an empty set *)
newSet^.count := 0;
newSet^.segment[0] := 0;
newSet^.segment[1] := 0;
newSet^.segment[2] := 0;
(* add each token in tokenList to the new set *)
FOR index := 0 TO HIGH(tokenList) DO
Insert(newSet, tokenList[index])
END (* FOR *)
(* pass back new set *)
set := newSet
END NewFromArray;
(* --------------------------------------------------------------------------
* procedure Insert(set, token)
* --------------------------------------------------------------------------
* Inserts token into set.
* ----------------------------------------------------------------------- *)
PROCEDURE Insert ( set : TokenSet; token : TokenT );
VAR
segIndex, bit, pow2bit : CARDINAL;
BEGIN
(* bail out if set is invalid *)
IF set = NIL THEN
RETURN
END; (* IF *)
(* determine segment and bit where token is stored *)
segIndex := ORD(token) DIV Bitwidth;
bit := ORD(token) MOD Bitwidth;
pow2bit := pow2(bit);
(* test bit in segment *)
IF ODD(set^.segment[segIndex] DIV pow2bit) (* bit is set *) THEN
RETURN
ELSE (* bit is not set *)
(* set the bit *)
set^.segment[segIndex] := set^.segment[segIndex] + pow2bit;
(* update counter *)
set^.count := set^.count + 1
END (* END *)
END Insert;
(* --------------------------------------------------------------------------
* procedure Remove(set, token)
* --------------------------------------------------------------------------
* Removes token from set.
* ----------------------------------------------------------------------- *)
PROCEDURE Remove ( set : TokenSet; token : TokenT );
VAR
segIndex, bit, pow2bit : CARDINAL;
BEGIN
(* bail out if set is invalid *)
IF set = NIL THEN
RETURN
END; (* IF *)
(* determine segment and bit where token is stored *)
segIndex := ORD(token) DIV Bitwidth;
bit := ORD(token) MOD Bitwidth;
pow2bit := pow2(bit);
(* test bit in segment *)
IF ODD(set^.segment[segIndex] DIV pow2bit) (* bit is set *) THEN
(* clear the bit *)
set^.segment[segIndex] := set^.segment[segIndex] - pow2bit;
(* update counter *)
set^.count := set^.count - 1
END (* END *)
END Remove;
(* --------------------------------------------------------------------------
* function isEmpty(set)
* --------------------------------------------------------------------------
* Returns TRUE if set is empty, otherwise FALSE.
* ----------------------------------------------------------------------- *)
PROCEDURE isEmpty ( set : TokenSet ) : BOOLEAN;
BEGIN
IF set = NIL THEN
RETURN TRUE
END; (* IF *)
RETURN (set^.count = 0)
END isEmpty;
(* --------------------------------------------------------------------------
* function isElem(set)
* --------------------------------------------------------------------------
* Returns TRUE if token is an element of set, otherwise FALSE.
* ----------------------------------------------------------------------- *)
PROCEDURE isElem ( set : TokenSet; token : TokenT ) : BOOLEAN;
BEGIN
(* bail out if set is invalid *)
IF set = NIL THEN
RETURN FALSE
END; (* IF *)
(* determine segment and bit where token is stored *)
segIndex := ORD(token) DIV Bitwidth;
bit := ORD(token) MOD Bitwidth;
RETURN ODD(set^.segment[segIndex] DIV pow2(bit)) (* bit is set *)
END isElem;
(* --------------------------------------------------------------------------
* function count(set)
* --------------------------------------------------------------------------
* Returns the number of tokens in set.
* ----------------------------------------------------------------------- *)
PROCEDURE count ( set : TokenSet ) : CARDINAL;
BEGIN
IF set = NIL THEN
RETURN 0
END (* IF *)
RETURN set^.count
END count;
(* --------------------------------------------------------------------------
* procedure PrintTokenList(set)
* --------------------------------------------------------------------------
* Prints a comma separated list of tokens in set.
* ----------------------------------------------------------------------- *)
PROCEDURE PrintTokenList ( set : TokenSet );
VAR
counter : CARDINAL;
BEGIN
(* bail out if set is invalid *)
IF set = NIL THEN
Console.WriteChars("(NIL)")
END; (* IF *)
(* all clear -- print token list *)
counter := 0;
FOR token := MIN(TokenT) TO MAX(TokenT) DO
IF isElem(set, token) THEN
Console.WriteString(Token.lexemeForToken(token));
counter := counter + 1;
IF counter < set^.count THEN
Console.WriteChars(", ")
END (* IF *)
END (* IF *)
END (* FOR *)
END PrintTokenList;
(* --------------------------------------------------------------------------
* procedure PrintSegments(set)
* --------------------------------------------------------------------------
* Prints a comma separated list of the data segments of set in base-16.
* ----------------------------------------------------------------------- *)
PROCEDURE PrintSegments ( set : TokenSet );
BEGIN
(* bail out if set is invalid *)
IF set = NIL THEN
Console.WriteChars("(NIL)")
END; (* IF *)
(* all clear -- print segments *)
Console.WriteCardX(set^.segment2); Console.WriteChars(", ");
Console.WriteCardX(set^.segment1); Console.WriteChars(", ");
Console.WriteCardX(set^.segment0)
END PrintSegments;
(* --------------------------------------------------------------------------
* procedure Release(set)
* --------------------------------------------------------------------------
* Releases set and passes back NIL.
* ----------------------------------------------------------------------- *)
PROCEDURE Release ( VAR set : TokenSet );
BEGIN
(* bail out if set is invalid *)
IF set = NIL THEN
RETURN
END; (* IF *)
(* deallocate set and pass NIL *)
DEALLOCATE(set);
set := NIL
END Release;
BEGIN (* TokenSet *)
(* bail out if CARDINAL is not 32-bit wide *)
IF TSIZE(CARDINAL) # Bitwidth THEN
Console.WriteChars("Library TokenSet requires 32-bit CARDINALs.");
Console.WriteLn;
HALT
END (* IF *)
END TokenSet.