;
;  SYSTEM INTERFACE
;
;	file	'8k Basic'

        .PROJECT        basic.com
        .ORG    100h

BASIC:				;FULL RESTART INITIALIZATION
SYSINITJ:
	JMP	INITIALZ
REENTERBASIC:			;REENTER AFTER PAUSE
	JMP	cmndrstr

cdata   equ     9h

;
;  NON-BLOCKING INPUT
;   CHAR IN AC IF NOT ZERO
;   ZERO SET IF NONE
;
SYSKEYIN:
        mvi     a,10h
        out     cdata           ;Flash cursor
        in	cdata		;get character
	ora	a		;check if character available
	ret

;
;  SEND AC TO SCREEN
;
SYSDISPL:
	out	cdata
	RET
;
;  CHECK FOR BREAK REQUEST
;   SET ZERO TO BREAK
;
SYSBREAK:
	mvi	a,1
	ora	a
	ret

;
;  DELAY
;
SYSWAIT:
	RET
;
;  RETURN TO MONITOR
;
MONITOR	EQU	0F800H
SYSQUIT:
	JMP	MONITOR
CR	EQU	0DH
LF	EQU	0AH
BEL	EQU	07H
BS	EQU	08H
TAB	EQU	09H
HT	EQU	09H
CD1	EQU	11H
DEL	EQU	7FH
SI	EQU	0FH
ETX	EQU	03H
FF	EQU	0CH
ESC	EQU	18H
;
KEYSTM	EQU	80H		;STATEMENT CODES
KEYDAT	EQU	KEYSTM
KEYREM	EQU	KEYDAT+1
KEYLSAL	EQU	KEYREM+1
KEYEND	EQU	KEYLSAL
KEYFOR	EQU	KEYEND+1
KEYNEX	EQU	KEYFOR+1
KEYINPT	EQU	KEYNEX+1
KEYDIM	EQU	KEYINPT+1
KEYREA	EQU	KEYDIM+1
KEYLET	EQU	KEYREA+1
KEYGTO	EQU	KEYLET+1
KEYRUN	EQU	KEYGTO+1
KEYIF	EQU	KEYRUN+1
KEYELS	EQU	KEYIF+1
KEYRES	EQU	KEYELS+1
KEYGSB	EQU	KEYRES+1
KEYRET	EQU	KEYGSB+1
KEYSTOP	EQU	KEYRET+1
KEYON	EQU	KEYSTOP+1
KEYAUT	EQU	KEYON+1
KEYDEL	EQU	KEYAUT+1
KEYPLT	EQU	KEYDEL+1
KEYWAI	EQU	KEYPLT+1
KEYPRT	EQU	KEYWAI+1
KEYDEF	EQU	KEYPRT+1
KEYCON	EQU	KEYDEF+1
KEYLIS	EQU	KEYCON+1
KEYEDI	EQU	KEYLIS+1
KEYCLR	EQU	KEYEDI+1
KEYCLD	EQU	KEYCLR+1
KEYCSV	EQU	KEYCLD+1
KEYNEW	EQU	KEYCSV+1
KEYSET	EQU	KEYNEW+1
KEYSUGR	EQU	KEYSET+1
KEYLSBL	EQU	KEYSUGR
KEYTHEN	EQU	KEYSUGR
KEYTO	EQU	KEYTHEN+1
KEYSTEP	EQU	KEYTO+1
KEYLSBH	EQU	KEYSTEP+1
KEYPRM	EQU	KEYLSBH
KEYLINE	EQU	KEYPRM+1
KEYLSAH	EQU	KEYLINE+1
KEYTAB	EQU	KEYLSAH
KEYSPC	EQU	KEYTAB+1
KEYFN	EQU	KEYSPC+1
KEYNOT	EQU	KEYFN+1
KEYOFF	EQU	KEYNOT+1
;
KEYOPR	EQU	KEYOFF+1	;OPERATOR CODES
KEYADD	EQU	KEYOPR
KEYSUB	EQU	KEYADD+1
KEYMUL	EQU	KEYSUB+1
KEYDIV	EQU	KEYMUL+1
KEYMOD	EQU	KEYDIV+1
KEYEXPT	EQU	KEYMOD+1
KEYAND	EQU	KEYEXPT+1
KEYOR	EQU	KEYAND+1
KEYMAX	EQU	KEYOR+1
KEYMIN	EQU	KEYMAX+1
;
KEYREL	EQU	KEYMIN+1	;RELATION CODES
KEYGT	EQU	KEYREL
KEYEQ	EQU	KEYGT+1
KEYLT	EQU	KEYEQ+1
;
KEYFCT	EQU	KEYLT+1		;FUNCTION CODES
KEYSGN	EQU	KEYFCT
KEYINT	EQU	KEYSGN+1
KEYABS	EQU	KEYINT+1
KEYSQR	EQU	KEYABS+1
KEYRND	EQU	KEYSQR+1
KEYLOG	EQU	KEYRND+1
KEYEXP	EQU	KEYLOG+1
KEYCOS	EQU	KEYEXP+1
KEYSIN	EQU	KEYCOS+1
KEYTAN	EQU	KEYSIN+1
KEYATA	EQU	KEYTAN+1
KEYUSR	EQU	KEYATA+1
KEYFRE	EQU	KEYUSR+1
KEYPORT	EQU	KEYFRE+1
KEYPOS	EQU	KEYPORT+1
KEYMEM	EQU	KEYPOS+1
KEYLEN	EQU	KEYMEM+1
KEYSTR	EQU	KEYLEN+1
KEYVAL	EQU	KEYSTR+1
KEYASC	EQU	KEYVAL+1
KEYCHR	EQU	KEYASC+1
KEYHEX	EQU	KEYCHR+1
KEYHXV	EQU	KEYHEX+1
KEYUPR	EQU	KEYHXV+1
KEYLFT	EQU	KEYUPR+1
KEYRIG	EQU	KEYLFT+1
KEYMID	EQU	KEYRIG+1
KEYINS	EQU	KEYMID+1
;
KEYS	EQU	KEYINS+1	;LAST ENTRY
STMTABL:			;STATEMENT ROUTINES
	DW	DATSTM
	DW	REMSTM
				;LISTED WITH BLANK AFTER
	DW	ENDSTM
	DW	FORSTM
	DW	NEXSTM
	DW	INPSTM
	DW	DIMSTM
	DW	REASTM
	DW	LETSTM
	DW	GTOSTM
	DW	RUNSTM
	DW	IFSTM
	DW	ELSSTM
	DW	RESSTM
	DW	GSBSTM
	DW	RETSTM
	DW	STPSTM
	DW	ONSTM
	DW	AUTSTM
	DW	DELSTM
	DW	PLTSTM
	DW	WAISTM
	DW	PRTSTM
	DW	DEFSTM
	DW	CONSTM
	DW	LISSTM
	DW	EDISTM
	DW	CLRSTM
	DW	CLDSTM
	DW	CSVSTM
	DW	NEWSTM
	DW	SETSTM
OPRTABL:			;OPERATORS AND PRECEDENCE
	DB	79H
	DW	ADDOPR
	DB	79H
	DW	SUBOPR
	DB	7BH
	DW	MULOPR
	DB	7BH
	DW	DIVOPR
	DB	7BH
	DW	MODOPR
	DB	7FH
	DW	EXPOPR
	DB	50H
	DW	ANDOPR
	DB	46H
	DW	ORNOPR
	DB	76H
	DW	MAXOPR
	DB	76H
	DW	MINOPR
FCTTABL:				;FUNCTION ROUTINES
	DW	SGNFCT
	DW	INTFCT
	DW	ABSFCT
	DW	SQRFCT
	DW	RNDFCT
	DW	LOGFCT
	DW	EXPFCT
	DW	COSFCT
	DW	SINFCT
	DW	TANFCT
	DW	ATNFCT
	DW	ERRAFC
	DW	FREFCT
	DW	PORFCT
	DW	POSFCT
	DW	MEMFCT
	DW	LENFCT
	DW	STRFCT
	DW	VALFCT
	DW	ASCFCT
	DW	CHRFCT
	DW	HEXFCT
	DW	HXVFCT
	DW	UPRFCT
	DW	LFTFCT
	DW	RIGFCT
	DW	MIDFCT
	DW	INSFCT
KEYWADDS:			;POINTERS TO KEYWORD GROUPS
	DW	KEYWRD0, KEYWRD1, KEYWRD2, KEYWRD3
	DW	KEYWRD4, KEYWRD5, KEYWRD6, KEYWRD7
	DW	KEYWRD8, KEYWRD9, KEYWRDA, KEYWRDB
	DW	KEYWRDC, KEYWRDD, KEYWRDE, KEYWRDF
KEYWORDS:
KEYWRD0:
	DB	KEYPLT, 'PLO', 'T'+128
	DB	KEYPRT, 'PRIN', 'T'+128
	DB	KEYPRM, 'PROMP', 'T'+128
	DB	KEYPORT, 'POR', 'T'+128
	DB	KEYPOS-80H, 'PO', 'S'+128
KEYWRD1:
	DB	KEYAUT, 'AUT', 'O'+128
	DB	KEYAND, 'AN', 'D'+128
	DB	KEYABS, 'AB', 'S'+128
	DB	KEYATA, 'AT', 'N'+128
	DB	KEYASC-80H, 'AS', 'C'+128
KEYWRD2:
	DB	KEYREM, 'RE', 'M'+128
	DB	KEYREA, 'REA', 'D'+128
	DB	KEYRUN, 'RU', 'N'+128
	DB	KEYRES, 'RESTOR', 'E'+128
	DB	KEYRET, 'RETUR', 'N'+128
	DB	KEYRND, 'RN', 'D'+128
	DB	KEYRIG-80H, 'RIGHT', '$'+128
KEYWRD3:
	DB	KEYSTOP, 'STO', 'P'+128
	DB	KEYCON, 'CON', 'T'+128
	DB	KEYCLR, 'CLEA', 'R'+128
	DB	KEYCSV, 'SAV', 'E'+128
	DB	KEYSET, 'SE', 'T'+128
	DB	KEYSTEP, 'STE', 'P'+128
	DB	KEYSPC, 'SP', 'C'+128
	DB	KEYSGN, 'SG', 'N'+128
	DB	KEYSQR, 'SQ', 'R'+128
	DB	KEYCOS, 'CO', 'S'+128
	DB	KEYSIN, 'SI', 'N'+128
	DB	KEYSTR, 'STR', '$'+128
	DB	KEYCHR-80H, 'CHR', '$'+128
KEYWRD4:
	DB	KEYDAT, 'DAT', 'A'+128
	DB	KEYDIM, 'DI', 'M'+128
	DB	KEYDEL, 'DELET', 'E'+128
	DB	KEYDEF, 'DE', 'F'+128
	DB	KEYTHEN, 'THE', 'N'+128
	DB	KEYTO, 'T', 'O'+128
	DB	KEYTAB, 'TA', 'B'+128
	DB	KEYTAN-80H, 'TA', 'N'+128
KEYWRD5:
	DB	KEYEND, 'EN', 'D'+128
	DB	KEYELS, 'ELS', 'E'+128
	DB	KEYEDI, 'EDI', 'T'+128
	DB	KEYEXP, 'EX', 'P'+128
	DB	KEYUSR, 'US', 'R'+128
	DB	KEYUPR-80H, 'UPPER', '$'+128
KEYWRD6:
	DB	KEYFOR, 'FO', 'R'+128
	DB	KEYFN, 'F', 'N'+128
	DB	KEYFRE, 'FR', 'E'+128
	DB	KEYVAL-80H, 'VA', 'L'+128
KEYWRD7:
	DB	KEYGTO, 'GOT', 'O'+128
	DB	KEYGSB, 'GOSU', 'B'+128
	DB	KEYWAI-80H, 'WAI', 'T'+128
KEYWRD8:
	DB	KEYHEX, 'HEX', '$'+128
	DB	KEYHXV-80H, 'HEX', 'V'+128
KEYWRD9:
	DB	KEYINPT, 'INPU', 'T'+128
	DB	KEYIF, 'I', 'F'+128
	DB	KEYINT, 'IN', 'T'+128
	DB	KEYINS-80H, 'INST', 'R'+128
KEYWRDA:
	DB	KEYMUL-80H, '*'+128
KEYWRDB:
	DB	KEYADD-80H, '+'+128
KEYWRDC:
	DB	KEYLET, 'LE', 'T'+128
	DB	KEYLIS, 'LIS', 'T'+128
	DB	KEYCLD, 'LOA', 'D'+128
	DB	KEYLINE, 'LIN', 'E'+128
	DB	KEYLT, '<'+128
	DB	KEYLOG, 'LO', 'G'+128
	DB	KEYLEN, 'LE', 'N'+128
	DB	KEYLFT-80H, 'LEFT', '$'+128
KEYWRDD:
	DB	KEYSUB, '-'+128
	DB	KEYMOD, 'MO', 'D'+128
	DB	KEYMAX, 'MA', 'X'+128
	DB	KEYMIN, 'MI', 'N'+128
	DB	KEYEQ, '='+128
	DB	KEYMEM, 'ME', 'M'+128
	DB	KEYMID-80H, 'MID', '$'+128
KEYWRDE:
	DB	KEYNEX, 'NEX','T'+128
	DB	KEYNEW, 'NE','W'+128
	DB	KEYNOT, 'NO','T'+128
	DB	KEYEXPT, '^'+128
	DB	KEYGT-80H, '>'+128
KEYWRDF:
	DB	KEYPRT, '?'+128
	DB	KEYON, 'O', 'N'+128
	DB	KEYOFF, 'OF', 'F'+128
	DB	KEYDIV, '/'+128
	DB	KEYOR-80H, 'O', 'R'+128

ERRN:					;ERROR CODES
ERRNCN:
	DB	'CONTINUE',0		;CONTINUE ERROR
ERRNSL:
	DB	'DEVICE',0		;SAVE/LOAD DEVICE ERROR
ERRNDD:
	DB	'DIMENSION',0		;DOUBLE DIMENSION
ERRNID:
	DB	'DIRECT',0		;ILLEGAL DIRECT
ERRND0:
	DB	'DIVIDE BY 0',0		;DIVISION BY ZERO
ERRNFC:
	DB	'FUNCTION CALL',0	;FUNCTION CALL
ERRNLS:
	DB	'LONG STRING',0		;LONG STRING
ERRNOM:
	DB	'MEMORY SPACE',0	;OUT OF MEMORY
ERRNNF:
	DB	'NEXT W/O FOR',0	;NEXT WITHOUT FOR
ERRNOD:
	DB	'OUT OF DATA',0		;OUT OF DATA
ERRNOV:
	DB	'OVERFLOW',0		;OVERFLOW
ERRNRG:
	DB	'RETN W/O GOSUB',0	;RETURN WITHOUT GOSUB
ERRNOS:
	DB	'STRING SPACE',0	;OUT OF STRING SPACE
ERRNST:
	DB	'STRING TEMPS',0	;STRING TEMPORARIES
ERRNBS:
	DB	'SUBSCRIPT',0		;BAD SUBSCRIPT
ERRNSN:
	DB	'SYNTAX',0		;SYNTAX ERROR
ERRNTM:
	DB	'TYPE',0		;TYPE MISMATCH
ERRNUF:
	DB	'UNDFND FUNCTION',0	;UNDEFINED FUNCTION
ERRNUS:
	DB	'UNDFND LINE',0		;UNDEFINED STATEMENT
ERRNUV:
	DB	'UNDFND VARIABLE',0	;UNDEFINED VARIABLE
ERRNFI:
	DB	'File not Saved',0	;unknown file name

;
;  INTERPRETER VARIABLES
;
;            VARIABLES MARKED WITH SAME CHARACTER IN COLUMN 71
;               ARE FIXED IN THAT ORDER.
;
p3010:	    db	1		;0 to print on 3010	
REAINPFL:   DB	0		;READ/INPUT FLAG	
PRINTFLG:   DB	0		;PRINT/NO PRINT FLAG	
TRACEFLG:   DB	1		;TRACE/NO TRACE FLAG
SCANPFLG:   DB	0		;SCAN/NOSCAN PARENTHESIS FLAG
SCANPFLE:   DB	1		;ARRAY NAME FOR ERASE
SCANPFLD    EQU	KEYS-'('	;NO ARRAY ELEMENTS WANTED
MATSCCNT:   DB	0		;SUBSCRIPT COUNT
MATDMFLG:   DB	0		;SCANNING FOR VAR/DIMENSION V
TYPEFLG:    DB	0		;TYPE FLAG                  V
TYPEINTG    EQU	2		;TYPE OF INTEGER
TYPESTRG    EQU	3		;TYPE OF STRING
TYPESING    EQU	4		;TYPE OF SINGLE FLOATING POINT
TYPEDUBL    EQU	8		;TYPE OF DOUBLE FLOATING POINT
TYPEDEF     EQU	080H/4		;MARKING BIT FOR USER-FUNCTION
STRGTMPL:   DB	0		;TEMP STRING DESCRIPTR, LEN  S
STRGTMPA:   DW	0		;TEMP STRING DESCRIPTR, ADDR S
SCANPTR1:   DW	0		;SCAN POINTER
SCANPTR2:   DW	0		;SCAN POINTER
CURLINE:    DW	-1		;CURRENT LINE NUMBER
CURLINES:   DW	0		;SAVED CURRENT LINE NUMBER
PROGCNTR:   DW	ENDINTRP+12	;CURRENT PROGRAM LOCATION
VARINDEX    EQU	PROGCNTR	;INDEX VARIABLE OF FOR
PROGCNTS:   DW	0		;SAVED CURRENT PROGRAMLOCATION
CURLDATA:   DW	0		;CURRENT DATA LINE NUMBER
CURDATAP:   DW	ENDINTRP	;CURRENT DATA POINTER
INPTBUFR:   DW	INITSTSP	;INPUT BUFFER ADDRESS
PREDREL	    EQU	064H		;PRECEDENCE OF RELATION
PREDNUM	    EQU	070H		;LOWER BNDRY OF NUM OP PREC.
PREDNOT	    EQU	05AH		;PRECEDENCE OF NOT OPERATOR
PREDUMIN    EQU	07DH		;PRECEDENCE OF UNARY MINUS
LINESYZE    EQU	79+78		;DEFAULT LINESYZE
ITEMSIZE    EQU	14		;DEFAULT WIDTH OF PRINT ITEM

;
;  MEMORY ALLOCATIN POINTERS
;
LIMLOWER   EQU	02800H
LIMUPPER   EQU	0C000H

;
;  MEMORY LAYOUT
;
;  ENCODE BUFFER
;  PROGRAM
;  VARIABLES
;  ARRAYS
;  FREE SPACE  /  STACK (INCLUDING BUFFERS)
;  FREE STRING SPACE
;  STRINGS
;  STRING TEMPORARIES
;  FREE STRING TEMPORARIES
;
PROGBASE:    DW	ENDINTRP+13	;BASE OF PROGRAM SPACE
VARTABLE:    DW	ENDINTRP+15	;BASE OF VARIABLE TABLE
MATTABLE:    DW	ENDINTRP+15	;BASE OF ARRAY TABLE
FREELIMT:    DW ENDINTRP+15	;LOWER LIMIT OF FREE SPACE
STCKBASE:    DW	INITSTCK	;BASE OF STACK
STRGFREE:    DW	INITSTCK+10	;FIRST FREE STRING SPACE	
STRGBASE:    DW	INITSTCK+10	;BASE OF STRING SPACE
STRGTMPP:    DW	INITSTCK+11	;STRING TEMPORARY ALLOC PTR
STRGTLIM:    DW	INITSTCK+10+2*3	;STRING TEMPORARY LIMIT
ACCUMLTR:    DB	0,0		;ACCUMULATOR			A
FLACCMSB:    DB	0		;SIGN-BIT/HIGH-ORDER MANTISSA	A
FLACCEXP:    DB	0		;EXPONENT			A
FLACCSSV:    DB	0		;SAVED SIGN			A
NULLCNT:     DB 1		;# OF NULLS TO INSERT AFTER (CR)
CURSPOS:     DB	1		;CHARACTER CURSOR POSITION	C
CURSLIM:     DB 256-LINESYZE	;OUTPUT CURSOR LIMIT		C
FLSCR0:      DB	0		;FLOATING POINT SCRATCH AREA
FLSCR1:      DB 1
FLSCR2:      DB	2
FLSCR3:      DB	3
INOTINS      EQU FLSCR0		;INPUT/OUTPUT INSTRUCTIONS
OPCINP       EQU 0DBH		;INPUT INSTRUCTION
OPCOUT       EQU 0D3H		;OUTPUT INSTRUCTION
OPCRET       EQU 0C9H		;RETURN INSTRUCTION
RNDFCTSD:    DB  052h, 0c7h, 04fh, 080h   ;RANDOM SEED

;
;  GENERAL USE SUBROUTINES
;
;
;  SCAN ONE CHARACTER AND CLASSIFY
;
SCANNXTV:
	MOV	A,M		;SCAN CURRENT BYTE,
	XTHL
	CMP	M		;VERIFY MATCH,
	INX	H
	XTHL
	JNZ	ERRASN		;SQUAWK ABOUT SYNTAX ERROR
