tenth.s

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: