2 <GDECL (FCODE-CHANNEL) <OR FALSE CHANNEL> (FCODE-BUFFER) UVECTOR (FCODE-BUFFER-PAGE FCODE-FILE-POINTER MAX-BUFFERS) FIX (FCODE-BUFFER-CHANGED?) BOOLEAN (FCODE-LIST) <LIST [REST <OR FIX CODEVEC>]> (FCURRENT-CODE) CODEVEC (FCODE-COUNT FCURRENT-WORD FBYTE-OFFSET FSHIFT) FIX>
6 <MSETG FCODEVEC-LENGTH <* ,CODEVEC-LENGTH 4>>
9 <GFCN
\1aINIT-FINAL-CODE ("VALUE" FIX)>
12 <UUBLOCK <TYPE-CODE UVECTOR> 1024 = TEMP4>
14 <LOOP (TEMP5 VALUE LENGTH)>
16 <EMPUU? TEMP5 + ISTRE7>
18 <RESTUU TEMP5 1 = TEMP5>
21 <SETG 'FCURRENT-CODE TEMP4>
23 <GVAL 'FCURRENT-CODE = TEMP4>
24 <CONS TEMP4 () = TEMP4>
25 <SETG 'FCODE-LIST TEMP4>
27 <SETG 'FCODE-CHANNEL %<>>
28 <UUBLOCK <TYPE-CODE UVECTOR> 1024 = TEMP4>
30 <LOOP (TEMP5 VALUE LENGTH)>
32 <EMPUU? TEMP5 + ISTRE9>
34 <RESTUU TEMP5 1 = TEMP5>
37 <SETG 'FCODE-BUFFER TEMP4>
39 <SETG 'FCODE-BUFFER-PAGE -1>
40 <SETG 'FCODE-FILE-POINTER 0>
42 <SETG 'FCURRENT-WORD 0>
43 <SETG 'FBYTE-OFFSET 1>
46 <END
\1aINIT-FINAL-CODE>
49 <GFCN
\1aRESET-FCODE ("VALUE" FIX)>
55 <GVAL 'FCODE-LIST = TEMP9>
56 <NTHL TEMP9 1 = TEMP9>
57 <TYPE? TEMP9 <TYPE-CODE FIX> - EXIT4>
59 <GVAL 'FCODE-LIST = TEMP9>
60 <RESTL TEMP9 1 = TEMP9 (TYPE LIST)>
61 <SETG 'FCODE-LIST TEMP9>
65 <GVAL 'FCODE-LIST = TEMP9>
66 <NTHL TEMP9 1 = TEMP9 (TYPE UVECTOR)>
67 <SETG 'FCURRENT-CODE TEMP9>
69 <SETG 'FCODE-BUFFER-PAGE -1>
70 <GVAL 'FCODE-CHANNEL = TEMP9>
71 <TYPE? TEMP9 <TYPE-CODE FALSE> + PHRASE12>
74 <GVAL 'FCODE-CHANNEL = STACK>
76 <SETG 'FCODE-CHANNEL %<>>
78 <SETG 'FCODE-FILE-POINTER 0>
80 <SETG 'FCURRENT-WORD 0>
81 <SETG 'FBYTE-OFFSET 1>
87 <GFCN
\1aOPEN-FCODE-FILE ("VALUE" ATOM)>
90 <FRAME '
\1aCHANNEL-OPEN>
95 <CALL '
\1aCHANNEL-OPEN 4 = CH4>
96 <TYPE? CH4 <TYPE-CODE FALSE> - PHRASE6>
101 <CALL '
\1aSYS-ERR 2 = STACK>
104 <SETG 'FCODE-CHANNEL CH4>
107 <END
\1aOPEN-FCODE-FILE>
110 <GFCN
\1aWRITE-FCODE ("VALUE" ATOM UVECTOR FIX) BUF4 PAGE5>
113 <GVAL 'FCODE-CHANNEL = CH6>
114 <GVAL 'FCODE-CHANNEL = CH6>
115 <TYPE? CH6 <TYPE-CODE FALSE> - PHRASE8>
117 <FRAME '
\1aOPEN-FCODE-FILE>
118 <CALL '
\1aOPEN-FCODE-FILE 0>
120 <GVAL 'FCODE-CHANNEL = CH6>
123 <LSH PAGE5 10 = STACK (TYPE FIX)>
126 <FRAME '
\1aCHANNEL-OP>
132 <CALL '
\1aCHANNEL-OP 3>
137 <GFCN
\1aREAD-FCODE ("VALUE" ANY ANY ANY) BUF4 PAGE5>
140 <GVAL 'FCODE-CHANNEL = CH6>
143 <LSH PAGE5 10 = STACK (TYPE FIX)>
146 <FRAME '
\1aCHANNEL-OP>
152 <CALL '
\1aCHANNEL-OP 3 = CH6>
158 <GFCN
\1aADD-BYTE-TO-FCODE ("VALUE" FIX FIX) BYT4>
159 <TEMP CCODE6 CWORD7:FIX OFF8:FIX SHFT9:FIX TEMP15>
161 <GVAL 'FCURRENT-CODE = CCODE6>
162 <GVAL 'FCURRENT-WORD = CWORD7>
163 <GVAL 'FBYTE-OFFSET = OFF8>
164 <GVAL 'FSHIFT = SHFT9>
165 <SUB SHFT9 8 = SHFT9 (TYPE FIX)>
166 <GRTR? SHFT9 0 - PHRASE12 (TYPE FIX)>
167 <LSH BYT4 SHFT9 = TEMP15 (TYPE FIX)>
169 <OR CWORD7 TEMP15 = CCODE6>
171 <SETG 'FCURRENT-WORD CCODE6>
175 <GVAL 'FCODE-COUNT = SHFT9>
176 <EMPUU? CCODE6 - PHRASE25 (TYPE UVECTOR)>
177 <GVAL 'FCODE-LIST = CCODE6>
178 <DIV SHFT9 1024 = TEMP15 (TYPE FIX)>
179 <SUB TEMP15 1 = TEMP15 (TYPE FIX)>
180 <GRTR? TEMP15 0 - RESTL21 (TYPE FIX)>
181 <LOOP (CCODE6 VALUE) (TEMP15 VALUE)>
184 <RESTL CCODE6 1 = CCODE6 (TYPE LIST)>
185 <SUB TEMP15 1 = TEMP15 (TYPE FIX)>
186 <GRTR? TEMP15 0 + RESTL20 (TYPE FIX)>
190 <EMPL? TEMP15 + PHRASE23>
191 <RESTL TEMP15 1 = CCODE6 (TYPE LIST)>
192 <EMPL? CCODE6 - PHRASE23>
194 <FRAME '
\1aNEW-FCODE-BUFFER>
195 <CALL '
\1aNEW-FCODE-BUFFER 0 = CCODE6>
198 <RESTL TEMP15 1 = CCODE6 (TYPE LIST)>
200 <NTHL CCODE6 1 = CCODE6>
202 <OR CWORD7 BYT4 = BYT4>
204 <PUTUU CCODE6 1 BYT4>
206 <RESTUU CCODE6 1 = CCODE6 (TYPE UVECTOR)>
207 <SETG 'FCURRENT-CODE CCODE6>
209 <ADD SHFT9 1 = TEMP15 (TYPE FIX)>
211 <SETG 'FCODE-COUNT TEMP15>
213 <SETG 'FCURRENT-WORD 0>
214 <SET SHFT9 32 (TYPE FIX)>
218 <ADD OFF8 1 = TEMP15 (TYPE FIX)>
219 <SETG 'FBYTE-OFFSET TEMP15>
223 <END
\1aADD-BYTE-TO-FCODE>
226 <GFCN
\1aNEW-FCODE-BUFFER ("VALUE" UVECTOR)>
227 <TEMP RLST4:LIST BPAGE6 TEMP9 TEMP10 BUF21 CCODE5>
229 <GVAL 'FCODE-LIST = RLST4>
230 <GVAL 'FCODE-FILE-POINTER = BPAGE6>
231 <GVAL 'MAX-BUFFERS = TEMP9>
232 <LENL RLST4 = TEMP10 (TYPE FIX)>
233 <LESS? TEMP9 TEMP10 - PHRASE8 (TYPE FIX)>
235 <SET TEMP9 RLST4 (TYPE LIST)>
239 <EMPL? TEMP9 + MAPAP15>
241 <NTHL TEMP10 1 = BUF21>
242 <TYPE? BUF21 <TYPE-CODE UVECTOR> - PHRASE23>
243 <PUTL TEMP10 1 BPAGE6>
249 <RESTL TEMP9 1 = TEMP9 (TYPE LIST)>
252 <FRAME '
\1aWRITE-FCODE>
255 <CALL '
\1aWRITE-FCODE 2>
256 <ADD BPAGE6 1 = BUF21 (TYPE FIX)>
258 <SETG 'FCODE-FILE-POINTER BUF21>
264 <RESTL BUF21 1 = TEMP9 (TYPE LIST)>
265 <EMPL? TEMP9 + TAG27>
270 <CONS CCODE5 () = BPAGE6>
271 <PUTREST BUF21 BPAGE6>
276 <UUBLOCK <TYPE-CODE UVECTOR> 1024 = CCODE5>
278 <LOOP (BPAGE6 VALUE LENGTH)>
280 <EMPUU? BPAGE6 + ISTRE30>
282 <RESTUU BPAGE6 1 = BPAGE6>
287 <LOOP (BPAGE6 VALUE)>
289 <RESTL BPAGE6 1 = TEMP9 (TYPE LIST)>
290 <EMPL? TEMP9 + TAG32>
295 <CONS CCODE5 () = TEMP9>
296 <PUTREST BPAGE6 TEMP9>
300 <END
\1aNEW-FCODE-BUFFER>
303 <GFCN
\1aPUT-FCODE ("VALUE" <OR ATOM FIX> FIX FIX) DEST4 VAL5>
304 <TEMP CL6 OFF7:FIX CWORD8:FIX SHFT9:FIX TEMP13>
306 <GVAL 'FCODE-LIST = CL6>
307 <GVAL 'FBYTE-OFFSET = OFF7>
308 <GVAL 'FCURRENT-WORD = CWORD8>
309 <GVAL 'FSHIFT = SHFT9>
310 <ADD OFF7 2 = TEMP13 (TYPE FIX)>
312 <DIV TEMP13 4 = TEMP13 (TYPE FIX)>
313 <ADD DEST4 3 = OFF7 (TYPE FIX)>
314 <DIV OFF7 4 = OFF7 (TYPE FIX)>
315 <VEQUAL? TEMP13 OFF7 - PHRASE11 (TYPE FIX)>
317 <VEQUAL? SHFT9 32 + PHRASE11 (TYPE FIX)>
319 <ADD DEST4 3 = TEMP13 (TYPE FIX)>
321 <AND TEMP13 3 = TEMP13>
322 <ADD TEMP13 1 = TEMP13 (TYPE FIX)>
323 <NTHUU ![24 16 8 0!] TEMP13 = TEMP13 (TYPE FIX)>
324 <PUTBITS CWORD8 8 TEMP13 VAL5 = TEMP13>
326 <SETG 'FCURRENT-WORD TEMP13>
335 <GRTR? CWORD8 4096 + PHRASE22 (TYPE FIX)>
336 <ADD CWORD8 3 = TEMP13 (TYPE FIX)>
337 <DIV TEMP13 4 = OFF7 (TYPE FIX)>
339 <ADD CWORD8 3 = TEMP13 (TYPE FIX)>
341 <AND TEMP13 3 = TEMP13>
342 <ADD TEMP13 1 = TEMP13 (TYPE FIX)>
343 <NTHUU ![24 16 8 0!] TEMP13 = SHFT9 (TYPE FIX)>
345 <NTHL CL6 1 = TEMP13>
346 <TYPE? TEMP13 <TYPE-CODE UVECTOR> - PHRASE25>
348 <NTHL CL6 1 = CL6 (TYPE UVECTOR)>
351 <FRAME '
\1aGET-FCODE-BUFFER>
352 <NTHL CL6 1 = STACK (TYPE FIX)>
355 <CALL '
\1aGET-FCODE-BUFFER 2 = CL6>
357 <NTHUU CL6 OFF7 = TEMP13 (TYPE FIX)>
358 <PUTBITS TEMP13 8 SHFT9 VAL5 = CWORD8>
359 <DEAD TEMP13 SHFT9 VAL5>
360 <PUTUU CL6 OFF7 CWORD8>
361 <DEAD CL6 OFF7 CWORD8>
364 <RESTL CL6 1 = CL6 (TYPE LIST)>
365 <EMPL? CL6 - PHRASE28 (TYPE LIST)>
367 <PUSH 'OUT-OF-BOUNDS>
371 <SUB CWORD8 4096 = CWORD8 (TYPE FIX)>
376 <GFCN
\1aNTH-FCODE ("VALUE" FIX FIX) DEST4>
377 <TEMP CL5 OFF7:FIX CWORD8:FIX SHFT9:FIX TEMP13>
379 <GVAL 'FCODE-LIST = CL5>
380 <GVAL 'FBYTE-OFFSET = OFF7>
381 <GVAL 'FCURRENT-WORD = CWORD8>
382 <GVAL 'FSHIFT = SHFT9>
383 <ADD OFF7 2 = TEMP13 (TYPE FIX)>
385 <DIV TEMP13 4 = TEMP13 (TYPE FIX)>
386 <ADD DEST4 3 = OFF7 (TYPE FIX)>
387 <DIV OFF7 4 = OFF7 (TYPE FIX)>
388 <VEQUAL? TEMP13 OFF7 - PHRASE11 (TYPE FIX)>
390 <VEQUAL? SHFT9 32 + PHRASE11 (TYPE FIX)>
392 <ADD DEST4 3 = TEMP13 (TYPE FIX)>
394 <AND TEMP13 3 = TEMP13>
395 <ADD TEMP13 1 = TEMP13 (TYPE FIX)>
396 <NTHUU ![24 16 8 0!] TEMP13 = TEMP13 (TYPE FIX)>
397 <GETBITS CWORD8 8 TEMP13 = TEMP13>
406 <GRTR? CWORD8 4096 + PHRASE21 (TYPE FIX)>
407 <ADD CWORD8 3 = TEMP13 (TYPE FIX)>
408 <DIV TEMP13 4 = OFF7 (TYPE FIX)>
410 <ADD CWORD8 3 = TEMP13 (TYPE FIX)>
412 <AND TEMP13 3 = TEMP13>
413 <ADD TEMP13 1 = TEMP13 (TYPE FIX)>
414 <NTHUU ![24 16 8 0!] TEMP13 = SHFT9 (TYPE FIX)>
416 <NTHL CL5 1 = TEMP13>
417 <TYPE? TEMP13 <TYPE-CODE UVECTOR> - PHRASE24>
419 <NTHL CL5 1 = CL5 (TYPE UVECTOR)>
422 <FRAME '
\1aGET-FCODE-BUFFER>
423 <NTHL CL5 1 = STACK (TYPE FIX)>
426 <CALL '
\1aGET-FCODE-BUFFER 2 = CL5>
428 <NTHUU CL5 OFF7 = TEMP13 (TYPE FIX)>
430 <GETBITS TEMP13 8 SHFT9 = OFF7>
435 <RESTL CL5 1 = CL5 (TYPE LIST)>
436 <EMPL? CL5 - PHRASE27 (TYPE LIST)>
438 <PUSH 'OUT-OF-BOUNDS>
443 <SUB CWORD8 4096 = CWORD8 (TYPE FIX)>
448 <GFCN
\1aGET-FCODE-BUFFER ("VALUE" UVECTOR FIX ATOM) PAGE4 MODE5>
451 <GVAL 'FCODE-BUFFER-PAGE = TEMP8>
452 <VEQUAL? PAGE4 TEMP8 - PHRASE7 (TYPE FIX)>
454 <VEQUAL? MODE5 'WRITE - PHRASE20>
456 <SETG 'FCODE-BUFFER-CHANGED? 'T>
459 <GVAL 'FCODE-BUFFER-PAGE = TEMP8>
460 <LESS? TEMP8 0 + PHRASE12 (TYPE FIX)>
462 <GVAL 'FCODE-BUFFER-CHANGED? = TEMP8>
463 <TYPE? TEMP8 <TYPE-CODE FALSE> + PHRASE12>
465 <FRAME '
\1aWRITE-FCODE>
466 <GVAL 'FCODE-BUFFER = STACK>
467 <GVAL 'FCODE-BUFFER-PAGE = STACK>
468 <CALL '
\1aWRITE-FCODE 2>
470 <FRAME '
\1aREAD-FCODE>
471 <GVAL 'FCODE-BUFFER = STACK>
473 <CALL '
\1aREAD-FCODE 2>
474 <SETG 'FCODE-BUFFER-PAGE PAGE4>
476 <VEQUAL? MODE5 'READ - PHRASE19>
478 <SETG 'FCODE-BUFFER-CHANGED? %<>>
481 <SETG 'FCODE-BUFFER-CHANGED? 'T>
483 <GVAL 'FCODE-BUFFER = TEMP8>
486 <END
\1aGET-FCODE-BUFFER>
489 <GFCN
\1aADVANCE-FCODE ("VALUE" ATOM FIX) NUM4>
495 <FRAME '
\1aADD-BYTE-TO-FCODE>
497 <CALL '
\1aADD-BYTE-TO-FCODE 1>
498 <SUB NUM4 1 = NUM4 (TYPE FIX)>
499 <VEQUAL? NUM4 0 - AGAIN8 (TYPE FIX)>
501 <END
\1aADVANCE-FCODE>