From 7ae1202132642912db4025fcf2c3bea0ba1af449 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Wed, 22 Aug 2018 13:43:02 +0200 Subject: [PATCH] Port TENTH to MIDAS. --- Makefile | 2 +- build/misc.tcl | 4 + doc/programs.md | 1 + src/aap/tenth.2 | 953 ++++++++++++++++++++++++++++++++++++++++++++++++ src/aap/tenth.s | 947 ----------------------------------------------- 5 files changed, 959 insertions(+), 948 deletions(-) create mode 100644 src/aap/tenth.2 delete mode 100644 src/aap/tenth.s diff --git a/Makefile b/Makefile index 4a7595ac..0a245032 100644 --- a/Makefile +++ b/Makefile @@ -23,7 +23,7 @@ SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \ jim jm jpg macrak maxdoc maxsrc mrg munfas paulw reh rlb rlb% share \ tensor transl wgd zz graphs lmlib pratt quux scheme gsb ejs mudsys \ draw wl taa tj6 budd sharem ucode rvb kldcp math as imsrc gls demo \ - macsym lmcons dmcg hack hibou agb gt40 rug maeda ms kle + macsym lmcons dmcg hack hibou agb gt40 rug maeda ms kle aap DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \ xfont maxout ucode moon acount alan channa fonts games graphs humor \ diff --git a/build/misc.tcl b/build/misc.tcl index 9573c596..6bb7f3d9 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -1162,6 +1162,10 @@ respond "PURIFIED" "\r" respond "*" ":pdump sys; ts logo\r" respond "*" ":kill\r" +# TENTH, toy Forth for KS10. +respond "*" ":midas .; @ tenth_aap; tenth\r" +expect ":KILL" + # 11BOOT respond "*" ":midas /t sys3;ts 11boot_syseng;11boot\r" respond "with ^C" "APR==0\r\003" diff --git a/doc/programs.md b/doc/programs.md index b9fd83c9..dea2d600 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -234,6 +234,7 @@ - TELNET, Telnet client. - TELSER, Telnet/Supdup server. - TEN50, TOPS-10 emulator. +- TENTH, toy Forth for KS10. - THINK, think-a-dot game. - TIME, displays date/time/uptime and other info. - TIMES, TCP time server. diff --git a/src/aap/tenth.2 b/src/aap/tenth.2 new file mode 100644 index 00000000..5e34c903 --- /dev/null +++ b/src/aap/tenth.2 @@ -0,0 +1,953 @@ +TITLE TENTH + +EXPUNGE .SWAP,.BEGIN,.END,.ELSE,.I + +X=14 ; pointer into code/parameter field +PC=15 ; the interpreter's program counter +PP=16 ; parameter stack pointer +P=17 ; return stack pointer +APR=0 +CTYIN=32 +CTYOUT=33 + +PDLLEN=100 +PDL: .=.+PDLLEN +PPDL: .=.+PDLLEN +RSP: -PDLLEN,,PDL-1 +PSP: -PDLLEN,,PPDL-1 +INP: 0 +INBUF: 0 ? .=.+40 +INBUFBP: 440700,,INBUF+1 +WORDBUF: 0 ? .=.+10 +WORDBP: 440700,,WORDBUF+1 + +START: + SETZM CTYIN + MOVE P,RSP + MOVE PP,PSP + MOVEI PC,[.QUIT] + JRST NEXT + +; +; output +; + +; print ASCII character in AC 0 - changes AC 0 +PUTCHAR: + IORI 0,400 ; valid bit + MOVEM 0,CTYOUT + CONO APR,12000 ; 10000 = set flags, 2000 = interrupt flag + SKIPE CTYOUT ; wait for transmission to complete + JRST .-1 + CAIE 0,400\^J + POPJ P, + MOVEI 0,^M + JRST PUTCHAR + +; print null-terminated ASCII string in AC 0 - changes AC 0 1 +PUTS: + MOVE 1,0 ; address + HRLI 1,440700 ; 7-bit bytes + ILDB 0,1 + CAIN 0,0 + POPJ P, + PUSHJ P,PUTCHAR + JRST .-4 + +; prints a counted ASCII string in AC 0 +PUTSN: + MOVE 2,@0 ; char count + AOS 0 + MOVE 1,0 + HRLI 1,440700 +PUTSN1: SOSGE 2 + POPJ P, + ILDB 0,1 + PUSHJ P,PUTCHAR + JRST PUTSN1 + +; print 'panic' and halt +PANIC: + MOVEI 0,[ ASCIZ " panic " ] + PUSHJ P,PUTS + JRST 4,. + +BASE: 12 +DIGITS: "0 ? "1 ? "2 ? "3 ? "4 ? "5 ? "6 ? "7 ? "8 ? "9 ? "A ? "B ? "C ? "D ? "E ? "F + +; print number in AC 1 - changes AC 0 1 2 +PRINTN: + JUMPGE 1,UPRINTN + MOVEI 0,"- + PUSHJ P,PUTCHAR + MOVM 1,1 +UPRINTN: + IDIV 1,BASE + JUMPE 1,UPR1 + PUSH P,2 + PUSHJ P,UPRINTN + POP P,2 +UPR1: + MOVE 0,DIGITS(2) + JRST PUTCHAR + +; prints number in AC 1 and a space - changes AC 0 1 +PRNTNSP: + PUSHJ P,PRINTN + MOVEI 0,40 ; space + JRST PUTCHAR + +; reads one character into AC 0 +GETCH: + CONO APR,12000 ; 10000 = set flags, 2000 = interrupt flag + MOVE 0,CTYIN + CAIN 0,0 + JRST .-2 + SETZM CTYIN + TRZ 0,400 + CAIN 0,^M + MOVEI 0,^J + POPJ P, + +; +; input +; + +; reads one character into AC 0 and echos - changes AC 0 1 +GETCHAR: + PUSHJ P,GETCH + MOVE 1,0 + PUSHJ P,PUTCHAR + MOVE 0,1 + POPJ P, + +; reads characters into INBUF - changes AC 0 1 2 +GETS: + SETZM INP + MOVE 1,INBUFBP + SETZ 2, +NEXTC: PUSHJ P,GETCH + CAIN 0,^J + JRST GETSNL + CAIN 0,25 + JRST GETSKL + CAIN 0,^H + JRST GETSBS + IDPB 0,1 + AOS 2 + PUSHJ P,PUTCHAR + JRST NEXTC +GETSKL: ; kill line + MOVEI 0,^J + PUSHJ P,PUTCHAR + JRST GETS +GETSBS: ; backspace + PUSHJ P,PUTCHAR + MOVE 1,INBUFBP + SOSGE 2 + SETZ 2, + MOVE 0,2 + SOSGE 0 + JRST NEXTC + IBP 1 + JRST .-3 +GETSNL: + MOVEI 0,40 ; space + PUSHJ P,PUTCHAR + SETZ 0, + IDPB 0,1 + MOVEM 2,INBUF + POPJ P, + +; +; forth things +; + +; Code field values +ASM: + AOS X + JRST (X) + +DOCON: + AOS X + MOVE 0,(X) + PUSH PP,0 + JRST NEXT + +DOVAR: + AOS X + PUSH PP,X + JRST NEXT + +DOCOL: + AOS X + PUSH P,PC + MOVE PC,X + JRST NEXT + +; counterpart of DOCOL +..EXIT: 0 ? 0,,4 ? ASCII "EXIT" +.EXIT: ASM + POP P,PC + JRST NEXT + +; execute forth word at PC and increment PC +NEXT: MOVE X,(PC) + AOS PC + MOVE 1,(X) + JRST (1) + +; Dictionary +LATEST: .LATEST +HERE: END1 + +; parses one word from the input stream into the word buffer +; skips if a word was read +PARSEWORD: + SETZM WORDBUF + MOVE 0,INP + MOVE 1,INBUFBP + SOSGE 0 + JRST .+3 + IBP 1 + JRST .-3 + POP PP,2 ; terminator + MOVE 0,INP +PWDELIM: + ILDB 3,1 + AOS 0 + CAMLE 0,INBUF ; check length + JRST PWEND + CAMN 3,2 ; check for delimiter + JRST PWDELIM + MOVEM 0,INP ; save beginning of word + MOVE 4,WORDBP +PWCHAR: + IDPB 3,4 + ILDB 3,1 + AOS 0 + CAMLE 0,INBUF ; check length + JRST .+3 + CAME 3,2 ; check for delimiter + JRST PWCHAR + MOVE 1,INP + SUB 1,0 + MOVMM 1,WORDBUF +PWEND: + MOVEM 0,INP + SKIPE WORDBUF ; skip one instruction if we have a word + AOS (P) + POPJ P, + +; find word AC 1 in dictionary, skip if found at return it in AC 1 +FIND: + MOVE 2,LATEST + SKIPA +FINDNEXT: + MOVE 2,(2) + SKIPN 2 + POPJ P, ; not found + HRRZ 0,1(2) ; length + CAME 0,(1) + JRST FINDNEXT + MOVEI 3,1(1) ; byte pointer of word to look up + HRLI 3,440700 + MOVEI 4,2(2) ; byte pointer of word in dictionary + HRLI 4,440700 +FINDLOOP: + ILDB 5,3 + ILDB 6,4 + CAME 5,6 + JRST FINDNEXT + SOJG 0,FINDLOOP + ; found + MOVE 1,2 + AOS (P) + POPJ P, + +; go from dictionary entry AC 1 to code field +TCFA: + HRRZ 0,1(1) ; length + MOVEI 2,2(1) ; byte pointer + HRLI 2,440700 + IBP 2 + SOJG 0,.-1 + HRRZ 1,4 ; get word address from byte pointer + HLRZ 0,4 + CAIE 0,440700 ; go to next word unless we're already there + AOS 1 + POPJ P, + +; parse number in string AC 1, skip if number and return it in AC 0 +CHECKNUM: + SETZ 0, + MOVE 2,(1) ; length + AOS 1 + HRLI 1,440700 ; byte pointer + SETZ 4, ; sign + ILDB 3,1 + CAIE 3,"- + JRST .+5 + SOSN 2 + POPJ P, + AOS 4 +NUM1: ILDB 3,1 + CAIGE 3,"0 + POPJ P, + CAILE 3,"9 + JRST .+3 + SUBI 3,"0 + JRST NUM2 + CAIGE 3,"A + POPJ P, + CAILE 3,"F + JRST .+3 + SUBI 3,"A + JRST NUM2 + CAIGE 3,"a + POPJ P, + CAILE 3,"f + POPJ P, + SUBI 3,"a +NUM2: IMUL 0,BASE + ADD 0,3 + SOJG 2,NUM1 + SKIPE 4 ; negate if sign is set + MOVN 0,0 + AOS (P) + POPJ P, + +STATE: 0 ; interpreter state (0 = interpreting, else compiling) + +..INTERPRET: ..EXIT ? 0,,9 ? ASCII "INTERPRET" +.INTERPRET: ASM + SKIPN INBUF + PUSHJ P,GETS +NEXTW: MOVEI 0,40 ; space + PUSH PP,0 + PUSHJ P,PARSEWORD + JRST OK ; end of line + MOVEI 1,WORDBUF + PUSHJ P,FIND + JRST NUMBER + HLR X,1(1) ; get flags + PUSHJ P,TCFA + JUMPN X,.+3 ; immediate + SKIPE STATE + JRST COMPW ; compile word + MOVE X,1 ; interpret word + MOVE 1,(X) + JRST (1) +COMPW: MOVE 2,HERE + MOVEM 1,(2) + AOS HERE + JRST NEXTW +NUMBER: MOVEI 1,WORDBUF + PUSHJ P,CHECKNUM + JRST PANIC + SKIPE STATE + JRST COMPN ; compile number + PUSH PP,0 ; interpret number + JRST NEXTW +COMPN: MOVE 1,HERE + MOVEI 2,.LITERAL + MOVEM 2,(1) + MOVEM 0,1(1) + AOS HERE + AOS HERE + JRST NEXTW +OK: SKIPE STATE + JRST .+3 + MOVEI 0,[ASCIZ " ok "] + JRST .+2 + MOVEI 0,[ASCIZ " compiled "] + PUSHJ P,PUTS + JRST NEXTW-1 + +..QUIT: ..INTERPRET ? 0,,4 ? ASCII "QUIT" +.QUIT: DOCOL + [ ASM ? MOVE P,RSP ? JRST NEXT ] + .INTERPRET + .BRANCH + -2 + +..ABORT: ..QUIT ? 0,,5 ? ASCII "ABORT" +.ABORT: DOCOL + [ ASM ? MOVE PP,PSP ? JRST NEXT ] + .QUIT + +..CREATE: ..ABORT ? 0,,6 ? ASCII "CREATE" +.CREATE: ASM + PUSHJ P,CREATE + JRST NEXT + +CREATE: + MOVEI 0,40 ; space + PUSH PP,0 + PUSHJ P,PARSEWORD + JRST PANIC + MOVE 1,LATEST + MOVE 2,HERE + MOVEM 1,(2) ; link into dict + MOVEM 2,LATEST + MOVEI 1,WORDBUF ; copy word + HRRZ 0,0(1) ; length + MOVEM 0,1(2) + MOVEI 3,1(1) ; byte pointer of word buffer + HRLI 3,440700 + MOVEI 4,2(2) ; byte pointer of word in dictionary + HRLI 4,440700 + ILDB 5,3 ; copy chars + IDPB 5,4 + SOJG 0,.-2 + HRRZ 1,4 ; get word address from byte pointer + HLRZ 0,4 + CAIE 0,440700 ; go to next word unless we're already there + AOS 1 + MOVEM 1,HERE + POPJ P, + +..COLON: ..CREATE ? 0,,1 ? ASCII ":" +.COLON: DOCOL + .CREATE + .LITERAL ? DOCOL ? .COMMA + .RBRK + .EXIT + +..SEMICOLON: ..COLON ? 1,,1 ? ASCII ";" +.SEMICOLON: DOCOL + .LITERAL ? .EXIT ? .COMMA + .LBRK + .EXIT + +..CONST: ..SEMICOLON ? 0,,8 ? ASCII "CONSTANT" +.CONST: DOCOL + .CREATE + .LITERAL ? DOCON ? .COMMA + .COMMA + .EXIT + +..VAR: ..CONST ? 0,,8 ? ASCII "VARIABLE" +.VAR: DOCOL + .CREATE + .LITERAL ? DOVAR ? .COMMA + .LITERAL ? 0 ? .COMMA + .EXIT + +..BRANCH: ..VAR ? 0,,6 ? ASCII "BRANCH" +.BRANCH: ASM + MOVE 0,(PC) + ADD PC,0 + JRST NEXT + +..ZBRANCH: ..BRANCH ? 0,,7 ? ASCII "0BRANCH" +.ZBRANCH: ASM + POP PP,1 + SKIPE 1 + JRST .+4 + MOVE 0,(PC) + ADD PC,0 + JRST NEXT + AOS PC + JRST NEXT + +..LITERAL: ..ZBRANCH ? 0,,9 ? ASCII "(LITERAL)" +.LITERAL: ASM + MOVE 0,(PC) + AOS PC + PUSH PP,0 + JRST NEXT + +..COMMA: ..LITERAL ? 0,,1 ? ASCII "," +.COMMA: ASM + MOVE 1,HERE + POP PP,0 + MOVEM 0,(1) + AOS HERE + JRST NEXT + +..LBRK: ..COMMA ? 0,,1 ? ASCII "[" +.LBRK: ASM + SETZM STATE + JRST NEXT + +..RBRK: ..LBRK ? 0,,1 ? ASCII "]" +.RBRK: ASM + MOVEI 0,1 + MOVEM 0,STATE + JRST NEXT + +..IMMED: ..RBRK ? 0,,9 ? ASCII "IMMEDIATE" +.IMMED: ASM + MOVE 1,LATEST + MOVS 0,1 + XORM 0,1(1) + JRST NEXT + +..DOT: ..IMMED ? 0,,1 ? ASCII "." +.DOT: ASM + POP PP,1 + PUSHJ P,PRNTNSP + JRST NEXT + +..DOTS: ..DOT ? 0,,2 ? ASCII ".S" +.DOTS: ASM + MOVEI 0,"< + PUSHJ P,PUTCHAR + HRRZ 1,PP + SUBI 1,PPDL-1 + MOVN 3,1 ; loop counter + PUSHJ P,PRINTN + MOVEI 0,"> + PUSHJ P,PUTCHAR + SKIPN 3 + JRST NEXT ; empty stack + MOVS 3,3 ; put counter in left word + HRRI 3,PPDL + MOVEI 0,40 + PUSHJ P,PUTCHAR + MOVE 1,(3) + PUSHJ P,PRNTNSP + AOBJN 3,.-2 + JRST NEXT + +..DROP: ..DOTS ? 0,,4 ? ASCII "DROP" +.DROP: ASM + POP PP,0 + JRST NEXT + +..SWAP: ..DROP ? 0,,4 ? ASCII "SWAP" +.SWAP: ASM + POP PP,0 + EXCH 0,(PP) + PUSH PP,0 + JRST NEXT + +..DUP: ..SWAP ? 0,,3 ? ASCII "DUP" +.DUP: ASM + PUSH PP,(PP) + JRST NEXT + +..QDUP: ..DUP ? 0,,4 ? ASCII "?DUP" +.QDUP: ASM + SKIPE (PP) + PUSH PP,(PP) + JRST NEXT + +..OVER: ..QDUP ? 0,,4 ? ASCII "OVER" +.OVER: ASM + PUSH PP,-1(PP) + JRST NEXT + +..ROT: ..OVER ? 0,,3 ? ASCII "ROT" +.ROT: ASM + POP PP,0 + POP PP,1 + POP PP,2 + PUSH PP,1 + PUSH PP,0 + PUSH PP,2 + JRST NEXT + +..NROT: ..ROT ? 0,,4 ? ASCII "-ROT" +.NROT: ASM + POP PP,0 + POP PP,1 + POP PP,2 + PUSH PP,0 + PUSH PP,2 + PUSH PP,1 + JRST NEXT + +..TOR: ..NROT ? 0,,2 ? ASCII ">R" +.TOR: ASM + POP PP,0 + PUSH P,0 + JRST NEXT + +..FROMR: ..TOR ? 0,,2 ? ASCII "R>" +.FROMR: ASM + POP P,0 + PUSH PP,0 + JRST NEXT + +..FTCH: ..FROMR ? 0,,2 ? ASCII "R@" +.FTCHR: ASM + MOVE 0,(P) + PUSH PP,0 + JRST NEXT + +..RSP: ..FTCH ? 0,,4 ? ASCII "RSP@" +.RSP: ASM + PUSH PP,P + JRST NEXT + +..INCR: ..RSP ? 0,,2 ? ASCII "1+" +.INCR: ASM + AOS (PP) + JRST NEXT + +..DECR: ..INCR ? 0,,2 ? ASCII "1-" +.DECR: ASM + SOS (PP) + JRST NEXT + +..PLUS: ..DECR ? 0,,1 ? ASCII "+" +.PLUS: ASM + POP PP,0 + ADDM 0,(PP) + JRST NEXT + +..MINUS: ..PLUS ? 0,,1 ? ASCII "-" +.MINUS: ASM + POP PP,0 + POP PP,1 + SUB 1,0 + PUSH PP,1 + JRST NEXT + +..MUL: ..MINUS ? 0,,1 ? ASCII "*" +.MUL: ASM + POP PP,0 + IMULM 0,(PP) + JRST NEXT + +..DIVMOD: ..MUL ? 0,,4 ? ASCII "/MOD" +.DIVMOD: ASM + POP PP,1 + POP PP,0 + IDIV 0,1 + PUSH PP,1 + PUSH PP,0 + JRST NEXT + +..DIV: ..DIVMOD ? 0,,1 ? ASCII "/" +.DIV: ASM + POP PP,1 + POP PP,0 + IDIV 0,1 + PUSH PP,0 + JRST NEXT + +..MOD: ..DIV ? 0,,3 ? ASCII "MOD" +.MOD: ASM + POP PP,1 + POP PP,0 + IDIV 0,1 + PUSH PP,1 + JRST NEXT + +..EQU: ..MOD ? 0,,1 ? ASCII "=" +.EQU: ASM + POP PP,0 + CAME 0,(PP) + JRST FALSE +TRUE: SETOM (PP) + JRST NEXT +FALSE: SETZM (PP) + JRST NEXT + +..NEQU: ..EQU ? 0,,2 ? ASCII "<>" +.NEQU: ASM + POP PP,0 + CAMN 0,(PP) + JRST FALSE + JRST TRUE + +..LT: ..NEQU ? 0,,1 ? ASCII "<" +.LT: ASM + POP PP,0 + CAMG 0,(PP) + JRST FALSE + JRST TRUE + +..LE: ..LT ? 0,,2 ? ASCII "<=" +.LE: ASM + POP PP,0 + CAMGE 0,(PP) + JRST FALSE + JRST TRUE + +..GT: ..LE ? 0,,1 ? ASCII ">" +.GT: ASM + POP PP,0 + CAML 0,(PP) + JRST FALSE + JRST TRUE + +..GE: ..GT ? 0,,2 ? ASCII ">=" +.GE: ASM + POP PP,0 + CAMLE 0,(PP) + JRST FALSE + JRST TRUE + +..ZEQU: ..GE ? 0,,2 ? ASCII "0=" +.ZEQU: ASM + SKIPE (PP) + JRST FALSE + JRST TRUE + +..ZNEQU: ..ZEQU ? 0,,3 ? ASCII "0<>" +.ZNEQU: ASM + SKIPN (PP) + JRST FALSE + JRST TRUE + +..ZLT: ..ZNEQU ? 0,,2 ? ASCII "0<" +.ZLT: ASM + SKIPL (PP) + JRST FALSE + JRST TRUE + +..ZLE: ..ZLT ? 0,,3 ? ASCII "0<=" +.ZLE: ASM + SKIPLE (PP) + JRST FALSE + JRST TRUE + +..ZGT: ..ZLE ? 0,,2 ? ASCII "0>" +.ZGT: ASM + SKIPG (PP) + JRST FALSE + JRST TRUE + +..ZGE: ..ZGT ? 0,,3 ? ASCII "0>=" +.ZGE: ASM + SKIPGE (PP) + JRST FALSE + JRST TRUE + +..AND: ..ZGE ? 0,,3 ? ASCII "AND" +.AND: ASM + POP PP,0 + ANDM 0,(PP) + JRST NEXT + +..OR: ..AND ? 0,,2 ? ASCII "OR" +.OR: ASM + POP PP,0 + IORM 0,(PP) + JRST NEXT + +..XOR: ..OR ? 0,,3 ? ASCII "XOR" +.XOR: ASM + POP PP,0 + XORM 0,(PP) + JRST NEXT + +..NOT: ..XOR ? 0,,3 ? ASCII "NOT" +.NOT: ASM ; same as 0= + SKIPE (PP) + JRST FALSE + JRST TRUE + +..ABS: ..NOT ? 0,,3 ? ASCII "ABS" +.ABS: ASM + MOVM 0,(PP) + MOVEM 0,(PP) + JRST NEXT + +..NEG: ..ABS ? 0,,6 ? ASCII "NEGATE" +.NEG: ASM + MOVN 0,(PP) + MOVEM 0,(PP) + JRST NEXT + +..MIN: ..NEG ? 0,,3 ? ASCII "MIN" +.MIN: ASM + POP PP,0 + CAMGE 0,(PP) + MOVEM 0,(PP) + JRST NEXT + +..MAX: ..MIN ? 0,,3 ? ASCII "MAX" +.MAX: ASM + POP PP,0 + CAMLE 0,(PP) + MOVEM 0,(PP) + JRST NEXT + +..WORD: ..MAX ? 0,,4 ? ASCII "WORD" +.WORD: ASM + PUSHJ P,PARSEWORD + JRST .+1 + PUSH PP,WORDBUF + JRST NEXT + +..STORE: ..WORD ? 0,,1 ? ASCII "!" +.STORE: ASM + POP PP,1 + POP PP,0 + MOVEM 0,(1) + JRST NEXT + +..PSTORE: ..STORE ? 0,,2 ? ASCII "+!" +.PSTORE: ASM + POP PP,1 + POP PP,0 + ADDM 0,(1) + JRST NEXT + +..FETCH: ..PSTORE ? 0,,1 ? ASCII "@" +.FETCH: ASM + MOVE 1,(PP) + MOVE 1,(1) + MOVEM 1,(PP) + JRST NEXT + +..HERE: ..FETCH ? 0,,4 ? ASCII "HERE" +.HERE: DOCON ? HERE + +..STATE: ..HERE ? 0,,5 ? ASCII "STATE" +.STATE: DOCON ? STATE + +..BASE: ..STATE ? 0,,4 ? ASCII "BASE" +.BASE: DOCON ? BASE + +..INP: ..BASE ? 0,,3 ? ASCII ">IN" +.INP: DOCON ? INP + +..IF: ..INP ? 1,,2 ? ASCII "IF" +.IF: DOCOL + .LITERAL ? .ZBRANCH ? .COMMA + .HERE ? .FETCH + .LITERAL ? 0 ? .COMMA + .EXIT + +..THEN: ..IF ? 1,,4 ? ASCII "THEN" +.THEN: DOCOL + .DUP + .HERE ? .FETCH ? .SWAP ? .MINUS + .SWAP ? .STORE + .EXIT + +..ELSE: ..THEN ? 1,,4 ? ASCII "ELSE" +.ELSE: DOCOL + .LITERAL ? .BRANCH ? .COMMA + .HERE ? .FETCH + .LITERAL ? 0 ? .COMMA + .SWAP + .DUP + .HERE ? .FETCH ? .SWAP ? .MINUS + .SWAP ? .STORE + .EXIT + +..BEGIN: ..ELSE ? 1,,5 ? ASCII "BEGIN" +.BEGIN: DOCOL + .HERE ? .FETCH + .EXIT + +..AGAIN: ..BEGIN ? 1,,5 ? ASCII "AGAIN" +.AGAIN: DOCOL + .LITERAL ? .BRANCH ? .COMMA + .HERE ? .FETCH ? .MINUS ? .COMMA + .EXIT + +..UNTIL: ..AGAIN ? 1,,5 ? ASCII "UNTIL" +.UNTIL: DOCOL + .LITERAL ? .ZBRANCH ? .COMMA + .HERE ? .FETCH ? .MINUS ? .COMMA + .EXIT + +; same as IF really +..WHILE: ..UNTIL ? 1,,5 ? ASCII "WHILE" +.WHILE: DOCOL + .LITERAL ? .ZBRANCH ? .COMMA + .HERE ? .FETCH + .LITERAL ? 0 ? .COMMA + .EXIT + +..REPEAT: ..WHILE ? 1,,6 ? ASCII "REPEAT" +.REPEAT: DOCOL + .LITERAL ? .BRANCH ? .COMMA + .SWAP + .HERE ? .FETCH ? .MINUS ? .COMMA + .DUP + .HERE ? .FETCH ? .SWAP ? .MINUS + .SWAP ? .STORE + .EXIT + +..DO: ..REPEAT ? 1,,2 ? ASCII "DO" +.DO: DOCOL + .LITERAL ? .SWAP ? .COMMA + .LITERAL ? .TOR ? .COMMA + .LITERAL ? .TOR ? .COMMA + .HERE ? .FETCH + .EXIT + +; remove index and limit from return stack +..UNLOOP: ..DO ? 0,,6 ? ASCII "UNLOOP" +.UNLOOP: ASM + POP P,0 + POP P,0 + JRST NEXT + +..LOOP: ..UNLOOP ? 1,,4 ? ASCII "LOOP" +.LOOP: DOCOL + .LITERAL ? .FROMR ? .COMMA ; index + .LITERAL ? .INCR ? .COMMA + .LITERAL ? .DUP ? .COMMA + .LITERAL ? .FTCHR ? .COMMA ; limit + .LITERAL ? .GE ? .COMMA ; branch back if i >= limit is false + .LITERAL ? .SWAP ? .COMMA ; put index back on return stack + .LITERAL ? .TOR ? .COMMA + .LITERAL ? .ZBRANCH ? .COMMA + .HERE ? .FETCH ? .MINUS ? .COMMA + .LITERAL ? .UNLOOP ? .COMMA + .EXIT + +..PLULOOP: ..LOOP ? 1,,5 ? ASCII "+LOOP" +.PLUSLOOP: DOCOL + .LITERAL ? .FROMR ? .COMMA ; index + .LITERAL ? .PLUS ? .COMMA ; only difference to above code + .LITERAL ? .DUP ? .COMMA + .LITERAL ? .FTCHR ? .COMMA ; limit + .LITERAL ? .GE ? .COMMA ; branch back if i >= limit is false + .LITERAL ? .SWAP ? .COMMA ; put index back on return stack + .LITERAL ? .TOR ? .COMMA + .LITERAL ? .ZBRANCH ? .COMMA + .HERE ? .FETCH ? .MINUS ? .COMMA + .LITERAL ? .UNLOOP ? .COMMA + .EXIT + +..I: ..PLULOOP ? 0,,1 ? ASCII "I" +.I: ASM + MOVE 0,(P) + PUSH PP,0 + JRST NEXT + +..J: ..I ? 0,,1 ? ASCII "J" +.J: ASM + MOVE 0,2(P) + PUSH PP,0 + JRST NEXT + +..EMIT: ..J ? 0,,4 ? ASCII "EMIT" +.EMIT: ASM + POP PP,0 + PUSHJ P,PUTCHAR + JRST NEXT + +..KEY: ..EMIT ? 0,,3 ? ASCII "KEY" +.KEY: ASM + PUSHJ P,GETCH + PUSH PP,0 + JRST NEXT + +..CR: ..KEY ? 0,,2 ? ASCII "CR" +.CR: DOCOL + .LITERAL ? ^J + .EMIT + .EXIT + +.LATEST: +..SP: ..KEY ? 0,,5 ? ASCII "SPACE" +.SP: DOCOL + .LITERAL ? 40 + .EMIT + .EXIT + +END1: + +END START diff --git a/src/aap/tenth.s b/src/aap/tenth.s deleted file mode 100644 index cb66fe79..00000000 --- a/src/aap/tenth.s +++ /dev/null @@ -1,947 +0,0 @@ -X=14 # pointer into code/parameter field -PC=15 # the interpreter's program counter -PP=16 # parameter stack pointer -P=17 # return stack pointer -APR=0 -CTYIN=32 -CTYOUT=33 - -PDLLEN=100 -PDL: .=.+PDLLEN -PPDL: .=.+PDLLEN -RSP: -PDLLEN,,PDL-1 -PSP: -PDLLEN,,PPDL-1 -INP: 0 -INBUF: 0; .=.+40 -INBUFBP: 440700,,INBUF+1 -WORDBUF: 0; .=.+10 -WORDBUFBP: 440700,,WORDBUF+1 - -START: - SETZM CTYIN - MOVE P,RSP - MOVE PP,PSP - MOVEI PC,{ _QUIT } - JRST NEXT - -# -# output -# - -# print ASCII character in AC 0 - changes AC 0 -PUTCHAR: - IORI 0,400 # valid bit - MOVEM 0,CTYOUT - CONO APR,12000 # 10000 = set flags, 2000 = interrupt flag - SKIPE CTYOUT # wait for transmission to complete - JRST .-1 - CAIE 0,400|"\n - POPJ P, - MOVEI 0,"\r - JRST PUTCHAR - -# print null-terminated ASCII string in AC 0 - changes AC 0 1 -PUTS: - MOVE 1,0 # address - HRLI 1,440700 # 7-bit bytes - ILDB 0,1 - CAIN 0,0 - POPJ P, - PUSHJ P,PUTCHAR - JRST .-4 - -# prints a counted ASCII string in AC 0 -PUTSN: - MOVE 2,@0 # char count - AOS 0 - MOVE 1,0 - HRLI 1,440700 -PUTSN1: SOSGE 2 - POPJ P, - ILDB 0,1 - PUSHJ P,PUTCHAR - JRST PUTSN1 - -# print 'panic' and halt -PANIC: - MOVEI 0,{ ASCII "\npanic\n\0" } - PUSHJ P,PUTS - JRST 4,. - -BASE: 12 -DIGITS: "0; "1; "2; "3; "4; "5; "6; "7; "8; "9; "A; "B; "C; "D; "E; "F - -# print number in AC 1 - changes AC 0 1 2 -PRINTN: - JUMPGE 1,UPRINTN - MOVEI 0,"- - PUSHJ P,PUTCHAR - MOVM 1,1 -UPRINTN: - IDIV 1,BASE - JUMPE 1,UPR1 - PUSH P,2 - PUSHJ P,UPRINTN - POP P,2 -UPR1: - MOVE 0,DIGITS(2) - JRST PUTCHAR - -# prints number in AC 1 and a space - changes AC 0 1 -PRINTNSP: - PUSHJ P,PRINTN - MOVEI 0,40 # space - JRST PUTCHAR - -# reads one character into AC 0 -GETCH: - CONO APR,12000 # 10000 = set flags, 2000 = interrupt flag - MOVE 0,CTYIN - CAIN 0,0 - JRST .-2 - SETZM CTYIN - TRZ 0,400 - CAIN 0,"\r - MOVEI 0,"\n - POPJ P, - -# -# input -# - -# reads one character into AC 0 and echos - changes AC 0 1 -GETCHAR: - PUSHJ P,GETCH - MOVE 1,0 - PUSHJ P,PUTCHAR - MOVE 0,1 - POPJ P, - -# reads characters into INBUF - changes AC 0 1 2 -GETS: - SETZM INP - MOVE 1,INBUFBP - SETZ 2, -NEXTC: PUSHJ P,GETCH - CAIN 0,"\n - JRST GETSNL - CAIN 0,25 - JRST GETSKL - CAIN 0,"\b - JRST GETSBS - IDPB 0,1 - AOS 2 - PUSHJ P,PUTCHAR - JRST NEXTC -GETSKL: # kill line - MOVEI 0,"\n - PUSHJ P,PUTCHAR - JRST GETS -GETSBS: # backspace - PUSHJ P,PUTCHAR - MOVE 1,INBUFBP - SOSGE 2 - SETZ 2, - MOVE 0,2 - SOSGE 0 - JRST NEXTC - IBP 1 - JRST .-3 -GETSNL: - MOVEI 0,40 # space - PUSHJ P,PUTCHAR - SETZ 0, - IDPB 0,1 - MOVEM 2,INBUF - POPJ P, - -# -# forth things -# - -# Code field values -ASM: - AOS X - JRST (X) - -DOCON: - AOS X - MOVE 0,(X) - PUSH PP,0 - JRST NEXT - -DOVAR: - AOS X - PUSH PP,X - JRST NEXT - -DOCOL: - AOS X - PUSH P,PC - MOVE PC,X - JRST NEXT - -# counterpart of DOCOL -__EXIT: 0; 0,,4; ASCII "EXIT" -_EXIT: ASM - POP P,PC - JRST NEXT - -# execute forth word at PC and increment PC -NEXT: MOVE X,(PC) - AOS PC - MOVE 1,(X) - JRST (1) - -# Dictionary -LATEST: _LATEST -HERE: END - -# parses one word from the input stream into the word buffer -# skips if a word was read -PARSEWORD: - SETZM WORDBUF - MOVE 0,INP - MOVE 1,INBUFBP - SOSGE 0 - JRST .+3 - IBP 1 - JRST .-3 - POP PP,2 # terminator - MOVE 0,INP -PWDELIM: - ILDB 3,1 - AOS 0 - CAMLE 0,INBUF # check length - JRST PWEND - CAMN 3,2 # check for delimiter - JRST PWDELIM - MOVEM 0,INP # save beginning of word - MOVE 4,WORDBUFBP -PWCHAR: - IDPB 3,4 - ILDB 3,1 - AOS 0 - CAMLE 0,INBUF # check length - JRST .+3 - CAME 3,2 # check for delimiter - JRST PWCHAR - MOVE 1,INP - SUB 1,0 - MOVMM 1,WORDBUF -PWEND: - MOVEM 0,INP - SKIPE WORDBUF # skip one instruction if we have a word - AOS (P) - POPJ P, - -# find word AC 1 in dictionary, skip if found at return it in AC 1 -FIND: - MOVE 2,LATEST - SKIPA -FINDNEXT: - MOVE 2,(2) - SKIPN 2 - POPJ P, # not found - HRRZ 0,1(2) # length - CAME 0,(1) - JRST FINDNEXT - MOVEI 3,1(1) # byte pointer of word to look up - HRLI 3,440700 - MOVEI 4,2(2) # byte pointer of word in dictionary - HRLI 4,440700 -FINDLOOP: - ILDB 5,3 - ILDB 6,4 - CAME 5,6 - JRST FINDNEXT - SOJG 0,FINDLOOP - # found - MOVE 1,2 - AOS (P) - POPJ P, - -# go from dictionary entry AC 1 to code field -TCFA: - HRRZ 0,1(1) # length - MOVEI 2,2(1) # byte pointer - HRLI 2,440700 - IBP 2 - SOJG 0,.-1 - HRRZ 1,4 # get word address from byte pointer - HLRZ 0,4 - CAIE 0,440700 # go to next word unless we're already there - AOS 1 - POPJ P, - -# parse number in string AC 1, skip if number and return it in AC 0 -CHECKNUM: - SETZ 0, - MOVE 2,(1) # length - AOS 1 - HRLI 1,440700 # byte pointer - SETZ 4, # sign - ILDB 3,1 - CAIE 3,"- - JRST .+5 - SOSN 2 - POPJ P, - AOS 4 -NUM1: ILDB 3,1 - CAIGE 3,"0 - POPJ P, - CAILE 3,"9 - JRST .+3 - SUBI 3,"0 - JRST NUM2 - CAIGE 3,"A - POPJ P, - CAILE 3,"F - JRST .+3 - SUBI 3,"A - JRST NUM2 - CAIGE 3,"a - POPJ P, - CAILE 3,"f - POPJ P, - SUBI 3,"a -NUM2: IMUL 0,BASE - ADD 0,3 - SOJG 2,NUM1 - SKIPE 4 # negate if sign is set - MOVN 0,0 - AOS (P) - POPJ P, - -STATE: 0 # interpreter state (0 = interpreting, else compiling) - -__INTERPRET: __EXIT; 0,,9; ASCII "INTERPRET" -_INTERPRET: ASM - SKIPN INBUF - PUSHJ P,GETS -NEXTW: MOVEI 0,40 # space - PUSH PP,0 - PUSHJ P,PARSEWORD - JRST OK # end of line - MOVEI 1,WORDBUF - PUSHJ P,FIND - JRST NUMBER - HLR X,1(1) # get flags - PUSHJ P,TCFA - JUMPN X,.+3 # immediate - SKIPE STATE - JRST COMPW # compile word - MOVE X,1 # interpret word - MOVE 1,(X) - JRST (1) -COMPW: MOVE 2,HERE - MOVEM 1,(2) - AOS HERE - JRST NEXTW -NUMBER: MOVEI 1,WORDBUF - PUSHJ P,CHECKNUM - JRST PANIC - SKIPE STATE - JRST COMPN # compile number - PUSH PP,0 # interpret number - JRST NEXTW -COMPN: MOVE 1,HERE - MOVEI 2,_LITERAL - MOVEM 2,(1) - MOVEM 0,1(1) - AOS HERE - AOS HERE - JRST NEXTW -OK: SKIPE STATE - JRST .+3 - MOVEI 0,{ASCII " ok\n\0"} - JRST .+2 - MOVEI 0,{ASCII " compiled\n\0"} - PUSHJ P,PUTS - JRST NEXTW-1 - -__QUIT: __INTERPRET; 0,,4; ASCII "QUIT" -_QUIT: DOCOL - { ASM; MOVE P,RSP; JRST NEXT } - _INTERPRET - _BRANCH - -2 - -__ABORT: __QUIT; 0,,5; ASCII "ABORT" -_ABORT: DOCOL - { ASM; MOVE PP,PSP; JRST NEXT } - _QUIT - -__CREATE: __ABORT; 0,,6; ASCII "CREATE" -_CREATE: ASM - PUSHJ P,CREATE - JRST NEXT - -CREATE: - MOVEI 0,40 # space - PUSH PP,0 - PUSHJ P,PARSEWORD - JRST PANIC - MOVE 1,LATEST - MOVE 2,HERE - MOVEM 1,(2) # link into dict - MOVEM 2,LATEST - MOVEI 1,WORDBUF # copy word - HRRZ 0,0(1) # length - MOVEM 0,1(2) - MOVEI 3,1(1) # byte pointer of word buffer - HRLI 3,440700 - MOVEI 4,2(2) # byte pointer of word in dictionary - HRLI 4,440700 - ILDB 5,3 # copy chars - IDPB 5,4 - SOJG 0,.-2 - HRRZ 1,4 # get word address from byte pointer - HLRZ 0,4 - CAIE 0,440700 # go to next word unless we're already there - AOS 1 - MOVEM 1,HERE - POPJ P, - -__COLON: __CREATE; 0,,1; ASCII ":" -_COLON: DOCOL - _CREATE - _LITERAL; DOCOL; _COMMA - _RBRK - _EXIT - -__SEMICOLON: __COLON; 1,,1; ASCII ";" -_SEMICOLON: DOCOL - _LITERAL; _EXIT; _COMMA - _LBRK - _EXIT - -__CONST: __SEMICOLON; 0,,8; ASCII "CONSTANT" -_CONST: DOCOL - _CREATE - _LITERAL; DOCON; _COMMA - _COMMA - _EXIT - -__VAR: __CONST; 0,,8; ASCII "VARIABLE" -_VAR: DOCOL - _CREATE - _LITERAL; DOVAR; _COMMA - _LITERAL; 0; _COMMA - _EXIT - -__BRANCH: __VAR; 0,,6; ASCII "BRANCH" -_BRANCH: ASM - MOVE 0,(PC) - ADD PC,0 - JRST NEXT - -__ZBRANCH: __BRANCH; 0,,7; ASCII "0BRANCH" -_ZBRANCH: ASM - POP PP,1 - SKIPE 1 - JRST .+4 - MOVE 0,(PC) - ADD PC,0 - JRST NEXT - AOS PC - JRST NEXT - -__LITERAL: __ZBRANCH; 0,,9; ASCII "(LITERAL)" -_LITERAL: ASM - MOVE 0,(PC) - AOS PC - PUSH PP,0 - JRST NEXT - -__COMMA: __LITERAL; 0,,1; ASCII "," -_COMMA: ASM - MOVE 1,HERE - POP PP,0 - MOVEM 0,(1) - AOS HERE - JRST NEXT - -__LBRK: __COMMA; 0,,1; ASCII "[" -_LBRK: ASM - SETZM STATE - JRST NEXT - -__RBRK: __LBRK; 0,,1; ASCII "]" -_RBRK: ASM - MOVEI 0,1 - MOVEM 0,STATE - JRST NEXT - -__IMMED: __RBRK; 0,,9; ASCII "IMMEDIATE" -_IMMED: ASM - MOVE 1,LATEST - MOVS 0,1 - XORM 0,1(1) - JRST NEXT - -__DOT: __IMMED; 0,,1; ASCII "." -_DOT: ASM - POP PP,1 - PUSHJ P,PRINTNSP - JRST NEXT - -__DOTS: __DOT; 0,,2; ASCII ".S" -_DOTS: ASM - MOVEI 0,"< - PUSHJ P,PUTCHAR - HRRZ 1,PP - SUBI 1,PPDL-1 - MOVN 3,1 # loop counter - PUSHJ P,PRINTN - MOVEI 0,"> - PUSHJ P,PUTCHAR - SKIPN 3 - JRST NEXT # empty stack - MOVS 3,3 # put counter in left word - HRRI 3,PPDL - MOVEI 0,40 - PUSHJ P,PUTCHAR - MOVE 1,(3) - PUSHJ P,PRINTNSP - AOBJN 3,.-2 - JRST NEXT - -__DROP: __DOTS; 0,,4; ASCII "DROP" -_DROP: ASM - POP PP,0 - JRST NEXT - -__SWAP: __DROP; 0,,4; ASCII "SWAP" -_SWAP: ASM - POP PP,0 - EXCH 0,(PP) - PUSH PP,0 - JRST NEXT - -__DUP: __SWAP; 0,,3; ASCII "DUP" -_DUP: ASM - PUSH PP,(PP) - JRST NEXT - -__QDUP: __DUP; 0,,4; ASCII "?DUP" -_QDUP: ASM - SKIPE (PP) - PUSH PP,(PP) - JRST NEXT - -__OVER: __QDUP; 0,,4; ASCII "OVER" -_OVER: ASM - PUSH PP,-1(PP) - JRST NEXT - -__ROT: __OVER; 0,,3; ASCII "ROT" -_ROT: ASM - POP PP,0 - POP PP,1 - POP PP,2 - PUSH PP,1 - PUSH PP,0 - PUSH PP,2 - JRST NEXT - -__NROT: __ROT; 0,,4; ASCII "-ROT" -_NROT: ASM - POP PP,0 - POP PP,1 - POP PP,2 - PUSH PP,0 - PUSH PP,2 - PUSH PP,1 - JRST NEXT - -__TOR: __NROT; 0,,2; ASCII ">R" -_TOR: ASM - POP PP,0 - PUSH P,0 - JRST NEXT - -__FROMR: __TOR; 0,,2; ASCII "R>" -_FROMR: ASM - POP P,0 - PUSH PP,0 - JRST NEXT - -__FETCHR: __FROMR; 0,,2; ASCII "R@" -_FETCHR: ASM - MOVE 0,(P) - PUSH PP,0 - JRST NEXT - -__RSP: __FETCHR; 0,,4; ASCII "RSP@" -_RSP: ASM - PUSH PP,P - JRST NEXT - -__INCR: __RSP; 0,,2; ASCII "1+" -_INCR: ASM - AOS (PP) - JRST NEXT - -__DECR: __INCR; 0,,2; ASCII "1-" -_DECR: ASM - SOS (PP) - JRST NEXT - -__PLUS: __DECR; 0,,1; ASCII "+" -_PLUS: ASM - POP PP,0 - ADDM 0,(PP) - JRST NEXT - -__MINUS: __PLUS; 0,,1; ASCII "-" -_MINUS: ASM - POP PP,0 - POP PP,1 - SUB 1,0 - PUSH PP,1 - JRST NEXT - -__MUL: __MINUS; 0,,1; ASCII "*" -_MUL: ASM - POP PP,0 - IMULM 0,(PP) - JRST NEXT - -__DIVMOD: __MUL; 0,,4; ASCII "/MOD" -_DIVMOD: ASM - POP PP,1 - POP PP,0 - IDIV 0,1 - PUSH PP,1 - PUSH PP,0 - JRST NEXT - -__DIV: __DIVMOD; 0,,1; ASCII "/" -_DIV: ASM - POP PP,1 - POP PP,0 - IDIV 0,1 - PUSH PP,0 - JRST NEXT - -__MOD: __DIV; 0,,3; ASCII "MOD" -_MOD: ASM - POP PP,1 - POP PP,0 - IDIV 0,1 - PUSH PP,1 - JRST NEXT - -__EQU: __MOD; 0,,1; ASCII "=" -_EQU: ASM - POP PP,0 - CAME 0,(PP) - JRST FALSE -TRUE: SETOM (PP) - JRST NEXT -FALSE: SETZM (PP) - JRST NEXT - -__NEQU: __EQU; 0,,2; ASCII "<>" -_NEQU: ASM - POP PP,0 - CAMN 0,(PP) - JRST FALSE - JRST TRUE - -__LT: __NEQU; 0,,1; ASCII "<" -_LT: ASM - POP PP,0 - CAMG 0,(PP) - JRST FALSE - JRST TRUE - -__LE: __LT; 0,,2; ASCII "<=" -_LE: ASM - POP PP,0 - CAMGE 0,(PP) - JRST FALSE - JRST TRUE - -__GT: __LE; 0,,1; ASCII ">" -_GT: ASM - POP PP,0 - CAML 0,(PP) - JRST FALSE - JRST TRUE - -__GE: __GT; 0,,2; ASCII ">=" -_GE: ASM - POP PP,0 - CAMLE 0,(PP) - JRST FALSE - JRST TRUE - -__ZEQU: __GE; 0,,2; ASCII "0=" -_ZEQU: ASM - SKIPE (PP) - JRST FALSE - JRST TRUE - -__ZNEQU: __ZEQU; 0,,3; ASCII "0<>" -_ZNEQU: ASM - SKIPN (PP) - JRST FALSE - JRST TRUE - -__ZLT: __ZNEQU; 0,,2; ASCII "0<" -_ZLT: ASM - SKIPL (PP) - JRST FALSE - JRST TRUE - -__ZLE: __ZLT; 0,,3; ASCII "0<=" -_ZLE: ASM - SKIPLE (PP) - JRST FALSE - JRST TRUE - -__ZGT: __ZLE; 0,,2; ASCII "0>" -_ZGT: ASM - SKIPG (PP) - JRST FALSE - JRST TRUE - -__ZGE: __ZGT; 0,,3; ASCII "0>=" -_ZGE: ASM - SKIPGE (PP) - JRST FALSE - JRST TRUE - -__AND: __ZGE; 0,,3; ASCII "AND" -_AND: ASM - POP PP,0 - ANDM 0,(PP) - JRST NEXT - -__OR: __AND; 0,,2; ASCII "OR" -_OR: ASM - POP PP,0 - IORM 0,(PP) - JRST NEXT - -__XOR: __OR; 0,,3; ASCII "XOR" -_XOR: ASM - POP PP,0 - XORM 0,(PP) - JRST NEXT - -__NOT: __XOR; 0,,3; ASCII "NOT" -_NOT: ASM # same as 0= - SKIPE (PP) - JRST FALSE - JRST TRUE - -__ABS: __NOT; 0,,3; ASCII "ABS" -_ABS: ASM - MOVM 0,(PP) - MOVEM 0,(PP) - JRST NEXT - -__NEG: __ABS; 0,,6; ASCII "NEGATE" -_NEG: ASM - MOVN 0,(PP) - MOVEM 0,(PP) - JRST NEXT - -__MIN: __NEG; 0,,3; ASCII "MIN" -_MIN: ASM - POP PP,0 - CAMGE 0,(PP) - MOVEM 0,(PP) - JRST NEXT - -__MAX: __MIN; 0,,3; ASCII "MAX" -_MAX: ASM - POP PP,0 - CAMLE 0,(PP) - MOVEM 0,(PP) - JRST NEXT - -__WORD: __MAX; 0,,4; ASCII "WORD" -_WORD: ASM - PUSHJ P,PARSEWORD - JRST .+1 - PUSH PP,WORDBUF - JRST NEXT - -__STORE: __WORD; 0,,1; ASCII "!" -_STORE: ASM - POP PP,1 - POP PP,0 - MOVEM 0,(1) - JRST NEXT - -__PSTORE: __STORE; 0,,2; ASCII "+!" -_PSTORE: ASM - POP PP,1 - POP PP,0 - ADDM 0,(1) - JRST NEXT - -__FETCH: __PSTORE; 0,,1; ASCII "@" -_FETCH: ASM - MOVE 1,(PP) - MOVE 1,(1) - MOVEM 1,(PP) - JRST NEXT - -__HERE: __FETCH; 0,,4; ASCII "HERE" -_HERE: DOCON; HERE - -__STATE: __HERE; 0,,5; ASCII "STATE" -_STATE: DOCON; STATE - -__BASE: __STATE; 0,,4; ASCII "BASE" -_BASE: DOCON; BASE - -__INP: __BASE; 0,,3; ASCII ">IN" -_INP: DOCON; INP - -__IF: __INP; 1,,2; ASCII "IF" -_IF: DOCOL - _LITERAL; _ZBRANCH; _COMMA - _HERE; _FETCH - _LITERAL; 0; _COMMA - _EXIT - -__THEN: __IF; 1,,4; ASCII "THEN" -_THEN: DOCOL - _DUP - _HERE; _FETCH; _SWAP; _MINUS - _SWAP; _STORE - _EXIT - -__ELSE: __THEN; 1,,4; ASCII "ELSE" -_ELSE: DOCOL - _LITERAL; _BRANCH; _COMMA - _HERE; _FETCH - _LITERAL; 0; _COMMA - _SWAP - _DUP - _HERE; _FETCH; _SWAP; _MINUS - _SWAP; _STORE - _EXIT - -__BEGIN: __ELSE; 1,,5; ASCII "BEGIN" -_BEGIN: DOCOL - _HERE; _FETCH - _EXIT - -__AGAIN: __BEGIN; 1,,5; ASCII "AGAIN" -_AGAIN: DOCOL - _LITERAL; _BRANCH; _COMMA - _HERE; _FETCH; _MINUS; _COMMA - _EXIT - -__UNTIL: __AGAIN; 1,,5; ASCII "UNTIL" -_UNTIL: DOCOL - _LITERAL; _ZBRANCH; _COMMA - _HERE; _FETCH; _MINUS; _COMMA - _EXIT - -# same as IF really -__WHILE: __UNTIL; 1,,5; ASCII "WHILE" -_WHILE: DOCOL - _LITERAL; _ZBRANCH; _COMMA - _HERE; _FETCH - _LITERAL; 0; _COMMA - _EXIT - -__REPEAT: __WHILE; 1,,6; ASCII "REPEAT" -_REPEAT: DOCOL - _LITERAL; _BRANCH; _COMMA - _SWAP - _HERE; _FETCH; _MINUS; _COMMA - _DUP - _HERE; _FETCH; _SWAP; _MINUS - _SWAP; _STORE - _EXIT - -__DO: __REPEAT; 1,,2; ASCII "DO" -_DO: DOCOL - _LITERAL; _SWAP; _COMMA - _LITERAL; _TOR; _COMMA - _LITERAL; _TOR; _COMMA - _HERE; _FETCH - _EXIT - -# remove index and limit from return stack -__UNLOOP: __DO; 0,,6; ASCII "UNLOOP" -_UNLOOP: ASM - POP P,0 - POP P,0 - JRST NEXT - -__LOOP: __UNLOOP; 1,,4; ASCII "LOOP" -_LOOP: DOCOL - _LITERAL; _FROMR; _COMMA # index - _LITERAL; _INCR; _COMMA - _LITERAL; _DUP; _COMMA - _LITERAL; _FETCHR; _COMMA # limit - _LITERAL; _GE; _COMMA # branch back if i >= limit is false - _LITERAL; _SWAP; _COMMA # put index back on return stack - _LITERAL; _TOR; _COMMA - _LITERAL; _ZBRANCH; _COMMA - _HERE; _FETCH; _MINUS; _COMMA - _LITERAL; _UNLOOP; _COMMA - _EXIT - -__PLUSLOOP: __LOOP; 1,,5; ASCII "+LOOP" -_PLUSLOOP: DOCOL - _LITERAL; _FROMR; _COMMA # index - _LITERAL; _PLUS; _COMMA # only difference to above code - _LITERAL; _DUP; _COMMA - _LITERAL; _FETCHR; _COMMA # limit - _LITERAL; _GE; _COMMA # branch back if i >= limit is false - _LITERAL; _SWAP; _COMMA # put index back on return stack - _LITERAL; _TOR; _COMMA - _LITERAL; _ZBRANCH; _COMMA - _HERE; _FETCH; _MINUS; _COMMA - _LITERAL; _UNLOOP; _COMMA - _EXIT - -__I: __PLUSLOOP; 0,,1; ASCII "I" -_I: ASM - MOVE 0,(P) - PUSH PP,0 - JRST NEXT - -__J: __I; 0,,1; ASCII "J" -_J: ASM - MOVE 0,2(P) - PUSH PP,0 - JRST NEXT - -__EMIT: __J; 0,,4; ASCII "EMIT" -_EMIT: ASM - POP PP,0 - PUSHJ P,PUTCHAR - JRST NEXT - -__KEY: __EMIT; 0,,3; ASCII "KEY" -_KEY: ASM - PUSHJ P,GETCH - PUSH PP,0 - JRST NEXT - -__CR: __KEY; 0,,2; ASCII "CR" -_CR: DOCOL - _LITERAL; "\n - _EMIT - _EXIT - -_LATEST: -__SP: __KEY; 0,,5; ASCII "SPACE" -_SP: DOCOL - _LITERAL; 40 - _EMIT - _EXIT - -END: