TITLE	BBC BASIC (C) R.T.RUSSELL 1981-2025
;
;BBC BASIC INTERPRETER - Z80 VERSION
;EVALUATE EXPRESSION MODULE - "EVAL"
;(C) COPYRIGHT R.T.RUSSELL 1981-2025
;
;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.3, 07-05-1984
;VERSION 3.0, 08-03-1987
;VERSION 5.0, 31-05-2024
;VERSION 5.1, 28-12-2024
;VERSION 5.2, 11-01-2025
;VERSION 5.3, 16-03-2025 (Shifts moved to new codes)
;
;BINARY FLOATING POINT REPRESENTATION:
; 32 BIT SIGN-MAGNITUDE NORMALIZED MANTISSA
; 8 BIT EXCESS-128 SIGNED EXPONENT
; SIGN BIT REPLACES MANTISSA MSB (IMPLIED "1")
; MANTISSA=0 & EXPONENT=0 IMPLIES VALUE IS ZERO.
;
;BINARY INTEGER REPRESENTATION:
; 32 BIT 2'S-COMPLEMENT SIGNED INTEGER
; "EXPONENT" BYTE = 0 (WHEN PRESENT)
;
;NORMAL REGISTER ALLOCATION: MANTISSA - HLH'L'
;                            EXPONENT - C
;
	GLOBAL	EXPR
	GLOBAL	EXPRN
	GLOBAL	EXPRI
	GLOBAL	EXPRS
	GLOBAL	ITEMI
	GLOBAL	CONS
	GLOBAL	LOADS
	GLOBAL	VAL0
	GLOBAL	SFIX
	GLOBAL	STR
	GLOBAL	HEXSTR
	GLOBAL	LOAD4
	GLOBAL	LOADN
	GLOBAL	DLOAD5
	GLOBAL	TEST
	GLOBAL	ZERO
	GLOBAL	COMMA
	GLOBAL	BRAKET
	GLOBAL	DECODE
	GLOBAL	PUSHS
	GLOBAL	POPS
	GLOBAL	SEARCH
	GLOBAL	SCP
	GLOBAL	LETARR
;
	EXTRN	MUL16
	EXTRN	ERROR
	EXTRN	SYNTAX
	EXTRN	CHANEL
	EXTRN	CHNL
	EXTRN	STOREN
	EXTRN	STORE4
	EXTRN	STORE5
	EXTRN	STACCS
	EXTRN	CHECK
	EXTRN	USR
	EXTRN	VAR
	EXTRN	FN
	EXTRN	XEQ
	EXTRN	NXT
	EXTRN	X14OR5
	EXTRN	MODIFY
	EXTRN	MODIFS
	EXTRN	TERMQ
;
	EXTRN	GETVAR
	EXTRN	LEXAN2
	EXTRN	RANGE
	EXTRN	GETTOP
;
	EXTRN	STAVAR
	EXTRN	PAGE
	EXTRN	LOMEM
	EXTRN	HIMEM
	EXTRN	RANDOM
	EXTRN	COUNT
	EXTRN	LISTON
	EXTRN	PC
	EXTRN	ERL
	EXTRN	ERR
	EXTRN	ACCS
	EXTRN	ERRTXT
	EXTRN	KEYWDS
	EXTRN	KEYWDL
	EXTRN	FREE
	EXTRN	BUFFER
;
	EXTRN	OSRDCH
	EXTRN	OSOPEN
	EXTRN	OSBGET	
	EXTRN	OSSTAT
	EXTRN	GETCSR
	EXTRN	GETIME
	EXTRN	GETIMS
	EXTRN	GETEXT
	EXTRN	GETPTR
	EXTRN	OSKEY
;
	EXTRN	POINT
	EXTRN	ADVAL
	EXTRN	TINTFN
	EXTRN	MODEFN
	EXTRN	WIDFN
;
	EXTRN	FPP