SCANNXT:
	INX	H		;SCAN FOR NEXT NON-BLANK CHAR
	MOV	A,M		;C=NUMERIC CHARACTER
	CPI	':'		;Z=END OF STATEMENT
	RNC
	CPI	' '
	JZ	SCANNXT
	CPI	'0'
	CMC
	INR	A
	DCR	A
	RET
;
;  TEST FOR ALPHABETIC CHARACTER
;
ALPHACHK:
	MOV	A,M		;TEST FOR ALPHABETIC CHARACTER
ALPHACHA:
	CPI	'z'+1		;LOWER CASE
	RNC
	CPI	'a'		;LOWER CASE
	JNC	ALPHACHL
	CPI	'Z'+1		;C=ALPHABETIC
	RNC
	CPI	'A'		;UPPER CASE
	CMC
	RET
ALPHACHL:
	ADI	'A'-'a'		;CONVERT LOWER TO UPPER
	RET

;
;  MATCH CHARACTER OF BUFFER AGAINST CHARACTER IN A
;
CHARMTCH:
	XRA	M		;MAKE MATCH TEST
	RZ			;Z-SUCCESS]
	CPI	'a'-'A'		;LOWER CASE - UPPER CASE
	RNZ			;NOT LOWER-UPPER DIFFERENCE
	CALL	ALPHACHK	;ALPHABETIC?
	SBB	A
	INR	A		;Z=C,S=0
	RET

;
;  CHECK TYPE OF EXPRESSION	       LEN     CHAR
;            RETURNS:  S => INTEGER	2	%
;		       Z => STRING	3	$
;		      PO => SINGLE	4	@
;		      NC => DOUBLE	8	#
TYPECHK:
	LDA	TYPEFLG
TYPECHKA:
	CPI	TYPESING+1
	DCR	A
	DCR	A
	DCR	A
	ORA	A
	STC
	RET
;
;  SCAN A PAIR OF LINE NUMBER PARAMETERS
;
SCANLPRZ:
	LXI	B,0		;DEFAULT SECOND IS FIRST
SCANLPRM:
	CNZ	SCANLINN	;DEFAULT FIRST IS IN DE
	PUSH	PSW
	MOV	A,B
	ORA	C		;ZERO DEFAULT IS FIRST PARAMETER
	JNZ	SCANLPR1
	MOV	B,D
	MOV	C,E
SCANLPR1:
	POP	PSW
	XCHG
	XTHL			;PUT FIRST ONTO STACK
	PUSH	H
	XCHG
	MOV	D,B
	MOV	E,C
	RZ
	CPI	KEYDIV		;SEPARATOR MUST BE '/'.
	JZ	SCANLPR2
	CALL	SCANNXTV	;bscan (val)
	DB	','		;   OR ','
	DCX	H
SCANLPR2:
	LXI	D,0FFFFH	;EMPTY SECOND OPERAND = END
	CALL	SCANNXT		;bscan ,
	RZ

;
;  SCAN A LINE NUMBER
;
SCANLINN:
	DCX	H		;SCAN LINE # IN COMMAND/STATEMENT
SCANLINR:
	LXI	D,0		;DEFAULT LINE IS 0, INITIALIZE
SCANLINL:
	CALL	SCANNXT		;bscan ,
	RNC
	PUSH	H
	PUSH	PSW
	LXI	H,0FFFFH/10-1
	CALL	CMHLLTDE
	JC	ERRASN
	MOV	H,D
	MOV	L,E		;HL=10*DE
	DAD	D
	DAD	H
	DAD	D
	DAD	H
	POP	PSW
	SUI	'0'		;GET VALUE OF NEXT DIGIT
	MOV	E,A
	MVI	D,000H
	DAD	D		;AND ADD IT ON
	XCHG
	POP	H
	JMP	SCANLINL
;
;  SEARCH FOR A GIVEN LINE NUMBER
;
LINESRCH:
	LHLD	PROGBASE	;LOOK FOR LINE NUMBER IN DE
LINESRCL:
	PUSH	H		;C=LINE FOUND
	CALL	LINELINK	;BC=LINE LOCATION, IF FOUND
	JZ	POPHLRET	;=NEXT LINE, IF NOT FOUND
	PUSH	B		;ADDRESS OF NEXT LINE
	MOV	A,M		;GET NUMBER OF CURRENT LINE
	INX	H
	MOV	H,M		;(from HL,MA)
	MOV	L,A
	CALL	CMHLLTDE
	POP	H		;HL=NEXT LINE
	POP	B
	CMC
	RZ
	JNC	LINESRCL
	MOV	H,B
	MOV	L,C
	CMC
	RET

;
;  LINK TO NEXT LINE
;
LINELINK:
	PUSH	H		;FIND ADDRESS OF NEXT LINE
	MOV	C,M		;Z=END OF PROGRAM
	INX	H
	MOV	B,M
	INX	H
	XTHL
	DAD	B		;ADD LENGTH TO ADDRESS
	XTHL
	MOV	A,B
	ORA	C
	POP	B
	RET
;
;  INSERT/REPLACE LINE OF PROGRAM
;
LINEINS:
	PUSH	D		;DE=LINE NUMBER
	CNC	KEYSCAN		;C=ALREADY KEY-SCANNED
	CALL	SCANNXT		;bscan , NC=MUST BE KEY-SCANNED
	POP	D
	PUSH	H		;HL=TEXT TO INSERT
	PUSH	D
	PUSH	B		;BC=LENGTH OF TEXT
	PUSH	PSW		;Z=DELETE, NO REPLACE
	CALL	LINESRCH	;LOOK FOR LINE
	PUSH	B		;SAVE LOCATION
	CC	LINEDEL		;DELETE IF PRESENT
	POP	D
	POP	PSW
	JZ	POPHL3RT	;EXIT IF NOTHING MORE
	LHLD	FREELIMT	;PULL APART FOR NEW LINE
	XTHL
	POP	B
	PUSH	H
	DAD	B
	CALL	COPYCHK
	XCHG
	POP	B
	MOV	M,C		;BEGINNING OF NEW LINE
	INX	H
	MOV	M,B
	INX	H
	POP	D
	MOV	M,E		;INSERT LINE NUMBER
	INX	H
	MOV	M,D
	INX	H
	XCHG
	POP	H		;RECOVER TEXT POINTER
LINEINSL:
	MOV	A,M		;INSERT TEXT OF NEW LINE
	STAX	D
	INX	H
	INX	D
	ORA	A
	JNZ	LINEINSL
	JMP	LINEDELU

;
;  DELETE TEXT FROM PROGRAM
;
LINEDEL:
	XCHG			;BC=BEGINNING OF TEXT TO REMOVE
	MOV	A,C
	SUB	E		;COMPUTE NETATIVE OF
	MOV	L,A		;NUMBER OF BYTES DELETED
	MOV	A,B
	SBB	D
	MOV	H,A
	PUSH	H
	LHLD	FREELIMT	;HL=BEGINNING OF TEXT SURVIVING
LINEDELL:
	LDAX	D
	STAX	B
	INX	B
	INX	D
	CALL	CMHLLTDE
	JNC	LINEDELL
	POP	B
LINEDELU:
	LHLD	FREELIMT	;UPDATE DATA POINTERS
	DAD	B		;BC=INCREMENT
	SHLD	FREELIMT
	LHLD	MATTABLE
	DAD	B
	SHLD	MATTABLE
	LHLD	VARTABLE
	DAD	B
	SHLD	VARTABLE
	JMP	CLEARPCN

;
;  MAKE SIXTEEN BIT COMPARISON
;
CMHLLTDE:
	MOV	A,H		;COMPARE DE VS HL
	SUB	D		;C=HL<DE
	RNZ
	MOV	A,L
	SUB	E
	RET
;
;  MOVE LONG TO HIGHER ADDRESS
;
COPYCHK:
	CALL	SPACECHK
COPYTEXT:
	PUSH	B		;COPY SECTION DE-BC TO AREA
	XTHL			;ENDING AT HL
	POP	B
COPYTXTL:
	CALL	CMHLLTDE
	MOV	A,M
	STAX	B
	RZ
	DCX	B
	DCX	H
	JMP	COPYTXTL

;
;  CHECK SPACE FOR STACK ALLOCATION
;
SPACESTK:
	PUSH	H		;VERIFY STACK HAS ROOM ENOUGH
	LHLD	FREELIMT	;C=NUMBER OF WORKS NEEDED
	MVI	B,000H
	DAD	B
	DAD	B
	CALL	SPACECHK
	POP	H
	RET

;
;  CHECK SPACE FOR PROGRAM OR VARIABLE ALLOCATION
;
SPACECHK:
	PUSH	D		;CHECK THAT ENOUGH SPACE IS LEFT
	XCHG			;ON STACK ABOVE HL
	LXI	H,-38
	DAD	SP
	CALL	CMHLLTDE
	XCHG
	POP	D
	RNC
ERRAOM:
	MVI	E,ERRNOM-ERRN
	JMP	ERRMSG
;
;  RE-INITIALIZATION ROUTINES
;
NEWSTM:
	RNZ			;NEW COMMAND
CLEARPGM:
	LHLD	PROGBASE	;CLEAR PROGRAM
	XRA	A
	MOV	M,A
	INX	H
	MOV	M,A
	INX	H
NEWLOAD:
	SHLD	VARTABLE
CLEARSET:
	CALL	CLEARPCN	;CLEAR PROGRAM POINTERS
CLEARVST:
	SHLD	PROGCNTR	;UPDATE PROGRAM COUNTER
	CALL	CLEARVAR	;CLEAR VARIABLES
CLEARSTK:
	POP	B		;RESET STACK,
	LHLD	STCKBASE
	SPHL
	LXI	H,0-LINESYZE-3
	DAD	SP
	SPHL			;CREATE INPUT BUFFER
	SHLD	INPTBUFR
	LHLD	STRGBASE	;CLEAR STRING TEMPORARIES,
	INX	H
	SHLD	STRGTMPP
	LXI	H,0
	PUSH	H
	SHLD	PROGCNTS	;SET NO CONTINUE
	LHLD	PROGCNTR
	PUSH	B
	RET

CLEARVAR:
	LHLD	VARTABLE	;CLEAR ALL VARIABLES
	SHLD	MATTABLE
	SHLD	FREELIMT
	LHLD	STRGBASE
	SHLD	STRGFREE
	RET

CLEARPCN:
	LXI	H,0		;CLEAR PROGRAM POINTERS
	SHLD	PROGCNTS
	LHLD	PROGBASE
	DCX	H
	MVI	M,0		;END OF LINE -1
	SHLD	PROGCNTR
	XRA	A
;
;  RESTORE:  REWIND DATA STATEMENTS
;
RESSTM:
	JZ	RESSTMDF	;RESTORE STATEMENT
	CALL	SCANLINN
	PUSH	H
	CALL	LINESRCH
	JNC	ERRAUS
	POP	H
	XCHG
	JMP	RESSTMBU
RESSTMDF:
	XCHG			;DEFAULT IS RESTORE TO BEGINING
	LHLD	PROGBASE
RESSTMBU:
	DCX	H		;BACK UP BEFORE LINE
RESDTPTR:
	SHLD	CURDATAP	;SET DATA POINTER
	XCHG
	RET

;
;  CLEAR:  CLEAR VARIABLES, REALLOCATE STRING SPACE
;
CLRSTM:
	JZ	CLEARVST	;CLEAR STATEMENT
	CALL	VALINTDE
	DCX	H		;bscan -
	CALL	SCANNXT		;bscan ,
	RNZ
	PUSH	H
	LHLD	STRGBASE
	MOV	A,L
	SUB	E
	MOV	E,A
	MOV	A,H
	SBB	D
	MOV	D,A
	JC	ERRASN
	LHLD	VARTABLE
	LXI	B,40
	DAD	B
	CALL	CMHLLTDE
	JNC	ERRAOM
	XCHG
	SHLD	STCKBASE
	POP	H
	JMP	CLEARVST
;
;  LOW-LEVEL CHARACTER I/O ROUTINES
;
PRNTCHRI:
	XTHL
	MOV	A,M
	INX	H
	XTHL
PRNTCHRA:
	PUSH	PSW		;TRANSMIT CHARACTER
	LDA	PRINTFLG
	ORA	A
	JNZ	POPAFRET
	POP	PSW
	PUSH	PSW
	CPI	' '
	JC	PRNTCHRW
	PUSH	H
	LHLD	CURSPOS		;LINE TOO LONG?
	MOV	A,H
	ADD	L
	MOV	A,L
	POP	H
	CC	PRNTCRLF
	INR	A
	STA	CURSPOS
PRNTCHRW:
	POP	PSW		;SEND CHARACTER
	CALL	SYSDISPL
	RET

INPTCHAR:
	CALL	SYSKEYIN	;RECEIVE A CHARACTER
	JZ	INPTCHAR	;WAIT FOR ONE
	CPI	SI
	RNZ
	LDA	PRINTFLG
	CMA
	STA	PRINTFLG
	JMP	INPTCHAR
;
;  ERROR PROCESSING
;
MSGERROR:
	DB	' ERROR',0
MSGIN:
	DB	' IN ',0
MSGOK:
	DB	CR,LF,'OK',CR,LF,0
MSGBREAK:
	DB	CR,LF,'BREAK',0

ERRDATA:
	LHLD	CURLDATA
	SHLD	CURLINE
ERRASN:
	MVI	E,ERRNSN-ERRN
ERRMSG:
	CALL	CLEARSTK
	XRA	A
	STA	PRINTFLG	;TURN ON PRINTING
	STA	SCANPFLG	;ALLOW SUBSCRIPTING
	CALL	PRNTCRLF
	LXI	H,ERRN
	MOV	D,A
	CALL	PRNTCHRI	;print (val)
	DB	'?'
	DAD	D		;PRINT ERROR CODE
	CALL	PRNTMSG
	LXI	H,MSGERROR
ERRMSGPR:
	CALL	PRNTMSG
	LHLD	CURLINE
	MOV	A,H
	ANA	L
	INR	A
	CNZ	ERRMSGIN
;
;  COMMAND/LINE INPUT
;
CMNDSTRT:
	XRA	A		;TOP LEVEL EXECUTIVE
	STA	PRINTFLG	;TURN ON PRINTING
	STA	SCANPFLG	;ALLOW SUBSCRIPTINT
	LXI	H,-1
	SHLD	CURLINE
	LXI	H,MSGOK
	CALL	PRNTMSG		;REQUEST COMMAND
CMNDINPT:
	LXI	D,MSGSTARS+2	;INPUT COMMAND
	CALL	INPTRQST
	JC	CMNDINPT
	CALL	SCANNXT		;bscan ,
	PUSH	PSW
	CALL	SCANLINN	;SCAN OFF LINE NUMBER
	PUSH	D
	CALL	KEYSCAN		;SCAN STATEMENT
	POP	D
	POP	PSW
	JNC	EXECUTE		;DIRECT IF NO LINE NUMBER
	CALL	LINEINS		;INSERT LINE AS REQUESTED
	JMP	CMNDINPT

CMNDRSTR:
	CALL	CLEARSTK	;ENTRY FOR RESTARTING
	CALL	PRNTCRLF
	LXI	H,MSGREDO+11	;TELL HIM WE'RE STARTING
	JMP	ERRMSGPR
;
;  AUTOMATIC LINE-NUMBERED INPUT
;
AUTSTMIN:
	PUSH	D		;SAVE LINE NUMBER
	CALL	LINEINS		;INSERT LINE
	POP	H		;RECOVER LINE NUMBER,
	POP	D		;INCREMENT
	DAD	D
	JC	ERRAOV
	JMP	AUTSTMN
AUTSTM:
	POP	B		;REMOVE CALLER
AUTSTMS:
	LXI	D,1000		;DEFAULT STARTING LINE NUMBER
	LXI	B,100		;DEFAULT INCREMENT VALUE
	CALL	SCANLPRM	;SCAN PARAMETERS
	JNZ	ERRASN
	POP	H
	CALL	PRNTCRLF
AUTSTMN:
	PUSH	D		;SAVE INCREMENT
	PUSH	H		;AND NEXT LINE NUMBER
	CALL	ENCODEHL	;PROMPT WITH LINE NUMBER
	XCHG
	INX	D
	CALL	INPTRQST
	POP	D
	JC	AUTSTMBR
	CALL	SCANNXT		;bscan ,
	JNC	AUTSTMIN
	CMC
AUTSTMBR:
	POP	D		;TAKE A BREAK
	JC	CMNDSTRT	;END OF AUTO
	JMP	AUTSTMS		;GET NEW LINE NUMBER, INCREMENT
;
;  LEXICAL SCANNER / KEYWORD RECOGNITION
;
KEYSCAN:
	MVI	C,5		;SCAN INPUT LINE FOR KEYWORDS,
	MOV	D,H		;CONDENSE LINE ON TOP OF SELF
	MOV	E,L
	DCX	H		;bscan -
	PUSH	H
	CALL	SCANNXT		;bscan +
KEYSCANL:
	MOV	A,M
	CPI	' '
	JZ	KEYSCANH	;DELETE BLANKS
	MOV	B,A
	CPI	'"'
	JZ	KEYSCANI	;SWALLOW WHOLE STRING
	ORA	A
	JZ	KEYSCANX
	CPI	'0'		;NON-KEYWORD
	JC	KEYSCANK
	CPI	'<'		;   SO WE DON'T SCAN
	JC	KEYSCANP
KEYSCANK:
	PUSH	B		;SCAN FOR MATCHING KEYWORD
	PUSH	D
	PUSH	H
	ANI	00FH		;HASH CHARACTER
	MOV	E,A
	MVI	D,0
	LXI	H,KEYWADDS	;ADDRESS C'SPONDING KEYWORDS
	DAD	D
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	JMP	KEYSCANB

KEYSCANZ:
	LDAX	D
	ORA	A
	JP	KEYSCANN
KEYSCANM:
	MOV	A,B		;MATCH, GET SYMBOL NUMBER
	ORI	080H
	JMP	KEYSCANF
KEYSCANN:
	INX	H		;ADDRESS NEXT CHAR IN LINE
	INX	D
	INR	C
KEYSCANC:
	LDAX	D		;COMPARE LINE WITH KEYWORD
	ANI	07FH
	CALL	CHARMTCH	;COMPARE CHARACTERS
	JZ	KEYSCANZ
	MOV	A,C		;MATCH ENOUGH YET?
	CPI	3
	JC	KEYSCANA

	CALL	ALPHACHK	;STOP ON BREAK CHAR OK
	DCX	H
	JNC	KEYSCANM
KEYSCANA:
	XCHG
KEYSCANW:
	ORA	M		;SKIP OVER REST OF KEYWORD
	INX	H
	JP	KEYSCANW
	XRA	B
KEYSCANB:
	MOV	B,M		;GET CODE FOR KEYWORD
	INX	H
	XCHG
	POP	H		;RESTORE STARTING POSITION
	PUSH	H
	MVI	C,0
	JP	KEYSCANC
	MOV	A,M		;NO MATCH, GET CHARACTER
KEYSCANF:
	POP	D		;RECOVER OUTPUT POINTER
	POP	D
	POP	B
	MVI	B,':'		;CHECK SPECIAL PROCESSING
	CPI	KEYELS
	JNZ	KEYSCAND
	XCHG
	MOV	M,B		;INSERT COLON BEFORE ELSE
	XCHG
	INX	D
	INR	C
KEYSCAND:
	CPI	KEYDAT
	JZ	KEYSCANI
	MVI	B,0
	CPI	KEYREM
	jz	keyscani
	cpi	keycld		;pass file name in load and save
	jz	keyscani
	cpi	keycsv
KEYSCANI:
	CZ	KEYSCANV
	ORA	A
	JZ	KEYSCANX
KEYSCANP:
	STAX	D		;INSERT SYMBOL IN MEMORY
	INX	D
	INR	C
KEYSCANH:
	INX	H
	JMP	KEYSCANL
KEYSCANX:
	POP	H		;EXIT KEYWORD TRANSLATION
	STAX	D		;END OF STATEMENT
	INX	D
	STAX	D		;END OF 'PROGRAM'
	INX	D
	STAX	D
	MOV	B,A		;LENGTHIN BC
	RET

;
;  COPY BUFFER TEXT WITHOUT PROCESSING
;
KEYSCANV:
	STAX	D		;COPY TEXT VERBATIM TO STOPPER
	INR	C
	INX	D
	INX	H
	MOV	A,M
	ORA	A
	RZ
	CMP	B
	RZ
	CPI	'"'		;STRING WITHIN TEXT?
	JNZ	KEYSCANV
	PUSH	B
	MOV	B,A
	CALL	KEYSCANV
	POP	PSW
	MOV	B,A
	MOV	A,M
	ORA	A		;STRING TERMINATE ON END OF LINE?
	RZ
	JMP	KEYSCANV
;
;  LINE INPUT ROUTINE
;
INPTLNBS:
	DCX	H		;DELETE A CHARACTER FROM INPUT
	DCR	B
	JZ	INPTLNRD
	CALL	SYSDISPL	;print BS
	inr	c		;char count
	JMP	INPTLINL
INPTLNRD:
	LXI	H,MSGSTARS	;BREAK ENTERED
	CALL	PRNTMSG		;TELL HIM WE GOT IT
	DCR	B		;BREAK AT BEGINNING MEANS BREAK
	JZ	INPTEXIT

INPTCRLF:
	CALL	PRNTCRLF	;ON THE NEXT LINE
