title	TINY BASIC
	name	('TINIDISK')
;**************************************************************
;*
;*                TINY BASIC FOR INTEL 8080
;*                      VERSION 1.0
;*                    BY LI-CHEN WANG
;*                     10 JUNE, 1976
;*                       @COPYLEFT
;*                  ALL WRONGS RESERVED
;*
;*        Brought back into use by Werner Cirsovius
;*                     February 2014
;*
;*      Changed code slightly:
;*  (1) Remove RST calls into TPA (Joyce uses RST 7 internally)
;*  (2) Use console I/O thru direct BDOS call
;*  (3) This allows conversion to upper case before echoing
;*  (4) Install macros for clarity of reading code
;*
;**************************************************************

cal	macro	adr		; *** WAS RST 1..7
	db	0cdh
	dw	adr
	endm

_ldai	macro
	db	3eh
	endm

dwa	macro	adr		; *** Makes table more readable
	db	HIGH adr + MSB
	db	LOW adr
	endm

jf	macro	adr		; *** Short jump if FALSE
	db	adr-$-1
	endm

os	equ	0000h
cpm	equ	0005h		; DISK PARAMETERS
fcb	equ	005ch

condir	equ	 6

keyget	equ	0ffh

setdma	equ	26
open	equ	15
readd	equ	20
writed	equ	21
close	equ	16
make	equ	22
delete	equ	19

fdrv	equ	 1
fnam	equ	 8
fext	equ	 3
_EX	equ	12
_CR	equ	32

_EOF	equ	1

OSerr	equ	0ffh

reclng	equ	128

DELLIN	equ	'\'		; Character for deleting the whole line
bs	equ	08h
lf	equ	0ah
ff	equ	0ch
cr	equ	0dh
DEL	equ	7fh

LOMASK	equ	00001111b
UPMASK	equ	11110000b
NOMSB	equ	01111111b
MSB	equ	10000000b

ON	equ	-1

	aseg

	org	100h		; OF CPM.

start:
	jp	init		; GO TO INITIALIZATION ROUTINE.	JIF
;
; Original RST (1..7) vectors positioned here.
; Now they must be CALLed
; RST 7 is used on the JOYCE as interrupt entry point
;
; *** TSTC ***
;
tstc:
	ex	(sp),hl		
	cal	ignblk		; IGNORE BLANKS AND
	cp	(hl)		; TEST CHARACTER
	inc	hl		; COMPARE THE BYTE THAT
	jr	z,tc2		; FOLLOWS THE RST INST.
	push	bc		; WITH THE TEXT (DE->)
	ld	c,(hl)		; IFF NOT =, ADD THE 2ND
	ld	b,0		; BYTE THAT FOLLOWS THE
	add	hl,bc		; RST TO THE OLD PC
	pop	bc		; I.E., DO A RELATIVE
	dec	de		; JUMP IFF NOT =
tc2:
	inc	de		; IFF =, SKIP THOSE BYTES
	inc	hl		; AND CONTINUE
	ex	(sp),hl
	ret
;*
;**************************************************************
;*
;* *** OUTC *** & CHKIO ****!
;* THESE ARE THE ONLY I/O ROUTINES IN TBI.
;* 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'.  IFF OCSW=0
;* 'OUTC' WILL JUST RETURN TO THE CALLER.  IFF OCSW IS NOT 0,
;* IT WILL OUTPUT THE BYTE IN A.  IFF THAT IS A CR, A LF IS ALSO
;* SEND OUT.  ONLY THE FLAGS MAY BE CHANGED AT RETURN, ALL REG.
;* ARE RESTORED.
;*
;* 'CHKIO' CHECKS THE INPUT.  IFF NO INPUT, IT WILL RETURN TO
;* THE CALLER WITH THE Z FLAG SET.  IFF THERE IS INPUT, Z FLAG
;* IS CLEARED AND THE INPUT BYTE IS IN A.  HOWERER, IFF THE
;* INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND
;* Z FLAG IS RETURNED.  IFF A CONTROL-C IS READ, 'CHKIO' WILL
;* RESTART TBI AND DO NOT RETURN TO THE CALLER.
;*
chkio:
	push	bc		; SAVE B ON STACK
	push	de		; AND D
	push	hl		; THEN H
	ld	a,keyget	; GET CONSTAT WORD
	call	CIO		; CALL THE BDOS
	or	a		; SET FLAGS
				; IF READY GET CHARACTER
	jr	z,idone		; RESTORE AND RETURN
	call	conv		; Convert to upper case
	push	af
	call	CIO		; Echo character
	pop	af
	cp	'O'-'@'		; IS IT CONTROL-O?
	jr	nz,ci2		; NO, MORE CHECKING
	ld	a,(ocsw)	; CONTROL-O  FLIP OCSW
	cpl			; ON TO OFF, OFF TO ON
	ld	(ocsw),a	; AND PUT IT BACK
	jr	chkio		; AND GET ANOTHER CHARACTER
ci2:
	cp	'C'-'@'		; IS IT CONTROL-C?
	jr	nz,idone	; RETURN AND RESTORE IF NOT
	jp	rstart		; YES, RESTART TBI
;
; *** CRLF ***
;
crlf:
	ld	a,cr
;
; *** OUTC ***
;
outc:
	push	af
	ld	a,(ocsw)	; PRINT CHARACTER ONLY
	or	a		; IFF OCSW SWITCH IS ON
	jr	nz,oc3		; IT IS OFF
	pop	af		; IT IS OFF
	ret
oc3:
	pop	af		; GET OLD A BACK
	push	bc		; SAVE B ON STACK
	push	de		; AND D
	push	hl		; AND H TOO
	push	af
	push	af		; SAVE CHARACTER
	call	CIO		; CALL CPM AND DO IT
	pop	af		; GET CHAR. BACK
	cp	cr		; WAS IT A 'CR'?
	jr	nz,done		; NO, DONE
	ld	a,lf		; GET LINEFEED
	call	CIO		; CALL CPM
done:
	pop	af		; GET CHARACTER BACK
idone:
	pop	hl		; GET H BACK
	pop	de		; AND D
	pop	bc		; AND B TOO
	ret			; RESTORE AF AND RETURN
;
; *** BDOS console interface ***
;
CIO:				; Direct console I/O
	ld	e,a		; Get character or control
	ld	c,condir	; Load code
	call	cpm		; Get or put
	ret