;
FUNTOK	EQU	8DH		;1st FUNCTION TOKEN
TMOD	EQU	83H
TLEN	EQU	0A9H
TTO	EQU	0B8H
TDIM	EQU	0DEH
TEND	EQU	0E0H
TMODE	EQU	0EBH
TREPORT	EQU	0F6H
TWIDTH	EQU	0FEH
TTINT	EQU	0AH
TBY	EQU	0FH
;
;TABLE OF ADDRESSES FOR FUNCTIONS:
;
FUNTBL:	DEFW	DECODE		;Line number
	DEFW	OPENIN		;OPENIN
	DEFW	PTR		;PTR
	DEFW	PAGEV		;PAGE
	DEFW	TIMEV		;TIME
	DEFW	LOMEMV		;LOMEM
	DEFW	HIMEMV		;HIMEM
	DEFW	ABS		;ABS
	DEFW	ACS		;ACS
	DEFW	ADVAL		;ADVAL
	DEFW	ASC		;ASC
	DEFW	ASN		;ASN
	DEFW	ATN		;ATN
	DEFW	BGET		;BGET
	DEFW	COS		;COS
	DEFW	COUNTV		;COUNT
	DEFW	DEG		;DEG
	DEFW	ERLV		;ERL
	DEFW	ERRV		;ERR
	DEFW	EVAL		;EVAL
	DEFW	EXP		;EXP
	DEFW	EXT		;EXT
	DEFW	ZERO		;FALSE
	DEFW	FN		;FN
	DEFW	GET		;GET
	DEFW	INKEY		;INKEY
	DEFW	INSTR		;INSTR(
	DEFW	INT		;INT
	DEFW	LEN		;LEN
	DEFW	LN		;LN
	DEFW	LOG		;LOG
	DEFW	CPL		;NOT
	DEFW	OPENUP		;OPENUP
	DEFW	OPENOT		;OPENOUT
	DEFW	PI		;PI
	DEFW	POINT		;POINT(
	DEFW	POS		;POS
	DEFW	RAD		;RAD
	DEFW	RND		;RND
	DEFW	SGN		;SGN
	DEFW	SIN		;SIN
	DEFW	SQR		;SQR
	DEFW	TAN		;TAN
	DEFW	TOPV		;TO(P)
	DEFW	TRUE		;TRUE
	DEFW	USR		;USR
	DEFW	VAL		;VAL
	DEFW	VPOS		;VPOS
	DEFW	CHRS		;CHR$
	DEFW	GETS		;GET$
	DEFW	INKEYS		;INKEY$
	DEFW	LEFTS		;LEFT$(
	DEFW	MIDS		;MID$(
	DEFW	RIGHTS		;RIGHT$(
	DEFW	STRS		;STR$
	DEFW	STRING		;STRING$(
	DEFW	EOF		;EOF
	DEFW	SUM		;SUM
;
TCMD	EQU	FUNTOK+($-FUNTBL)/2
;
CR	EQU	0DH
LF	EQU	0AH
AND	EQU	80H
DIV	EQU	81H
EOR	EQU	82H
MOD	EQU	83H
OR	EQU	84H
;
SOPTBL:	DEFW	SLE		;<= (STRING)
	DEFW	SNE		;<>
	DEFW	SGE		;>=
	DEFW	SLT		;<
	DEFW	SEQ		;=
	DEFW	SGT		;>
;
;EXPR - VARIABLE-TYPE EXPRESSION EVALUATION
; Expression type is returned in A'F':
; Numeric - A' bit 7=0, F' sign bit cleared.
; String - A' bit 7=1, F' sign bit set.
;Floating-point or integer result returned in HLH'L'C
; Integer result denoted by C=0 and HLH'L' non-zero.
;String result returned in string accumulator, DE set.
;
;Hierarchy is: (1) Variables, functions,
; constants, bracketed expressions.
; (2) ^
; (3) * / MOD DIV
; (4) + -
; (5) = <> <= >= > <
; (6) AND
; (7) EOR OR
;
EXPR:	CALL	EXPR1		;GET FIRST OPERAND
EXPR0A:	CP	EOR		;CHECK OPERATOR
	JR	Z,EXPR0B
	CP	OR
	RET	NZ
EXPR0B:	CALL	SAVE		;SAVE FIRST OPERAND
	CALL	EXPR1		;GET SECOND OPERAND
	CALL	DOIT		;DO OPERATION
	JR	EXPR0A		;CONTINUE
;
EXPR1:	CALL	EXPR2
EXPR1A:	CP	AND
	RET	NZ
	CALL	SAVE
	CALL	EXPR2
	CALL	DOIT
	JR	EXPR1A
;
EXPR2:	CALL	EXPR3
	CALL	RELOPQ
	RET	NZ
	LD	B,A
	INC	IY		;BUMP OVER OPERATOR
	CALL	NXT
	CALL	RELOPQ		;COMPOUND OPERATOR?
	JR	NZ,EXPR2B
	INC	IY
	CP	B
	JR	Z,SHIFT		;SHIFT OR ==
	ADD	A,B
	LD	B,A
EXPR2B:	LD	A,B
	EX	AF,AF'
	JP	M,EXPR2S
	EX	AF,AF'
	SUB	4
	CP	'>'-4
	JR	NZ,EXPR2C
	ADD	A,2
EXPR2C:	AND	0FH
EXPR2D:	CALL	SAVE1
	CALL	EXPR3
	CALL	DOIT		;Must NOT be "JP DOIT"
	RET
;
SHIFT:	CP	'='
	JR	Z,EXPR2B	;==
	CALL	NXT
	CALL	RELOPQ
	JR	NZ,SHIFT1
	CP	B
	JP	NZ,SYNTAX
	INC	IY
	INC	B
SHIFT1:	LD	A,B
	SUB	16
	JR	EXPR2D
;
EXPR2S:	EX	AF,AF'
	DEC	A
	AND	7
	CALL	PUSHS		;SAVE STRING ON STACK
	PUSH	AF		;SAVE OPERATOR
	CALL	EXPR3		;SECOND STRING
	EX	AF,AF'
	JP	P,MISMAT
	POP	AF
	LD	C,E		;LENGTH OF STRING #2
	POP	DE
	LD	HL,0
	ADD	HL,SP
	LD	B,E		;LENGTH OF STRING #1
	PUSH	DE
	LD	DE,ACCS
	EX	DE,HL
	CALL	DISPT2
	POP	DE
	EX	DE,HL
	LD	H,0
	ADD	HL,SP
	LD	SP,HL
	EX	DE,HL
	XOR	A		;NUMERIC MARKER
	LD	C,A		;INTEGER MARKER
	EX	AF,AF'
	LD	A,(IY)
	RET
;
EXPR3:	CALL	EXPR4
EXPR3A:	CP	'-'
	JR	Z,EXPR3B
	CP	'+'
	RET	NZ
	EX	AF,AF'
	JP	M,EXPR3S
	EX	AF,AF'
EXPR3B:	CALL	SAVE
	CALL	EXPR4
	CALL	DOIT
	JR	EXPR3A
;
EXPR3S:	EX	AF,AF'
	INC	IY		;BUMP PAST '+'
	CALL	PUSHS		;SAVE STRING ON STACK
	CALL	EXPR4		;SECOND STRING
	EX	AF,AF'
	JP	P,MISMAT
	LD	C,E		;C=LENGTH
	POP	DE
	PUSH	DE
	LD	HL,ACCS
	LD	D,H
	LD	A,C
	OR	A
	JR	Z,EXP3S3
	LD	B,L
	LD	L,A		;SOURCE
	ADD	A,E
	LD	E,A		;DESTINATION
	LD	A,19
	JR	C,ERROR2	;"String too long"
	PUSH	DE
	DEC	E
	DEC	L
	LDDR			;COPY
	POP	DE
EXP3S3:	EXX
	POP	BC
	CALL	POPS		;RESTORE FROM STACK
	EXX
	OR	80H		;FLAG STRING
	EX	AF,AF'
	LD	A,(IY)
	JR	EXPR3A
;
EXPR4:	CALL	EXPR5
EXPR4A:	CP	'*'
	JR	Z,EXPR4B
	CP	'/'
	JR	Z,EXPR4B
	CP	MOD
	JR	Z,EXPR4B
	CP	DIV
	RET	NZ
EXPR4B:	CALL	SAVE
	CALL	EXPR5
	CALL	DOIT
	JR	EXPR4A
;
EXPR45:	LD	A,E
	CP	'+'
	JR	Z,EXPR4
	CP	'-'
	JR	Z,EXPR4
EXPR5:	CALL	ITEM
	OR	A		;TEST TYPE
	EX	AF,AF'		;SAVE TYPE
EXPR5A:	CALL	NXT
	CP	'^'
	RET	NZ
	CALL	SAVE
	CALL	ITEM
	OR	A
	EX	AF,AF'
	CALL	DOIT
	JR	EXPR5A
;
EXPRN:	CALL	EXPR
	EX	AF,AF'
	RET	P
	JR	MISMAT
;
EXPRI:	CALL	EXPR
	EX	AF,AF'
	JP	P,SFIX
	JR	MISMAT
;
EXPRS:	CALL	EXPR
	EX	AF,AF'
	RET	M
	JR	MISMAT
;
BADHEX:	LD	A,28
ERROR2:	JP	ERROR		;"Bad HEX or binary"
;
NEGATE:	EXX
	LD	A,H
	CPL
	LD	H,A
	LD	A,L
	CPL
	LD	L,A
	EXX
	LD	A,H
	CPL
	LD	H,A
	LD	A,L
	CPL
	LD	L,A
ADD1:	EXX
	INC	HL
	LD	A,H
	OR	L
	EXX
	LD	A,0		;NUMERIC MARKER
	RET	NZ
	INC	HL
	RET
;
ITEMI:	CALL	ITEM
	OR	A
	JP	P,SFIX
	JR	MISMAT
;
ITEMS:	CALL	ITEM
	OR	A
	RET	M
MISMAT:	LD	A,6
	JR	ERROR2		;"Type mismatch"
;
ITEM1:	CALL	EXPR		;BRACKETED EXPR
	CALL	BRAKET
	EX	AF,AF'
	RET
;
ITEMN:	CALL	ITEM
	OR	A
	RET	P
	JR	MISMAT
;
;HEX - Get hexadecimal constant.
;   Inputs: ASCII string at (IY)
;  Outputs: Integer result in H'L'HL, C=0, A7=0.
;           IY updated (points to delimiter)
;
HEX:	CALL	ZERO
	CALL	HEXDIG
	JR	C,BADHEX
HEX1:	INC	IY
	AND	0FH
	LD	B,4
HEX2:	EXX
	ADD	HL,HL
	EXX
	ADC	HL,HL
	DJNZ	HEX2
	EXX
	OR	L
	LD	L,A
	EXX
	CALL	HEXDIG
	JR	NC,HEX1
	XOR	A
	RET
;
;BIN - Get binary constant.
;   Inputs: ASCII string at (IY)
;  Outputs: Integer result in H'L'HL, C=0, A=0.
;           IY updated (points to delimiter)
;
BIN:	CALL	ZERO
	CALL	BINDIG
	JR	C,BADHEX
BIN1:	INC	IY
	RR	A
	EXX
	ADC	HL,HL
	EXX
	ADC	HL,HL
	CALL	BINDIG
	JR	NC,BIN1
	XOR	A
	RET
;
;MINUS - Unary minus.
;   Inputs: IY = text pointer
;  Outputs: Numeric result, same type as argument.
;           Result in H'L'HLC
;
MINUS:	CALL	ITEMN
MINUS0:	DEC	C
	INC	C
	JR	Z,NEGATE	;ZERO/INTEGER
	LD	A,H
	XOR	80H		;CHANGE SIGN (FP)
	LD	H,A
	XOR	A		;NUMERIC MARKER
	RET
;
ADDROF:	CALL	VAR
	PUSH	HL
	EXX
	POP	HL
	JP	COUNT1
;
;ITEM - VARIABLE TYPE NUMERIC OR STRING ITEM.
;Item type is returned in A: Bit 7=0 numeric.
; Bit 7=1 string.
;Numeric item returned in HLH'L'C.
;String item returned in string accumulator,
; DE addresses byte after last (E=length).
;
ITEM:	CALL	CHECK
	CALL	NXT
	INC	IY
	CP	FUNTOK
	JR	C,ITEM0
	CP	TCMD
	JP	C,DISPAT	;FUNCTIONS
	JP	EXTRAS		;DIM, END, MODE, REPORT$, WIDTH
;
ITEM0:	CP	':'
	JR	NC,ITEM2	;VARIABLES 
	CP	'0'
	JR	NC,CON		;NUMERIC CONSTANT
	CP	'('
	JR	Z,ITEM1		;EXPRESSION
	CP	'-'
	JR	Z,MINUS		;UNARY MINUS
	CP	'+'
	JR	Z,ITEMN		;UNARY PLUS
	CP	'.'
	JR	Z,CON		;NUMERIC CONSTANT
	CP	'&'
	JR	Z,HEX		;HEX CONSTANT
	CP	'%'
	JR	Z,BIN		;BINARY CONSTANT
	CP	'"'
	JR	Z,CONS		;STRING CONSTANT
	CP	TTINT
	JP	Z,TINT		;TINT FUNCTION
ITEM2:	CP	TMOD	
	JP	Z,MODFUN	;MOD
	CP	'^'
	JR	Z,ADDROF	;^ OPERATOR
	DEC	IY
	CALL	GETVAR		;VARIABLE
	JR	NZ,NOSUCH
	BIT	6,A
	JR	NZ,ARRAY
	OR	A
	JP	M,LOADS		;STRING VARIABLE
LOADN:	BIT	2,A
	LD	C,0
	JR	Z,LOAD1		;BYTE VARIABLE
	BIT	0,A
	JR	Z,LOAD4		;INTEGER VARIABLE
LOAD5:	LD	C,(IX+4)
LOAD4:	EXX
	LD	L,(IX+0)
	LD	H,(IX+1)
	EXX
	LD	L,(IX+2)
	LD	H,(IX+3)
	RET
;
LOAD1:	LD	HL,0
	EXX
	LD	H,0
	LD	L,(IX+0)
	EXX
	RET
;
NOSUCH:	JP	C,SYNTAX
	LD	A,(LISTON)
	BIT	5,A
	LD	A,26
	JR	NZ,ERROR0	;"No such variable"
NOS1:	INC	IY
	CALL	RANGE
	JR	NC,NOS1
	LD	IX,PC
	XOR	A
	LD	C,A
	JR	LOAD4
;
;CON - Get unsigned numeric constant from ASCII string.
;   Inputs: ASCII string at (IY-1)
;  Outputs: Variable-type result in HLH'L'C
;           IY updated (points to delimiter)
;           A7 = 0 (numeric marker)
;
CON:	DEC	IY
	PUSH	IY
	POP	IX
	LD	A,36
	CALL	FPP
	JR	C,ERROR0
	PUSH	IX
	POP	IY
	XOR	A
	RET
;
;CONS - Get string constant from ASCII string.
;   Inputs: ASCII string at (IY)
;  Outputs: Result in string accumulator.
;           D = MS byte of ACCS, E = string length
;           A7 = 1 (string marker)
;           IY updated
;
CONS:	LD	DE,ACCS
CONS3:	LD	A,(IY)
	INC	IY
	CP	'"'
	JR	Z,CONS2
CONS1:	LD	(DE),A
	INC	E
	CP	CR
	JR	NZ,CONS3
	LD	A,9
ERROR0:	JP	ERROR		;"Missing """
;
CONS2:	LD	A,(IY)
	CP	'"'
	INC	IY
	JR	Z,CONS1
	DEC	IY
	LD	A,80H		;STRING MARKER
	RET
;
ARRAY:	LD	A,14		;'Bad use of array'
	JR	ERROR0
;
; ARRLEN - Get start address and number of elements of an array
;   Inputs: HL addresses array descriptor
;  Outputs: HL = address of first element
;           DE = total number of elements
;           A = 0
; Destroys: A,B,C,D,E,H,L,flags
;
ARRLEN:	LD	A,(HL)		;Number of dimensions
	INC	HL
	OR	A
	JR	Z,ARRAY
	LD	DE,1
ARLOOP:	LD	C,(HL)
	INC	HL
	LD	B,(HL)		;BC = size of this dimension
	INC	HL
	EX	DE,HL
	PUSH	AF
	PUSH	DE
	CALL	MUL16		;HL=HL*BC
	POP	DE
	POP	AF
	EX	DE,HL
	DEC	A
	JR	NZ,ARLOOP
	RET
;
GETARR:	CALL	NXT
	CALL	GETVAR
	JR	NZ,NOSUCH
	BIT	6,A
	SCF
	JR	Z,NOSUCH
	AND	8FH
	LD	B,A		;Type + size
GETAR1:	LD	A,(HL)
	INC	HL
	LD	H,(HL)
	LD	L,A
	AND	0FEH
	OR	H
	JR	Z,ARRAY		;Bad use of array
	RET
;
GETARB:	CALL	NXT
	CP	'('
	JR	NZ,GETARR
	INC	IY
	CALL	GETARR
	CALL	BRAKET
	RET
;
DLOADN:	BIT	2,A
	LD	B,0
	JR	Z,DLOAD1	;BYTE VARIABLE
	BIT	0,A
	JR	Z,DLOAD4	;INTEGER VARIABLE
DLOAD5:	LD	B,(IX+4)
DLOAD4:	EXX
	LD	E,(IX+0)
	LD	D,(IX+1)
	EXX
	LD	E,(IX+2)
	LD	D,(IX+3)
	RET
;
DLOAD1:	LD	DE,0
	EXX
	LD	D,0
	LD	E,(IX+0)
	EXX
	RET
;
LOADS:	LD	DE,ACCS
	RRA
	JR	NC,LOADS2	;FIXED STRING
	CALL	LOAD4
	EXX
	LD	A,L
	EXX
	OR	A
	LD	C,A
REPDUN:	LD	A,80H		;STRING MARKER
	RET	Z
	LD	B,0
	LDIR
	RET
;
LOADS2:	PUSH	IX
	POP	HL
LOADS3:	LD	A,(HL)
	LD	(DE),A
	INC	HL
	CP	CR
	JR	Z,REPDUN
	INC	E
	JR	NZ,LOADS3
	RET			;RETURN NULL STRING
;
; Version 5 extensions:
;
EXTRAS:	CP	TMODE
	JP	Z,MODEFN	;MODE
	CP	TWIDTH
	JP	Z,WIDFN		;WIDTH
	CP	TREPORT
	JR	Z,REPORS	;REPORT$
	CP	TEND
	JR	Z,ENDFUN	;END
	CP	TDIM
	JR	Z,DIMFUN	;DIM
SYNERR:	JP	SYNTAX		; 'Syntax error'
;
; END (function)
;
ENDFUN:	LD	HL,(FREE)
	JP	COUNT1
;
; REPORT$
;
REPORS:	LD	A,(IY)
	CP	'$'
	JR	NZ,SYNERR
	INC	IY
	LD	HL,(ERRTXT)
	LD	DE,ACCS
REPCPY:	LD	A,(HL)
	OR	A
	JR	Z,REPDUN
	LDI
	CP	160
	JP	PE,REPCPY
	CP	LF
	JR	Z,REPCPY
	DEC	E
	PUSH	HL
	LD	HL,KEYWDS
	LD	BC,KEYWDL
	CPIR
	LD	B,160
	CP	145
	JP	PE,REPTOK
	INC	B
REPTOK:	LD	A,(HL)
	LDI
	CP	B
	JP	PE,REPTOK
	POP	HL
	DEC	E
	JR	REPCPY
;
; DIM(array()[,sub])
;
DIMFUN:	CALL	NXT
	CP	'('
	JR	NZ,DIMF0
	INC	IY
	CALL	DIMF0
	CALL	BRAKET
	RET
;
DIMF0:	CALL	GETARR
	PUSH	HL
	CALL	NXT
	LD	E,0
	CP	','
	JR	NZ,DIMF1
	INC	IY
	CALL	EXPRI
	EXX
	EX	DE,HL
	INC	E
	DEC	E
	JR	Z,BADSUB
DIMF1:	POP	HL
	LD	A,(HL)
	INC	HL
	CP	E
	JR	C,BADSUB
	DEC	E
	JP	M,DIMF3
	ADD	HL,DE
	ADD	HL,DE
	LD	A,(HL)
	INC	HL
	LD	H,(HL)
	LD	L,A
	DEC	HL
DIMF2:	JP	COUNT1

DIMF3:	LD	L,A
	LD	H,0
	JR	DIMF2
;
BADSUB:	LD	A,15
	JP	ERROR			;"Bad subscript"
;
;VARIABLE-TYPE FUNCTIONS:
;
;Result returned in HLH'L'C (floating point)
;Result returned in HLH'L' (C=0) (integer)
;Result returned in string accumulator & DE (string)
;All registers destroyed.
;IY (text pointer) updated.
;Bit 7 of A indicates type: 0 = numeric, 1 = string.
;
;
;POS - horizontal cursor position.
;VPOS - vertical cursor position.
;EOF - return status of file.
;BGET - read byte from file.
;INKEY - as GET but wait only n centiseconds.
;GET - wait for keypress and return ASCII value.
;GET(n) - input from Z80 port n.
;ASC - ASCII value of string.
;LEN - length of string.
;LOMEM - location of dynamic variables.
;HIMEM - top of available RAM.
;PAGE - start of current text page.
;TOP - address of first free byte after program.
;ERL - line number where last error occurred.
;ERR - number of last error.
;COUNT - number of printing characters since CR.
;Results are integer numeric.
;
TINT:	CALL	TINTFN
	JR	COUNT1
POS:	CALL	GETCSR
	EX	DE,HL
	JR	COUNT1
VPOS:	CALL	GETCSR
	JR	COUNT1
EOF:	CALL	CHANEL
	CALL	OSSTAT
	JP	Z,TRUE
	JP	ZERO
BGET:	CALL	CHANEL		;CHANNEL NUMBER
	CALL	OSBGET
	LD	L,A
	JR	COUNT0
INKEY:	CALL	INKEYS
	JR	ASC0
GET:	CALL	NXT
	CP	'('
	JR	NZ,GET0
	CALL	ITEMI		;PORT ADDRESS
	EXX
	LD	B,H
	LD	C,L
	IN	L,(C)		;INPUT FROM PORT BC
	JR	COUNT0
GET0:	CALL	GETS
	JR	ASC1
ASC:	CALL	ITEMS
ASC0:	XOR	A
	CP	E
	JP	Z,TRUE		;NULL STRING
ASC1:	LD	HL,(ACCS)
	JR	COUNT0
LEN:	CALL	ITEMS
	EX	DE,HL
	JR	COUNT0
LOMEMV:	LD	HL,(LOMEM)
	JR	COUNT1
HIMEMV:	LD	HL,(HIMEM)
	JR	COUNT1
PAGEV:	LD	HL,(PAGE)
	JR	COUNT1
TOPV:	LD	A,(IY)
	INC	IY		;SKIP "P"
	CP	'P'
	JP	NZ,SYNTAX	;"Syntax Error"
	CALL	GETTOP
	JR	COUNT1
ERLV:	LD	HL,(ERL)
	JR	COUNT1
ERRV:	LD	HL,(ERR)
	JR	COUNT0
COUNTV:	LD	HL,(COUNT)
COUNT0:	LD	H,0
COUNT1:	EXX
	XOR	A
	LD	C,A		;INTEGER MARKER
	LD	H,A
	LD	L,A
	RET
;
;OPENIN - Open a file for reading.
;OPENOUT - Open a file for writing.
;OPENUP - Open a file for reading or writing.
;Result is integer channel number (0 if error)
;
OPENOT:	XOR	A
	DEFB	21H		;SKIP NEXT 2 BYTES
OPENUP:	LD	A,2
	DEFB	21H		;SKIP NEXT 2 BYTES
OPENIN:	LD	A,1
	PUSH	AF		;SAVE OPEN TYPE
	CALL	ITEMS		;FILENAME
	LD	A,CR
	LD	(DE),A
	POP	AF		;RESTORE OPEN TYPE
	ADD	A,-1		;AFFECT FLAGS
	LD	HL,ACCS
	CALL	OSOPEN
	LD	L,A
	JR	COUNT0
;
;EXT - Return length of file.
;PTR - Return current file pointer.
;Results are integer numeric.
;
EXT:	CALL	CHANEL
	CALL	GETEXT
	JR	TIME0
;
PTR:	CALL	CHANEL
	CALL	GETPTR
	JR	TIME0
;
;TIME - Return current value of elapsed time.
;Result is integer numeric.
;
TIMEV:	LD	A,(IY)
	CP	'$'
	JR	Z,TIMEVS
	CALL	GETIME
TIME0:	PUSH	DE
	EXX
	POP	HL
	XOR	A
	LD	C,A
	RET
;
;TIME$ - Return date/time string.
;Result is string
;
TIMEVS:	INC	IY		;SKIP $
	CALL	GETIMS
	LD	A,80H		;MARK STRING
	RET
;
;String comparison:
;
SLT:	CALL	SCP
	RET	NC
	JR	TRUE
;
SGT:	CALL	SCP
	RET	Z
	RET	C
	JR	TRUE
;
SGE:	CALL	SCP
	RET	C
	JR	TRUE
;
SLE:	CALL	SCP
	JR	Z,TRUE
	RET	NC
	JR	TRUE
;
SNE:	CALL	SCP
	RET	Z
	JR	TRUE
;
SEQ:	CALL	SCP
	RET	NZ
TRUE:	LD	A,-1
	EXX
	LD	H,A
	LD	L,A
	EXX
	LD	H,A
	LD	L,A
	INC	A
	LD	C,A
	RET
;
;PI - Return PI (3.141592654)
;Result is floating-point numeric.
;
PI:	LD	A,35
	JR	FPP1
;
;ABS - Absolute value
;Result is numeric, variable type.
;
ABS:	LD	A,16
	JR	FPPN
;
;NOT - Complement integer.
;Result is integer numeric.
;
CPL:	LD	A,26
	JR	FPPN
;
;DEG - Convert radians to degrees
;Result is floating-point numeric.
;
DEG:	LD	A,21
	JR	FPPN
;
;RAD - Convert degrees to radians
;Result is floating-point numeric.
;
RAD:	LD	A,27
	JR	FPPN
;
;SGN - Return -1, 0 or +1
;Result is integer numeric.
;
SGN:	LD	A,28
	JR	FPPN
;
;INT - Floor function
;Result is integer numeric.
;
INT:	LD	A,23
	JR	FPPN
;
;SQR - square root
;Result is floating-point numeric.
;
SQR:	LD	A,30
	JR	FPPN
;
;TAN - Tangent function
;Result is floating-point numeric.
;
TAN:	LD	A,31
	JR	FPPN
;
;COS - Cosine function
;Result is floating-point numeric.
;
COS:	LD	A,20
	JR	FPPN
;
;SIN - Sine function
;Result is floating-point numeric.
;
SIN:	LD	A,29
	JR	FPPN
;
;EXP - Exponential function
;Result is floating-point numeric.
;
EXP:	LD	A,22
	JR	FPPN
;
;LN - Natural log.
;Result is floating-point numeric.
;
LN:	LD	A,24
	JR	FPPN
;
;LOG - base-10 logarithm.
;Result is floating-point numeric.
;
LOG:	LD	A,25
	JR	FPPN
;
;ASN - Arc-sine
;Result is floating-point numeric.
;
ASN:	LD	A,18
	JR	FPPN
;
;ATN - arc-tangent
;Result is floating-point numeric.
;
ATN:	LD	A,19
	JR	FPPN
;
;ACS - arc-cosine
;Result is floating point numeric.
;
ACS:	LD	A,17
FPPN:	PUSH	AF
	CALL	ITEMN
	POP	AF
FPP1:	CALL	FPP
	JP	C,ERROR
	XOR	A
	RET
;
;SFIX - Convert to fixed-point notation
;
SFIX:	LD	A,38
	JR	FPP1
;
;SFLOAT - Convert to floating-point notation
;
SFLOAT:	LD	A,39
	JR	FPP1
;
;VAL - Return numeric value of string.
;Result is variable type numeric.
;
VAL:	CALL	ITEMS
VAL0:	XOR	A
	LD	(DE),A
	LD	IX,ACCS
	LD	A,36
	JR	FPP1
;
;EVAL - Pass string to expression evaluator.
;Result is variable type (numeric or string).
;
EVAL:	CALL	ITEMS
	LD	A,CR
	LD	(DE),A
	PUSH	IY
	LD	DE,ACCS
	LD	IY,ACCS
	LD	C,0
	CALL	LEXAN2		;TOKENISE
	LD	(DE),A
	INC	DE
	XOR	A
	CALL	PUSHS		;PUT ON STACK
	LD	IY,2
	ADD	IY,SP
	CALL	EXPR
	POP	IY
	ADD	IY,SP
	LD	SP,IY		;ADJUST STACK POINTER
	POP	IY
	EX	AF,AF'
	RET
;
;RND - Random number function.
; RND gives random integer 0-&FFFFFFFF
; RND(-n) seeds random number & returns -n.
; RND(0) returns last value in RND(1) form.
; RND(1) returns floating-point 0-0.99999999.
; RND(n) returns random integer 1-n.
;
RND:	LD	IX,RANDOM
	CALL	NXT
	CP	'('
	JR	Z,RND5		;ARGUMENT FOLLOWS
	CALL	LOAD5
RND1:	RR	C
	LD	B,32
RND2:	EXX			;CALCULATE NEXT
	ADC	HL,HL
	EXX
	ADC	HL,HL
	BIT	3,L
	JR	Z,RND3
	CCF
RND3:	DJNZ	RND2
RND4:	RL	C		;SAVE CARRY
	CALL	STORE5		;STORE NEW NUMBER
	XOR	A
	LD	C,A
	RET
RND5:	CALL	ITEMI
	LD	IX,RANDOM
	BIT	7,H		;NEGATIVE?
	SCF
	JR	NZ,RND4		;SEED
	CALL	TEST
	PUSH	AF
	LD	B,C
	EX	DE,HL
	EXX
	EX	DE,HL
	CALL	LOAD5
	CALL	NZ,RND1		;NEXT IF NON-ZERO
	EXX			;SCRAMBLE (CARE!)
	LD	C,7FH
RND6:	BIT	7,H		;FLOAT
	JR	NZ,RND7
	EXX
	ADD	HL,HL
	EXX
	ADC	HL,HL
	DEC	C
	JR	NZ,RND6
RND7:	RES	7,H		;POSITIVE 0-0.999999
	POP	AF
	RET	Z		;ZERO ARGUMENT
	EXX
	LD	A,E
	DEC	A
	OR	D
	EXX
	OR	E
	OR	D
	RET	Z		;ARGUMENT=1
	LD	B,0		;INTEGER MARKER
	LD	A,10
	CALL	FPP		;MULTIPLY
	JP	C,ERROR
	CALL	SFIX
	JP	ADD1
;
;SUMLEN(array())
;
SUMLEN:	INC	IY		;Skip LEN
	CALL	GETARB
	BIT	7,B
	JP	Z,MISMAT	;Type mismatch
	CALL	ARRLEN
	PUSH	HL
	POP	IX		;IX addresses array
	XOR	A
	LD	H,A
	LD	L,A
	LD	B,A
SUMLN1:	LD	C,(IX)
	ADD	HL,BC
	LD	C,4
	ADD	IX,BC
	DEC	DE		;Count elements
	LD	A,D
	OR	E
	JR	NZ,SUMLN1
	JP	COUNT1
;
;SUM(array())
;
SUM:	CALL	NXT
	CP	TLEN
	JR	Z,SUMLEN
	CALL	GETARB
	BIT	7,B
	JR	NZ,SUMSTR
	PUSH	BC
	CALL	ARRLEN
	PUSH	HL
	POP	IX		;IX addresses array
	CALL	ZERO
	POP	AF		;A = element size
SUMUP:	PUSH	DE
	PUSH	AF
	CALL	DLOADN
	LD	A,11 
	CALL	FPP
	JP	C,ERROR
	POP	AF
	LD	D,0
	LD	E,A
	ADD	IX,DE		;Bump to next element
	POP	DE
	DEC	DE		;Count elements
	LD	B,A
	LD	A,D
	OR	E
	LD	A,B
	JR	NZ,SUMUP
	RET
;
;SUM(string array)
;
SUMSTR:	CALL	ARRLEN
	PUSH	HL
	POP	IX		;IX addresses array
	EX	DE,HL
	LD	DE,ACCS
	LD	B,0
SUMST1:	PUSH	HL
	LD	C,(IX)
	LD	A,C
	OR	A
	JR	Z,SUMST2
	ADD	A,E
	LD	A,19
	JP	C,ERROR		;"String too long"
	LD	L,(IX+2)
	LD	H,(IX+3)
	LDIR
SUMST2:	POP	HL
	LD	C,4
	ADD	IX,BC
	DEC	HL		;Count elements
	LD	A,H
	OR	L
	JR	NZ,SUMST1
	OR	80H
	RET	
;
;MOD(array())
;
MODFUN:	CALL	GETARB
	BIT	7,B
	JP	NZ,MISMAT
	PUSH	BC
	CALL	ARRLEN
	PUSH	HL
	POP	IX		;IX addresses array
	CALL	ZERO
	POP	AF		;A = element size
MODUP:	PUSH	DE
	PUSH	AF
	PUSH	BC
	PUSH	HL
	EXX
	PUSH	HL
	EXX
	CALL	LOADN
	XOR	A
	LD	B,A
	LD	D,A
	LD	E,A
	EXX
	LD	D,A
	LD	E,2
	EXX
	LD	A,14
	PUSH	IX
	CALL	FPP		;Square
	POP	IX
	JP	C,ERROR
	EXX
	EX	DE,HL
	POP	HL
	EXX
	EX	DE,HL
	POP	HL
	LD	A,C
	POP	BC
	LD	B,A
	LD	A,11 
	CALL	FPP		;Accumulate
	JP	C,ERROR
	POP	AF
	LD	D,0
	LD	E,A
	ADD	IX,DE		;Bump to next element
	POP	DE
	DEC	DE		;Count elements
	LD	B,A
	LD	A,D
	OR	E
	LD	A,B
	JR	NZ,MODUP
	LD	A,30
	CALL	FPP		;Square root
	XOR	A
	RET
;
;INSTR - String search.
;Result is integer numeric.
;
INSTR:	CALL	EXPRS		;STRING TO SEARCH
	CALL	COMMA
	CALL	PUSHS		;SAVE STRING ON STACK
	CALL	EXPRS		;SUB-STRING
	POP	BC
	LD	HL,0
	ADD	HL,SP		;HL ADDRESSES MAIN
	PUSH	BC		;C = MAIN STRING LENGTH
	LD	B,E		;B = SUB-STRING LENGTH
	CALL	NXT
	CP	','
	LD	A,0
	JR	NZ,INSTR1
	INC	IY		;SKIP COMMA
	PUSH	BC		;SAVE LENGTHS
	PUSH	HL		;SAVE MAIN ADDRESS
	CALL	PUSHS
	CALL	EXPRI
	POP	BC
	CALL	POPS
	POP	HL		;RESTORE MAIN ADDRESS
	POP	BC		;RESTORE LENGTHS
	EXX
	LD	A,L
	EXX
	OR	A
	JR	Z,INSTR1
	DEC	A
INSTR1:	LD	DE,ACCS		;DE ADDRESSES SUB
	CALL	SEARCH
	POP	DE
	JR	Z,INSTR2	;N.B. CARRY CLEARED
	SBC	HL,HL
	ADD	HL,SP
INSTR2:	SBC	HL,SP
	EX	DE,HL
	LD	H,0
	ADD	HL,SP
	LD	SP,HL
	EX	DE,HL
	CALL	BRAKET
	JP	COUNT1
;
;SEARCH - Search string for sub-string
;   Inputs: Main string at HL length C
;           Sub-string at DE length B
;           Starting offset A
;  Outputs: NZ - not found
;           Z - found at location HL-1
;           Carry always cleared
;
SEARCH:	PUSH	BC
	LD	B,0
	LD	C,A
	ADD	HL,BC		;NEW START ADDRESS
	POP	BC
	SUB	C
	JR	NC,SRCH4
	NEG
	LD	C,A		;REMAINING LENGTH
SRCH1:	LD	A,(DE)
	PUSH	BC
	LD	B,0
	CPIR			;FIND FIRST CHARACTER
	LD	A,C
	POP	BC
	JR	NZ,SRCH4
	LD	C,A
	DEC	B		;Bug fix
	CP	B		;Bug fix
	INC	B		;Bug fix
	JR	C,SRCH4		;Bug fix
	PUSH	BC
	PUSH	DE
	PUSH	HL
	DEC	B
	JR	Z,SRCH3		;FOUND !
SRCH2:	INC	DE
	LD	A,(DE)
	CP	(HL)
	JR	NZ,SRCH3
	INC	HL
	DJNZ	SRCH2
SRCH3:	POP	HL
	POP	DE
	POP	BC
	JR	NZ,SRCH1
	XOR	A		;Z, NC
	RET			;FOUND
;
SRCH4:	OR	0FFH		;NZ, NC
	RET			;NOT FOUND
;
;CHR$ - Return character with given ASCII value.
;Result is string.
;
CHRS:	CALL	ITEMI
	EXX
	LD	A,L
	JR	GET1
;
;GET$ - Return key pressed as string, or read from file
;Result is string.
;
GETS:	CALL	NXT
	CP	'#'
	JR	Z,GET2
	CALL	OSRDCH
GET1:	SCF
	JR	INKEY1
;
GET2:	CALL	CHNL		;File channel
	CALL	NXT
	CP	TBY
	JR	Z,GET3
	CP	TTO
	JR	NZ,GET4
GET3:	INC	IY
	PUSH	AF
	PUSH	DE
	CALL	ITEMI		;Get BY or TO qualifier
	EXX
	LD	B,H
	LD	C,L
	POP	DE
	POP	AF
GET4:	LD	HL,ACCS
	CP	TTO
	JR	Z,GET5
	LD	D,C		;Maximum count
	LD	BC,100H		;Default
	CP	TBY
	JR	Z,GET6
GET5:	LD	D,0
	SET	1,B		;Flag no count
GET6:	PUSH	BC
	CALL	OSBGET
	POP	BC
	BIT	1,B
	JR	Z,GET10
	CP	C
	JR	Z,GET9		;NUL (or supplied term)
	BIT	7,B
	JR	NZ,GET7
	BIT	0,B
	JR	Z,GET8
	CP	LF
	JR	Z,GET9		;LF
GET7:	CP	CR
	JR	Z,GET9		;CR
GET8:	OR	A
GET10:	LD	(HL),A
	INC	L
	DEC	D
	JR	C,GET9		;EOF
	JR	NZ,GET6
GET9:	EX	DE,HL
	LD	A,80H
	RET
;
;INKEY$ - Wait up to n centiseconds for keypress.
; Return key pressed as string or null
; string if time elapsed.
;Result is string.
;
INKEYS:	CALL	ITEMI
	EXX
	CALL	OSKEY
INKEY1:	LD	DE,ACCS
	LD	(DE),A
	LD	A,80H
	RET	NC
	INC	E
	RET
;
;MID$ - Return sub-string.
;Result is string.
;
MIDS:	CALL	EXPRS
	CALL	COMMA
	CALL	PUSHS		;SAVE STRING ON STACK
	CALL	EXPRI
	POP	BC
	CALL	POPS
	EXX
	LD	A,L
	EXX
	OR	A
	JR	Z,MIDS1
	DEC	A
	LD	L,A
	SUB	E
	LD	E,0
	JR	NC,MIDS1
	NEG
	LD	C,A
	CALL	RIGHT1
MIDS1:	CALL	NXT
	CP	','
	JR	Z,LEFT1
	CALL	BRAKET
	LD	A,80H
	RET
;
;LEFT$ - Return left part of string.
;Carry cleared if entire string returned.
;Result is string.
;
LEFTS:	CALL	EXPRS
	CALL	NXT
	CP	','
	JR	Z,LEFT1
	CALL	BRAKET
	LD	A,E
	OR	A
	JR	Z,LEFT3
	DEC	E
	JR	LEFT3
;
LEFT1:	INC	IY
	CALL	PUSHS		;SAVE STRING ON STACK
	CALL	EXPRI
	POP	BC
	CALL	POPS
	CALL	BRAKET
	EXX
	LD	A,L
	EXX
	CP	E
	JR	NC,LEFT3
	LD	L,E		;FOR RIGHT$
LEFT2:	LD	E,A
LEFT3:	LD	A,80H		;STRING MARKER
	RET
;
;RIGHT$ - Return right part of string.
;Result is string.
;
RIGHTS:	CALL	EXPRS
	CALL	NXT
	CP	','
	JR	Z,RIGHT0
	CALL	BRAKET
	LD	A,E
	OR	A
	JR	Z,LEFT3
	DEC	A
	LD	C,1
	JR	RIGHT2
;
RIGHT0:	CALL	LEFT1
	RET	NC
	INC	E
	DEC	E
	RET	Z
	LD	C,E
	LD	A,L
	SUB	E
RIGHT2:	LD	L,A
RIGHT1:	LD	B,0
	LD	H,D
	LD	E,B
	LDIR			;MOVE
	LD	A,80H
	RET
;
;STRING$ - Return n concatenations of a string.
;Result is string.
;
STRING:	CALL	EXPRI
	CALL	COMMA
	EXX
	LD	A,L
	EXX
	PUSH	AF
	CALL	EXPRS
	CALL	BRAKET
	POP	AF
	OR	A
	JR	Z,LEFT2		;N=0
	DEC	A
	LD	C,A
	LD	A,80H		;STRING MARKER
	RET	Z
	INC	E
	DEC	E
	RET	Z		;NULL STRING
	LD	B,E
	LD	H,D
	LD	L,0
STRIN1:	PUSH	BC
STRIN2:	LD	A,(HL)
	INC	HL
	LD	(DE),A
	INC	E
	LD	A,19
	JP	Z,ERROR		;"String too long"
	DJNZ	STRIN2
	POP	BC
	DEC	C
	JR	NZ,STRIN1
	LD	A,80H
	RET
;
;SUBROUTINES
;
;TEST - Test HLH'L' for zero
;  Outputs: Z-flag set & A=0 if zero
; Destroys: A,F
;
TEST:	LD	A,H
	OR	L
	EXX
	OR	H
	OR	L
	EXX
	RET
;
;DECODE - Decode line number in pseudo-binary.
;   Inputs: IY = Text pointer.
;  Outputs: HL=0, H'L'=line number, C=0.
; Destroys: A,C,H,L,H',L',IY,F
;
DECODE:	EXX
	LD	A,(IY)
	INC	IY
	RLA
	RLA
	LD	H,A
	AND	0C0H
	XOR	(IY)
	INC	IY
	LD	L,A
	LD	A,H
	RLA
	RLA
	AND	0C0H
	XOR	(IY)
	INC	IY
	LD	H,A
	EXX
	XOR	A
	LD	C,A
	LD	H,A
	LD	L,A
	RET
;
;HEXSTR - convert numeric value to HEX string.
;   Inputs: HLH'L'C = integer or floating-point number
;  Outputs: String in string accumulator.
;           E = string length. D = ACCS/256
;
HEXSTS:	INC	IY		;SKIP TILDE
	CALL	ITEMN
	CALL	HEXSTR
	LD	A,80H
	RET
;
HEXSTR:	CALL	SFIX
	LD	BC,8
	LD	DE,ACCS
HEXST1:	PUSH	BC
	LD	B,4
	XOR	A
HEXST2:	EXX
	ADD	HL,HL
	EXX
	ADC	HL,HL
	RLA
	DJNZ	HEXST2
	POP	BC
	DEC	C
	RET	M
	JR	Z,HEXST3
	OR	A
	JR	NZ,HEXST3
	CP	B
	JR	Z,HEXST1
HEXST3:	ADD	A,90H
	DAA
	ADC	A,40H
	DAA
	LD	(DE),A
	INC	DE
	LD	B,A
	JR	HEXST1
;
;Function STR - convert numeric value to ASCII string.
;   Inputs: HLH'L'C = integer or floating-point number.
;  Outputs: String in string accumulator.
;           E = length, D = ACCS/256
;           A = 80H (type=string)
;
;First normalise for decimal output:
;
STRS:	CALL	NXT
	CP	'~'
	JR	Z,HEXSTS
	CALL	ITEMN
	LD	IX,STAVAR
	LD	A,(IX+3)
	OR	A
	LD	IX,G9-1		;G9 FORMAT
	JR	Z,STR0
STR:	LD	IX,STAVAR
STR0:	LD	DE,ACCS
	LD	A,37
	CALL	FPP
	JP	C,ERROR
	BIT	0,(IX+2)
STR1:	LD	A,80H		;STRING MARKER
	RET	Z
	LD	A,C
	ADD	A,4
STR2:	CP	E
	JR	Z,STR1
	EX	DE,HL
	LD	(HL),' '	;TRAILING SPACE
	INC	HL
	EX	DE,HL
	JR	STR2
;
G9:	DEFW	9
;
;STRING COMPARE
;Compare string (DE) length B with string (HL) length C.
;Result preset to false.
;
SCP:	CALL	SCP0
ZERO:	LD	A,0
	EXX
	LD	H,A
	LD	L,A
	EXX
	LD	H,A
	LD	L,A
	LD	C,A
	RET
;
SCP0:	INC	B
	INC	C
SCP1:	DEC	B
	JR	Z,SCP2
	DEC	C
	JR	Z,SCP3
	LD	A,(DE)
	CP	(HL)
	RET	NZ
	INC	DE
	INC	HL
	JR	SCP1
SCP2:	OR	A
	DEC	C
	RET	Z
	SCF
	RET
SCP3:	OR	A
	INC	C
	RET
;
;PUSH$ - SAVE STRING ON STACK.
;   Inputs: String in string accumulator.
;           E = string length.
;           A - saved on stack.
; Destroys: B,C,D,E,H,L,IX,SP,F
;
PUSHS:	LD	HL,ACCS
	CALL	CHECK
	POP	IX		;RETURN ADDRESS
	OR	A		;CLEAR CARRY
	LD	D,H
	LD	C,E
	SBC	HL,DE
	ADD	HL,SP
	LD	SP,HL
	LD	B,A
	PUSH	BC
	JR	Z,PUSHS1	;ZERO LENGTH
	EX	DE,HL
	LD	B,0
	LD	L,B		;L=0
	LDIR			;COPY TO STACK
	CALL	CHECK
PUSHS1:	JP	(IX)		;"RETURN"
;
;POP$ - RESTORE STRING FROM STACK.
;   Inputs: C = string length.
;  Outputs: String in string accumulator.
;           E = string length.
; Destroys: B,C,D,E,H,L,IX,SP,F
;
POPS:	POP	IX		;RETURN ADDRESS
	LD	HL,0
	LD	B,H		;B=0
	ADD	HL,SP
	LD	DE,ACCS
	INC	C
	DEC	C
	JR	Z,POPS1		;ZERO LENGTH
	LDIR			;COPY FROM STACK
POPS1:	LD	SP,HL
	JP	(IX)		;"RETURN"
;
BINDIG:	LD	A,(IY)
	CP	'0'
	RET	C
	CP	'1'+1
	CCF
	RET	C
	SUB	'0'
	RET
;
HEXDIG:	LD	A,(IY)
	CP	'0'
	RET	C
	CP	'9'+1
	CCF
	RET	NC
	CP	'A'
	RET	C
	SUB	'A'-10
	CP	16
	CCF
	RET
;
RELOPQ:	CP	'>'
	RET	NC
	CP	'='
	RET	NC
	CP	'<'
	RET
;
SAVE:	INC	IY
	AND	0FH
SAVE1:	EX	AF,AF'
	JP	M,MISMAT
	EX	AF,AF'
	EX	(SP),HL
	EXX
	PUSH	HL
	EXX
	PUSH	AF
	PUSH	BC
	JP	(HL)
;
DOIT:	EX	AF,AF'
	JP	M,MISMAT
	EXX
	POP	BC		;RETURN ADDRESS
	EXX
	LD	A,C
	POP	BC
	LD	B,A
	POP	AF		;OPERATOR
	EXX
	EX	DE,HL
	POP	HL
	EXX
	EX	DE,HL
	POP	HL
	EXX
	PUSH	BC
	EXX
	CALL	FPP
	JR	C,ERROR1
	XOR	A
	EX	AF,AF'		;TYPE
	LD	A,(IY)
	RET
;
COMMA:	CALL	NXT
	INC	IY
	CP	','
	RET	Z
	LD	A,5
	JR	ERROR1		;"Missing ,"
;
BRAKET:	CALL	NXT
	INC	IY
	CP	')'
	RET	Z
	LD	A,27
ERROR1:	JP	ERROR		;"Missing )"
;
DISPT2:	PUSH	HL
	LD	HL,SOPTBL
	JR	DISPT0
;
DISPAT:	PUSH	HL
	SUB	FUNTOK
	LD	HL,FUNTBL
DISPT0:	PUSH	BC
	ADD	A,A
	LD	C,A
	LD	B,0
	ADD	HL,BC
	LD	A,(HL)
	INC	HL
	LD	H,(HL)
	LD	L,A
	POP	BC
	EX	(SP),HL
	RET			;OFF TO ROUTINE
;
STOREA:	LD	A,D
	PUSH	DE
	PUSH	HL
	EX	(SP),IX
	OR	A
	JP	M,STORA1
	CALL	LOADN
	EX	(SP),IX
	CALL	MODIFY
	POP	HL
	POP	DE
	LD	C,D
	LD	B,0
	RET
;
STORA1:	PUSH	DE
	CALL	LOADS
	POP	HL
	EX	(SP),IX
	CALL	MODIFS
	POP	HL
	POP	DE
	LD	BC,4
	RET
;
; Assign to whole array:
; array1() = array expression
; array1() = n1,n2,n3,n4...
; array1() = n (n copied into all elements)
;
; Inputs: D = type (65, 68, 69, 193)
;         E = opcode ('=' for store, '+','-' etc. for modify)
;         HL = IX = VARPTR
;         IY = text pointer
;
LETARR:	RES	6,D		;Lose array marker
	PUSH	DE		;Save type & opcode
	CALL	GETAR1		;Get and check indirect link
	CALL	ARRLEN		;DE = elements, HL addresses first
	POP	BC
	LD	A,B		;A = type
	PUSH	DE
	PUSH	BC
	PUSH	HL
	CALL	X14OR5		;DE = size in bytes
	LD	B,D
	LD	C,E
	POP	IX
	POP	DE
;
; (SP) = number of elements
; BC = size in bytes
; DE = type & opcode
; IX = address of first element
;
; allocate space on stack and zero it:
;
	XOR	A		;Clear carry and zero error code
	SBC	HL,HL
	ADD	HL,SP		;HL = SP
	SBC	HL,BC
	JR	C,ERROR1	;'No room'
	PUSH	BC
	LD	BC,(FREE)
	INC	B		;Safety margin
	SBC	HL,BC
	ADD	HL,BC
	POP	BC
	JR	C,ERROR1	;'No room'
	LD	SP,HL	
LETA0:	LD	(HL),0
	INC	HL
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,LETA0	;Clear allocated stack
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	LD	H,A
	LD	L,A
	ADD	HL,SP
;
;	CALL	NXT
;	CP	TEVAL		;;EVAL not currently supported
;
	CALL	EXPRA
	LD	SP,HL		;Update stack pointer
	POP	BC		;Level stack
	JP	XEQ
;
; EXPRA - Evaluate array expression, strictly left-to-right;
; Note: String array arithmetic (concatenation) is not supported
; because it would require a way of recovering freed string space.
;
;   Inputs: BC = number of elements
;           DE = type & opcode
;           HL = address of temporary stack space
;           IX = address of first element of array
;  Outputs: HL = value to set stack pointer to
;
EXPRA:	LD	A,'='
	DEC	IY
EXPRA1:	INC	IY
	PUSH	DE
	PUSH	BC
	PUSH	HL
	PUSH	IX
	LD	E,A		;Operator
	CALL	ITEMA
	POP	IX
	POP	HL
	POP	BC
	POP	DE
	CALL	NXT
	CP	','		;List?
	JR	Z,EXPRA3
	CALL	TERMQ
	JR	NZ,EXPRA1
;
; Update destination array from stack:
;
EXPRA2:	PUSH	BC
	CALL	STOREA		;(IX) <- (HL)
	ADD	HL,BC
	ADD	IX,BC
	POP	BC
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,EXPRA2
	RET
;
; Update destination array from list (n.b. not transferred via stack):
;
EXPRA3:	PUSH	BC
	CALL	STOREA		;(IX) <- (HL)
EXPRA4:	INC	IY		;Bump past comma
	ADD	HL,BC
	ADD	IX,BC
	POP	BC
	DEC	BC
	LD	A,B
	OR	C
	RET	Z
	PUSH	BC
	PUSH	DE
	PUSH	HL
	PUSH	IX
	BIT	7,D
	JR	NZ,EXPRA5
	PUSH	DE
	CALL	EXPRN
	POP	DE
	POP	IX
	PUSH	IX
	CALL	MODIFY
	JR	EXPRA6
;
EXPRA5:	PUSH	DE
	CALL	EXPRS
	POP	HL
	POP	IX
	PUSH	IX
	CALL	MODIFS
EXPRA6:	POP	IX
	POP	HL
	POP	DE
	LD	BC,4
	BIT	7,D
	JR	NZ,EXPRA7
	LD	C,D
EXPRA7:	CALL	NXT
	CP	','
	JR	Z,EXPRA4
	POP	DE
EXPRA8:	ADD	HL,BC		;Skip remaining elements
	DEC	DE
	LD	A,D
	OR	E
	JR	NZ,EXPRA8
	RET
;
; ITEMA: evaluate and operate on array item
;   Inputs: D = type
;           E = operator ('=' for first item)
;           BC = number of elements
;           HL = pointer to destination on stack
;           IY = text pointer
;  Outputs: IY updated
; Destroys: Everything except SP
;
ITEMA:	CALL	NXT
	PUSH	HL		;Pointer to destination
	PUSH	BC		;Number of elements
	PUSH	IY		;In case normal expression
	PUSH	DE		;Ditto
	CP	'-'
	JR	NZ,ITEMA1	;Not unary minus
	LD	A,E
	CP	'='
	JR	NZ,ITEMA1	;Not unary minus
	INC	IY		;Bump past '-'
	CALL	NXT
	LD	E,'-'		;Unary minus
ITEMA1:	PUSH	DE		;Type and operator
	CALL	GETVAR
	POP	DE		;Type & operator
	JR	NZ,ITEMA4	;Non-array expression
	BIT	6,A
	JR	Z,ITEMA4	;Not a whole array
	POP	BC		;Junk saved original op
	POP	BC		;Junk saved text pointer
	RES	6,A
	CP	D
	JP	NZ,MISMAT	;'Type mismatch'
	PUSH	DE		;Save type & operator again
	CALL	GETAR1
	CALL	ARRLEN
	LD	B,D		;BC = number of elements
	LD	C,E
	POP	DE		;Restore type & operator
	EX	(SP),HL
	CALL	NXT
	POP	IX		;Pointer to source
	CP	'.'
	JP	Z,ARRDOT	;Dot product
	OR	A
	SBC	HL,BC		;Same number of elements?
	JP	NZ,MISMAT	;'Type mismatch'	
	POP	HL		;Pointer to destination
	BIT	7,D
	JR	NZ,ITEMA3
;
; Process numeric array item:
;
ITEMA2:	PUSH	BC
	PUSH	HL
	LD	A,D
	CALL	LOADN
	EX	(SP),IX
	PUSH	DE
	CALL	MODIFY
	POP	DE
	EX	(SP),IX
	POP	HL
	LD	C,D
	LD	B,0
	ADD	IX,BC
	ADD	HL,BC
	POP	BC
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,ITEMA2
	RET
;
; Process string array item (just copy descriptors):
;
ITEMA3:	EX	DE,HL		;DE = destination
	LD	H,B
	LD	L,C
	ADD	HL,HL
	ADD	HL,HL
	LD	B,H
	LD	C,L
	PUSH	IX
	POP	HL		;HL = source
	LDIR
	RET
;
; Process numeric non-array item:
;
ITEMA4:	POP	DE		;Restore original operator
	POP	IY		;Restore original text pointer
	BIT	7,D
	JR	NZ,ITEMA5
	PUSH	DE
	CALL	EXPR45		;; should be EXP345
	LD	A,C		;Exponent
	POP	DE		;Type / operator
	POP	BC		;Count
	POP	IX
ITEMA7:	PUSH	HL
	PUSH	BC
	PUSH	DE
	EXX
	PUSH	HL
	EXX
	PUSH	AF
	LD	C,A
	CALL	MODIFY
	POP	AF
	EXX
	POP	HL
	EXX
	POP	DE
	LD	C,D
	LD	B,0
	ADD	IX,BC
	POP	BC
	DEC	BC
	SBC	HL,HL
	SBC	HL,BC
	POP	HL
	JR	NZ,ITEMA7	;Copy into every element!
	RET
;
; Process string non-array item:
;
ITEMA5:	CALL	EXPRS
	LD	A,E
	OR	A
	JR	Z,ITEMA0
	LD	HL,ACCS
	LD	DE,BUFFER
	LD	C,A
	LD	B,0
	LDIR
ITEMA0:	POP	BC
	POP	IX
	EXX
	LD	L,A
	EXX
	LD	DE,4
	LD	HL,BUFFER
ITEMA6:	CALL	STORE4
	ADD	IX,DE
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,ITEMA6	;Copy into every element!
	RET
;
; Array dot-product:
;
ARRDOT:	INC	IY		;Bump past dot
	LD	A,D		;Type
	OR	A
	JP	M,MISMAT	;'Type mismatch'
	EX	DE,HL
	POP	HL
;
; A = type
; DE = no. of elements in destination array (outer loop counter)
; IX = pointer to first source array data
; HL = pointer to destination data
; IY = text pointer
;
	PUSH	DE
	PUSH	HL
	PUSH	IX
	PUSH	AF
	CALL	GETARR
	CALL	ARRLEN
	POP	AF
	EX	DE,HL
	LD	L,(IX)
	LD	H,(IX+1)	;Indirect pointer
	LD	L,(HL)		;No. of dimensions
	DEC	L
	EX	DE,HL
	POP	IX
	POP	BC
	POP	DE
;
	PUSH	IY		;Save text pointer
	PUSH	BC		;Save destination pointer
	PUSH	HL
	POP	IY
;
; Get row counts:
;
	LD	HL,1
	JR	Z,ARR1D
	LD	H,(IY-1)
	LD	L,(IY-2)
ARR1D:	PUSH	DE
	EX	DE,HL
	CALL	X14OR5
	EX	DE,HL
	POP	DE
	LD	B,(IX-1)
	LD	C,(IX-2)
;
; A = type, Z-flag set if first array is one-dimensional
; BC = no. of rows of first source array (inner loop counter)
; DE = no. of elements in destination array (outer loop counter)
; HL = no. of rows of second source array * size of each element
; IX = pointer to first source array
; IY = pointer to second source array
; (SP) = pointer to destination data
;
; Dot-product outer loop:
;
OUTER:	PUSH	BC		;1
	PUSH	DE		;2
	PUSH	HL		;3
	PUSH	IX		;4
	PUSH	IY		;5
	LD	D,B
	LD	E,C
	PUSH	AF
	CALL	ZERO		;Zero accumulator
	POP	AF
INNER:	PUSH	DE		;6
	PUSH	BC		;Save accumulator
	PUSH	HL
	EXX
	PUSH	HL
	EXX
;
	CALL	LOADN		;Load from (IX)
	PUSH	IX
	EX	(SP),IY
	POP	IX
;
	CALL	DLOADN		;Load from (IY)
	PUSH	IX
	EX	(SP),IY
	POP	IX
;
	PUSH	AF
	LD	A,10
	CALL	FPP		;Multiply
	JP	C,ERROR
	POP	AF
;
	EXX			;Restore accumulator
	EX	DE,HL
	POP	HL
	EXX
	EX	DE,HL
	POP	HL
	EX	AF,AF'
	LD	A,C
	POP	BC
	LD	B,A
	EX	AF,AF'
;
	PUSH	AF
	LD	A,11
	CALL	FPP		;Accumulate
	JP	C,ERROR
	POP	AF
;
; Bump pointers:
;
	POP	DE		;5
;
	EXX
	LD	C,A
	LD	B,0
	ADD	IX,BC
	POP	DE
	POP	BC
	EX	(SP),HL
	EX	DE,HL
	ADD	IY,DE
	EX	DE,HL
	EX	(SP),HL
	PUSH	BC
	PUSH	DE
	EXX
;
; Count inner loops:
;
	DEC	DE		;Inner loop counter
	INC	E
	DEC	E
	JR	NZ,INNER
	INC	D
	DEC	D
	JR	NZ,INNER
;
	POP	IY		;4
	POP	IX		;3
;
; Swap pointers:
;
	EXX
	EX	AF,AF'
	POP	AF
	POP	BC
	POP	DE
	EX	(SP),IX
	PUSH	DE
	PUSH	BC
	PUSH	AF
	EX	AF,AF'
	EXX
;
; Save to destination array and bump pointer:
;
	PUSH	AF
	PUSH	DE
	CALL	STOREN
	POP	DE
	POP	AF
	LD	C,A
	LD	B,0
	ADD	IX,BC
;
; Swap pointers:
;
	EXX
	EX	AF,AF'
	POP	AF
	POP	BC
	POP	DE
	EX	(SP),IX
	PUSH	DE
	PUSH	BC
	PUSH	AF
	EX	AF,AF'
	EXX
;
	POP	HL		;2
	POP	DE		;1 Outer loop counter
	POP	BC		;0
	DEC	DE		;Count outer loops
;
; Adjust IX & IY
;
	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	C,A
	LD	B,0
	ADD	IY,BC
	PUSH	AF
	PUSH	HL
	CALL	X14OR5
	POP	BC
	CALL	MOD16
	POP	AF
	OR	A
	LD	BC,0
	SBC	HL,BC
	POP	HL
	POP	DE
	POP	BC
	JR	NZ,MODNZ
	PUSH	DE
	PUSH	HL
	EX	DE,HL
	PUSH	IY
	POP	HL
	OR	A
	SBC	HL,DE
	PUSH	HL
	POP	IY
	LD	D,B
	LD	E,C
	CALL	X14OR5
	ADD	IX,DE
	POP	HL
	POP	DE
MODNZ:
;
; Count outer loops:
;
	INC	E
	DEC	E
	JP	NZ,OUTER
	INC	D
	DEC	D
	JP	NZ,OUTER
;
; Exit:
;
	POP	HL
	POP	IY
	RET
;
; HL = DE MOD BC
;
MOD16:	XOR	A
	LD	H,A
	LD	L,A
	LD	A,17
MOD160:	SBC	HL,BC
	JR	NC,MOD161
	ADD	HL,BC
MOD161:	CCF
	RL	E
	RL	D
	DEC	A
	RET	Z
	ADC	HL,HL
	JR	MOD160
;
	END