INPTRQST:
	MOV	H,D
	MOV	L,E		;PRINT USER'S PROMPT MESSAGE
	CALL	PRNTMSG
	LHLD	INPTBUFR	;INPUT A LINE FROM RECEIVER
	LXI	B,1*256
	CALL	PRNTCHRI	;print (val)
	DB	' '		;OK, WE'RE READY FOR INPUT
INPTLINL:
	MVI	M,0		;MAINTAIN ENDING ZERO
	CALL	INPTCHAR
INPTLINC:
	CPI	BEL
	JZ	INPTLNST	;BELL'S OK
	CPI	CR
	JZ	INPTCRTN	;CARRIAGE RTN IS END OF LINE
	CPI	BS
	JZ	INPTLNBS	;BACKSPACE IS DELETE
	CPI	ETX		;CONTROL C IS ABORT
	JZ	INPTLNRD	;FORGET THIS LINE, START OVER
	CPI	FF		;FORM FEEDS ARE ECHOED
	JZ	INPTLNEC
	CPI	' '
	JC	INPTLINL	;IGNORE OTHER CONTROL CHARS
INPTLNST:
	MOV	M,A		;STORE THE CHARACTER
	MOV	A,B
	CPI	LINESYZE
	MVI	A,BEL
	JNC	INPTLNEC
	INR	B
	ORA	C
	MOV	C,M
	INX	H
	MVI	A,LF
	CM	PRNTCHRA
	MOV	A,C
INPTLNEC:
	CALL	PRNTCHRA	;ac -> screen  ;ECHO CHARACTER
	JMP	INPTLINL
INPTCRTN:
	DCR	B		;CARRIAGE RETURN AT BEGINNING
	JZ	INPTCRLF	;GETS ANOTHER TURN
INPTEXIT:
	LHLD	INPTBUFR
	DCX	H
	CALL	PRNTCRLF
	SUB	B		;SET CONDITION CODES
	CMC
	SBB	A		;NS=NC=Z = NON-EMPTY LINE
	RET

MSGSTARS:
	DB	'***',0
;
;  SET OPTIONS COMMAND
;
SETSTM:
	JZ	ERRASN		;TURN OPTION ON OR OFF
	CPI	KEYLIS
	JZ	SETSTMLS
	PUSH	PSW		;SAVE OPTION
	CALL	SCANNXT		;bscan ,
	JZ	ERRASN
	SUI	KEYON
	MOV	B,A		;SAVE FLAG
	CALL	SCANNXT		;bscan +
	POP	PSW		;WHICH OPTION
	CPI	KEYGTO
	JZ	SETSTMGT	;GOTO
	CPI	KEYPRT
	JNZ	ERRASN
SETSTMPR:
	MOV	A,B
	sta	p3010		;used to be printflg **
	RET
SETSTMGT:
	MOV	A,B
	STA	TRACEFLG
	RET
SETSTMLS:
	INX	H
	CALL	VALBYTE
	CMA			;FIND NEGATIVE OF BYTE
	INR	A
	STA	CURSLIM
	RET

;
;  DELETE COMMAND PROCESSOR
;
DELSTM:
	LXI	D,0FFFFH	;DELETE COMMAND
	CALL	SCANLPRZ
	XTHL			;SAVE SCAN POINTER
	XCHG
	CALL	CMHLLTDE	;VERITY  FIRST<=LAST
	JC	ERRASN
	PUSH	H
	CALL	LINESRCH	;LOOK FOR FIRST LINE
	POP	D
	PUSH	B
	CALL	LINESRCH	;LOOK FOR LAST LINE
	POP	B
	CALL	LINEDEL
	POP	H
	RET

;
;  LIST COMMAND PROCESSOR
;
LISSTM:
	LXI	D,0		;LIST COMMAND
	LXI	B,0FFFFH	;TOTAL DEFAULT IS ENTIRE FILE
	JZ	LISSTMSC
	LXI	B,0		;ELSE DEFAULT IS ONLY ONE LINE
LISSTMSC:
	CALL	SCANLPRM	;SCAN LINE PARAMETERS
	JNZ	ERRASN
	XTHL
	XCHG
	PUSH	H
	CALL	LINESRCH
	PUSH	B
LISSTMLP:
	POP	B		;MOVE ON TO NEXT LINE
	POP	D
	POP	H
	CALL	SYSBREAK	;ALLOW BREAK
	JZ	EXECUTEB
	PUSH	B
	XTHL
	CALL	LINELINK
	JZ	POPHLRET	;END OF PROGRAM, QUIT
	PUSH	D
	PUSH	B
	PUSH	H		;SAVE TEXT FOR LATER
	MOV	C,M		;FETCH LINE NUMBER
	INX	H
	MOV	B,M
	MOV	H,B
	MOV	L,C
	XCHG
	CALL	CMHLLTDE
	JC	LISSTMXT	;LAST LINE REACHED?
	CALL	PRNTCRLF	;LIST CURRENT LINE
	XCHG
	CALL	PRINTINT	;PRINT LINE NUMBER
	CALL	PRNTCHRI	;print (val)
	DB	' '		;FOLLOWED BY BLANK
	POP	H
	CALL	LISEDIXP	;EXPAND TEXT
	CALL	PRNTMSG		;AND PRINT IT
	LXI	H,0+LINESYZE+3
	DAD 	SP
	SPHL			;DEALLOCATE EXPANDED TEXT
	JMP	LISSTMLP

LISSTMXT:
	POP	H
POPHL3RT:
	POP	H
	POP	H
POPHLRET:
	POP	H
	RET

;
;  EXPAND KEYWORDS IN LINE / INVERSE OF KEYSCAN
;
LISEDIXP:
	MVI	C,LINESYZE/2	;SPACE ENOUGH TO EXPAND LINE?
	CALL	SPACESTK
	XCHG			;SAVE POINTER TO LINE TO EXPAND
	POP	B		;AND CALLER
	LXI	H,0-LINESYZE-3
	DAD	SP
	SPHL			;CREATE TEXT BUFFER ON STACK
	PUSH	B		;PUT BACK CALLER
	XCHG
	INX	H
	INX	H		;plus 2
	PUSH	H		;SAVE TEXT POINTER
	LXI	H,4		;CREATE POINTER TO EXPAND TEXT
	DAD	SP
	XCHG
	MVI	B,LINESYZE	;INITIALIZE LENGTH COUNTER
	JMP	LISEDIKD
LISEDISC:
	CALL	LISEDIST	;STUFF ONE CHARACTER OF LINE
LISEDIKD:
	POP	H		;DO REST OF LINE
	MOV	A,M
LISEDINC:
	INX	H
	CPI	':'
	JNZ	LISEDIKT
	MOV	A,M
	CPI	KEYELS		;:ELSE BECOMES ELSE
	JZ	LISEDINC
	MVI	A,':'
LISEDIKT:
	ANA	A		;MOVE HIGH ORDER INTO S-FLAG
	JZ	LISEDIXT
	PUSH	H
	JP	LISEDISC
	MOV	C,A
	LXI	H,KEYLSBH*256+KEYLSBL
	CALL	LISEDISB	;OPTIONAL BLANK BEFORE KEYWORD
	LXI	H,KEYWORDS	;SEARCH FOR KEYWORD
	JMP	LISEDIKS
LISEDIKL:
	ORA	M
	INX	H
	JP	LISEDIKL
LISEDIKS:
	MOV	A,M		;FETCH KEYWORD NUMBER
	ORI	080H
	INX	H
	XRA	C
	JNZ	LISEDIKL
LISEDIKY:
	MOV	A,M		;EXPAND KEYWORD
	RLC
	ANA	A		;HIGH-ORDER TO CARRY
	RAR
	CALL	LISEDIST	;STUFF THIS CHARACTER
	INX	H
	JNC	LISEDIKY	;DO THEM ALL
	MOV	A,C
	LXI	H,KEYLSAH*256+KEYLSAL
	CALL	LISEDISB	;OPTIONAL BLANK AFTER KEYWORD
	JMP	LISEDIKD

LISEDISB:
	CMP	L		;INSERT BLANK IN LINE IF
	RC			;L <= A < H
	CMP	H
	RNC
	MVI	A,' '		;GENERATE BLANK
LISEDIST:
	STAX	D
	INX	D
	DCR	B
	RNZ			;TRUNCATE TOO LONG A LINE
	INR	B
	DCX	H
	RET

LISEDIXT:
	STAX	D
	MVI	A,LINESYZE+1	;COMPUTE LENGTH OF OUTPUT
	SUB	B
	MOV	B,A
	LXI	H,2		;CREATE POINTER TO EXPAND TEXT
	DAD	SP
	RET			;AND RETURN
;
;  EDIT COMMAND PROCESSOR
;
EDISTM:
	LXI	D,0		;SCAN PARAMETERS
	CALL	SCANLPRZ
	XTHL			;SAVE SCAN,
	SHLD	SCANPTR1	;AND OUTPUT LINE NUMBER
	CALL	LINESRCH	;LOOK UP LINE
	JNC	ERRAUS		;NOT FOUND...
	MOV	H,B
	MOV	L,C
	INX	H
	INX	H		;plus 2
	CALL	LISEDIXP	;EXPAND LINE
	LHLD	SCANPTR1	;RECOVER LINE NUMBER
	PUSH	H
EDISTMLS:
	CALL	EDISTMCR	;GIVE HIM A LOOK AT IT
	CALL	PRNTMSG		;PRINT COPY OF TEXT
	CALL	EDISTMCR	;A NEW EDIT LINE
	MVI	C,1		;POSITION COUNTER
EDISTMNX:
	CALL	EDISTMCH	;OK MASTER, TELL ME WHAT TO DO
	CPI	' '		;MOVE ALONG
	JZ	EDISTMAD
	CALL	ALPHACHA	;CONVERT LOWER TO UPPER
	CPI	'D'		;DELETE
	JZ	EDISTMDL
	CPI	'I'		;INSERT
	JZ	EDISTMIN
	CPI	'R'		;REPLACE
	JZ	EDISTMRP
EDISTMER:
	MVI	A,BEL		;SQUAWK ABOUT ERROR
EDISTMEC:
	CALL	PRNTCHRA	;ac -> screen
	JMP	EDISTMNX
;
;  ADVANCE
;
EDISTMAD:
	MOV	A,C
	CMP	B		;CAN WE STILL ADVANCE?
	JNC	EDISTMER
	INR	C		;ADVANCE POSITION COUNTER
	MOV	A,M
	INX	H		;PRINT CHARACTER PASSED OVER
	JMP	EDISTMEC
;
;  DELETE
;
EDISTMDL:
	MOV	A,C
	CMP	B		;ANYTHING TO DELETE?
	JNC	EDISTMER
	DCR	B		;DECREASE CHARACTER COUNT
	PUSH	H		;SAVE CURRENT POSITION
	MOV	A,M
	CALL	PRNTCHRA	;LIST CHARACTER DELETED
	MOV	D,H
	MOV	E,L
EDISTMDM:
	INX	H
	MOV	A,M		;MOVE THIS CHARACTER DOWNWARD
	STAX	D
	INX	D
	ORA	A
	JNZ	EDISTMDM
	POP	H
	JMP	EDISTMNX
;
;  INSERT
;
EDISTMIN:
	CALL	EDISTMCH	;GET SOMETHING TO PUT IN
	MOV	D,A		;SAVE COPY OF CHARACTER
EDISTMRI:
	MOV	A,B
	CPI	LINESYZE	;ROOM AT THE INNPUT BUFFER?
	JNC	EDISTMER
	INR	B		;COUNT NEWCOMER
	INR	C		;NEXT ONE GOES AFTER HIM
	MOV	A,D
	CALL	PRNTCHRA	;ac -> screen  ;PRINT NEWCOMER
	PUSH	H		;SAVE CURRENT POSITION
EDISTMIM:
	MOV	E,M
	MOV	M,A		;MOVE CHARACTERS UP ONE BYTE
	ORA	A
	MOV	A,E
	INX	H
	JNZ	EDISTMIM
	POP	H
	INX	H
	JMP	EDISTMIN
;  REPLACE
;
EDISTMRP:
	CALL	EDISTMCH	;GET UPDATE CHARACTER
	MOV	D,A
	MOV	A,C
	CMP	B		;REPLACING END OF LINE?
	JNC	EDISTMRI	;IF SO, GO TO INSERT
	MOV	M,D		;UPDATE THE CHARACTER
	INR	C
	INX	H
	MOV	A,D
	CALL	PRNTCHRA	;ac -> screen  ;PRINT NEWCOMER
	JMP	EDISTMRP
;
;  SEARCH
;
EDISTMSR:
	CALL	EDISTMCH	;FIND CHARACTER TO SEARCH FOR
	CALL	ALPHACHA	;CONVERT TO STANDARD CASE
	MOV	D,A
	MVI	E,0
EDISTMSL:
	MOV	A,C
	CMP	B
	JNC	EDISTMER	;NO MORE, TERMINATE SEARCH
	CALL	ALPHACHK	;FETCH CHARACTER IN STANDARD CASE
	CMP	E
	JZ	EDISTMNX	;GOTTA MATCH?
	CALL	PRNTCHRA	;ac -> screen  ;LIST FAILURES
	INR	C
	INX	H
	MOV	E,D
	JMP	EDISTMSL	;AND KEEP LOOKING

EDISTMXT:
	DCR	C		;BEGINNING CR MEANS DONE, UPDATE
	JNZ	EDISTMLS	;OTHERWISE, LIST, MORE EDITS
	POP	D		;RETRIEVE LINE NUMBER
	LXI	H,0
	DAD	SP		;POINT TO TEXT
	CALL	LINEINS		;AND REINSERT
EDISTMQT:
	LXI	H,0+LINESYZE+3
	DAD	SP
	SPHL			;DEALLOCATE TEXT BUFFER
	POP	H		;RECOVER SCAN POINTER
	RET			;AND RETURN
;
;  LIST LINE, PREPARE FOR UPDATES
;
EDISTMCR:
	POP	D
	POP	H		;RETRIEVE COPY OF LINE NUMBER
	PUSH	H		;SAVE IT,
	PUSH	D
	PUSH	B		;AND LINE LENGTH
	CALL	PRNTCRLF
	CALL	PRINTINT	;PRINT LINE NUMBER
	CALL	PRNTCHRI	;print (val)
	DB	' '
	LXI	H,6
	DAD	SP		;CREATE POINTER TO TEXT BUFFER
	POP	B
	RET
;
;  GET OPTION CHARACTER
;
EDISTMCH:
	CALL	INPTCHAR	;GET CHARACTER ROUTINE
	CPI	' '
	RNC			;NOT CONTROL, RETURN
	CPI	BEL
	RZ
	POP	D		;REMOVE CALLER
	CPI	HT		;SEARCH (TAB)
	JZ	EDISTMSR
	CPI	CR		;LIST, OR UPDATE
	JZ	EDISTMXT
	CPI	ESC		;TERMINATE OPTION
	JZ	EDISTMNX
	CPI	ETX		;ABORT, NO UPDATE
	JNZ	EDISTMER
	LXI	H,MSGSTARS	;TYPE BREAK MESSAGE
	CALL	PRNTMSG
	POP	D
	JMP	EDISTMQT
;
;  SCAN STACK FOR 'FOR' LOOP
;
FORBLCK	EQU	16		;SIZE OF 'FOR' STACK ENTRY

FORCHK:
	LXI	H,4		;LOOK FOR MARK ON STACK
	DAD	SP
FORCHKL:
	MOV	A,M
	INX	H
	CPI	KEYFOR
	RNZ
	MVI	A,TYPESING
	STA	TYPEFLG		;SET CORRECT TYPE FLAG
	MOV	C,M		;MARK IS PRESENT
	INX	H
	MOV	B,M
	INX	H
	PUSH	H
	MOV	H,B
	MOV	L,C
	MOV	A,D		;LOOKING FOR PARTICULAR VARIABLE?
	ORA	E
	XCHG
	JZ	FORCHKXT
	XCHG			;IS THIS IT?
	CALL	CMHLLTDE
FORCHKXT:
	LXI	B,FORBLCK-3
	POP	H
	RZ
	DAD	B
	JMP	FORCHKL

;
;  FOR STATEMENT PROCESSOR
;
FORSTM:
	MVI	A,SCANPFLD	;FOR STATEMENT
	STA	SCANPFLG
	CALL	LETSTM
	CALL	TYPECHK
	JPE	ERRATM		;MUST BE SINGLE INDEX
	XTHL			;SAVE SCANPTR, REMOVE CALLER
	XCHG
	SHLD	VARINDEX
	XCHG
	CALL	FORCHK
	POP	D
	JNZ	FORSTMNF
	DAD	B
	SPHL
FORSTMNF:
	XCHG
	MVI	C,(FORBLCK+1)/2
	CALL	SPACESTK

	PUSH	H
	CALL	DATSTM		;FIND FIRST STATEMENT IN FOR LOOP
	XTHL			;AND SAVE
	PUSH	H
	LHLD	CURLINE		;SAVE CURRENT LINE NUMBER
	XTHL
	CALL	SCANNXTV	;bscan (val)
	DB	KEYTO		;SCAN LIMIT VALUE,
	CALL	VALNUMBR	;bscan numbr
	PUSH	H
	CALL	LDRGAC
	POP	H
	PUSH	B		;SAVE ON STACK
	PUSH	D
	LXI	B,08100H	;LOAD DEFAULT STEP=1.0
	MOV	D,C
	MOV	E,D
	MOV	A,M
	CPI	KEYSTEP		;CHECK FOR EXPLICIT STEP SIZE
	MVI	A,001H
	JNZ	FORSTMST
	CALL	SCANNXT		;bscan +
	CALL	VALNUMBR	;bscan numbr
	PUSH	H
	CALL	LDRGAC
	POP	H
	CALL	SIGNACC
FORSTMST:
	PUSH	B		;SAVE STEP SIZE ON STACK
	PUSH	D
	PUSH	PSW		;SAVE DIRECTION
	INX	SP
	PUSH	H
	LHLD	VARINDEX	;SAVE INDEX VARIABLE
	XTHL
FORMARK:
	MVI	B,KEYFOR	;MARK STACK WITH 'FOR'
	PUSH	B
	INX	SP
;
;  INTERPRETER EXECUTIVE
;
EXECUTEL:
	CALL	BREAKCHK	;USER HAVE ANY COMMENTS?
	SHLD	PROGCNTR
	MOV	A,M
	CPI	':'
	JZ	EXECUTE		;MUTIPLE STATEMENTS ON LINE?
	ORA	A
	JNZ	ERRASN
	INX	H		;END OF LINE,
	MOV	A,M
	INX	H
	ORA	M
	INX	H
	JZ	ENDPROGM	;END OF PROGRAM?
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	SHLD	CURLINE		;MOVE TO NEXT LINE
	XCHG
EXECUTE:
	CALL	SCANNXT		;bscan ,  ;EXECUTE STATEMENT
	LXI	D,EXECUTEL
	PUSH	D
EXECUTEC:
	RZ
EXECUTES:
	CPI	KEYSTM		;WHAT KIND OF STATEMENT?
	JC	LETSTM
	CPI	KEYSUGR
	JNC	EXECUTE2
	ADD	A
	MOV	C,A
	MVI	B,000H
	XCHG
	LXI	H,STMTABL
	DAD	B
	MOV	C,M
	INX	H
	MOV	B,M
	PUSH	B
	XCHG
	JMP	SCANNXT
BREAKCHK:
	CALL	SYSBREAK	;TIME TO TAKE A BREAK?
STPSTM:
	RNZ			;STOP STATEMENT
	INR	A
EXECUTEB:
	SHLD	PROGCNTR
INPSTMBR:
	POP	B		;THROW AWAY CALLER
ENDPROGM:
	PUSH	PSW
	LHLD	CURLINE
	MOV	A,L
	ANA	H
	INR	A
	JZ	ENDSTMC
	SHLD	CURLINES	;SAVE INFORMATION FOR CONTINUE
	LHLD	PROGCNTR
	SHLD	PROGCNTS
ENDSTMC:
	XRA	A
	STA	PRINTFLG
	POP	PSW
	LXI	H,MSGBREAK
	JNZ	ERRMSGPR
	JMP	CMNDSTRT

CONSTM:
	RNZ			;CONT COMMAND
	MVI	E,ERRNCN-ERRN
	LHLD	PROGCNTS
	MOV	A,H
	ORA	L
	JZ	ERRMSG
	XCHG
	LHLD	CURLINES
	SHLD	CURLINE
	XCHG
	RET

RUNSTM:
	JZ	CLEARSET	;RUN COMMAND
	CALL	CLEARVST
	LXI	B,EXECUTEL
	JMP	RUNSTMC

ENDSTM:
	JZ	EXECUTEB	;END STATEMENT
	CALL	SCANNXTV	;bscan (val)
	DB	KEYRUN
	JMP	SYSQUIT
;
;  GOSUB/GOTO STATEMENTS
;
GSBSTM:
	MVI	C,3		;GOSUB STATEMENT
	CALL	SPACESTK
	POP	B
	PUSH	H
	PUSH	H
	LHLD	CURLINE
	XTHL
	MVI	D,KEYGSB	;MARK STACK WITH GOSUB
	PUSH	D
	INX	SP
RUNSTMC:
	PUSH	B
