github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-18 09:12:08 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/aap/tenth.3
Lars Brinkhoff 3c2f52304a Make TENTH run under ITS.
2018-08-23 10:15:01 +02:00

979 lines
15 KiB
Groff
Raw Blame History

TITLE TENTH
EXPUNGE .SWAP,.BEGIN,.END,.ELSE,.I
IFNDEF TS,TS==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
IFE TS,[
APR=0
CTYIN=32
CTYOUT=33
]
IFN TS,[
TYIC==1
TYOC==2
]
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:
IFE TS, SETZM CTYIN
IFN TS,[
.OPEN TYIC,[.UAI,,'TTY]
.LOSE
.OPEN TYOC,[.UAO,,'TTY]
.LOSE
.CALL [ SETZ ; turn off echoing
SIXBIT /TTYSET/
MOVEI TYIC
MOVE [030202,,020202]
SETZ [030202,,020202] ]
]
MOVE P,RSP
MOVE PP,PSP
MOVEI PC,[.QUIT]
JRST NEXT
;
; output
;
; print ASCII character in AC 0 - changes AC 0
PUTCHAR:
IFE TS,[
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
]
IFN TS, .IOT TYOC,0
CAIE 0,IFE TS,[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:
IFE TS,[
CONO APR,12000 ; 10000 = set flags, 2000 = interrupt flag
MOVE 0,CTYIN
CAIN 0,0
JRST .-2
SETZM CTYIN
TRZ 0,400
]
IFN TS, .IOT TYIC,0
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
Reference in New Issue View Git Blame Copy Permalink