Pegasys-RomWBW/Source/Apps/BBCBASIC/exec.z80

		TITLE	BBC BASIC (C) R.T.RUSSELL 1981-2024
	NAME	('EXEC')
;
;BBC BASIC INTERPRETER - Z80 VERSION
;STATEMENT EXECUTION MODULE - "EXEC"
;(C) COPYRIGHT R.T.RUSSELL 1981-2024
;
;THE NAME BBC BASIC IS USED WITH THE PERMISSION
;OF THE BRITISH BROADCASTING CORPORATION AND IS
;NOT TRANSFERRABLE TO A FORKED OR DERIVED WORK.
;
;VERSION 2.1, 22-01-1984
;VERSION 3.1, 11-06-1987
;VERSION 5.0, 19-05-2024
;
	GLOBAL	XEQ
	GLOBAL	RUN0
	GLOBAL	CHAIN0
	GLOBAL	CHECK
	GLOBAL	MUL16
	GLOBAL	X14OR5
	GLOBAL	TERMQ
	GLOBAL	STOREN
	GLOBAL	STORE4
	GLOBAL	STORE5
	GLOBAL	STACCS
	GLOBAL	SPACES
	GLOBAL	FN
	GLOBAL	USR
	GLOBAL	ESCAPE
	GLOBAL	SYNTAX
	GLOBAL	CHANEL
	GLOBAL	CHNL
	GLOBAL	VAR
	GLOBAL	TABIT
	GLOBAL	MODIFY
	GLOBAL	MODIFS
;
	EXTRN	ASSEM
	EXTRN	ERROR
	EXTRN	REPORT
	EXTRN	WARM
	EXTRN	CLOOP
	EXTRN	SAYLN
	EXTRN	LOAD0
	EXTRN	CRLF
	EXTRN	PBCDL
	EXTRN	TELL
	EXTRN	FINDL
	EXTRN	SETLIN
	EXTRN	CLEAR
	EXTRN	GETVAR
	EXTRN	PUTVAR
	EXTRN	GETDEF
	EXTRN	LOCATE
	EXTRN	CREATE
	EXTRN	OUTCHR
	EXTRN	EXTERR
	EXTRN	BYE
	EXTRN	NXT
	EXTRN	NLIST
;
	EXTRN	OSWRCH
	EXTRN	OSLINE
	EXTRN	OSSHUT
	EXTRN	OSBPUT
	EXTRN	OSBGET
	EXTRN	CLRSCN
	EXTRN	PUTCSR
	EXTRN	PUTIME
	EXTRN	PUTIMS
	EXTRN	PUTPTR
	EXTRN	OSCALL
	EXTRN	OSCLI
	EXTRN	TRAP
;
	EXTRN	SOUND
	EXTRN	CLG
	EXTRN	DRAW
	EXTRN	ENVEL
	EXTRN	GCOL
	EXTRN	MODE
	EXTRN	MOVE
	EXTRN	PLOT
	EXTRN	COLOUR
	EXTRN	CIRCLE
	EXTRN	ELLIPSE
	EXTRN	FILL
	EXTRN	MOUSE
	EXTRN	ORIGIN
	EXTRN	RECTAN
	EXTRN	LINE
	EXTRN	WAIT
	EXTRN	TINT
	EXTRN	SYS
;
	EXTRN	STR
	EXTRN	HEXSTR
	EXTRN	EXPR
	EXTRN	EXPRN
	EXTRN	EXPRI
	EXTRN	EXPRS
	EXTRN	ITEMI
	EXTRN	CONS
	EXTRN	LOADS
	EXTRN	VAL0
	EXTRN	SFIX
	EXTRN	TEST
	EXTRN	LOAD4
	EXTRN	LOADN
	EXTRN	DLOAD5
	EXTRN	FPP
	EXTRN	COMMA
	EXTRN	BRAKET
	EXTRN	PUSHS
	EXTRN	POPS
	EXTRN	ZERO
	EXTRN	SCP
	EXTRN	LETARR
;
	EXTRN	ACCS
	EXTRN	PAGE
	EXTRN	LOMEM
	EXTRN	HIMEM
	EXTRN	FREE
	EXTRN	BUFFER
	EXTRN	ERRTRP
	EXTRN	ONERSP
	EXTRN	CURLIN
	EXTRN	COUNT
	EXTRN	WIDTH
	EXTRN	STAVAR
	EXTRN	DATPTR
	EXTRN	RANDOM
	EXTRN	TRACEN
	EXTRN	LISTON
	EXTRN	PC
	EXTRN	OC
;
LF	EQU	0AH
CR	EQU	0DH
TAND	EQU	80H
TOR	EQU	84H
TERROR	EQU	85H
TLINE	EQU	86H
TOFF	EQU	87H
TSTEP	EQU	88H
TSPC	EQU	89H
TTAB	EQU	8AH
TELSE	EQU	8BH
TTHEN	EQU	8CH
TLINO	EQU	8DH
TTO	EQU	0B8H
TCMD	EQU	0C0H
TWHILE	EQU	0C7H
TWHEN	EQU	0C9H
TOF	EQU	0CAH
TENDCASE EQU	0CBH
TOTHERWISE EQU	0CCH
TENDIF	EQU	0CDH
TENDWHILE EQU	0CEH
TCALL	EQU	0D6H
TDATA	EQU	0DCH
TDEF	EQU	0DDH
TFOR	EQU	0E3H
TGOSUB	EQU	0E4H
TGOTO	EQU	0E5H
TLOCAL	EQU	0EAH
TNEXT	EQU	0EDH
TON	EQU	0EEH
TPROC	EQU	0F2H
TREM	EQU	0F4H
TREPEAT	EQU	0F5H
TRETURN	EQU	0F8H
TSTOP	EQU	0FAH
TUNTIL	EQU	0FDH
TEXIT	EQU	10H
;
CMDTAB:	DEFW	LEFTSL
	DEFW	MIDSL
	DEFW	RITESL
	DEFW	SYNTAX	;STR$
	DEFW	SYNTAX	;STRING$
	DEFW	SYNTAX	;EOF
	DEFW	SYNTAX	;SUM
	DEFW	WHILE
	DEFW	CASE
	DEFW	SYNTAX	;WHEN
	DEFW	SYNTAX	;OF
	DEFW	XEQ	;ENDCASE
	DEFW	SYNTAX	;OTHERWISE
	DEFW	XEQ	;ENDIF
	DEFW	ENDWHI	;ENDWHILE
	DEFW	PTR
	DEFW	PAGEV
	DEFW	TIMEV
	DEFW	LOMEMV
	DEFW	HIMEMV
	DEFW	SOUND
	DEFW	BPUT
	DEFW	CALL
	DEFW	CHAIN
	DEFW	CLR
	DEFW	CLOSE
	DEFW	CLG
	DEFW	CLS
	DEFW	REM		;DATA
	DEFW	REM		;DEF
	DEFW	DIM
	DEFW	DRAW
	DEFW	END
	DEFW	ENDPRO
	DEFW	ENVEL
	DEFW	FOR
	DEFW	GOSUB
	DEFW	GOTO
	DEFW	GCOL
	DEFW	IF
	DEFW	INPUT
	DEFW	LET
	DEFW	LOCAL
	DEFW	MODE
	DEFW	MOVE
	DEFW	NEXT
	DEFW	ON
	DEFW	VDU
	DEFW	PLOT
	DEFW	PRINT
	DEFW	PROC
	DEFW	READ
	DEFW	REM
	DEFW	REPEAT
	DEFW	REPOR
	DEFW	RESTOR
	DEFW	RETURN
	DEFW	RUN
	DEFW	STOP
	DEFW	COLOUR
	DEFW	TRACE
	DEFW	UNTIL
	DEFW	WIDTHV
	DEFW	CLI		;OSCLI
	DEFW	REM		;NUL
	DEFW	CIRCLE
	DEFW	ELLIPSE
	DEFW	FILL
	DEFW	MOUSE
	DEFW	ORIGIN
	DEFW	BYE		;QUIT
	DEFW	RECTAN
	DEFW	SWAP
	DEFW	SYS
	DEFW	TINT
	DEFW	WAIT
	DEFW	SYNTAX		;INSTALL
	DEFW	REM		;CR
	DEFW	PUT		;Token changed
	DEFW	SYNTAX		;BY
	DEFW	EXIT
;
TLAST	EQU	TCMD-128+($-CMDTAB)/2
;
RUN:	CALL	TERMQ
	JR	Z,RUN0
CHAIN:	CALL	EXPRS
	LD	A,CR
	LD	(DE),A
CHAIN0:	LD	SP,(HIMEM)
	CALL	LOAD0
RUN0:	LD	SP,(HIMEM)	;PREPARE FOR RUN
	LD	IX,RANDOM
RAND:	LD	A,R		;RANDOMISE (CARE!)
	JR	Z,RAND
	RLCA
	RLCA
	LD	(IX+3),A
	SBC	A,A
	LD	(IX+4),A
	CALL	CLEAR
	LD	HL,0
	LD	(ERRTRP),HL
	LD	HL,(PAGE)
	CALL	DSRCH		;LOOK FOR "DATA"
	LD	(DATPTR),HL	;SET DATA POINTER
	LD	IY,(PAGE)
XEQ0:	CALL	NEWLIN
	LD	A,(IY)
	CP	TELSE
	JP	Z,MELSE		;ELSE
	CP	TWHEN
	JP	Z,WHEN		;WHEN
	CP	TOTHERWISE
	JP	Z,WHEN
XEQ:	LD	(CURLIN),IY	;ERROR POINTER
	CALL	TRAP		;CHECK KEYBOARD
XEQ1:	CALL	NXT
	INC	IY
	CP	':'		;SEPARATOR
	JR	Z,XEQ1
	CP	CR
	JR	Z,XEQ0		;NEW PROGRAM LINE
	CP	TLAST
	JP	PE,LET0		;IMPLIED LET
	SUB	TCMD
	JP	M,EXTRAS
	ADD	A,A
	LD	C,A
	LD	B,0
	LD	HL,CMDTAB
	ADD	HL,BC
	LD	A,(HL)		;TABLE ENTRY
	INC	HL
	LD	H,(HL)
	LD	L,A
	CALL	NXT
	JP	(HL)		;EXECUTE STATEMENT
;
;END
;
ENDIM:	PUSH	IY
	POP	HL
	LD	BC,(PAGE)
	SBC	HL,BC		;IMMEDIATE MODE ?
	JP	C,CLOOP
END:	LD	E,0
	CALL	OSSHUT		;CLOSE ALL FILES
	JP	WARM		;"Ready"
;
NEWLIN:	LD	A,(IY+0)	;A=LINE LENGTH
	LD	BC,3
	ADD	IY,BC
	OR	A
	JR	Z,ENDIM		;LENGTH=0, EXIT
	LD	HL,(TRACEN)
	LD	A,H
	OR	L
	RET	Z
	LD	D,(IY-1)	;DE = LINE NUMBER
	LD	E,(IY-2)
	SBC	HL,DE
	RET	C
	EX	DE,HL
	LD	A,'['		;TRACE
	CALL	OUTCHR
	CALL	PBCDL
	LD	A,']'
	CALL	OUTCHR
	LD	A,' '
	JP	OUTCHR
;
;ROUTINES FOR EACH STATEMENT:
;
;OSCLI
;
CLI:	CALL	EXPRS
	LD	A,CR
	LD	(DE),A
	LD	HL,ACCS
	CALL	OSCLI
	JR	XEQ
