Commit | Line | Data |
---|---|---|
49c172c0 | 1 | REM > types library for mal in BBC BASIC |
ca23e632 BH |
2 | |
3 | REM This library should be the only thing that understands the | |
4 | REM implementation of mal data types in BBC BASIC. All other | |
5 | REM code should use routines in this library to access them. | |
6 | ||
7 | REM As far as other code is concerned, a mal object is just an | |
8 | REM opaque 32-bit integer, which might be a pointer, or might not. | |
9 | ||
94b7a079 BH |
10 | REM All mal objects live in an array, Z%(), with string values held |
11 | REM in a parallel array, Z$(). There's one row in Z%(), and one | |
12 | REM entry in Z$(), for each mal object. | |
2ec0dbee | 13 | |
ec8336b0 | 14 | REM Z%(x,0) holds the type of an object and other small amounts of |
94b7a079 | 15 | REM information. The bottom bit indicates the semantics of Z%(x,1): |
ec8336b0 BH |
16 | |
17 | REM &01 : Z%(x,1) is a pointer into Z%() | |
4fbd9d0f BH |
18 | |
19 | REM Z%(x,2) and Z%(x,3) are always pointers into Z%(), to 'nil' if nothing | |
20 | REM else. | |
7f6d61fc | 21 | |
2e3de60f BH |
22 | REM The &40 bit is used to distinguish empty lists, vectors and hash-maps. |
23 | REM The &80 bit distinguishes vectors from lists and macros from functions. | |
24 | ||
7f6d61fc BH |
25 | REM sS%() is a shadow stack, used to keep track of which mal values might |
26 | REM be referenced from local variables at a given depth of the BASIC call | |
27 | REM stack. It grows upwards. sSP% points to the first unused word. sFP% | |
28 | REM points to the start of the current shadow stack frame. The first word | |
29 | REM of each shadow stack frame is the saved value of sFP%. The rest are | |
30 | REM mal values. | |
6d1a36e8 BH |
31 | |
32 | REM Types are: | |
ec8336b0 | 33 | REM &00 nil |
4fbd9d0f BH |
34 | REM &04 boolean |
35 | REM &08 integer | |
36 | REM &0C core function | |
ec8336b0 | 37 | REM &01 atom |
4fbd9d0f BH |
38 | REM &05 free block |
39 | REM &09 list/vector (each object is a cons cell) | |
40 | REM &0D environment | |
41 | REM &11 hash-map internal node | |
42 | REM &15 mal function (first part) | |
43 | REM &19 mal function (second part) | |
44 | REM &02 string/keyword | |
45 | REM &06 symbol | |
90f6b7a2 | 46 | REM &0A hash-map leaf node |
6d1a36e8 BH |
47 | |
48 | REM Formats of individual objects are defined below. | |
ca23e632 BH |
49 | |
50 | DEF PROCtypes_init | |
b0d6aa71 BH |
51 | REM Mal's heap has to be statically dimensioned, but we also |
52 | REM need to leave enough space for BASIC's stack and heap. | |
53 | REM The BASIC heap is where all strings live. | |
54 | REM | |
55 | REM Each row of Z%() consumes 16 bytes. The size of each entry | |
56 | REM in Z$() varies by platform: 5 bytes in ARM BBC BASIC V, | |
57 | REM 8 bytes in Brandy on a 32-bit system, 16 bytes in Brandy on | |
58 | REM a 64-bit system. | |
59 | ||
022d4cb9 | 60 | DIM Z%((HIMEM-LOMEM)/110,3), Z$((HIMEM-LOMEM)/110) |
7f6d61fc | 61 | DIM sS%((HIMEM-LOMEM)/64) |
b0d6aa71 | 62 | |
4fbd9d0f BH |
63 | Z%(1,0) = &04 : REM false |
64 | Z%(2,0) = &04 : Z%(2,1) = TRUE : REM true | |
2e3de60f BH |
65 | Z%(3,0) = &49 : Z%(3,1) = 3 : REM empty list |
66 | Z%(4,0) = &C9 : Z%(4,1) = 4 : REM empty vector | |
67 | Z%(5,0) = &51 : REM empty hashmap | |
4b811acc | 68 | next_Z% = 6 |
7f6d61fc BH |
69 | sSP% = 1 |
70 | sFP% = 0 | |
7b6e74a6 | 71 | F% = 0 |
ca23e632 BH |
72 | ENDPROC |
73 | ||
74 | DEF FNtype_of(val%) | |
2e3de60f | 75 | =Z%(val%,0) AND &1F |
ca23e632 | 76 | |
7f6d61fc | 77 | DEF PROCgc_enter |
5411931a | 78 | REM PRINT ;sFP%; |
7f6d61fc BH |
79 | sS%(sSP%) = sFP% |
80 | sFP% = sSP% | |
81 | sSP% += 1 | |
5411931a | 82 | REM PRINT " >>> ";sFP% |
7f6d61fc | 83 | ENDPROC |
a6b84652 | 84 | |
1610afd2 BH |
85 | REM FNgc_save is equivalent to PROCgc_enter except that it returns a |
86 | REM value that can be passed to PROCgc_restore to pop all the stack | |
87 | REM frames back to (and including) the one pushed by FNgc_save. | |
7b6e74a6 | 88 | DEF FNgc_save |
1610afd2 | 89 | PROCgc_enter |
7b6e74a6 BH |
90 | =sFP% |
91 | ||
7f6d61fc | 92 | DEF PROCgc_exit |
5411931a | 93 | REM PRINT ;sS%(sFP%);" <<< ";sFP% |
7f6d61fc BH |
94 | sSP% = sFP% |
95 | sFP% = sS%(sFP%) | |
a6b84652 BH |
96 | ENDPROC |
97 | ||
7b6e74a6 BH |
98 | DEF PROCgc_restore(oldFP%) |
99 | sFP% = oldFP% | |
1610afd2 BH |
100 | REM PRINT "!!! FP reset" |
101 | PROCgc_exit | |
102 | ENDPROC | |
7b6e74a6 | 103 | |
7f6d61fc BH |
104 | DEF FNref_local(val%) |
105 | sS%(sSP%) = val% | |
106 | sSP% += 1 | |
107 | =val% | |
108 | ||
109 | DEF FNgc_exit(val%) | |
110 | PROCgc_exit | |
1610afd2 BH |
111 | =FNref_local(val%) |
112 | ||
113 | DEF FNgc_restore(oldFP%, val%) | |
114 | PROCgc_restore(oldFP%) | |
115 | =FNref_local(val%) | |
7b6e74a6 | 116 | |
d9dcadde BH |
117 | DEF PROCgc_keep_only2(val1%, val2%) |
118 | PROCgc_exit | |
119 | PROCgc_enter | |
120 | val1% = FNref_local(val1%) | |
121 | val2% = FNref_local(val2%) | |
122 | ENDPROC | |
123 | ||
7b6e74a6 | 124 | DEF FNmalloc(type%) |
15119738 | 125 | LOCAL val% |
90d169ce | 126 | REM If the heap is full, collect garbage first. |
d510574d BH |
127 | IF F% = 0 AND next_Z% > DIM(Z%(),1) THEN |
128 | PROCgc | |
129 | IF F% = 0 ERROR &40E80950, "Out of mal heap memory" | |
130 | ENDIF | |
7b6e74a6 BH |
131 | IF F% <> 0 THEN |
132 | val% = F% | |
133 | F% = Z%(val%,1) | |
134 | ELSE | |
135 | val% = next_Z% | |
136 | next_Z% += 1 | |
137 | ENDIF | |
a1767f63 | 138 | Z%(val%,0) = type% |
7f6d61fc | 139 | =FNref_local(val%) |
15119738 | 140 | |
7b6e74a6 | 141 | DEF PROCfree(val%) |
4fbd9d0f | 142 | Z%(val%,0) = &05 |
7b6e74a6 BH |
143 | Z%(val%,1) = F% |
144 | Z%(val%,2) = 0 | |
145 | Z%(val%,3) = 0 | |
94b7a079 | 146 | Z$(val%) = "" |
7b6e74a6 BH |
147 | F% = val% |
148 | ENDPROC | |
149 | ||
150 | DEF PROCgc | |
5411931a | 151 | REM PRINT "** START GC **" |
7b6e74a6 BH |
152 | PROCgc_markall |
153 | PROCgc_sweep | |
5411931a | 154 | REM PRINT "** FINISH GC **" |
7b6e74a6 BH |
155 | ENDPROC |
156 | ||
157 | DEF PROCgc_markall | |
158 | LOCAL sp%, fp% | |
159 | fp% = sFP% | |
5411931a | 160 | REM PRINT ">>marking..."; |
7b6e74a6 BH |
161 | FOR sp% = sSP% - 1 TO 0 STEP -1 |
162 | IF sp% = fp% THEN | |
163 | fp% = sS%(sp%) | |
5411931a | 164 | REM PRINT " / "; |
7b6e74a6 BH |
165 | ELSE PROCgc_mark(sS%(sp%)) |
166 | ENDIF | |
167 | NEXT sp% | |
5411931a | 168 | REM PRINT |
7b6e74a6 BH |
169 | ENDPROC |
170 | ||
171 | DEF PROCgc_mark(val%) | |
a1767f63 | 172 | IF (Z%(val%,0) AND &100) = 0 THEN |
5411931a | 173 | REM PRINT " ";val%; |
a1767f63 | 174 | Z%(val%,0) += &100 |
ec8336b0 | 175 | IF (Z%(val%,0) AND &01) THEN PROCgc_mark(Z%(val%,1)) |
4fbd9d0f | 176 | PROCgc_mark(Z%(val%,2)) |
33368392 | 177 | PROCgc_mark(Z%(val%,3)) |
7b6e74a6 BH |
178 | ENDIF |
179 | ENDPROC | |
180 | ||
181 | DEF PROCgc_sweep | |
182 | LOCAL val% | |
5411931a | 183 | REM PRINT ">>sweeping ..."; |
7b6e74a6 | 184 | FOR val% = 6 TO next_Z% - 1 |
4fbd9d0f | 185 | IF FNtype_of(val%) <> &05 AND (Z%(val%,0) AND &100) = 0 THEN |
5411931a | 186 | REM PRINT " ";val%; |
7b6e74a6 | 187 | PROCfree(val%) |
a1767f63 BH |
188 | ELSE |
189 | Z%(val%,0) -= &100 | |
7b6e74a6 BH |
190 | ENDIF |
191 | NEXT val% | |
5411931a | 192 | REM PRINT |
7b6e74a6 BH |
193 | ENDPROC |
194 | ||
33368392 BH |
195 | DEF FNmeta(val%) |
196 | =Z%(val%,3) | |
197 | ||
198 | DEF FNwith_meta(val%, meta%) | |
199 | LOCAL newval% | |
200 | newval% = FNmalloc(Z%(val%,0)) | |
201 | Z%(newval%,1) = Z%(val%,1) | |
202 | Z%(newval%,2) = Z%(val%,2) | |
203 | Z%(newval%,3) = meta% | |
30409c3d | 204 | Z$(newval%) = Z$(val%) |
33368392 BH |
205 | =newval% |
206 | ||
ca23e632 BH |
207 | REM ** Nil ** |
208 | ||
c32c31b3 BH |
209 | DEF FNis_nil(val%) |
210 | =FNtype_of(val%) = 0 | |
211 | ||
ca23e632 BH |
212 | DEF FNnil |
213 | =0 | |
214 | ||
3ab6b58b BH |
215 | REM ** Boolean ** |
216 | ||
604e6260 | 217 | REM Z%(x,1) = TRUE or FALSE |
6d1a36e8 | 218 | |
3ab6b58b | 219 | DEF FNis_boolean(val%) |
4fbd9d0f | 220 | =FNtype_of(val%) = &04 |
3ab6b58b BH |
221 | |
222 | DEF FNalloc_boolean(bval%) | |
4b811acc BH |
223 | IF bval% THEN =2 |
224 | =1 | |
3ab6b58b BH |
225 | |
226 | DEF FNunbox_boolean(val%) | |
9809aa65 | 227 | IF NOT FNis_boolean(val%) THEN ERROR &40E80911, "Not a boolean" |
604e6260 | 228 | =Z%(val%,1) |
3ab6b58b | 229 | |
b4033eb7 BH |
230 | DEF FNis_truish(val%) |
231 | IF FNis_nil(val%) THEN =FALSE | |
604e6260 | 232 | IF FNis_boolean(val%) THEN =FNunbox_boolean(val%) |
b4033eb7 BH |
233 | =TRUE |
234 | ||
ca23e632 BH |
235 | REM ** Integers ** |
236 | ||
6d1a36e8 BH |
237 | REM Z%(x,1) = integer value |
238 | ||
ca23e632 | 239 | DEF FNis_int(val%) |
4fbd9d0f | 240 | =FNtype_of(val%) = &08 |
ca23e632 BH |
241 | |
242 | DEF FNalloc_int(ival%) | |
243 | LOCAL val% | |
4fbd9d0f | 244 | val% = FNmalloc(&08) |
4b811acc | 245 | Z%(val%,1) = ival% |
ca23e632 BH |
246 | =val% |
247 | ||
248 | DEF FNunbox_int(val%) | |
9809aa65 | 249 | IF NOT FNis_int(val%) THEN ERROR &40E80912, "Not an integer" |
4b811acc | 250 | =Z%(val%,1) |
ca23e632 | 251 | |
bc27a6ad BH |
252 | REM ** Strings and keywords ** |
253 | ||
94b7a079 BH |
254 | REM Z$(x) is the string value |
255 | REM Z%(x,2) points to the next part of the string | |
bc27a6ad | 256 | REM A keyword is a string with first character CHR$(127). |
68f0184e BH |
257 | |
258 | DEF FNis_string(val%) | |
4fbd9d0f | 259 | =FNtype_of(val%) = &02 |
68f0184e BH |
260 | |
261 | DEF FNalloc_string(sval$) | |
262 | LOCAL val% | |
4fbd9d0f | 263 | val% = FNmalloc(&02) |
94b7a079 | 264 | Z$(val%) = sval$ |
68f0184e BH |
265 | =val% |
266 | ||
68f0184e BH |
267 | DEF FNunbox_string(val%) |
268 | IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string" | |
94b7a079 BH |
269 | IF NOT FNis_nil(Z%(val%,2)) ERROR &40E80914, "Cannot unbox a long string" |
270 | =Z$(val%) | |
68f0184e | 271 | |
e55d7a2d BH |
272 | DEF FNstring_append(val%, add$) |
273 | LOCAL newval% | |
0f97a00d | 274 | IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string" |
e55d7a2d BH |
275 | newval% = FNalloc_string(Z$(val%)) |
276 | IF FNis_nil(Z%(val%,2)) THEN | |
277 | IF LEN(Z$(newval%)) + LEN(add$) <= 255 THEN | |
278 | Z$(newval%) += add$ | |
279 | ELSE | |
280 | Z%(newval%,2) = FNalloc_string(add$) | |
281 | ENDIF | |
0f97a00d | 282 | ELSE |
e55d7a2d | 283 | Z%(newval%,2) = FNstring_append(Z%(val%,2), add$) |
0f97a00d | 284 | ENDIF |
e55d7a2d | 285 | =newval% |
0f97a00d | 286 | |
e55d7a2d | 287 | DEF FNstring_concat(val%, add%) |
869a03e4 | 288 | LOCAL newval% |
0f97a00d BH |
289 | IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string" |
290 | IF NOT FNis_string(add%) THEN ERROR &40E80914, "Not a string" | |
869a03e4 BH |
291 | newval% = FNalloc_string(Z$(val%)) |
292 | IF FNis_nil(Z%(val%,2)) THEN | |
293 | IF LEN(Z$(newval%)) + LEN(Z$(add%)) <= 255 THEN | |
294 | Z$(newval%) += Z$(add%) | |
295 | Z%(newval%,2) = Z%(add%,2) | |
296 | ELSE | |
297 | Z%(newval%,2) = add% | |
298 | ENDIF | |
299 | ELSE | |
300 | Z%(newval%,2) = FNstring_concat(Z%(val%,2), add%) | |
301 | ENDIF | |
302 | =newval% | |
0f97a00d BH |
303 | |
304 | DEF FNstring_len(val%) | |
94b7a079 BH |
305 | LOCAL len% |
306 | WHILE NOT FNis_nil(val%) | |
307 | len% += LEN(Z$(val%)) | |
308 | val% = Z%(val%,2) | |
0f97a00d BH |
309 | ENDWHILE |
310 | =len% | |
311 | ||
312 | DEF FNstring_chr(val%, pos%) | |
94b7a079 BH |
313 | WHILE pos% > LEN(Z$(val%)) |
314 | pos% -= LEN(Z$(val%)) | |
315 | val% = Z%(val%,2) | |
316 | IF FNis_nil(val%) THEN ="" | |
0f97a00d | 317 | ENDWHILE |
94b7a079 | 318 | =MID$(Z$(val%), pos%, 1) |
0f97a00d | 319 | |
ca23e632 BH |
320 | REM ** Symbols ** |
321 | ||
94b7a079 | 322 | REM Z$(x) = value of the symbol |
6d1a36e8 | 323 | |
ca23e632 | 324 | DEF FNis_symbol(val%) |
4fbd9d0f | 325 | =FNtype_of(val%) = &06 |
ca23e632 BH |
326 | |
327 | DEF FNalloc_symbol(sval$) | |
f1e3f09f | 328 | LOCAL val% |
4fbd9d0f | 329 | val% = FNmalloc(&06) |
94b7a079 | 330 | Z$(val%) = sval$ |
ca23e632 BH |
331 | =val% |
332 | ||
333 | DEF FNunbox_symbol(val%) | |
9809aa65 | 334 | IF NOT FNis_symbol(val%) THEN ERROR &40E80915, "Not a symbol" |
94b7a079 | 335 | =Z$(val%) |
ca23e632 | 336 | |
07f3522f | 337 | REM ** Lists and vectors ** |
ca23e632 | 338 | |
07f3522f BH |
339 | REM Lists and vectors are both represented as linked lists: the only |
340 | REM difference is in the state of the is_vector flag in the head cell | |
341 | REM of the list. Note that this means that the tail of a list may be | |
342 | REM a vector, and vice versa. FNas_list and FNas_vector can be used | |
343 | REM to convert a sequence to a particular type as necessary. | |
344 | ||
345 | REM Z%(x,0) AND &80 = is_vector flag | |
6d1a36e8 BH |
346 | REM Z%(x,1) = index in Z%() of next pair |
347 | REM Z%(x,2) = index in Z%() of first element | |
348 | ||
9e1b7a8f BH |
349 | REM The empty list is a distinguished value, with elements that match |
350 | REM the spec of 'first' and 'rest'. | |
6d1a36e8 | 351 | |
ca23e632 | 352 | DEF FNempty |
4b811acc | 353 | =3 |
ca23e632 | 354 | |
07f3522f BH |
355 | DEF FNempty_vector |
356 | =4 | |
357 | ||
ca23e632 BH |
358 | DEF FNalloc_pair(car%, cdr%) |
359 | LOCAL val% | |
4fbd9d0f | 360 | val% = FNmalloc(&09) |
7f6d61fc BH |
361 | Z%(val%,2) = car% |
362 | Z%(val%,1) = cdr% | |
363 | =val% | |
a6b84652 | 364 | |
07f3522f BH |
365 | DEF FNalloc_vector_pair(car%, cdr%) |
366 | LOCAL val% | |
367 | val% = FNalloc_pair(car%, cdr%) | |
9152704f | 368 | Z%(val%,0) = Z%(val%,0) OR &80 |
07f3522f BH |
369 | =val% |
370 | ||
ca23e632 | 371 | DEF FNis_empty(val%) |
2e3de60f | 372 | =(Z%(val%,0) AND &40) = &40 |
ca23e632 | 373 | |
9152704f | 374 | DEF FNis_seq(val%) |
4fbd9d0f | 375 | =FNtype_of(val%) = &09 |
ca23e632 | 376 | |
9152704f | 377 | DEF FNis_list(val%) |
4fbd9d0f | 378 | =FNtype_of(val%) = &09 AND (Z%(val%, 0) AND &80) = &00 |
9152704f | 379 | |
07f3522f | 380 | DEF FNis_vector(val%) |
4fbd9d0f | 381 | =FNtype_of(val%) = &09 AND (Z%(val%, 0) AND &80) = &80 |
07f3522f BH |
382 | |
383 | DEF FNas_list(val%) | |
9152704f | 384 | IF FNis_list(val%) THEN =val% |
07f3522f | 385 | IF FNis_empty(val%) THEN =FNempty |
f14770fc | 386 | =FNalloc_pair(FNfirst(val%), FNrest(val%)) |
07f3522f BH |
387 | |
388 | DEF FNas_vector(val%) | |
ec8336b0 | 389 | IF FNis_vector(val%) THEN =val% |
07f3522f | 390 | IF FNis_empty(val%) THEN =FNempty_vector |
f14770fc | 391 | =FNalloc_vector_pair(FNfirst(val%), FNrest(val%)) |
07f3522f | 392 | |
f14770fc | 393 | DEF FNfirst(val%) |
9152704f | 394 | IF NOT FNis_seq(val%) THEN ERROR &40E80916, "Can't get car of non-sequence" |
7f6d61fc | 395 | =FNref_local(Z%(val%,2)) |
ca23e632 | 396 | |
f14770fc | 397 | DEF FNrest(val%) |
9152704f | 398 | IF NOT FNis_seq(val%) THEN ERROR &40E80916, "Can't get cdr of non-sequence" |
7f6d61fc | 399 | =FNref_local(Z%(val%,1)) |
c2d58701 | 400 | |
86f8c24f BH |
401 | DEF FNalloc_list2(val0%, val1%) |
402 | =FNalloc_pair(val0%, FNalloc_pair(val1%, FNempty)) | |
403 | ||
404 | DEF FNalloc_list3(val0%, val1%, val2%) | |
405 | =FNalloc_pair(val0%, FNalloc_pair(val1%, FNalloc_pair(val2%, FNempty))) | |
406 | ||
f14770fc | 407 | DEF FNcount(val%) |
717da462 BH |
408 | LOCAL i% |
409 | WHILE NOT FNis_empty(val%) | |
f14770fc | 410 | val% = FNrest(val%) |
717da462 BH |
411 | i% += 1 |
412 | ENDWHILE | |
413 | = i% | |
414 | ||
f14770fc | 415 | DEF FNnth(val%, n%) |
1588b9d4 | 416 | WHILE n% > 0 |
59c39631 | 417 | IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range" |
f14770fc | 418 | val% = FNrest(val%) |
59c39631 BH |
419 | n% -= 1 |
420 | ENDWHILE | |
82805c27 | 421 | IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range" |
f14770fc | 422 | =FNfirst(val%) |
59c39631 | 423 | |
717da462 BH |
424 | REM ** Core functions ** |
425 | ||
6d1a36e8 BH |
426 | REM Z%(x,1) = index of function in FNcore_call |
427 | ||
717da462 | 428 | DEF FNis_corefn(val%) |
4fbd9d0f | 429 | =FNtype_of(val%) = &0C |
717da462 BH |
430 | |
431 | DEF FNalloc_corefn(fn%) | |
432 | LOCAL val% | |
4fbd9d0f | 433 | val% = FNmalloc(&0C) |
4b811acc | 434 | Z%(val%,1) = fn% |
717da462 BH |
435 | =val% |
436 | ||
437 | DEF FNunbox_corefn(val%) | |
9809aa65 | 438 | IF NOT FNis_corefn(val%) THEN ERROR &40E80919, "Not a core function" |
4b811acc | 439 | =Z%(val%,1) |
717da462 | 440 | |
6d1a36e8 BH |
441 | REM ** Hash-maps ** |
442 | ||
f046cfa6 BH |
443 | REM Hash-maps are represented as a crit-bit tree. |
444 | ||
90f6b7a2 BH |
445 | REM An internal node has: |
446 | REM Z%(x,0) >> 16 = next bit of key to check | |
447 | REM Z%(x,1) = index in Z%() of left child (if next bit of key is 0) | |
448 | REM Z%(x,2) = index in Z%() of right child (if next bit of key is 1) | |
449 | ||
450 | REM A leaf node has | |
94b7a079 | 451 | REM Z$(x) = key |
ec8336b0 | 452 | REM Z%(x,2) = index in Z%() of value |
c2d58701 | 453 | |
90f6b7a2 | 454 | REM The empty hash-map is a special value containing no data. |
c2d58701 BH |
455 | |
456 | DEF FNempty_hashmap | |
4b811acc | 457 | =5 |
c2d58701 | 458 | |
90f6b7a2 | 459 | DEF FNhashmap_alloc_leaf(key$, val%) |
c2d58701 | 460 | LOCAL entry% |
90f6b7a2 | 461 | entry% = FNmalloc(&0A) |
94b7a079 | 462 | Z$(entry%) = key$ |
ec8336b0 | 463 | Z%(entry%,2) = val% |
90f6b7a2 | 464 | =entry% |
c2d58701 | 465 | |
c592ecd1 BH |
466 | DEF FNhashmap_alloc_node(bit%, left%, right%) |
467 | LOCAL entry% | |
4fbd9d0f | 468 | entry% = FNmalloc(&11) |
c592ecd1 BH |
469 | Z%(entry%,0) += (bit% << 16) |
470 | Z%(entry%,1) = left% | |
471 | Z%(entry%,2) = right% | |
472 | =entry% | |
473 | ||
c2d58701 | 474 | DEF FNis_hashmap(val%) |
90f6b7a2 BH |
475 | LOCAL t% |
476 | t% = FNtype_of(val%) | |
2e3de60f | 477 | =t% = &11 OR t% = &0A |
90f6b7a2 | 478 | |
c592ecd1 BH |
479 | DEF FNkey_bit(key$, bit%) |
480 | LOCAL cnum% | |
481 | cnum% = bit% >> 3 | |
482 | IF cnum% >= LEN(key$) THEN =FALSE | |
c96b3a5b | 483 | =ASC(MID$(key$, cnum% + 1, 1)) AND (&80 >> (bit% AND 7)) |
c592ecd1 BH |
484 | |
485 | DEF FNkey_bitdiff(key1$, key2$) | |
486 | LOCAL bit% | |
487 | WHILE FNkey_bit(key1$, bit%) = FNkey_bit(key2$, bit%) | |
488 | bit% += 1 | |
489 | ENDWHILE | |
490 | =bit% | |
491 | ||
90f6b7a2 | 492 | DEF FNhashmap_set(map%, key$, val%) |
c96b3a5b | 493 | LOCAL bit%, nearest% |
2e3de60f | 494 | IF FNis_empty(map%) THEN =FNhashmap_alloc_leaf(key$, val%) |
c96b3a5b | 495 | nearest% = FNhashmap_find(map%, key$) |
94b7a079 BH |
496 | IF Z$(nearest%) = key$ THEN =FNhashmap_replace(map%, key$, val%) |
497 | bit% = FNkey_bitdiff(key$, Z$(nearest%)) | |
c96b3a5b BH |
498 | =FNhashmap_insert(map%, bit%, key$, val%) |
499 | ||
500 | DEF FNhashmap_insert(map%, bit%, key$, val%) | |
501 | LOCAL left%, right% | |
502 | IF FNtype_of(map%) = &11 AND (Z%(map%,0) >> 16) < bit% THEN | |
503 | IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN | |
504 | left% = Z%(map%,1) | |
505 | right% = FNhashmap_insert(Z%(map%,2), bit%, key$, val%) | |
c592ecd1 | 506 | ELSE |
c96b3a5b BH |
507 | left% = FNhashmap_insert(Z%(map%,1), bit%, key$, val%) |
508 | right% = Z%(map%,2) | |
c592ecd1 | 509 | ENDIF |
c96b3a5b BH |
510 | =FNhashmap_alloc_node(Z%(map%,0)>>16, left%, right%) |
511 | ENDIF | |
512 | IF FNkey_bit(key$, bit%) THEN | |
513 | left% = map% | |
514 | right% = FNhashmap_alloc_leaf(key$, val%) | |
515 | ELSE | |
516 | left% = FNhashmap_alloc_leaf(key$, val%) | |
517 | right% = map% | |
c592ecd1 | 518 | ENDIF |
c96b3a5b BH |
519 | =FNhashmap_alloc_node(bit%, left%, right%) |
520 | ||
521 | ||
522 | REM Replace a known-present key in a non-empty hashmap. | |
523 | DEF FNhashmap_replace(map%, key$, val%) | |
524 | LOCAL left%, right% | |
525 | IF FNtype_of(map%) = &0A THEN =FNhashmap_alloc_leaf(key$, val%) | |
c592ecd1 | 526 | IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN |
c96b3a5b BH |
527 | left% = Z%(map%,1) |
528 | right% = FNhashmap_replace(Z%(map%,2), key$, val%) | |
c592ecd1 | 529 | ELSE |
c96b3a5b BH |
530 | left% = FNhashmap_replace(Z%(map%,1), key$, val%) |
531 | right% = Z%(map%,2) | |
c592ecd1 | 532 | ENDIF |
c96b3a5b | 533 | =FNhashmap_alloc_node(Z%(map%,0)>>16, left%, right%) |
129c2ac6 | 534 | |
11454e72 BH |
535 | DEF FNhashmap_remove(map%, key$) |
536 | LOCAL child% | |
2e3de60f | 537 | IF FNis_empty(map%) THEN =map% |
11454e72 | 538 | IF FNtype_of(map%) = &0A THEN |
94b7a079 | 539 | IF Z$(map%) = key$ THEN =FNempty_hashmap |
11454e72 BH |
540 | ENDIF |
541 | IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN | |
542 | child% = FNhashmap_remove(Z%(map%,2), key$) | |
2e3de60f | 543 | IF FNis_empty(child%) THEN =Z%(map%,1) |
11454e72 BH |
544 | =FNhashmap_alloc_node(Z%(map%,0)>>16, Z%(map%,1), child%) |
545 | ELSE | |
546 | child% = FNhashmap_remove(Z%(map%,1), key$) | |
2e3de60f | 547 | IF FNis_empty(child%) THEN =Z%(map%,2) |
11454e72 BH |
548 | =FNhashmap_alloc_node(Z%(map%,0)>>16, child%, Z%(map%,2)) |
549 | ENDIF | |
550 | ||
40999104 BH |
551 | REM FNhashmap_find finds the nearest entry in a non-empty hash-map to |
552 | REM the key requested, and returns the entire entry. | |
553 | DEF FNhashmap_find(map%, key$) | |
554 | WHILE FNtype_of(map%) = &11 | |
555 | IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN map% = Z%(map%,2) ELSE map% = Z%(map%,1) | |
556 | ENDWHILE | |
557 | =map% | |
11454e72 | 558 | |
c2d58701 | 559 | DEF FNhashmap_get(map%, key$) |
9809aa65 | 560 | IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap" |
2e3de60f | 561 | IF FNis_empty(map%) THEN =FNnil |
40999104 | 562 | map% = FNhashmap_find(map%, key$) |
94b7a079 | 563 | IF Z$(map%) = key$ THEN =FNref_local(Z%(map%,2)) ELSE =FNnil |
dbe45187 | 564 | |
61df4dc6 BH |
565 | DEF FNhashmap_contains(map%, key$) |
566 | IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap" | |
2e3de60f | 567 | IF FNis_empty(map%) THEN =FALSE |
40999104 | 568 | map% = FNhashmap_find(map%, key$) |
94b7a079 | 569 | =Z$(map%) = key$ |
61df4dc6 | 570 | |
90f6b7a2 | 571 | DEF FNhashmap_keys(map%) |
c592ecd1 BH |
572 | =FNhashmap_keys1(map%, FNempty) |
573 | ||
574 | DEF FNhashmap_keys1(map%, acc%) | |
2e3de60f | 575 | IF FNis_empty(map%) THEN =acc% |
c592ecd1 | 576 | IF FNtype_of(map%) = &0A THEN |
94b7a079 | 577 | =FNalloc_pair(FNalloc_string(Z$(map%)), acc%) |
c592ecd1 | 578 | ENDIF |
c96b3a5b | 579 | =FNhashmap_keys1(Z%(map%,1), FNhashmap_keys1(Z%(map%,2), acc%)) |
c592ecd1 | 580 | |
11454e72 BH |
581 | DEF FNhashmap_vals(map%) |
582 | =FNhashmap_vals1(map%, FNempty) | |
583 | ||
584 | DEF FNhashmap_vals1(map%, acc%) | |
2e3de60f | 585 | IF FNis_empty(map%) THEN =acc% |
11454e72 BH |
586 | IF FNtype_of(map%) = &0A THEN |
587 | =FNalloc_pair(Z%(map%,2), acc%) | |
588 | ENDIF | |
c96b3a5b | 589 | =FNhashmap_vals1(Z%(map%,1), FNhashmap_vals1(Z%(map%,2), acc%)) |
11454e72 | 590 | |
c592ecd1 | 591 | DEF PROChashmap_dump(map%) |
2e3de60f | 592 | IF FNis_empty(map%) THEN |
c592ecd1 BH |
593 | PRINT "[empty]" |
594 | ELSE | |
595 | PRINT "[-----]" | |
596 | PROChashmap_dump_internal(map%, "") | |
597 | ENDIF | |
598 | ENDPROC | |
599 | ||
600 | DEF PROChashmap_dump_internal(map%, prefix$) | |
94b7a079 | 601 | IF FNtype_of(map%) = &0A PRINT prefix$;Z$(map%) |
4fbd9d0f | 602 | IF FNtype_of(map%) = &11 THEN |
c592ecd1 BH |
603 | PRINT prefix$;"<";Z%(map%,0) >> 16;">" |
604 | PROChashmap_dump_internal(Z%(map%,1), prefix$ + "L ") | |
605 | PROChashmap_dump_internal(Z%(map%,2), prefix$ + "R ") | |
606 | ENDIF | |
607 | ENDPROC | |
b6e4898c | 608 | |
1204264c BH |
609 | REM ** Functions ** |
610 | ||
8db9135b | 611 | REM A function is represented by two cells: |
24951719 | 612 | REM Z%(x,0) AND &80 = is_macro flag |
6d1a36e8 | 613 | REM Z%(x,1) = index in Z%() of ast |
8db9135b BH |
614 | REM Z%(x,2) = y |
615 | ||
616 | REM Z%(y,1) = index in Z%() of params | |
617 | REM Z%(y,2) = index in Z%() of env | |
6d1a36e8 | 618 | |
1204264c | 619 | DEF FNis_fn(val%) |
4fbd9d0f | 620 | =FNtype_of(val%) = &15 |
1204264c | 621 | |
24951719 | 622 | DEF FNis_nonmacro_fn(val%) |
4fbd9d0f | 623 | =FNtype_of(val%) = &15 AND (Z%(val%, 0) AND &80) = &00 |
24951719 BH |
624 | |
625 | DEF FNis_macro(val%) | |
4fbd9d0f | 626 | =FNtype_of(val%) = &15 AND (Z%(val%, 0) AND &80) = &80 |
24951719 | 627 | |
9462d98d | 628 | DEF FNalloc_fn(ast%, params%, env%) |
8db9135b | 629 | LOCAL val1%, val2% |
4fbd9d0f | 630 | val1% = FNmalloc(&15) |
8db9135b | 631 | Z%(val1%,1) = ast% |
4fbd9d0f | 632 | val2% = FNmalloc(&19) |
8db9135b BH |
633 | Z%(val1%,2) = val2% |
634 | Z%(val2%,1) = params% | |
635 | Z%(val2%,2) = env% | |
636 | =val1% | |
1204264c | 637 | |
90d90dfd | 638 | DEF FNas_macro(val%) |
24951719 | 639 | IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" |
90d90dfd BH |
640 | LOCAL newval% |
641 | newval% = FNmalloc(Z%(val%,0) OR &80) | |
642 | Z%(newval%,1) = Z%(val%,1) | |
643 | Z%(newval%,2) = Z%(val%,2) | |
644 | Z%(newval%,3) = Z%(val%,3) | |
645 | =newval% | |
24951719 | 646 | |
9462d98d | 647 | DEF FNfn_ast(val%) |
1204264c | 648 | IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" |
7f6d61fc | 649 | =FNref_local(Z%(val%,1)) |
1204264c | 650 | |
9462d98d | 651 | DEF FNfn_params(val%) |
1204264c | 652 | IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" |
8db9135b | 653 | =FNref_local(Z%(Z%(val%,2),1)) |
1204264c BH |
654 | |
655 | DEF FNfn_env(val%) | |
656 | IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function" | |
8db9135b | 657 | =FNref_local(Z%(Z%(val%,2),2)) |
1204264c | 658 | |
940092c6 BH |
659 | REM ** Atoms ** |
660 | ||
661 | REM Z%(x,1) = index in Z% of current referent | |
662 | ||
663 | DEF FNis_atom(val%) | |
ec8336b0 | 664 | =FNtype_of(val%) = &01 |
940092c6 BH |
665 | |
666 | DEF FNalloc_atom(contents%) | |
667 | LOCAL val% | |
ec8336b0 | 668 | val% = FNmalloc(&01) |
940092c6 BH |
669 | Z%(val%,1) = contents% |
670 | =val% | |
671 | ||
940092c6 BH |
672 | DEF FNatom_deref(val%) |
673 | =FNref_local(Z%(val%,1)) | |
674 | ||
675 | DEF PROCatom_reset(val%, contents%) | |
676 | Z%(val%,1) = contents% | |
677 | ENDPROC | |
678 | ||
dbe45187 BH |
679 | REM ** Environments ** |
680 | ||
6d1a36e8 BH |
681 | REM Z%(x,1) = index in Z% of hash-map |
682 | REM Z%(x,2) = index in Z% of outer environment | |
683 | ||
dbe45187 | 684 | DEF FNis_environment(val%) |
4fbd9d0f | 685 | =FNtype_of(val%) = &0D |
dbe45187 BH |
686 | |
687 | DEF FNalloc_environment(outer%) | |
688 | LOCAL val% | |
4fbd9d0f | 689 | val% = FNmalloc(&0D) |
4b811acc BH |
690 | Z%(val%,1) = FNempty_hashmap |
691 | Z%(val%,2) = outer% | |
dbe45187 BH |
692 | =val% |
693 | ||
694 | DEF FNenvironment_data(val%) | |
695 | IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment" | |
7f6d61fc | 696 | =FNref_local(Z%(val%,1)) |
dbe45187 BH |
697 | |
698 | DEF PROCenvironment_set_data(val%, data%) | |
699 | IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment" | |
4b811acc | 700 | Z%(val%,1) = data% |
dbe45187 BH |
701 | ENDPROC |
702 | ||
703 | DEF FNenvironment_outer(val%) | |
704 | IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment" | |
7f6d61fc | 705 | =FNref_local(Z%(val%,2)) |
dd3d5ad7 BH |
706 | |
707 | REM Local Variables: | |
708 | REM indent-tabs-mode: nil | |
709 | REM End: |