GTOSTM:
	CALL	SCANLINN	;GOTO STATEMENT
	PUSH	D
	CALL 	REMSTM
	POP	D
	PUSH	H
	CALL	TRACE
	LHLD	CURLINE
	CALL	CMHLLTDE
	POP	H
	INX	H
	CC	LINESRCL
	CNC	LINESRCH
	MOV	H,B
	MOV	L,C
	DCX	H
	RC
ERRAUS:
	MVI	E,ERRNUS-ERRN
	JMP	ERRMSG

;
;  RETURN STATEMENT
;
RETSTM:
	RNZ			;RETURN STATEMENT
	MVI	D,0FFH
	CALL	FORCHK		;KILL ACTIVE FOR LOOPS
	SPHL			;INSIDE SUBROUTINE
	CPI	KEYGSB
	MVI	E,ERRNRG-ERRN
	JNZ	ERRMSG
	POP	D
	CALL	TRACE
	XCHG
	SHLD	CURLINE
	LXI	H,EXECUTEL
	XTHL
;	JMP	DATSTM
;
;  DATA/ELSE/REM STATEMENTS
;
DATSTM:
	MVI	C,':'		;DATA STATEMENT
	JMP	SCAN2KEY
ELSSTM:

REMSTM:
	MVI	C,000H		;REM STATEMENT
SCAN2KEY:
	MVI	B,000H		;SKIP TO KEYWORD IN C
DATRSKST:
	MOV	A,C		;SET UP TERMINATING BYTE
	MOV	C,B
	MOV	B,A
DATRSKIP:
	MOV	A,M		;SKIP TO TERMINATING BYTE
	ORA	A
	RZ
	CMP	B
	RZ
	INX	H
	CPI	'"'		;STRING TO SKIP?
	JZ	DATRSKST
	CPI	KEYIF
	JNZ	DATRSKIP
	INR	D		;COUNT NUMBER OF IFS WE SKIP
	JMP	DATRSKIP

;
;  PROGRAM BRANCH TRACING
;
TRACE:
	LDA	TRACEFLG	;TRACING?
	ORA	A
	RNZ
	PUSH	B
	PUSH	D		;SAVE DESTINATION LINE NUMBER
	CALL	PRNTCHRI	;print (val)
	DB	'['		;LEFT BRACKET
	LHLD	CURLINE
	CALL	PRINTINT	;PRINT CURRENT LINE NUMBER
	CALL	PRNTCHRI	;print (val)
	DB	','
	POP	H
	PUSH	H
	CALL	PRINTINT	;PRINT DESTINATION LINE NUMBER
	CALL	PRNTCHRI	;print (val)
	DB	']'		;RIGHT BRACKET
POPDEBCR:
	POP	D
	POP	B
	RET
;
;  ASSIGNMENT STATEMENT PROCESSOR
;
LETSTM:
	CALL	VARSCAN		;LET STATEMENT
	CALL	SCANNXTV	;bscan (val)
	DB	KEYEQ
ASSIGNVL:
	LDA	TYPEFLG
	PUSH	PSW
	PUSH	D
	CALL	VALEXPR		;bscan expr
	POP	D
	POP	PSW
ASSIGN:
	XCHG			;MAKE THE ASSIGMENT
	PUSH	D		;SAVE SCAN
	PUSH	H		;SAVE VARIABLE
	CALL	COERCE
	JNZ	LETSTMNM
	CALL	STRGUNIQ	;REMOVE CONFLICT PROBLEMS
	CALL	STRGRELT	;RELEASE STRING TEMPORARY
	POP	H		;COPY DESCRIPTOR TO DESTINATION
	CALL	COPYVAL
	POP	H
	RET

LETSTMNM:
	CALL	LDMMAC		;MAKE NUMERIC ASSIGNMENT
	POP	D
	POP	H
	RET

STRGUNIQ:
	LHLD	ACCUMLTR	;GET STRING DESCRIPTOR
	XCHG			;IS STRING IN STRING SPACE?
	CALL	STRGTEST
	RNC
	CALL	CMHLLTDE	;VARIABLE REFERENCE?
	CNC	STRGSTOR	;IF SO, MAKE NEW COPY
	RET
;
;  COERCE ACCUMULATOR TO TYPE IN A
;
COERCE:
	CALL	TYPECHKA
COERCEF:
	JPO	CSINGLE
	JZ	CSTRING
	JMP	ERRATM

VALNUMBR:
	CALL	VALEXPR		;bscan expr
CSINGLE:
	CALL	TYPECHK
	RPO
	JMP	ERRATM

CSTRING:
	CALL	TYPECHK
	RZ
	JMP	ERRATM

ERRATM:
	MVI	E,ERRNTM-ERRN
	JMP	ERRMSG

VALINTDE:
	CALL	VALNUMBR	;bscan numbr EVAL POSITIVE INTEGER EXPR
CINTPOS:
	CALL	SIGNACC		;CONVERT TO INTEGER
	JM	ERRAFC
CINTEGER:
	LDA	FLACCEXP
	CPI	090H
	JC	FIXAC
	LXI	B,09080H
	LXI	D,00000H
	CALL	FLCMP
	MOV	D,C
	RZ

ERRAFC:
	MVI	E,ERRNFC-ERRN
	JMP	ERRMSG

VALBYTE2:
	CALL	SCANNXTV	;bscan (val)
	DB	','		;EVAL LATER BYTE ARGUMENTS
VALBYTE:
	CALL	VALNUMBR	;bscan numbr EVAL BYTE EXPRESSION
CBYTE:
	CALL	CINTPOS		;CONVERT ACC TO BYTE
	MOV	A,D
	ORA	A
	JNZ	ERRAFC
	DCX	H
	CALL	SCANNXT		;bscan ,
	MOV	A,E
	RET

EXECUTE2:
	CPI	KEYPORT		;PORT OUTPUT?
	JZ	PORSTM
	CPI	KEYMEM		;MEMORY ALTERATION?
	JZ	MEMSTM

;
;  MID-STRING ASSIGNMENT STATEMENT
;
MIDSTM:
	CALL	SCANNXTV	;bscan (val)
	DB	KEYMID		;ENTER POINTING TO 'MID$'
	CALL	SCANNXTV	;bscan (val)
	DB	'('
	CALL	VARSCAN		;SCAN VARIABLE TO UPDATE
	CALL	CSTRING		;MAKE SURE IT'S A STRING
	PUSH	D		;SAVE REFERENCE
	PUSH	H
	CALL	STRGTEST	;WHERE IS STRING NOW?
	PUSH	D		;SHOULDN'T BE IN PROGRAM
	CNC	STRGSTOR	;OR ELSE WE MODIFY OURSELF
	POP	H
	CALL	COPYVAL
	POP	H		;CONTINUE SCAN
	CALL	VALBYTE2	;SCAN STARTING POSITION
	ORA	A
	JZ	ERRAFC		;MUST BE NON-ZERO
	PUSH	D
	MVI	E,0FFH
	MOV	A,M
	CPI	')'		;DEFAULT LENGTH?
	CNZ	VALBYTE2	;SCAN LENGTH, IF GIVEN
	CALL	SCANNXTV	;bscan (val)
	DB	')'
	POP	B		;CONDENSE STACK
	MOV	D,C
	PUSH	D
	CALL	SCANNXTV	;bscan (val)
	DB	KEYEQ
	CALL	VALEXPR		;bscan expr  ;EVALUATE RIGHT HAND SIDE
	SHLD	SCANPTR1
	CALL	LENFCTC		;RELEASE STRING RESOURCE
	MOV	C,M		;AND LOAD DESCRIPTOR
	INX	H
	MOV	B,M
	POP	D		;GET BACK LENGTH, START
	CMP	E
	JNC	MIDSTMLN	;LENMOV = MIN(LENI, LENS)
	MOV	E,A
MIDSTMLN:
	POP	H		;RECOVER DESTINATION DESCRIPTOR
	MOV	A,M		;GET ITS LENGTH
	DCR	D
	SUB	D		;SUBTRACT STARTING POSITION
	JC	MIDSTMXT	;NOTHING TO DO IF BEYOND
	CMP	E
	JNC	MIDSTMLM
	MOV	E,A
MIDSTMLM:
	PUSH	B		;SAVE SOURCE ADDRESS
	CALL	LDICBMM		;COMPUTE DESTINATION ADDRESS
	MOV	L,D
	MVI	H,0
	DAD	B
	XCHG
	POP	B
	CALL	COPYSTRG	;COPY STRING
MIDSTMXT:
	LHLD	SCANPTR1
	RET

;
;  LOCATE STRING REFERENCE BY DE
;
STRGTEST:
	PUSH	D		;DE=STRING REFERENCE
	XCHG
	INX	H		;GET ADDRESS OF STRING
	MOV	E,M
	INX	H
	MOV	D,M
	LHLD	FREELIMT	;BOUNDARY
	CALL	CMHLLTDE	;NC = STRING IN PROGRAM
	POP	D		;C = STRIN IN BUFFER
	RET			;OR STRING SPACE
;
;  CASE/CONDITINAL STATEMENT PROCESSORS
;
ONSTM:
	CALL	VALBYTE		;ON STATEMENT
	MOV	A,M
	MOV	B,A
	CPI	KEYGSB		;GOSUB RATHER THAN GOTO?
	JZ	ONNSTMC
	CALL	SCANNXTV	;bscan (val)
	DB	KEYGTO		;MUST BE GOTO...
	DCX	H
ONNSTMC:
	MOV	C,E
ONNSTMSL:
	DCR	C		;LOOK FOR RIGHT LINE NUMBER
	MOV	A,B
	JZ	EXECUTES	;THEN EXECUTE STATEMENT
	CALL	SCANLINR
	CPI	','
	RNZ
	JMP	ONNSTMSL

IFSTM:
	CALL	VALNUMBR	;bscan numbr  ;IF STATEMENT
	MOV	A,M
	CPI	KEYGTO
	JZ	IFNSTMC
	CALL	SCANNXTV	;bscan (val)
	DB	KEYTHEN
IFNSTMC:
	CALL	SIGNACC		;TEST CONDITION
	JNZ	IFNSTMCH
	MVI	D,1
IFNSTMSK:
	MVI	C,KEYELS
	CALL	SCAN2KEY	;SKIP TO CORRESPONDING ELSE
	ORA	A
	RZ			;OR END OF LINE
	CALL	SCANNXT		;bscan +
	DCR	D
	JNZ	IFNSTMSK
IFNSTMCH:
	DCX	H		;bscan -
	CALL	SCANNXT		;bscan ,  ;CHOICE MADE
	JC	GTOSTM		;GOTO A LABEL,
	JMP	EXECUTEC	;OR EXECUTE A STATEMENT

;
;  PRINT STATEMENT PROCESSOR
;
PRTSTMN:
	CPI	KEYTAB		;TAB OPTION?
	JZ	PRNTOPTN
	CPI	KEYSPC		;SPACE OPTION
	JZ	PRNTOPTN
	PUSH	H
	CPI	','
	JZ	PRNTCOMA
	CPI	';'
	JZ	PRNTSEMI
	POP	B
	CALL	VALEXPR		;bscan expr
	DCX	H		;bscan -
	PUSH	H
	CALL	TYPECHK
	JZ	PRTSTRNG
	CALL	VALSTRGN	;CREATE STRING FROM NUMBER
	LHLD	ACCUMLTR	;VERIFY ROOM ENOUGH ON LINE
	MOV	A,M
	LXI	H,CURSPOS
	ADD	M
	INX	H
	ADD	M
	CC	PRNTCRLF	;NO ROOM, FIND ANOTHER LINE
	CALL	PRNTSTRT
	CALL	PRNTCHRI	;print (val)
	DB	' '
	INR	A
PRTSTRNG:
	CZ	PRNTSTRT	;SEND OUTPUT STRING
	POP	H
	CALL	SCANNXT		;bscan ,
PRTSTM:
	JNZ	PRTSTMN		;PRINT STATEMENT
PRNTCRLF:
	CALL	PRNTCHRI	;print (val)
	DB	CR		;PRINT A CR, LF
	CALL	PRNTCHRI	;print (val)
	DB	LF
PRNTNULS:
	LDA	NULLCNT		;PRINT NULLS AFTER CR
PRNTNULL:
	DCR	A
	STA	CURSPOS
	RZ
	PUSH	PSW
	XRA	A
	CALL	PRNTCHRA	;ac -> screen
	POP	PSW
	JMP	PRNTNULL
PRNTCOMA:
	LDA	CURSPOS		;COMMA SEPARATOR
	CPI	((LINESYZE/ITEMSIZE)-1)*ITEMSIZE
	CNC	PRNTCRLF
	JNC	PRNTSEMI
PRNTCOML:
	SUI	ITEMSIZE
	JNC	PRNTCOML
	CMA
	JMP	PRNTCOMC

PRNTOPTN:
	PUSH	PSW
	CALL	SCANNXT		;bscan +
	CALL	VALPARNS	;GET OPTION PARAMETER
	CALL	CSINGLE
	CALL	CBYTE
	DCX	H
	POP	PSW
	CPI	KEYSPC
	PUSH	H
	MOV	A,E
	JZ	PRNTBLNK
	LDA	CURSPOS
	CMA
	ADD	E
	JNC	PRNTSEMI
PRNTCOMC:
	INR	A
PRNTBLNK:
	MOV	B,A		;PAD OUTPUT WITH A BLANKS
	ORA	A
	JZ	PRNTSEMI
	MVI	A,' '
PRNTBLNL:
	CALL	PRNTCHRA	;ac -> screen
	DCR	B
	JNZ	PRNTBLNL
PRNTSEMI:
	POP	H
	CALL	SCANNXT		;bscan ,
	RZ
	JMP	PRTSTMN
PRNTNUMS:
	INX	H		;SEND STRING TO TRANSMITTER
PRNTMSG:
	PUSH	B
	PUSH	D
	LXI	B,POPDEBCR
	PUSH	B
	CALL	VALSTRGZ	;STRING ENDS ON ZERO
PRNTSTRT:
	CALL	STRGRELA
	CALL	LDDCBMM
	INR	D
PRNTSTRL:
	DCR	D
	RZ
	LDAX	B
	CALL	PRNTCHRA	;ac -> screen
	CPI	CR
	CZ	PRNTNULS
	INX	B
	JMP	PRNTSTRL

;
;  RETURN CURRENT POTITION ON OUTPUT LINE
;
POSFCT:
	LDA	CURSPOS		;POS FUNCTION
FLOATA:
	MOV	B,A		;RETURN BYTE ANSWER
	XRA	A
	JMP	FLOATAB

;
;  PLOT STATEMENT
;
PLTSTM:
	CALL	VALNUMBR	;bscan numbr  ;GET X-COORDINATE
	CALL	CINTEGER
	PUSH	D
	CALL	SCANNXTV	;bscan (val)
	DB	','
	CALL	VALNUMBR	;bscan numbr  ;GET Y-COORDINATE
	CALL	CINTEGER
	PUSH	D
	CALL	SCANNXTV	;bscan (val)
	DB	','
	CALL	VALNUMBR	;bscan numbr  ;GET OPERATION
	CALL	CINTEGER
	MOV	A,E
	POP	D
	POP	B
	PUSH	H
;	CALL	SYSPLOT
	POP	H
	RET
;
;  INPUT/READ STATEMENT PROCESSORS
;
MSGQUES:
	DB	'??',0
MSGREDO:
	DB	'?REDO FROM START',CR,LF,0
MSGEXTRA:
	DB	'?EXTRA IGNORED',CR,LF,0
;
;  INPUT
;
INPSTM:
	XRA	A		;INPUT STATEMENT
	STA	PRINTFLG	;TURN ON PRINTING
INPSTMRD:
	PUSH	H		;SAVE SCAN IN CASE OF ERROR
	MVI	C,LINESYZE/2
	CALL	SPACESTK
	XCHG
	LHLD	INPTBUFR	;SAVE ADDRESS OF CURRENT BUFFER
	PUSH	H
	LXI	H,0-LINESYZE-3
	DAD	SP
	SPHL			;AND CREATE A NEW BUFFER
	SHLD	INPTBUFR
	XCHG
	MOV	A,M
	CPI	'"'
	JZ	INPSTMPR
	CPI	KEYPRM
	LXI	D,MSGQUES+1
	JNZ	INPSTMIN
	CALL	SCANNXT		;bscan +
INPSTMPR:
	CALL	VALEXPR		;bscan expr  ;OPTIONAL PROMPT STRING
	CALL	CSTRING
	CALL	SCANNXTV	;bscan (val)
	DB	';'
	PUSH	H
	CALL	PRNTSTRT
	POP	H
	LXI	D,MSGQUES+2
INPSTMIN:
	PUSH	H
	CALL	DATAINPT
	JMP	REAINPFS
;
;  READ
;
REASTM:
	PUSH	H		;READ STATEMENT
	LHLD	CURDATAP
	MOV	A,M
	ORA	A
	CZ	DATASRCH	;GET DATA IF NECESSARY

REAINPFS:
	STA	REAINPFL
	JMP	REAINPLQ
REAINPLP:
	CALL	SCANNXTV	;bscan (val)
	DB	','
	XTHL
	MOV	A,M
	CPI	','
	CNZ	DATAGET
REAINPLQ:
	XTHL
	MOV	A,M
	CPI	KEYLINE		;LINE OPTION?
	JZ	INPSTMLN
	CALL	VARSCAN		;FIND NEXT VARIABLE TO BE INPUT
	XTHL			;SAVE INPUT LIST POINTER
	PUSH	D		;SAVE VARIABLE POINTER,
	LDA	TYPEFLG		;AND TYPE
	PUSH	PSW
	CALL	REAINPDC	;DECODE INPUT
REAINPLA:
	POP	PSW		;ASSIGN VALUE
	POP	D
	CALL	ASSIGN
	DCX	H		;bscan -
	CALL	SCANNXT		;bscan ,
	JZ	REAINPCM
	CPI	','		;DATA ITEMS SEPARTED BY COMMAS
	JNZ	REAINPER
REAINPCM:
	XTHL
	DCX	H		;bscan -  ;MORE VARIABLES?
	CALL	SCANNXT		;bscan ,
	JNZ	REAINPLP
	POP	D		;END OF VARLIST
	LDA	REAINPFL
	ORA	A
	XCHG
	JNZ	RESDTPTR
	PUSH	D
	PUSH	PSW
	ORA	M
	LXI	H,MSGEXTRA
INPSTMER:
	CNZ	PRNTMSG
	POP	PSW
INPSTMXT:
	POP	D		;RECOVER SCAN POINTER
	LXI	H,0+LINESYZE+3
	DAD	SP
	SPHL			;DEALLOCATE BUFFER
	POP	H
	SHLD	INPTBUFR	;AND RESTORE ADDRESS OF OLD
	XCHG
	POP	D
	RZ
	JM	INPSTMBR	;BREAK TIME...
	XCHG
	JMP	INPSTMRD	;OR REDO THE INPUT

REAINPER:
	LDA	REAINPFL
	ORA	A
	JNZ	ERRDATA
	LXI	H,MSGREDO
	INR	A
	PUSH	PSW
	JMP	INPSTMER

;
;  SEARCH FOR DATA STATEMENT
;
DATAGET:
	LDA	REAINPFL
	ORA	A		;READ OR INPUT?
	LXI	D,MSGQUES
	JZ	DATAINPT	;INPUT
DATASRCH:
	CALL	DATSTM		;LOOK FOR NEXT DATA STATEMENT
	ORA	A
	JNZ	DATASRCK
	INX	H
	MOV	A,M
	INX	H
	ORA	M
	INX	H
	MVI	E,ERRNOD-ERRN
	JZ	ERRMSG
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	SHLD	CURLDATA
	XCHG
DATASRCK:
	CALL	SCANNXT		;bscan ,
	CPI	KEYDAT
	JNZ	DATASRCH
	RET

DATAINPT:
	CALL	INPTRQST
	RZ			;INPUT OK, RETURN
	POP	B		;BREAK ***
	JMP	INPSTMXT

REAINPDC:
	CALL	SCANNXT		;bscan ,
	CALL	TYPECHK
	MOV	A,M
	JNZ	DECODE		;READ/INPUT A NUMBER
	CPI	'"'
	JZ	VALSTRGC
	MVI	D,':'
	MVI	B,','
	DCX	H
	JMP	VALSTRGS	;READ/INPUT A STRING

INPSTMLN:
	LDA	REAINPFL	;LINE OPTION VALID ONLY
	ORA	A		;FOR INPUT STATEMENT
	JNZ	ERRASN
	CALL	SCANNXT		;bscan +
	CALL	VARSCAN
	XTHL
	PUSH	D
	LDA	TYPEFLG
	PUSH	PSW
	MVI	B,0
	CALL	VALSTRGY	;SWALOW REST OF INPUT LINE
	JMP	REAINPLA	;AND ASSIGN TO STRING VARIABLE
;
;  NEXT STATEMENT PROCESSOR
;
NEXSTM:
	LXI	D,0		;NEXT STATEMENT