;
;REM, *
;
EXT:	PUSH	IY
	POP	HL
	CALL	OSCLI
REM:	PUSH	IY
	POP	HL
	LD	A,CR
	LD	B,A
	CPIR			;FIND LINE END
	PUSH	HL
	POP	IY
	JP	XEQ0
;
EXTRAS:	CP	TELSE-TCMD
	JR	Z,REM		;ELSE
	CP	TERROR-TCMD
	JR	Z,THROW		;ERROR
	CP	TLINE-TCMD
	JP	Z,LINE		;LINE
	JP	SYNTAX
;
;ERROR num,string$
;
THROW:	CALL	EXPRI
	EXX
	PUSH	HL
	EXX
	CALL	COMMA
	CALL	EXPRS
	POP	HL
	XOR	A
	LD	(DE),A
	LD	A,L
	LD	HL,ACCS
	LD	DE,BUFFER
	PUSH	DE
	LD	BC,256
	LDIR
	JP	EXTERR
;
; SWAP
;
SWAP:	CALL	GETVAR
	JR	NZ,SWAPNZ
	PUSH	AF
	PUSH	HL
	CALL	COMMA
	CALL	NXT
	CALL	GETVAR
SWAPNZ:	JR	NZ,NOSUCH
	POP	DE
	POP	BC
	CP	B
	JR	NZ,MISMAT
	AND	00001111B
	JR	Z,MISMAT
	LD	A,B
	AND	11000000B
	JR	Z,SWAP1
	LD	B,2
	JP	P,SWAP1
	JP	PE,SWAP1
	LD	B,4
SWAP1:	LD	C,(HL)
	LD	A,(DE)
	LD	(HL),A
	LD	A,C
	LD	(DE),A
	INC	DE
	INC	HL
	DJNZ	SWAP1
	JR	XEQR
;
;[LET] var = expr
;
LET0:	CP	'*'
	JR	Z,EXT
	CP	'='
	JR	Z,FNEND
	CP	'['
	JR	Z,ASM
	DEC	IY
LET:	CALL	ASSIGN
	JP	Z,XEQ
	JR	C,SYNTAX	;"Syntax error"
	JP	P,LETARR	;Numeric array
	JP	PE,LETARR	;String array
	LD	A,D		;Type
	PUSH	DE
	PUSH	HL
	CALL	EXPRS
	POP	IX
	POP	HL
	CALL	MODIFS
XEQR:	JP	XEQ
;
; GETSTR - Get string variable
;   Inputs: IY = text pointer
;  Outputs: B = type
;           Z-flag set if comma
;
GETSTR:	CALL	GETVAR
	JR	NZ,NOSUCH
	LD	B,A
	AND	11000000B
	JP	P,MISMAT
	JP	PE,BADUSE
	BIT	0,B
	JR	Z,MISMAT
	CALL	NXT
	CP	','
	RET
;
VAR:	CALL	GETVAR
	RET	Z
	JP	NC,PUTVAR
NOSUCH:	LD	A,26		;'No such variable'
	DEFB	21H
SYNTAX:	LD	A,16		;"Syntax error"
	DEFB	21H
ESCAPE:	LD	A,17		;"Escape"
	DEFB	21H
BADUSE:	LD	A,14		;'Bad use of array'
	DEFB	21H
MISMAT:	LD	A,6		;'Type mismatch'
ERROR0:	JP	ERROR
;
ASM0:	CALL	NEWLIN
ASM:	LD	(CURLIN),IY
	CALL	TRAP
	CALL	ASSEM
	JR	C,SYNTAX
	CP	CR
	JR	Z,ASM0
	LD	HL,LISTON
	LD	A,(HL)
	AND	0FH
	OR	30H
	LD	(HL),A
	JR	XEQR
;
;=
;
FNEND:	CALL	EXPR		;FUNCTION RESULT
	EX	AF,AF'
	ADD	A,A
	LD	A,E
	JR	C,FNEND1
	LD	A,C
FNEND1:	EX	AF,AF'
	PUSH	HL
	EXX
	POP	BC
	EX	DE,HL		;SAVE RESULT IN A'B'C'D'E'
	EXX
FNEND2:	POP	BC
	LD	HL,FNCHK
	XOR	A
	SBC	HL,BC
	JR	Z,FNEND3
	PUSH	BC
	CALL	RESLOC
	JR	NZ,FNEND2
	LD	A,7
	JR	ERROR0		;"No FN"
;
FNEND3:	POP	IY
	LD	(CURLIN),IY	;IN CASE OF ERROR
	EXX
	EX	DE,HL
	PUSH	BC
	EXX
	POP	HL
	EX	AF,AF'
	LD	E,A
	LD	C,A
	RRA
	RET
