ProForth source code
FSYS.S: ProDOS system program to load the dictionary.
LST ON,NOGen,NOAsym,NOVsym* FORTH.SYSTEM by John Matthews, M.D.A1 EQU $3CA2 EQU $3EA4 EQU $42FSTART EQU $800 Forth dictionary entryFBUF1 EQU $B200MLI EQU $BF00 Call MLIBITMAP EQU $BF58 ProDOS memory bit mapFLEVEL EQU $BF94MACHID EQU $BF98CLR80COL EQU $C000 Hardware switchesCLR80VID EQU $C00CSETALTCH EQU $C00FROMON EQU $C082HOME EQU $FC58 Monitor routinesGETKEY EQU $FD0CCROUT EQU $FD8EPRBYTE EQU $FDDACOUT EQU $FDEDMOVE EQU $FE2CSETKBD EQU $FE89SETVID EQU $FE93 SYS ORG $2000 LDX #$FF TXS LDA #0 STA A1 STA A2 STA A4 LDA #$21 STA A1+1 LDA #$24 STA A2+1 LDA #<FSYS STA A4+1 LDY #0 JSR MOVE LDA #>FSYS STA $3F2 LDA #<FSYS STA $3F3 EOR #$A5 STA $3F4 JMP FSYS ORG $A000* Initialize normal keyboard & 40 columnsFSYS LDA ROMON Enable the ROMs! JSR SETVID JSR SETKBD STA CLR80VID STA SETALTCH STA CLR80COL LDA MACHID AND #2 BEQ NO80COL JSR $C300NO80COL JSR HOME JSR SCREEN* Initialize the ProDOS bit map LDX #$17 LDA #1 Global page ($BF00) in use STA BITMAP,X DEX LDA #0 Free all other pages STA FLEVEL File level = 0CLRBITS STA BITMAP,X DEX BPL CLRBITS LDA #$CF Zero page, stack and text STA BITMAP page 1 in use* Clear the future user area & buffers LDA #$B2 STA A1+1 LDY #0 STY A1CLRBUF1 TYACLRBUF2 STA (A1),Y INY BNE CLRBUF2 INC A1+1 LDA A1+1 CMP #$BF BNE CLRBUF1* Close any open files JSR MLI DB $CC CLOSE command DW CLOSLIST BCS ERROR* Get the prefix JSR MLI DB $C7 GET PREFIX command DW PREFLIST BCS ERROR LDA PREFIX BEQ ERROR Null prefix is death* Open F.DICT file LDA #>FNAME1 STA ONAME LDA #<FNAME1 STA ONAME+1 JSR MLI DB $C8 OPEN command DW OPENLIST BCS ERROR* Get end of file mark LDA REFNO Use the REFNO supplied STA EREF by the call to OPEN JSR MLI DB $D1 GET EOF command DW EOFLIST BCS ERROR* Read the file LDA REFNO Use the REFNO again STA RREF LDA EPOS Use the length supplied STA RLENGTH by the call to GET EOF LDA EPOS+1 STA RLENGTH+1 JSR MLI DB $CA READ command DW READLIST BCS ERROR* Close F.DICT JSR MLI DB $CC CLOSE command DW CLOSLIST BCS ERROR* Open F.DISK LDA #>FNAME2 STA ONAME LDA #<FNAME2 STA ONAME+1 JSR MLI DB $C8 OPEN command DW OPENLIST BCS ERROR JMP FSTART* Handle fatal errorERROR PHA A Save the error code JSR CROUT Print RETURN LDY ERRMSG Print error message LDX #1ERR1 LDA ERRMSG,X ORA #$80 JSR COUT INX DEY BNE ERR1 PLA A Restore error code JSR PRBYTE Print it JSR GETKEY Wait for it JSR MLI Die horribly DB $65 QUIT command DW QLIST* Standard print routinePRINT1 LDY #0 PLA STA A1 PLA STA A1+1PRINT2 INC A1 BNE PRINT3 INC A1+1PRINT3 LDA (A1),Y BEQ PRINT4 ORA #$80 JSR COUT JMP PRINT2PRINT4 INC A1 BNE PRINT5 INC A1+1PRINT5 JMP (A1)* Print the creditsSCREEN JSR PRINT1 DB 13,13 ASC "*** PRO-FORTH V3.2 ***" DB 13,13,13 ASC "PRESENTED BY APPLE-DAYTON, INC." DB 13,13 ASC "PO BOX 1666 FAIRBORN OH 45324-7666" DB 13,13,13 ASC "COURTESY OF THE FORTH INTEREST GROUP" DB 13,13 ASC "PO BOX 1105 SAN CARLOS CA 94070" DB 13,13,13 ASC "ADAPTED FOR PRODOS BY JOHN B. MATTHEWS" DB 13,13,13 DB 0 RTS* "Prefix" parameter listPREFLIST DB 1 Parameter count DW PREFIX Pathname pointer* "Open" parameter listOPENLIST DB 3 Parameter countONAME DW FNAME1 File name pointer DW FBUF1 File #1 buffer addr.REFNO DB 0 Reference number* "End of File" parameter listEOFLIST DB 2 Parameter countEREF DB 0 Reference numberEPOS DB 0,0,0 File position* "Read" parameter listREADLIST DB 4 Parameter countRREF DB 0 Reference numberRDATA DW FSTART Data buffer addr.RLENGTH DW 0 Requested length DW 0 Actual length* "Close" parameter listCLOSLIST DB 1 Parameter countCREF DB 0 0 closes all open files* "Quit aprameter listQLIST DFB 4,0,0,0,0,0,0* String storageERRMSG STR "PRODOS ERROR: $"FNAME1 STR "F.DICT"FNAME2 STR "F.DISK"PREFIX DS 64,0NAME: EDASM macro used by FDICT.S
DFB &1 DCI &2 IFEQ >*+3 LST ON FAIL 2,'PFA=xxFF' FINFDICT.S: Forth dictionary
LST OFF,NOGen,NOWarn,NOVsym,NOAsym,NOExp MACLIB ORG $800SSIZE EQU 1024NBUF EQU 2BMAG EQU SSIZE+4*NBUFBOS EQU $60TOS EQU $DEN EQU TOS+8IP EQU N+8W EQU IP+3UP EQU W+2XSAVE EQU UP+2KSWL EQU $38TIBX EQU $0300MEM EQU $BF00UAREA EQU MEM-128DAREA EQU UAREA-BMAGMLI EQU $BF00OUTCH EQU $FDEDINCH EQU $FD0CCROUT EQU $FD8EMONITOR EQU $FF69ORIG EQU *ENTER JMP COLD+2 NOP REENTER JMP WARM NOP DW $0004 DW $5ED2 DW NTOP Last NFA DW 8 Backspace key DW UAREA User start DW TOS Program TOS DW $1FF Return TOS DW TIBX Terminal input buffer DW 31 Name field size max DW 1 Warning DW TOP FENCE DW TOP DP DW VLO VOC-LINK DW 0L22 NAME $83,'LIT' DW 00LIT DW *+2 LDA (IP),Y PHA INC IP BNE L30 INC IP+1L30 LDA (IP),YL31 INC IP BNE PUSH INC IP+1PUSH DEX DEXPUT STA 1,X PLA STA 0,XNEXT LDY #1 LDA (IP),Y STA W+1 DEY LDA (IP),Y STA W CLC LDA IP ADC #2 STA IP BCC L54 INC IP+1L54 JMP W-1*L35 NAME $84,'CLIT' DW L22CLIT DW *+2 LDA (IP),Y PHA TYA BEQ L31SETUP ASL A STA N-1L63 LDA 0,X STA N,Y INX INY CPY N-1 BNE L63 LDY #0 RTSL75 NAME $87,'EXECUTE' DW L35EXEC DW *+2 LDA 0,X STA W LDA 1,X STA W+1 INX INX JMP W-1L89 NAME $86,'BRANCH' DW L75BRAN DW *+2 CLC LDA (IP),Y ADC IP PHA INY LDA (IP),Y ADC IP+1 STA IP+1 PLA STA IP JMP NEXT+2L107 NAME $87,'0BRANCH' DW L89ZBRAN DW *+2 INX INX LDA $FE,X ORA $FF,X BEQ BRAN+2BUMP CLC LDA IP ADC #2 STA IP BCC L122 INC IP+1L122 JMP NEXTL127 NAME $86,'(LOOP)' DW L107PLOOP DW L130L130 STX XSAVE TSX INC $101,X BNE PL1 INC $102,XPL1 CLC LDA $103,X SBC $101,X LDA $104,X SBC $102,XPL2 LDX XSAVE ASL A BCC BRAN+2 PLA PLA PLA PLA JMP BUMPL154 NAME $87,'(+LOOP)' DW L127PPLOO DW *+2 INX INX STX XSAVE LDA $FF,X PHA PHA LDA $FE,X TSX INX INX CLC ADC $101,X STA $101,X PLA ADC $102,X STA $102,X PLA BPL PL1 CLC LDA $101,X SBC $103,X LDA $102,X SBC $104,X JMP PL2L185 NAME $84,'(DO)' DW L154PDO DW *+2 LDA 3,X PHA LDA 2,X PHA LDA 1,X PHA LDA 0,X PHAPOPTWO INX INXPOP INX INX JMP NEXTL207 NAME $81,'I' DW L185I DW R+2L214 NAME $85,'DIGIT' DW L207DIGIT DW *+2 SEC LDA 2,X SBC #$30 BMI L234 CMP #$A BMI L227 SEC SBC #7 CMP #$A BMI L234L227 CMP 0,X BPL L234 STA 2,X LDA #1 PHA TYA JMP PUTL234 TYA PHA INX INX JMP PUTL243 NAME $86,'(FIND)' DW L214PFIND DW *+2 LDA #2 JSR SETUP STX XSAVEL249 LDY #0 LDA (N),Y EOR (N+2),Y AND #$3F BNE L281L254 INY LDA (N),Y EOR (N+2),Y ASL A BNE L280 BCC L254 LDX XSAVE DEX DEX DEX DEX CLC TYA ADC #5 ADC N STA 2,X LDY #0 TYA ADC N+1 STA 3,X STY 1,X LDA (N),Y STA 0,X LDA #1 PHA JMP PUSHL280 BCS L284L281 INY LDA (N),Y BPL L281L284 INY LDA (N),Y TAX INY LDA (N),Y STA N+1 STX N ORA N BNE L249 LDX XSAVE LDA #0 PHA JMP PUSHL301 NAME $87,'ENCLOSE' DW L243ENCL DW *+2 LDA #2 JSR SETUP TXA SEC SBC #8 TAX STY 3,X STY 1,X DEY DEC N+3 DEC 1,XL313 INY BNE LX1 INC N+3 INC 1,XLX1 LDA (N+2),Y CMP N BEQ L313 STY 4,X LDA 1,X STA 5,XL318 LDA (N+2),Y BNE L327 STY 2,X STY 0,X LDA 1,X STA 3,X TYA CMP 4,X BNE L326 LDA 1,X CMP 5,X BNE L326 INC 2,X BNE L326 INC 3,XL326 JMP NEXTL327 PHA STY 2,X LDA 1,X STA 3,X INY BNE LX2 INC 1,X INC N+3LX2 PLA CMP N BNE L318 STY 0,X JMP NEXTL337 NAME $84,'EMIT' DW L301EMIT DW XEMITL344 NAME $83,'KEY' DW L337KEY DW XKEYL351 NAME $89,'?TERMINAL' DW L344QTERM DW XQTERL358 NAME $82,'CR' DW L351CR DW XCRL365 NAME $85,'CMOVE' DW L358CMOVE DW *+2 LDA #3 JSR SETUPL370 CPY N BNE L375 DEC N+1 BPL L375 JMP NEXTL375 LDA (N+4),Y STA (N+2),Y INY BNE L370 INC N+5 INC N+3 JMP L370L386 NAME $82,'U*' DW L365USTAR DW *+2 LDA 2,X STA N STY 2,X LDA 3,X STA N+1 STY 3,X LDY #16L396 ASL 2,X ROL 3,X ROL 0,X ROL 1,X BCC L411 CLC LDA N ADC 2,X STA 2,X LDA N+1 ADC 3,X STA 3,X LDA #0 ADC 0,X STA 0,XL411 DEY BNE L396 JMP NEXTL418 NAME $82,'U/' DW L386USLAS DW *+2 LDA 4,X LDY 2,X STY 4,X ASL A STA 2,X LDA 5,X LDY 3,X STY 5,X ROL A STA 3,X LDA #16 STA NL433 ROL 4,X ROL 5,X SEC LDA 4,X SBC 0,X TAY LDA 5,X SBC 1,X BCC L444 STY 4,X STA 5,XL444 ROL 2,X ROL 3,X DEC N BNE L433 JMP POPL453 NAME $83,'AND' DW L418ANDD DW *+2 LDA 0,X AND 2,X PHA LDA 1,X AND 3,XBINARY INX INX JMP PUTL469 NAME $82,'OR' DW L453OR DW *+2 LDA 0,X ORA 2,X PHA LDA 1,X ORA 3,X INX INX JMP PUTL484 NAME $83,'XOR' DW L469XOR DW *+2 LDA 0,X EOR 2,X PHA LDA 1,X EOR 3,X INX INX JMP PUTL499 NAME $83,'SP@' DW L484SPAT DW *+2 TXAPUSHOA PHA LDA #0 JMP PUSHL511 NAME $83,'SP!' DW L499SPSTO DW *+2 LDY #6 LDA (UP),Y TAX JMP NEXTL522 NAME $83,'RP!' DW L511RPSTO DW *+2 STX XSAVE LDY #8 LDA (UP),Y TAX TXS LDX XSAVE JMP NEXTL536 NAME $82,';S' DW L522SEMIS DW *+2 PLA STA IP PLA STA IP+1 JMP NEXTL548 NAME $85,'LEAVE' DW L536LEAVE DW *+2 STX XSAVE TSX LDA $101,X STA $103,X LDA $102,X STA $104,X LDX XSAVE JMP NEXTL563 NAME $82,'>R' DW L548TOR DW *+2 LDA 1,X PHA LDA 0,X PHA INX INX JMP NEXTL577 NAME $82,'R>' DW L563RFROM DW *+2 DEX DEX PLA STA 0,X PLA STA 1,X JMP NEXTL591 NAME $81,'R' DW L577R DW *+2 STX XSAVE TSX LDA $101,X PHA LDA $102,X LDX XSAVE JMP PUSHL605 NAME $82,'0=' DW L591ZEQU DW *+2 LDA 0,X ORA 1,X STY 1,X BNE L613 INYL613 STY 0,X JMP NEXTL619 NAME $82,'0<' DW L605ZLESS DW *+2 ASL 1,X TYA ROL A STY 1,X STA 0,X JMP NEXT DW 0L632 NAME $81,'+' DW L619PLUS DW *+2 CLC LDA 0,X ADC 2,X STA 2,X LDA 1,X ADC 3,X STA 3,X INX INX JMP NEXTL649 NAME $82,'D+' DW L632DPLUS DW *+2 CLC LDA 2,X ADC 6,X STA 6,X LDA 3,X ADC 7,X STA 7,X LDA 0,X ADC 4,X STA 4,X LDA 1,X ADC 5,X STA 5,X JMP POPTWOL670 NAME $85,'MINUS' DW L649MINUS DW *+2 SEC TYA SBC 0,X STA 0,X TYA SBC 1,X STA 1,X JMP NEXTL685 NAME $86,'DMINUS' DW L670DMINU DW *+2 SEC TYA SBC 2,X STA 2,X TYA SBC 3,X STA 3,X JMP MINUS+3L700 NAME $84,'OVER' DW L685OVER DW *+2 LDA 2,X PHA LDA 3,X JMP PUSHL711 NAME $84,'DROP' DW L700DROP DW POPL718 NAME $84,'SWAP' DW L711SWAP DW *+2 LDA 2,X PHA LDA 0,X STA 2,X LDA 3,X LDY 1,X STY 3,X JMP PUTL733 NAME $83,'DUP' DW L718DUP DW *+2 LDA 0,X PHA LDA 1,X JMP PUSHL744 NAME $82,'+!' DW L733PSTOR DW *+2 CLC LDA (0,X) ADC 2,X STA (0,X) INC 0,X BNE L754 INC 1,XL754 LDA (0,X) ADC 3,X STA (0,X) JMP POPTWOL762 NAME $86,'TOGGLE' DW L744TOGGL DW *+2 LDA (2,X) EOR 0,X STA (2,X) JMP POPTWOL773 NAME $81,'@' DW L762AT DW *+2 LDA (0,X) PHA INC 0,X BNE L781 INC 1,XL781 LDA (0,X) JMP PUTL787 NAME $82,'C@' DW L773CAT DW *+2 LDA (0,X) STA 0,X STY 1,X JMP NEXTL798 NAME $81,'!' DW L787STORE DW *+2 LDA 2,X STA (0,X) INC 0,X BNE L806 INC 1,XL806 LDA 3,X STA (0,X) JMP POPTWOL813 NAME $82,'C!' DW L798CSTOR DW *+2 LDA 2,X STA (0,X) JMP POPTWOL823 NAME $C1,':' DW L813COLON DW DOCOL DW QEXEC DW SCSP DW CURR DW AT DW CON DW STORE DW CREAT DW RBRAC DW PSCODDOCOL LDA IP+1 PHA LDA IP PHA CLC LDA W ADC #2 STA IP TYA ADC W+1 STA IP+1 JMP NEXTL853 NAME $C1,';' DW L823 DW DOCOL DW QCSP DW COMP DW SEMIS DW SMUDG DW LBRAC DW SEMISL867 NAME $88,'CONSTANT' DW L853CONST DW DOCOL DW CREAT DW SMUDG DW COMMA DW PSCODDOCON LDY #2 LDA (W),Y PHA INY LDA (W),Y JMP PUSHL885 NAME $88,'VARIABLE' DW L867VAR DW DOCOL DW CONST DW PSCODDOVAR CLC LDA W ADC #2 PHA TYA ADC W+1 JMP PUSHL902 NAME $84,'USER' DW L885USER DW DOCOL DW CONST DW PSCODDOUSE LDY #2 CLC LDA (W),Y ADC UP PHA LDA #0 ADC UP+1 JMP PUSHL920 NAME $81,'0' DW L902ZERO DW DOCON DW 0L928 NAME $81,'1' DW L920ONE DW DOCON DW 1L936 NAME $81,'2' DW L928TWO DW DOCON DW 2L944 NAME $81,'3' DW L936THREE DW DOCON DW 3L952 NAME $82,'BL' DW L944BL DW DOCON DW $20L960 NAME $83,'C/L' DW L952CSLL DW DOCON DW 64L968 NAME $85,'FIRST' DW L960FIRST DW DOCON DW DAREAL976 NAME $85,'LIMIT' DW L968LIMIT DW DOCON DW UAREAL984 NAME $85,'B/BUF' DW L976BBUF DW DOCON DW SSIZEL992 NAME $85,'B/SCR' DW L984BSCR DW DOCON DW 1024/SSIZEL993 NAME $85,'FSIZE' DW L992FSIZE DW DOCON DW 100L1000 NAME $87,'+ORIGIN' DW L993PORIG DW DOCOL DW LIT,ORIG DW PLUS DW SEMISL1010 NAME $83,'TIB' DW L1000TIB DW DOUSE DFB $AL1018 NAME $85,'WIDTH' DW L1010WIDTH DW DOUSE; DFB $CL1026 NAME $87,'WARNING' DW L1018WARN DW DOUSE DFB $EL1034 NAME $85,'FENCE' DW L1026FENCE DW DOUSE DFB $10L1042 NAME $82,'DP' DW L1034DP DW DOUSE DFB $12L1050 NAME $88,'VOC-LINK' DW L1042VOCL DW DOUSE DFB $14L1058 NAME $83,'BLK' DW L1050BLK DW DOUSE DFB $16L1066 NAME $82,'IN' DW L1058IN DW DOUSE DFB $18L1074 NAME $83,'OUT' DW L1066OUT DW DOUSE DFB $1AL1082 NAME $83,'SCR' DW L1074SCR DW DOUSE DFB $1CL1090 NAME $86,'OFFSET' DW L1082OFSET DW DOUSE DFB $1EL1098 NAME $87,'CONTEXT' DW L1090CON DW DOUSE DFB $20L1106 NAME $87,'CURRENT' DW L1098CURR DW DOUSE DFB $22L1114 NAME $85,'STATE' DW L1106STATE DW DOUSE DFB $24L1122 NAME $84,'BASE' DW L1114BASE DW DOUSE DFB $26L1130 NAME $83,'DPL' DW L1122DPL DW DOUSE DFB $28L1138 NAME $83,'FLD' DW L1130FLD DW DOUSE DFB $2AL1146 NAME $83,'CSP' DW L1138CSP DW DOUSE DFB $2CL1154 NAME $82,'R#' DW L1146RNUM DW DOUSE DFB $2EL1162 NAME $83,'HLD' DW L1154HLD DW DOUSE DFB $30L1170 NAME $82,'1+' DW L1162ONEP DW DOCOL DW ONE DW PLUS DW SEMISL1180 NAME $82,'2+' DW L1170TWOP DW DOCOL DW TWO DW PLUS DW SEMISL1190 NAME $84,'HERE' DW L1180HERE DW DOCOL DW DP DW AT DW SEMISL1200 NAME $85,'ALLOT' DW L1190ALLOT DW DOCOL DW DP DW PSTOR DW SEMISL1210 DFB $81,$AC , DW L1200COMMA DW DOCOL DW HERE DW STORE DW TWO DW ALLOT DW SEMISL1222 DFB $82,'C',$AC C, DW L1210CCOMM DW DOCOL DW HERE DW CSTOR DW ONE DW ALLOT DW SEMISL1234 NAME $81,'-' DW L1222SUB DW DOCOL DW MINUS DW PLUS DW SEMISL1244 NAME $81,'=' DW L1234EQUAL DW DOCOL DW SUB DW ZEQU DW SEMISL1246 NAME $82,'U<' DW L1244ULESS DW *+2 LDA 2,X CMP 0,X LDA 3,X SBC 1,X TYA ROL A EOR #1 STA 2,X STY 3,X JMP POPL1254 NAME $81,'<' DW L1246LESS DW *+2 SEC LDA 2,X SBC 0,X LDA 3,X SBC 1,X STY 3,X BVC L1258 EOR #$80L1258 BPL L1260 INYL1260 STY 2,X JMP POPL1264 NAME $81,'>' DW L1254GREAT DW DOCOL DW SWAP DW LESS DW SEMISL1274 NAME $83,'ROT' DW L1264ROT DW DOCOL DW TOR DW SWAP DW RFROM DW SWAP DW SEMISL1286 NAME $85,'SPACE' DW L1274SPACE DW DOCOL DW BL DW EMIT DW SEMISL1296 NAME $84,'-DUP' DW L1286DDUP DW DOCOL DW DUP DW ZBRANL1301 DW $4 DW DUPL1303 DW SEMISL1308 NAME $88,'TRAVERSE' DW L1296TRAV DW DOCOL DW SWAPL1312 DW OVER DW PLUS DW CLIT DFB $7F DW OVER DW CAT DW LESS DW ZBRANL1320 DW $FFF1 DW SWAP DW DROP DW SEMISL1328 NAME $86,'LATEST' DW L1308LATES DW DOCOL DW CURR DW AT DW AT DW SEMISL1339 NAME $83,'LFA' DW L1328LFA DW DOCOL DW CLIT DFB 4 DW SUB DW SEMISL1350 NAME $83,'CFA' DW L1339CFA DW DOCOL DW TWO DW SUB DW SEMISL1360 NAME $83,'NFA' DW L1350NFA DW DOCOL DW CLIT DFB $5 DW SUB DW LIT,$FFFF DW TRAV DW SEMISL1373 NAME $83,'PFA' DW L1360PFA DW DOCOL DW ONE DW TRAV DW CLIT DFB 5 DW PLUS DW SEMISL1386 NAME $84,'!CSP' DW L1373SCSP DW DOCOL DW SPAT DW CSP DW STORE DW SEMISL1397 NAME $86,'?ERROR' DW L1386QERR DW DOCOL DW SWAP DW ZBRANL1402 DW 8 DW ERROR DW BRANL1405 DW 4L1406 DW DROPL1407 DW SEMISL1412 NAME $85,'?COMP' DW L1397QCOMP DW DOCOL DW STATE DW AT DW ZEQU DW CLIT DFB $11 DW QERR DW SEMISL1426 NAME $85,'?EXEC' DW L1412QEXEC DW DOCOL DW STATE DW AT DW CLIT DFB $12 DW QERR DW SEMISL1439 NAME $86,'?PAIRS' DW L1426QPAIR DW DOCOL DW SUB DW CLIT DFB $13 DW QERR DW SEMISL1451 NAME $84,'?CSP' DW L1439QCSP DW DOCOL DW SPAT DW CSP DW AT DW SUB DW CLIT DFB $14 DW QERR DW SEMISL1466 NAME $88,'?LOADING' DW L1451QLOAD DW DOCOL DW BLK DW AT DW ZEQU DW CLIT DFB $16 DW QERR DW SEMISL1480 NAME $87,'COMPILE' DW L1466COMP DW DOCOL DW QCOMP DW RFROM DW DUP DW TWOP DW TOR DW AT DW COMMA DW SEMISL1495 NAME $C1,'[' DW L1480LBRAC DW DOCOL DW ZERO DW STATE DW STORE DW SEMISL1507 NAME $81,']' DW L1495RBRAC DW DOCOL DW CLIT DFB $C0 DW STATE DW STORE DW SEMISL1519 NAME $86,'SMUDGE' DW L1507SMUDG DW DOCOL DW LATES DW CLIT DFB $20 DW TOGGL DW SEMISL1531 NAME $83,'HEX' DW L1519HEX DW DOCOL DW CLIT DFB 16 DW BASE DW STORE DW SEMISL1543 NAME $87,'DECIMAL' DW L1531DECIM DW DOCOL DW CLIT DFB 10 DW BASE DW STORE DW SEMISL1555 NAME $87,'(;CODE)' DW L1543PSCOD DW DOCOL DW RFROM DW LATES DW PFA DW CFA DW STORE DW SEMISL1568 NAME $C5,';CODE' DW L1555 DW DOCOL DW QCSP DW COMP DW PSCOD DW LBRAC DW SMUDG DW SEMISL1582 NAME $87,'<BUILDS' DW L1568BUILD DW DOCOL DW ZERO DW CONST DW SEMISL1592 NAME $85,'DOES>' DW L1582DOES DW DOCOL DW RFROM DW LATES DW PFA DW STORE DW PSCODDODOE LDA IP+1 PHA LDA IP PHA LDY #2 LDA (W),Y STA IP INY LDA (W),Y STA IP+1 CLC LDA W ADC #4 PHA LDA W+1 ADC #0 JMP PUSHL1622 NAME $85,'COUNT' DW L1592COUNT DW DOCOL DW DUP DW ONEP DW SWAP DW CAT DW SEMISL1634 NAME $84,'TYPE' DW L1622TYPE DW DOCOL DW DDUP DW ZBRANL1639 DW $18 DW OVER DW PLUS DW SWAP DW PDOL1644 DW I DW CAT DW EMIT DW PLOOPL1648 DW $FFF8 DW BRANL1650 DW $4L1651 DW DROPL1652 DW SEMISL1657 NAME $89,'-TRAILING' DW L1634DTRAI DW *+2 LDY 0,X LDA 2,X STA N LDA 3,X STA N+1DTR1 DEY BMI DTR2 LDA (N),Y CMP #$20 BEQ DTR1DTR2 INY STY 0,X JMP NEXTL1685 NAME $84,'(.")' DW L1657PDOTQ DW DOCOL DW R DW COUNT DW DUP DW ONEP DW RFROM DW PLUS DW TOR DW TYPE DW SEMISL1701 NAME $C2,'."' DW L1685 DW DOCOL DW CLIT DFB $22 DW STATE DW AT DW ZBRANL1709 DW $14 DW COMP DW PDOTQ DW WORD DW HERE DW CAT DW ONEP DW ALLOT DW BRANL1718 DW $AL1719 DW WORD DW HERE DW COUNT DW TYPEL1723 DW SEMISL1729 NAME $86,'EXPECT' DW L1701EXPEC DW *+2 STX XSAVE LDA 2,X STA N LDA 3,X STA N+1 JSR $FD6F CPX #$4D BCC EXPEC1 LDX #$4CEXPEC1 LDA #0 STA $200,X INX STA $200,X INX STA $200,X INX STA $200,X TXA TAYEXPEC2 LDA $200,X AND #$7F STA (N),Y DEY DEX BPL EXPEC2 LDX XSAVE JMP POPTWOL1788 NAME $85,'QUERY' DW L1729QUERY DW DOCOL DW TIB DW AT DW CLIT DFB 80 DW EXPEC DW ZERO DW IN DW STORE DW SEMISL1804 DFB $C1,$80 @ DW L1788 DW DOCOL DW BLK DW AT DW ZBRANL1810 DW $2A DW ONE DW BLK DW PSTOR DW ZERO DW IN DW STORE DW BLK DW AT DW ZERO,BSCR DW USLAS DW DROP DW ZEQU DW ZBRANL1824 DW 8 DW QEXEC DW RFROM DW DROPL1828 DW BRANL1829 DW 6L1830 DW RFROM DW DROPL1832 DW SEMISL1838 NAME $84,'FILL' DW L1804FILL DW DOCOL DW SWAP DW TOR DW OVER DW CSTOR DW DUP DW ONEP DW RFROM DW ONE DW SUB DW CMOVE DW SEMISL1856 NAME $85,'ERASE' DW L1838ERASE DW DOCOL DW ZERO DW FILL DW SEMISL1866 NAME $86,'BLANKS' DW L1856BLANK DW DOCOL DW BL DW FILL DW SEMISL1876 NAME $84,'HOLD' DW L1866HOLD DW DOCOL DW LIT,$FFFF DW HLD DW PSTOR DW HLD DW AT DW CSTOR DW SEMISL1890 NAME $83,'PAD' DW L1876PAD DW DOCOL DW HERE DW CLIT DFB 68 DW PLUS DW SEMISL1902 NAME $84,'WORD' DW L1890WORD DW DOCOL DW BLK DW AT DW ZBRANL1908 DW $C DW BLK DW AT DW BLOCK DW BRANL1913 DW $6L1914 DW TIB DW ATL1916 DW IN DW AT DW PLUS DW SWAP DW ENCL DW HERE DW CLIT DFB $22 DW BLANK DW IN DW PSTOR DW OVER DW SUB DW TOR DW R DW HERE DW CSTOR DW PLUS DW HERE DW ONEP DW RFROM DW CMOVE DW SEMISL1943 NAME $85,'UPPER' DW L1902UPPER DW DOCOL DW OVER DW PLUS DW SWAP DW PDOL1950 DW I DW CAT DW CLIT DFB $5F DW GREAT DW ZBRANL1956 DW 09 DW I DW CLIT DFB $20 DW TOGGLL1961 DW PLOOPL1962 DW $FFEA DW SEMISL1968 NAME $88,'(NUMBER)' DW L1943PNUMB DW DOCOLL1971 DW ONEP DW DUP DW TOR DW CAT DW BASE DW AT DW DIGIT DW ZBRANL1979 DW $2C DW SWAP DW BASE DW AT DW USTAR DW DROP DW ROT DW BASE DW AT DW USTAR DW DPLUS DW DPL DW AT DW ONEP DW ZBRANL1994 DW 8 DW ONE DW DPL DW PSTORL1998 DW RFROM DW BRANL2000 DW $FFC6L2001 DW RFROM DW SEMISL2007 NAME $86,'NUMBER' DW L1968NUMBER DW DOCOL DW ZERO DW ZERO DW ROT DW DUP DW ONEP DW CAT DW CLIT DFB $2D DW EQUAL DW DUP DW TOR DW PLUS DW LIT,$FFFFL2023 DW DPL DW STORE DW PNUMB DW DUP DW CAT DW BL DW SUB DW ZBRANL2031 DW $15 DW DUP DW CAT DW CLIT DFB $2E DW SUB DW ZERO DW QERR DW ZERO DW BRANL2041 DW $FFDDL2042 DW DROP DW RFROM DW ZBRANL2045 DW 4 DW DMINUL2047 DW SEMISL2052 NAME $85,'-FIND' DW L2007DFIND DW DOCOL DW BL DW WORD DW HERE DW COUNT DW UPPER DW HERE DW CON DW AT DW AT DW PFIND DW DUP DW ZEQU DW ZBRANL2068 DW $A DW DROP DW HERE DW LATES DW PFINDL2073 DW SEMISL2078 NAME $87,'(ABORT)' DW L2052PABOR DW DOCOL DW ABORT DW SEMISL2087 NAME $85,'ERROR' DW L2078ERROR DW DOCOL DW WARN DW AT DW ZLESS DW ZBRAN DW L2096-* DW PABORL2096 DW HERE DW COUNT DW TYPE DW PDOTQ STR ' ? ' DW MESS DW SPSTO DW DROP,DROP DW IN DW AT DW BLK DW AT DW QUIT DW SEMISL2113 NAME $83,'ID.' DW L2087IDDOT DW DOCOL DW PAD DW CLIT DFB $20 DW CLIT DFB $5F DW FILL DW DUP DW PFA DW LFA DW OVER DW SUB DW PAD DW SWAP DW CMOVE DW PAD DW COUNT DW CLIT DFB $1F DW ANDD DW TYPE DW SPACE DW SEMISL2142 NAME $86,'CREATE' DW L2113CREAT DW DOCOL DW LIT,$A800 DW HERE DW ULESS DW TWO DW QERR DW DFIND DW ZBRANL2155 DW $0F DW DROP DW NFA DW IDDOT DW CLIT DFB 4 DW MESS DW SPACEL2163 DW HERE DW DUP DW CAT DW WIDTH DW AT DW MIN DW ONEP DW ALLOT DW DP DW CAT DW CLIT DFB $FD DW EQUAL DW ALLOT DW DUP DW CLIT DFB $A0 DW TOGGL DW HERE DW ONE DW SUB DW CLIT DFB $80 DW TOGGL DW LATES DW COMMA DW CURR DW AT DW STORE DW HERE DW TWOP DW COMMA DW SEMISL2200 NAME $C9,'[COMPILE]' DW L2142 DW DOCOL DW DFIND DW ZEQU DW ZERO DW QERR DW DROP DW CFA DW COMMA DW SEMISL2216 NAME $C7,'LITERAL' DW L2200LITER DW DOCOL DW STATE DW AT DW ZBRANL2222 DW 8 DW COMP DW LIT DW COMMAL2226 DW SEMISL2232 NAME $C8,'DLITERAL' DW L2216DLIT DW DOCOL DW STATE DW AT DW ZBRANL2238 DW 8 DW SWAP DW LITER DW LITERL2242 DW SEMISL2248 NAME $86,'?STACK' DW L2232QSTAC DW DOCOL DW CLIT DFB TOS-2 DW SPAT DW ULESS DW ONE DW QERR DW SPAT DW CLIT DFB BOS DW ULESS DW CLIT DFB 7 DW QERR DW SEMISL2269 NAME $89,'INTERPRET' DW L2248INTER DW DOCOLL2272 DW DFIND DW ZBRANL2274 DW $1E DW STATE DW AT DW LESS DW ZBRANL2279 DW $A DW CFA DW COMMA DW BRANL2283 DW $6L2284 DW CFA DW EXECL2286 DW QSTAC DW BRANL2288 DW $1CL2289 DW HERE DW NUMBER DW DPL DW AT DW ONEP DW ZBRANL2295 DW 8 DW DLIT DW BRANL2298 DW $6L2299 DW DROP DW LITERL2301 DW QSTACL2302 DW BRANL2303 DW $FFC2L2309 NAME $89,'IMMEDIATE' DW L2269 DW DOCOL DW LATES DW CLIT DFB $40 DW TOGGL DW SEMISL2321 NAME $8A,'VOCABULARY' DW L2309 DW DOCOL DW BUILD DW LIT,$A081 DW COMMA DW CURR DW AT DW CFA DW COMMA DW HERE DW VOCL DW AT DW COMMA DW VOCL DW STORE DW DOESDOVOC DW TWOP DW CON DW STORE DW SEMISL2346 NAME $C5,'FORTH' DW L2321FORTH DW DODOE DW DOVOC DW $A081XFOR DW NTOPVLO DW 0L2357 NAME $8B,'DEFINITIONS' DW L2346DEFIN DW DOCOL DW CON DW AT DW CURR DW STORE DW SEMISL2369 NAME $C1,'(' DW L2357 DW DOCOL DW CLIT DFB $29 DW WORD DW SEMISL2381 NAME $84,'QUIT' DW L2369QUIT DW DOCOL DW ZERO DW BLK DW STORE DW LBRACL2388 DW RPSTO DW CR DW QUERY DW INTER DW STATE DW AT DW ZEQU DW ZBRAN DW L2399-* DW PDOTQ STR 'OK'L2399 DW BRAN DW L2388-* DW SEMISL2406 NAME $85,'ABORT' DW L2381ABORT DW DOCOLABORT1 DW SPSTO DW DECIM DW DR0 DW CR DW PDOTQ STR 'APPLE-DAYTON ProFORTH V3.2' DW CR DW FORTH DW DEFIN DW QUITL2423 NAME $84,'COLD' DW L2406COLD DW *+2 LDA #>WARM STA $3F9 LDA #<WARM STA $3FA LDA #>RESET STA $3F2 LDA #<RESET STA $3F3 EOR #$A5 STA $3F4 LDA #$4C STA $3EA LDA #>MYHOOK STA $3EB LDA #<MYHOOK STA $3EC LDA ORIG+$0C STA FORTH+6 LDA ORIG+$0D STA FORTH+7 LDY #$15 BNE L2433WARM LDY #$0FL2433 LDA ORIG+$10 STA UP LDA ORIG+$11 STA UP+1L2437 LDA ORIG+$0C,Y STA (UP),Y DEY BPL L2437 LDA #$80 NULL prompt if STA $33 backspace to far JSR MYHOOK LDA #<ABORT1 STA IP+1 LDA #>ABORT1 STA IP CLD LDA #$6C STA W-1 JMP RPSTO+2RESET LDA $BF98 AND #2 BEQ RESET1 JSR $C300RESET1 JMP WARMMYKEY JSR $FF58 CMP #$FF BNE MYKEY1 LDA #$88 DEL=^HMYKEY1 RTSMYHOOK LDA KSWL+1 CMP #<MYKEY BEQ HOOKED STA MYKEY+2 LDA KSWL STA MYKEY+1 LDA #>MYKEY STA KSWL LDA #<MYKEY STA KSWL+1HOOKED RTSL2453 NAME $84,'S->D' DW L2423STOD DW DOCOL DW DUP DW ZLESS DW MINUS DW SEMISL2464 NAME $82,'+-' DW L2453PM DW DOCOL DW ZLESS DW ZBRANL2469 DW 4 DW MINUSL2471 DW SEMISL2476 NAME $83,'D+-' DW L2464DPM DW DOCOL DW ZLESS DW ZBRANL2481 DW 4 DW DMINUL2483 DW SEMISL2488 NAME $83,'ABS' DW L2476ABS DW DOCOL DW DUP DW PM DW SEMISL2498 NAME $84,'DABS' DW L2488DABS DW DOCOL DW DUP DW DPM DW SEMISL2508 NAME $83,'MIN' DW L2498MIN DW DOCOL DW OVER DW OVER DW GREAT DW ZBRANL2515 DW 4 DW SWAPL2517 DW DROP DW SEMISL2523 NAME $83,'MAX' DW L2508MAX DW DOCOL DW OVER DW OVER DW LESS DW ZBRANL2530 DW 4 DW SWAPL2532 DW DROP DW SEMISL2538 NAME $82,'M*' DW L2523MSTAR DW DOCOL DW OVER DW OVER DW XOR DW TOR DW ABS DW SWAP DW ABS DW USTAR DW RFROM DW DPM DW SEMISL2556 NAME $82,'M/' DW L2538MSLAS DW DOCOL DW OVER DW TOR DW TOR DW DABS DW R DW ABS DW USLAS DW RFROM DW R DW XOR DW PM DW SWAP DW RFROM DW PM DW SWAP DW SEMISL2579 NAME $81,'*' DW L2556STAR DW DOCOL DW USTAR DW DROP DW SEMISL2589 NAME $84,'/MOD' DW L2579SLMOD DW DOCOL DW TOR DW STOD DW RFROM DW MSLAS DW SEMISL2601 NAME $81,'/' DW L2589SLASH DW DOCOL DW SLMOD DW SWAP DW DROP DW SEMISL2612 NAME $83,'MOD' DW L2601MOD DW DOCOL DW SLMOD DW DROP DW SEMISL2622 NAME $85,'*/MOD' DW L2612SSMOD DW DOCOL DW TOR DW MSTAR DW RFROM DW MSLAS DW SEMISL2634 NAME $82,'*/' DW L2622SSLAS DW DOCOL DW SSMOD DW SWAP DW DROP DW SEMISL2645 NAME $85,'M/MOD' DW L2634MSMOD DW DOCOL DW TOR DW ZERO DW R DW USLAS DW RFROM DW SWAP DW TOR DW USLAS DW RFROM DW SEMISL2662 NAME $83,'USE' DW L2645USE DW DOVAR DW DAREAL2670 NAME $84,'PREV' DW L2662PREV DW DOVAR DW DAREAL2678 NAME $84,'+BUF' DW L2670PBUF DW DOCOL DW LIT DW SSIZE+4 DW PLUS DW DUP DW LIMIT DW EQUAL DW ZBRANL2688 DW 6 DW DROP DW FIRSTL2691 DW DUP DW PREV DW AT DW SUB DW SEMISL2700 NAME $86,'UPDATE' DW L2678UPDAT DW DOCOL DW PREV DW AT DW AT DW LIT,$8000 DW OR DW PREV DW AT DW STORE DW SEMISL2705 NAME $85,'FLUSH' DW L2700 DW DOCOL DW LIT,NBUF+1 DW ZERO,PDOL2835 DW LIT,$7FFF,BUFFR DW DROP,PLOOP,L2835-* DW SEMISL2716 NAME $8D,'EMPTY-BUFFERS' DW L2705 DW DOCOL DW FIRST DW LIMIT DW OVER DW SUB DW ERASE DW SEMISL2729 NAME $83,'DR0' DW L2716DR0 DW DOCOL DW LIT,0,OFSET,STORE DW SEMISL2740 NAME $83,'DR1' DW L2729DR1 DW DOCOL DW FSIZE,OFSET,STORE DW SEMISL2751 NAME $86,'BUFFER' DW L2740BUFFR DW DOCOL DW USE DW AT DW DUP DW TORL2758 DW PBUF DW ZBRANL2760 DW $FFFC DW USE DW STORE DW R DW AT DW ZLESS DW ZBRANL2767 DW $14 DW R DW TWOP DW R DW AT DW LIT,$7FFF DW ANDD DW ZERO DW RSLWL2776 DW R DW STORE DW R DW PREV DW STORE DW RFROM DW TWOP DW SEMISL2788 NAME $85,'BLOCK' DW L2751BLOCK DW DOCOL DW OFSET DW AT DW PLUS DW TOR DW PREV DW AT DW DUP DW AT DW R DW SUB DW DUP DW PLUS DW ZBRANL2804 DW $34L2805 DW PBUF DW ZEQU DW ZBRANL2808 DW $14 DW DROP DW R DW BUFFR DW DUP DW R DW ONE DW RSLW DW TWO DW SUBL2818 DW DUP DW AT DW R DW SUB DW DUP DW PLUS DW ZEQU DW ZBRANL2826 DW $FFD6 DW DUP DW PREV DW STOREL2830 DW RFROM DW DROP DW TWOP DW SEMISL2838 NAME $86,'(LINE)' DW L2788PLINE DW DOCOL DW TOR DW CSLL DW BBUF DW SSMOD DW RFROM DW BSCR DW STAR DW PLUS DW BLOCK DW PLUS DW CSLL DW SEMISL2857 NAME $85,'.LINE' DW L2838DLINE DW DOCOL DW PLINE DW DTRAI DW TYPE DW SEMISL2868 NAME $87,'MESSAGE' DW L2857MESS DW DOCOL DW WARN DW AT DW ZBRAN DW L2888-* DW CLIT DFB 4 DW OFSET DW AT DW BSCR DW SLASH DW SUB DW DLINE DW BRAN DW L2891-*L2888 DW PDOTQ STR 'MSG #' DW DOTL2891 DW SEMISL2896 NAME $84,'LOAD' DW L2868LOAD DW DOCOL DW BLK DW AT DW TOR DW IN DW AT DW TOR DW ZERO DW IN DW STORE DW BSCR DW STAR DW BLK DW STORE DW INTER DW RFROM DW IN DW STORE DW RFROM DW BLK DW STORE DW SEMISL2924 NAME $C3,'-->' DW L2896 DW DOCOL DW QLOAD DW ZERO DW IN DW STORE DW BSCR DW BLK DW AT DW OVER DW MOD DW SUB DW BLK DW PSTOR DW SEMISXEMIT INC UAREA+$1A BNE XEMIT1 INC UAREA+$1BXEMIT1 LDA 0,X STX XSAVE ORA #$80 JSR OUTCH LDX XSAVE JMP POPXKEY STX XSAVE JSR INCH AND #$7F LDX XSAVE JMP PUSHOAXQTER BIT $C000 BPL XQTER2XQTER1 BIT $C010 BIT $C000 BMI XQTER1 INYXQTER2 TYA JMP PUSHOAXCR STX XSAVE JSR CROUT LDX XSAVE JMP NEXTL3050 NAME $85,'(R/W)' DW L2924PRSLW DW *+2 LDA 0,X STA SETREF STA RWREF LDA #$CA STA RWCOM LDA 2,X BNE PRSLW1 LDA #$CB STA RWCOMPRSLW1 LDA 6,X STA RWBUF LDA 7,X STA RWBUF+1 LDA 4,X ASL A STA SETPOS+1 LDA 5,X ROL A STA SETPOS+2 ASL SETPOS+1 ROL SETPOS+2 JSR MLI DB $CE Set file position DW SETLIST BCS PRSLW2 JSR MLIRWCOM DB 0 Read/write command DW RWLISTPRSLW2 PHA TXA CLC ADC #6 TAX TYA JMP PUTSETLIST DB 2SETREF DB 0SETPOS DB 0,0,0RWLIST DB 4RWREF DB 0RWBUF DW 0RWLEN DW 1024,0FCLIST DB 1,0BLIST DFB 4,0,0,0,0,0,0L3060 NAME $83,'R/W' DW L3050RSLW DW DOCOL,TOR,DUP,FSIZE,ULESS DW ZBRAN,RSLW1-* DW ONE,BRAN,RSLW2-*RSLW1 DW FSIZE,SUB,TWORSLW2 DW RFROM,SWAP,PRSLW DW DDUP,ZBRAN,RSLW3-* DW DOT,LIT,8,ERRORRSLW3 DW SEMISL3202 NAME $C1,"'" DW L3060TICK DW DOCOL DW DFIND DW ZEQU DW ZERO DW QERR DW DROP DW LITER DW SEMISL3217 NAME $86,'FORGET' DW L3202FORG DW DOCOL DW TICK,NFA,DUP DW FENCE,AT,ULESS,CLIT DFB $15 DW QERR,TOR,VOCL,ATL3220 DW R,OVER,ULESS DW ZBRAN,L3225-* DW FORTH,DEFIN,AT,DUP DW VOCL,STORE DW BRAN,$FFFF-24+1 ;L3220-*L3225 DW DUP,CLIT DFB 4 DW SUBL3228 DW PFA,LFA,AT DW DUP,R,ULESS DW ZBRAN,$FFFF-14+1 ;L3228-* DW OVER,TWO,SUB,STORE DW AT,DDUP,ZEQU DW ZBRAN,$FFFF-39+1 ;L3225-* DW RFROM,DP,STORE DW SEMISL3250 NAME $84,'BACK' DW L3217BACK DW DOCOL DW HERE DW SUB DW COMMA DW SEMISL3261 NAME $C5,'BEGIN' DW L3250 DW DOCOL DW QCOMP DW HERE DW ONE DW SEMISL3273 NAME $C5,'ENDIF' DW L3261ENDIF DW DOCOL DW QCOMP DW TWO DW QPAIR DW HERE DW OVER DW SUB DW SWAP DW STORE DW SEMISL3290 NAME $C4,'THEN' DW L3273 DW DOCOL DW ENDIF DW SEMISL3300 NAME $C2,'DO' DW L3290 DW DOCOL DW COMP DW PDO DW HERE DW THREE DW SEMISL3313 NAME $C4,'LOOP' DW L3300 DW DOCOL DW THREE DW QPAIR DW COMP DW PLOOP DW BACK DW SEMIS DW SEMISL3327 NAME $C5,'+LOOP' DW L3313 DW DOCOL DW THREE DW QPAIR DW COMP DW PPLOO DW BACK DW SEMISL3341 NAME $C5,'UNTIL' DW L3327UNTIL DW DOCOL DW ONE DW QPAIR DW COMP DW ZBRAN DW BACK DW SEMISL3355 NAME $C3,'END' DW L3341 DW DOCOL DW UNTIL DW SEMISL3365 NAME $C5,'AGAIN' DW L3355AGAIN DW DOCOL DW ONE DW QPAIR DW COMP DW BRAN DW BACK DW SEMISL3379 NAME $C6,'REPEAT' DW L3365 DW DOCOL DW TOR DW TOR DW AGAIN DW RFROM DW RFROM DW TWO DW SUB DW ENDIF DW SEMISL3396 NAME $C2,'IF' DW L3379IF DW DOCOL DW COMP DW ZBRAN DW HERE DW ZERO DW COMMA DW TWO DW SEMISL3411 NAME $C4,'ELSE' DW L3396 DW DOCOL DW TWO DW QPAIR DW COMP DW BRAN DW HERE DW ZERO DW COMMA DW SWAP DW TWO DW ENDIF DW TWO DW SEMISL3431 NAME $C5,'WHILE' DW L3411 DW DOCOL DW IF DW TWOP DW SEMISL3442 NAME $86,'SPACES' DW L3431SPACS DW DOCOL DW ZERO DW MAX DW DDUP DW ZBRANL3449 DW $0C DW ZERO DW PDOL3452 DW SPACE DW PLOOPL3454 DW $FFFCL3455 DW SEMISL3460 NAME $82,'<#' DW L3442BDIGS DW DOCOL DW PAD DW HLD DW STORE DW SEMISL3471 NAME $82,'#>' DW L3460EDIGS DW DOCOL DW DROP DW DROP DW HLD DW AT DW PAD DW OVER DW SUB DW SEMISL3486 NAME $84,'SIGN' DW L3471SIGN DW DOCOL DW ROT DW ZLESS DW ZBRANL3492 DW $7 DW CLIT DFB $2D DW HOLDL3496 DW SEMISL3501 DFB $81,$A3 DW L3486DIG DW DOCOL DW BASE DW AT DW MSMOD DW ROT DW CLIT DFB 9 DW OVER DW LESS DW ZBRANL3513 DW 7 DW CLIT DFB 7 DW PLUSL3517 DW CLIT DFB $30 DW PLUS DW HOLD DW SEMISL3526 NAME $82,'#S' DW L3501DIGS DW DOCOLL3529 DW DIG DW OVER DW OVER DW OR DW ZEQU DW ZBRANL3535 DW $FFF4 DW SEMISL3541 NAME $83,'D.R' DW L3526DDOTR DW DOCOL DW TOR DW SWAP DW OVER DW DABS DW BDIGS DW DIGS DW SIGN DW EDIGS DW RFROM DW OVER DW SUB DW SPACS DW TYPE DW SEMISL3562 NAME $82,'D.' DW L3541DDOT DW DOCOL DW ZERO DW DDOTR DW SPACE DW SEMISL3573 NAME $82,'.R' DW L3562DOTR DW DOCOL DW TOR DW STOD DW RFROM DW DDOTR DW SEMISL3585 DFB $81,$AE DW L3573DOT DW DOCOL DW STOD DW DDOT DW SEMISL3595 NAME $81,'?' DW L3585QUES DW DOCOL DW AT DW DOT DW SEMISL3605 NAME $84,'LIST' DW L3595LIST DW DOCOL DW DECIM DW CR DW DUP DW SCR DW STORE DW PDOTQ DFB 6 ASC 'Scr # ' DW DOT DW CLIT DFB 16 DW ZERO DW PDOL3620 DW CR DW I DW THREE DW DOTR DW SPACE DW I DW SCR DW AT DW DLINE DW PLOOPL3630 DW $FFEC DW CR DW SEMISL3637 NAME $85,'INDEX' DW L3605 DW DOCOL DW CR DW ONEP DW SWAP DW PDOL3647 DW CR DW I DW THREE DW DOTR DW SPACE DW ZERO DW I DW DLINE DW QTERM DW ZBRANL3657 DW 4 DW LEAVEL3659 DW PLOOPL3660 DW $FFE6 DW CLIT DFB $0D DW EMIT DW SEMISL3666 NAME $85,'TRIAD' DW L3637 DW DOCOL DW THREE DW SLASH DW THREE DW STAR DW THREE DW OVER DW PLUS DW SWAP DW PDOL3681 DW CR DW I DW LIST DW PLOOPL3685 DW $FFF8 DW CR DW CLIT DFB $F DW MESS DW CR DW CLIT DFB $0D DW EMIT DW SEMISL3696 NAME $85,'VLIST' DW L3666VLIST DW DOCOL DW CLIT DFB $80 DW OUT DW STORE DW CON DW AT DW ATL3706 DW OUT DW AT DW CSLL DW GREAT DW ZBRAN DW L3716-* DW CR DW ZERO DW OUT DW STOREL3716 DW DUP DW IDDOT DW SPACE DW SPACE DW PFA DW LFA DW AT DW DUP DW ZEQU DW QTERM DW OR DW ZBRAN DW L3706-* DW DROP DW SEMISNMON NAME $83,'MON' DW L3696MON DW *+2 JMP MONITORNMLI NAME $83,'MLI' DW NMONDOMLI DW *+2 LDA 0,X STA MLICOM LDA 2,X STA MLICOM+1 LDA 3,X STA MLICOM+2 JSR MLIMLICOM DFB 0,0,0 INX INX PHA TYA JMP PUTNCALL NAME $84,'CALL' DW NMLICALL DW *+2 STX XSAVE LDA 0,X STA CALL1+1 LDA 1,X STA CALL1+2 LDA 0 LDX 1 LDY 2CALL1 JSR 0 STY 2 STX 1 STA 0 LDX XSAVE JMP POPNTOP NAME $83,'BYE' DW NCALLBYE DW *+2 JSR MLI DB $CC DW FCLIST JSR MLI DFB $65 DW BLISTTOP DFB 00