NEXSTML:
	CNZ	VARSCAN
	SHLD	PROGCNTR
	CALL	FORCHK		;VERIFY WE'RE IN FOR LOOP
	JNZ	ERRANF
	SPHL			;BACK UP STACK
	PUSH	D
	MOV	A,M		;RECOVER SIGN OF STEPSIZE
	INX	H
	PUSH	PSW
	PUSH	D
	CALL	LDRGACMM	;RECOVER STEP SIZE
	XTHL
	PUSH	H
	CALL	FLADDM		;INCREMENT CONTROL VARIABLE
	POP	H
	CALL	LDMMAC
	POP	H
	CALL	LDRGMM
	PUSH	H
	CALL	FLCMP
	POP	H
	POP	B
	SUB	B
	CALL	LDRGMM		;RECOER LINE NUMBR, PROGRAM CNTR
	JZ	NEXSTMC		;CHECK LIMIT
	CALL	TRACE
	XCHG
	SHLD	CURLINE
	MOV	H,B
	MOV	L,C
	JMP	FORMARK

ERRANF:
	MVI	E,ERRNNF-ERRN
	JMP	ERRMSG

NEXSTMC:
	SPHL			;END OF LOOP...
	LHLD	PROGCNTR
	MOV	A,M
	CPI	','
	JNZ	EXECUTEL	;MORE INDICES?
	CALL	SCANNXT		;bscan	,
	CALL	NEXSTML
;
;  EVALUTATE AN EXPRESSION
;
VALEXPR:
	DCX	H		;SCAN & EVALUATE AN EXPRESSION
	MVI	D,0		;INITIAL PRECEDENCE=0
VALEXPRL:
	PUSH	D
	MVI	C,1
	CALL	SPACESTK
	CALL	VALPRMRY	;bscan prmry
	SHLD	SCANPTR2
VALEXPRC:
	LHLD	SCANPTR2
VALEXPRD:
	POP	B		;PREVIOUS PRECEDENCE
	MOV	A,B
	CPI	PREDNUM
	CNC	CSINGLE
	MOV	A,M
	MVI	D,000H
VALEXPRR:
	SUI	KEYREL		;RELATION?
	JC	VALEXPRO
	CPI	KEYFCT-KEYREL
	JNC	VALEXPRO
	CPI	1		;YES
	RAL
	XRA	D		;CONVERT 0,1,2 TO 1,2,4
	CMP	D
	MOV	D,A
	JC	ERRASN
	SHLD	SCANPTR1
	CALL	SCANNXT		;bscan ,
	JMP	VALEXPRR

VALEXPRO:
	MOV	A,D
	ORA	A
	JNZ	VALREL
	MOV	A,M
	SHLD	SCANPTR1
	SUI	KEYOPR		;OPERATOR?
	RC
	CPI	KEYREL-KEYOPR
	RNC
	MOV	E,A		;YES
	CALL	TYPECHK		;STRING OPERANDS?
	ORA	E		;AND CATENATION OPERATOR?
	MOV	A,E
	JZ	VALCONCT	;YES
	ADD	E
	ADD	E
	MOV	E,A
	LXI	H,OPRTABL
	DAD	D
	MOV	A,B
	MOV	D,M
	CMP	D
	RNC
	INX	H
	CALL	CSINGLE
VALEXPR2:
	PUSH	B		;STACK OPERATION
	LXI	B,VALEXPRC	;EVALUATE SECOND OPERAND
	PUSH	B
	MOV	B,D
	MOV	C,E
	CALL	PUSHAC
	MOV	D,B
	MOV	E,C
	MOV	C,M
	INX	H
	MOV	B,M
	PUSH	B
	LHLD	SCANPTR1
	JMP	VALEXPRL

;
;  EVALUATE A RELATION
;
VALREL:
	LXI	H,RELOPR	;SCAN & EVALUATE RELATION
	LDA	TYPEFLG
	RLC
	RLC
	RLC
	ORA	D
	MOV	E,A
	MVI	D,PREDREL
	MOV	A,B
	CMP	D
	RNC
	JMP	VALEXPR2

RELOPRXT:
	INR	A		;MATCH RESULF OF COMPARISON
	ADC	A		;-1,0,1 TO 1,2,4
	POP	B		;VERSUS RELATION TO BE TESTED
	ANA	B
	ADI	-1
	SBB	A
	JMP	FLOATBYT
RELOPR:
	DW	RELOPRC		;COMPUTE RELATION
RELOPRC:
	MOV	A,C
	POP	B
	POP	D
	PUSH	PSW
	RRC
	RRC
	RRC
	ANI	00FH
	CALL	COERCE
	LXI	H,RELOPRXT
	PUSH	H
	JNZ	FLCMP		;NUMERIC COMPARISON?
	MVI	A,TYPESING	;NO, STRING
	STA	TYPEFLG
	PUSH	D
	CALL	STRGRELA	;RELEASE TEMP OF SECOND OPERAND
	POP	D
	MOV	C,M
	INX	H
	PUSH	B		;SAVE LENGTH
	MOV	C,M
	INX	H
	MOV	B,M
	PUSH	B		;AND ADDRESS
	CALL	STRGRELD	;RELEASE TEMP OF FIRST OPERAND
	CALL	LDDCBMM
	POP	H
	XTHL
	MOV	E,L
	POP	H
RELOPRSL:
	MOV	A,E		;COMPARE CHARACTER BY CHARACTER
	ORA	D
	RZ
	MOV	A,E
	SUI	1
	RC
	XRA	A
	CMP	D
	INR	A
	RNC
	DCR	D
	DCR	E
	LDAX	B
	CMP	M
	INX	H
	INX	B
	JZ	RELOPRSL
	CMC
	JMP	CMPXT
;
;  EVALUATE A PRIMARY
;
VALPRMRY:
	MVI	A,TYPESING	;SCAN & EVALUATE A PRIMARY
	STA	TYPEFLG
	CALL	SCANNXT		;bscan ,
	JC	DECODE		;NUMERIC CONSTANT?
	CALL	ALPHACHK
	JC	VALVAR		;VARIABLE?
	CPI	KEYADD
	JZ	VALPRMRY
	CPI	'.'
	JZ	DECODE
	CPI	KEYSUB
	JZ	VALUMINS
	CPI	'"'		;STRING CONSTANT?
	JZ	VALSTRGC
	CPI	KEYNOT
	JZ	VALUNOT
	CPI	KEYFN		;DEFINED FUNCTION?
	JZ	VALFCTD
	CPI	KEYIF		;CONDITIONAL EXPRESSION?
	JZ	VALCOND
	SUI	KEYFCT		;INSTRISIC FUNCTION?
	JNC	VALFCTN
VALPARNS:
	CALL	SCANNXTV	;bscan (val)
	DB	'('
VALPARN2:
	CALL	VALEXPR		;bscan expr
	CALL	SCANNXTV	;bscan (val)
	DB	')'
	RET

VALUMINS:
	MVI	D,PREDUMIN	;EVALUATE UNARY MINUS
	CALL	VALEXPRL
	LHLD	SCANPTR2
	PUSH	H
	CALL	CMACCS
VALRETNM:
	CALL	CSINGLE
	POP	H
	RET
;
;  EVALUATE A VARIABLE
;
VALVAR:
	CALL	VARSCAN		;SCAN & EVALUATE VARIABLE
	PUSH	H
	PUSH	D
	XCHG
	MVI	E,ERRNUV-ERRN
	JNZ	ERRMSG
	SHLD	ACCUMLTR
	CALL	TYPECHK
	XCHG
	LXI	H,ACCUMLTR
	CNZ	COPYVAL
	POP	D
	POP	H
	RET

;
;  EVALUATE CONDITIONAL EXPRESSION
;
VALCOND:
	CALL	SCANNXT		;bscan , EVAL CONDITIONAL EXPRESSION
	CALL	VALNUMBR	;bscan numbr
	CALL	SCANNXTV	;bscan (val)
	DB	KEYTHEN
	CALL	SIGNACC
	JZ	VALCONDF
	CALL	VALEXPR		;bscan expr  ;TRUE, EVALUATE THEN PORTION
	MVI	D,1
VALCNDTL:
	MVI	C,KEYEND
	CALL	SCAN2KEY	;SKIP ELSE PORTION
	CALL	SCANNXTV	;bscan (val)
	DB	KEYEND
	DCR	D
	JNZ	VALCNDTL
	RET

VALCONDF:
	MVI	D,1
VALCNDFL:
	MVI	C,KEYELS	;FALSE, SKIP THEN PORTION
	CALL	SCAN2KEY
	CALL	SCANNXTV	;bscan (val)
	DB	KEYELS
	DCR	D
	JNZ	VALCNDFL
	CALL	VALEXPR		;bscan expr  ;EVALUAGE ELSE PORTION
	CALL	SCANNXTV	;bscan (val)
	DB	KEYEND
	RET
;
;  EVALUATE INSTRINSIC FUNCTION
;
VALFCTN:
	MVI	B,000H		;Scan & EVALUATE INSTRINSIC FUNCTION
	RLC
	MOV	C,A
	PUSH	B
	CALL	SCANNXT		;bscan ,
	MOV	A,C
	CPI	(KEYLFT-KEYFCT)*2-1	;LEFT$, MID$, OR RIGHT$
	JC	VALFCTAR
	CALL	SCANNXTV	;bscan (val)
	DB	'('
	CALL	VALEXPR		;bscan expr
	CALL	CSTRING
	XCHG
	LHLD	ACCUMLTR
	XTHL			;PUSH STRING ONTO STACK
	JMP	VALFCTLK

VALFCTAR:
	CALL	VALPARNS	;EVALUATE ARGUMENT TO FUNCTION
	XTHL
	LXI	D,VALRETNM
	PUSH	D
VALFCTLK:
	LXI	B,FCTTABL	;BRANCH TO APPROPRIATE ROUTINE
	DAD	B
	MOV	C,M
	INX	H
	MOV	H,M
	MOV	L,C
	PCHL			;CALL FUNCTION
;
;  PROCESS STRING CONSTANT
;
VALSTRGN:
	CALL	ENCODE		;CREATE STRING FROM NUMBER
VALSTRGZ:
	MVI	B,080H
	DCX	H
	JMP	VALSTRGY

VALSTRGC:
	MVI	B,'"'		;SCAN & DECODE A STRING CONSTANT
VALSTRGY:
	MOV	D,B
VALSTRGS:
	PUSH	H
	MVI	C,-1
VALSTRGL:
	INX	H		;FIND STRING LENGTH
	MOV	A,M
	INR	C
	ORA	A
	JZ	VALSTRGE
	CMP	D
	JZ	VALSTRGE
	CMP	B
	JNZ	VALSTRGL
VALSTRGE:
	CPI	'"'
	CZ	SCANNXT
	XTHL
	INX	H
	XCHG
	MOV	A,C
	CALL	STRSTCDS
	XCHG
	CALL	STRGTEST	;LOCATE STRING
	CMC
	RAR
	ORA	B
	CP	STRGSTOR	;MAKE COPY OF CERTAIN BUFFERS
;
;  ALLOCATE STRING TEMPORARY
;
STRGALOT:
	LXI	D,STRGTMPL	;USE CURRENT DESCRIPTOR
STRGALOU:
	PUSH	D
	MVI	A,TYPESTRG	;RETURN STRING RESULT
	STA	TYPEFLG
	LHLD	STRGTMPP	;IN A NEW STRING TEMPORARY
	SHLD	ACCUMLTR
	XCHG
	LHLD	STRGTLIM	;ANY MORE TEMPORARIES?
	CALL	CMHLLTDE
	JC	ERRAST
	XCHG
	POP	D		;GET DESCRIPTOR
	CALL	COPYVAL		;COPY IT
	SHLD	STRGTMPP
	POP	H
	RET

STRGALOV:
	PUSH	H
	JMP	STRGALOU

ERRAST:
	MVI	E,ERRNST-ERRN
	JMP	ERRMSG
;
;  RELEASE STRING RESOURCES
;
STRGRELA:
	LHLD	ACCUMLTR
STRGRELH:
	XCHG
STRGRELD:
	CALL	STRGRELT	;RELEASE TEMPORARY
	XCHG
	RNZ			;NOT OUR BOY
	PUSH	D
	MOV	D,B
	MOV	E,C
	DCX	D
	MOV	C,M
	LHLD	STRGFREE
	CALL	CMHLLTDE
	JNZ	POPHLRET
	MOV	B,A		;RELEASE STRING SPACE
	DAD	B
	SHLD	STRGFREE
	POP	H
	RET

;
;  RELEASE STRING TEMPORARY
;
STRGRELT:
	LHLD	STRGTMPP	;RELEASE STRING TEMPORARY
	DCX	H
	MOV	B,M
	DCX	H
	MOV	C,M
	DCX	H
	CALL	CMHLLTDE
	RNZ
	SHLD	STRGTMPP	;RELEASE STRING TEMPORARY
	RET
;
;  EVALUATE A CATENATION
;
VALCONCT:
	PUSH	B		;EVALUATE A CONCATENATION
	PUSH	H
	LHLD	ACCUMLTR	;SAVE FIRST OPERAND,
	XTHL
	CALL	VALPRMRY	;bscan prmry  ;EVALUATE SECOND
	XTHL
	CALL	CSTRING
	MOV	A,M		;ADD LENGTHS,
	PUSH	H
	LHLD	ACCUMLTR
	PUSH	H
	ADD	M
	MVI	E,ERRNLS-ERRN
	JC	ERRMSG
	CALL	STRNGEN		;AND ALLOCATE OUTPUT STRING
	POP	D
	CALL	STRGRELD	;RELEASE STRING TEMPORARIES
	XTHL
	CALL	STRGRELH
	PUSH	H
	LHLD	STRGTMPA	;COPY STRINGS TO OUTPUT STRING
	XCHG
	CALL	VALCONCP
	CALL	VALCONCP
	LXI	H,VALEXPRD
	XTHL
	PUSH	H
	JMP	STRGALOT

VALCONCP:
	POP	H		;COPY STRING FOR CATENATION
	XTHL
	MOV	A,M		;GET LENGTH,
	INX	H
	MOV	C,M		;ADDRESS OF STRING
	INX	H
	MOV	B,M
	MOV	L,A

COPYSTRG:
	INR	L		;COPY A STRING OF LENGTH L
COPYSTRL:
	DCR	L		;FROM BC TO DE
	RZ
	LDAX	B
	STAX	D
	INX	B
	INX	D
	JMP	COPYSTRL
;
;  DIMENSION STATEMENT PROCESSING
;
DIMSTML:
	DCX	H
	CALL	SCANNXT		;bscan ,
	RZ
	CALL	SCANNXTV	;bscan (val)
	DB	','
DIMSTM:
	LXI	B,DIMSTML	;DIM STATEMENT
	PUSH	B
	MVI	A,080H
	JMP	VARSCANI

;
;  SCAN A VARIABLE NAME
;
VARSCAN:
	XRA	A		;SCAN FOR VARIABLE
VARSCANI:
	STA	MATDMFLG
	MVI	B,0*TYPEDEF
VARSCNDF:
	CALL	ALPHACHK	;ENTRY TO SCAN FOR DEFINED FCT
	JNC	ERRASN
	ORA	B
	MOV	B,A
	MVI	C,'?'
	MVI	D,TYPESING	;ASSUME NUMERIC VARIABLE
	CALL	SCANNXT		;bscan ,
	JC	VARSCAND
	CALL	ALPHACHK
	JNC	VARSCANS
VARSCAND:
	MOV	C,A
VARSKIPL:
	CALL	SCANNXT		;bscan ,  ;SKIP EXTRA ALPHANUMERIC
	JC	VARSKIPL	;CHARACTERS IN NAME
	CALL	ALPHACHK
	JC	VARSKIPL
VARSCANS:
	SUI	'$'		;STRING VARIABLE?
	JNZ	VARNAME
	MVI	D,TYPESTRG	;YES
	CALL	SCANNXT		;bscan ,

VARNAME:
	MOV	A,B		;TRANSLATE IDENT OT INTERNAL FORM
	SUI	'@'		;DEF/VARIABLE IS FIRST BIT
	RLC			;FIRST CHAR IS NEXT FIVE BITS
	RLC
	MOV	B,A
	MOV	A,C		;SECOND CHAR IS NEXT SIX BITS
	SUI	'0'
	RRC
	RRC
	RRC
	RRC
	MOV	C,A
	XRA	B		;PACK THREE BYTES INTO TWO
	ANI	0003H
	XRA	B
	MOV	B,A
	MOV	A,D
	STA	TYPEFLG
	XRA	C		;TYPE IS LAST FOUR BITS
	ANI	00FH
	XRA	C
	MOV	C,A

	LDA	SCANPFLG
	ADD	M
	CPI	'('		;SUBSCRIPTED?
	JZ	MATSCANP
	CPI	'['		;BY LEFT BRACKET?
	JZ	MATSCANB
	XRA	A
	STA	SCANPFLG
	PUSH	H

;
;  LOOK UP VARIABLE IN TABLE
;
	LHLD	VARTABLE
VARSCANT:
	XCHG
	LHLD	MATTABLE
	CALL	CMHLLTDE	;LOOK THROUGH VARIABLE TABLE
	JZ	VARSCANF
	LDAX	D
	MOV	L,A
	CMP	C
	INX	D
	JNZ	VARSCANM
	LDAX	D
	CMP	B
VARSCANM:
	INX	D
	JZ	VARSCANX
	MOV	A,L
	ANI	00FH		;ADDRESS NEXT ENTRY
	MOV	L,A
	MVI	H,0
	DAD	D
	JMP	VARSCANT

VARSCANF:
	PUSH	B		;NOT FOUND, CREATE ENTRY
	MOV	A,C
	ANI	00FH
	ADI	2
	MOV	C,A
	MVI	B,0
	XCHG
	LHLD	FREELIMT
	PUSH	H
	DAD	B
	POP	B
	PUSH	H
	CALL	COPYCHK		;MOVE ARRAYS FOR SPACE
	POP	H
	SHLD	FREELIMT
	MOV	H,B
	MOV	L,C
	SHLD	MATTABLE	;ALLOCATE, ZERO ENTRY
VARALLOC:
	DCX	H	
	MVI	M,000H
	CALL	CMHLLTDE
	JNZ	VARALLOC
	POP	D
	MOV	M,E
	INX	H
	MOV	M,D
	INX	H
	XCHG			;EXIT VARIABLE SCAN
	ORA	E		;NZ=VAR NOT FOUND, CREATED
VARSCANX:
	POP	H		;HL=SCAN POINTER
	RET

;
;  LOOK UP ARRAY IN TABLE
;
MATSCANB:
	ADI	']'-'['+'('-')'	;(got me?)
MATSCANP:
	ADI	')'-'('
	PUSH	H		;SCAN SUBSCRIPT OF VARIABLE
	LHLD	MATDMFLG
	ORA	L
	MOV	L,A
	XTHL			;SAVE DIMFLAG, CLOSE CHAR, TYPE
	MVI	D,000H
MATSCANL:
	PUSH	D		;SCAN SUBSCRIPT LIST
	PUSH	B
	CALL	SCANNXT		;scan ,
	CALL	VALINTDE	;EVALUATE SUBSCRIPT
	POP	B
	POP	PSW
	XCHG
	XTHL
	PUSH	H
	XCHG
	INR	A		;COUNT NUMBER OF SUBSCRIPTS
	MOV	D,A
	MOV	A,M
	CPI	','
	JZ	MATSCANL
	XTHL
	SHLD	MATDMFLG	;RESTORE DIMFLAG, TYPE
	MOV	A,L
	POP	H
	XRA	M
	ADD	A		;CHECK FOR CORRECT CLOSER
	JNZ	ERRASN
	SHLD	SCANPTR2
	PUSH	D
	LHLD	MATTABLE	;LOOK FOR NAME IN
	JMP	MATSCANO	;MAT VARIABLE TABLE
MATSCANN:
	DAD	D
MATSCANO:
	XCHG
	LHLD	FREELIMT
	XCHG
	CALL	CMHLLTDE
	JZ	MATSCANC
	MOV	A,M
	CMP	C
	INX	H
	JNZ	MATSCANM
	MOV	A,M
	CMP	B
MATSCANM:
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	JNZ	MATSCANN
	LDA	MATDMFLG	;NAME FOUND
	ORA	A
	MVI	E,ERRNDD-ERRN
	JM	ERRMSG
	POP	PSW		;RIGHT NUMBER OF SUBSCRIPTS?
	CMP	M
	JZ	MATSCANI
ERRABS:
	MVI	E,ERRNBS-ERRN
	JMP	ERRMSG

MATSCANC:
	MOV	A,C		;NAME NOT FOUND, CREATE NEW ENTRY
	ANI	00FH
	MOV	E,A
	MVI	D,0
	MOV	M,C
	INX	H
	MOV	M,B
	INX	H
	POP	PSW
	STA	MATSCCNT
	MOV	C,A
	CALL	SPACESTK
	SHLD	SCANPTR1
	INX	H
	INX	H		;plus 2
	MOV	B,C
	MOV	M,B
	INX	H
MATSCNSB:
	LDA	MATDMFLG	;SET SUBSCRIPT RANGES
	ORA	A
	MOV	A,B
	LXI	B,11		;DEFAULT RANGE=0-10
	JP	MATSCNSD
	POP	B
	INX	B
