Machine-Independent MDL for TOPS-20 and VAX.
[pdp10-muddle.git] / mim / development / mim / vaxc / fcode.mima
diff --git a/mim/development/mim/vaxc/fcode.mima b/mim/development/mim/vaxc/fcode.mima
new file mode 100644 (file)
index 0000000..2db1939
--- /dev/null
@@ -0,0 +1,501 @@
+
+<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>
+
+<SETG MAX-BUFFERS 5>
+
+<MSETG FCODEVEC-LENGTH <* ,CODEVEC-LENGTH 4>>
+
+#WORD *11314717470*
+                   <GFCN \1aINIT-FINAL-CODE ("VALUE" FIX)>
+                   <TEMP TEMP4 TEMP5>
+                   <INTGO>
+                   <UUBLOCK <TYPE-CODE UVECTOR> 1024 = TEMP4>
+                   <SET TEMP5 TEMP4>
+                   <LOOP (TEMP5 VALUE LENGTH)>
+ISTR6
+                   <EMPUU? TEMP5 + ISTRE7>
+                   <PUTUU TEMP5 1 0>
+                   <RESTUU TEMP5 1 = TEMP5>
+                   <JUMP + ISTR6>
+ISTRE7
+                   <SETG 'FCURRENT-CODE TEMP4>
+                   <DEAD TEMP4>
+                   <GVAL 'FCURRENT-CODE = TEMP4>
+                   <CONS TEMP4 () = TEMP4>
+                   <SETG 'FCODE-LIST TEMP4>
+                   <DEAD TEMP4>
+                   <SETG 'FCODE-CHANNEL %<>>
+                   <UUBLOCK <TYPE-CODE UVECTOR> 1024 = TEMP4>
+                   <SET TEMP5 TEMP4>
+                   <LOOP (TEMP5 VALUE LENGTH)>
+ISTR8
+                   <EMPUU? TEMP5 + ISTRE9>
+                   <PUTUU TEMP5 1 0>
+                   <RESTUU TEMP5 1 = TEMP5>
+                   <JUMP + ISTR8>
+ISTRE9
+                   <SETG 'FCODE-BUFFER TEMP4>
+                   <DEAD TEMP4>
+                   <SETG 'FCODE-BUFFER-PAGE -1>
+                   <SETG 'FCODE-FILE-POINTER 0>
+                   <SETG 'FCODE-COUNT 1>
+                   <SETG 'FCURRENT-WORD 0>
+                   <SETG 'FBYTE-OFFSET 1>
+                   <SETG 'FSHIFT 32>
+                   <RETURN 32>
+                   <END \1aINIT-FINAL-CODE>
+
+#WORD *3174377565*
+                   <GFCN \1aRESET-FCODE ("VALUE" FIX)>
+                   <TEMP TEMP9>
+                   <INTGO>
+                   <LOOP>
+AGAIN6
+                   <INTGO>
+                   <GVAL 'FCODE-LIST = TEMP9>
+                   <NTHL TEMP9 1 = TEMP9>
+                   <TYPE? TEMP9 <TYPE-CODE FIX> - EXIT4>
+                   <DEAD TEMP9>
+                   <GVAL 'FCODE-LIST = TEMP9>
+                   <RESTL TEMP9 1 = TEMP9 (TYPE LIST)>
+                   <SETG 'FCODE-LIST TEMP9>
+                   <DEAD TEMP9>
+                   <JUMP + AGAIN6>
+EXIT4
+                   <GVAL 'FCODE-LIST = TEMP9>
+                   <NTHL TEMP9 1 = TEMP9 (TYPE UVECTOR)>
+                   <SETG 'FCURRENT-CODE TEMP9>
+                   <DEAD TEMP9>
+                   <SETG 'FCODE-BUFFER-PAGE -1>
+                   <GVAL 'FCODE-CHANNEL = TEMP9>
+                   <TYPE? TEMP9 <TYPE-CODE FALSE> + PHRASE12>
+                   <DEAD TEMP9>
+                   <FRAME '\1aCLOSE>
+                   <GVAL 'FCODE-CHANNEL = STACK>
+                   <CALL '\1aCLOSE 1>
+                   <SETG 'FCODE-CHANNEL %<>>
+PHRASE12
+                   <SETG 'FCODE-FILE-POINTER 0>
+                   <SETG 'FCODE-COUNT 1>
+                   <SETG 'FCURRENT-WORD 0>
+                   <SETG 'FBYTE-OFFSET 1>
+                   <SETG 'FSHIFT 32>
+                   <RETURN 32>
+                   <END \1aRESET-FCODE>
+
+#WORD *21427501014*
+                   <GFCN \1aOPEN-FCODE-FILE ("VALUE" ATOM)>
+                   <TEMP CH4>
+                   <INTGO>
+                   <FRAME '\1aCHANNEL-OPEN>
+                   <PUSH 'DISK>
+                   <PUSH "CACHE.FILE">
+                   <PUSH "CREATE">
+                   <PUSH "BINARY">
+                   <CALL '\1aCHANNEL-OPEN 4 = CH4>
+                   <TYPE? CH4 <TYPE-CODE FALSE> - PHRASE6>
+                   <FRAME '\1aERROR>
+                   <FRAME '\1aSYS-ERR>
+                   <PUSH "CACHE.FILE">
+                   <PUSH CH4>
+                   <CALL '\1aSYS-ERR 2 = STACK>
+                   <CALL '\1aERROR 1>
+PHRASE6
+                   <SETG 'FCODE-CHANNEL CH4>
+                   <DEAD CH4>
+                   <RETURN 'T>
+                   <END \1aOPEN-FCODE-FILE>
+
+#WORD *22104746003*
+                   <GFCN \1aWRITE-FCODE ("VALUE" ATOM UVECTOR FIX) BUF4 PAGE5>
+                   <TEMP CH6>
+                   <INTGO>
+                   <GVAL 'FCODE-CHANNEL = CH6>
+                   <GVAL 'FCODE-CHANNEL = CH6>
+                   <TYPE? CH6 <TYPE-CODE FALSE> - PHRASE8>
+                   <DEAD CH6>
+                   <FRAME '\1aOPEN-FCODE-FILE>
+                   <CALL '\1aOPEN-FCODE-FILE 0>
+PHRASE8
+                   <GVAL 'FCODE-CHANNEL = CH6>
+                   <FRAME '\1aACCESS>
+                   <PUSH CH6>
+                   <LSH PAGE5 10 = STACK (TYPE FIX)>
+                   <DEAD PAGE5>
+                   <CALL '\1aACCESS 2>
+                   <FRAME '\1aCHANNEL-OP>
+                   <PUSH CH6>
+                   <DEAD CH6>
+                   <PUSH 'WRITE-BUFFER>
+                   <PUSH BUF4>
+                   <DEAD BUF4>
+                   <CALL '\1aCHANNEL-OP 3>
+                   <RETURN 'T>
+                   <END \1aWRITE-FCODE>
+
+#WORD *12243145154*
+                   <GFCN \1aREAD-FCODE ("VALUE" ANY ANY ANY) BUF4 PAGE5>
+                   <TEMP CH6>
+                   <INTGO>
+                   <GVAL 'FCODE-CHANNEL = CH6>
+                   <FRAME '\1aACCESS>
+                   <PUSH CH6>
+                   <LSH PAGE5 10 = STACK (TYPE FIX)>
+                   <DEAD PAGE5>
+                   <CALL '\1aACCESS 2>
+                   <FRAME '\1aCHANNEL-OP>
+                   <PUSH CH6>
+                   <DEAD CH6>
+                   <PUSH 'READ-BUFFER>
+                   <PUSH BUF4>
+                   <DEAD BUF4>
+                   <CALL '\1aCHANNEL-OP 3 = CH6>
+                   <RETURN CH6>
+                   <DEAD CH6>
+                   <END \1aREAD-FCODE>
+
+#WORD *34505060006*
+                   <GFCN \1aADD-BYTE-TO-FCODE ("VALUE" FIX FIX) BYT4>
+                   <TEMP CCODE6 CWORD7:FIX OFF8:FIX SHFT9:FIX TEMP15>
+                   <INTGO>
+                   <GVAL 'FCURRENT-CODE = CCODE6>
+                   <GVAL 'FCURRENT-WORD = CWORD7>
+                   <GVAL 'FBYTE-OFFSET = OFF8>
+                   <GVAL 'FSHIFT = SHFT9>
+                   <SUB SHFT9 8 = SHFT9 (TYPE FIX)>
+                   <GRTR? SHFT9 0 - PHRASE12 (TYPE FIX)>
+                   <LSH BYT4 SHFT9 = TEMP15 (TYPE FIX)>
+                   <DEAD BYT4>
+                   <OR CWORD7 TEMP15 = CCODE6>
+                   <DEAD CWORD7 TEMP15>
+                   <SETG 'FCURRENT-WORD CCODE6>
+                   <DEAD CCODE6>
+                   <JUMP + PHRASE17>
+PHRASE12
+                   <GVAL 'FCODE-COUNT = SHFT9>
+                   <EMPUU? CCODE6 - PHRASE25 (TYPE UVECTOR)>
+                   <GVAL 'FCODE-LIST = CCODE6>
+                   <DIV SHFT9 1024 = TEMP15 (TYPE FIX)>
+                   <SUB TEMP15 1 = TEMP15 (TYPE FIX)>
+                   <GRTR? TEMP15 0 - RESTL21 (TYPE FIX)>
+                   <LOOP (CCODE6 VALUE) (TEMP15 VALUE)>
+RESTL20
+                   <INTGO>
+                   <RESTL CCODE6 1 = CCODE6 (TYPE LIST)>
+                   <SUB TEMP15 1 = TEMP15 (TYPE FIX)>
+                   <GRTR? TEMP15 0 + RESTL20 (TYPE FIX)>
+RESTL21
+                   <SET TEMP15 CCODE6>
+                   <DEAD CCODE6>
+                   <EMPL? TEMP15 + PHRASE23>
+                   <RESTL TEMP15 1 = CCODE6 (TYPE LIST)>
+                   <EMPL? CCODE6 - PHRASE23>
+                   <DEAD CCODE6>
+                   <FRAME '\1aNEW-FCODE-BUFFER>
+                   <CALL '\1aNEW-FCODE-BUFFER 0 = CCODE6>
+                   <JUMP + PHRASE25>
+PHRASE23
+                   <RESTL TEMP15 1 = CCODE6 (TYPE LIST)>
+                   <DEAD TEMP15>
+                   <NTHL CCODE6 1 = CCODE6>
+PHRASE25
+                   <OR CWORD7 BYT4 = BYT4>
+                   <DEAD CWORD7>
+                   <PUTUU CCODE6 1 BYT4>
+                   <DEAD BYT4>
+                   <RESTUU CCODE6 1 = CCODE6 (TYPE UVECTOR)>
+                   <SETG 'FCURRENT-CODE CCODE6>
+                   <DEAD CCODE6>
+                   <ADD SHFT9 1 = TEMP15 (TYPE FIX)>
+                   <DEAD SHFT9>
+                   <SETG 'FCODE-COUNT TEMP15>
+                   <DEAD TEMP15>
+                   <SETG 'FCURRENT-WORD 0>
+                   <SET SHFT9 32 (TYPE FIX)>
+PHRASE17
+                   <SETG 'FSHIFT SHFT9>
+                   <DEAD SHFT9>
+                   <ADD OFF8 1 = TEMP15 (TYPE FIX)>
+                   <SETG 'FBYTE-OFFSET TEMP15>
+                   <DEAD TEMP15>
+                   <RETURN OFF8>
+                   <DEAD OFF8>
+                   <END \1aADD-BYTE-TO-FCODE>
+
+#WORD *21420556560*
+                   <GFCN \1aNEW-FCODE-BUFFER ("VALUE" UVECTOR)>
+                   <TEMP RLST4:LIST BPAGE6 TEMP9 TEMP10 BUF21 CCODE5>
+                   <INTGO>
+                   <GVAL 'FCODE-LIST = RLST4>
+                   <GVAL 'FCODE-FILE-POINTER = BPAGE6>
+                   <GVAL 'MAX-BUFFERS = TEMP9>
+                   <LENL RLST4 = TEMP10 (TYPE FIX)>
+                   <LESS? TEMP9 TEMP10 - PHRASE8 (TYPE FIX)>
+                   <DEAD TEMP9>
+                   <SET TEMP9 RLST4 (TYPE LIST)>
+                   <LOOP>
+MAP12
+                   <INTGO>
+                   <EMPL? TEMP9 + MAPAP15>
+                   <SET TEMP10 TEMP9>
+                   <NTHL TEMP10 1 = BUF21>
+                   <TYPE? BUF21 <TYPE-CODE UVECTOR> - PHRASE23>
+                   <PUTL TEMP10 1 BPAGE6>
+                   <DEAD TEMP10>
+                   <SET CCODE5 BUF21>
+                   <DEAD BUF21>
+                   <JUMP + MAPAP15>
+PHRASE23
+                   <RESTL TEMP9 1 = TEMP9 (TYPE LIST)>
+                   <JUMP + MAP12>
+MAPAP15
+                   <FRAME '\1aWRITE-FCODE>
+                   <PUSH CCODE5>
+                   <PUSH BPAGE6>
+                   <CALL '\1aWRITE-FCODE 2>
+                   <ADD BPAGE6 1 = BUF21 (TYPE FIX)>
+                   <DEAD BPAGE6>
+                   <SETG 'FCODE-FILE-POINTER BUF21>
+                   <DEAD BUF21>
+                   <SET BUF21 RLST4>
+                   <DEAD RLST4>
+                   <LOOP (BUF21 VALUE)>
+TAG26
+                   <RESTL BUF21 1 = TEMP9 (TYPE LIST)>
+                   <EMPL? TEMP9 + TAG27>
+                   <SET BUF21 TEMP9>
+                   <DEAD TEMP9>
+                   <JUMP + TAG26>
+TAG27
+                   <CONS CCODE5 () = BPAGE6>
+                   <PUTREST BUF21 BPAGE6>
+                   <DEAD BUF21 BPAGE6>
+                   <RETURN CCODE5>
+                   <DEAD CCODE5>
+PHRASE8
+                   <UUBLOCK <TYPE-CODE UVECTOR> 1024 = CCODE5>
+                   <SET BPAGE6 CCODE5>
+                   <LOOP (BPAGE6 VALUE LENGTH)>
+ISTR29
+                   <EMPUU? BPAGE6 + ISTRE30>
+                   <PUTUU BPAGE6 1 0>
+                   <RESTUU BPAGE6 1 = BPAGE6>
+                   <JUMP + ISTR29>
+ISTRE30
+                   <SET BPAGE6 RLST4>
+                   <DEAD RLST4>
+                   <LOOP (BPAGE6 VALUE)>
+TAG31
+                   <RESTL BPAGE6 1 = TEMP9 (TYPE LIST)>
+                   <EMPL? TEMP9 + TAG32>
+                   <SET BPAGE6 TEMP9>
+                   <DEAD TEMP9>
+                   <JUMP + TAG31>
+TAG32
+                   <CONS CCODE5 () = TEMP9>
+                   <PUTREST BPAGE6 TEMP9>
+                   <DEAD BPAGE6 TEMP9>
+                   <RETURN CCODE5>
+                   <DEAD CCODE5>
+                   <END \1aNEW-FCODE-BUFFER>
+
+#WORD *21516276332*
+                   <GFCN \1aPUT-FCODE ("VALUE" <OR ATOM FIX> FIX FIX) DEST4 VAL5>
+                   <TEMP CL6 OFF7:FIX CWORD8:FIX SHFT9:FIX TEMP13>
+                   <INTGO>
+                   <GVAL 'FCODE-LIST = CL6>
+                   <GVAL 'FBYTE-OFFSET = OFF7>
+                   <GVAL 'FCURRENT-WORD = CWORD8>
+                   <GVAL 'FSHIFT = SHFT9>
+                   <ADD OFF7 2 = TEMP13 (TYPE FIX)>
+                   <DEAD OFF7>
+                   <DIV TEMP13 4 = TEMP13 (TYPE FIX)>
+                   <ADD DEST4 3 = OFF7 (TYPE FIX)>
+                   <DIV OFF7 4 = OFF7 (TYPE FIX)>
+                   <VEQUAL? TEMP13 OFF7 - PHRASE11 (TYPE FIX)>
+                   <DEAD TEMP13>
+                   <VEQUAL? SHFT9 32 + PHRASE11 (TYPE FIX)>
+                   <DEAD SHFT9>
+                   <ADD DEST4 3 = TEMP13 (TYPE FIX)>
+                   <DEAD DEST4>
+                   <AND TEMP13 3 = TEMP13>
+                   <ADD TEMP13 1 = TEMP13 (TYPE FIX)>
+                   <NTHUU ![24 16 8 0!] TEMP13 = TEMP13 (TYPE FIX)>
+                   <PUTBITS CWORD8 8 TEMP13 VAL5 = TEMP13>
+                   <DEAD CWORD8 VAL5>
+                   <SETG 'FCURRENT-WORD TEMP13>
+                   <RETURN TEMP13>
+                   <DEAD TEMP13>
+PHRASE11
+                   <SET CWORD8 DEST4>
+                   <DEAD DEST4>
+                   <LOOP>
+AGAIN20
+                   <INTGO>
+                   <GRTR? CWORD8 4096 + PHRASE22 (TYPE FIX)>
+                   <ADD CWORD8 3 = TEMP13 (TYPE FIX)>
+                   <DIV TEMP13 4 = OFF7 (TYPE FIX)>
+                   <DEAD TEMP13>
+                   <ADD CWORD8 3 = TEMP13 (TYPE FIX)>
+                   <DEAD CWORD8>
+                   <AND TEMP13 3 = TEMP13>
+                   <ADD TEMP13 1 = TEMP13 (TYPE FIX)>
+                   <NTHUU ![24 16 8 0!] TEMP13 = SHFT9 (TYPE FIX)>
+                   <DEAD TEMP13>
+                   <NTHL CL6 1 = TEMP13>
+                   <TYPE? TEMP13 <TYPE-CODE UVECTOR> - PHRASE25>
+                   <DEAD TEMP13>
+                   <NTHL CL6 1 = CL6 (TYPE UVECTOR)>
+                   <JUMP + COND24>
+PHRASE25
+                   <FRAME '\1aGET-FCODE-BUFFER>
+                   <NTHL CL6 1 = STACK (TYPE FIX)>
+                   <DEAD CL6>
+                   <PUSH 'WRITE>
+                   <CALL '\1aGET-FCODE-BUFFER 2 = CL6>
+COND24
+                   <NTHUU CL6 OFF7 = TEMP13 (TYPE FIX)>
+                   <PUTBITS TEMP13 8 SHFT9 VAL5 = CWORD8>
+                   <DEAD TEMP13 SHFT9 VAL5>
+                   <PUTUU CL6 OFF7 CWORD8>
+                   <DEAD CL6 OFF7 CWORD8>
+                   <RETURN 'T>
+PHRASE22
+                   <RESTL CL6 1 = CL6 (TYPE LIST)>
+                   <EMPL? CL6 - PHRASE28 (TYPE LIST)>
+                   <FRAME '\1aERROR>
+                   <PUSH 'OUT-OF-BOUNDS>
+                   <PUSH 'PUT-FCODE>
+                   <CALL '\1aERROR 2>
+PHRASE28
+                   <SUB CWORD8 4096 = CWORD8 (TYPE FIX)>
+                   <JUMP + AGAIN20>
+                   <END \1aPUT-FCODE>
+
+#WORD *32410634272*
+                   <GFCN \1aNTH-FCODE ("VALUE" FIX FIX) DEST4>
+                   <TEMP CL5 OFF7:FIX CWORD8:FIX SHFT9:FIX TEMP13>
+                   <INTGO>
+                   <GVAL 'FCODE-LIST = CL5>
+                   <GVAL 'FBYTE-OFFSET = OFF7>
+                   <GVAL 'FCURRENT-WORD = CWORD8>
+                   <GVAL 'FSHIFT = SHFT9>
+                   <ADD OFF7 2 = TEMP13 (TYPE FIX)>
+                   <DEAD OFF7>
+                   <DIV TEMP13 4 = TEMP13 (TYPE FIX)>
+                   <ADD DEST4 3 = OFF7 (TYPE FIX)>
+                   <DIV OFF7 4 = OFF7 (TYPE FIX)>
+                   <VEQUAL? TEMP13 OFF7 - PHRASE11 (TYPE FIX)>
+                   <DEAD TEMP13>
+                   <VEQUAL? SHFT9 32 + PHRASE11 (TYPE FIX)>
+                   <DEAD SHFT9>
+                   <ADD DEST4 3 = TEMP13 (TYPE FIX)>
+                   <DEAD DEST4>
+                   <AND TEMP13 3 = TEMP13>
+                   <ADD TEMP13 1 = TEMP13 (TYPE FIX)>
+                   <NTHUU ![24 16 8 0!] TEMP13 = TEMP13 (TYPE FIX)>
+                   <GETBITS CWORD8 8 TEMP13 = TEMP13>
+                   <DEAD CWORD8>
+                   <RETURN TEMP13>
+                   <DEAD TEMP13>
+PHRASE11
+                   <SET CWORD8 DEST4>
+                   <LOOP>
+AGAIN19
+                   <INTGO>
+                   <GRTR? CWORD8 4096 + PHRASE21 (TYPE FIX)>
+                   <ADD CWORD8 3 = TEMP13 (TYPE FIX)>
+                   <DIV TEMP13 4 = OFF7 (TYPE FIX)>
+                   <DEAD TEMP13>
+                   <ADD CWORD8 3 = TEMP13 (TYPE FIX)>
+                   <DEAD CWORD8>
+                   <AND TEMP13 3 = TEMP13>
+                   <ADD TEMP13 1 = TEMP13 (TYPE FIX)>
+                   <NTHUU ![24 16 8 0!] TEMP13 = SHFT9 (TYPE FIX)>
+                   <DEAD TEMP13>
+                   <NTHL CL5 1 = TEMP13>
+                   <TYPE? TEMP13 <TYPE-CODE UVECTOR> - PHRASE24>
+                   <DEAD TEMP13>
+                   <NTHL CL5 1 = CL5 (TYPE UVECTOR)>
+                   <JUMP + COND23>
+PHRASE24
+                   <FRAME '\1aGET-FCODE-BUFFER>
+                   <NTHL CL5 1 = STACK (TYPE FIX)>
+                   <DEAD CL5>
+                   <PUSH 'READ>
+                   <CALL '\1aGET-FCODE-BUFFER 2 = CL5>
+COND23
+                   <NTHUU CL5 OFF7 = TEMP13 (TYPE FIX)>
+                   <DEAD CL5 OFF7>
+                   <GETBITS TEMP13 8 SHFT9 = OFF7>
+                   <DEAD TEMP13 SHFT9>
+                   <RETURN OFF7>
+                   <DEAD OFF7>
+PHRASE21
+                   <RESTL CL5 1 = CL5 (TYPE LIST)>
+                   <EMPL? CL5 - PHRASE27 (TYPE LIST)>
+                   <FRAME '\1aERROR>
+                   <PUSH 'OUT-OF-BOUNDS>
+                   <PUSH DEST4>
+                   <PUSH 'NTH-FCODE>
+                   <CALL '\1aERROR 3>
+PHRASE27
+                   <SUB CWORD8 4096 = CWORD8 (TYPE FIX)>
+                   <JUMP + AGAIN19>
+                   <END \1aNTH-FCODE>
+
+#WORD *21553301514*
+                   <GFCN \1aGET-FCODE-BUFFER ("VALUE" UVECTOR FIX ATOM) PAGE4 MODE5>
+                   <TEMP TEMP8>
+                   <INTGO>
+                   <GVAL 'FCODE-BUFFER-PAGE = TEMP8>
+                   <VEQUAL? PAGE4 TEMP8 - PHRASE7 (TYPE FIX)>
+                   <DEAD TEMP8>
+                   <VEQUAL? MODE5 'WRITE - PHRASE20>
+                   <DEAD MODE5>
+                   <SETG 'FCODE-BUFFER-CHANGED? 'T>
+                   <JUMP + PHRASE20>
+PHRASE7
+                   <GVAL 'FCODE-BUFFER-PAGE = TEMP8>
+                   <LESS? TEMP8 0 + PHRASE12 (TYPE FIX)>
+                   <DEAD TEMP8>
+                   <GVAL 'FCODE-BUFFER-CHANGED? = TEMP8>
+                   <TYPE? TEMP8 <TYPE-CODE FALSE> + PHRASE12>
+                   <DEAD TEMP8>
+                   <FRAME '\1aWRITE-FCODE>
+                   <GVAL 'FCODE-BUFFER = STACK>
+                   <GVAL 'FCODE-BUFFER-PAGE = STACK>
+                   <CALL '\1aWRITE-FCODE 2>
+PHRASE12
+                   <FRAME '\1aREAD-FCODE>
+                   <GVAL 'FCODE-BUFFER = STACK>
+                   <PUSH PAGE4>
+                   <CALL '\1aREAD-FCODE 2>
+                   <SETG 'FCODE-BUFFER-PAGE PAGE4>
+                   <DEAD PAGE4>
+                   <VEQUAL? MODE5 'READ - PHRASE19>
+                   <DEAD MODE5>
+                   <SETG 'FCODE-BUFFER-CHANGED? %<>>
+                   <JUMP + PHRASE20>
+PHRASE19
+                   <SETG 'FCODE-BUFFER-CHANGED? 'T>
+PHRASE20
+                   <GVAL 'FCODE-BUFFER = TEMP8>
+                   <RETURN TEMP8>
+                   <DEAD TEMP8>
+                   <END \1aGET-FCODE-BUFFER>
+
+#WORD *27553405450*
+                   <GFCN \1aADVANCE-FCODE ("VALUE" ATOM FIX) NUM4>
+                   <TEMP TEMP5:ATOM>
+                   <INTGO>
+                   <LOOP>
+AGAIN8
+                   <INTGO>
+                   <FRAME '\1aADD-BYTE-TO-FCODE>
+                   <PUSH NUM4>
+                   <CALL '\1aADD-BYTE-TO-FCODE 1>
+                   <SUB NUM4 1 = NUM4 (TYPE FIX)>
+                   <VEQUAL? NUM4 0 - AGAIN8 (TYPE FIX)>
+                   <RETURN 'T>
+                   <END \1aADVANCE-FCODE>