.enabl	lc
	.title	itsy bitsy basic
;+
;
; An itsy bitsy BASIC interpreter, by John Wilson.
;
; Originally based on a FOCAL interpreter written in BASIC on 12-Feb-85.
;
; 30-May-86	JMBW	Started.
; 09-Sep-91	JMBW	Added GOSUB/RETURN, FOR/NEXT (it's been awhile!).
; 14-Sep-91	JMBW	Added ! comments and END.
;
;-
	.mcall	.exit,.gtlin,.print,.scca,.ttyin,.ttyout
;
gosubs=	100.	;max # of active GOSUB's
fors=	26.	;max # of active FOR's
;
ctrlc=	3	;^C
tab=	11	;tab
lf=	12	;line feed
cr=	15	;carriage return
blank=	40	;blank
;
jsw=	44	;RT11 job status word
;
ibb:	.print	#banner		;say hello
	bis	#40000,@#jsw	;set lower case bit
	.scca	#ccarea		;catch ^C's
	mov	#gotab,gosp	;init GOSUB SP
	mov	#fortab,forsp	;init FOR SP
;+
;
; Come here to print ready prompt and continue.
;
;-
prmpt:	.print	#prompt		;prompt
	mov	#-1,line	;not RUNning
	clr	ccflag		;no ^C's
nprmpt:	; here for no prompt
	mov	#1000,sp	;purge stack
	mov	#kbbuf,r5	;point at buffer
	.gtlin	r5		;read a line
;
	call	skip		;skip white space
	beq	nprmpt		;blank line, get more
; check for ^C
	mov	r5,r0		;copy ptr
10$:	tstb	(r0)+		;find end
	bne	10$		;loop
	cmpb	-2(r0),#ctrlc	;^C?
	beq	prmpt		;yes, reprompt
;
	call	prsint		;line number?
	bcs	20$		;no...
	call	progln		;yep, handle it
	br	nprmpt		;loop
;
20$:	mov	#cmds,r1	;point at commands
	mov	#cmdisp,r2	;point at dispatch table
	call	30$		;this is kind of a hack
	br	prmpt		;loop
30$:	call	parse		;parse, dispatch
	mov	r5,lptr		;pt at line
	jmp	stmnt		;not a cmd, see if statement
;
cmds:	.asciz	"BYE"
	.asciz	"LIST"
	.asciz	"RUN"
	.byte	0		;end of table
;
	.even
cmdisp:	.word	bye
	.word	list
	.word	run
;+
;
; BYE command.
;
;-
bye:	.exit			;see you around
;+
;
; LIST command.
;
;-
list:	mov	#mem,r1		;point at memory
10$:	cmp	r1,freptr	;off end?
	beq	20$		;yep
	mov	(r1)+,r0	;no, get line #
	mov	r1,-(sp)	;save
	call	prlno		;print it
	mov	(sp)+,r1	;restore
	.ttyout	#blank		;print a blank
	.print	r1		;print rest of line
	tstb	(r1)+		;at end?
	bne	.-2		;no
	inc	r1		;bump again
	bic	#1,r1		;.even
	br	10$		;loop
20$:	rts	pc
;+
;
; Print line # in r0.
;
;-
prlno:	mov	#10.,r2		;base 10.
	mov	#enbuf,r5	;point at buf
	mov	#3,r4		;loop 3 times
10$:	call	$div		;divide
	bis	#'0,r1		;cvt to ascii
	movb	r1,-(r5)	;put in buf
	sob	r4,10$		;loop
	bis	#'0,r0		;last dig
	movb	r0,-(r5)	;put in buf
	.print	r5		;print the #
	rts	pc
;+
;
; RUN command.
;
;-
run:	cmp	freptr,#mem	;anything in memory?
	beq	30$		;no
	mov	#gotab,gosp	;init GOSUB SP
	mov	#fortab,forsp	;init FOR SP
	mov	#mem,lptr	;point at first line
	mov	lptr,r4		;get ptr
10$:	mov	(r4)+,line	;get line #
	mov	r4,r5		;copy ptr
	call	stmnt		;execute statement
	mov	lptr,r4		;get ptr back (may have changed)
	tst	(r4)+		;skip line #
20$:	tstb	(r4)+		;skip to end
	bne	20$		;loop
	inc	r4		;bump ptr
	bic	#1,r4		;.even
	cmp	r4,freptr	;off end?
	beq	30$		;yes
	mov	r4,lptr		;save
	br	10$		;loop
30$:	rts	pc
;+
;
; Execute statement at (r5).
;
;-
stmnt:	tst	(pc)+		;^C?
ccflag:	.word	0
	bne	10$		;yes, skip
	mov	#stmnts,r1	;point at statements
	mov	#stdisp,r2	;point at dispatch table
	call	parse		;parse, dispatch
	jmp	$let		;assume LET
10$:	mov	#2,r1		;eat 2 ^C's
20$:	.ttyin			;get a char
	cmp	r0,#ctrlc	;^C?
	bne	20$		;no, loop
	sob	r1,20$		;yes, count it
	jmp	$stop		;STOP
;
stmnts:	.asciz	"&"
	.asciz	"END"
	.asciz	"FOR"
	.asciz	"GOSUB"
	.asciz	"GOTO"
	.asciz	"IF"
	.asciz	"LET"
	.asciz	"NEXT"
	.asciz	"PRINT"
	.asciz	"REM"
	.asciz	"RETURN"
	.asciz	"STOP"
crlf:	.byte	0		;end of table
;
	.even
stdisp:	.word	$print
	.word	$end
	.word	$for
	.word	$gosub
	.word	$goto
	.word	$if
	.word	$let
	.word	$next
	.word	$print
	.word	$rem
	.word	$retur
	.word	$stop
;+
;
; Look up keyword at (r5) on table of .asciz keywords at (r1), dispatch to
; corresponding address in table at (r2) if found.
;
; If not found, return; otherwise return
; to preceding stack level.
;
;-
parse:	mov	r5,r4		;copy
10$:	tstb	(r1)		;at end?
	beq	60$		;yep, not found
	mov	r4,r5		;copy ptr
20$:	movb	(r1)+,r3	;get a char
	beq	50$		;end of keyword, match!
	call	skip		;skip white space
	beq	40$		;eol, never mind
	movb	(r5)+,r0	;get char
	cmp	r0,#'a		;lower case?
	blo	30$		;no
	cmp	r0,#'z
	bhi	30$
	sub	#40,r0		;yes, convert
30$:	cmp	r0,r3		;chars match?
	beq	20$		;yep, loop
40$:	tstb	(r1)+		;skip to next keyword
	bne	40$		;loop
	tst	(r2)+		;skip to next dispatch address
	br	10$		;do next keyword
50$:	tst	(sp)+		;bag top of stack
	jmp	@(r2)+		;dispatch
60$:	mov	r4,r5		;restore ptr
	rts	pc
;
whterr:	tst	line		;line # >=0?
	bpl	synerr		;yep
prwhat:	.print	#what		;print msg
	jmp	prmpt		;loop
synerr:	mov	#syntax,r0	;yep
	;br	error
;
error:	.print			;print the msg
	tst	line		;running?
	bmi	10$		;no
	.print	#atline		;at line
	mov	line,r0		;get line #
	call	prlno		;print it
	mov	#-1,line	;not running anymore
10$:	.print	#crlf		;print msg
	jmp	prmpt		;loop
;
	.rem	_
1000 REM ASK
1010 IF LEN(L$)=0% THEN 900
1020 A$=SEG$(L$,1%,1%) \ L$=SEG$(L$,2%,LEN(L$))
1030 IF A$<'A' THEN 900
1040 IF A$>'Z' THEN 900
1050 PRINT ': '; \ INPUT #0%,V(ASC(A$)-65%) \ REM INPUT THE VALUE
1060 IF LEN(L$)=0% THEN RETURN
1070 IF SEG$(L$,1%,1%)<>',' THEN 1090
1080 L$=SEG$(L$,2%,LEN(L$)) \ GO TO 1010
1090 IF SEG$(L$,1%,1%)<>'\' THEN 900
1100 L$=SEG$(L$,2%,LEN(L$)) \ GO TO 500
_
;+
;
; FOR v = e1 TO e2 [STEP e3]
;
;-
$for:	; get v
	call	skip		;skip white space
	beq	forerr		;eol, error
	movb	(r5)+,r0	;get a char
	bic	#40,r0		;cvt to upper if lower
	sub	#'A,r0		;cvt to offset
	cmp	r0,#25.		;<='Z'?
	bhi	forerr		;no, error
	asl	r0		;cvt to offset
	add	#vars,r0	;form addr of var
	mov	r0,-(sp)	;save
	; get e1
	call	skip		;skip white space
	cmpb	(r5)+,#'=	;equals sign?
	bne	forerr		;nope, error
	call	eval		;get an expression
	mov	r0,@(sp)	;set initial value
	; look for TO
	mov	#to,r1		;set up to check for TO
	mov	#todisp,r2
	call	parse
	br	forerr
$to:	; get e2
	call	eval		;do it
	mov	r0,-(sp)
	mov	#step,r1	;set up to check for STEP
	mov	#spdisp,r2
	call	parse
	mov	#1,r0		;STEP 1
	br	step1
$step:	; get e3
	call	eval		;do it
step1:	; e3 in r0
	mov	(sp)+,r1	;get e2
	mov	(sp)+,r2	;and #v
	mov	forsp,r3	;get table ptr
	cmp	r3,#formax	;FOR table full?
	beq	10$		;yes
	mov	r2,(r3)+	;save #v,
	mov	r0,(r3)+	; step,
	mov	r1,(r3)+	;and limit
	mov	r5,(r3)+	;current interp. ptr
	mov	lptr,(r3)+	;and LPTR
	mov	r3,forsp	;update
	jmp	nextst		;get more
10$:	mov	#forv,r0	;too many FOR's
	jmp	error
forerr:	jmp	whterr		;error
;
to:	.asciz	"TO"
	.byte	0
todisp:	.word	$to
;
step:	.asciz	"STEP"
	.byte	0
spdisp:	.word	$step
;+
;
; NEXT v
;
;-
$next:	mov	forsp,r2	;get stack
	cmp	r2,#fortab	;are there any FOR's?
	beq	50$		;no
	sub	#10.,r2		;back up
	; see if v was given to check for nesting
	call	skip		;is there a variable?
	beq	10$		;no
	movb	(r5)+,r0	;get a char
	bic	#40,r0		;cvt to upper if lower
	sub	#'A,r0		;cvt to offset
	cmp	r0,#25.		;<='Z'?
	bhi	forerr		;syntax error
	asl	r0		;cvt to offset
	add	#vars,r0	;form addr of var
	cmp	r0,(r2)		;the one we expect?
	bne	50$		;no, error
10$:	; increment loop variable
	mov	(r2)+,r0	;get ptr to variable
	mov	(r2)+,r1	;get increment
	bmi	30$		;negative, special case
	add	r1,(r0)		;bump loop index
	cmp	(r0),(r2)+	;are we done?
	bgt	40$		;yes
20$:	mov	(r2)+,r5	;restore interp. ptr
	mov	(r2)+,r2	;get LPTR
	mov	r2,lptr		;save
	mov	(r2)+,line	;line #
	jmp	nextst
30$:	; negative STEP
	add	r1,(r0)		;bump loop index
	cmp	(r0),(r2)+	;are we done?
	bge	20$		;no, continue
40$:	; done
	sub	#6,r2		;back to where we were
	mov	r2,forsp	;clear from stack
	jmp	nextst		;continue
50$:	mov	#nexwof,r0	;next w/o for
	jmp	error
;+
;
; GOTO statement.
;
;-
$goto:	.enabl	lsb
	call	prsint		;get an integer
	bcs	10$		;error
	call	fline		;find the line
	bcs	20$		;no such line
	mov	r2,lptr		;set new ptr
	mov	(r2)+,line	;save line #
	mov	r2,r5		;point at the line
	jmp	stmnt		;do the line
10$:	jmp	whterr		;syntax error (no line #)
20$:	mov	#noline,r0	;can't find line
	jmp	error
;+
;
; GOSUB statement.
;
;-
$gosub:	call	prsint		;get an integer
	bcs	10$		;err
	call	fline		;find line
	bcs	20$		;no such
	; save r5 on stack
	cmp	gosp,#gomax	;stack full?
	beq	30$		;yes
	mov	r5,@gosp	;no, save
	add	#2,gosp		;bump ptr
	mov	lptr,@gosp	;LPTR
	add	#2,gosp
	mov	r2,lptr		;set new ptr
	mov	(r2)+,line	;save line #
	mov	r2,r5		;point at the line
	jmp	stmnt		;do the line
30$:	mov	#gosubv,r0	;too many GOSUB's
	jmp	error
	.dsabl	lsb
;+
;
; RETURN statement.
;
;-
$retur:	cmp	gosp,#gotab	;nothing to which to return?
	beq	10$		;punt
	sub	#2,gosp		;get LPTR
	mov	@gosp,r0
	mov	r0,lptr
	mov	(r0),line
	sub	#2,gosp		;get interpreter ptr
	mov	@gosp,r5
	jmp	nextst
10$:	mov	#retwog,r0	;return w/o gosub
	jmp	error
;+
;
; IF statement.
;
; No THEN for now, have to use "IF(expr) stmnt[:stmnt...]".
;
;-
$if:	call	eval		;evaluate expression
	tst	r0		;true?
	beq	10$		;no
	jmp	stmnt		;yes, execute statement(s)
10$:	rts	pc
;+
;
; LET statement.
;
;-
$let:	call	skip		;skip white space
	beq	10$		;eol, error
	movb	(r5)+,r0	;get a char
	bic	#40,r0		;cvt to upper if lower
	sub	#'A,r0		;cvt to offset
	cmp	r0,#25.		;<='Z'?
	bhi	10$		;no, error
	asl	r0		;cvt to offset
	mov	r0,-(sp)	;save
	call	skip		;skip white space
	cmpb	(r5)+,#'=	;equals sign?
	bne	10$		;nope, error
	call	eval		;get an expression
	mov	(sp)+,r1	;get variable index
	mov	r0,vars(r1)	;set new value
	br	nextst		;get more
10$:	jmp	whterr		;error
;+
;
; PRINT (&) statement.  Strings are allowed here.
;
;-
$print:	br	20$		;skip
10$:	movb	(r5),r1		;get 1st char
	cmp	r1,#'"		;quotes?
	beq	50$		;yes
	cmp	r1,#''
	beq	50$
	call	eval		;evaluate expression
	call	prnum		;print it
20$:	call	skip		;more?
	beq	40$		;no, done
	movb	(r5),r0		;get char
	cmp	r0,#';		;semicolon?
	beq	30$		;yes
	cmp	r0,#',		;comma?
	bne	10$		;no
	.ttyout	#tab		;yes, tab
30$:	inc	r5		;eat it
	call	skip		;more?
	bne	10$		;yes
	br	nextst		;more
40$:	; crlf needed
	.print	#crlf		;crlf
	br	nextst		;more
50$:	; string
	inc	r5		;skip delimiter
60$:	movb	(r5)+,r0	;get next char
	beq	40$		;hard eol
	cmp	r0,r1		;end of string?
	beq	20$		;yes
	.ttyout			;no, dump
	br	60$		;loop
;+
;
; Print number in r0 (signed).
;
;-
prnum:	mov	#enbuf,r4	;pt at end of buf
	mov	r0,-(sp)	;save number
	bpl	10$		;positive, skip
	neg	r0		;take abs val
10$:	mov	#10.,r2		;base 10.
20$:	call	$div		;divide
	bis	#'0,r1		;cvt to ascii
	movb	r1,-(r4)	;put in buf
	tst	r0		;anything left?
	bne	20$		;yeah, loop
	tst	(sp)+		;was it negative?
	bpl	30$		;no, skip
	movb	#'-,-(r4)	;put in buf
30$:	.print	r4		;print the number
	rts	pc
;+
;
; REM statement (this is a toughie).
;
;-
$rem:	rts	pc		;don't look for \ or :
;+
;
; STOP statement.
;
;-
$stop:	tst	(sp)+		;flush r.a.
	clr	ccflag		;clear ^C flag
	mov	#stopm,r0	;pt at msg
	jmp	error		;treat as error
;+
;
; END
;
;-
$end:	tst	(sp)+		;flush
	clr	ccflag		;clear ^C flag
	jmp	prmpt
;+
;
; Handle next statement on line ('\',':') or return if none.
;
;-
nextst:	call	skip		;skip blanks
	bne	10$		;not end of line
	movb	(r5)+,r0	;get char we stopped on
	beq	20$		;end of line, just return
	jmp	stmnt		;handle next statement
10$:	jmp	whterr		;error
20$:	rts	pc
;
	.rem	_
3000 REM TYPE
3010 IF LEN(L$)=0 THEN RETURN
3020 A$=SEG$(L$,1%,1%)
3030 IF A$='"' THEN 3050
3040 IF A$<>"'" THEN 3100
3050 A%=2%
3060 IF LEN(L$)<A% THEN 900
3070 IF SEG$(L$,A%,A%)=A$ THEN 3090
3080 PRINT SEG$(L$,A%,A%); \ A%=A%+1% \ GO TO 3060
3090 L$=SEG$(L$,A%+1%,LEN(L$)) \ GO TO 3010
3100 IF A$='!' THEN PRINT  \ L$=SEG$(L$,2%,LEN(L$)) \ GO TO 3010
3110 IF A$=',' THEN L$=SEG$(L$,2%,LEN(L$)) \ GO TO 3010
3115 IF A$='\' THEN L$=SEG$(L$,2%,LEN(L$)) \ GO TO 500
3120 GOSUB 5000 \ IF E%=1% THEN RETURN
3130 PRINT V;
3140 L$=SEG$(L$,P0%,LEN(L$)) \ GO TO 3010
_
;+
;
; Insert line r1 unless (r5) is null, in which case delete line r1.
;
;-
progln:	call	skip		;skip white space
	bne	50$		;not blank, go insert/replace
	; delete line r1
	cmp	freptr,#mem	;anything to delete?
	beq	40$		;no, just nop
	call	fline		;find line # r1
	bcs	40$		;no such line, nop
	mov	r2,r3		;copy ptr
	tst	(r3)+		;skip line #
10$:	tstb	(r3)+		;eol?
	bne	10$		;no
	inc	r3		;bump ptr again
	bic	#1,r3		;.even
	cmp	r3,freptr	;last line?
	bne	20$		;no
	mov	r2,freptr	;yes, zap it
	rts	pc
20$:	mov	freptr,r4	;copy end
	sub	r3,r4		;find length to copy
	clc			;C=0
	ror	r4		;word count
30$:	mov	(r3)+,(r2)+	;copy a word
	sob	r4,30$		;loop
	mov	r2,freptr	;update ptr
40$:	rts	pc
50$:	; insert/replace the line
	mov	r5,r0		;copy ptr
60$:	tstb	(r0)+		;end?
	bne	60$		;no
	sub	r5,r0		;=length
	inc	r0		;bump ptr
	bic	#1,r0		;.even
	call	fline		;look up the line #
	bcs	150$		;not found, skip
	tst	(r2)+		;skip line #
	mov	r2,r3		;copy ptr
70$:	tstb	(r3)+		;eol?
	bne	70$		;no
	inc	r3		;bump ptr again
	bic	#1,r3		;.even
	cmp	r3,freptr	;last line?
	bne	90$		;nupe
	add	r2,r0		;pt at new end
	cmp	r0,#memend	;off end?
	bhi	180$		;yep, error
	mov	r0,freptr	;update ptr
80$:	movb	(r5)+,(r2)+	;copy a byte
	bne	80$		;loop
	rts	pc
90$:	; replacing a line in the middle somewhere
	mov	r3,r4		;copy
	sub	r2,r4		;find length of old line
	cmp	r0,r4		;same as before?
	beq	110$		;yes, easy
	bhi	120$		;need to expand
	add	r2,r4		;point at old end
	add	r2,r0		;new end
	mov	freptr,r3	;get ptr to end
	sub	r4,r3		;find byte count
	clc			;C=0
	ror	r3		;word count
100$:	mov	(r4)+,(r0)+	;copy a word
	sob	r3,100$		;loop
	mov	r0,freptr	;new free pointer
110$:	movb	(r5)+,(r2)+	;copy a byte
	bne	110$		;loop
	rts	pc
120$:	sub	r4,r0		;find difference
	add	r2,r4		;point at old end
	mov	freptr,r3	;get ptr to end
	sub	r4,r3		;find byte count
	clc			;C=0
	ror	r3		;word count
	mov	freptr,r4	;get source
	add	r4,r0		;dest
130$:	cmp	r0,#memend	;too big?
	bhi	180$		;yep
	mov	r0,freptr	;new free pointer
140$:	mov	-(r4),-(r0)	;copy
	sob	r3,140$		;loop
	br	110$		;go copy line
150$:	; inserting a new line
	add	#2,r0		;allow for line #
	mov	freptr,r4	;get source
	cmp	r2,r4		;at end?
	beq	170$		;yep
	add	r4,r0		;dest
	mov	r4,r3		;copy
	sub	r2,r3		;byte count
	clc			;C=0
	ror	r3		;word count
	cmp	r0,#memend	;out of memory?
	bhi	180$		;yes
	mov	r0,freptr	;no, save ptr
160$:	mov	-(r4),-(r0)	;copy
	sob	r3,160$		;loop
	mov	r1,(r2)+	;save line #
	br	110$		;go copy line
170$:	add	r0,r4		;find new end
	cmp	r4,#memend	;out of memory?
	bhi	180$		;yep
	mov	r4,freptr	;save it
	mov	r1,(r2)+	;save line #
	br	110$		;go copy string
180$:	.print	#oom		;out of memory
	rts	pc
;+
;
; Find line number r1.
;
; Return with r1 intact and r2 pointing at the line,
; or at the following line if C=1.
;
;-
fline:	mov	#mem,r2		;point at begn
10$:	cmp	r2,freptr	;at end?
	beq	30$		;yes, not found
	cmp	r1,(r2)		;past it yet?
	blo	30$		;yes, not found
	beq	40$		;got it
	tst	(r2)+		;skip line #
20$:	tstb	(r2)+		;at end?
	bne	20$		;no
	inc	r2		;bump ptr
	bic	#1,r2		;.even
	br	10$		;loop
30$:	sec			;not found
40$:	rts	pc
;+
;
; Skip spaces and tabs.
;
; Return Z=1 if off end of statement.
;
;-
skip:	movb	(r5)+,r0	;get a char
	beq	30$		;end of line
	cmp	#' ,r0		;blank?
	beq	skip		;yes, ignore
	cmp	#tab,r0		;tab?
	beq	skip		;yup
	dec	r5		;back up
	cmp	r0,#'!		;comment?
	beq	20$
	cmp	r0,#':		;end of statement?
	beq	10$
	cmp	r0,#'\
10$:	rts	pc
20$:	; ! comment
	tstb	(r5)+		;skip to eol
	bne	.-2
30$:	; hard eol
	dec	r5		;back up
	sez			;Z=1
	rts	pc
;+
;
; Expression evaluator.
;
; Evaluates expression at (r5);
; returns value in r0.
;
;-
eval:	call	eval1		;do an expression
	bcs	10$		;error, skip
	rts	pc
10$:	mov	#illexp,r0	;illegal expr
	jmp	error		;handle it
;+
;
; Evaluate a relational expression.
;
; =,<>,<,<=,>,>=
;
;-
eval1:	call	arith		;do a primary
	bcs	100$		;error
	mov	r0,r1		;save r0
10$:	call	skip		;skip white space
	beq	90$		;eol, return
	cmp	r0,#'=		;"="?
	bne	20$		;no, skip
	mov	r1,-(sp)	;yes, save first number
	inc	r5		;skip "="
	call	arith		;get another primary
	bcs	110$		;error
	cmp	(sp)+,r0	;restore, compare
	beq	70$		;equal
	br	80$		;not equal
20$:	cmp	r0,#'<		;"<"?
	bne	50$		;no
	mov	r1,-(sp)	;save
	inc	r5		;skip "<"
	call	skip		;skip blanks
	beq	110$		;eol, error
	inc	r5		;skip char
	cmp	r0,#'>		;"<>"?
	bne	30$		;no
	call	arith		;get subexpr
	bcs	110$		;error
	cmp	(sp)+,r0	;equal?
	bne	70$		;no
	br	80$		;yes
30$:	cmp	r0,#'=		;"<="?
	bne	40$		;no
	call	arith		;get subexpr
	bcs	110$		;error
	cmp	(sp)+,r0	;compare
	ble	70$		;<=
	br	80$		;>
40$:	dec	r5		;must be just "<"
	call	arith		;get subexpr
	bcs	110$		;err
	cmp	(sp)+,r0	;compare
	blt	70$		;<
	br	80$		;>=
50$:	cmp	r0,#'>		;">"?
	bne	90$		;no, return
	inc	r5		;bump ptr
	mov	r1,-(sp)	;save
	call	skip		;skip to next char
	beq	110$		;eol, error
	cmp	r0,#'=		;">="?
	bne	60$		;no
	inc	r5		;yes, skip "="
	call	arith		;get subexpr
	bcs	110$		;err
	cmp	(sp)+,r0	;compare
	bge	70$		;>=
	br	80$		;<
60$:	call	arith		;just ">", subexpr
	bcs	110$		;error
	cmp	(sp)+,r0	;compare
	ble	80$		;<=
	;br	70$		;>
70$:	; true
	mov	#-1,r1		;return -1
	br	10$		;loop
80$:	; false
	clr	r1		;return 0
	br	10$		;loop
90$:	clc			;no problem
	mov	r1,r0		;copy
100$:	rts	pc
110$:	tst	(sp)+		;purge stack
	sec			;error
	rts	pc
;+
;
; Evaluate an arithmetic subexpression (+,-,*,/,^).
;
;-
arith:	call	addsub		;do a primary
	bcs	40$		;error
	mov	r0,r1		;save r0
10$:	call	skip		;skip white space
	beq	30$		;eol, return
	cmp	r0,#'+		;"+"?
	bne	20$		;no, skip
	mov	r1,-(sp)	;yes, save addend
	inc	r5		;skip "+"
	call	addsub		;get another primary
	bcs	50$		;error
	mov	(sp)+,r1	;restore
	add	r0,r1		;find sum
	br	10$		;loop
20$:	cmp	r0,#'-		;"-"?
	bne	30$		;no, return
	mov	r1,-(sp)	;yes, save minuend
	inc	r5		;skip "-"
	call	addsub		;get subtrahend
	mov	(sp)+,r1	;restore minuend
	sub	r0,r1		;find difference
	br	10$		;loop
30$:	clc			;no problem
	mov	r1,r0		;copy
40$:	rts	pc
50$:	tst	(sp)+		;purge stack
	sec			;error
	rts	pc
;+
;
; Add/subtract primary evaluator.
;
; Handles subexpressions containing only "*", "/", and "^".
;
;-
addsub:	call	muldiv		;do a primary
	bcs	70$		;error
	mov	r0,r1		;save r0
10$:	call	skip		;skip white space
	beq	60$		;eol, return
	cmp	r0,#'*		;"*"?
	bne	20$		;no, skip
	mov	r1,-(sp)	;yes, save multiplicand
	inc	r5		;skip "*"
	call	muldiv		;get multiplier
	bcs	80$		;error
	mov	(sp)+,r2	;restore
	call	$mul		;find product
	br	10$		;loop
20$:	cmp	r0,#'/		;"/"?
	bne	60$		;no, return
	mov	r1,-(sp)	;yes, save dividend
	inc	r5		;skip "/"
	call	muldiv		;get divisor
	mov	r0,r2		;copy
	bne	30$		;non-zero
	.print	#div0		;division by 0, issue warning
30$:	mov	r2,r4		;copy flag
	bpl	40$		;positive, skip
	neg	r2		;take absolute vaalue
40$:	mov	(sp)+,r0	;restore dividend
	bpl	50$		;positive, skip
	xor	r0,r4		;flip flag
	neg	r0		;take abs val
50$:	call	$div		;divide
	mov	r0,r1		;copy quotient
	tst	r4		;should we flip it?
	bpl	10$		;no, loop
	neg	r1		;yes, do it
	br	10$		;loop
60$:	clc			;no problem
	mov	r1,r0		;copy
70$:	rts	pc
80$:	tst	(sp)+		;purge stack
	sec			;error
	rts	pc
;
$div:	; divide r0 by r2
	; result in r0, remainder in r1
	; clears r3
	clr	r1		;init rem
	mov	#20,r3		;bit counter
10$:	asl	r0		;rotate a bit
	rol	r1		;into r1
	cmp	r1,r2		;will r2 fit into the rem?
	bcs	20$		;no, skip
	sub	r2,r1		;yes, do it for real
20$:	adc	r0		;OR in new bit
	sob	r3,10$		;loop
	com	r0		;correct (C always flipped)
	rts	pc
;
$mul:	; multiply r0 by r2
	; result in r1
	; clears r0 and r3, trashes r2
	clr	r1		;init product
	mov	#20,r3		;bit counter
10$:	ror	r2		;add?
	bcc	20$		;no
	add	r0,r1		;yes
20$:	asl	r0		;shift
	sob	r3,10$		;loop
	rts	pc
;+
;
; Multiply/divide primary evaluator.
;
; Handles subexpressions containing only "^".
;
; Ignores sign of exponent (not much use
; since we are using integers only).
;
; Uses the following algorithm to compute foo^bar:
;
;	if bar=0, return 1
;	zot=1
; loop:	if bar=1, return foo*zot
;	if bar is odd, zot=zot*foo
;	foo=foo^2
;	bar=bar/2
;	go to loop
;
;-
muldiv:	call	prim		;do a primary
	bcs	70$		;error
	mov	r0,r1		;save r0
10$:	call	skip		;skip white space
	beq	60$		;eol, return
	cmp	r0,#'^		;"^"?
	bne	60$		;no, return
	mov	r1,-(sp)	;yes, save value
	inc	r5		;skip "^"
	call	prim		;do another primary
	bcs	80$		;error
	; r1=(sp)^r0
	mov	r0,r4		;copy exponent
	beq	50$		;=0, number is 1
	mov	#1,-(sp)	;correction for odd powers
20$:	clc			;shift in a 0
	ror	r4		;/2, catch bit 0 in C
	beq	40$		;was 1, we're done
	bcc	30$		;was even, skip
	mov	(sp),r0		;get correction
	mov	2(sp),r2	;get number
	call	$mul		;multiply
	mov	r1,(sp)		;replace
30$:	mov	2(sp),r0	;get number
	mov	r0,r2		;copy
	call	$mul		;square it (power *2)
	mov	r1,2(sp)	;save
	br	20$		;loop
40$:	mov	(sp)+,r0	;get correction
	mov	(sp)+,r2	;and number
	call	$mul		;multiply
	br	10$		;done, loop
50$:	tst	(sp)+		;clear stack
	mov	#1,r1		;exponent was 0, # is 1
	br	10$		;loop
60$:	clc			;no problem
	mov	r1,r0		;put in r0
70$:	rts	pc
80$:	tst	(sp)+		;purge stack
	sec			;error
	rts	pc
;+
;
; Primary evaluator.
;
;-
prim:	call	skip		;skip white space
	beq	100$		;end of line, error
	clr	r1		;sign defaults to '+'
10$:	cmp	r0,#'+		;plus?
	beq	20$		;yes, ignore it
	cmp	r0,#'-		;minus?
	bne	30$		;no, skip
	com	r1		;yes, flip sign
20$:	inc	r5		;skip
	call	skip		;skip white space
	bne	10$		;loop
	br	100$		;end of line, error
30$:	mov	r1,-(sp)	;save sign flag
	cmp	r0,#'(		;left paren?
	bne	60$		;no
	inc	r5		;yes, skip it
	call	eval1		;evaluate subexpr in parens
	cmpb	(r5)+,#')	;right paren?
	beq	40$		;yes
	dec	r5		;back up (not really nessa)
	mov	#clpar,r0	;no closing paren
	jmp	error		;error
40$:	tst	(sp)+		;get sign back
	beq	50$		;skip
	neg	r0		;negative, negate
50$:	clc			;no error
	rts	pc
60$:	; constant or variable
	call	prsint		;constant?
	bcs	70$		;no, must be variable
	mov	r1,r0		;copy to r0
	br	40$		;apply sign
70$:	; must be variable
	movb	(r5)+,r0	;get a char
	cmp	r0,#'Z		;lower case, maybe?
	blos	80$		;no
	sub	#40,r0		;yes, cvt to upper case if so
80$:	sub	#'A,r0		;cvt to offset
	cmp	r0,#25.		;<='Z'?
	bhi	90$		;no, error
	asl	r0		;cvt to offset
	mov	vars(r0),r0	;get value
	br	40$		;apply sign, return
90$:	tst	(sp)+		;error, clear stack
100$:	sec			;no value
	rts	pc
;+
;
; Parse an integer at (r5).
;
; Return value in r1.  C=1 if (r5) wasn't an integer.
;
;-
prsint:	movb	(r5)+,r1	;get a char
	beq	30$		;end of line, skip
	cmp	r1,#blank	;blank?
	beq	prsint		;yes, ignore it
	cmp	r1,#tab		;tab?
	beq	prsint		;yep
	sub	#'0,r1		;cvt to binary
	cmp	r1,#9.		;digit?
	bhi	30$		;no
10$:	movb	(r5)+,r0	;get a char
	beq	20$		;end of line
	cmp	r0,#blank	;blank?
	beq	10$		;yes
	cmp	r0,#tab		;tab?
	beq	10$		;yes
	sub	#'0,r0		;cvt to bin
	cmp	r0,#9.		;digit?
	bhi	20$		;no, end of #
	mov	r1,r2		;copy
	asl	r1		;*2
	asl	r1		;*4
	add	r2,r1		;*5
	asl	r1		;*10.
	add	r0,r1		;add in the new digit
	br	10$		;loop
20$:	dec	r5		;back up
	clc			;no problem
	rts	pc
30$:	dec	r5		;back up
	sec			;not a #
	rts	pc
;
line:	.word	0		;current line #
lptr:	.word			;ptr to current line
freptr:	.word	mem		;ptr to end of mem
;
ccarea:	.byte	0,35		;.SCCA
	.word	ccflag		;addr of flag
;
banner:	.asciz	"Itsy Bitsy BASIC, by John Wilson"
prompt:	.asciz	<cr><lf>"Ready."
oom:	.asciz	"?Out of memory"
what:	.asciz	<cr><lf>"?What?"
syntax:	.ascii	<cr><lf>"?Syntax error"<200>
atline:	.ascii	" at line "<200>
clpar:	.ascii	<cr><lf>"?No closing paren"<200>
illexp:	.ascii	<cr><lf>"?Illegal expression"<200>
stopm:	.ascii	<cr><lf>"STOP"<200>
noline:	.ascii	<cr><lf>"?No such line"<200>
gosubv:	.ascii	<cr><lf>"?GOSUB stack overflow"<200>
retwog:	.ascii	<cr><lf>"?RETURN without GOSUB"<200>
forv:	.ascii	<cr><lf>"?FOR stack overflow"<200>
nexwof:	.ascii	<cr><lf>"?NEXT without FOR"<200>
div0:	.asciz	<cr><lf>"%Division by 0"
;
nbuf:	.blkb	6		;number buffer
enbuf:	.byte	200		;end of nbuf
	.even
	.word	-1		;line # for KBBUF
kbbuf:	.blkb	81.		;KB buffer
;
	.even
vars:	.blkw	26.		;variables A-Z
;
; GOSUB table
gosp:	.blkw			;ptr into GOTAB (initially #GOTAB)
gotab:	.blkw	2*gosubs	;interpreter ptr, LPTR for each RETURN
gomax=	.			;end of table
;
; FOR table
forsp:	.blkw			;ptr into FORTAB (initially #FORTAB)
fortab:	.blkw	5*fors		;see $FOR code
formax=	.			;end of table
;
; format of a line entry:
;	.word	<lin.no>
;	.asciz	/line/
;	.even
;
	.odd
	.byte	0		;comes before first line #
mem:
;	.blkb	2000
;memend=	.
memend=	mem+2000
;
	.end	ibb