MATSCNSD:
	MOV	M,C
	INX	H
	MOV	M,B
	INX	H
	PUSH	PSW
	PUSH	H
	CALL	MUL16		;UPDATE ARRAY SIZE
	XCHG
	POP	H
	POP	B
	DCR	B
	JNZ	MATSCNSB
	MOV	B,D
	MOV	C,E
	XCHG			;ALLOCATE ARRAY,
	DAD	D
	JC	ERRABS
	CALL	SPACECHK
	SHLD	FREELIMT
MATSCANZ:
	DCX	H		;AND ZERO
	MVI	M,000H
	CALL	CMHLLTDE
	JNZ	MATSCANZ
	INX	B		;SAVE ENTRY SIZE
	MOV	H,A
	LDA	MATDMFLG
	ORA	A
	LDA	MATSCCNT
	MOV	L,A
	DAD	H
	DAD	B
	XCHG
	LHLD	SCANPTR1	;AT BEGINNING OF ENTRY
	MOV	M,E
	INX	H
	MOV	M,D
	INX	H
	JM	MATSCANX	;DIM ONLY?
MATSCANI:
	INX	H		;INITIALIZE SUBSCRIPT COMPUTATION
	LXI	B,0
	JMP	MATSCANS
MATSCANR:
	POP	H		;COMPUTE SPECIFIC REFERENCE
MATSCANS:
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	XTHL
	PUSH	PSW
	CALL	CMHLLTDE
	JNC	ERRABS
	PUSH	H
	CALL	MUL16
	POP	D
	DAD	D
	POP	PSW
	DCR	A
	MOV	B,H
	MOV	C,L
	JNZ	MATSCANR
	LDA	TYPEFLG
	MOV	E,A
	MVI	D,0
	CALL	MUL16		;MULTIPLY BY ENTRY SIZE
	POP	B
	DAD	B
	XCHG
MATSCANX:
	LHLD	SCANPTR2
	CALL	SCANNXT		;bscan ,
	CMP	A
	RET

MUL16:
	LXI	H,0		;MULTIPLY BC*DE GIVING HL
	MOV	A,B
	ORA	C
	RZ
	MVI	A,16
MUL16LP:
	DAD	H
	JC	ERRABS
	XCHG
	DAD	H
	XCHG
	JNC	MUL16XT
	DAD	B
	JC	ERRABS
MUL16XT:
	DCR	A
	JNZ	MUL16LP
	RET
;
;  USER-DEFINED FUNCTION DEFINITION
;
DEFSTM:
	CALL	SCANFNN		;DEF STATEMENT
	PUSH	H		;CHECK IF IN DIRECT MODE
	LHLD	CURLINE		;Z=DIRECT MODE
	INX	H
	MOV	A,H
	ORA	L
	POP	H
	JZ	ERRAID
	XCHG			;SAVE REFERENCE TO DEFINITION
	MOV	M,E
	INX	H
	MOV	M,D
	XCHG	
	MOV	A,M
	CPI	'('		;CHECK FOR VARLIST
DEFSTML:
	JNZ	DATSTM
	CALL	SCANNXT		;bscan ,
	CALL	VARSCAN		;DEFINE VARIABLES IN LIST
	MOV	A,M
	CPI	','
	JMP	DEFSTML
;
;  USER-DEFINED FUNCTION EVALUATION
;
VALFCTD:
	CALL	SCANFNN		;SCAN & EVALUATE USER DEFINED FUNCTION
	LDA	TYPEFLG		;SAVE TYPE OF FUNCTION
	ORA	A
	PUSH	PSW
	PUSH	H		;SAVE CALL ARGUMENTS
	XCHG
	MOV	A,M
	INX	H
	MOV	H,M		;FETCH FUNCTION DEFINITION
	MOV	L,A
	ORA	H
	MVI	E,ERRNUF-ERRN
	JZ	ERRMSG		;MUST BE DEFINED ...
	MOV	A,M
	CPI	'('		;PARAMETERS NEEDED?
	JNZ	VALFCTNA	;APPARENTLY NOT
	CALL	SCANNXT		;bscan ,
	XTHL
	CALL	SCANNXTV	;bscan (val)
	DB	'('		;MUST BE PARAMETERS IN CALL
	XTHL
	JMP	VALFCTDM
;
;  ARGUMENT SCANNING
;
VALFCTDL:
	CALL	SCANNXTV	;bscan (val)
	DB	','		;COMMAS BETWEEN ARGUMENTS
	XTHL
	CALL	SCANNXTV	;bscan (val)
	DB	','		;AND BETWEEN PARAMETERS
VALFCTDM:
	MVI	C,4		;VERIFY SPACE ON STACK
	CALL	SPACESTK
	MVI	A,SCANPFLD	;SCAN NEXT PARAMETER
	STA	SCANPFLG
	CALL	VALVAR		;GET CURRENT VALUE OF PARAMETER
	SHLD	SCANPTR1	;SAVE PARAMETER SCAN
	POP	H
	SHLD	SCANPTR2	;SAVE ARGUMENT SCAN
	CALL	TYPECHK
	JZ	VALFCTPS	;PUSH STRINGS DIFFERENTLY
	CALL	PUSHAC1		;PUSH NUMERIC ACCUMULATOR
	PUSH	H		;SAVE VARIABLE'S ADDRESS
	JMP	VALFCTPT
VALFCTPS:
	CALL	STRGALOV	;COPY DESCRIPTOR TO TEMPORARY
	XRA	A		;ELIMINATE ORIGINAL DESCRIPTOR
	DCX	D
	DCX	D
	DCX	D		;plus 3
	STAX	D
	LHLD	ACCUMLTR	;GET ADDRESS OF DESCRIPTOR
	PUSH	H
	PUSH	D		;PUT IT BACK HERE LATER

VALFCTPT:
	LDA	TYPEFLG		;SAVE TYPE OF PARAMETER
	STC
	POP	D
	PUSH	D		;GET COPY OF ADDRESS
	PUSH	PSW
	LHLD	SCANPTR1	;SAVE PARAMETER SCAN
	PUSH	H
	LHLD	SCANPTR2
	CALL	ASSIGNVL	;UPDATE VALUE OF PARAMETER
	MOV	A,M
	CPI	')'
	JNZ	VALFCTDL	;MORE ARGUMENTS
	CALL	SCANNXT		;bscan (val)
	XTHL
	CALL	SCANNXTV	;bcscan (val)
	DB	')'		;MUST BE END OF PARAMETERS TOO
;
;  EVALUATE EXPRESSION
;
VALFCTNA:
	CALL	SCANNXTV	;bscan (val)
	DB	KEYEQ		;LOOK FOR EQUALS SIGN
	CALL	VALEXPR		;bscan expr  ;EVALUATE FUNCTION
	DCX	H
	CALL	SCANNXT		;bscan ,
	JNZ	ERRASN
	POP	H
	SHLD	SCANPTR1
	CALL	TYPECHK
	JNZ	VALFCTRL
	CALL	STRGUNIQ
	XCHG
	SHLD	ACCUMLTR
;  RESTORE PARAMETERS
;
VALFCTRL:
	POP	PSW		;RESTORE VALUES OF PARAMETERS
	JNC	VALFCTCR
	POP	H
	CALL	TYPECHKA
	JZ	VALFCTRS
	POP	B
	POP	D
	MOV	M,E		;RESTORE NUMERIC VALUE
	INX	H
	MOV	M,D
	INX	H
	MOV	M,C
	INX	H
	MOV	M,B
	JMP	VALFCTRL
VALFCTRS:
	POP	D		;RESTORE STRING VALUE
	XCHG
	SHLD	STRGTMPP	;DEALLOCATE TEMPORARY
	XCHG
	MVI	B,TYPESTRG
	CALL	COPYVALL
	JMP	VALFCTRL

VALFCTCR:
	LHLD	SCANPTR1	;COERCE RESULT TO CORRECT TYPE
	CALL	TYPECHKA	
	JNZ	COERCEF
	CALL	CSTRING		;STRING FUNCTION
	PUSH	H
	LHLD	ACCUMLTR
	XCHG
	CALL	STRGRELT
	JMP	STRGALOU

ERRAID:
	MVI	E,ERRNID-ERRN
	JMP	ERRMSG

SCANFNN:
	CALL	SCANNXTV	;bscan (val)
	DB	KEYFN
	MVI	A,SCANPFLD
	STA	SCANPFLG
	MVI	B,TYPEDEF
	JMP	VARSCNDF
;
;  GENERATE A NEW CURRENT STRING
;
STRNGEN:
	CALL	STRGALOC	;GENERATE A NEW STRING,
STRSTCDS:
	LXI	H,STRGTMPL	;SET CURRENT STRING DESCRIPTOR
	PUSH	H
	MOV	M,A
	INX	H
	MOV	M,E
	INX	H
	MOV	M,D
	POP	H
	RET

;
;  ALLOCATE STORAGE IN STRING SPACE
;
STRGALOC:
	ORA	A		;ALLOCATE SPACE FOR STRING,
	JMP	STRGALAH	;SIZE IN A
STRGALAG:
	POP	PSW		;ENTER FOR SECOND TRY
STRGALAH:
	PUSH	PSW
	LHLD	STCKBASE
	XCHG
	LHLD	STRGFREE
	CMA
	MOV	C,A
	MVI	B,0FFH
	DAD	B
	INX	H
	CALL	CMHLLTDE
	JC	STRGALGC
	SHLD	STRGFREE
	INX	H
	XCHG			;RETURNS:  DE=STRING ADDRESS
POPAFRET:
	POP	PSW
	RET

STRGALGC:
	POP	PSW		;COLLECT GARBAGE IN STRING SPACE
	MVI	E,ERRNOS-ERRN
	JZ	ERRMSG
	CMP	A
	PUSH	PSW
	LXI	B,STRGALAG	;THEN TRY ALLOCATION
	PUSH	B
;
;  COLLECT GARBAGE IN STRING SPACE
;
STRGGBCL:
	LHLD	STRGBASE	;MAKE ALL STRINGS UNSAFE
STRGGBLP:
	SHLD	STRGFREE	;FIND HIGHEST UNSAFE STRING
	LXI	H,0
	PUSH	H
	LHLD	STCKBASE
	PUSH	H
	LHLD	STRGBASE	;SCAN TEMPORARIES,
	INX	H
STRGGBTL:
	XCHG
	LHLD	STRGTMPP
	XCHG
	CALL	CMHLLTDE
	LXI	B,STRGGBTL
	JNZ	STRGGBHI
	LHLD	VARTABLE	;SCAN REGULAR VARIABLES,
STRGGBVR:
	XCHG
	LHLD	MATTABLE
	XCHG
	CALL	CMHLLTDE
	JZ	STRGGNAV
	MOV	A,M
	INX	H
	ANI	00FH
	SUI	TYPESTRG
	MOV	E,A
	SBB	A
	MOV	D,A
	MOV	A,M
	INX	H
	ANI	080H		;DEFINITIONS ARE STRINGS
	DAD	D
	ORA	E
	CALL	STRGGBHV
	JMP	STRGGBVR

STRGGBAL:
	POP	B
STRGGNAV:
	XCHG			;SCAN ARRAY VARIABLES
	LHLD	FREELIMT
	XCHG
	CALL	CMHLLTDE
	JZ	STRGGBMV
	CALL	LDRGMM
	MOV	A,E
	PUSH	H
	DAD	B
	ANI	00FH
	CPI	TYPESTRG
	JNZ	STRGGBAL
	SHLD	SCANPTR1
	POP	H
	MOV	C,M
	MVI	B,000H
	DAD	B
	DAD	B
	INX	H
STRGGBAS:
	XCHG			;LOOK THROUGH ENTIRE ARRAY
	LHLD	SCANPTR1
	XCHG
	CALL	CMHLLTDE
	JZ	STRGGNAV
	LXI	B,STRGGBAS
STRGGBHI:
	PUSH	B		;COMPARE THIS STRING ADDR TO MAX
	XRA	A
STRGGBHV:
	MOV	C,M		;LOAD STRING DESCRIPTOR
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	RNZ			;NOT A STRING VARIABLE
	MOV	A,C
	ORA	A		;CHECK FOR ZERO LENGTH
	RZ
	MOV	B,H		;ALREADY SAFE?
	MOV	C,L
	LHLD	STRGFREE
	CALL	CMHLLTDE
	MOV	H,B
	MOV	L,C
	RC
	POP	H		;COMPARE WITH HIGHEST UNSAFE
	XTHL
	CALL	CMHLLTDE
	XTHL
	PUSH	H
	MOV	H,B
	MOV	L,C
	RNC
	POP	B		;SAVE NEW HIGHEST UNSAFE ADDR
	POP	PSW
	POP	PSW
	PUSH	H
	PUSH	D
	PUSH	B
	RET
STRGGBMV:
	POP	D		;MAKE HIGHEST UNSAFE SAFE
	POP	H
	MOV	A,L
	ORA	H
	RZ			;ANY UNSAFE?
	DCX	H		;LOAD DESCRIPTOR
	MOV	B,M
	DCX	H
	MOV	C,M
	PUSH	H
	DCX	H
	MOV	L,M		;FIND END OF STRING
	MVI	H,000H
	DAD	B
	MOV	D,B
	MOV	E,C
	DCX	H
	MOV	B,H
	MOV	C,L
	LHLD	STRGFREE	;COPY IT TO END OF SAFE AREA
	CALL	COPYTEXT
	POP	H
	MOV	M,C
	INX	H
	MOV	M,B
	MOV	H,B
	MOV	L,C
	DCX	H
	JMP	STRGGBLP	;EXTEND SAFE AREA

;
;  VARIOUS NUMERIC/STRING CONVERSION FUNCTIONS
;

;
;  FIND LENGTH OF STRING
;
LENFCT:
	LXI	B,FLOATA	;LEN FUNCTION
	PUSH	B
LENFCTC:
	CALL	CSTRING
	CALL	STRGRELA
	MVI	A,TYPESING
	STA	TYPEFLG
	MOV	A,M
	ORA	A
	INX	H
	RET

;
;  CONVERT CHARACTER TO BYTE
;
ASCFCT:
	CALL	LENFCTC		;ASC FUNCTION
	JZ	ERRAFC
	MOV	C,M		;FETCH ADDRESS
	INX	H
	MOV	B,M
	LDAX	B		;THEN THE FIRST CHARACTER
	JMP	FLOATA

;
;  CONVERT BYTE TO CHARACTER
;
CHRFCT:
	MVI	A,1		;CHR$ FUNCTION
	CALL	STRNGEN
	CALL	CBYTE
	LHLD	STRGTMPA
	MOV	M,E
VALRETST:
	POP	B		;STRING FUNCTION, REMOVE CSINGLE
	JMP	STRGALOT
;
;  DECODE NUMBER FROM STRING
;
VALFCT:
	CALL	LENFCTC		;VAL FUNCTION
	JZ	ZEROAC
	MOV	E,A
	MVI	D,0
	MOV	C,M
	INX	H
	MOV	B,M
	PUSH	B
	MOV	H,B
	MOV	L,C
	DAD	D
	MOV	B,M
	MOV	M,D
	XTHL
	PUSH	B
	MOV	A,M
	CALL	DECODE
	POP	B
	POP	H
	MOV	M,B
	RET

;
;  ENCODE NUMBER IN STRING
;
STRFCT:
	CALL	CSINGLE		;STR$ FUNCTION
	CALL	VALSTRGN	;CREATE STRING FROM NUMBER
	CALL	STRGRELA
	LXI	B,VALRETST
	PUSH	B
	XCHG
STRGSTOR:
	XCHG
	MOV	A,M		;STORE STRING INTO STRING SPACE,
	PUSH	H		;LEAVE DESCRIPTOR IN STRGTMP
	CALL	STRGALOC
	POP	H
	CALL	LDICBMM		;LOAD BUFFER ADDRESS
	CALL	STRSTCDS
	PUSH	H
	MOV	L,A
	CALL	COPYSTRG
POPDERET:
	POP	D
	RET
;
;  CONVERT HEX STRING TO NUMBER
;
HXVFCT:
	CALL	LENFCTC		;DO INITIAL PROCESSING
	JZ	ZEROAC
	MOV	E,A
	MOV	C,M
	INX	H
	MOV	B,M
	LXI	H,0		;INITIAL OUTPUT TO ZERO
HXVFCTL:
	LDAX	B		;FETCH CHARACTER
	INX	B
	CPI	':'		;  VERIFY THAT IT'S HEX
	CNC	HXVFCTCH
	JNC	ERRAFC		;IF NOT, COMPLAIN
	SUI	'0'
	JC	ERRAFC		;MUST BE AT LEAST ZERO
	DAD	H
	DAD	H		;INCORPORATE NEW DIGIT
	DAD	H
	DAD	H
	ORA	L
	MOV	L,A
	DCR	E		;COUNT DIGITS
	JNZ	HXVFCTL
FLOATHL:
	MOV	A,H		;CONVERT INTEGER IN HL TO FLOAT
	MOV	B,L
	JMP	FLOATAB

HXVFCTCH:
	CALL	ALPHACHA	;CONVERT ANY ALPHA TO UPPER
	RNC
	SUI	'A'-'9'-1	;MOVE ALPHA TO AFTER DIGITS
	CPI	'0'+16		;SET FLAGS CORRECTLY
	RET
;
;  CONVERT BYTE TO TWO HEX CHARACTERS
;
HEXFCT:
	MVI	A,2		;ALLOCATE OUTPUT STRING
	CALL	STRNGEN
	LDA	FLACCEXP
	CALL	FIXAC		;GET INPUT BYTE
	LXI	H,VALRETST
	PUSH	H
	LHLD	STRGTMPA
	CALL	HEXFCTL
HEXFCTL:
	MOV	A,E		;CONVERT ONE DIGIT
	RLC
	RLC
	RLC
	RLC
	MOV	E,A
	ANI	00FH
	CPI	10
	CMC			;COVERT TO CHARACTER FORM
	ACI	'0'
	DAA
	MOV	M,A
	INX	H
	RET

;
;  TRANSLATE STRING TO UPPER CASE
;
UPRFCT:
	CALL	CSTRING
	LHLD	ACCUMLTR	;GET LENGTH OF OPERAND
	PUSH	H
	MOV	A,M
	CALL	STRNGEN		;ALLOCATE OUTPUT STRING
	POP	D
	CALL	STRGRELD	;RELEASE INPUT STRING
	CALL	LDDCBMM
	LHLD	STRGTMPA
	INR	D
UPRFCTL:
	DCR	D		;TRANSLATE WHILE COPYING
	JZ	VALRETST	;DONE
	LDAX	B
	CALL	ALPHACHA	;CONVER LOWER TO UPPER
	MOV	M,A
	INX	B
	INX	H
	JMP	UPRFCTL
;
;  SUBSTRING FUNCTIONS
;
LFTFCT:
	CALL	LEFRIGAR	;LEFT$ FUNCTION
	XRA	A		;LEFT(X,N)=MID(X,1,N)
LEFRIGMR:
	XTHL
	MOV	C,A		;C=START-1, B=LEN
LEFRIGMD:
	PUSH	H		;RESOLVE DESIRED LEN WITH STRING
	MOV	A,M
	CMP	B
	JC	LEFRIGMC
	MOV	A,B
	JMP	LEFRIGMB

LEFRIGAR:
	XCHG			;INITIAL COMMON PROCESSING
	CALL	VALBYTE2	;FOR LEFT$, RIGHT$
	MOV	B,E
	CALL	SCANNXTV	;bscan (val)
	DB	')'
	RET

LEFRIGMC:
	MVI	C,0
LEFRIGMB:
	PUSH	B
	CALL	STRGALOC	;ALLOCATE ANSWER STRING
	POP	B
	POP	H
	PUSH	H
	INX	H
	MOV	B,M		;COMPUTE ADDRESSES FOR COPY
	INX	H
	MOV	H,M
	MOV	L,B		;(from HL,MB)
	MVI	B,0
	DAD	B
	MOV	B,H
	MOV	C,L
	CALL	STRSTCDS
	MOV	L,A
	CALL	COPYSTRG	;COPY
	POP	D
	CALL	STRGRELD
	JMP	STRGALOT
RIGFCT:
	CALL	LEFRIGAR	;RIGHT$ FUNCTION
	POP	D
	PUSH	D
	LDAX	D
	SUB	B		;RIGHT(X,N)=MID(X,LEN(X)-N+1,N)
	JMP	LEFRIGMR

MIDFCT:
	XCHG			;MID$ FUNCTION
	CALL	VALBYTE2	;SCAN STARTING POSITION
	MOV	B,E
	ORA	A		;NON-ZERO STARTING POSITION?
	JZ	ERRAFC
	PUSH	B
	MVI	E,0FFH
	MOV	A,M
	CPI	')'
	CNZ	VALBYTE2	;SCAN OPTIONAL THIRD ARGUMENT
	CALL	SCANNXTV	;bscan (val)
	DB	')'
	POP	PSW		;COMPUTE STARTING BYTE AND LENGTH
	XTHL
	LXI	B,LEFRIGMD
	PUSH	B
	DCR	A
	CMP	M
	MVI	B,0		;START > LENI => LENO=0
	RNC
	MOV	C,A
	MOV	A,M
	SUB	C
	CMP	E
	MOV	B,A
	RC			;LEN0 = MIN(LENI-START,LENR)
	MOV	B,E
	RET