;
;DIM var(dim1[,dim2[,...]])[,var(...]
;DIM var expr[,var expr...]
;
DIM:	PUSH	IY
	CP	'!'
	JP	Z,DIM4
	CALL	LOCATE		;VARIABLE
	JP	C,BADDIM
	CALL	NZ,CREATE
	LD	A,(IY)
	CP	'('
	JP	NZ,DIM4
	PUSH	HL
	POP	IX
	LD	A,(HL)
	AND	0FEH
	INC	HL
	OR	(HL)
	JP	NZ,DIM4
	POP	BC		;LEVEL STACK
	LD	A,D
	LD	HL,(FREE)
	PUSH	HL
	EX	(SP),IX
	PUSH	HL
	PUSH	AF		;SAVE TYPE
	LD	DE,1
	LD	B,D		;DIMENSION COUNTER
DIM1:	INC	IY
	PUSH	BC
	PUSH	DE
	PUSH	IX
	CALL	EXPRI		;DIMENSION SIZE
	BIT	7,H
	JR	NZ,BADDIM
	EXX
	INC	HL
	POP	IX
	INC	IX
	LD	(IX),L		;SAVE SIZE
	INC	IX
	LD	(IX),H
	POP	BC
	CALL	MUL16		;HL=HL*BC
	JR	C,NOROOM	;TOO LARGE
	EX	DE,HL		;DE=PRODUCT
	POP	BC
	INC	B		;DIMENSION COUNTER
	LD	A,(IY)
	CP	','		;ANOTHER
	JR	Z,DIM1
	INC	IX
	CALL	BRAKET		;CLOSING BRACKET
	POP	AF		;RESTORE TYPE
	CALL	X14OR5		;DE=DE*n
	JR	C,NOROOM
	POP	HL
	LD	(HL),B		;NO. OF DIMENSIONS
	EX	(SP),IX
	POP	HL
	AND	80H
	OR	(IX)		;FLAGS
;
;  A = flags: bit 7 = string, bit 0 = LOCAL 
; DE = amount to allocate
; HL = where to allocate (if not LOCAL)
; (HL - FREE is size of 'descriptor')
; IX = where to store pointer
;
DIM3:	PUSH	HL
	INC	H		;Safety margin
	ADD	HL,DE
	JR	C,NOROOM
	SBC	HL,SP
	JR	NC,NOROOM
	POP	HL
	PUSH	HL
	LD	BC,(FREE)
	OR	A
	SBC	HL,BC
	LD	B,H
	LD	C,L
	POP	HL
	SBC	HL,BC
	BIT	0,A
	JR	Z,ARRCHK	;NOT LOCAL
	LD	HL,0
	ADD	HL,SP
	SBC	HL,DE
	SBC	HL,BC
	LD	SP,HL
	PUSH	DE
	PUSH	BC
	PUSH	AF
	CALL	ARRCHK
ARRCHK:	LD	(IX+0),L	;SAVE POINTER
	LD	(IX+1),H
	LD	A,B
	OR	C
	JR	Z,DIM2
	PUSH	DE
	EX	DE,HL
	LD	HL,(FREE)
	LDIR			;COPY DESCRIPTOR
	EX	DE,HL
	POP	DE
DIM2:	LD	A,D
	OR	E
	JR	Z,DIM5
	LD	(HL),0		;INITIALISE ARRAY
	INC	HL
	DEC	DE
	JR	DIM2
;
BADDIM:	LD	A,10		;"Bad DIM"
	DEFB	21H
NOROOM:	LD	A,11		;"DIM space"
ERROR1:	JP	ERROR
;
DIM5:	SBC	HL,SP
	JR	NC,DIM7		;LOCAL
	ADD	HL,SP
	LD	(FREE),HL
DIM7:	CALL	NLIST		;ANOTHER VARIABLE?
	JP	DIM
;
DIM4:	POP	IY
	CALL	VAR
	OR	A
	JR	Z,BADDIM
	JP	M,BADDIM
	BIT	6,A
	JR	NZ,BADDIM
	LD	B,A		;TYPE
	CALL	NXT
	CP	TLOCAL
	LD	A,0		;PRESET TO NOT LOCAL
	JR	NZ,DIM8
	INC	IY
	INC	A		;FLAG LOCAL
DIM8:	PUSH	AF
	LD	A,B		;TYPE
	EXX
	LD	HL,0
	LD	C,H
	CALL	STOREN		;RESERVED AREA
	PUSH	IX
	CALL	EXPRI
	POP	IX
	EXX
	INC	HL
	EX	DE,HL
	LD	HL,(FREE)
	POP	AF		;LOCAL FLAG
	JP	DIM3
;
;PRINT list...
;PRINT #channel,list...
;
PRINT:	CP	'#'
	JR	NZ,PRINT0
	CALL	CHNL		;CHANNEL NO. = E
PRNTN1:	CALL	NLIST
	PUSH	DE
	CALL	EXPR		;ITEM TO PRINT
	EX	AF,AF'
	JP	M,PRNTN2	;STRING
	POP	DE
	PUSH	BC
	EXX
	LD	A,L
	EXX
	CALL	OSBPUT
	EXX
	LD	A,H
	EXX
	CALL	OSBPUT
	LD	A,L
	CALL	OSBPUT
	LD	A,H
	CALL	OSBPUT
	POP	BC
	LD	A,C
	CALL	OSBPUT
	JR	PRNTN1
PRNTN2:	LD	C,E
	POP	DE
	LD	HL,ACCS
	INC	C
PRNTN3:	DEC	C
	JR	Z,PRNTN4
	LD	A,(HL)
	INC	HL
	PUSH	BC
	CALL	OSBPUT
	POP	BC
	JR	PRNTN3
PRNTN4:	LD	A,CR
	CALL	OSBPUT
	JR	PRNTN1
;
PRINT6:	LD	B,2
	JR	PRINTC
PRINT8:	LD	BC,100H
	JR	PRINTC
PRINT9:	LD	HL,STAVAR
	XOR	A
	CP	(HL)
	JR	Z,PRINT0
	LD	A,(COUNT)
	OR	A
	JR	Z,PRINT0
PRINTA:	SUB	(HL)
	JR	Z,PRINT0
	JR	NC,PRINTA
	NEG
	CALL	SPACES
PRINT0:	LD	A,(STAVAR)
	LD	C,A		;PRINTS
	LD	B,0		;PRINTF
PRINTC:	CALL	TERMQ
	JR	Z,PRINT4
	RES	0,B
	INC	IY
	CP	'~'
	JR	Z,PRINT6
	CP	';'
	JR	Z,PRINT8
	CP	','
	JR	Z,PRINT9
	CALL	FORMAT		;SPC, TAB, '
	JR	Z,PRINTC
	DEC	IY
	PUSH	BC
	CALL	EXPR		;VARIABLE TYPE
	EX	AF,AF'
	JP	M,PRINT3	;STRING
	POP	DE
	PUSH	DE
	BIT	1,D
	PUSH	AF
	CALL	Z,STR		;DECIMAL
	POP	AF
	CALL	NZ,HEXSTR	;HEX
	POP	BC
	PUSH	BC
	LD	A,C
	SUB	E
	CALL	NC,SPACES		;RIGHT JUSTIFY
PRINT3:	POP	BC
	CALL	PTEXT		;PRINT
	JR	PRINTC
PRINT4:	BIT	0,B
	CALL	Z,CRLF
	JR	XEQGO3
;
ONERR:	INC	IY		;SKIP "ERROR"
	CALL	NXT
	LD	HL,0		;FLAG NOT LOCAL
	CP	TLOCAL
	JR	NZ,ONERR1
	INC	IY		;SKIP "LOCAL"
	LD	HL,(ERRTRP)
	PUSH	HL
	LD	HL,(ONERSP)
	PUSH	HL
	LD	HL,400H		;TYPE = 4, 'EXPONENT' = 0
	PUSH	HL
	LD	HL,ERRTRP
	PUSH	HL
	LD	HL,LOCCHK
	PUSH	HL
	LD	HL,0
	ADD	HL,SP
	CALL	NXT
ONERR1:	LD	(ONERSP),HL
	LD	(ERRTRP),IY
	CP	TOFF
	JP	NZ,REM
	INC	IY		;SKIP "OFF"
	SBC	HL,HL
	LD	(ONERSP),HL
	LD	(ERRTRP),HL
XEQGO3:	JP	XEQ
;
;ON expr GOTO line[,line...] [ELSE statement]
;ON expr GOTO line[,line...] [ELSE line]
;ON expr GOSUB line[,line...] [ELSE statement]
;ON expr GOSUB line[,line...] [ELSE line]
;ON expr PROCone [,PROCtwo..] [ELSE PROCotherwise]
;ON ERROR [LOCAL] statement [:statement...]
;ON ERROR [LOCAL] OFF
;
ON:	CP	TERROR
	JR	Z,ONERR		;"ON ERROR"
	CALL	EXPRI
	LD	A,(IY)
	INC	IY
	LD	E,','		;SEPARATOR
	CP	TGOTO
	JR	Z,ON1
	CP	TGOSUB
	JR	Z,ON1
	LD	E,TPROC
	CP	E
	LD	A,39
	JR	NZ,ERROR2	;"ON syntax"
ON1:	LD	D,A
	EXX
	PUSH	HL
	EXX
	POP	BC		;ON INDEX
	LD	A,B
	OR	H
	OR	L
	JR	NZ,ON4		;OUT OF RANGE
	OR	C
	JR	Z,ON4
	DEC	C
	JR	Z,ON3		;INDEX=1
ON2:	CALL	TERMQ
	JR	Z,ON4		;OUT OF RANGE
	INC	IY		;SKIP DELIMITER
	CP	'"'
	JR	Z,ON5
	CP	E
	JR	NZ,ON2
	DEC	C
	JR	NZ,ON2
ON3:	LD	A,E
	CP	TPROC
	JR	Z,ONPROC
	PUSH	DE
	CALL	ITEMI		;LINE NUMBER
	POP	DE
	LD	A,D
	CP	TGOTO
	JR	Z,GOTO2
	CALL	SPAN		;SKIP REST OF LIST
	JR	GOSUB1
;
ON5:	CALL	QUOTE
	INC	IY
	JR	ON2
;
ON4:	LD	A,(IY)
	INC	IY
	CP	TELSE
	JP	Z,IF1		;ELSE CLAUSE
	CP	CR
	JR	NZ,ON4
	LD	A,40
ERROR2:	JP	ERROR		;"ON range"
;
ONPROC:	LD	A,TON
	JP	PROC
;
;GOTO line
;
GOTO:	CALL	ITEMI		;LINE NUMBER
GOTO1:	CALL	TERMQ
	JP	NZ,SYNTAX
GOTO2:	EXX
	CALL	FINDL
	PUSH	HL
	POP	IY
	JP	Z,XEQ0
	LD	A,41
	JR	ERROR2		;"No such line"
;
;GOSUB line
;
GOSUB:	CALL	ITEMI		;LINE NUMBER
GOSUB1:	PUSH	IY		;TEXT POINTER
	CALL	CHECK		;CHECK ROOM
	CALL	GOTO1		;SAVE MARKER
GOSCHK	EQU	$
;
;RETURN
;
RETURN:	POP	DE		;MARKER
	LD	HL,GOSCHK
	OR	A
	SBC	HL,DE
	POP	IY
	JR	Z,XEQGO2
	LD	A,38
	JR	ERROR2		;"No GOSUB"
;
;REPEAT
;
REPEAT:	PUSH	IY
	CALL	CHECK
	CALL	XEQ
REPCHK	EQU	$
;
;UNTIL expr
;
UNTIL:	POP	BC
	PUSH	BC
	LD	HL,REPCHK
	OR	A
	SBC	HL,BC
	JR	Z,UNTIL1
	LD	A,3
	CALL	RESLOC
	JR	NZ,UNTIL
	LD	A,43
	JR	ERROR2		;"Not in a REPEAT loop"
;
UNTIL1:	CALL	EXPRI
	CALL	TEST
	POP	BC
	POP	DE
	JR	NZ,XEQGO2		;TRUE
	PUSH	DE
	PUSH	BC
	PUSH	DE
	POP	IY
XEQGO2:	JP	XEQ
;
;FOR var = expr TO expr [STEP expr]
;
FORVAR:	LD	A,34
	JR	ERROR2		;"FOR variable"
;
FOR:	CALL	ASSIGN
	JR	NZ,FORVAR	;"FOR variable"
	PUSH	AF		;SAVE TYPE
	LD	A,(IY)
	CP	TTO
	LD	A,36
	JR	NZ,ERROR2	;"No TO"
	INC	IY
	PUSH	IX
	CALL	EXPRN		;LIMIT
	POP	IX
	POP	AF
	LD	B,A		;TYPE
	PUSH	BC		;SAVE ON STACK
	PUSH	HL
	LD	HL,0
	LD	C,H
	EXX
	PUSH	HL
	LD	HL,1		;PRESET STEP
	EXX
	LD	A,(IY)
	CP	TSTEP
	JR	NZ,FOR1
	INC	IY
	PUSH	IX
	CALL	EXPRN		;STEP
	POP	IX
FOR1:	LD	B,8		;FPP '>'
	BIT	7,H
	JR	NZ,FOR2		;STEP SIGN
	LD	B,12		;FPP '<'
FOR2:	PUSH	BC
	PUSH	HL
	EXX
	PUSH	HL
	EXX
	PUSH	IY		;SAVE TEXT POINTER
	PUSH	IX		;LOOP VARIABLE
	CALL	CHECK
	CALL	XEQ
FORCHK	EQU	$
;
;NEXT [var[,var...]]
;
NEXT:	POP	BC		;MARKER
	LD	HL,FORCHK
	OR	A
	SBC	HL,BC
	JR	Z,NEXT2
	PUSH	BC
	LD	A,3
	CALL	RESLOC
	JR	NZ,NEXT
	LD	A,32
	JR	ERROR3		;"Not in a FOR loop"
;
NEXT2:	CALL	TERMQ
	POP	HL
	PUSH	HL
	PUSH	BC
	PUSH	HL
	CALL	NZ,GETVAR	;VARIABLE
	POP	DE
	EX	DE,HL
	OR	A
NEXT0:	SBC	HL,DE
	JR	NZ,NEXT1
	PUSH	DE
	LD	IX,6+2
	ADD	IX,SP
	CALL	DLOAD5		;STEP
	LD	A,(IX+11)	;TYPE
	POP	IX
	CALL	LOADN		;LOOP VARIABLE
	PUSH	AF
	LD	A,'+' AND 0FH
	CALL	FPP		;ADD STEP
	JR	C,ERROR3
	POP	AF		;RESTORE TYPE
	CALL	STOREN		;UPDATE VARIABLE
	LD	IX,12
	ADD	IX,SP
	CALL	DLOAD5		;LIMIT
	LD	A,(IX-1)
	CALL	FPP		;TEST AGAINST LIMIT
	JR	C,ERROR3
	INC	H
	JR	NZ,LOOP		;KEEP LOOPING
	LD	HL,18
	ADD	HL,SP
	LD	SP,HL
	CALL	NLIST
	JR	NEXT
;
LOOP:	POP	BC
	POP	DE
	POP	IY
	PUSH	IY
	PUSH	DE
	PUSH	BC
	JP	XEQ
;
NEXT1:	LD	HL,18
	ADD	HL,SP
	LD	SP,HL		;"POP" THE STACK
	POP	BC
	LD	HL,FORCHK
	SBC	HL,BC
	POP	HL		;VARIABLE POINTER
	PUSH	HL
	PUSH	BC
	JR	Z,NEXT0
	LD	A,33
ERROR3:	JP	ERROR		;"Can't match FOR"
;
;FNname
;N.B. ENTERED WITH A <> TON
;
FN:	PUSH	AF		;MAKE SPACE ON STACK
	CALL	PROC1
FNCHK	EQU	$
;
;PROCname
;N.B. ENTERED WITH A = ON PROC FLAG
;
PROC:	PUSH	AF		;MAKE SPACE ON STACK
	CALL	PROC1
PROCHK	EQU	$
PROC1:	CALL	CHECK
	DEC	IY
	PUSH	IY
	CALL	GETDEF
	POP	BC
	JR	Z,PROC4
	LD	A,30
	JR	C,ERROR3	;"Bad call"
	PUSH	BC
	LD	HL,(PAGE)
PROC2:	LD	A,TDEF
	CALL	SEARCH		;LOOK FOR "DEF"
	JR	C,PROC3
	PUSH	HL
	POP	IY
	INC	IY		;SKIP DEF
	CALL	NXT
	CALL	GETDEF
	PUSH	IY
	POP	DE
	JR	C,PROC6
	CALL	NZ,CREATE
	PUSH	IY
	POP	DE
	LD	(HL),E
	INC	HL
	LD	(HL),D		;SAVE ADDRESS
PROC6:	EX	DE,HL
	LD	A,CR
	LD	B,A
	CPIR			;SKIP TO END OF LINE
	JR	PROC2
PROC3:	POP	IY		;RESTORE TEXT POINTER
	CALL	GETDEF
	LD	A,29
	JR	NZ,ERROR3	;"No such FN/PROC"
PROC4:	LD	E,(HL)
	INC	HL
	LD	D,(HL)		;GET ADDRESS
	LD	HL,2
	ADD	HL,SP
	CALL	NXT		;ALLOW SPACE BEFORE (
	PUSH	DE		;EXCHANGE DE,IY
	EX	(SP),IY
	POP	DE
	CP	'('		;ARGUMENTS?
	JP	NZ,PROC5
	CALL	NXT		;ALLOW SPACE BEFORE (
	CP	'('
	JP	NZ,SYNTAX	;"Syntax error"
	PUSH	IY
	POP	BC		;SAVE IY IN BC
	EXX
	EX	AF,AF'
	XOR	A		;INITIALISE RETURN COUNT
	EX	AF,AF'
	CALL	SAVLOC		;SAVE DUMMY VARIABLES
	EX	AF,AF'
	OR	A
	JR	Z,RETCHK	;NO RETURNS
	PUSH	HL
	NEG
	LD	L,A
	NEG
	LD	H,-1		;HL = -RETURNS
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL		;-RETURNS * 8
	EX	(SP),HL
	POP	IX
	ADD	IX,SP
	LD	SP,IX
	PUSH	AF		;PUSH RETURN COUNT
	CALL	RETCHK		;PUSH MARKER
RETCHK:	EX	AF,AF'
	CALL	BRAKET		;CLOSING BRACKET
	EXX
	PUSH	BC
	POP	IY		;RESTORE IY
	PUSH	HL
	CALL	ARGUE		;TRANSFER ARGUMENTS
	POP	HL
;
; If any of the dummy arguments is the same as a passed-by-reference
; variable, then it must not be restored on exit (it would overwrite
; the wanted returned values), therefore search the saved values on
; the stack and if a match is found set bit 4 of the type.  On exit
; from the FN/PROC this will prevent the dummies from being restored.
;
	EX	(SP),HL
	OR	A
	LD	BC,RETCHK
	SBC	HL,BC
	ADD	HL,BC
	EX	(SP),HL
	JR	NZ,PROC5	;No RETURNs
;
	PUSH	DE
	PUSH	HL
	LD	HL,7		;Skip two PUSHes and RETCHK
	ADD	HL,SP
	LD	A,(HL)		;RETURN count
	INC	HL
	PUSH	HL
	POP	IX		;Address RETURNs table
PROC0:	LD	E,A
	LD	D,0
	EX	DE,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,DE		;HL addresses SAVLOC stack
	INC	HL
	INC	HL		;Bump past LOCCHK
PROC7:	LD	E,(HL)
	INC	HL
	LD	D,(HL)		;DE = SAVLOC VARPTR
	INC	HL
	LD	C,(HL)		;Length (if string)
	INC	HL
	LD	B,(HL)		;Variable type
;
; Scan RETURNs table for VARPTR match
;
	PUSH	BC		;Save type
	PUSH	HL
	PUSH	IX
	LD	B,A		;B = RETURN count
PROC8:	LD	L,(IX+4)
	LD	H,(IX+5)	;HL = RETURNed VARPTR
	OR	A
	SBC	HL,DE
	JR	Z,PROC9
	EX	DE,HL
	LD	DE,8
	ADD	IX,DE
	EX	DE,HL
	DJNZ	PROC8
PROC9:	POP	IX
	POP	HL
	POP	BC		;Restore type
;
; If match, set bit 4 of type:
;
	JR	NZ,PROCA
	SET	4,(HL)		;Flag don't restore
;
; Increment past stacked data:
;
PROCA:	LD	DE,3
	BIT	6,B
	JR	NZ,PROCB	;Whole array
	LD	E,5
	BIT	7,B
	JR	Z,PROCB		;Numeric
	LD	E,C
	INC	DE
PROCB:	ADD	HL,DE
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	INC	HL		; BC = marker ?
	EX	DE,HL
	LD	HL,LOCCHK
	OR	A
	SBC	HL,BC
	EX	DE,HL
	JR	Z,PROC7		;Another
	POP	HL
	POP	DE
;
PROC5:	LD	(HL),E		;SAVE "RETURN ADDRESS"
	INC	HL
	LD	A,(HL)
	LD	(HL),D
	CP	TON		;WAS IT "ON PROC" ?
	JR	NZ,XEQGO
	PUSH	DE
	EX	(SP),IY
	CALL	SPAN		;SKIP REST OF ON LIST
	EX	(SP),IY
	POP	DE
	LD	(HL),D
	DEC	HL
	LD	(HL),E
XEQGO:	JP	XEQ
;
LOCERR:	INC	IY
	JR	XEQGO
;
;LOCAL DATA
;
LOCDAT:	INC	IY
	LD	HL,(DATPTR)
	PUSH	HL
	LD	A,40H
	PUSH	AF
	LD	HL,DATPTR
	PUSH	HL
	LD	HL,LOCCHK
	PUSH	HL
	JR	XEQGO
;
;LOCAL var[,var...]
;
LOCAL:	CP	TERROR
	JR	Z,LOCERR
	CP	TDATA
	JR	Z,LOCDAT
	POP	BC
	PUSH	BC
	LD	HL,FNCHK
	OR	A
	SBC	HL,BC
	JR	Z,LOCAL1
	LD	HL,PROCHK
	OR	A
	SBC	HL,BC
	JR	Z,LOCAL1
	LD	HL,LOCCHK
	OR	A
	SBC	HL,BC
	JR	Z,LOCAL1
	LD	HL,ARRCHK
	OR	A
	SBC	HL,BC
	JR	Z,LOCAL1
	LD	HL,RETCHK
	OR	A
	SBC	HL,BC
	LD	A,12
	JP	NZ,ERROR	;"Not LOCAL"
LOCAL1:	PUSH	IY
	POP	BC
	EXX
	DEC	IY
	CALL	SAVLOC
	EXX
	PUSH	BC
	POP	IY
LOCAL2:	CALL	GETVAR
	JP	NZ,SYNTAX
	BIT	6,A		;ARRAY?
	JR	NZ,LOCAL4
	OR	A		;TYPE
	EX	AF,AF'
	CALL	ZERO
	EX	AF,AF'
	PUSH	AF
	CALL	P,STOREN	;ZERO
	POP	AF
	LD	E,C
	CALL	M,STORES
LOCAL3:	CALL	NLIST
	JR	LOCAL2
;
LOCAL4:	LD	(IX+0),1	;FLAG LOCAL ARRAY
	LD	(IX+1),0
	JR	LOCAL3
;
;ENDPROC
;
ENDPRO:	POP	BC
	LD	HL,PROCHK	;PROC MARKER
	XOR	A
	SBC	HL,BC
	JR	Z,ENDPR1
	PUSH	BC		;PUT BACK
	CALL	RESLOC
	JR	NZ,ENDPRO
	LD	A,13
	JP	ERROR		;"No PROC"
;
ENDPR1:	POP	IY
	JP	XEQ
;
;INPUT #channel,var,var...
;
INPUTN:	CALL	CHNL		;E = CHANNEL NUMBER
INPN1:	CALL	NLIST
	PUSH	DE
	CALL	VAR
	POP	DE
	PUSH	AF		;SAVE TYPE
	PUSH	HL		;VARPTR
	OR	A
	JP	M,INPN2		;STRING
	CALL	OSBGET
	EXX
	LD	L,A
	EXX
	CALL	OSBGET
	EXX
	LD	H,A
	EXX
	CALL	OSBGET
	LD	L,A
	CALL	OSBGET
	LD	H,A
	CALL	OSBGET
	LD	C,A
	POP	IX
	POP	AF		;RESTORE TYPE
	PUSH	DE		;SAVE CHANNEL
	CALL	STOREN
	POP	DE
	JR	INPN1
INPN2:	LD	HL,ACCS
INPN3:	CALL	OSBGET
	CP	CR
	JR	Z,INPN4
	LD	(HL),A
	INC	L
	JR	NZ,INPN3
INPN4:	POP	IX
	POP	AF
	PUSH	DE
	EX	DE,HL
	CALL	STACCS
	POP	DE
	JR	INPN1
;
;INPUT ['][SPC(x)][TAB(x[,y])]["prompt",]var[,var...]
;INPUT LINE [SPC(x)][TAB(x[,y])]["prompt",]var[,var...]
;
INPUT:	CP	'#'
	JR	Z,INPUTN
	LD	C,0		;FLAG PROMPT
	CP	TLINE
	JR	NZ,INPUT0
	INC	IY		;SKIP "LINE"
	LD	C,80H
INPUT0:	LD	HL,BUFFER
	LD	(HL),CR		;INITIALISE EMPTY
INPUT1:	CALL	TERMQ
	JP	Z,XEQ		;DONE
	INC	IY
	CP	','
	JR	Z,INPUT3	;SKIP COMMA
	CP	';'
	JR	Z,INPUT3
	PUSH	HL		;SAVE BUFFER POINTER
	CP	'"'
	JR	NZ,INPUT6
	PUSH	BC
	CALL	CONS
	POP	BC
	CALL	PTEXT		;PRINT PROMPT
	JR	INPUT9
INPUT6:	CALL	FORMAT		;SPC, TAB, '
	JR	NZ,INPUT2
INPUT9:	POP	HL
	SET	0,C		;FLAG NO PROMPT
	JR	INPUT0
INPUT2:	DEC	IY
	PUSH	BC
	CALL	VAR
	POP	BC
	POP	HL
	PUSH	AF		;SAVE TYPE
	LD	A,(HL)
	INC	HL
	CP	CR		;BUFFER EMPTY?
	CALL	Z,REFILL
	BIT	7,C
	PUSH	AF
	CALL	NZ,LINES
	POP	AF
	CALL	Z,FETCHS
	POP	AF		;RESTORE TYPE
	PUSH	BC
	PUSH	HL
	OR	A
	JP	M,INPUT4	;STRING
	PUSH	AF
	PUSH	IX
	CALL	VAL0
	POP	IX
	POP	AF
	CALL	STOREN
	JR	INPUT5
INPUT4:	CALL	STACCS
INPUT5:	POP	HL
	POP	BC
INPUT3:	RES	0,C
	JR	INPUT1
;
REFILL:	BIT	0,C
	JR	NZ,REFIL0	;NO PROMPT
	LD	A,'?'
	CALL	OUTCHR		;PROMPT
	LD	A,' '
	CALL	OUTCHR
REFIL0:	LD	HL,BUFFER
	PUSH	BC
	PUSH	HL
	PUSH	IX
	CALL	OSLINE
	POP	IX
	POP	HL
	POP	BC
	LD	B,A		;POS AT ENTRY
	XOR	A
	LD	(COUNT),A
	CP	B
	RET	Z
REFIL1:	LD	A,(HL)
	CP	CR
	RET	Z
	INC	HL
	DJNZ	REFIL1
	RET
;
;READ var[,var...]
;
READ:	CP	'#'
	JP	Z,INPUTN
	LD	HL,(DATPTR)
READ0:	LD	A,(HL)
	CP	':'
	CALL	Z,REFIL1
	INC	HL		;SKIP COMMA OR "DATA"
	CP	CR		;END OF DATA STMT?
	CALL	Z,GETDAT
	PUSH	HL
	CALL	VAR
	POP	HL
	OR	A
	JP	M,READ1		;STRING
	PUSH	HL
	EX	(SP),IY
	PUSH	AF		;SAVE TYPE
	PUSH	IX
	CALL	EXPRN
	POP	IX
	POP	AF
	CALL	STOREN
	EX	(SP),IY
	JR	READ2
READ1:	CALL	FETCHS
	PUSH	HL
	CALL	STACCS
READ2:	POP	HL
	LD	(DATPTR),HL
	CALL	NLIST
	JR	READ0
;
GETDAT:	CALL	DSRCH
	INC	HL
	RET	NC
	LD	A,42
	JR	ERROR4		;"Out of DATA"
;
;IF expr statement
;IF expr THEN statement [ELSE statement]
;IF expr THEN line [ELSE line]
;IF expr THEN
;
IF:	CALL	EXPRI
	CALL	TEST
	JR	Z,IFNOT		;FALSE
	LD	A,(IY)
	CP	TTHEN
	JP	NZ,XEQ
IF0:	INC	IY		;SKIP "THEN"
	LD	A,(IY)
	CP	';'
	JR	Z,IF0
IF1:	CALL	NXT
	CP	TLINO
	JP	NZ,XEQ		;STATEMENT FOLLOWS
	JP	GOTO		;LINE NO. FOLLOWS
;
IFELSE:	LD	A,(IY)
	INC	IY
	CP	';'
	JR	NZ,IFNEXT
	JR	IFTHEN
;
IF2:	CALL	QUOTE		;SKIP STRING
IFNOT:	LD	A,(IY)
	INC	IY
IFNEXT:	CP	'"'
	JR	Z,IF2		;QUOTED STRING
	CP	TREM
	JP	Z,REM		;REM
	CP	CR
	JP	Z,XEQ0		;END OF LINE
	CP	TELSE
	JR	Z,IF1		;ELSE CLAUSE
	CP	TTHEN
	JR	NZ,IFNOT	;TRY FOR END AGAIN
IFTHEN:	LD	A,(IY)
	CP	CR
	JR	NZ,IFELSE
	LD	BC,TELSE
	LD	DE,TENDIF*256+TTHEN
	INC	IY
	CALL	NSCAN
	JP	Z,XEQ1
NENDIF:	LD	A,49
ERROR4:	JP	ERROR		;"Missing ENDIF"
;
; ELSE (multi-line)
;
MELSE:	LD	BC,-3
	ADD	IY,BC
	LD	BC,TENDIF
	LD	DE,TENDIF*256+TTHEN
	CALL	NSCAN
	JP	Z,XEQ
	JR	NENDIF
;
; WHEN and OTHERWISE:
;
WHEN:	LD	BC,-3
	ADD	IY,BC
	LD	BC,TENDCASE
	LD	DE,TENDCASE*256+TOF
	CALL	NSCAN
	JP	Z,XEQ
	LD	A,47
	JR	ERROR4		;"Missing ENDCASE"
;
; CASE
;
CASE:	CALL	EXPR		;String or numeric
	EX	AF,AF'
	LD	B,0		;Flag numeric
	JP	P,CASE6		;numeric
	CALL	PUSHS		;put string on stack
	POP	BC		;C = length
	LD	B,1		;Flag string
CASE6:	LD	A,(IY)
	INC	IY
	CP	TOF
	LD	A,37
	JR	NZ,ERROR4	;"Missing OF"
	LD	A,(IY)
	INC	IY		;Address line-length byte
	CP	CR
	LD	A,48
	JR	NZ,ERROR4	;"OF not last"
CASE1:	XOR	A		;Level
CASE0:	EXX
	PUSH	HL		;Push to stack
	EXX
	PUSH	HL
	PUSH	BC
	LD	L,A		;Level
	LD	BC,TOTHERWISE*256+TWHEN
 	LD	DE,TENDCASE*256+TOF
	CALL	NSCAN1
	POP	BC		;Restore from stack
	POP	HL
	EXX
	POP	HL
	EXX
	LD	A,47
	JP	NZ,ERROR	;Missing ENDCASE
	LD	A,(IY-1)
	CP	TENDCASE
	JR	Z,CASE9
	CP	TOTHERWISE
	JR	Z,CASE9
CASE4:	BIT	0,B		;Numeric or string?
	JR	NZ,CASE3
	PUSH	BC		;Type/exponent/length 
	PUSH	HL		;MS 32 bits
	EXX
	PUSH	HL		;LS 32 bits
	EXX
	CALL	EXPRN
	LD	IX,0
	ADD	IX,SP		;Address stack
	EXX
	LD	E,(IX+0)	;Get LS 32-bits
	LD	D,(IX+1)
	EXX
	LD	E,(IX+2)
	LD	D,(IX+3)	;Get MS 32-bits
	LD	B,(IX+4)	;Get exponent
	LD	A,9
	CALL	FPP		;In case integer vs float
	LD	A,L
	OR	A		;NZ if equal
	EXX
	POP	HL
	EXX
	POP	HL
	POP	BC
	JR	NZ,CASE5	;Match found
CASE2:	LD	A,(IY)
	INC	IY
	CP	','
	JR	Z,CASE4		;Not found, try another
	EXX
	PUSH	IY
	EX	(SP),HL
	LD	A,CR
	LD	B,A
	CPIR			;Find CR
	EX	(SP),HL
	POP	IY
	EXX
	LD	A,(IY-2)	;Last token in previous line
	CP	TOF		;CASE statement in WHEN line
	JR	NZ,CASE1
	LD	A,1
	JR	CASE0
;
;Finished, level stack if string:
;
CASE9:	BIT	0,B
	JR	Z,CASE8
	LD	H,0
	LD	L,C
	ADD	HL,SP
	LD	SP,HL
CASE8:	JP	XEQ
;
;Matched, so skip any more expressions:
;
CASE5:	CALL	NXT
	CP	','
	JR	NZ,CASE9	;End of list
	INC	IY
	PUSH	BC		;Save type and string length
	CALL	EXPR		;Evaluate but discard
	POP	BC
	JR	CASE5
;
;String compare:
;
CASE3:	PUSH	BC
	CALL	EXPRS
	POP	BC
	LD	HL,0
	ADD	HL,SP
	LD	B,E
	LD	DE,ACCS
	PUSH	BC
	CALL	SCP		;String compare
	POP	BC
	LD	B,1
	JR	NZ,CASE2
	JR	CASE5
;
; WHILE
;
WHILE:	PUSH	IY		;Save current position
	CALL	CHECK
	CALL	WHICHK		;Push marker
WHICHK:	CALL	EXPRI
	CALL	TEST
	JR	NZ,XEQGO5
	POP	BC		;Pop marker
	POP	BC		;Level stack
	LD	BC,TWHILE+TENDWHILE*256
	LD	D,1
	CALL	WSRCH
XEQGO5:	JP	XEQ
;
; ENDWHILE
;
ENDWHI:	POP	BC		;Marker
	POP	DE		;Saved text pointer
	PUSH	DE
	PUSH	BC
	OR	A
	LD	HL,WHICHK
	SBC	HL,BC
	JR	Z,ENDWH1
	LD	A,3
	CALL	RESLOC
	JR	NZ,ENDWHI
	LD	A,46
	JR	ERROR5		;"Not in a WHILE loop"
;
ENDWH1:	PUSH	IY
	LD	IY,0
	ADD	IY,DE
	CALL	EXPRI
	CALL	TEST
	POP	DE		;Text pointer
	JR	NZ,XEQGO5
	POP	BC		;Junk marker
	POP	BC		;Junk pointer
	LD	IY,0
	ADD	IY,DE
	JR	XEQGO5
;
;CLS
;
CLS:	CALL	CLRSCN
	XOR	A
	LD	(COUNT),A
	JP	XEQ
;
;STOP
;
STOP:	CALL	TELL
	DEFB	CR
	DEFB	LF
	DEFB	TSTOP
	DEFB	0
	CALL	SETLIN		;FIND CURRENT LINE
	CALL	SAYLN
	CALL	CRLF
	JP	CLOOP
;
;REPORT
;
REPOR:	CALL	REPORT
	JP	XEQ
;
;CLEAR
;
CLR:	CALL	CLEAR
	LD	HL,(PAGE)
	JR	RESTR1
;
;RESTORE ERROR
;
RESERR:	INC	IY
	LD	A,2
	CALL	RESLOC
	JP	NZ,XEQ
	LD	A,53		;ON ERROR not LOCAL
ERROR5:	JP	ERROR
;
;RESTORE DATA
;
RESDAT:	INC	IY
	LD	A,1
	CALL	RESLOC
	JP	NZ,XEQ
	LD	A,54		;'DATA not LOCAL'
	DEFB	21H
NOLINE:	LD	A,41		;'No such line'
	JR	ERROR5
;
;RESTORE [line]
;
RESTOR:	CP	TERROR
	JR	Z,RESERR
	CP	TDATA
	JR	Z,RESDAT
	CP	'+'
	JR	Z,RESREL
	LD	HL,(PAGE)
	CALL	TERMQ
	JR	Z,RESTR1
	CALL	ITEMI
	EXX
	CALL	FINDL		;SEARCH FOR LINE
	JR	NZ,NOLINE
RESTR1:	CALL	DSRCH
	LD	(DATPTR),HL
	JP	XEQ
;
RESREL:	CALL	EXPRI
	EXX
	EX	DE,HL
	PUSH	IY
	POP	HL
	LD	A,CR
	LD	B,A
	CPIR			;FIND LINE END
	DEC	E
	JR	Z,RESTR1
	JP	M,RESTR1
	XOR	A
	LD	B,A
RESTR2:	LD	C,(HL)
	CP	C
	JR	Z,NOLINE
	ADD	HL,BC
	DEC	E
	JR	NZ,RESTR2
	JR	RESTR1
;
;PTR#channel=expr
;PAGE=expr
;TIME=expr
;LOMEM=expr
;HIMEM=expr
;
PTR:	CALL	CHANEL
	CALL	EQUALS
	LD	A,E
	PUSH	AF
	CALL	EXPRI
	PUSH	HL
	EXX
	POP	DE
	POP	AF
	CALL	PUTPTR
	JR	XEQGO1
;
PAGEV:	CALL	EQUALS
	CALL	EXPRI
	EXX
	LD	L,0
	LD	(PAGE),HL
	JR	XEQGO1
;
TIMEV:	CP	'$'
	JR	Z,TIMEVS
	CALL	EQUALS
	CALL	EXPRI
	PUSH	HL
	EXX
	POP	DE
	CALL	PUTIME
	JR	XEQGO1
;
TIMEVS:	INC	IY		;SKIP '$'
	CALL	EQUALS
	CALL	EXPRS
	CALL	PUTIMS
	JR	XEQGO1
;
LOMEMV:	CALL	EQUALS
	CALL	EXPRI
	CALL	CLEAR
	EXX
	LD	(LOMEM),HL
	LD	(FREE),HL
	JR	XEQGO1
;
HIMEMV:	CALL	EQUALS
	CALL	EXPRI
	EXX
	LD	DE,(FREE)
	INC	D
	XOR	A
	SBC	HL,DE
	ADD	HL,DE
	JP	C,ERROR		;"No room"
	LD	DE,(HIMEM)
	LD	(HIMEM),HL
	EX	DE,HL
	SBC	HL,SP
	JP	NZ,XEQ
	EX	DE,HL
	LD	SP,HL		;LOAD STACK POINTER
XEQGO1:	JP	XEQ
;
;WIDTH expr
;
WIDTHV:	CALL	EXPRI
	EXX
	LD	A,L
	LD	(WIDTH),A
	JR	XEQGO1
;
;TRACE ON
;TRACE OFF
;TRACE line
;
TRACE:	INC	IY
	LD	HL,0
	CP	TON
	JR	Z,TRACE0
	CP	TOFF
	JR	Z,TRACE1
	DEC	IY
	CALL	EXPRI
	EXX
TRACE0:	DEC	HL
TRACE1:	LD	(TRACEN),HL
	JR	XEQGO1
;
;VDU expr,expr;....
;
VDU:	CALL	EXPRI
	EXX
	LD	A,L
	CALL	OSWRCH
	LD	A,(IY)
	CP	','
	JR	Z,VDU2
	CP	';'
	JR	NZ,VDU3
	LD	A,H
	CALL	OSWRCH
VDU2:	INC	IY
VDU3:	CALL	TERMQ
	JR	NZ,VDU
	JR	XEQGO1
;
;CLOSE channel number
;
CLOSE:	CALL	CHANEL
	CALL	OSSHUT
	JR	XEQGO1
;
;BPUT #channel,byte
;BPUT #channel,string[;]
;
BPUT:	CALL	CHANEL		;CHANNEL NUMBER
	PUSH	DE
	CALL	COMMA
	CALL	EXPR
	EX	AF,AF'
	JP	M,BPUTS
	CALL	SFIX
	EXX
	LD	A,L
	POP	DE
	CALL	OSBPUT
BPUTX:	JR	XEQGO1
;
BPUTS:	LD	A,E
	POP	DE
	LD	D,A
	LD	HL,ACCS
BPUTS1:	LD	A,(HL)
	INC	HL
	CALL	OSBPUT
	DEC	D
	JR	NZ,BPUTS1
	CALL	NXT
	CP	';'
	INC	IY
	JR	Z,BPUTX
	LD	A,LF
	CALL	OSBPUT
	DEC	IY
	JR	BPUTX
;
;CALL address[,var[,var...]]
;
CALL:	CALL	EXPRI		;ADDRESS
	EXX
	PUSH	HL		;SAVE IT
	LD	B,0		;PARAMETER COUNTER
	LD	DE,BUFFER	;VECTOR
CALL1:	CALL	NXT
	CP	','
	JR	NZ,CALL2
	INC	IY
	INC	B
	CALL	NXT
	PUSH	BC
	PUSH	DE
	CALL	VAR
	POP	DE
	POP	BC
	INC	DE
	LD	(DE),A		;PARAMETER TYPE
	INC	DE
	EX	DE,HL
	LD	(HL),E		;PARAMETER ADDRESS
	INC	HL
	LD	(HL),D
	EX	DE,HL
	JR	CALL1
CALL2:	LD	A,B
	LD	(BUFFER),A	;PARAMETER COUNT
	POP	HL		;RESTORE ADDRESS
	CALL	USR1
	JP	XEQ
;
;USR(address)
;
USR:	CALL	ITEMI
	EXX
USR1:	PUSH	HL		;ADDRESS ON STACK
	EX	(SP),IY
	INC	H		;PAGE &FF?
	LD	HL,USR2		;RETURN ADDRESS
	PUSH	HL
	LD	IX,STAVAR
	CALL	Z,OSCALL	;INTERCEPT PAGE &FF
	LD	C,(IX+24)
	PUSH	BC
	POP	AF		;LOAD FLAGS
	LD	A,(IX+4)	;LOAD Z80 REGISTERS
	LD	B,(IX+8)
	LD	C,(IX+12)
	LD	D,(IX+16)
	LD	E,(IX+20)
	LD	H,(IX+32)
	LD	L,(IX+48)
	LD	IX,BUFFER
	JP	(IY)		;OFF TO USER ROUTINE
USR2:	POP	IY
	XOR	A
	LD	C,A
	RET
;
; LEFT$(A$[,N]) = string
; MID$(A$,N[,M]) = string
; RIGHT$(A$[,N]) = string
;
LEFTSL: CALL    GETSTR
	LD	HL,0FF00H	;Default all but last
	JR	NZ,MIDSL1
	JR	MIDSL0
;
RITESL: CALL	GETSTR
	LD	HL,0FFFFH	;Default last char only
	JR	NZ,MIDSL1
	JR	MIDSL0
;
MIDSL:	CALL	GETSTR
	LD	A,5
	JP	NZ,ERROR	;'Missing comma'
	INC	IY
	PUSH	IX
	CALL	EXPRI
	POP	IX
	EXX
	CALL	NXT
	DEC	L
	LD	H,254		;Default rest of string
	CP	','
	JR	NZ,MIDSL1
MIDSL0:	INC	IY
	PUSH	HL
	PUSH	IX
	CALL	EXPRI
	POP	IX
	EXX
	LD	A,L
	POP	HL
	OR	A
	JR	Z,MIDSL2	;Zero length
	DEC	A
	ADD	A,L
	LD	H,A
	JR	NC,MIDSL1
	LD	A,L
	INC	A
	JR	Z,MIDSL1
	LD	H,254
	JR	MIDSL1
;
MIDSL2:	LD	HL,1
MIDSL1:	CALL	BRAKET
	CALL	EQUALS
	PUSH	HL
	PUSH	IX
	CALL	EXPRS
	POP	IX
	POP	HL
	LD	C,E
	LD	B,(IX+0)
	LD	E,(IX+2)
	LD	D,(IX+3)
;
; Source string at ACCS, length C
; Destination string at DE, length B
; L = first character to modify 0-254
; H =  last character to modify 0-254
; IF L=255 THEN modify rightmost H + 2 chars
; ELSE IF H=255 modify all but last character
; ELSE IF L > H do nothing
; IX = destination VARPTR
;
	LD	A,L
	INC	A
	JR	NZ,SUBSL1
	INC	H
	INC	H
	LD	A,C
	CP	H
	JR	NC,SUBSL0
	LD	H,A
SUBSL0:	LD	A,B
	SUB	H
	JR	NC,SUBSL6
	XOR	A
SUBSL6:	LD	L,A
	JR	SUBSL5
;
SUBSL1:	LD	A,H
	INC	A
	JR	NZ,SUBSL2
	LD	A,B
	SUB	2
	JR	C,SUBSL9
	LD	H,A
SUBSL2:	LD	A,L
	CP	B
	JR	NC,SUBSL9
	LD	A,H
	CP	B
	JR	C,SUBSL3
SUBSL5:	LD	A,B
	DEC	A
	LD	H,A
SUBSL3:	LD	A,H
	SUB	L
	JR	C,SUBSL9
	INC	A
	CP	C
	JR	C,SUBSL4
	LD	A,C
SUBSL4:	LD	B,0
	LD	H,B
	LD	C,A
	OR	A
	JR	Z,SUBSL9
	EX	DE,HL
	ADD	HL,DE
	EX	DE,HL
	LD	HL,ACCS
	LDIR
SUBSL9:	JP	XEQ
;
; EXIT FOR [var]
; EXIT REPEAT
; EXIT WHILE
;
EXIT:	INC	IY		;Skip FOR/REPEAT/WHILE
	CP	TFOR
	JR	NZ,EXIT0
	LD	IX,0		;For EXIT FOR <var>
	CALL	TERMQ
	CALL	NZ,GETVAR
	LD	A,TFOR
EXIT0:	LD	D,1		;Level for WSRCH
	LD	E,A
EXIT1:	LD	A,E
	POP	BC		;Marker
	LD	HL,FORCHK
	OR	A
	SBC	HL,BC
	JR	Z,EXIT4
	LD	HL,REPCHK
	OR	A
	SBC	HL,BC
	JR	Z,EXIT6
	LD	HL,WHICHK
	OR	A
	SBC	HL,BC
	JR	Z,EXIT7
	PUSH	BC		;Put back marker
	PUSH	IX
	POP	BC
	EXX
	LD	A,3
	CALL	RESLOC
	EXX
	PUSH	BC
	POP	IX
	JR	NZ,EXIT1
	LD	A,44
	JP	ERROR		;'Bad EXIT'
;
EXIT4:	POP	BC		;VARPTR
	LD	HL,14		;Skip text pointer, limit & step
	ADD	HL,SP
	LD	SP,HL		;Pop FOR record
	CP	TFOR
	JR	NZ,EXIT1
	PUSH	IX
	POP	HL
	LD	A,H
	OR	L
	JR	Z,EXIT5
	SBC	HL,BC
EXIT5:	LD	BC,TFOR+TNEXT*256
	JR	Z,EXIT8
	INC	D		;Count nested FOR loops
	JR	EXIT1
;
EXIT6:	POP	BC		;Text pointer
	CP	TREPEAT
	JR	NZ,EXIT1
	LD	BC,TREPEAT+TUNTIL*256
	JR	EXIT8
;
EXIT7:	POP	BC		;Text pointer
	CP	TWHILE
	JR	NZ,EXIT1
	LD	BC,TWHILE+TENDWHILE*256
EXIT8:	CALL	WSRCH
	CALL	SPAN		;Skip UNTIL expression
	JP	XEQ
;
;PUT port,data
;
PUT:	CALL	EXPRI		;PORT ADDRESS
	EXX
	PUSH	HL
	CALL	COMMA
	CALL	EXPRI		;DATA
	EXX
	POP	BC
	OUT	(C),L		;OUTPUT TO PORT BC
	JP	XEQ
;
;SUBROUTINES:
;
;ASSIGN - Assign a numeric value to a variable.
;Outputs: NC,  Z     - OK, numeric scalar
;         NC, NZ, PE - OK, string array  (D = type, E = operator)
; else if NC, NZ, P  - OK, numeric array (D = type, E = operator)
; else if NC, NZ     - OK, string scalar
;          C, NZ     - illegal / invalid
;
ASSIGN:	CALL	GETVAR		;VARIABLE
	RET	C		;ILLEGAL VARIABLE
	CALL	NZ,PUTVAR
	LD	D,A		;Type
	CALL	NXT
	INC	IY
	LD	E,A		;Operator (or =)
	CP	'='
	CALL	NZ,EQUALS
	LD	A,D
	AND	11000000B	
	RET	NZ		;String or array
	PUSH	DE
	PUSH	HL
	CALL	EXPRN
	POP	IX
	POP	DE
;
; Falls through to...
;
; MODIFY - Update numeric variable according to operator:
;   Inputs: D = type
;           E = operator
;           HLH'L'C = value
;           IX = destination VARPTR
; Destroys: Everything except IX,IY,SP
; 
MODIFY:	LD	A,E
	CP	'='
	JR	Z,STORE0	;Simple assignment
	PUSH	DE
	EXX
	EX	DE,HL
	EXX
	EX	DE,HL
	LD	B,C
	EX	(SP),HL
	LD	A,H
	EX	(SP),HL
	CALL	LOADN
	EX	(SP),HL
	LD	A,L
	EX	(SP),HL
	AND	15
	PUSH	IX
	CALL	FPP
	POP	IX
	POP	DE
	JP	C,ERROR
STORE0:	LD	A,D		;Type
STOREN:	CP	5
	JR	Z,STORE5
	PUSH	AF
	INC	C		;SPEED - & PRESERVE F'
	DEC	C		; WHEN CALLED BY FNEND0
	CALL	NZ,SFIX		;CONVERT TO INTEGER
	POP	AF
	CP	4
	JR	Z,STORE4
	CP	A		;SET ZERO
STORE1:	EXX
	LD	(IX+0),L
	EXX
	RET
;
STORE5:	LD	(IX+4),C
STORE4:	EXX
	LD	(IX+0),L
	LD	(IX+1),H
	EXX
	LD	(IX+2),L
	LD	(IX+3),H
	RET
;
; MODIFS - Update string variable according to operator:
;   Inputs: H = type
;           L = operator (= or +)
;           E = string length (string in accumulator)
;           IX = destination VARPTR
; Destroys: Everything except SP, IY
;
MODIFS:	LD	A,L		;Operator
	CP	'+'
	LD	A,H		;Type
	JR	NZ,STACCS
	PUSH	IY
	PUSH	IX
	POP	IY
	CALL	PUSHS
	PUSH	IY
	POP	IX
	CALL	LOADS
	POP	BC
	LD	A,B		;Type
	INC	C
	DEC	C
	JR	Z,MODFS1	;Zero length
	LD	HL,0
	LD	B,H
	ADD	HL,SP
	LDIR
	LD	SP,HL
MODFS1:	POP	IY
;
; Falls through to:
;
STACCS:	LD	HL,ACCS
STORES:	RRA
	JR	NC,STORS3	;FIXED STRING
	PUSH	HL
	CALL	LOAD4
	LD	A,E		;LENGTH OF STRING
	EXX
	LD	L,A
	LD	A,H		;LENGTH ALLOCATED
	EXX
	CP	E
	JR	NC,STORS1	;ENOUGH ROOM
	EXX
	LD	H,L
	EXX
	PUSH	HL
	LD	B,0
	LD	C,A
	ADD	HL,BC
	LD	BC,(FREE)
	SBC	HL,BC		;IS STRING LAST?
	POP	HL
	JR	Z,STORS0
	LD	H,B
	LD	L,C		;DESTINATION
;
	OR	A		;V5 optimisation
	JR	Z,STORS0
	LD	A,E
STORS2:	LD	E,A
	DEC	E
	AND	E
	JR	NZ,STORS2
	SCF
	RL	E
	LD	A,E
	EXX
	LD	H,A
	EXX
;
STORS0:	SCF
STORS1:	CALL	STORE4		;PRESERVES CARRY!
	LD	B,0
	LD	C,E
	EX	DE,HL
	POP	HL
	DEC	C
	INC	C
	RET	Z		;NULL STRING
	LDIR
	RET	NC		;STRING REPLACED
	LD	(FREE),DE
CHECK:	PUSH	HL
	LD	HL,(FREE)
	INC	H
	SBC	HL,SP
	POP	HL
	RET	C
	XOR	A
	JP	ERROR		;"No room"
;
STORS3:	LD	C,E
	PUSH	IX
	POP	DE
	XOR	A
	LD	B,A
	CP	C
	JR	Z,STORS5
	LDIR
STORS5:	LD	A,CR
	LD	(DE),A
	RET
;
; SAVRET - SAVE 'RETURNed' PARAMETER INFO
;
SAVRET:	LD	(IX+0),L		;Formal VARPTR
	LD	(IX+1),H
	LD	(IX+2),A
	EX	(SP),IY
	PUSH	AF
	PUSH	IY
	PUSH	IX
	CALL	NXT
	CALL	VAR
	POP	IX
	LD	(IX+4),L		;Actual VARPTR
	LD	(IX+5),H
	LD	(IX+6),A
	POP	IY
	POP	AF
	LD	BC,8
	ADD	IX,BC
	JR	ARGUE0
;
;ARGUE: TRANSFER FN OR PROC ARGUMENTS FROM THE
; CALLING STATEMENT TO THE DUMMY VARIABLES VIA
; THE STACK.  IT MUST BE DONE THIS WAY TO MAKE
; PROCFRED(A,B)    DEF PROCFRED(B,A)     WORK.
;   Inputs: DE addresses parameter list 
;           IY addresses dummy variable list
;           IX addresses RETURNed parameter data block
;  Outputs: DE,IY updated
; Destroys: Everything
;
ARGUE:	LD	A,-1
	PUSH	AF		;PUT MARKER ON STACK
ARGUE1:	INC	IY		;BUMP PAST ( OR ,
	INC	DE
	PUSH	DE
	LD	B,0
	CALL	NXT
	CP	TRETURN
	JR	NZ,ARGUE9
	INC	IY		;SKIP 'RETURN'
	CALL	NXT
	INC	B		;FLAG 'RETURN'
ARGUE9:	PUSH	BC
	PUSH	IX
	CALL	GETVAR		;FORMAL PARAMETER
	JR	C,ARGERR
	CALL	NZ,PUTVAR
	POP	IX
	POP	BC
	POP	DE
	PUSH	HL		;VARPTR
	PUSH	AF
	PUSH	DE
	DEC	B
	JR	Z,SAVRET
	EX	(SP),IY
ARGUE0:	BIT	6,A		;ARRAY?
	JR	NZ,ARGUE3
	OR	A		;TYPE
	JP	M,ARGUE2	;STRING
	PUSH	IX
	CALL	EXPRN		;ACTUAL PARAMETER
	POP	IX
	EX	(SP),IY
	POP	DE
	POP	AF
	EXX
	PUSH	HL
	EXX
	PUSH	HL
	LD	B,A
	PUSH	BC
	JR	ARGUE4
;
ARGUE2:	PUSH	IX
	CALL	EXPRS
	EXX
	POP	BC
	EX	(SP),IY
	POP	DE
	EXX
	POP	AF
	CALL	PUSHS
	EXX
	PUSH	BC
	POP	IX
ARGUE4:	CALL	NXT
	CP	','
	JR	NZ,ARGUE5
	LD	A,(DE)
	CP	','
	JR	Z,ARGUE1	;ANOTHER
ARGERR:	LD	A,31
	JP	ERROR		;"Bad arguments"
;
ARGUE3:	PUSH	IX
	CALL	NXT
	CALL	GETVAR
	JR	C,ARGERR
	LD	C,(IX+0)
	LD	B,(IX+1)
	POP	IX
	CALL	NXT
	EX	(SP),IY
	POP	DE
	POP	AF
	PUSH	BC		;STACK ARRAY POINTER
	PUSH	AF		;STACK TYPE
	JR	ARGUE4
;
ARGUE5:	CALL	BRAKET
	LD	A,(DE)
	CP	')'
	JR	NZ,ARGERR
	INC	DE
UNSTAK:	EXX
ARGUE6:	POP	BC
	LD	A,B
	INC	A
	EXX
	RET	Z		;MARKER POPPED
	EXX
	DEC	A
	BIT	6,A		;ARRAY
	JR	NZ,ARGUE8
	OR	A
	JP	M,ARGUE7	;STRING
	POP	HL
	EXX
	POP	HL
	EXX
	POP	IX
	CALL	STOREN		;WRITE TO DUMMY
	JR	ARGUE6
;
ARGUE7:	CALL	POPS
	POP	IX
	CALL	STACCS
	JR	ARGUE6
;
ARGUE8:	POP	BC		;ARRAY POINTER
	POP	IX
	LD	(IX+0),C
	LD	(IX+1),B
	JR	ARGUE6
;
;Restore RETURNed parameters, via the stack to ensure that
; PROCFRED(A,B)    DEF PROCFRED(RETURN B,RETURN A)  works.
;
RETXFR:	LD	A,-1
	PUSH	AF		;PUT MARKER ON STACK
RETXF1:	EXX
	LD	L,(IX+4)	;Actual parameter (destination)
	LD	H,(IX+5)
	PUSH	HL		;STACK VARPTR
	LD	L,(IX+0)	;Formal parameter (source)
	LD	H,(IX+1)
	LD	A,(IX+2)
	BIT	6,A		;ARRAY?
	JR	NZ,RETXF3
	OR	A		;TYPE
	JP	M,RETXF2	;STRING
	PUSH	HL
	EX	(SP),IX
	CALL	LOADN
	POP	IX
	EXX			;STACK VALUE
	PUSH	HL
	EXX
	PUSH	HL
RETXF6:	LD	B,(IX+6)
	PUSH	BC		;TYPE & EXPONENT
RETXF5:	CALL	CHECK		;CHECK ROOM
	JR	RETXF4
;
RETXF3:	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	PUSH	DE		;STACK ARRAY POINTER
	JR	RETXF6
;
RETXF2:	PUSH	HL
	EX	(SP),IX
	CALL	LOADS
	POP	IX
	LD	A,(IX+6)
	EXX
	PUSH	IX
	POP	HL
	EXX
	CALL	PUSHS
	EXX
	PUSH	HL
	POP	IX
	EXX
RETXF4:	LD	DE,8
	ADD	IX,DE
	EXX
	DJNZ	RETXF1
	JP	UNSTAK
;
;Restore 'RETURNed' parameters, 
;
RESRET:	POP	BC		;B = 'RETURN' COUNT
	LD	H,0
	LD	L,B
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL		;RETURN COUNT * 8
	ADD	HL,SP
	LD	IX,0
	ADD	IX,SP		;ADDRESS PARAMETER LIST
	PUSH	AF
	PUSH	DE
	PUSH	HL
	EXX
	PUSH	BC
	PUSH	DE
	EXX
	LD	A,B
	LD	HL,ACCS
	LD	DE,BUFFER
	LD	BC,255
	LDIR
	LD	B,A
	CALL	RETXFR		;TRANSFER VIA STACK
	LD	HL,BUFFER
	LD	DE,ACCS
	LD	BC,255
	LDIR
	EXX
	POP	DE
	POP	BC
	EXX
	POP	HL
	POP	DE
	POP	AF
	JR	RESAR1
;
; Restore LOCAL array or memory block:
;
RESARR:	POP	BC
	BIT	7,B		;String array?
	POP	HL
	POP	BC
	ADD	HL,BC
	ADD	HL,SP
	CALL	NZ,FREESA	;Free string array
RESAR1:	LD	SP,HL
	JR	RESLO1
;
; RESLOC - Restore local variables/arrays or DATA/ERROR status from stack
;   Inputs: A = 0 if everything OK, bit0 set if DATPTR, bit1 set if ERRTRP
;  Outputs: Z if nothing was restored, NZ if something was restored
; Destroys: A,B,C,D,E,H,L,H',L',IX,SP,flags
;
RESLOC:	POP	DE		;Return address
	LD	IX,0		;To flag nothing was restored
RESLO1:	POP	BC		;Marker ?
	LD	HL,LOCCHK
	OR	A
	SBC	HL,BC
	JR	Z,RESLO2	;Something to restore
	OR	A
	JR	NZ,RESLO8
	LD	HL,RETCHK
	SBC	HL,BC
	JR	Z,RESRET
	LD	HL,ARRCHK
	OR	A
	SBC	HL,BC
	JR	Z,RESARR
RESLO8:	PUSH	IX
	POP	HL
	LD	A,H
	OR	L
RESLO0:	PUSH	BC		;Put back marker
	EX	DE,HL
	JP	(HL)		;Return
;
RESLO2:	POP	IX		;Variable pointer
	OR	A
	JR	Z,RESLO3	;Everything allowed
	PUSH	IX
	POP	BC
	BIT	0,A
	JR	Z,RESLO6	;Bit 0 set, so
	LD	HL,DATPTR	;test for DATPTR
	SBC	HL,BC
	JR	Z,RESLO3
RESLO6:	OR	A
	BIT	1,A
	JR	Z,RESLO7	;Bit 1 set, so
	LD	HL,ERRTRP	;test for ERRPTR
	SBC	HL,BC
	JR	Z,RESLO3
RESLO7:	PUSH	BC		;Put back pointer
	LD	BC,LOCCHK
	JR	RESLO0
;
RESLO3:	POP	BC		;Type / exponent
	BIT	6,B
	JR	NZ,RESLO4	;Array?
	BIT	7,B
	JR	NZ,RESLO5	;String?
	POP	HL
	EXX
	POP	HL
	EXX
	BIT	4,B
	JR	NZ,RESLO1
	PUSH	AF
	LD	A,B
	CALL	STOREN		;Numeric
	POP	AF
	JR	RESLO1
;
RESLO4:	POP	HL
	BIT	4,B
	JR	NZ,RESLO1
	LD	(IX+0),L	;Array
	LD	(IX+1),H
	JR	RESLO1
;
RESLO9:	LD	B,0
	ADD	HL,BC
	LD	SP,HL
RESLGO:	JR	RESLO1
;
RESLO5:	LD	HL,0
	ADD	HL,SP
	BIT	4,B
	JR	NZ,RESLO9
	PUSH	AF
	PUSH	DE
	LD	E,C
	LD	A,B
	CALL	STORES		;String
	POP	DE
	POP	AF
	LD	SP,HL
	JR	RESLGO
;
;SAVLOC: SUBROUTINE TO STACK LOCAL PARAMETERS
;  OF A FUNCTION OR PROCEDURE.
;THERE IS A LOT OF STACK MANIPULATION - CARE!!
;   Inputs: IY is parameters pointer
;  Outputs: IY updated
;           A' incremented for each RETURN
; Destroys: A',A,B,C,D,E,H,L,IX,IY,F,SP
;
SAVLOC:	POP	DE		;RETURN ADDRESS
SAVLO1:	INC	IY		;BUMP PAST ( OR ,
	CALL	NXT
	CP	TRETURN
	JR	NZ,SAVLO6
	EX	AF,AF'
	INC	A		;RETURN counter
	EX	AF,AF'
	INC	IY		;Bump past RETURN
	CALL	NXT
SAVLO6:	PUSH	DE
	EXX
	PUSH	BC
	PUSH	DE
	PUSH	HL
	EXX
	CALL	VAR		;DUMMY VARIABLE
	EXX
	POP	HL
	POP	DE
	POP	BC
	EXX
	POP	DE
	BIT	6,A		;ARRAY?
	JR	NZ,SAVLO3
	OR	A		;TYPE
	JP	M,SAVLO2	;STRING
	EXX
	PUSH	HL		;SAVE H'L'
	EXX
	LD	B,A		;TYPE
	CALL	LOADN
	EXX
	EX	(SP),HL
	EXX
	PUSH	HL
	PUSH	BC
	JR	SAVLO4
;
SAVLO3:	LD	C,(IX+0)	;ARRAY POINTER
	LD	B,(IX+1)
	PUSH	BC		;SAVE TO STACK
	PUSH	AF		;SAVE TYPE
	JR	SAVLO4
;
SAVLO2:	PUSH	AF		;STRING TYPE
	PUSH	DE
	EXX
	PUSH	HL
	EXX
	CALL	LOADS
	EXX
	POP	HL
	EXX
	LD	C,E
	POP	DE
	CALL	CHECK
	POP	AF		;LEVEL STACK
	LD	HL,0
	LD	B,L
	SBC	HL,BC
	ADD	HL,SP
	LD	SP,HL
	LD	B,A		;TYPE
	PUSH	BC
	JR	Z,SAVLO4
	PUSH	DE
	LD	DE,ACCS
	EX	DE,HL
	LD	B,L
	LDIR			;SAVE STRING ON STACK
	POP	DE
SAVLO4:	PUSH	IX		;VARPTR
	CALL	SAVLO5
LOCCHK	EQU	$
SAVLO5:	CALL	CHECK
	CALL	NXT
	CP	','		;MORE?
	JR	Z,SAVLO1
	EX	DE,HL
	JP	(HL)		;"RETURN"
;
TERMQ:	CALL	NXT
	CP	TELSE
	RET	NC
	CP	':'		;ASSEMBLER SEPARATOR
	RET	NC
	CP	CR
	RET
;
SPAN:	CALL	TERMQ
	RET	Z
	INC	IY
	CP	'"'
	CALL	Z,QUOTE
	JR	SPAN
;
EQUALS:	CALL	NXT
	INC	IY
	CP	'='
	RET	Z
	LD	A,4
	JP	ERROR		;"Mistake"
;
FORMAT:	CP	TTAB
	JR	Z,DOTAB
	CP	TSPC
	JR	Z,DOSPC
	CP	''''
	RET	NZ
	CALL	CRLF
	XOR	A
	RET
;
DOTAB:	PUSH	BC
	CALL	EXPRI
	EXX
	POP	BC
	LD	A,(IY)
	CP	','
	JR	Z,DOTAB1
	CALL	BRAKET
	LD	A,L
TABIT:	LD	HL,COUNT
	CP	(HL)
	RET	Z
	PUSH	AF
	CALL	C,CRLF
	POP	AF
	SUB	(HL)
	JR	SPACES
DOTAB1:	INC	IY
	PUSH	BC
	PUSH	HL
	CALL	EXPRI
	EXX
	POP	DE
	POP	BC
	CALL	BRAKET
	CALL	PUTCSR
	XOR	A
	RET
;
DOSPC:	PUSH	BC
	CALL	ITEMI
	EXX
	LD	A,L
	POP	BC
SPACES:	OR	A
	RET	Z
	PUSH	BC
	LD	B,A
FILL1:	LD	A,' '
	CALL	OUTCHR
	DJNZ	FILL1
	POP	BC
	XOR	A
	RET
;
PTEXT:	LD	HL,ACCS
	INC	E
PTEXT1:	DEC	E
	RET	Z
	LD	A,(HL)
	INC	HL
	CALL	OUTCHR
	JR	PTEXT1
;
FETCHS:	PUSH	AF
	PUSH	BC
	PUSH	HL
	EX	(SP),IY
	CALL	XTRACT
	CALL	NXT
	EX	(SP),IY
	POP	HL
	POP	BC
	POP	AF
	RET
;
LINES:	LD	DE,ACCS
LINE1S:	LD	A,(HL)
	LD	(DE),A
	CP	CR
	RET	Z
	INC	HL
	INC	E
	JR	LINE1S
;
XTRACT:	CALL	NXT
	CP	'"'
	INC	IY
	JP	Z,CONS
	DEC	IY
	LD	DE,ACCS
XTRAC1:	LD	A,(IY)
	LD	(DE),A
	CP	','
	RET	Z
	CP	CR
	RET	Z
	INC	IY
	INC	E
	JR	XTRAC1
;
DSRCH:	LD	A,TDATA
SEARCH:	LD	B,0
SRCH1:	LD	C,(HL)
	INC	C
	DEC	C
	JR	Z,SRCH2		;FAIL
	INC	HL
	INC	HL
	INC	HL
	CP	(HL)
	RET	Z
	DEC	C
	DEC	C
	DEC	C
	ADD	HL,BC
	JP	SRCH1
SRCH2:	DEC	HL		;POINT TO CR
	SCF
	RET
;
; NSCAN - scan for token at start of line, with nesting of inner structures
; Alternative entry at NSCAN1 with L = level (used by CASE)
;
;   Inputs: B = token to find (1, start of line)
;           C = token to find (2, start of line)
;           E = token to nest (end of line)
;           D = token to unnest (start of line)
;           IY = start search area (line length byte)
;  Outputs: NZ if not found
;           Z if found, IY points to byte after token
; Destroys: A,B,C,L,IY,F
;
NSCAN:	LD	L,0		;nest level
NSCAN1:	LD	A,(IY)		;get line length
	OR	A		;test zero = end of prog
	JR	Z,NSCAN6
	LD	A,(IY+3)	;initial token
	CP	B		;test value reqd
	JR	Z,NSCAN3	;found (1)
	CP	C
	JR	Z,NSCAN3	;found (2)
NSCAN7:	CP	D		;unnest?
	JR	Z,NSCAN5
NSCAN2:	PUSH	BC
	LD	B,0
	LD	C,(IY)
	ADD	IY,BC		;go to next line
	LD	A,(IY-2)
	CP	E		;nest?
	LD	A,C	
	POP	BC
	JR	NZ,NSCAN1	;continue
	CP	5		;empty line ?
	JR	C,NSCAN1	;continue
	INC	L		;increment nest level
	JR	NSCAN1		;continue
;
NSCAN3:	INC	L
	DEC	L
	JR	NZ,NSCAN7
NSCAN4:	LD	BC,4
	ADD	IY,BC
	XOR	A		;Z
	RET
;
NSCAN5:	DEC	L		;decrement nest level
	JP	P,NSCAN2
	JR	NSCAN4
;
NSCAN6:	OR	1		;NZ
	RET
;
; WSRCH - search for token, with nesting of inner structures
;
;   Inputs: B = token to find or unnest (anywhere)
;           C = token to nest (anywhere), ignore after EXIT
;           D = ordinal (1 = find first token, 2 = second)
;           IY = address to start looking
;  Outputs: IY points to byte after that found
;           if not found abort to END
; Destroys: A,D,IY,F
;
WSRCH:	LD	A,(IY)
	INC	IY
	CP	'"'
	CALL	Z,QUOTE
	CP	TREM
	JR	Z,WSRCHM
	CP	TEXIT
	JR	Z,WSRCHE
	CP	B
	JR	Z,WSRCHX
	CP	C
	JR	Z,WSRCHP
	CP	CR
	JR	NZ,WSRCH
WSRCH1:	LD	A,(IY)			;Line length
	INC	IY
	OR	A
	JP	Z,END
	INC	IY
	INC	IY			;Skip line number
	LD	A,(IY)
	CP	TDATA
	JR	NZ,WSRCH
WSRCHM:	LD	A,(IY)
	INC	IY
	CP	CR
	JR	NZ,WSRCHM		;Skip to end of line
	JR	WSRCH1
;
WSRCHP:	INC	D
	JR	WSRCH
;
WSRCHX:	DEC	D
	JR	NZ,WSRCH
	RET
;
WSRCHE:	CALL	NXT
	INC	IY
	JR	WSRCH
;
; QUOTE - skip quoted string
;
QUOTE:	LD	A,(IY)
	INC	IY
	CP	CR
	JP	Z,MISQUO
	CP	'"'
	JR	NZ,QUOTE
	RET
;
MISQUO:	LD	A,9
	JP	ERROR		;"Missing quote"
;
; X14OR5 - multiply by 1, 4 or 5
;   Inputs: DE = number to be multiplied
;           A = 1, 4 or 5 (else multiply by 4)
;  Outputs: DE = DE * A
;           Carry set if overflow
; Destroys: D,E,H,L,F
;
X14OR5:	LD	H,D
	LD	L,E
	CP	1
	RET	Z
	CP	5
	ADD	HL,HL
	RET	C
	ADD	HL,HL
	RET	C
	EX	DE,HL
	RET	NZ
	ADD	HL,DE
	EX	DE,HL
	RET
;
; MUL16 - 16-bit multiply
;   Inputs: HL = number to be multiplied
;           BC = multiplier
;  Outputs: HL = HL * BC
;           Carry set if overflow
; Destroys: A,D,E,H,L,F
;
MUL16:	EX	DE,HL
	LD	HL,0
	LD	A,16
MUL161:	ADD	HL,HL
	RET	C		;OVERFLOW
	SLA	E
	RL	D
	JR	NC,MUL162
	ADD	HL,BC
	RET	C
MUL162:	DEC	A
	JR	NZ,MUL161
	RET
;
CHANEL:	CALL	NXT
	CP	'#'
	LD	A,45
	JP	NZ,ERROR	;"Missing #"
CHNL:	INC	IY		;SKIP '#'
	CALL	ITEMI
	EXX
	EX	DE,HL
	RET
;
; FREESA - Free members of a string array if adjacent to the top of heap
;   Inputs: BC = length of array (= 4 * number of elements)
;           HL addresses array first byte *above* array
;  Outputs: NZ if any array element freed, Z if none
; Destroys: nothing
;
FREESA:	PUSH	AF
FREES0:	PUSH	BC
	PUSH	DE
	PUSH	HL
	XOR	A
	LD	D,B
	LD	E,C
	LD	B,A
FREES1:	PUSH	DE
	DEC	HL
	LD	D,(HL)
	DEC	HL
	LD	E,(HL)
	DEC	HL
	LD	C,(HL)
	DEC	HL
	PUSH	HL
	LD	HL,(FREE)
	EX	DE,HL
	ADD	HL,BC
	SBC	HL,DE
	JR	NZ,FREES2
	ADD	HL,DE
	SBC	HL,BC
	LD	(FREE),HL
	OR	H
FREES2:	POP	DE
	POP	HL
	LD	C,4
	OR	A
	SBC	HL,BC
	EX	DE,HL
	JR	NZ,FREES1
	OR	A
	POP	HL
	POP	DE
	POP	BC
	OR	A
	JR	NZ,FREES0
	POP	AF
	RET
;
	END