;
; *** Convert character to upper case ***
;
conv:
	push	af
	cp	cr		; Test end of selection
	jr	z,disconv
	cp	'"'		; Test string
	jr	z,toggit
	cp	''''		; Test string
	jr	z,toggit
	ld	a,(convit)	; Get flag
	or	a		; Test conversion
	jr	nz,notogg
	pop	af
	cp	'a'		; Test range
	ret	c
	cp	'z'+1
	ret	nc
	add	a,'A'-'a'	; Convert it
	ret
toggit:
	ld	a,(convit)	; Get flag
	xor	ON		; Toggle it
	jr	convset
disconv:
	xor	a
convset:
	ld	(convit),a	; Turn flag ON/OFF
notogg:
	pop	af
	ret
;
convit:
	db	0
;
; *** EXPR ***
;
expr:
	call	expr2
	push	hl		; EVALUATE AN EXPRESION
	ld	hl,tab8-1	; LOOKUP REL.OP.
	jp	exec		; GO DO IT
;
; *** COMP ***
;
comp:
	ld	a,h
	cp	d		; COMPARE HL WITH DE
	ret	nz		; RETURN CORRECT C AND
	ld	a,l		; Z FLAGS
	cp	e		; BUT OLD A IS LOST
	ret
;
; *** IGNBLK ***
;
ignblk:
	ld	a,(de)		
	cp	' '		; IGNORE BLANKS
	ret	nz		; IN TEXT (WHERE DE->)
	inc	de		; AND RETURN THE FIRST
	jr	ignblk		; NON-BLANK CHAR. IN A
;
; *** FINISH ***
;
finish:
	pop	af
	call	fin		; CHECK END OF COMMAND
	jp	qwhat		; PRINT "WHAT?" IFF WRONG
;
; *** TSTV ***
;
tstv:
	cal	ignblk		
	sub	'A'-1		; TEST VARIABLES
	ret	c		; C:NOT A VARIABLE
	jr	nz,tv1		; NOT "@" ARRAY
	inc	de		; IT IS THE "@" ARRAY
	call	parn		; @ SHOULD BE FOLLOWED
	add	hl,hl		; BY (EXPR) AS ITS INDEX
	jp	c,qhow		; IS INDEX TOO BIG?
	push	de		; WILL IT OVERWRITE
	ex	de,hl		; TEXT?
	call	size		; FIND SIZE OF FREE
	cal	comp		; AND CHECK THAT
	jp	c,asorry	; IFF SO, SAY "SORRY"
ss1a	equ	$+2
	ld	hl,varbgn	; IFF NOT, GET ADDRESS
	call	subde		; OF @(EXPR) AND PUT IT
	pop	de		; IN HL
	ret			; C FLAG IS CLEARED
tv1:
	cp	'Z'+1-'A'+1	; NOT @, IS IT A TO Z?
	ccf			; IFF NOT RETURN C FLAG
	ret	c
	inc	de		; IFF A THROUGH Z
tv1a	equ	$+2
	ld	hl,varbgn	; COMPUTE ADDRESS OF
	rlca			; THAT VARIABLE
	add	a,l		; AND RETURN IT IN HL
	ld	l,a		; WITH C FLAG CLEARED
	ld	a,0
	adc	a,h
	ld	h,a
	ret
;
; *** TSTNUM ***
;
tstnum:
	ld	hl,0
	ld	b,h		; TEST IFF THE TEXT IS
	cal	ignblk		; A NUMBER
tn1:
	cp	'0'		; IFF NOT, RETURN 0 IN
	ret	c		; B AND HL
	cp	'9'+1		; IFF NUMBERS, CONVERT
	ret	nc		; TO BINARY IN HL AND
	ld	a,UPMASK	; SET A TO # OF DIGITS
	and	h		; IFF H>255, THERE IS NO
	jr	nz,qhow		; ROOM FOR NEXT DIGIT
	inc	b		; B COUNTS # OF DIGITS
	push	bc
	ld	b,h		; HL=10;*HL+(NEW DIGIT)
	ld	c,l
	add	hl,hl		; WHERE 10;* IS DONE BY
	add	hl,hl		; SHIFT AND ADD
	add	hl,bc
	add	hl,hl
	ld	a,(de)		; AND (DIGIT) IS FROM
	inc	de		; STRIPPING THE ASCII
	and	LOMASK		; CODE
	add	a,l
	ld	l,a
	ld	a,0
	adc	a,h
	ld	h,a
	pop	bc
	ld	a,(de)		; DO THIS DIGIT AFTER
	jp	p,tn1		; DIGIT. S SAYS OVERFLOW
qhow:
	push	de		; *** ERROR: "HOW?" ***
ahow:
	ld	de,how
	jp	error
;
how:
	db	'HOW?',cr
ok:
	db	'OK',cr
what:
	db	'WHAT?',cr
sorry:
	db	'SORRY',cr
;*
;**************************************************************
;*
;* *** MAIN ***
;*
;* THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
;* AND STORES IT IN THE MEMORY.
;*
;* AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE
;* STACK AND SOME OTHER INTERNAL VARIABLES.  THEN IT PROMPTS
;* ">" AND READS A LINE.  IFF THE LINE STARTS WITH A NON-ZERO
;* NUMBER, THIS NUMBER IS THE LINE NUMBER.  THE LINE NUMBER
;* (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)
;* IS STORED IN THE MEMORY.  IFF A LINE WITH THE SAME LINE
;* NUMBER IS ALREDY THERE, IT IS REPLACED BY THE NEW ONE.  IF
;* THE REST OF THE LINE CONSISTS OF A 0DHONLY, IT IS NOT STORED
;* AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
;*
;* AFTER A LINE ISs INSERTED, REPLACED, OR DELETED, THE PROGRAM
;* LOOPS BACK AND ASK FOR ANOTHER LINE.  THIS LOOP WILL BE
;* TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
;* NUMBER; AND CONTROL IS TRANSFERED TO "DIRCT".
;*
;* TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
;* LABELED "TXTBGN" AND ENDED AT "TXTEND".  WE ALWAYS FILL THIS
;* AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED
;* BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".
;*
;* THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
;* THAT IS CURRENTLY BEING INTERPRETED.  WHILE WE ARE IN
;* THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
;* (SEE NEXT SECTION), "CURRNT" SHOULD POINT TO A 0.
;*
rsta	equ	$+2
rstart:
	ld	sp,stack	; SET STACK POINTER
	call	crlf		; AND JUMP TO HERE
	ld	de,ok		; DE->STRING
	sub	a		; A=0
	call	prtstg		; PRINT STRING UNTIL 0DH
	ld	hl,st2+1	; LITERAL 0
	ld	(currnt),hl	; CURRNT->LINE # = 0
st2:
	ld	hl,0
	ld	(lopvar),hl
	ld	(stkgos),hl
st3:
	ld	a,'>'		; PROMPT '>' AND
	call	getln		; READ A LINE
	push	de		; DE->END OF LINE
st3a	equ	$+2
	ld	de,buffer	; DE->BEGINNING OF LINE
	call	tstnum		; TESt IFF IT IS A NUMBER
	cal	ignblk
	ld	a,h		; HL=VALUE OF THE # OR
	or	l		; 0 IFF NO # WAS FOUND
	pop	bc		; BC->END OF LINE
	jp	z,direct
	dec	de		; BACKUP DE AND SAVE
	ld	a,h		; VALUE OF LINE # THERE
	ld	(de),a
	dec	de
	ld	a,l
	ld	(de),a
	push	bc		; BC,DE->BEGIN, END
	push	de
	ld	a,c
	sub	e
	push	af		; A=# OF BYTES IN LINE
	call	fndln		; FIND THIS LINE IN SAVE
	push	de		; AREA, DE->SAVE AREA
	jr	nz,st4		; NZ:NOT FOUND, INSERT
	push	de		; Z:FOUND, DELETE IT
	call	fndnxt		; FIND NEXT LINE
				; DE->NEXT LINE
	pop	bc		; BC->LINE TO BE DELETED
	ld	hl,(txtunf)	; HL->UNFILLED SAVE AREA
	call	mvup		; MOVE UP TO DELETE
	ld	h,b		; TXTUNF->UNFILLED AREA
	ld	l,c
	ld	(txtunf),hl	; UPDATE
st4:
	pop	bc		; GET READY TO INSERT
	ld	hl,(txtunf)	; BUT FIRT CHECK IF
	pop	af		; THE LENGTH OF NEW LINE
	push	hl		; IS 3 (LINE # AND CR)
	cp	3		; THEN DO NOT INSERT
	jr	z,rstart	; MUST CLEAR THE STACK
	add	a,l		; COMPUTE NEW TXTUNF
	ld	l,a
	ld	a,0
	adc	a,h
	ld	h,a		; HL->NEW UNFILLED AREA
st4a	equ	$+2
	ld	de,txtend	; CHECK TO SEE IF THERE
	cal	comp		; IS ENOUGH SPACE
	jp	nc,qsorry	; SORRY, NO ROOM FOR IT
	ld	(txtunf),hl	; OK, UPDATE TXTUNF
	pop	de		; DE->OLD UNFILLED AREA
	call	mvdown
	pop	de		; DE->BEGIN, HL->END
	pop	hl
	call	mvup		; MOVE NEW LINE TO SAVE
	jr	st3		; AREA
;*
;**************************************************************
;*
;* *** TABLES *** DIRECT *** & EXEC ***
;*
;* THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE.
;* WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION
;* OF CODE ACCORDING TO THE TABLE.
;*
;* AT 'EXEC', DE SHOULD POINT TO THE STRING AD HL SHOULD POINT
;* TO THE TABLE-1.  AT 'DIRECT', DE SHOULD POINT TO THE STRING,
;* HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF
;* ALL DIRECT AND STATEMENT COMMANDS.
;*
;* A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL
;* MATCH WILL BE CONSIDERED AS A MATCH.  E.G., 'P.', 'PR.',
;* 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'.
;*
;* THE TABLE CONSISTS OF ANY NUMBER OF ITEMS.  EACH ITEM
;* IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND
;* A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH
;* BYTE SET TO 1.
;*
;* END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY.  IFF THE
;* STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
;* MATCH THIS NULL ITEM AS DEFAULT.
;*
tab1:				; DIRECT COMMANDS
	db	'LIST'
	dwa	list
	db	'RUN'
	dwa	run
	db	'NEW'
	dwa	new
	db	'LOAD'
	dwa	dload
	db	'SAVE'
	dwa	dsave
	db	'BYE'
	dwa	os		; GO BACK TO CPM
tab2:				; DIRECT/TATEMENT
	db	'NEXT'
	dwa	next
	db	'LET'
	dwa	let
	db	'OUT'
	dwa	outcmd
	db	'POKE'
	dwa	poke
	db	'WAIT'
	dwa	waitcm
	db	'IF'
	dwa	iff
	db	'GOTO'
	dwa	goto
	db	'GOSUB'
	dwa	gosub
	db	'RETURN'
	dwa	return
	db	'REM'
	dwa	rem
	db	'FOR'
	dwa	for
	db	'INPUT'
	dwa	input
	db	'PRINT'
	dwa	print
	db	'STOP'
	dwa	stop
	dwa	deflt
	db	'YOU CAN ADD MORE' ; COMMANDS BUT
				; REMEMBER TO MOVE DEFAULT DOWN.
tab4	equ	$		; FUNCTIONS
	db	'RND'
	dwa	rnd
	db	'INP'
	dwa	inp
	db	'PEEK'
	dwa	peek
	db	'USR'
	dwa	usr
	db	'ABS'
	dwa	abs
	db	'SIZE'
	dwa	size
	dwa	xp40
	db	'YOU CAN ADD MORE' ; FUNCTIONS BUT REMEMBER
				; TO MOVE XP40 DOWN
tab5:				; "TO" IN "FOR"
	db	'TO'
	dwa	fr1
	dwa	qwhat
tab6:				; "STEP" IN "FOR"
	db	'STEP'
	dwa	fr2
	dwa	fr3
tab8:				; RELATION OPERATORS
	db	'>='
	dwa	xp11
	db	'#'
	dwa	xp12
	db	'>'
	dwa	xp13
	db	'='
	dwa	xp15
	db	'<='
	dwa	xp14
	db	'<'
	dwa	xp16
	dwa	xp17
;*
direct:
	ld	hl,tab1-1	; *** DIRECT ***
;*
exec:				; *** EXEC ***
	cal	ignblk		; IGNORE LEADING BLANKS
	push	de		; SAVE POINTER
ex1:
	ld	a,(de)		; IFF FOUND '.' IN STRING
	inc	de		; BEFORE ANY MISMATCH
	cp	'.'		; WE DECLARE A MATCH
	jr	z,ex3
	inc	hl		; HL->TABLE
	cp	(hl)		; IFF MATCH, TEST NEXT
	jr	z,ex1
	ld	a,NOMSB		; ELSE, SEE IFF BIT 7
	dec	de		; OF TABLE IS SET, WHICH
	cp	(hl)		; IS THE JUMP ADDR. (HI)
	jr	c,ex5		; C:YES, MATCHED
ex2:
	inc	hl		; NC:NO, FIND JUMP ADDR.
	cp	(hl)
	jp	nc,ex2
	inc	hl		; BUMP TO NEXT TAB. ITEM
	pop	de		; RESTORE STRING POINTER
	jr	exec		; TEST AGAINST NEXT ITEM
ex3:
	ld	a,NOMSB		; PARTIAL MATCH, FIND
ex4:
	inc	hl		; JUMP ADDR., WHICH IS
	cp	(hl)		; FLAGGED BY BIT 7
	jr	nc,ex4
ex5:
	ld	a,(hl)		; LOAD HL WITH THE JUMP
	inc	hl		; ADDRESS FROM THE TABLE
	ld	l,(hl)
	and	NOMSB		; MASK OFF BIT 7
	ld	h,a
	pop	af		; CLEAN UP THE GABAGE
	jp	(hl)		; AND WE GO DO IT
;*
;**************************************************************
;*
;* WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT
;* COMMANDS.  CONTROL IS TRANSFERED TO THESE POINTS VIA THE
;* COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST
;* SECTION.  AFTER THE COMMAND IS EXECUTED, CONTROL IS
;* TANSFERED TO OTHER SECTIONS AS FOLLOWS:
;*
;* FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART'
;* FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IFF ANY; ELSE
;* GO BACK TO 'RSTART'.
;* FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.
;* FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.
;* FOR ALL OTHERS: IFF 'CURRNT' -> 0, GO TO 'RSTART', ELSE
;* GO EXECUTE NEXT COMMAND.  (THIS IS DONE IN 'FINISH'.)
;*
;**************************************************************
;*
;* *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO ***
;*
;* 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'
;*
;* 'STOP(CR)' GOES BACK TO 'RSTART'
;*
;* 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN
;* 'CURRNT'), AND START EXECUTE IT.  NOTE THAT ONLY THOSE
;* COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.
;*
;* THERE ARE 3 MORE ENTRIES IN 'RUN':
;* 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT.
;* 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.
;* 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.
;*
;* 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET
;* LINE, AND JUMP TO 'RUNTSL' TO DO IT.
;* 'DLOAD' LOADS A NAMED PROGRAM FROM DISK.
;* 'DSAVE' SAVES A NAMED PROGRAM ON DISK.
;* 'FCBSET' SETS UP THE FILE CONTROL BLOCK FOR SUBSEQUENT DISK I/O.
;*
new:
	call	endchk		; *** NEW(CR) ***
	ld	hl,txtbgn
	ld	(txtunf),hl
;*
stop:
	call	endchk		; *** STOP(CR) ***
	jp	rstart
;*
run:
	call	endchk		; *** RUN(CR) ***
	ld	de,txtbgn	; FIRST SAVED LINE
;*
runnxl:
	ld	hl,0		; *** RUNNXL ***
	call	fndlnp		; FIND WHATEVER LINE #
	jp	c,rstart	; C:PASSED TXTUNF, QUIT
;*
runtsl:
				; *** RUNTSL ***
	ld	(currnt),de	; SET 'CURRNT'->LINE #
	inc	de		; BUMP PASS LINE #
	inc	de
;*
runsml:
	call	chkio		; *** RUNSML ***
	ld	hl,tab2-1	; FIND COMMAND IN TAB2
	jp	exec		; AND EXECUTE IT
;*
goto:
	cal	expr		; *** GOTO EXPR ***
	push	de		; SAVE FOR ERROR ROUTINE
	call	endchk		; MUST FIND A 0DH
	call	fndln		; FIND THE TARGET LINE
	jp	nz,ahow		; NO SUCH LINE #
	pop	af		; CLEAR THE "PUSH DE"
	jr	runtsl		; GO DO IT
;*
dload:
	cal	ignblk		; IGNORE BLANKS
	push	hl		; SAVE H
	call	fcbset		; SET UP FILE CONTROL BLOCK
	push	de		; SAVE THE REST
	push	bc
	ld	de,fcb		; GET FCB ADDRESS
	ld	c,open		; PREPARE TO OPEN FILE
	call	cpm		; OPEN IT
	cp	OSerr		; IS IT THERE?
	jp	z,qhow		; NO, SEND ERROR
	ld	de,txtunf	; GET BEGINNING
load:
	push	de		; SAVE DMA ADDRESS
	ld	c,setdma	;
	call	cpm		; SET DMA ADDRESS
	ld	c,readd		;
	ld	de,fcb
	call	cpm		; READ SECTOR
	cp	_EOF		; DONE?
	jr	c,rdmore	; NO, READ MORE
	jp	nz,qhow		; BAD READ
	ld	c,close
	ld	de,fcb
	call	cpm		; CLOSE FILE
	pop	de		; THROW AWAY DMA ADD.
	pop	bc		; GET OLD REGISTERS BACK
	pop	de
	pop	hl
	cal	finish		; FINISH
rdmore:
	pop	de		; GET DMA ADDRESS
	ld	hl,reclng	; GET 128
	add	hl,de		; ADD 128 TO DMA ADD.
	ex	de,hl		; PUT IT BACK IN D
	jp	load		; AND READ SOME MORE
;*
dsave:
	cal	ignblk		; IGNORE BLANKS
	push	hl		; SAVE H
	call	fcbset		; SETUP FCB
	push	de
	push	bc		; SAVE OTHERS
	ld	de,fcb
	ld	c,delete
	call	cpm		; ERASE FILE IF IT EXISTS
	ld	de,fcb
	ld	c,make
	call	cpm		; MAKE A NEW ONE
	cp	OSerr		; IS THERE SPACE?
	jp	z,qhow		; NO, ERROR
	ld	de,txtunf	; GET BEGINNING
save:
	push	de		; SAVE DMA ADDRESS
	ld	c,setdma	;
	call	cpm		; SET DMA ADDRESS
	ld	c,writed
	ld	de,fcb
	call	cpm		; WRITE SECTOR
	or	a		; SET FLAGS
	jp	nz,qhow		; IF NOT ZERO, ERROR
	pop	de		; GET DMA ADD. BACK
	ld	a,(txtunf+1)	; AND MSB OF LAST ADD.
	cp	d		; IS D SMALLER?
	jr	c,savdon	; YES, DONE
	jr	nz,writmor	; DONT TEST E IF NOT EQUAL
	ld	a,(txtunf)	; IS E SMALLER?
	cp	e
	jr	c,savdon	; YES, DONE
writmor:
	ld	hl,reclng
	add	hl,de		; ADD 128 TO DMA ADD.
	ex	de,hl		; GET IT BACK IN D
	jr	save		; WRITE SOME MORE
savdon:
	ld	c,close
	ld	de,fcb
	call	cpm		; CLOSE FILE
	pop	bc		; GET REGISTERS BACK
	pop	de
	pop	hl
	cal	finish		; FINISH
;*
fcbset:
	push	de		; Save text pointer
	ld	de,fcb		; GET FILE CONTROL BLOCK ADDRESS
	ld	hl,$fcb
	ld	bc,fcblen
	ldir			; Init FCB
	pop	de
	ld	hl,fcb+fdrv	; GET FILENAME START
fn:
	ld	a,(de)		; GET CHARACTER
	cp	cr		; IS IT A 'CR'
	jr	z,fnex		; YES, DONE
	cp	' '+1		; LEGAL CHARACTER?
	jp	c,qwhat		; NO, SEND ERROR
	cp	'Z'+1		; AGAIN
	jp	nc,qwhat	; DITTO
	ld	(hl),a		; SAVE IT IN FCB
	inc	hl		; NEXT
	inc	de
	ld	a,LOW (fcb+fdrv+fnam)
	cp	l		; LAST?
	jr	nz,fn		; NO, CONTINUE
				; TRUNCATE AT 8 CHARACTERS
fnex:
	xor	a		; CLEAR A
	ld	(fcb+_CR),a	; START AT RECORD 0
	ret
;
$fcb:
	db	0,'        TBI',0,0,0,0
fcblen	equ	$-$fcb
;*
;*************************************************************
;*
;* *** LIST *** & PRINT ***
;*
;* LIST HAS TWO FORMS:
;* 'LIST(CR)' LISTS ALL SAVED LINES
;* 'LIST #(CR)' START LIST AT THIS LINE #
;* YOU CAN STOP THE LISTING BY CONTROL C KEY
;*
;* PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)'
;* WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK-
;* ARROWS, AND STRINGS.  THESE ITEMS ARE SEPERATED BY COMMAS.
;*
;* A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER.  IT CONTROLSs
;* THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO
;* BE PRINTED.  IT STAYS EFFECTIVE FOR THE REST OF THE PRINT
;* COMMAND UNLESS CHANGED BY ANOTHER FORMAT.  IFF NO FORMAT IS
;* SPECIFIED, 6 POSITIONS WILL BE USED.
;*
;* A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF
;* DOUBLE QUOTES.
;*
;* A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF)
;*
;* A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN
;* PRINTED OR IFF THE LIST IS A NULL LIST.  HOWEVER IFF THE LIST
;* ENDED WITH A COMMA, NO (CRL) IS GENERATED.
;*
list:
	call	tstnum		; TEST IFF THERE IS A #
	call	endchk		; IFF NO # WE GET A 0
	call	fndln		; FIND THIS OR NEXT LINE
ls1:
	jp	c,rstart	; C:PASSED TXTUNF
	call	prtln		; PRINT THE LINE
	call	chkio		; STOP IFF HIT CONTROL-C
	call	fndlnp		; FIND NEXT LINE
	jr	ls1		; AND LOOP BACK
;*
print:
	ld	c,6		; C = # OF SPACES
	cal	tstc		; IFF NULL LIST & ";"
	db	';'
	jf	pr2
	call	crlf		; GIVE CR-LF AND
	jp	runsml		; CONTINUE SAME LINE
pr2:
	cal	tstc		; IFF NULL LIST (CR)
	db	cr
	jf	pr0
	call	crlf		; ALSO GIVE CR-LF AND
	jp	runnxl		; GO TO NEXT LINE
pr0:
	cal	tstc		; ELSE IS IT FORMAT?
	db	'#'
	jf	pr1
	cal	expr		; YES, EVALUATE EXPR.
	ld	c,l		; AND SAVE IT IN C
	jr	pr3		; LOOK FOR MORE TO PRINT
pr1:
	call	qtstg		; OR IS IT A STRING?
	  jp	pr8		; IFF NOT, MUST BE EXPR.
pr3:
	cal	tstc		; IFF ",", GO FIND NEXT
	db	','
	jf	pr6
	call	fin		; IN THE LIST.
	jr	pr0		; LIST CONTINUES
pr6:
	call	crlf		; LIST ENDS
	cal	finish
pr8:
	cal	expr		; EVALUATE THE EXPR
	push	bc
	call	prtnum		; PRINT THE VALUE
	pop	bc
	jr	pr3		; MORE TO PRINT?
;*
;**************************************************************
;*
;* *** GOSUB *** & RETURN ***
;*
;* 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO'
;* COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER
;* ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE
;* SUBROUTINE 'RETURN'.  IN ORDER THAT 'GOSUB' CAN BE NESTED
;* (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.
;* THE STACK POINTER IS SAVED IN 'STKGOS'. THE OLD 'STKGOS' IS
;* SAVED IN THE STACK.  IFF WE ARE IN THE MAIN ROUTINE, 'STKGOS'
;* IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),
;* BUT WE STILL SAVE IT AS A FLAG FORr NO FURTHER 'RETURN'S.
;*
;* 'RETURN(CR)' UNDOS EVERYHING THAT 'GOSUB' DID, AND THUS
;* RETURN THE EXCUTION TO THE COMMAND AFTER THE MOST RECENT
;* 'GOSUB'.  IFF 'STKGOS' IS ZERO, IT INDICATES THAT WE
;* NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.
;*
gosub:
	call	pusha		; SAVE THE CURRENT "FOR"
	cal	expr		; PARAMETERS
	push	de		; AND TEXT POINTER
	call	fndln		; FIND THE TARGET LINE
	jp	nz,ahow		; NOT THERE. SAY "HOW?"
	ld	hl,(currnt)	; FOUND IT, SAVE OLD
	push	hl		; 'CURRNT' OLD 'STKGOS'
	ld	hl,(stkgos)
	push	hl
	ld	hl,0		; AND LOAD NEW ONES
	ld	(lopvar),hl
	add	hl,sp
	ld	(stkgos),hl
	jp	runtsl		; THEN RUN THAT LINE
return:
	call	endchk		; THERE MUST BE A 0DH
	ld	hl,(stkgos)	; OLD STACK POINTER
	ld	a,h		; 0 MEANS NOT EXIST
	or	l
	jp	z,qwhat		; SO, WE SAY: "WHAT?"
	ld	sp,hl		; ELSE, RESTORE IT
	pop	hl
	ld	(stkgos),hl	; AND THE OLD 'STKGOS'
	pop	hl
	ld	(currnt),hl	; AND THE OLD 'CURRNT'
	pop	de		; OLD TEXT POINTER
	call	popa		; OLD "FOR" PARAMETERS
	cal	finish		; AND WE ARE BACK HOME
;*
;**************************************************************
;*
;* *** FOR *** & NEXT ***
;*
;* 'FOR' HAS TWO FORMS:
;* 'FOR VAR=EXP1 TO EXP2 STEP EXP1' AND 'FOR VAR=EXP1 TO EXP2'
;* THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
;* EXP1=1.  (I.E., WITH A STEP OF +1.)
;* TBI WILL FIND THE VARIABLE VAR. AND SET ITS VALUE TO THE
;* CURRENT VALUE OF EXP1.  IT ALSO EVALUATES EXPR2 AND EXP1
;* AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTERr ETC. IN
;* THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',
;* 'LOPLMT', 'LOPLN', AND 'LOPPT'.  IFF THERE IS ALREADY SOME-
;* THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO
;* 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
;* BEFORE THE NEW ONE OVERWRITES IT.
;* TBI WILL THEN DIG IN THE STACK AND FIND OUT IFF THIS SAME
;* VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.
;* IFF THAT IS THE CASE THEN THE OLD 'FOR' LOOP IS DEACTIVATED.
;* (PURGED FROM THE STACK..)
;*
;* 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
;* END OF THE 'FOR' LOOP.  THE CONTROL VARIABLE VAR. IS CHECKED
;* WITH THE 'LOPVAR'.  IFF THEY ARE NOT THE SAME, TBI DIGS IN
;* THE STACK TO FIND THE RIGHTt ONE AND PURGES ALL THOSE THAT
;* DID NOT MATCH.  EITHER WAY, TBI THEN ADDS THE 'STEP' TO
;* THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT.  IFF IT
;* IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
;* FOLLOWING THE 'FOR'.  IFF OUTSIDE THE LIMIT, THE SAVE ARER
;* IS PURGED AND EXECUTION CONTINUES.
;*
for:
	call	pusha		; SAVE THE OLD SAVE AREA
	call	setval		; SET THE CONTROL VAR.
	dec	hl		; HL IS ITS ADDRESS
	ld	(lopvar),hl	; SAVE THAT
	ld	hl,tab5-1	; USE 'EXEC' TO LOOK
	jp	exec		; FOR THE WORD 'TO'
fr1:
	cal	expr		; EVALUATE THE LIMIT
	ld	(loplmt),hl	; SAVE THAT
	ld	hl,tab6-1	; USE 'EXEC' TO LOOK
	jp	exec		; FOR THE WORD 'STEP'
fr2:
	cal	expr		; FOUND IT, GET STEP
	jp	fr4
fr3:
	ld	hl,1		; NOT FOUND, SET TO 1
fr4:
	ld	(lopinc),hl	; SAVE THAT TOO
fr5:
	ld	hl,(currnt)	; SAVE CURRENT LINE #
	ld	(lopln),hl
	ex	de,hl		; AND TEXT POINTER
	ld	(loppt),hl
	ld	bc,10		; DIG INTO STACK TO
	ld	hl,(lopvar)	; FIND 'LOPVAR'
	ex	de,hl
	ld	h,b
	ld	l,b		; HL=0 NOW
	add	hl,sp		; HERE IS THE STACK
	_ldai
fr7:
	add	hl,bc		; EACH LEVEL IS 10 DEEP
	ld	a,(hl)		; GET THAT OLD 'LOPVAR'
	inc	hl
	or	(hl)
	jr	z,fr8		; 0 SAYS NO MORE IN IT
	ld	a,(hl)
	dec	hl
	cp	d		; SAME AS THIS ONE?
	jr	nz,fr7
	ld	a,(hl)		; THE OTHER HALF?
	cp	e
	jr	nz,fr7
	ex	de,hl		; YES, FOUND ONE
	ld	hl,0
	add	hl,sp		; TRY TO MOVE SP
	ld	b,h
	ld	c,l
	ld	hl,10
	add	hl,de
	call	mvdown		; AND PURGE 10 WORDS
	ld	sp,hl		; IN THE STACK
fr8:
	ld	hl,(loppt)	; JOB DONE, RESTORE DE
	ex	de,hl
	cal	finish		; AND CONTINUE
;*
next:
	cal	tstv		; GET ADDRESS OF VAR.
	jp	c,qwhat		; NO VARIABLE, "WHAT?"
	ld	(varnxt),hl	; YES, SAVE IT
nx0:
	push	de		; SAVE TEXT POINTER
	ex	de,hl
	ld	hl,(lopvar)	; GET VAR. IN 'FOR'
	ld	a,h
	or	l		; 0 SAYS NEVER HAD ONE
	jp	z,awhat		; SO WE ASK: "WHAT?"
	cal	comp		; ELSE WE CHECK THEM
	jr	z,nx3		; OK, THEY AGREE
	pop	de		; NO, LET'S SEE
	call	popa		; PURGE CURRENT LOOP
	ld	hl,(varnxt)	; AND POP ONE LEVEL
	jr	nx0		; GO CHECK AGAIN
nx3:
	ld	e,(hl)		; COME HERE WHEN AGREED
	inc	hl
	ld	d,(hl)		; DE=VALUE OF VAR.
	ld	hl,(lopinc)
	push	hl
	add	hl,de		; ADD ONE STEP
	ex	de,hl
	ld	hl,(lopvar)	; PUT IT BACK
	ld	(hl),e
	inc	hl
	ld	(hl),d
	ld	hl,(loplmt)	; HL->LIMIT
	pop	af		; OLD HL
	or	a
	jp	p,nx1		; STEP > 0
	ex	de,hl
nx1:
	call	ckhlde		; COMPARE WITH LIMIT
	pop	de		; RESTORE TEXT POINTER
	jr	c,nx2		; OUTSIDE LIMIT
	ld	hl,(lopln)	; WITHIN LIMIT, GO
	ld	(currnt),hl	; BACK TO THE SAVED
	ld	hl,(loppt)	; 'CURRNT' AND TEXT
	ex	de,hl		; POINTER
	cal	finish
nx2:
	call	popa		; PURGE THIS LOOP
	cal	finish
;*
;**************************************************************
;*
;* *** REM *** IFF *** INPUT *** & LET (& DEFLT) ***
;*
;* 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI.
;* TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION.
;*
;* 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE
;* COMMANDS (INCLUDING OUTHER 'IF'S) SEPERATED BY SEMI-COLONS.
;* NOTE THAT THE WORD 'THEN' IS NOT USED.  TBI EVALUATES THE
;* EXPR. IFF IT IS NON-ZERO, EXECUTION CONTINUES.  IFF THE
;* EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
;* EXECUTION CONTINUES AT THE NEXT LINE.
;*
;* 'IPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED
;* BY A LIST OF ITEMS.  IFF THE ITEM IS A STRING IN SINGLE OR
;* DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
;* IN 'PRINT'.  IFF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS
;* PRINTED OUT FOLLOWED BY A COLON.  THEN TBI WAITS FOR AN
;* EXPR. TO BE TYPED IN.  THE VARIABLE ISs THEN SET TO THE
;* VALUE OF THIS EXPR.  IFF THE VARIABLE IS PROCEDED BY A STRING
;* (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
;* PRINTED FOLLOWED BY A COLON.  TBI THEN WAITS FOR INPUT EXPR.
;* AND SET THE VARIABLE TO THE VALUE OF THE EXPR.
;*
;* IFF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?",
;* "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
;* THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.
;* THIS IS HANDLED IN 'INPERR'.
;*
;* 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS.
;* EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR.
;* TBI EVALUATES THE EXPR. AND SET THE VARIBLE TO THAT VALUE.
;* TB WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.
;* THIS IS DONE BY 'DEFLT'.
;*
rem:
	ld	hl,0		; *** REM ***
	_ldai
;*
iff:
	cal	expr		; *** IFF ***
	ld	a,h		; IS THE EXPR.=0?
	or	l
	jp	nz,runsml	; NO, CONTINUE
	call	fndskp		; YES, SKIP REST OF LINE
	jp	nc,runtsl
	jp	rstart
;*
inperr:
	ld	hl,(stkinp)	; *** INPERR ***
	ld	sp,hl		; RESTORE OLD SP
	pop	hl		; AND OLD 'CURRNT'
	ld	(currnt),hl
	pop	de		; AND OLD TEXT POINTER
	pop	de		; REDO INPUT
;*
input:				; *** INPUT ***
	push	de		; SAVE IN CASE OF ERROR
	call	qtstg		; IS NEXT ITEM A STRING?
	  jp	ip2		; NO
	cal	tstv		; YES. BUT FOLLOWED BY A
	jr	c,ip4		; VARIABLE?   NO.
	jr	ip3		; YES.  INPUT VARIABLE
ip2:
	push	de		; SAVE FOR 'PRTSTG'
	cal	tstv		; MUST BE VARIABLE NOW
	jp	c,qwhat		; "WHAT?" IT IS NOT?
	ld	a,(de)		; GET READY FOR 'RTSTG'
	ld	c,a
	sub	a
	ld	(de),a
	pop	de
	call	prtstg		; PRINT STRING AS PROMPT
	ld	a,c		; RESTORE TEXT
	dec	de
	ld	(de),a
ip3:
	push	de		; SAVE IN CASE OF ERROR
	ex	de,hl
	ld	hl,(currnt)	; ALSO SAVE 'CURRNT'
	push	hl
	ld	hl,input	; A NEGATIVE NUMBER
	ld	(currnt),hl	; AS A FLAG
	ld	hl,0		; SAVE SP TOO
	add	hl,sp
	ld	(stkinp),hl
	push	de		; OLD HL
	ld	a,':'		; PRINT THIS TOO
	call	getln		; AND GET A LINE
ip3a	equ	$+2
	ld	de,buffer	; POINTS TO BUFFER
	cal	expr		; EVALUATE INPUT
	nop			; CAN BE 'CALL ENDCHK'
	nop
	nop
	pop	de		; OK, GET OLD HL
	ex	de,hl
	ld	(hl),e		; SAVE VALUE IN VAR.
	inc	hl
	ld	(hl),d
	pop	hl		; GET OLD 'CURRNT'
	ld	(currnt),hl
	pop	de		; AND OLD TEXT POINTER
ip4:
	pop	af		; PURGE JUNK IN STACK
	cal	tstc		; IS NEXT CH. ','?
	db	','
	jf	ip5
	jp	input		; YES, MORE ITEMS.
ip5:
	cal	finish
;*
deflt:	ld	a,(de)		; *** DEFLT ***
	cp	cr		; EMPTY LINE IS OK
	jr	z,lt1		; ELSE IT IS 'LET'
;*
let:
	call	setval		; *** LET ***
	cal	tstc		; SET VALUE TO VAR.
	db	','
	jf	lt1
	jp	let		; ITEM BY ITEM
lt1:
	cal	finish		; UNTIL FINISH
;*
;**************************************************************
;*
;* *** EXPR ***
;*
;* 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
;* <EXPR>::=<EXPR2>
;*          <EXPR2><REL.OP.><EXPR2>
;* WHERE <REL.OP.> IS ONE OF THE OPERATORSs IN TAB8 AND THE
;* RESULT OF THESE OPERATIONS IS 1 IFF TRUE AND 0 IFF FALSE.
;* <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....)
;* WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
;* <EXPR3>::=<EXPR4>(<* OR /><EXPR4>)(....)
;* <EXPR4>::=<VARIABLE>
;*           <FUNCTION>
;*           (<EXPR>)
;* <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR>
;* AS INDEX, FNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
;* <EXPR4> CAN BE AN <EXPR> IN PARANTHESE.
;*
xp11:
	call	xp18		; REL.OP.">="
	ret	c		; NO, RETURN HL=0
	ld	l,a		; YES, RETURN HL=1
	ret
xp12:
	call	xp18		; REL.OP."#"
	ret	z		; FALSE, RETURN HL=0
	ld	l,a		; TRUE, RETURN HL=1
	ret
xp13:
	call	xp18		; REL.OP.">"
	ret	z		; FALSE
	ret	c		; ALSO FALSE, HL=0
	ld	l,a		; TRUE, HL=1
	ret
xp14:
	call	xp18		; REL.OP."<="
	ld	l,a		; SET HL=1
	ret	z		; REL. TRUE, RETURN
	ret	c
	ld	l,h		; ELSE SET HL=0
	ret
xp15:
	call	xp18		; REL.OP."="
	ret	nz		; FALSE, RETRUN HL=0
	ld	l,a		; ELSE SET HL=1
	ret
xp16:
	call	xp18		; REL.OP."<"
	ret	nc		; FALSE, RETURN HL=0
	ld	l,a		; ELSE SET HL=1
	ret
xp17:
	pop	hl		; NOT REL.OP.
	ret			; RETURN HL=<EXPR2>
xp18:
	ld	a,c		; SUBROUTINE FOR ALL
	pop	hl		; REL.OP.'S
	pop	bc
	push	hl		; REVERSE TOP OF STACK
	push	bc
	ld	c,a
	call	expr2		; GET 2ND <EXPR2>
	ex	de,hl		; VALUE IN DE NOW
	ex	(sp),hl		; 1ST <EXPR2> IN HL
	call	ckhlde		; COMPARE 1ST WITH 2ND
	pop	de		; RESTORE TEXT POINTER
	ld	hl,0		; SET HL=0, A=1
	ld	a,1
	ret
;*
expr2:
	cal	tstc		; NEGATIVE SIGN?
	db	'-'
	jf	xp21
	ld	hl,0		; YES, FAKE '0-'
	jr	xp26		; TREAT LIKE SUBTRACT
xp21:
	cal	tstc		; POSITIVE SIGN?  IGNORE
	db	'+'
	jf	xp22
xp22:
	call	expr3		; 1ST <EXPR3>
xp23:
	cal	tstc		; ADD?
	db	'+'
	jf	xp25
	push	hl		; YES, SAVE VALUE
	call	expr3		; GET 2ND<EXPR3>
xp24:
	ex	de,hl		; 2ND IN DE
	ex	(sp),hl		; 1ST IN HL
	ld	a,h		; COMPARE SIGN
	xor	d
	ld	a,d
	add	hl,de
	pop	de		; RESTORE TEXT POINTER
	jp	m,xp23		; 1ST 2ND SIGN DIFFER
	xor	h		; 1ST 2ND SIGN EQUAL
	jp	p,xp23		; SO ISp RESULT
	jp	qhow		; ELSE WE HAVE OVERFLOW
xp25:
	cal	tstc		; SUBTRACT?
	db	'-'
	jf	xp42
xp26:
	push	hl		; YES, SAVE 1ST <EXPR3>
	call	expr3		; GET 2ND <EXPR3>
	call	chgsgn		; NEGATE
	jr	xp24		; AND ADD THEM
;*
expr3:
	call	expr4		; GET 1ST <EXPR4>
xp31:
	cal	tstc		; MULTIPLY?
	db	'*'
	jf	xp34
	push	hl		; YES, SAVE 1ST
	call	expr4		; AND GET 2ND <EXPR4>
	ld	b,0		; CLEAR B FOR SIGN
	call	chksgn		; CHECK SIGN
	ex	de,hl		; 2ND IN DE NOW
	ex	(sp),hl		; 1ST IN HL
	call	chksgn		; CHECK SIGN OF 1ST
	ld	a,h		; IS HL > 255 ?
	or	a
	jr	z,xp32		; NO
	ld	a,d		; YES, HOW ABOUT DE
	or	d
	ex	de,hl		; PUT SMALLER IN HL
	jp	nz,ahow		; ALSO >, WILL OVERFLOW
xp32:
	ld	a,l		; THIS IS DUMB
	ld	hl,0		; CLEAR RESULT
	or	a		; ADD AND COUNT
	jp	z,xp35
xp33:
	add	hl,de
	jp	c,ahow		; OVERFLOW
	dec	a
	jr	nz,xp33
	jr	xp35		; FINISHED
xp34:
	cal	tstc		; DIVIDE?
	db	'/'
	jf	xp42
	push	hl		; YES, SAVE 1ST <EXPR4>
	call	expr4		; AND GET 2ND ONE
	ld	b,0		; CLEAR B FOR SIGN
	call	chksgn		; CHECK SIGN OF 2ND
	ex	de,hl		; PUT 2ND IN DE
	ex	(sp),hl		; GET 1ST IN HL
	call	chksgn		; CHECK SIGN OF 1ST
	ld	a,d		; DIVIDE BY 0?
	or	e
	jp	z,ahow		; SAY "HOW?"
	push	bc		; ELSE SAVE SIGN
	call	divide		; USE SUBROUTINE
	ld	h,b		; RESULT IN HL NOW
	ld	l,c
	pop	bc		; GET SIGN BACK
xp35:
	pop	de		; AND TEXT POINTER
	ld	a,h		; HL MUST BE +
	or	a
	jp	m,qhow		; ELSE IT IS OVERFLOW
	ld	a,b
	or	a
	call	m,chgsgn	; CHANGE SIGN IFF NEEDED
	jr	xp31		; LOOK OR MORE TERMS
;*
expr4:
	ld	hl,tab4-1	; FIND FUNCTION IN TAB4
	jp	exec		; AND GO DO IT
xp40:
	cal	tstv		; NO, NOT A FUNCTION
	jr	c,xp41		; NOR A VARIABLE
	ld	a,(hl)		; VARIABLE
	inc	hl
	ld	h,(hl)		; VALUE IN HL
	ld	l,a
	ret
xp41:
	call	tstnum		; OR IS IT A NUMBER
	ld	a,b		; # OF DIGIT
	or	a
	ret	nz		; OK
parn:
	cal	tstc		; NO DIGIT, MUST BE
	db	'('
	jf	xp43
	cal	expr		; "(EXPR)"
	cal	tstc
	db	')'
	jf	xp43
xp42:
	ret
xp43:
	jp	qwhat		; ELSE SAY: "WHAT?"
;*
rnd:
	call	parn		; *** RND(EXPR) ***
	ld	a,h		; EXPR MUST BE +
	or	a
	jp	m,qhow
	or	l		; AND NON-ZERO
	jp	z,qhow
	push	de		; SAVE BOTH
	push	hl
	ld	hl,(ranpnt)	; GET MEMORY AS RANDOM
	ld	de,lstrom	; NUMBER
	cal	comp
	jr	c,ra1		; WRAP AROUND IFF LAST
	ld	hl,start
ra1:
	ld	e,(hl)
	inc	hl
	ld	d,(hl)
	ld	(ranpnt),hl
	pop	hl
	ex	de,hl
	push	bc
	call	divide		; RND(N)=MOD(M,N)+1
	pop	bc
	pop	de
	inc	hl
	ret
;*
abs:
	call	parn		; *** ABS(EXPR) ***
	call	chksgn		; CHECK SIGN
	ld	a,h		; NOTE THAT -32768
	or	h		; CANNOT CHANGE SIGN
	jp	m,qhow		; SO SAY: "HOW?"
	ret
size:
	ld	hl,(txtunf)	; *** SIZE ***
	push	de		; GET THE NUMBER OF FREE
	ex	de,hl		; BYTES BETWEEN 'TXTUNF'
sizea	equ	$+2
	ld	hl,varbgn	; AND 'VARBGN'
	call	subde
	pop	de
	ret
;*
;*********************************************************
;*
;*   *** OUT *** INP *** WAIT *** POKE *** PEEK *** & USR
;*
;*  OUT I,J(,K,L)
;*
;*  OUTPUTS EXPRESSION 'J' TO PORT 'I', AND MAY BE REPEATED
;*  AS IN DATA 'L' TO PORT 'K' AS MANY TIMES AS NEEDED
;*  THIS COMMAND MODIFIES ;*  THIS COMMAND MODIFIES
;*  THIS COMMAND MODIFY'S A SMALL SECTION OF CODE LOCATED
;*  JUST ABOVE ADDRESS 2K
;*
;*  INP (I)
;*
;*  THIS FUNCTION RETURNS DATA READ FROM INPUT PORT 'I' AS
;*  IT'S VALUE.
;*  IT ALSO MODIFIES CODE JUST ABOVE 2K.
;*
;*  WAIT I,J,K
;*
;*  THIS COMMAND READS THE STATUS OF PORT 'I', EXCLUSIVE OR'S
;*  THE RESULT WITH 'K' IF THERE IS ONE, OR IF NOT WITH 0,
;*  AND'S WITH 'J' AND RETURNS WHEN THE RESULT IS NONZERO.
;*  ITS MODIFIED CODE IS ALSO ABOVE 2K.
;*
;*  POKE I,J(,K,L)
;*
;*  THIS COMMAND WORKS LIKE OUT EXCEPT THAT IT PUTS DATA 'J'
;*  INTO MEMORY LOCATION 'I'.
;*
;*  PEEK (I)
;*
;*  THIS FUNCTION WORKS LIKE INP EXCEPT IT GETS IT'S VALUE
;*  FROM MEMORY LOCATION 'I'.
;*
;*  USR (I(,J))
;*
;*  USR CALLS A MACHINE LANGUAGE SUBROUTINE AT LOCATION 'I'
;*  IF THE OPTIONAL PARAMETER 'J' IS USED ITS VALUE IS PASSED
;*  IN H&L.  THE VALUE OF THE FUNCTION SHOULD BE RETURNED IN H&L.
;*
;************************************************************
;*
outcmd:
	cal	expr
	ld	a,l
	ld	(outio+1),a
	cal	tstc
	db	','
	jf	iox
	cal	expr
	ld	a,l
	call	outio
	cal	tstc
	db	','
	jf	oufin
	jr	outcmd
oufin:
	cal	finish
waitcm:
	cal	expr
	ld	a,l
	ld	(waitio+1),a
	cal	tstc
	db	','
	jf	iox
	cal	expr
	push	hl
	cal	tstc
	db	','
	jf	wt0
	cal	expr
	ld	a,l
	pop	hl
	ld	h,a
	jr	wtn0
wt0:
	ld	h,0
wtn0:
	jp	waitio
inp:
	call	parn
	ld	a,l
	ld	(inpio+1),a
	ld	h,0
iox:
	jp	inpio
ioer:
	jp	qwhat
poke:
	cal	expr
	push	hl
	cal	tstc
	db	','
	jf	poer
	cal	expr
	ld	a,l
	pop	hl
	ld	(hl),a
	cal	tstc
	db	','
	jf	pofin
	jr	poke
pofin:
	cal	finish
peek:
	call	parn
	ld	l,(hl)
	ld	h,0
	ret
poer:
	jp	qwhat
usr:
	push	bc
	cal	tstc
	db	'('		; QWHAT
	jf	usrex
	cal	expr		; EXPR
	cal	tstc
	db	')'		; PASPARM
	jf	pasprm
	push	de
	ld	de,usret
	push	de
	push	hl
	ret			; CALL USR ROUTINE
pasprm:
	cal	tstc
	db	','
	jf	userr
	push	hl
	cal	expr
	cal	tstc
	db	')'
	jf	usrex
	pop	bc
	push	de
	ld	de,usret
	push	de
	push	bc
	ret			; CALL USR ROUTINE
usret:
	pop	de
	pop	bc
usrex:
	ret
userr:
	jp	qwhat
;*
;**************************************************************
;*
;* *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
;*
;* 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
;*
;* 'SUBDE' SUBTRACTS DE FROM HL
;*
;* 'CHKSGN' CHECKS SIGN OF HL.  IFF +, NO CHANGE.  IFF -, CHANGE
;* SIGN AND FLIP SIGN OF B.
;*
;* 'CHGSGN' CHNGES SIGN OF HL AND B UNCONDITIONALLY.
;*
;* 'CKHLE' CHECKS SIGN OF HL AND DE.  IFF DIFFERENT, HL AND DE
;* ARE INTERCHANGED.  IFF SAME SIGN, NOT INTERCHANGED.  EITHER
;* CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS.
;*
divide:
	push	hl		; *** DIVIDE ***
	ld	l,h		; DIVIDE H BY DE
	ld	h,0
	call	dv1
	ld	b,c		; SAVE RESULT IN B
	ld	a,l		; (REMAINDER+L)/DE
	pop	hl
	ld	h,a
dv1:
	ld	c,-1		; RESULT IN C
dv2:
	inc	c		; DUMB ROUTINE
	call	subde		; DIVIDE BY SUBTRACT
	jr	nc,dv2		; AND COUNT
	add	hl,de
	ret
;*
subde:
	or	a		; *** SUBDE ***
	sbc	hl,de		; SUBTRACT DE FROM HL
	ret
;*
chksgn:
	ld	a,h		; *** CHKSGN ***
	or	a		; CHECK SIGN OF HL
	ret	p		; IFF -, CHANGE SIGN
;*
chgsgn:
	ld	a,h		; *** CHGSGN ***
	cpl			; CHANGE SIGN OF HL
	ld	h,a
	ld	a,l
	cpl
	ld	l,a
	inc	hl
	ld	a,b		; AND ALSO FLIP B
	xor	MSB
	ld	b,a
	ret
;*
ckhlde:
	ld	a,h
	xor	d		; SAME SIGN?
	jp	p,ck1		; YES, COMPARE
	ex	de,hl		; NO, XCH AND COMP
ck1:
	cal	comp
	ret
;*
;**************************************************************
;*
;* *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) ***
;*
;* "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND
;* THEN AN EXPR.  IT EVALUATES THE EXPR. AND SET THE VARIABLE
;* TO THAT VALUE.
;*
;* "FIN" CHECKS THE END OF A COMMAND.  IFF IT ENDED WITH ";",
;* EXECUTION CONTINUES.  IFF IT ENDED WITH A CR, IT FINDS THE
;* NEXT LINE AND CONTINUE FROM THERE.
;*
;* "ENDCHK" CHECKS IFF A COMMAND IS ENDED WITH CR.  THIS IS
;* REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.)
;*
;* "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR).
;* IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?"
;* INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP
;* O THE STACK) POINTS TO.  EXECUTION OF TB IS STOPPED
;* AND TBI IS RESTARTED.  HOWEVER, IFF 'CURRNT' -> ZERO
;* (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT
;*  PRINTED.  AND IFF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT'
;* COMMAND, THE INPUT LINE IS NOT PRINTED AND EXECUTION IS
;* NOT TERMINATED BUT CONTINUED AT 'INPERR'.
;*
;* RELATED TO 'ERROR' ARE THE FOLLOWING:
;* 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?"
;* 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'.
;* 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
;* 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS
;*
setval:
	cal	tstv		; *** SETVAL ***
	jp	c,qwhat		; "WHAT?" NO VARIABLE
	push	hl		; SAVE ADDRESS OF VAR.
	cal	tstc		; PASS "=" SIGN
	db	'='
	jf	sv1
	cal	expr		; EVALUATE EXPR.
	ld	b,h		; VALUE IN BC NOW
	ld	c,l
	pop	hl		; GET ADDRESS
	ld	(hl),c		; SAVE VALUE
	inc	hl
	ld	(hl),b
	ret
sv1:
	jp	qwhat		; NO "=" SIGN
;*
fin:
	cal	tstc		; *** FIN ***
	db	';'
	jf	fi1
	pop	af		; ";", PURGE RET ADDR.
	jp	runsml		; CONTINUE SAME LINE
fi1:
	cal	tstc		; NOT ";", IS IT CR?
	db	cr
	jf	fi2
	pop	af		; YES, PURGE RET ADDR.
	jp	runnxl		; RUN NEXT LINE
fi2:
	ret			; ELSE RETURN TO CALLER
;*
endchk:
	cal	ignblk		; *** ENDCHK ***
	cp	cr		; END WITH CR?
	ret	z		; OK, ELSE SAY: "WHAT?"
;*
qwhat:
	push	de		; *** QWHAT ***
awhat:
	ld	de,what		; *** AWHAT ***
error:
	sub	a		; *** ERROR ***
	call	prtstg		; PRINT 'WHAT?', 'HOW?'
	pop	de		; OR 'SORRY'
	ld	a,(de)		; SAVE THE CHARACTER
	push	af		; AT WHERE OLD DE ->
	sub	a		; AND PUT A 0 THERE
	ld	(de),a
	ld	hl,(currnt)	; GET CURRENT LINE #
	push	hl
	ld	a,(hl)		; CHECK THE VALUE
	inc	hl
	or	(hl)
	pop	de
	jp	z,rstart	; IFF ZERO, JUST RERSTART
	ld	a,(hl)		; IFF NEGATIVE,
	or	a
	jp	m,inperr	; REDO INPUT
	call	prtln		; ELSE PRINT THE LINE
	dec	de		; UPTO WHERE THE 0 IS
	pop	af		; RESTORE THE CHARACTER
	ld	(de),a
	ld	a,'?'		; PRINTt A "?"
	cal	outc
	sub	a		; AND THE REST OF THE
	call	prtstg		; LINE
	jp	rstart
qsorry:
	push	de		; *** QSORRY ***
asorry:
	ld	de,sorry	; *** ASORRY ***
	jp	error
;*
;**************************************************************
;*
;* *** GETLN *** FNDLN (& FRIENDS) ***
;*
;* 'GETLN' READS A INPUT LINE INTO 'BUFFER'.  IT FIRST PROMPT
;* THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS THE
;* THE BUFFER AND ECHOS.  IT IGNORES LF'S AND NULLS, BUT STILL
;* ECHOS THEM BACK.  RUB-OUT IS USED TO CAUSE IT TO DELETE
;* THE LAST CHARATER (IFF THERE IS ONE), AND ALT-MOD IS USED TO
;* CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER.
;* 0DHSIGNALS THE END OF A LINE, AND CAUE 'GETLN' TO RETURN.
;*
;* 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE
;* TEXT SAVE AREA.  DE IS USED AS THE TEXT POINTER.  IFF THE
;* LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE
;* (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z.
;* IFF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE #
;* IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ.  IFF
;* WE REACHED THE END OF TEXT SAVE ARE AND CANNOT FIND THE
;* LINE, FLAGS ARE C & NZ.
;* 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE
;* AREA TO START THE SEARCH.  SOME OTHER ENTRIES OF THIS
;* ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.
;* 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #.
;* 'FNDNXT' WILL BUMP DE BY 2, FIND A 0DHAND THEN START SEARCH.
;* 'FNDSKP' USE DE TO FIND A CR, AND THEN STRART SEARCH.
;*
getln:
	cal	outc		; *** GETLN ***
getlna	equ	$+2
	ld	de,buffer	; PROMPT AND INIT
gl1:
	call	chkio		; CHECK KEYBOARD
	jr	z,gl1		; NO INPUT, WAIT
	cp	DEL		; DELETE LST CHARACTER?
	jr	z,gl3		; YES
	cp	bs		; DELETE LST CHARACTER?
	jr	z,gl3		; YES
	cp	lf		; IGNORE LF
	jr	z,gl1
	or	a		; IGNORE NULL
	jr	z,gl1
	cp	DELLIN 		; DELETE THE WHOLE LINE?
	jr	z,gl4		; YES
	ld	(de),a		; ELSE, SAVE INPUT
	inc	de		; AND BUMP POINTER
	cp	cr		; WAS IT CR?
	jr	nz,gl2		; NO
	ld	a,lf		; YES, GET LINE FEED
	cal	outc		; CALL OUTC AND LINE FEED
	ret			; WE'VE GOT A LINE
gl2:
	ld	a,e		; MORE FREE ROOM?
	cp	LOW bufend
	jr	nz,gl1		; YES, GET NEXT INPUT
gl3:
	ld	a,e		; DELETE LAST CHARACTER
	cp	LOW buffer	; BUT DO WE HAVE ANY?
	jr	z,gl4		; NO, REDO WHOLE LINE
	dec	de		; YES, BACKUP POINTER
	call	bsout		; AND ECHO A BACK-SPACE
	jr	gl1		; GO GET NEXT INPUT
gl4:
	call	crlf		; REDO ENTIRE LINE
	ld	a,'^'		; CR, LF AND UP-ARROW
	jr	getln
;
bsout:
	ld	a,' '		; AND ECHO A BACK-SPACE
	cal	outc
	ld	a,bs
	cal	outc
	ret
;*
fndln:
	ld	a,h		; *** FNDLN ***
	or	a		; CHECK SIGN OF HL
	jp	m,qhow		; IT CANNT BE -
	ld	de,txtbgn	; INIT. TEXT POINTER
;*
fndlnp:				; *** FNDLNP ***
	push	hl		; SAVE LINE #
	ld	hl,(txtunf)	; CHECK IFF WE PASSED END
	dec	hl
	cal	comp
	pop	hl		; GET LINE # BACK
	ret	c		; C,NZ PASSED END
	ld	a,(de)		; WE DID NOT, GET BYTE 1
	sub	l		; IS THIS THE LINE?
	ld	b,a		; COMPARE LOW ORDER
	inc	de
	ld	a,(de)		; GET BYTE 2
	sbc	a,h		; COMPARE HIGH ORDER
	jr	c,fl2		; NO, NOT THERE YET
	dec	de		; ELSE WE EITHER FOUND
	or	b		; IT, OR IT IS NOT THERE
	ret			; NC,Z:FOUND; NC,NZ:NO
;*
fndnxt:				; *** FNDNXT ***
	inc	de		; FIND NEXT LINE
fl2:
	inc	de		; JUST PASSED BYTE 1 & 2
;*
fndskp:
	ld	a,(de)		; *** FNDSKP ***
	cp	cr		; TRY TO FIND 0DH
	jr	nz,fl2		; KEEP LOOKING
	inc	de		; FOUND CR, SKIP OVER
	jr	fndlnp		; CHECK IFF END OF TEXT
;*
;*************************************************************
;*
;* *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN ***
;*
;* 'PRTSTG' PRINTS A STRING POINTED BY DE.  IT STOPS PRINTING
;* AND RETURNS TO CALLER WHEN EITHER A 0DHIS PRINTED OR WHEN
;* THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE
;* CALLER).  OLD A IS STORED IN B, OLD B IS LOST.
;*
;* 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE
;* QUOTE.  IFF NONE OF THESE, RETURN TO CALLER.  IFF BACK-ARROW,
;* OUTPUT A 0DHWITHOUT A LF.  IFF SINGLE OR DOUBLE QUOTE, PRINT
;* THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE.
;* AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED
;* OVER (USUALLY A JUMP INSTRUCTION).
;*
;* 'PRTNUM' PRINTS THE NUMBER IN HL.  LEADING BLANKS ARE ADDED
;* IFF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
;* HOWEVER, IFF THE NUMBER OF DIGITS IS LARGER THAN THE # IN
;* C, ALL DIGITS ARE PRINTED ANYWAY.  NEGATIVE SIGN IS ALSO
;* PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT.
;*
;* 'PRTLN' PRINSrA SAVED TEXT LINE WITH LINE # AND ALL.
;*
prtstg:
	ld	b,a		; *** PRTSTG ***
ps1:
	ld	a,(de)		; GET A CHARACTERr
	inc	de		; BUMP POINTER
	cp	b		; SAME AS OLD A?
	ret	z		; YES, RETURN
	cal	outc		; ELSE PRINT IT
	cp	cr		; WAS IT A CR?
	jr	nz,ps1		; NO, NEXT
	ret			; YES, RETURN
;*
qtstg:
	cal	tstc		; *** QTSTG ***
	db	'"'
	jf	qt3
	ld	a,'"'		; IT IS A "
qt1:
	call	prtstg		; PRINT UNTIL ANOTHER
	cp	cr		; WAS LAST ONE A CR?
	pop	hl		; RETURN ADDRESS
	jp	z,runnxl	; WAS CR, RUN NEXT LINE
qt2:
	inc	hl		; SKIP 3 BYTES ON RETURN
	inc	hl
	inc	hl
	jp	(hl)		; RETURN
qt3:
	cal	tstc		; IS IT A ' ?
	db	''''
	jf	qt4
	ld	a,''''		; YES, DO SAME
	jr	qt1		; AS IN "
qt4:
	cal	tstc		; IS IT BACK-ARROW?
	db	'_'
	jf	qt5
	ld	a,cr+MSB	; YES, 0DHWITHOUT LF!!
	cal	outc		; DO IT TWICE TO GIVE
	cal	outc		; TTY ENOUGH TIME
	pop	hl		; RETURN ADDRESS
	jr	qt2
qt5:
	ret			; NONE OF ABOVE
;*
prtnum:
	push	de		; *** PRTNUM ***
	ld	de,10		; DECIMAL
	push	de		; SAVE AS A FLAG
	ld	b,d		; B=SIGN
	dec	c		; C=SPACES
	call	chksgn		; CHECK SIGN
	jp	p,pn1		; NO SIGN
	ld	b,'-'		; B=SIGN
	dec	c		; '-' TAKES SPACE
pn1:
	push	bc		; SAVE SIGN & SPACE
pn2:
	call	divide		; DEVIDE HL BY 10
	ld	a,b		; RESULT 0?
	or	c
	jr	z,pn3		; YES, WE GOT ALL
	ex	(sp),hl		; NO, SAVE REMAINDER
	dec	l		; AND COUNT SPACE
	push	hl		; HL IS OLD BC
	ld	h,b		; MOVE RESULT TO BC
	ld	l,c
	jr	pn2		; AND DIVIDE BY 10
pn3:
	pop	bc		; WE GOT ALL DIGITS IN
pn4:
	dec	c		; THE STACK
	ld	a,c		; LOOK AT SPACE COUNT
	or	a
	jp	m,pn5		; NO LEADING BLANKS
	ld	a,' '		; LEADING BLANKS
	cal	outc
	jr	pn4		; MORE?
pn5:
	ld	a,b		; PRINT SIGN
	cal	outc		; MAYBE - OR NULL
	ld	e,l		; LAST REMAINDER IN E
pn6:
	ld	a,e		; CHECK DIGIT IN E
	cp	10		; 10 IS FLAG FOR NO MORE
	pop	de
	ret	z		; IFF SO, RETURN
	add	a,'0'		; ELSE CONVERT TO ASCII
	cal	outc		; AND PRINT THE DIGIT
	jr	pn6		; GO BACK FOR MORE
;*
prtln:
	ld	a,(de)		; *** PRTLN ***
	ld	l,a		; LOW ORDER LINE #
	inc	de
	ld	a,(de)		; HIGH ORDER
	ld	h,a
	inc	de
	ld	c,4		; PRINT 4 DIGIT LINE #
	call	prtnum
	ld	a,' '		; FOLLOWED BY A BLANK
	cal	outc
	sub	a		; AND THEN THE TEXT
	call	prtstg
	ret
;*
;**************************************************************
;*
;* *** MVUP *** MVDOWN *** POPA *** & PUSHA ***
;*
;* 'MVUP' MOVES A BLOCK UP FROM HERE DE-> TO WHERE BC-> UNTIL
;* DE = HL
;*
;* 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
;* UNTIL DE = BC
;*
;* 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE
;* STACK
;*
;* 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE
;* STACK
;*
mvup:
	cal	comp		; *** MVUP ***
	ret	z		; DE = HL, RETURN
	ld	a,(de)		; GET ONE BYTE
	ld	(bc),a		; MOVE IT
	inc	de		; INCREASE BOTH POINTERS
	inc	bc
	jr	mvup		; UNTIL DONE
;*
mvdown:
	ld	a,b		; *** MVDOWN ***
	sub	d		; TEST IFF DE = BC
	jr	nz,md1		; NO, GO MOVE
	ld	a,c		; MAYBE, OTHER BYTE?
	sub	e
	ret	z		; YES, RETURN
md1:
	dec	de		; ELSE MOVE A BYTE
	dec	hl		; BUT FIRST DECREASE
	ld	a,(de)		; BOTH POINTERS AND
	ld	(hl),a		; THEN DO IT
	jr	mvdown		; LOOP BACK
;*
popa:
	pop	bc		; BC = RETURN ADDR.
	pop	hl		; RESTORE LOPVAR, BUT
	ld	(lopvar),hl	; =0 MEANS NO MORE
	ld	a,h
	or	l
	jr	z,pp1		; YEP, GO RETURN
	pop	hl		; NOP, RESTORE OTHERS
	ld	(lopinc),hl
	pop	hl
	ld	(loplmt),hl
	pop	hl
	ld	(lopln),hl
	pop	hl
	ld	(loppt),hl
pp1:
	push	bc		; BC = RETURN ADDR.
	ret
;*
pusha:
pushav	equ	$+2
	ld	hl,stklmt	; *** PUSHA ***
	call	chgsgn
	pop	bc		; BC=RETURN ADDRESS
	add	hl,sp		; IS STACK NEAR THE TOP?
	jp	nc,qsorry	; YES, SORRY FOR THAT.
	ld	hl,(lopvar)	; ELSE SAVE LOOP VAR.S
	ld	a,h		; BUT IFF LOPVAR IS 0
	or	l		; THAT WILL BE ALL
	jr	z,pu1
	ld	hl,(loppt)	; ELSE, MORE TO SAVE
	push	hl
	ld	hl,(lopln)
	push	hl
	ld	hl,(loplmt)
	push	hl
	ld	hl,(lopinc)
	push	hl
	ld	hl,(lopvar)
pu1:
	push	hl
	push	bc		; BC = RETURN ADDR.
	ret
lstrom:				; ALL ABOVE CAN BE ROM
outio:
	out	(0ffh),a
	ret
waitio:
	in	a,(0ffh)
	xor	h
	and	l
	jr	z,waitio
	cal	finish
inpio:
	in	a,(0ffh)
	ld	l,a
	ret
;
ocsw:
	db	ON		; SWITCH FOR OUTPUT
currnt:
	dw	0		; POINTS TO CURRENT LINE
stkgos:
	dw	0		; SAVES SP IN 'GOSUB'
varnxt:
	dw	0		; TEMPORARY STORAGE
stkinp:
	dw	0		; SAVES SP IN 'INPUT'
lopvar:
	dw	0		; 'FOR' LOOP SAVE AREA
lopinc:
	dw	0		; INCREMENT
loplmt:
	dw	0		; LIMIT
lopln:
	dw	0		; LINE NUMBER
loppt:
	dw	0		; TEXT POINTER
ranpnt:
	dw	start		; RANDOM NUMBER POINTER
txtunf:
	dw	txtbgn		; ->UNFILLED TEXT AREA
txtbgn:
	ds	1		; TEXT SAVE AREA BEGINS
msg1:
	db	'SHERRY BROTHERS TINY BASIC VER. 3.1',cr
;
; Init TINY BASIC environment
;
init:
	ld	a,ff		; GET FORM FEED
	cal	outc		; SEND TO CRT
	sub	a		; CLEAR ACCUMULATOR
	ld	de,msg1		; GET INIT MESSAGE
	call	prtstg		; SEND IT
	ld	a,(cpm+2)	; GET FBASE FOR TOP
	ld	(rsta),a
	dec	a		; DECREMENT FOR OTHER POINTERS
	ld	(ss1a),a	; AND FIX THEM TOO
	ld	(tv1a),a
	ld	(st3a),a
	ld	(st4a),a
	ld	(ip3a),a
	ld	(sizea),a
	ld	(getlna),a
	ld	(pushav),a
	ld	hl,rstart	; GET NEW START JUMP
	ld	(start+1),hl	; AND FIX IT
	jp	rstart

	org	0f00h

txtend	equ	$		; TEXT SAVE AREA ENDS
varbgn:
	ds	2*27		; VARIABLE @(0)
	ds	1		; EXTRA BYTE FOR BUFFER
buffer:
	ds	80		; INPUT BUFFER
bufend	equ	$		; BUFFER ENDS
	ds	40		; EXTRA BYTES FOR STACK
stklmt	equ	$		; TOP LIMIT FOR STACK

	org	2000h

stack	equ	$		; STACK STARTS HERE

	end