;
;  INDEX OF STRING FUNCTION
;
INSFCT:
	XCHG	
	CALL	SCANNXTV	;bscan (val)
	DB	','
	CALL	VALPARN2	;SCAN SECOND ARGUMENT
	XTHL			;SHUFFLE RETURN STACK
	LXI	B,POPHLRET
	PUSH	B
	PUSH	H
	CALL	LENFCTC		;PROCESS  SECOND STRING
	XTHL
	PUSH	PSW
	JZ	INSFCTXT
	CALL	STRGRELH	;WORK ON FIRST STRING
	MOV	A,M
	POP	B
	POP	D
	SUB	B		;COMPARE LENGTHS
	JC	ZEROAC		;TEST IS LONGER, NO MATCHES
	INR	A
	MOV	C,A		;SAVE NUMBER OF ATTEMPTS
	PUSH	B
	CALL	LDICBMM		;GET ADDRESS OF TARGET
	XCHG
	MOV	E,M		;GET ADDRESS OF MATCHER
	INX	H
	MOV	D,M
	XCHG
	POP	D		;RECOVER LENGTH, COUNTER
	MVI	A,1
INSFCTSL:
	PUSH	D		;SAVE LENGTH, COUNTER
	PUSH	PSW		;SAVE POSITION
	PUSH	B		;SAVE ADDRESSES
	PUSH	H
	MOV	E,D
	CALL	RELOPRSL	;COMPARE STRINGS
	POP	H		;RECOVER ADDRESSES
	POP	B
INSFCTXT:
	POP	D
	MOV	A,D		;RECOVER POSITION
	POP	D		;AND LENGTH, COUNTER
	JZ	FLOATA		;ANSWER FOUND, GIVE IT BACK
	INR	A		;INCREMENT POSITION
	INX	B
	DCR	E		;COUNT ATTEMPTS
	JNZ	INSFCTSL	;KEEP TRYING
	JMP	ZEROAC		;OR NOMATCH
;
;  FUNCTION RETURNING AMOUNT OF REMAINING FREE SPACE
;
FREFCT:
	LHLD	MATTABLE	;FRE FUNCTION
	XCHG
	LXI	H,0
	DAD	SP
	CALL	TYPECHK
	JNZ	FREFCTNS
	CALL	STRGRELA	;RETURN BYTES OF FREE STRNG SPACE
	CALL	STRGGBCL
	LHLD	STCKBASE
	XCHG
	LHLD	STRGFREE
FREFCTNS:
	MOV	A,L
	SUB	E
	MOV	B,A
	MOV	A,H
	SBB	D
FLOATAB:
	MOV	D,B
	MVI	E,000H
	LXI	H,TYPEFLG
	MVI	M,TYPESING
	MVI	B,090H
	JMP	FLOATINT

;
;  MEMORY DIDDLING FACILITIES
;
MEMFCT:
	CALL	TYPECHK		;MEM FUNCTION
	JZ	MEMFCTC
	CALL	CINTEGER
	LDAX	D
	JMP	FLOATA
MEMFCTC:
	CALL	LENFCTC		;RELEASE ARGUMENT
	LHLD	PROGBASE
	JZ	FLOATHL		;ZERO LENGTH STRING=PROGBASE
	LHLD	STRGTLIM
	JMP	FLOATHL		;OTHERWISE=UPPER LIMIT

MEMSTM:
	CALL	SCANNXT		;bscan +  ;MEM STATEMENT
	CALL	VALPARNS
	CALL	CINTEGER
	PUSH	D
	CALL	SCANNXTV	;bscan (val)
	DB	KEYEQ
	CALL	VALBYTE
	POP	D
	STAX	D
	RET
;
;  DIRECT I/O FACILITIES
;
PORFCT:
	CALL	CBYTE		;PORT FUNCTION
	MVI	D,OPCINP
	CALL	INOTGEN
	CALL	INOTINS
	JMP	FLOATA

PORSTM:
	CALL	SCANNXT		;bscan +  ;PORT STATEMENT
	CALL	VALPARNS
	CALL	CBYTE
	PUSH	D
	CALL 	SCANNXTV	;bscan (val)
	DB	KEYEQ
	CALL	VALBYTE
	POP	D
	MVI	D,OPCOUT
	CALL	INOTGEN
	JMP	INOTINS

WAISTM:
	CALL	VALBYTE		;WAIT STATEMENT
	PUSH	D
	CALL	VALBYTE2
	PUSH	PSW
	MVI	E,0
	CNZ	VALBYTE2
	POP	B
	MOV	C,E
	POP	D
	MVI	D,OPCINP
	CALL	INOTGEN
WAISTMIN:
	CALL	SYSWAIT		;DO A SYSTEM WAIT
	CALL	INOTINS		;THEN CHECK DEVICE
	XRA	C
	ANA	B
	JZ	WAISTMIN
	RET

INOTGEN:
	PUSH	H		;GENERATE INPUT/OUTPUT FOLLOWED
	LXI	H,INOTINS	;BY RETURN
	MOV	M,D
	INX	H
	MOV	M,E
	INX	H
	MVI	M,OPCRET
	POP	H
	RET
;
;  CSAVE/CLOAD ROCESSORS
;    save filename - save on diskette
;    load filename - get from diskette
;
;  load and save programs from the disk
;
d14base	equ	0b400h
fsprom	equ	0b000h
bootstart  equ	fsprom+39bh	;load image files
directorylookup  equ  d14base+4e0h  ;find filename
opens	equ	d14base+396h	;open stream
puts	equ	d14base+3dch	;put char
closes	equ	d14base+42dh	;close stream
;
cldstm:
	call	setfilename	;parse filename
	call	directorylookup
	jnc	namenotfound
	call	bootstart
	call	checkprogram
	call	newload		;reset program pointers
	jmp	cmndstrt
namenotfound:
	mvi	e,errnfi-errn	;file not saved
	jmp	errmsg


csvstm:
	call	setfilename
	mvi	b,2		;write enable
	call	opens		;open stream (only one in D14)
	jnc	cannotopen	; -disk full or other bad stuff
	call	checkprogram
	push	h		;save end pointer
	lhld	progbase	;first address
	mov	c,l
	call	puts
	mov	c,h
	call	puts
	mvi	c,0		;start address = 0 for no start
	call	puts
	call	puts
	pop	d		;de has end address=1
saveloop:
	mov	c,m		;get char
	inx	h
	call	puts		;and send t file
	mov	a,h		;is this the end?
	cmp	d
	jnz	saveloop
	mov	a,l
	cmp	e
	jnz	saveloop
	call	closes		;yes
	jmp	cmndstrt
cannotopen:
	mvi	e,errnsl-errn
	jmp	errmsg

;
;  setfilename
;    returns hl set to a filename string
;
setfilename:
	lxi	d,filename+1
	mvi	b,0
sfnloop:
	mov	a,m		;look at char
	cpi	0
	jz	sfndone
	cpi	' '
	jz	sfndone
	inr	b		;up count
	inx	h
	stax	d
	inx	d
	jmp	sfnloop
sfndone:
	lxi	h,filename
	xra	a		;is the name non zero
	ora	b
	jz	errasn		;yes
	mov	m,a		;store count
	ret

;
;  checkprogram
;    walk over the program looking for the end
;    return last byte+1 in hl
;
checkprogram:
	lhld	progbase	;starts here
cprogloop:
	mov	a,m		;pick up line length
	inx	h
	ora	m
	inx	h
	jz	cprogok		;if zero then all done
	inx	h
	inx	h		;skip line number
cprogloop2:
	mov	a,m
	ora	a
	inx	h
	jz	cprogloop	;zero at the end of the line
	jmp	cprogloop2
cprogok:
	ret
filename:  ds	60

;
;  LOGICAL OPERATORS
;
ORNOPR:
	ORA	A		;OR OPERATOR
	JMP	LOGOPRIC
ANDOPR:
	XRA	A		;AND OPERATOR
LOGOPRIC:
	PUSH	PSW
	CALL	CSINGLE
	CALL	CINTEGER
	POP	PSW
	XCHG
	POP	B
	XTHL
	XCHG
	CALL	LDACRG
	PUSH	PSW
	CALL	CINTEGER
	POP	PSW
	POP	B
	MOV	A,C
	JNZ	ORNOPRFN
	ANA	E
	MOV	C,A
	MOV	A,B
	ANA	D
	JMP	LOGOPRXT	;RETURN FROM AND

ORNOPRFN:
	ORA	E
	MOV	C,A
	MOV	A,B 
	ORA	D
LOGOPRXT:
	MOV	B,C
	JMP	FLOATAB		;RETURN FROM OR

VALUNOT:
	MVI	D,PREDNOT	;EVALUATE UNARY NOT
	CALL	VALEXPRL
	CALL	CSINGLE
	CALL	CINTEGER
	MOV	A,E
	CMA
	MOV	C,A
	MOV	A,D
	CMA
	CALL	LOGOPRXT
	POP	B
	JMP	VALEXPRC
;
;  MOD, MAXIMUM, MINIMUM OPERATORS
;
MODOPR:
	POP	B		;MODULO FUNCTION
	POP	D		;X MOD Y =
	PUSH	D		;X - INT(X/Y) * Y
	PUSH	B
	LHLD	ACCUMLTR
	PUSH	H
	LHLD	FLACCMSB
	PUSH	H
	CALL	FLDIV
	CALL	INTFCT
	POP	B
	POP	D
	CALL	FLMUL
	JMP	SUBOPR

MAXOPR:
	POP	B
	POP	D
	CALL	FLCMP		;COMPARE OPERANDS
	RZ			;NO DIFFERENCE
	JC	LDACRG		;REGISTERS LARGER
	JMP	LDRGAC		;ACUMULATOR LARGER

MINOPR:
	POP	B
	POP	D
	CALL	FLCMP		;COMPARE OPERANDS
	RZ			;NO DIFFERENCE
	JNC	LDACRG		;REGISTERS SMALLER
	JMP	LDRGAC		;ACCUMULATOR SMALLER
;
;  FLOATING POINT ADD/SUBTRACT ROUTINES
;
FLADDHLF:
	LXI	H,FLHALF
FLADDM:
	CALL	LDRGMM
	JMP	FLADD

FLMMMAC:
	CALL	LDRGMM		;COMPUTE MM-AC
	JMP	FLSUB

SUBOPR:
	POP	B
	POP	D
FLSUB:
	CALL	CMACCS		;SUBTRACT ACC FROM REGISTERS
FLADD:
	MOV	A,B		;ADD ACCUMULATOR TO REGISTERS
	ORA	A
	RZ
	LDA	FLACCEXP
	ORA	A
	JZ	LDACRG
	SUB	B
	JNC	FLADDMGC
	CMA			;NEED LARGER IN AC, INTERCHANGE
	INR	A
	XCHG
	CALL	PUSHAC
	XCHG
	CALL	LDACRG
	POP	B
	POP	D
FLADDMGC:
	CPI	019H		;ARE MAGNITUDES ARE COMMENSURATE?
	RNC
	PUSH	PSW
	CALL	SIGNIFY
	MOV	H,A
	POP	PSW
	CALL	SHIFTR0
	ORA	H
	LXI	H,ACCUMLTR
	JP	FLADDIFF
	CALL	ADDM2CDE
	JNC	FLROUND
	INX	H
	INR	M
	JZ	ERRAOV
	MVI	L,001H
	CALL	SHIFTRLB
	JMP	FLROUND
FLADDIFF:
	XRA	A		;FIND DIFFERENCE
	SUB	B
	MOV	B,A
	MOV	A,M
	SBB	E
	MOV	E,A
	INX	H
	MOV	A,M
	SBB	D
	MOV	D,A
	INX	H
	MOV	A,M
	SBB	C
	MOV	C,A
NORMALZI:
	CC	CMREGS
NORMALIZ:
	MOV	L,B		;NORMALIZE REGISTERS
	MOV	H,E
	XRA	A
NORMAL8:
	MOV	B,A		;NORMALIZE BY BYTES
	MOV	A,C
	ORA	A
	JNZ	NORMAL1
	MOV	C,D
	MOV	D,H
	MOV	H,L
	MOV	L,A
	MOV	A,B
	SUI	008H
	CPI	0E0H
	JNZ	NORMAL8
ZEROAC:
	XRA	A		;ZERO ACCUMULATOR
LDACCE:
	STA	FLACCEXP
	RET

NORMAL1L:
	DCR	B		;NORMALIZE BY BITS
	DAD	H
	MOV	A,D
	RAL
	MOV	D,A
	MOV	A,C
	ADC	A
	MOV	C,A
NORMAL1:
	JP	NORMAL1L
	MOV	A,B
	MOV	E,H
	MOV	B,L
	ORA	A
	JZ	FLROUND
	LXI	H,FLACCEXP
	ADD	M
	MOV	M,A
	JNC	ZEROAC
	RZ
FLROUND:
	MOV	A,B		;ROUND RESULT
FLROUNDV:
	LXI	H,FLACCEXP
	ORA	A
	CM	INCCDE
	MOV	B,M
	INX	H
	MOV	A,M
	ANI	080H
	XRA	C
	MOV	C,A
	JMP	LDACRG

INCCDE:
	INR	E		;INCREMENT CDE
	RNZ
	INR	D
	RNZ
	INR	C
	RNZ
	MVI	C,080H
	INR	M
	RNZ
ERRAOV:
	MVI	E,ERRNOV-ERRN
	JMP	ERRMSG

ADDM2CDE:
	MOV	A,M		;ADD MEMORY TO CDE
	ADD	E
	MOV	E,A
	INX	H
	MOV	A,M
	ADC	D
	MOV	D,A
	INX	H
	MOV	A,M
	ADC	C
	MOV	C,A
	RET
CMREGS:
	LXI	H,FLACCSSV	;COMPLEMENT SAVED SIGN, CDEB
	MOV	A,M
	CMA
	MOV	M,A
	XRA	A
	MOV	L,A
	SUB	B
	MOV	B,A
	MOV	A,L
	SBB	E
	MOV	E,A
	MOV	A,L
	SBB	D
	MOV	D,A
	MOV	A,L
	SBB	C
	MOV	C,A
	RET

SHIFTR0:
	MVI	B,000H
SHIFTR:
	SUI	008H		;SHIFT CDEB RIGHT BY A BITS
	JC	SHIFTRB
	MOV	B,E
	MOV	E,D
	MOV	D,C
	MVI	C,000H
	JMP	SHIFTR
SHIFTRB:
	ADI	009H
	MOV	L,A
SHIFTRBL:
	XRA	A
	DCR	L
	RZ
	MOV	A,C
SHIFTRLB:
	RAR
	MOV	C,A
	MOV	A,D
	RAR
	MOV	D,A
	MOV	A,E
	RAR
	MOV	E,A
	MOV	A,B
	RAR
	MOV	B,A
	JMP	SHIFTRBL
;
;  FLOATING POINT MULTIPLY ROUTINE
;
MULOPR:
	POP	B
	POP	D
FLMUL:
	CALL	SIGNACC		;MULTIPLY REGISTERS BY ACC
	RZ
	MVI	L,000H
	CALL	FLMLDVEX
	MOV	A,C
	STA	FLSCR0
	XCHG
	SHLD	FLSCR1
	LXI	B,0
	MOV	D,B
	MOV	E,C
	LXI	H,NORMALIZ	;NORMALIZE ANSWER AFTER
	PUSH	H
	LXI	H,FLMULLP	;THREE TIMES THROUGH LOOP
	PUSH	H
	PUSH	H
	LXI	H,ACCUMLTR
FLMULLP:
	MOV	A,M
	INX	H
	ORA	A
	JZ	FLMULXT
	PUSH	H
	MVI	L,008H
FLMULLQ:
	RAR			;NEXT BIT OF MULTIPLIER
	MOV	H,A
	MOV	A,C
	JNC	FLMULNA
	PUSH	H
	LHLD	FLSCR1		;BIT ON, ADD MULTIPLICAND
	DAD	D
	XCHG
	POP	H
	LDA	FLSCR0
	ADC	C
FLMULNA:
	RAR			;SHIFT CDEB RIGHT ONE BIT
	MOV	C,A
	MOV	A,D
	RAR
	MOV	D,A
	MOV	A,E
	RAR
	MOV	E,A
	MOV	A,B
	RAR
	MOV	B,A
	DCR	L
	MOV	A,H
	JNZ	FLMULLQ
	POP	H
	RET

FLMULXT:
	MOV	B,E
	MOV	E,D
	MOV	D,C
	MOV	C,A
	RET

FLMLDVEX:
	MOV	A,B		;COMPUTE EXP FOR MULTIPLY/DIVIDE
	ORA	A
	JZ	FLMLDVEZ
	MOV	A,L
	LXI	H,FLACCEXP
	XRA	M
	ADD	B
	MOV	B,A
	RAR
	XRA	B
	MOV	A,B
	JP	FLMLDVEY
	ADI	080H
	MOV	M,A
	JZ	POPHLRET
	CALL	SIGNIFY
	MOV	M,A
	DCX	H
	RET

EXPRNEXC:
	CALL	SIGNACC		;RANGE EXECEEDED FOR EXP FUNCTION
	CMA			;RESULT DETERMINED BY SGN(X)
	POP	H
FLMLDVEY:
	ORA	A
FLMLDVEZ:
	POP	H
	JP	ZEROAC
	JMP	ERRAOV
;
;  FLOATING POINT DIVIDE ROUTINE
;
FLDIVB10:
	CALL	PUSHAC		;COMPUTE AC/10
	LXI	B,08420H
	LXI	D,00000H
	CALL	LDACRG
DIVOPR:
	POP	B
	POP	D
FLDIV:
	CALL	SIGNACC		;DIVIDE REGISTERS BY ACCUMULATOR
	JZ	ERRAD0
	MVI	L,0FFH
	CALL	FLMLDVEX
	INR	M
	INR	M		;plus 2
	DCX	H
	MOV	A,M
	CMA
	STA	FLSCR2
	DCX	H
	MOV	A,M
	CMA
	STA	FLSCR1
	DCX	H
	MOV	A,M
	CMA
	STA	FLSCR0
	MOV	B,C
	XCHG
	XRA	A
	MOV	C,A
	MOV	D,A
	MOV	E,A
	STA	FLSCR3
FLDIVLP:
	PUSH	H
	PUSH	B
	STC
	LDA	FLSCR0
	ADC	L
	MOV	L,A
	LDA	FLSCR1
	ADC	H
	MOV	H,A
	LDA	FLSCR2
	ADC	B
	MOV	B,A
	LDA	FLSCR3
	ACI	0FFH
	JNC	FLDIVSF
	STA	FLSCR3
	POP	PSW		;TRIAL SUBRACT SUCCEEDED,
	POP	PSW		;THROW AWAY SAVED DIVIDEND
	STC
	JMP	FLDIVSS
FLDIVSF:
	POP	B		;TRIAL SUBTRACT FAILED, RESTORE
	POP	H
FLDIVSS:
	MOV	A,C
	INR	A
	DCR	A
	RAR
	JM	FLROUNDV
	RAL
	MOV	A,E
	RAL
	MOV	E,A
	MOV	A,D
	RAL
	MOV	D,A
	MOV	A,C
	RAL
	MOV	C,A
	DAD	H
	MOV	A,B
	RAL
	MOV	B,A
	LDA	FLSCR3
	RAL
	STA	FLSCR3
	MOV	A,C
	ORA	D
	ORA	E
	JNZ	FLDIVLP
	PUSH	H
	LXI	H,FLACCEXP
	DCR	M
	POP	H
	JNZ	FLDIVLP	
	JMP	ERRAOV

ERRAD0:
	MVI	E,ERRND0-ERRN
	JMP	ERRMSG

;
;  MISCELLANEOUS AUXILIARY ROUTINES
;

;
;  CPY ACCUMULATOR TO STACK
;
PUSHAC:
	XCHG			;PUSH ACCUMULATOR ONTO STACK
PUSHAC1:
	LHLD	ACCUMLTR
	XTHL
	PUSH	H
	LHLD	FLACCMSB
	XTHL
	PUSH	H
	XCHG
	RET

;
;  LOAD ACCUMULATOR
;
LDRGACMM:
	CALL	LDRGMM		;LOAD FLOATING ACC AND REGISTERS
LDACRG:
	XCHG			;LOAD ACCUMULATOR FROM REGISTERS
	SHLD	ACCUMLTR
	MOV	H,B
	MOV	L,C
	SHLD	FLACCMSB
	XCHG
	RET

;
;  LOAD REGISTERS
;
LDRGAC:
	LXI	H,ACCUMLTR	;LOAD REGISTERS FROM ACCUMULATOR
LDRGMM:
	MOV	E,M		;LOAD REGISTERS FROM FLOAT NUMBER
	INX	H
LDDCBMM:
	MOV	D,M		;LOAD REGISTERS FROM STRING
LDICBMM:
	INX	H
	MOV	C,M
	INX	H
	MOV	B,M
INCHLRET:
	INX	H
	RET
;
;  STORE ACCUMULATOR / COPY A VALUE
;
LDMMAC:
	LXI	D,ACCUMLTR	;LOAD MEMORY FROM ACCUMULATOR
COPYVAL:
	LDA	TYPEFLG		;COPY VALUE FROM (DE) TO (HL)
	MOV	B,A
COPYVALL:
	LDAX	D
	MOV	M,A
	INX	D
	INX	H
	DCR	B
	JNZ	COPYVALL
	RET

