DB 86H ASC 'EXPEC' DB 'T'+80H DW DOTQ-5 EXPEC DW DOCOL DW OVER DW PLUS DW OVER DW XDO EXPE1 DW KEY DW DUP DW LIT DW 0EH DW PORIG DW AT DW EQUAL DW ZBRAN DW EXPE2-$ DW DROP DW DUP DW IDO DW EQUAL DW DUP DW FROMR DW TWO DW SUBB DW PLUS DW TOR DW ZBRAN DW EXPE6-$ DW LIT DW BELL DW BRAN DW EXPE3-$ EXPE6 DW LIT DW BSOUT EXPE7 DW BRAN DW EXPE3-$ EXPE2 DW DUP DW LIT DW 0DH DW EQUAL DW ZBRAN DW EXPE4-$ DW LEAVE DW DROP DW BL DW ZERO DW BRAN DW EXPE5-$ EXPE4 DW DUP EXPE5 DW IDO DW CSTOR DW ZERO DW IDO DW ONEP DW STORE EXPE3 DW EMIT DW XLOOP DW EXPE1-$ DW DROP DW SEMIS * DB 85H ASC 'QUER' DB 'Y'+80H DW EXPEC-9 QUERY DW DOCOL DW TIB DW AT DW LIT DW 400H DW EXPEC DW ZERO DW INN DW STORE DW SEMIS * DB 0C1H 0 (Null) DB 80H DW QUERY-8 NULL DW DOCOL DW BLK DW AT DW ZBRAN DW NULL1-$ DW ONE DW BLK DW PSTOR DW ZERO DW INN DW STORE DW BLK DW AT DW BSCR DW ONE DW SUBB DW ANDD DW ZEQU DW ZBRAN DW NULL2-$ DW QEXEC DW FROMR DW DROP NULL2 DW BRAN DW NULL3-$ NULL1 DW FROMR DW DROP NULL3 DW SEMIS * DB 84H ASC 'FIL' DB 'L'+80H DW NULL-4 FILL DW $+2 MOV L,C MOV H,B POP D POP B XTHL . XCHG . FILL1 MOV A,B ORA C JZ FILL2 MOV A,L STAX D INX D DCX B JMP FILL1 FILL2 POP B JMP NEXT * DB 85H ASC 'ERAS' DB 'E'+80H DW FILL-7 ERASE DW DOCOL DW ZERO DW FILL DW SEMIS * DB 86H ASC 'BLANK' DB 'S'+80H DW ERASE-8 BLANK DW DOCOL DW BL DW FILL DW SEMIS * DB 84H ASC 'HOL' DB 'D'+80H DW BLANK-9 HOLD DW DOCOL DW LIT DW -1 DW HLD DW PSTOR DW HLD DW AT DW CSTOR DW SEMIS * DB 83H ASC 'PA' DB 'D'+80H DW HOLD-7 PAD DW DOCOL DW HERE DW LIT DW 44H DW PLUS DW SEMIS * DB 84H ASC 'WOR' DB 'D'+80H DW PAD-6 WORD DW DOCOL DW BLK DW AT DW ZBRAN DW WORD1-$ DW BLK DW AT DW BLOCK DW BRAN DW WORD2-$ WORD1 DW TIB DW AT WORD2 DW INN DW AT DW PLUS DW SWAP DW ENCL DW HERE DW LIT DW 22H DW BLANK DW INN DW PSTOR DW OVER DW SUBB DW TOR DW RR DW HERE DW CSTOR DW PLUS DW HERE DW ONEP DW FROMR DW CMOVE DW SEMIS * DB 88H ASC '(NUMBER' DB ')'+80H DW WORD-7 PNUMB DW DOCOL PNUM1 DW ONEP DW DUP DW TOR DW CAT DW BASE DW AT DW DIGIT DW ZBRAN DW PNUM2-$ 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 ZBRAN DW PNUM3-$ DW ONE DW DPL DW PSTOR PNUM3 DW FROMR DW BRAN DW PNUM1-$ PNUM2 DW FROMR DW SEMIS * DB 86H ASC 'NUMBE' DB 'R'+80H DW PNUMB-0BH NUMB DW DOCOL DW ZERO DW ZERO DW ROT DW DUP DW ONEP DW CAT DW LIT DW 2DH DW EQUAL DW DUP DW TOR DW PLUS DW LIT DW -1 NUMB1 DW DPL DW STORE DW PNUMB DW DUP DW CAT DW BL DW SUBB DW ZBRAN DW NUMB2-$ DW DUP DW CAT DW LIT DW 2EH DW SUBB DW ZERO DW QERR DW ZERO DW BRAN DW NUMB1-$ NUMB2 DW DROP DW FROMR DW ZBRAN DW NUMB3-$ DW DMINU NUMB3 DW SEMIS * DB 85H ASC '-FIN' DB 'D'+80H DW NUMB-9 DFIND DW DOCOL DW BL DW WORD DW HERE DW CONT DW AT DW AT DW PFIND DW DUP DW ZEQU DW ZBRAN DW DFIN1-$ DW DROP DW HERE DW LATES DW PFIND DFIN1 DW SEMIS * DB 87H ASC '(ABORT' DB ')'+80H DW DFIND-8 PABOR DW DOCOL DW ABORT DW SEMIS * DB 85H ASC 'ERRO' DB 'R'+80H DW PABOR-0AH ERROR DW DOCOL DW WARN DW AT DW ZLESS DW ZBRAN DW ERRO1-$ DW PABOR ERRO1 DW HERE DW COUNT DW TYPE DW PDOTQ DB 3 ASC ' ? ' DW MESS DW SPSTO DW ZERO Clean up the stack a bit DW SWAP DW DROP DW BLK DW AT DW DDUP DW ZBRAN DW ERRO2-$ DW INN DW AT DW SWAP ERRO2 DW QUIT * DB 83H ASC 'ID' DB '.'+80H DW ERROR-8 IDDOT DW DOCOL DW PAD DW LIT DW 20H DW LIT DW 5FH DW FILL DW DUP DW PFA DW LFA DW OVER DW SUBB DW PAD DW SWAP DW CMOVE DW PAD DW COUNT DW LIT DW 1FH DW ANDD DW TYPE DW SPACE DW SEMIS * DB 86H ASC 'CREAT' DB 'E'+80H DW IDDOT-6 CREAT DW DOCOL DW DFIND DW ZBRAN DW CREA1-$ DW DROP DW NFA DW IDDOT DW LIT DW 4 DW MESS DW SPACE CREA1 DW HERE DW DUP DW CAT DW WIDTH DW AT DW MIN DW ONEP DW ALLOT DW DUP DW LIT DW 0A0H DW TOGGL DW HERE DW ONE DW SUBB DW LIT DW 80H DW TOGGL DW LATES DW COMMA DW CURR DW AT DW STORE DW HERE DW TWOP DW COMMA DW SEMIS * DB 0C9H ASC '[COMPILE' DB ']'+80H DW CREAT-9 BCOMP DW DOCOL DW DFIND DW ZEQU DW ZERO DW QERR DW DROP DW CFA DW COMMA DW SEMIS * DB 0C7H ASC 'LITERA' DB 'L'+80H DW BCOMP-0CH LITER DW DOCOL DW STATE DW AT DW ZBRAN DW LITE1-$ DW COMP DW LIT DW COMMA LITE1 DW SEMIS * DB 0C8H ASC 'DLITERA' DB 'L'+80H DW LITER-0AH DLITE DW DOCOL DW STATE DW AT DW ZBRAN DW DLIT1-$ DW SWAP DW LITER DW LITER DLIT1 DW SEMIS * DB 86H ASC '?STAC' DB 'K'+80H DW DLITE-0BH QSTAC DW DOCOL DW SPAT DW SZERO DW AT DW SWAP DW ULESS DW ONE DW QERR DW SPAT DW HERE DW LIT DW 80H DW PLUS DW ULESS DW LIT DW 7 DW QERR DW SEMIS * DB 89H ASC 'INTERPRE' DB 'T'+80H DW QSTAC-9 INTER DW DOCOL INTE1 DW DFIND DW ZBRAN DW INTE2-$ DW STATE DW AT DW LESS DW ZBRAN DW INTE3-$ DW CFA DW COMMA DW BRAN DW INTE4-$ INTE3 DW CFA DW EXEC INTE4 DW QSTAC DW BRAN DW INTE5-$ INTE2 DW HERE DW NUMB DW DPL DW AT DW ONEP DW ZBRAN DW INTE6-$ DW DLITE DW BRAN DW INTE7-$ INTE6 DW DROP DW LITER INTE7 DW QSTAC INTE5 DW BRAN DW INTE1-$ * DB 89H ASC 'IMMEDIAT' DB 'E'+80H DW INTER-0CH IMMED DW DOCOL DW LATES DW LIT DW 40H DW TOGGL DW SEMIS * DB 8AH ASC 'VOCABULAR' DB 'Y'+80H DW IMMED-0CH VOCAB DW DOCOL DW BUILD DW LIT DW 0A081H DW COMMA DW CURR DW AT DW CFA DW COMMA DW HERE DW VOCL DW AT DW COMMA DW VOCL DW STORE DW DOES DOVOC DW TWOP DW CONT DW STORE DW SEMIS * DB 0C5H ASC 'FORT' DB 'H'+80H DW VOCAB-0DH FORTH DW DODOE DW DOVOC DW 0A081H DW TASK-7 * DW 0 * DB 8BH ASC 'DEFINITION' DB 'S'+80H DW FORTH-8 DEFIN DW DOCOL DW CONT DW AT DW CURR DW STORE DW SEMIS * DB 0C1H DB '('+80H DW DEFIN-0EH PAREN DW DOCOL DW LIT DW 29H ')' DW WORD DW SEMIS * DB 84H ASC 'QUI' DB 'T'+80H DW PAREN-4 QUIT DW DOCOL DW ZERO DW BLK DW STORE DW LBRAC QUIT1 DW RPSTO DW CR DW QUERY DW INTER DW STATE DW AT DW ZEQU DW ZBRAN DW QUIT2-$ DW PDOTQ DB 2 ASC 'ok' QUIT2 DW BRAN DW QUIT1-$ * DB 85H ASC 'ABOR' DB 'T'+80H DW QUIT-7 ABORT DW DOCOL DW NOOP String stack check goes here (if loaded) DW SPSTO DW ZERO Puts a zero under stack (for neatness) DW SWAP DW DROP DW DEC DW QSTAC DW CLS DW CR DW PDOTQ DB 1EH ASC 'Proteus 8080 Disk Forth ' DB FIGRL+30H,ADOT,FIGRV+30H,USRVER+30H DB ACR DB LF * DW FORTH DW DEFIN IF SOL DW STRAP Set the PTDOS error trap ENDF DW QUIT * WRM LXI B,WRM1 JMP NEXT * WRM1 DW WARM * DB 84H ASC 'WAR' DB 'M'+80H DW ABORT-8 WARM DW DOCOL DW MTBUF DW ABORT * CLD LXI B,CLD1 LHLD ORIG+12H SPHL . LDA GLBIO *** For PTDOS only STA CLD2 *** MVI A,1 *** STA GLBIO *** JMP NEXT CLD1 DW COLD * CLD2 DB 0 *** For PTDOS system only * DB 84H ASC 'COL' DB 'D'+80H DW WARM-7 COLD DW DOCOL DW MTBUF DW ZERO DW DENSTY DW STORE DW LIT DW BUF1 DW USE DW STORE DW LIT DW BUF1 DW PREV DW STORE DW DRZER * DW LIT DW ORIG+12H DW LIT DW UP DW AT DW LIT DW 6 DW PLUS DW LIT DW 10H DW CMOVE DW LIT DW ORIG+0CH DW AT DW LIT DW FORTH+6 DW STORE DW ABORT * DB 84H ASC 'S->' DB 'D'+80H DW COLD-7 STOD DW $+2 POP D LXI H,0 MOV A,D ANI 80H JZ STOD1 DCX H STOD1 JMP DPUSH * DB 82H ASC '+' DB '-'+80H DW STOD-7 PM DW DOCOL DW ZLESS DW ZBRAN DW PM1-$ DW MINUS PM1 DW SEMIS * DB 83H ASC 'D+' DB '-'+80H DW PM-5 DPM DW DOCOL DW ZLESS DW ZBRAN DW DPM1-$ DW DMINU DPM1 DW SEMIS * DB 83H ASC 'AB' DB 'S'+80H DW DPM-6 ABS DW DOCOL DW DUP DW PM DW SEMIS * DB 84H ASC 'DAB' DB 'S'+80H DW ABS-6 DABS DW DOCOL DW DUP DW DPM DW SEMIS * DB 83H ASC 'MI' DB 'N'+80H DW DABS-7 MIN DW DOCOL DW TDUP DW GREAT DW ZBRAN DW MIN1-$ DW SWAP MIN1 DW DROP DW SEMIS * DB 83H ASC 'MA' DB 'X'+80H DW MIN-6 MAX DW DOCOL DW TDUP DW LESS DW ZBRAN DW MAX1-$ DW SWAP MAX1 DW DROP DW SEMIS * DB 82H ASC 'M' DB '*'+80H DW MAX-6 MSTAR DW DOCOL DW TDUP DW XORR DW TOR DW ABS DW SWAP DW ABS DW USTAR DW FROMR DW DPM DW SEMIS * DB 82H ASC 'M' DB '/'+80H DW MSTAR-5 MSLAS DW DOCOL DW OVER DW TOR DW TOR DW DABS DW RR DW ABS DW USLAS DW FROMR DW RR DW XORR DW PM DW SWAP DW FROMR DW PM DW SWAP DW SEMIS * DB 81H DB '*'+80H DW MSLAS-5 STAR DW DOCOL : * U* DROP ; DW USTAR DW DROP DW SEMIS * DB 84H ASC '/MO' DB 'D'+80H DW STAR-4 SLMOD DW DOCOL : /MOD >R S->D R> M/ ; DW TOR DW STOD DW FROMR DW MSLAS DW SEMIS * DB 81H DB '/'+80H DW SLMOD-7 SLASH DW DOCOL : / /MOD SWAP DROP ; DW SLMOD DW SWAP DW DROP DW SEMIS * DB 83H ASC 'MO' DB 'D'+80H DW SLASH-4 MODD DW DOCOL : MOD /MOD DROP ; DW SLMOD DW DROP DW SEMIS * DB 85H ASC '*/MO' DB 'D'+80H DW MODD-6 SSMOD DW DOCOL : */MOD >R M* R> M/ ; DW TOR DW MSTAR DW FROMR DW MSLAS DW SEMIS * DB 82H ASC '*' DB '/'+80H DW SSMOD-8 SSLA DW DOCOL : */ */MOD SWAP DROP ; DW SSMOD DW SWAP DW DROP DW SEMIS * DB 85H ASC 'M/MO' DB 'D'+80H DW SSLA-5 MSMOD DW DOCOL DW TOR DW ZERO DW RR DW USLAS DW FROMR DW SWAP DW TOR DW USLAS DW FROMR DW SEMIS * DB 86H ASC '(LINE' DB ')'+80H DW MSMOD-8 PLINE DW DOCOL DW TOR DW LIT DW 40H DW BBUF DW SSMOD DW FROMR DW BSCR DW STAR DW PLUS DW BLOCK DW PLUS DW LIT DW 40H DW SEMIS * DB 85H ASC '.LIN' DB 'E'+80H DW PLINE-9 DLINE DW DOCOL DW PLINE DW DTRAI DW TYPE DW SEMIS * DB 87H ASC 'MESSAG' DB 'E'+80H DW DLINE-8 MESS DW DOCOL DW WARN DW AT DW ZBRAN DW MESS1-$ DW DDUP DW ZBRAN DW MESS2-$ DW LIT DW 4 DW OFSET DW AT DW BSCR DW SLASH DW SUBB DW DLINE DW SPACE MESS2 DW BRAN DW MESS3-$ IF SOL MESS1 DW LIT DW 21 DW STAR DW LIT DW ASCMES DW PLUS DW LIT DW 21 DW DTRAI DW TYPE DW BRAN DW MESS3-$ ASCMES EQU $ ASC ' ' ASC 'Empty stack ' ASC 'Dictionary is full ' ASC 'MSG # 3 ' ASC 'is not unique ' ASC 'MSG # 5 ' ASC 'Disk range ? ' ASC 'Stack is full ' ASC 'Disk error ! ' DS 21*8 ASC 'Compilation mode only' ASC 'Execution mode only ' ASC 'Conditionals unpaired' ASC 'Definition unfinished' ASC 'In guarded dictionary' ENDF IF FIG MESS1 DW PDOTQ DB 6 ASC 'MSG # ' DW DOT ENDF MESS3 DW SEMIS * * * * * DB 82H ASC 'P' DB '@'+80H DW MESS-0AH PTAT DW $+2 POP D LXI H,$+2 MOV M,E IN 0 MOV L,A MVI H,0 JMP HPUSH * DB 82H ASC 'P' DB '!'+80H DW PTAT-5 PTSTO DW $+2 POP D LXI H,$+4 MOV M,E POP H MOV A,L OUT 0 JMP NEXT * page