;
;  TURN ON HIGH ORDER MANTISSA BITS OF ACCUMULATOR/REGISTERS
;
SIGNIFY:
	LXI	H,FLACCMSB	;SET ON HIGH-ORDER MANTISSA BITS,
	MOV	A,M		;AND SAVE SIGN IN FLACCSSV
	RLC
	STC
	RAR
	MOV	M,A		;FIRST ACCUMULATOR,
	CMC
	RAR
	INX	H
	INX	H
	MOV	M,A
	MOV	A,C
	RLC
	STC
	RAR
	MOV	C,A		;THEN REGISTERS
	RAR
	XRA	M
	RET
;
;  FLOATING POINT COMPARISON:  REGISTERS VS ACCUMULATOR
;
FLCMP:
	MOV	A,B		;FLOATING COMPARE REGS TO ACC
	ORA	A
	JZ	SIGNACC
	LXI	H,FLCMPXT
	PUSH	H
	CALL	SIGNACC
	MOV	A,C
	RZ
	LXI	H,FLACCMSB
	XRA	M
	MOV	A,C
	RM
	CALL	FLCMPM
	RAR
	XRA	C
	RET

FLCMPM:
	INX	H		;COMPARE MANTISSAS
	MOV	A,B
	CMP	M
	RNZ
	DCX	H
	MOV	A,C
	CMP	M
	RNZ
	DCX	H
	MOV	A,D
	CMP	M
	RNZ
	DCX	H
	MOV	A,E
	SUB	M
	RNZ
	POP	H
	POP	H
	RET
;
;  COMPUTER INTEGER PART OF ACCUMULATOR
;
FIXAC:
	MOV	B,A		;LOAD REGS WITH FIX(AC)
	MOV	C,A
	MOV	D,A
	MOV	E,A
	ORA	A
	RZ
	PUSH	H
	CALL	LDRGAC
	CALL	SIGNIFY
	XRA	M
	MOV	H,A
	CM	DECCDE
	MVI	A,098H
	SUB	B
	CALL	SHIFTR0
	MOV	A,H
	RAL
	CC	INCCDE
	MVI	B,000H
	CC	CMREGS
	POP	H
	RET

DECCDE:
	DCX	D		;DECREMENT CDE
	MOV	A,D
	ANA	E
	INR	A
	RNZ
	DCR	C
	RET

FLMULB10:
	CALL	LDRGAC		;MULTIPLY CONTENTS OF AC BY 10
	MOV	A,B
	ORA	A
	RZ
	ADI	002H
	JC	ERRAOV 
	MOV	B,A
	CALL	FLADD		;AC=AC+4*AC
	LXI	H,FLACCEXP
	INR	M		;AC=2*AC
	RNZ
	JMP	ERRAOV

SIGNACC:
	LDA	FLACCEXP	;FIND SIGN OF ACCUMULATOR
	ORA	A
	RZ
	LDA	FLACCMSB
	JMP	SIGNXTND
FLCMPXT:
	CMA
SIGNXTND:
	RAL
CMPXT:
	SBB	A
	RNZ
	INR	A
	RET

CMANSWR:
	LXI	H,CMACCS	;F(X)=-F(0)
	XTHL
	PCHL

SGNFCT:
	CALL	SIGNACC
FLOATBYT:
	MVI	B,088H
	LXI	D,0
FLOATINT:
	LXI	H,FLACCEXP	;CONVERT INTEGER IN ADE TO FLOAT,
	MOV	C,A
	MOV	M,B		;EXPONENT ASSUMED IN B
	MVI	B,000H
	INX	H
	MVI	M,080H
	RAL
	JMP	NORMALZI

;
;  COMPUTE ABSOLUTE VALUE OF ACCUMULATOR
;
ABSFCT:
	CALL	SIGNACC		;ABS FUNCTION
	RP
CMACCS:
	LXI	H,FLACCMSB	;CHANGE SIGN OF ACCUMULATOR
	MOV	A,M
	XRI	080H
	MOV	M,A
	RET

INTFCT:
	LXI	H,FLACCEXP	;INT FUNCTION
	MOV	A,M
	CPI	098H
	LDA	ACCUMLTR
	RNC
	MOV	A,M
	CALL	FIXAC
	MVI	M,098H
	MOV	A,E
	PUSH	PSW
	MOV	A,C
	RAL
	CALL	NORMALZI
	POP	PSW
	RET
;
;  FLOATING POINT DECODE ROUTINE
;
DECODE:
	CPI	'-'		;DECODE EXTERNAL FORM OF NUMBER
	PUSH	PSW
	JZ	DECODEIN
	CPI	'+'
	JZ	DECODEIN
	DCX	H
DECODEIN:
	CALL	ZEROAC
	MOV	B,A
	MOV	D,A
	MOV	E,A
	CMA
	MOV	C,A
DECODELP:
	CALL	SCANNXT		;bscan ,
	JC	DECDIGIT
	CPI	'.'
	JZ	DECODEPT
	CPI	'E'		;UPPER CASE E
	JZ	DECODEXP
	CPI	'e'		;LOWER CASE E
	JNZ	DECODVAL
DECODEXP:
	CALL	SCANNXT		;bscan ,
	PUSH	H
	LXI	H,DECODEXL
	XTHL
	DCR	D
	CPI	KEYSUB
	RZ
	CPI	'-'
	RZ
	INR	D
	CPI	'+'
	RZ
	CPI	KEYADD
	RZ
	POP	PSW
	DCX	H
DECODEXL:
	CALL	SCANNXT		;bscan ,  ;SCAN EXPONENT
	JNC	DECODEXQ
	MOV	A,E		;DECODE EXPONENT DIGIT
	RLC			;E=10*E+VAL(M)
	RLC
	ADD	E
	RLC
	ADD	M
	SUI	'0'
	MOV	E,A
	JMP	DECODEXL
DECODEXQ:
	INR	D
	JNZ	DECODVAL
	XRA	A
	SUB	E
	MOV	E,A
	INR	C
DECODEPT:
	INR	C		;DECODE DECIMAL POINT
	JZ	DECODELP
DECODVAL:
	PUSH	H
	MOV	A,E
	SUB	B
DECDEXPA:
	CP	DECMULUP	;COMBINE MANTISSA, EXPONENT
	JP	DECDEXAL
	PUSH	PSW
	CALL	FLDIVB10
	POP	PSW
	INR	A
DECDEXAL:
	JNZ	DECDEXPA
	POP	D
	POP	PSW
	CZ	CMACCS
	XCHG
	RET
DECMULUP:
	RZ
FLMLB10C:
	PUSH	PSW
	CALL	FLMULB10
	POP	PSW
	DCR	A
	RET

DECDIGIT:
	PUSH	D		;DECODE DIGIT OF NUMBER
	MOV	D,A
	MOV	A,B
	ADC	C
	MOV	B,A
	PUSH	B
	PUSH	H
	PUSH	D
	CALL	FLMULB10
	POP	PSW
	SUI	'0'
	CALL	DECDGADD
	POP	H
	POP	B
	POP	D
	JMP	DECODELP

DECDGADD:
	CALL	PUSHAC
	CALL	FLOATBYT
ADDOPR:
	POP	B
	POP	D
	JMP	FLADD
;
;  FLOATING POINT ENCODE ROUTINE
;
ERRMSGIN:
	PUSH	H		;PRINT CUR LINE NUMBER IN ERROR
	LXI	H,MSGIN
	CALL	PRNTMSG
	POP	H
PRINTINT:
	PUSH	H		;PRINT AN INTEGER
	LXI	H,PRNTNUMS
	XTHL
ENCODEHL:
	XCHG			;ENCODE AN INTEGER
	XRA	A
	MVI	B,098H
	CALL	FLOATINT
ENCODE:
	LXI	D,-13		;ENCODE AC IN EXTERNAL FORM
	LHLD	PROGBASE
	DAD	D		;CREATE POINTER TO ENCODE BUFFER
	PUSH	H
	CALL	SIGNACC
	MVI	M,' '
	JP	ENCODFRS
	MVI	M,'-'
ENCODFRS:
	INX	H
	MVI	M,'0'
	JZ	ENCODZXT
	PUSH	H
	CM	CMACCS
	XRA	A
	PUSH	PSW
	CALL	ENCODCMP
ENCODUPL:
	LXI	B,09143H	;FORCE NUMBER TO RANGE
	LXI	D,04FF8H	;10**5 <= AC BY MULTIPLICATION
	CALL	FLCMP
	DCR	A
	JP	ENCODRND
	POP	PSW
	CALL	FLMLB10C
	PUSH	PSW
	JMP	ENCODUPL

ENCODDNL:
	CALL	FLDIVB10	;FORCE NUMBER TO RANGE
	POP	PSW		;AC < 10**6 BY DIVISION
	INR	A
	PUSH	PSW
	CALL	ENCODCMP
ENCODRND:
	CALL	FLADDHLF	;ROUND UP RESULT
	INR A
	CALL	FIXAC
	CALL	LDACRG
	LXI	B,00206H	;D.DDDDD
	POP	PSW
	ADD	C
	JM	ENCDEXPS
	CPI	007H
	JNC	ENCDEXPS
	INR	A
	MOV	B,A
	MVI	A,001H
ENCDEXPS:
	DCR	A
	POP	H
	PUSH	PSW
	LXI	D,ENCDCOEF
ENCODDGL:
	DCR	B
	MVI	M,'.'
	CZ	INCHLRET
	PUSH	B
	PUSH	H
	PUSH	D
	CALL	LDRGAC
	POP	H
	MVI	B,'0'-1		;GENERATE NEXT DIGIT
ENCODSBL:
	INR	B
	MOV	A,E
	SUB	M
	MOV	E,A
	INX	H
	MOV	A,D
	SBB	M
	MOV	D,A
	INX	H
	MOV	A,C
	SBB	M
	MOV	C,A
	DCX	H
	DCX	H
	JNC	ENCODSBL
	CALL	ADDM2CDE
	INX	H
	CALL	LDACRG
	XCHG
	POP	H
	MOV	M,B
	INX	H
	POP	B
	DCR	C
	JNZ	ENCODDGL
	DCR	B
	JZ	ENCODEXP
ENCDRTZR:
	DCX	H		;REMOVE TRAILING ZEROES
	MOV	A,M
	CPI	'0'
	JZ	ENCDRTZR
	CPI	'.'		;REMOVE TRAILING DECIMAL POINT
	CNZ	INCHLRET
ENCODEXP:
	POP	PSW		;ENCODE EXPONENT
	JZ	ENCODEXT
	MVI	M,'E'
	INX	H
	MVI	M,'+'
	JP	ENCDEXPP
	MVI	M,'-'
	CMA
	INR	A
ENCDEXPP:
	MVI	B,'0'-1
ENCDEXPL:
	INR	B
	SUI	10
	JNC	ENCDEXPL
	ADI	'9'+1
	INX	H
	MOV	M,B
ENCODZXT:
	INX	H
	MOV	M,A
	INX	H
ENCODEXT:
	MOV	M,C
	POP	H
	RET

ENCODCMP:
	LXI	B,09474H	;10**6
	LXI	D,023F7H
	CALL	FLCMP
	POP	H
	DCR	A
	JP	ENCODDNL
	PCHL

FLHALF:
	DB	000h, 000h, 000h, 080h	;1/2

ENCDCOEF:
	db	0a0h, 086h, 001h	;10**5
	db	010h, 027h, 000h	;10**4
	db	0e8h, 003h, 000h	;10**3
	db	064h, 000h, 000h	;10**2
	db	00ah, 000h, 000h	;10**1
	db	001h, 000h, 000h	;10**0
;
;  FLOATING POINT LOGARITHM ROUTINE
;
LOGCOEF:
	DB	3
	db	0aah, 056h, 019h, 080h
	db	0f1h, 022h, 076h, 080h
	db	045h, 0aah, 038h, 082h
FLONE:
	db	000h, 000h, 000h, 081h	;1.0
LOGFCT:
	CALL	SIGNACC		;LOG FUNCTION
	DCR	A
	JM	ERRAFC
	LXI	H,FLACCEXP
	MOV	A,M
	LXI	B,08035H
	LXI	D,004F3H
	SUB	B
	PUSH	PSW
	MOV	M,B
	PUSH	D
	PUSH	B
	CALL	FLADD
	POP	B
	POP	D
	INR	B
	CALL	FLDIV
	LXI	H,FLONE
	CALL	FLMMMAC
	LXI	H,LOGCOEF
	CALL	FCTPOLY2
	LXI	B,08080H
	LXI	D,00000H
	CALL	FLADD
	POP	PSW
	CALL	DECDGADD
FLMULLN2:
	LXI	B,08031H	;LN(2)=0.6931472
	LXI	D,07218H
	JMP	FLMUL
;
;  FLOATING POINT SQUARE ROOT/EXPONENTIATION ROUTINE
;
SQRFCT:
	CALL	PUSHAC		;SQR FUNCTION
	LXI	H,FLHALF	;SQR(X)=X**1/2
	CALL	LDRGACMM
EXPOPR:
	POP	B		;X**Y=EXP(LOG(X)*Y)
	POP	D
	CALL	SIGNACC
	JZ	EXPFCT
	MOV	A,B
	ORA	A
	JZ	LDACCE
	PUSH	D
	PUSH	B
	MOV	A,C
	ORI	07FH
	CALL	LDRGAC
	JP	EXPEXPOS
	PUSH	D
	PUSH	B
	CALL	INTFCT
	POP	B
	POP	D
	PUSH	PSW
	CALL	FLCMP
	POP	H
	MOV	A,H
	RAR
EXPEXPOS:
	POP	H
	SHLD	FLACCMSB
	POP	H
	SHLD	ACCUMLTR
	CC	CMANSWR
	CZ	CMACCS
	PUSH	D
	PUSH	B
	CALL	LOGFCT
	POP	B
	POP	D
	CALL	FLMUL
;
;  EXPONENTIAL FUNCTION ROUTINE
;
EXPFCT:
	CALL	PUSHAC		;EXP FUNCTION
	LXI	B,08138H	;LOG(2)E=1.442695
	LXI	D,0AA3BH
	CALL	FLMUL
	LDA	FLACCEXP
	CPI	088H
	JNC	EXPRNEXC
	CALL	INTFCT
	ADI	080H
	ADI	002H
	JC	EXPRNEXC
	PUSH	PSW
	LXI	H,FLONE
	CALL	FLADDM
	CALL	FLMULLN2
	POP	PSW
	POP	B
	POP	D
	PUSH	PSW
	CALL	FLSUB
	CALL	CMACCS
	LXI	H,EXPCOEF
	CALL	FCTPOLY1
	LXI	D,0
	POP	B
	MOV	C,D
	JMP	FLMUL

EXPCOEF:
	DB	8
	db	040h, 02eh, 094h, 074h
	db	070h, 04fh, 02eh, 077h
	db	06eh, 002h, 088h, 07ah
	db	0e6h, 0a0h, 02ah, 07ch
	db	050h, 0aah, 0aah, 07eh
	db	0ffh, 0ffh, 07fh, 07fh
	db	000h, 000h, 080h, 081h
	db	000h, 000h, 000h, 081h
;
;  FLOATING POINT POLYNOMINAL EVALUATORS
;
FCTPOLY2:
	CALL	PUSHAC		;POLYNOMIAL EVALUATOR
	LXI	D,MULOPR	;EVALUATE P(X**2)*X
	PUSH	D
	PUSH	H
	CALL	LDRGAC
	CALL	FLMUL
	POP	H
FCTPOLY1:
	CALL	PUSHAC		;EVALUATE P(X)
	MOV	A,M
	INX	H
	CALL	LDRGACMM
FCTPOLYL:
	POP	B
	POP	D
	DCR	A
	RZ
	PUSH	D
	PUSH	B
	PUSH	PSW
	PUSH	H
	CALL	FLMUL
	POP	H
	CALL	LDRGMM
	PUSH	H
	CALL	FLADD
	POP	H
	POP	PSW
	JMP	FCTPOLYL
;
;  RANDOM NUMBER GENERATOR
;
RNDFCT:
	CALL	SIGNACC		;RND FUNCTION
	JM	RNDFCTUS	;<0 - INITIALIZE SEED
	LXI	H,RNDFCTSD
	CALL	LDRGACMM
	RZ			;=0 - PREVIOUS VALUE
	LXI	B,09835H
	LXI	D,0447AH
	CALL	FLMUL		;>0 - NEXT VALUE
	LXI	B,06828H
	LXI	D,0B146H
	CALL	FLADD
RNDFCTUS:
	CALL	LDRGAC		;CHANGE SEED
	MOV	A,E
	MOV	E,C
	MOV	C,A
	MVI	M,080H
	DCX	H
	MOV	B,M
	MVI	M,080H
	CALL	NORMALIZ
	LXI	H,RNDFCTSD
	JMP	LDMMAC
;
;  FLOATING POINT SINE/COSINE ROUTINES
;
COSFCT:
	LXI	H,PIOVER2	;COS FUNCTION
	CALL	FLADDM
SINFCT:
	CALL	PUSHAC		;SIN FUNCTION
	LXI	B,08349H	;Y=X*2*PI
	LXI	D,00FDBH
	CALL	LDACRG
	POP	B
	POP	D
	CALL	FLDIV
	CALL	PUSHAC		;Y=Y MOD 1
	CALL	INTFCT
	POP	B
	POP	D
	CALL	FLSUB
	LXI	H,FLQUART
	CALL	FLMMMAC
	CALL	SIGNACC
	STC
	JP	SINFCTC
	CALL	FLADDHLF
	CALL	SIGNACC
	ORA	A
SINFCTC:
	PUSH	PSW
	CP	CMACCS
	LXI	H,FLQUART
	CALL	FLADDM
	POP	PSW
	CNC	CMACCS
	LXI	H,COSCOEF
	JMP	FCTPOLY2

PIOVER2:
	db	0dbh, 00fh, 049h, 081h	;PI/2

FLQUART:
	db	000h, 000h, 000h, 07fh	;1/4

COSCOEF:
	DB	5
	db	0bah, 0d7h, 01eh, 086h
	db	064h, 026h, 099h, 087h
	db	058h, 034h, 023h, 087h
	db	0e0h, 05dh, 0a5h, 086h
	db	0dah, 00fh, 049h, 083h
;
;  FLOATING POINT TANGENT/ARCTANGENT ROUTINES
;
TANFCT:
	CALL	PUSHAC		;TAN FUNCTION
	CALL	SINFCT
	POP	B		;TAN(X) = SIN(X)/COS(X)
	POP	H
	CALL	PUSHAC
	XCHG
	CALL	LDACRG
	CALL	COSFCT
	JMP	DIVOPR

ATNFCT:
	CALL	SIGNACC
	CM	CMANSWR
	CM	CMACCS
	LDA	FLACCEXP
	CPI	081H
	JC	ATNFCTC
	LXI	B,08100H
	MOV	D,C
	MOV	E,C
	CALL	FLDIV
	LXI	H,FLMMMAC
	PUSH	H
ATNFCTC:
	LXI	H,ATNCOEF
	CALL	FCTPOLY2
	LXI	H,PIOVER2
	RET

ATNCOEF:
	DB	9
	db	04ah, 0d7h, 03bh, 078h
	db	002h, 06eh, 084h, 07bh
	db	0feh, 0c1h, 02fh, 07ch
	db	074h, 031h, 09ah, 07dh
	db	084h, 03dh, 05ah, 07dh
	db	0c8h, 07fh, 091h, 07eh
	db	0e4h, 0bbh, 04ch, 07eh
	db	06ch, 0aah, 0aah, 07fh
	db	000h, 000h, 000h, 081h
VERSNDAT:
	DB	'02/03/78',0

ENDINTRP:
	DB	0		;END OF INTERPRETER
;
;  INITIALIZATION
;
INITIALZ:
	LXI	H,0FFFFH
	SHLD	CURLINE
	LXI	H,INITSTCK
	SPHL
	SHLD	STCKBASE
	XRA	A
	STA	PRINTFLG
	;CLEAR SCREEN
	CALL	PRNTCRLF
	LXI	H,LIMUPPER	;ADDRESS LAST BYTE
	SHLD	STRGTLIM
	LXI	D,-10*3
	DAD	D
	SHLD	STRGBASE
	SHLD	STRGFREE
	LXI	D,-256
	DAD	D
	JNC	ERRAOM
	PUSH	H
	LXI	H,LIMLOWER	;ADDRESS OF FIRST BYTE
	LXI	D,12
	DAD	D
	MVI	M,000H
	INX	H
	SHLD	PROGBASE
	XTHL
	POP	D
	SPHL
	SHLD	STCKBASE
	LXI	H,-13
	DAD	SP
	SPHL
	XCHG
	CALL	SPACECHK
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	LXI	B,-16
	DAD	B
	CALL	PRNTCRLF
	CALL	PRINTINT
	LXI	H,INITMFRE
	CALL	PRNTMSG
	LXI	H,VERSNDAT
	CALL	PRNTMSG
	CALL	CLEARPGM
	LXI	H,CMNDRSTR
	SHLD	SYSINITJ+1
	PCHL

INITMFRE:
	DB	' BYTES FREE'
	DB	CR,LF,LF
	db	'BASIC, Version of ', 0
INITSTSP:
	DS	30*2+78+79 ;LINESYZE	;INITIALIZE STACK SPACE
INITSTCK:
	DS	20

	END
