;
;MAY 18, 1978    V6.78
;
;8K BASIC INTERPRETER
;FOR THE COMPUCOLOR II
;COPYRIGHT (C) 1976, 1977, 1978
;BY COMPUCOLOR CORP.
;
;PROGRAMMED BY CHARLES A. MUENCH
;
TRICK	EQU	0	;DUMMY OPERAND FOR TRICK CODE
BASORG	EQU	40H	;BASIC START ADDRESS
LINBF	EQU	8046H	;START OF BASIC RAM AREA
SRAM	EQU	8200H	;START OF BASIC DATA AREA
CR	EQU	0DH
LF	EQU	0AH
KEYOT	EQU	33H
CMPDH	EQU	3453H
SUBHD	EQU	3459H
MOVDH	EQU	343BH
MOVHD	EQU	3444H
CMPHD	EQU	344DH
ADHLA	EQU	3518H
ANHD	EQU	351DH
NEGH	EQU	3524H
NOTH	EQU	3525H
ORHD	EQU	352CH
XORHD	EQU	3533H
SHLHD	EQU	353AH
SHRHD	EQU	3544H
MULHD	EQU	3562H
DIVHD	EQU	3581H
SPNOR	EQU	3460H
EMESS	EQU	262DH
WF2	EQU	284FH
RF2	EQU	2883H
CHDLR	EQU	2EFCH
PFSPC	EQU	3077H
OPENX	EQU	2C86H
RESET	EQU	26A5H
WR	EQU	2EF8H
RD	EQU	2EFBH
CLX	EQU	2859H
AESCTB	EQU	0BH
KERDY	EQU	1EH
BASOUT	EQU	33H
ACRTSP	EQU	36H
BEGEX	EQU	38H
FPB	EQU	80F7H
DBFE	EQU	819DH
PUP	EQU	81B7H
THRUFL	EQU	81DEH
KEYFL	EQU	81DFH
BASFL	EQU	81F1H
LOFL	EQU	81F9H
CHAR	EQU	81FEH
READY	EQU	81FFH
;
;STORED STATEMENT FORMAT IS AS FOLLOWS
;
;NEXT RAM ADR, LINE #, LINE WITH TOKEN VAL., 0
;
;TOKEN VALUES SHOWN ON ASCII COMMAND CHART
;
	ORG	BASORG	;START OF BASIC
BASIC:
	CALL	START
	JMP	INITOF
BASTA:
	CALL	START
	LXI	H,MSGRDY
	CALL	PRMSG	;PRINT MESSAGE AT H,L
	JMP	DELINE	;RESTART BASIC
	JMP	INIT	;AUTO INIT BASIC
	JMP	INF23	;INPUT FLAG VECTOR
AUTOX:
	CALL	CLRPTR	;RESET STACK AND VARIABLES
	LXI	H,LINEIN+3 ;PRETEND X470 WAS CALLED
	PUSH	H	;X2FF (AFTER PRINTING READY)
	CALL	AUTOLD	;SETUP INPUT BUFFER
	LHLD	INFLG	;SETUP HL WITH POINTER TO FLAG
	JMP	WAIT2	;LET X470 ROUTINE RETURN TO X2FF+3
;
;TEST FOR HL = DE ?
;
X4A:
	LHLD	STRPTR	;NEXT AVAIL STRING BYTE
	LDA	TRICK	;SKIP 2 INSTRU
	ORG	$-2
ZTSTDE:
	DCX	H
	MVI	M,0
	MVI	A,TRICK	;SKIP 1 INSTRUC
	ORG	$-1
	XCHG
CMPDEHL:
	MOV	A,H
	SUB	D
	RNZ
	MOV	A,L
	SUB	E
	RET
;
;RET BY A JUMP WITH SP=BC=VAL HL POINTS TO
;
ONSTACK:
	XTHL
	SHLD	PJUMP+1
	POP	H
	MOV	C,M
	INX	H
	MOV	B,M
	INX	H
	PUSH	B
	JMP	PJUMP
Y43	EQU	$
;
;EROM TABLES
;
;ADDRESS TABLE
;
FNCTBL:
	DW	SGN	;AC SGN
	DW	INT	;AD INT
	DW	ABS	;AE ABS
	DW	USER1	;AF CALL AREA
	DW	FRE	;B0 FRE
	DW	INP	;B1 INP
	DW	POS	;B2 POS
	DW	SQR	;B3 SQR
	DW	RND	;B4 RND
	DW	LOG	;B5 LOG
	DW	EXP	;B6 EXP
	DW	COS	;B7 COS
	DW	SIN	;B8 SIN
	DW	TAN	;B9 TAN
	DW	ATN	;BA ATN
	DW	PEEK	;BB PEEK
	DW	LEN	;BC LEN
	DW	STR$	;BD STR$
	DW	VAL	;BE VAL
	DW	ASC	;BF ASC
	DW	CHR$	;C0 CHA$
	DW	LEFT$	;C1 LEFT$
	DW	RIGHT$	;C2 RIGHT$
	DW	MID$	;C3 MID$
MTHTBL:
	DB	79H
	DW	FPLUS	;A4   +
	DB	79H
	DW	FMINUS	;A5   -
	DB	7CH
	DW	FMULT	;A6   *
	DB	7CH
	DW	FDIV	;A7   /
	DB	7FH
	DW	FEXP	;A8   ^
	DB	50H
	DW	BOLAND	;A9 AND
	DB	46H
	DW	BOLOR	;AA  OR
;
;ASCII COMMAND TABLE
;
	DB	0FFH	;THIS BYTE DENOTES START OF TABLE
;
ASCTBL:
	DB	'EN','D'+80H
	DB	'FO','R'+80H
	DB	'NEX','T'+80H
	DB	'DAT','A'+80H
	DB	'INPU','T'+80H
	DB	'DI','M'+80H
	DB	'REA','D'+80H
	DB	'FIL','E'+80H
	DB	'GOT','O'+80H
	DB	'RU','N'+80H
	DB	'I','F'+80H
	DB	'RESTOR','E'+80H
	DB	'GOSU','B'+80H
	DB	'RETUR','N'+80H
	DB	'RE','M'+80H
	DB	'GE','T'+80H
	DB	'OU','T'+80H
	DB	'PU','T'+80H
	DB	'PLO','T'+80H
	DB	'SAV','E'+80H
	DB	'LOA','D'+80H
	DB	'POK','E'+80H
	DB	'PRIN','T'+80H
	DB	'LIS','T'+80H
	DB	'CON','T'+80H
	DB	'CLEA','R'+80H
	DB	'DE','F'+80H
	DB	'WAI','T'+80H
	DB	'O','N'+80H
	DB	'TAB','('+80H
	DB	'T','O'+80H
	DB	'F','N'+80H
	DB	'SPC','('+80H
	DB	'THE','N'+80H
	DB	'NO','T'+80H
	DB	'STE','P'+80H
	DB	'+'+80H,'-'+80H
	DB	'*'+80H,'/'+80H
	DB	'^'+80H
	DB	'AN','D'+80H
	DB	'O','R'+80H
	DB	'>'+80H
	DB	'='+80H,'<'+80H
	DB	'SG','N'+80H
	DB	'IN','T'+80H
	DB	'AB','S'+80H
	DB	'CAL','L'+80H
	DB	'FR','E'+80H
	DB	'IN','P'+80H
	DB	'PO','S'+80H
	DB	'SQ','R'+80H
	DB	'RN','D'+80H
	DB	'LO','G'+80H
	DB	'EX','P'+80H
	DB	'CO','S'+80H
	DB	'SI','N'+80H
	DB	'TA','N'+80H
	DB	'AT','N'+80H
	DB	'PEE','K'+80H
	DB	'LE','N'+80H
	DB	'STR','$'+80H
	DB	'VA','L'+80H
	DB	'AS','C'+80H
	DB	'CHR','$'+80H
	DB	'LEFT','$'+80H
	DB	'RIGHT','$'+80H
	DB	'MID','$'+80H
	NOP
;
;VERB TABLE
;
	NOP
VRBTBL:
	DW	ENDSTMT	;80 END
	DW	FOR	;81 FOR
	DW	NEXT	;82 NEXT
	DW	DATA	;83 DATA
	DW	INPUT	;84 INPUT
	DW	DIM	;85 DIM
	DW	READ	;86 READ
	DW	FILEX	;87 FILE
	DW	GOTO	;88 GOTO
	DW	RUN	;89 RUN
	DW	IFSTMT	;8A IF
	DW	RESTORE	;8B RESTORE
	DW	GOSUB	;8C GOSUB
	DW	RETURN	;8D RETURN
	DW	REM	;8E REM
	DW	GETX	;8F GET
	DW	OUTSTMT	;90 OUT
	DW	PUTX	;91 PUT
	DW	PLOT	;92 PLOT
	DW	SAVE	;93 SAVE
	DW	LOAD	;94 LOAD
	DW	POKE	;95 POKE
	DW	PRINT	;96 PRINT
	DW	LIST	;97 LIST
	DW	CONT	;98 CONT
	DW	CLEAR	;99 CLEAR
	DW	DEF	;9A DEF
	DW	WAIT	;9B WAIT
	DW	ON	;9C ON
;
;ERROR TABLE
;
ERRTBL:
	DB	'N','F'+80H
	DB	'S','N'+80H
	DB	'R','G'+80H
	DB	'O','D'+80H
	DB	'C','F'+80H
	DB	'O','V'+80H
	DB	'O','M'+80H
	DB	'U','S'+80H
	DB	'B','S'+80H
	DB	'D','D'+80H
	DB	'0','/'+80H
	DB	'I','D'+80H
	DB	'T','M'+80H
	DB	'O','S'+80H
	DB	'L','S'+80H
	DB	'S','T'+80H
	DB	'C','N'+80H
	DB	'U','F'+80H
	DB	'S','L'+128	;SAVE LOAD ERROR 36
Y1C0	EQU	$
;
;LINE WORKING BUFFER MAX = 80 CHAR
;
	ORG	LINBF
LINBF:
	DB	','
IOBUF:
	DB	0
	ORG	$+61H
;
;MEMORY SCRATCH REGISTERS
;
DIMWRK:
	DB	0
TYPFLG:
	DB	0
CMPSWCH:
	DB	0
MAXRAM:
	DB	0,0	;END OF RAM
WKBFPT:
	DB	0,0
WKBUF:
	DB	0,0
X213:
	DB	0,0
X215:
	DB	0,0
X217:
	DB	0,0
X219:
	DB	0,0
X21B:
	DB	0,0
SLCTR:
	DB	0,0
STTAD:
	DB	0,0	;START MESS$
STRPTR:
	DB	0,0	;END RAM,MESS$
ELBUF:
	DB	0,0	;END LINE BUF
AXLNO:
	DB	0,0	;WORKING LINE #
DISABL:
	DB	0
DATFLG:
	DB	0
NOWAT:
	DB	0,0	;END OF PROG-1
TEMP1:
	DB	0,0	;LAST PROG LINE
LINENUM:
	DB	0,0	;LINE #,-1=NONE
BLINE:
	DB	0,0
CONCTR:
	DB	0,0	;ZERO END PROG
STACK:
	DB	0,0	;STACK PT
STRTSRC:
	DB	0,0	;START OF SOURCE
ENDSRC:
	DB	0,0	;START VARIABLE
ENDVAR:
	DB	0,0	;START OF ARRAYS
ENDARY:
	DB	0,0	;END OF ARRAYS
DATPTR:
	DB	0,0	;DATA ADDRESS
FACC:
	DB	0	;LSBYTE ACCUM
	DB	0
	DB	0	;MSBYTE ACCUM
FACC+3:
	DB	0	;EXP BYTE ACCUM
X243:
	DB	0
ASCBF:
	DB	0,0
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	ORG	Y1C0
;
;ASCII MESSAGE TABLE
;
MSGERR:
	DB	' ERRO','R'+80H,0
MSGIN:
	DB	' IN',' '+80H,0
MSGRDY:
	DB	CR,LF,255,CR,'READY',LF
MSGCRLF:
	DB	CR,LF,0
MSGBRK:
	DB	CR,255,CR,'BREA','K'+80H,0
FNSRCH:
	LXI	H,4
	DAD	SP
FNS1:
	MOV	A,M
	INX	H
	CPI	81H
	RNZ
	MOV	C,M
	INX	H
	MOV	B,M
	INX	H
	PUSH	H
	MOV	L,C
	MOV	H,B
	MOV	A,D
	ORA	E
	XCHG
	JZ	FNS2
	CALL	CMPDEHL-1
FNS2:
	LXI	B,13
	POP	H
	RZ
	DAD	B
	JMP	FNS1
COMPCOP:
	CALL	TSTOM	;HL>SP-38 =OM
COMPCOP2:
	PUSH	B
	XTHL
	POP	B	;SWAP BC FOR HL
;
;MOVE TO RAM
;
COMPCOP3:
	CALL	CMPDEHL	;DE=HL?
	MOV	A,M
	STAX	B
	RZ
	DCX	B
	DCX	H
	JMP	COMPCOP3
;
;TEST IF 2X OFFSET + RAM<SP-38, RET +1
;
SPACHK2:
	PUSH	H
	LHLD	ENDARY	;START RAM
	MVI	B,0
	DAD	B
	DAD	B
	CALL	TSTOM	;HL<SP-38
POPHRT:
	POP	H
	RET
;
;TEST FOR HL<SP-38 OTHERWISE OM OUT MEMORY
;
TSTOM:
	PUSH	D
	XCHG
	LXI	H,-40
	DAD	SP
	CALL	CMPDEHL
	XCHG
	POP	D
	RNC
OMERR:
	MVI	E,12	;OM ERROR
	JMP	DOERMS	;ECHO
SNERR:
	LHLD	AXLNO
	SHLD	LINENUM	;LINE #
SNERR2:
	MVI	E,2	;SN ERROR
	LXI	B,TRICK
	ORG	$-2
DIVERR:
	MVI	E,20	;/0 ERROR
	LXI	B,TRICK
	ORG	$-2
NFERR:
	MVI	E,0	;NF ERROR
DOERMS:
	CALL	RSTSTK	;RESET SP & REG
	CALL	CRLF
	CMA
	CALL	CONOUT
	MVI	A,CR
	CALL	ZERCPOS-3
;
;PRINT ERROR TABLE MESSAGE
;
	LXI	H,ERRTBL	;ERR TABLE
	MOV	D,A
	DAD	D	;ADD OFFSET
	MOV	A,M	;GET CHARAC
	CALL	CONOUT	;ECHO
	CALL	SKPSPC
	CALL	CONOUT	;ECHO
;
;LOAD HL WITH ERROR MESSAGE
;
	LXI	H,MSGERR
MPC:
	CALL	PRMSG	;PRINT ERROR
	LHLD	LINENUM	;LINE #
	MOV	A,H	;LINE #,-1=NONE
	ANA	L
	INR	A
	CNZ	PRNTIN	;PRINT 'IN #'
;
;INITIALIZED BASIC START ADDRESS
;
	MVI	A,TRICK
	ORG	$-1
X2EE:
	POP	B
PMPLIN:
	LXI	H,MSGRDY
	CALL	PRMSG	;PRINT OK
PMPLIN2:
	LXI	H,-1
	SHLD	LINENUM	;LINE #
;
;GET CHAR & FILL LINE BUFFER UNTIL CR
;
LINEIN:
	CALL	READLN	;FILL BUFFER
	INX	H
	MOV	A,M
	CPI	10	;LINE FEED
	JZ	$+4
	DCX	H
	CALL	SKPSPC
	INR	A
	DCR	A
	JZ	PMPLIN2	;END, REFILL
	PUSH	PSW
	CALL	TOBINY	;IF # MAKE BINA
	PUSH	D	;LINE # IN BINA
	CALL	CMPRLIN	;PACK LINE BUFF
	MOV	B,A
	POP	D
	POP	PSW
	JNC	EXINST	;NOT #,RUN
	PUSH	D
	PUSH	B
	CALL	SKPSPC
	ORA	A
	PUSH	PSW
	CALL	FNDLIN	;FIND LINE #
	PUSH	B
	JNC	NLINE
	XCHG
	LHLD	ENDSRC
;
;PUT BUFFER AT NEXT AVAILABLE RAM LOCATION
;
REMOLD:
	LDAX	D
	STAX	B
	INX	B
	INX	D
	CALL	CMPDEHL
	JNZ	REMOLD
	MOV	H,B
	MOV	L,C
	SHLD	ENDSRC
NLINE:
	POP	D
	POP	PSW
	JZ	DELINE
	LHLD	ENDSRC
	XTHL
	POP	B
	DAD	B
	PUSH	H
	CALL	COMPCOP	;HL<SP-38
	POP	H
	SHLD	ENDSRC
	XCHG
	MOV	M,H
	INX	H
	INX	H
	POP	D
	MOV	M,E
	INX	H
	MOV	M,D
	INX	H
;
;SET FOR BEGINNING OF LINE BUFFER
;
;AND MOVE INTO RAM
	LXI	D,IOBUF
MOVLINE:
	LDAX	D
	MOV	M,A
	INX	H
	INX	D
	ORA	A
	JNZ	MOVLINE
;
;LOAD RE-ENTRY POINT
;
DELINE:
	CALL	CLRPTR
	INX	H
	XCHG
SNXLIN:
	MOV	H,D
	MOV	L,E
	MOV	A,M
	INX	H
	ORA	M
	JZ	PMPLIN2	;END, RESTART
	INX	H
	INX	H
	INX	H
	XRA	A
TOEND:
	CMP	M
	INX	H
	JNZ	TOEND
	XCHG
	MOV	M,E
	INX	H
	MOV	M,D
	JMP	SNXLIN
;
;SEARCH FOR LINE # MATCH OR END=0,0
;
FNDLIN:
	LHLD	STRTSRC
FNDLN2:
	MOV	B,H
	MOV	C,L
	MOV	A,M
	INX	H
	ORA	M
	DCX	H
	RZ
	INX	H
	INX	H
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A
	CALL	CMPDEHL
	MOV	H,B
	MOV	L,C
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A
	CMC
	RZ
	CMC
	RNC
	JMP	FNDLN2
;
;NEW STATEMENT ROUTINE
;
CLRPTR:
	LHLD	STRTSRC
	DCX	H
CLRPTR2:
	SHLD	NOWAT	;START-1
	LHLD	MAXRAM	;END OF RAM
	SHLD	STRPTR	;END POINTER
	CALL	REST2	;RESTORE ROUTINE
	LHLD	ENDSRC
	SHLD	ENDVAR
	SHLD	ENDARY
;
;RESET STACK AND REGISTERS
;
RSTSTK:
	POP	B
	LHLD	STACK	;STACK LEVEL 0
	SPHL
	LXI	H,WKBUF
	SHLD	WKBFPT
	XRA	A
	MOV	H,A
	MOV	L,A
	SHLD	CONCTR
	STA	DISABL
	PUSH	H
	PUSH	B
X3CB:
	LHLD	NOWAT
	RET
;
;END OF NEW STATEMENT ROUTINE
;
;REPACK LINE BUFFER USING TOKEN VALUES
CMPRLIN:
	XRA	A
	STA	CMPSWCH
	MVI	C,5
;
;SET FOR BEG OF LINE BUFFER
;
;AND SEARCH FOR SYMBOLS
	LXI	D,IOBUF
CMPNXT:
	MOV	A,M
	CPI	' '	;SPACE
	INX	H
	JZ	CMPNXT
	DCX	H
	MOV	B,A
	CPI	'"'	;DOUBLE QUOTES
	JZ	FQUOTE
	ORA	A
	JZ	FELINE
	LDA	CMPSWCH
	ORA	A
	MOV	B,A
	MOV	A,M
	JNZ	CMPOUT
	CPI	'?'	;?
	MVI	A,96H	;PRINT CODE
	JZ	CMPOUT
	MOV	A,M
	CPI	'0'	;NUMBER 0
	JC	NOTNUM
	CPI	'<'	;< SYMBOL
	JC	CMPOUT
NOTNUM:
	PUSH	D
;
;SET DE TO ASCII COMND TABLE
;
;AND SEARCH FOR MATCH
	LXI	D,ASCTBL-1
	PUSH	H
	JMP	$+6
MBTKN:
	CALL	SKPSPC
	INX	D
TNXTKN:
	LDAX	D
	ANI	7FH
	JZ	NOTOKN
	CMP	M
	JNZ	NOTTKN
	LDAX	D
	ORA	A
	JP	MBTKN
	POP	PSW
	MOV	A,B
	ORI	80H
	JP	TRICK
	ORG	$-2
NOTOKN:
	POP	H
	MOV	A,M
	POP	D
;
;PACK AND TEST
;
CMPOUT:
	INX	H
	STAX	D
	INX	D
	INR	C
	SUI	':'
	JZ	CMPON
	CPI	49H
	JNZ	CMPOFF
CMPON:
	STA	CMPSWCH
CMPOFF:
	SUI	54H
	JNZ	CMPNXT
	MOV	B,A
NOCOMP:
	MOV	A,M
	ORA	A
	JZ	FELINE
	CMP	B
	JZ	CMPOUT
FQUOTE:
	INX	H
	STAX	D
	INR	C
	INX	D
	JMP	NOCOMP
NOTTKN:
	POP	H
	PUSH	H
	INR	B
	XCHG
SKPTKN:
	ORA	M
	INX	H
	JP	SKPTKN
	XCHG
	JMP	TNXTKN
;
;FOUND END OF PACKED LINE BUFFER
;
FELINE:
	LXI	H,LINBF
	STAX	D
	INX	D
	STAX	D
	INX	D
	STAX	D
	RET
;
;DELETE LAST LINE BUFFER CHARACTER
;
KILINE:
	MVI	A,25
	CALL	ADR4
X464:
	MVI	A,7	;BELL CODE
X466:
	CALL	ADR4	;ECHO CHAR
	MVI	A,26	;CRSLT
	CALL	ADR4
X468:
	MOV	A,M	;GET LAST BUFFER CHAR
	CPI	20H	;IS IT A CONTROL CODE ?
	MVI	A,25	;CRSRT IF IT IS
	JC	X46A	;SKIP SPACE PAINT
	MVI	A,20H	;PRINT SPACE CODE
	CALL	ADR4	;TO CLEAR SCREEN POSITION
	MVI	A,26	;CRSLT OVER SPACE
X46A:
	CALL	ADR4	;ECHO EITHER CRSRT OR CRSLT
	MOV	A,L	;TEST LO BYTE OF ADDRESS
	DCX	H	;DECREMENT BUFFER POINTER
	SHLD	FACC
	CPI	LINBF AND 255	;IS IT LESS
	RNZ		;NOT TOO MANY DELETES
	CALL	CRLF	;TOO MANY DELETES > CRLF
X475:
	LXI	H,LINBF	;LINE BUFFER
X478:
	SHLD	FACC	;SAVE POINTER
	RET		;EXIT TO CALLER
READLN:
	LXI	H,LINBF	;ZERO OUT THE BUFFER
	MVI	A,(DIMWRK-LINBF)	;SO THAT CRSRT WILL
READLNA:
	MVI	M,0	;FUNCTION PROPERLY
	INX	H
	DCR	A
	JNZ	READLNA
	CALL	X475	;AND RESET BUFFER
	LHLD	INFLG	;SET VECTOR TO 23
	MVI	M,23
	STA	THRUFL	;SET NOT THRU INPUT
WAIT2:
	EI		;ENABLE INTERRUPTS
	LDA	THRUFL	;TEST FOR THRU
	CPI	0DH	;CR YET ?
	JNZ	WAIT2	;WAIT UNTIL SET
	MVI	M,12	;VECTOR TO NEVERNEVERLAND
	EI		;ENABLE INTERUPTS
	XRA	A	;CLEAR READY FLAG
	STA	READY
	JMP	READCR
;
;INPUT FLAG ROUTINE FOR BASIC FLAG=23
;
INF23:
	LDA	THRUFL	;WAS LAST CHARACTER ESCAPE ?
	CPI	01BH
	JZ	INESC	;YES, PROCESS THIS CHAR DIFFERENT
	MOV	A,E	;IS THIS AUTOLOAD?
	DCR	A
	JZ	AUTOLD	;YES, REPLACE BUFFER
	XRA	A
	MOV	M,A	;CLEAR INPUT FLAG
	MOV	A,E	;GET CHAR IN E
	CPI	3	;IS IT CODE 0,1,2 OR 3
	RZ		;RET IF YES WITH FLAG=0
	MVI	M,23	;RESETUP INPUT FLAG
	RC		;DON'T PROCESS BUT FLAG=23
	LHLD	FACC	;LOAD BUFFER POINTER
	CPI	1BH	;IS IT ESCAPE ?
	JZ	ESCIN	;YES, WAIT FOR NEXT
	ANA	A	;SET FLAGS IN PSW
	JP	X4A0	;IF NOT TOKEN ECHO CHAR
	CPI	0D6H	;IS IT GREATER THAN TOKENS
	JNC	X4A0	;NOT TOKEN SO ECHO
	CALL	TKNASC	;FIND TOKEN EXPANSION
X490:
	INX	H	;GET NEXT BUFFER ADDRESS
	MVI	M,' '	;SPACE OVER IN CASE END
	MOV	A,L	;TEST FOR END OF BUFFER
	CPI	(DIMWRK-1) AND 255	;IS IT END?
	JZ	KILINE	;YES, SO BACKSPACE
	LDAX	D	;GET CHAR FROM TOKEN WORD
	INX	D	;UPDATE MESS POINTER
	ORA	A
	PUSH	PSW	;SAVE STATUS OF CHAR
	ANI	7FH	;STRIP A7 BIT
	MOV	M,A	;STORE IN LINE BUFFER
	CALL	ADR4	;ECHO CHAR TO DISPLAY
	POP	PSW	;RESTORE STATUS OF CHAR
	JP	X490	;LOOP TILL MINUS = LAST CHAR
	MVI	A,20H	;SPACE CHAR
X4A0:
	INX	H	;STEP TO NEXT
	CPI	25	;IS IT CURSOR RIGHT
	CZ	XEE0	;MOV A,M;ORA A;RET
	RZ		;NOT A GOOD CHAR
	DCX	H	;BACK STEP
	CALL	ADR4	;ECHO CHAR (SPACE OR CHAR)
	CPI	11	;ERASE LINE
	JZ	X475	;START OVER
	CPI	26	;CRSLT
	JZ	X468	;YES, BACK UP
	CPI	12	;ERASE PAGE
	RZ		;YES, IGNORE
	CPI	CR	;IS IT RETURN
	INX	H
	JZ	X4D0	;YES, PROCESS LINE IN BUFFER
	MOV	M,A
	MOV	A,L	;TESTING BUFFER FULL
	CPI	(DIMWRK-1) AND 255	;LAST POSITION
	JZ	X464	;BACKUP ONE POSITION
	JMP	X478	;STORE H&L AND RETURN
AUTOLD:
	LXI	H,LINBF	;REPLACE BUFFER CONTENTS WITH
	LXI	D,AUTOMSG	;LOAD AND RUN TOKENS
	MVI	B,LENGTH
ALOOP:
	INX	H	;BUMP BUFFER POINTER
	LDAX	D	;TRANSFER 1 BYTE
	MOV	M,A
	INX	D	;BUMP MESSAGE POINTER
	DCR	B
	JNZ	ALOOP	;CONTINUE
	INX	H	;POINT PAST END OF DATA
	MVI	A,CR	;SETUP THRUFL VALUE
X4D0:
	STA	THRUFL	;SAVE IT FOR LATER
	MVI	M,0	;ZERO END OF BUFFER
	RET		;CLEAN UP REG SAVED ON STACK
AUTOMSG:DB	94H,'"MENU":',89H
LENGTH	EQU	$-AUTOMSG
ESCIN:
	MOV	A,L	;TEST FOR 2 FREE ENTRIES
	INX	H	;BUMP POINTER RIGHT
	MVI	M,20H	;SPACE OUT THIS CHAR
	CPI	(DIMWRK-3) AND 255
	JNC	KILINE		;ECHO AS BELL
	MOV	A,E	;STORE IN THRU FLAG
	STA	THRUFL
	RET
INESC:
	XRA	A	;CLEAR THRUFLAG
	STA	THRUFL
	MOV	A,E	;TEST FOR LEGAL VALUE
	ANI	31	;LOWER 5 BITS ONLY
	LHLD	FACC	;GET POINTER
	INX	H	;BUMP RIGHT
	CPI	4	;INIT FCS
	JZ	EXITB
	CPI	5	;REENTER BASIC WITH STACK
	JZ	EXITB
	CPI	23	;RESET BASIC
	JZ	EXITB
	CPI	31	;GOTO CRTMODE
	JZ	EXITB
INSERT:
	MVI	A,1BH	;ECHO ESCAPE SEQUENCE
	CALL	ADR4
	MOV	M,A	;AND BUFFER
	INX	H
	MOV	A,E	;ECHO CHARACTER
	CALL	ADR4
	MOV	M,A	;AND BUFFER
	SHLD	FACC
	RET		;EXIT
EXITB:
	LHLD	ACRTSP	;SETUP STACK
	SPHL
	LXI	H,BEGEX	;SETUP TOP OF STACK
	PUSH	H
	LHLD	AESCTB	;LOAD ADDRESS OF ESCTABLE
	MVI	D,0	;SETUP FOR DAD D
	MOV	E,A
	DAD	D	;INDEX INTO ESCAPE TABLE
	DAD	D
	MOV	A,M	;LOAD LO ADDRESS BYTE
	INX	H
	MOV	H,M	;LOAD HI ADDRESS BYTE
	MOV	L,A
	PUSH	H	;SAVE ADDRESS ON STACK
	LHLD	INFLG	;LOAD WHICH INPUT FLAG
	MVI	M,0	;CLEAR INPUT FLAG
	RET		;AND DISPATCH
;
;OUTPUT CHARACTER TO LIST DEVICE AND CHECK
;IF END OF LINE
;
CONOUT:
	CPI	' '
	JC	ADR4
	PUSH	PSW
	LDA	CHRCT	;CURSOR POSITION
	PUSH	H
	LXI	H,NOCHA
	CMP	M
	CNC	CRLF	;CRLF
	POP	H
	INR	A
	STA	CHRCT	;CURSOR POSITION
	POP	PSW
	JMP	ADR4
;
;LIST STATEMENT ROUTINE
;
LIST:
	CALL	TOBINY	;CONVERT LINE NO.
	RNZ
	PUSH	H
	CALL	FNDLIN
	PUSH	B
NXTLIN:
	POP	H
	CALL	ONSTACK
	POP	B
	MOV	A,B
	ORA	C
	JZ	POPHRT	;BASEX
	PUSH	B
	CALL	TSTCAN1	;TEST BREAK
	CALL	CRLF	;CRLF
	CALL	ONSTACK
	XTHL
	CALL	PRNTLN
	MVI	A,' '
	POP	H
ISCLEAR:
	CALL	CONOUT	;ECHO
	MOV	A,M
	ORA	A
	INX	H
	JZ	NXTLIN
	JP	ISCLEAR
	CALL	TKNASC	;EXPAND TOKEN NAME
LIST3:
	LDAX	D	;GET TOKEN CHAR
	INX	D	;INC TOKEN WORD
	ORA	A	;TEST IF EQUAL LAST CHAR
	PUSH	PSW
	ANI	7FH	;STRIP A7 BIT
	CALL	CONOUT	;ECHO
	POP	PSW	;GET RESULT OF TEST
	JP	LIST3	;LOOP UNTIL MINUS
	MVI	A,20H	;SPACE CODE
	JMP	ISCLEAR	;GET NEXT
;
;	EXPANDS TOKEN VALUE TO NAME ROUTINE
;
TKNASC:
	SUI	7FH
	MOV	C,A
;
;SET DE TO ASCII COMMAND TABLE
;
	LXI	D,ASCTBL-1
NENDTK:
	LDAX	D
	INX	D
	ORA	A
	JP	NENDTK
	DCR	C
	JNZ	NENDTK
	RET
;
;FOR X = STATEMENT ROUTINE
;
FOR:
	MVI	A,64H
	STA	DISABL
	CALL	LET
	XTHL
	CALL	FNSRCH
	POP	D
	JNZ	FOR2
	DAD	B
	SPHL
FOR2:
	XCHG
	MVI	C,8
	CALL	SPACHK2
	PUSH	H
	CALL	DATA
	XTHL
	PUSH	H
	LHLD	LINENUM
	XTHL
	CALL	TSTBYT
	DB	9EH	;TO CODE
	CALL	TSVAR
	CALL	EXPR
	PUSH	H
	CALL	FBCDE	;GET ACCUM
	POP	H
	PUSH	B	;MSBYTE
	PUSH	D	;LSBYTE
	LXI	B,8100H
	MOV	D,C
	MOV	E,D
	MOV	A,M
	CPI	0A3H	;STEP CODE
	MVI	A,01
	JNZ	NOSTEP
	CALL	SKPSPC
	CALL	EXPR
	PUSH	H
	CALL	FBCDE	;GET ACCUM
	CALL	FACCSN
	POP	H
NOSTEP:
	PUSH	B
	PUSH	D
	PUSH	PSW
	INX	SP
	PUSH	H
	LHLD	NOWAT	;START RAM-1
	XTHL
MORFOR:
	MVI	B,81H
	PUSH	B
	INX	SP
;
;TEST INPUT READY FOR LINE FEED = BREAK
;
PROCD:
	CALL	TSTCAN1	;TEST FOR BREAK
	SHLD	NOWAT	;START RAM-1
	MOV	A,M
	CPI	':'	;':'
	JZ	EXINST	;COLON
	ORA	A
	JNZ	SNERR2	;SN ERROR
	INX	H
	MOV	A,M
	INX	H
	ORA	M
	INX	H
	JZ	DONE
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	SHLD	LINENUM
	XCHG
EXINST:
	CALL	SKPSPC
	LXI	D,PROCD
	PUSH	D
EXINS2:
	RZ
XTOKEN:
	SUI	80H	;TOKEN?
	JC	LET	;NOT TOKEN
	CPI	1DH	;OUT OF TABLE?
	JNC	SNERR2	;SN ERROR
	RLC
	MOV	C,A
	MVI	B,0
	XCHG
;
;SET HL TO STATEMENT TABLE ADDRESS
;
	LXI	H,VRBTBL
	DAD	B	;ADD2X(TOKEN-80)
	MOV	C,M
	INX	H
	MOV	B,M
	PUSH	B
	XCHG
	JMP	SKPSPC
TSTBYT:
	MOV	A,M
	XTHL
	CMP	M
	INX	H
	XTHL
	JNZ	SNERR2	;SN ERROR
;
;  GET NEXT BYTE FROM MEMORY
;
;  RETURN IF MEMORY IS  :  OR ZERO  WITH ZERO FLAG SET
;
;	RETURN WITH  CARRY SET IF  NUMBERIC
;
SKPSPC:
	INX	H
	MOV	A,M
	CPI	':'	;: SYMBOL
	RNC		;GREATER THAN
SKN2:
	CPI	' '	;SPACE
	JZ	SKPSPC	;LOOP FOR CHAR
	CPI	'0'	;NUMBER
	CMC
	INR	A
	DCR	A
	RET
;
;RESTORE STATEMENT ROUTINE
;
RESTORE:
	CALL	TOBINY
	MOV	A,D
	ORA	E
	JZ	REST2
	PUSH	H
	CALL	X6C0
	POP	D
	JMP	NDP
REST2:
	XCHG
	LHLD	STRTSRC
	DCX	H
NDP:
	SHLD	DATPTR
	XCHG
	RET
;
;	TEST FOR BREAK KEY AND/OR LINE FEED KEY
;
TSTCAN1:
	EI		;INSURE INTERUPTS ARE ON
	LDA	READY	;TEST READY FLAG
	ANA	A	;IF NO CHAR THEN EXIT
	RZ
	JP	TSTCAN1	;IF BREAK THEN WAIT
	XRA	A	;CLEAR READY FLAG
	STA	READY
	LDA	CHAR	;ELSE TEST CHARACTER
	CALL	KEYOT	;ECHO CHARACTER
	CPI	LF	;TEST CHAR FOR BREAK
;
;	FALL INTO CONDITIONAL END ROUTINE
;
;END STATEMENT ROUTINE
STOP:
	RNZ
	ORI	TRICK
	ORG	$-1
ENDSTMT:
	RNZ
	SHLD	NOWAT
NOINP:
	POP	B
DONE:
	PUSH	PSW
	LHLD	LINENUM
	MOV	A,L
	ANA	H
	INR	A
	JZ	NOCONT
	SHLD	BLINE
	LHLD	NOWAT
	SHLD	CONCTR
NOCONT:
	POP	PSW
;
;MESSAGE BREAK
;
	LXI	H,MSGBRK
	JNZ	MPC
	JMP	PMPLIN
;
;CONTINUE STATEMENT ROUTINE
;
CONT:
	MVI	E,32
	LHLD	CONCTR
	MOV	A,H
	ORA	L
	JZ	DOERMS
	XCHG
	LHLD	BLINE
	SHLD	LINENUM
	XCHG
	RET
;
;PLOT X ROUTINE
;
PLOT:
	CALL	XPRDE
	CALL	ADR4
	CALL	SKPSPC+1
	RZ
	CALL	TSTBYT
	DB	','
	JMP	PLOT
;
;IS IT A TO Z LETTERS ?
;
TSTALPHA:
	MOV	A,M	;IS IT A TO Z?
	CPI	'A'	;A?
	RC
	CPI	'Z'-1	;Z?
	CMC
	RET
PEXEV:
	CALL	SKPSPC
EXPEVP:
	CALL	EXPR
FACDEP:
	CALL	FACCSN
	JM	FCERR	;CF ERROR
;
;GET ARGUMENT X OF CALL(X)- X IN DE REG
;
FACCDE:
	LDA	FACC+3	;EXP ACCUM
	CPI	90H
X640:
	JC	X12DD
	LXI	B,9080H	;SET ACCUM
	LXI	D,0	;VALUE 0
	CALL	X12B2
	MOV	D,C
	RZ
FCERR:
	MVI	E,8	;FC ERROR
	JMP	DOERMS	;BASEX
;
;CONVERT LINE # TO BINARY RESULT IN DE
;
TOBINY:
	DCX	H
TOBINY1:
	LXI	D,0
TOBINY2:
	CALL	SKPSPC
	RNC
	PUSH	H
	PUSH	PSW
	LXI	H,65520/10	;65529 LINES
	CALL	CMPDEHL
	JC	SNERR2	;SN ERROR
	MOV	H,D
	MOV	L,E
	DAD	D
	DAD	H
	DAD	D
	DAD	H
	POP	PSW
	SUI	'0'
	MOV	E,A
	MVI	D,0
	DAD	D
	XCHG
	POP	H
	JMP	TOBINY2
;
;CLEAR STATEMENT ROUTINE
;
CLEAR:
	JZ	CLRPTR2
	CALL	EXPEVP
	CALL	SKPSPC+1
	RNZ
	PUSH	H
	LHLD	MAXRAM	;END OF RAM
	MOV	A,L
	SUB	E
	MOV	E,A
	MOV	A,H
	SBB	D
	MOV	D,A
	JC	SNERR2	;SN ERROR
	LHLD	ENDSRC	;START OF RAM
	LXI	B,40	;40 LOCATIONS
	DAD	B
	CALL	CMPDEHL
	JNC	OMERR
	XCHG
	SHLD	STACK
	POP	H
	JMP	CLRPTR2
;
;RUN STATEMENT ROUTINE
;
RUN:
	JZ	CLRPTR	;SET REG&SP
	CALL	CLRPTR2	;SET REG & SP
	LXI	B,PROCD	;SETUP BREAK
	JMP	RUN2	;GOTO X
;
;GOSUB X ROUTINE
;
GOSUB:
	MVI	C,3
	CALL	SPACHK2
	POP	B
	PUSH	H
	PUSH	H
	LHLD	LINENUM
	XTHL
	MVI	D,8CH	;GOSUB CODE
	PUSH	D
	INX	SP
RUN2:
	PUSH	B
;
;GOTO X ROUTINE
;
GOTO:
	CALL	TOBINY	;GET NUMBER IN  DE
	CALL	REM	;HL = MEMORY PRESENT LOCATION
X6C0:
	PUSH	H
	LHLD	LINENUM
	CALL	CMPDEHL
	POP	H
	INX	H
	CC	FNDLN2
	CNC	FNDLIN
	MOV	H,B
	MOV	L,C
	DCX	H
	RC
	MVI	E,14
	JMP	DOERMS
;
;RETURN STATEMENT ROUTINE
;
RETURN:
	RNZ
	MVI	D,0FFH
	CALL	FNSRCH
	SPHL
	CPI	8CH	;GOSUB CODE
	MVI	E,4
	JNZ	DOERMS
	POP	H
	SHLD	LINENUM
	LXI	H,PROCD	;SETUP BREAK
	XTHL
;
;DATA STATEMENT ROUTINE
;
DATA:
	LXI	B,TRICK
	ORG	$-2
	LDA	TRICK
	ORG	$-2
;
;REM ARKS STATEMENT ROUTINE
;
REM:
	MVI	C,0
	MVI	B,0
REM2:
	MOV	A,C
	MOV	C,B
	MOV	B,A
REM3:
	MOV	A,M
	ORA	A
	RZ
	CMP	B
	RZ
	INX	H
	CPI	'"'
	JZ	REM2
	JMP	REM3
;
;LET X =  STATEMENT ROUTINE
;
LET:
	CALL	FNDVAR
	CALL	TSTBYT
	DB	0ACH	;= CODE
	PUSH	D
	LDA	TYPFLG
	PUSH	PSW
	CALL	EVAL
	POP	PSW
	XTHL
	SHLD	NOWAT
	RAR
	CALL	TSTYPE
	JZ	IZVAR
IZSTR:
	PUSH	H
	LHLD	FACC
	PUSH	H
	INX	H
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	LXI	H,CHRCT	;CURSOR POSITION
	CALL	CMPDEHL
	JNC	X72F
	LHLD	STACK
	CALL	CMPDEHL
	POP	D
	JNC	X737
	LHLD	ENDSRC
	CALL	CMPDEHL
	JNC	X737
	MVI	A,TRICK
	ORG	$-1
X72F:
	POP	D
	CALL	XED8
	XCHG
	CALL	XD21
X737:
	CALL	XED8
	POP	H
	CALL	COPY4
	POP	H
	RET
IZVAR:
	PUSH	H
	CALL	FMEM
	POP	D
	POP	H
	RET
;
;ON X GOTO Y STATEMENT ROUTINE
;
ON:
	CALL	XPRDE
	MOV	A,M
	MOV	B,A
	CPI	8CH	;GOSUB CODE
	JZ	ON2
	CALL	TSTBYT
	DB	88H	;GOTO CODE
	DCX	H
ON2:
	MOV	C,E
ON3:
	DCR	C
	MOV	A,B
	JZ	XTOKEN	;NEXT TOKEN
	CALL	TOBINY1
	CPI	','	;,
	RNZ
	JMP	ON3
;
;IF X   STATEMENT ROUTINE
;
IFSTMT:
	CALL	EVAL
	MOV	A,M
	CPI	88H	;GOTO CODE
	JZ	IF2	;SKIP THEN TEST
	CALL	TSTBYT
	DB	0A1H	;THEN CODE
	DCX	H
IF2:
	CALL	FACCSN
	JZ	REM	;GET END LINE
	CALL	SKPSPC
	JC	GOTO	;GOTO X
	JMP	EXINS2	;NEXT TOKEN
;
;PRINT ROUTINE
;
	DCX	H
MPRINT:
	CALL	SKPSPC
;
;PRINT STATEMENT ROUTINE
;
PRINT:
	JZ	CRLF
PRTMOR:
	RZ
	CPI	9DH	;TAB( CODE
	JZ	DOTAB
	CPI	0A0H	;SPC( CODE
	JZ	DOSPC
	PUSH	H
	CPI	','	;,
	JZ	BASTAB
	CPI	';'	;;
	JZ	ENDSPC
	POP	B
	CALL	EVAL
	PUSH	H
	LDA	TYPFLG
	ORA	A
	JNZ	PRSTR
	CALL	FACASC
	CALL	CNTLEN
	LHLD	FACC
	LDA	CHRCT	;CURSOR POSITION
	ADD	M
	PUSH	H
	LXI	H,NOCHA
	CMP	M
	POP	H
	CNC	CRLF	;CRLF
PRSTR:
	CALL	MSGOUT	;ECHO MESS
	POP	H
	JMP	MPRINT-1
;
;ADD 0 BYTE TO END OF LINE & CR, LF
;
READCR:
	LXI	H,LINBF
;
;CR,LF ROUTINE
;
CRLF:
	MVI	A,CR
	CALL	CONOUT
	MVI	A,LF
	CALL	CONOUT
ZERCPOS:
	XRA	A
	STA	CHRCT	;CURSOR POSITION
	RET
BASTAB:
	MVI	A,9	;TAB CODE
	CALL	CONOUT
	LDA	CHRCT	;CURSOR POSITION
	ORI	7
	INR	A
	STA	CHRCT	;CURSOR POSITION
	JMP	ENDSPC
;
;TAB( AND SPC(   SUBROUTINES
;
DOSPC:
	STC
DOTAB:
	PUSH	PSW
	CALL	SXPRDE
	CALL	TSTBYT
	DB	')'	;)
	DCX	H
	POP	PSW
	CPI	0A0H	;SPC( CODE
	PUSH	H
	MVI	A,-1
	JZ	X80D	;SPC(
	LDA	CHRCT	;CURSOR POSITION
	CMA
X80D:
	ADD	E
	JNC	ENDSPC
SPCLOOP:
	INR	A
;
;SPC(   ROUTINE
;
SPCLP1:
	MOV	B,A
SPCLP2:
	MVI	A,' '
	CALL	CONOUT	;ECHO SPACE
	DCR	B
	JNZ	SPCLP2
ENDSPC:
	POP	H
	CALL	SKPSPC
	JMP	PRTMOR
INERR:
	LDA	DATFLG
	ORA	A
	JNZ	SNERR
	POP	B
	JMP	X3CB
;
;INPUT X  STATEMENT ROUTINE
;
INPUT:
	CPI	'"'
	JNZ	INPUT2
	CALL	CNTLEN1
	CALL	TSTBYT
	DB	';'	;';'
	PUSH	H
	CALL	MSGOUT
	POP	H
	JMP	$+8
INPUT2:
	MVI	A,'?'
	CALL	CONOUT
	PUSH	H
	CALL	ERRIM
	CALL	READLN
	MVI	A,','
	STA	LINBF
	INX	H
	MOV	A,M
	CPI	10	;LF
	DCX	H
	POP	B
	JZ	NOINP
	PUSH	B
	ORA	A
	JNZ	READ2
	INX	H
	MVI	M,'0'
	INX	H
	MOV	M,A
	DCX	H
	DCX	H
	JMP	READ2
;
;READ STATEMENT ROUTINE
;
READ:
	PUSH	H
	LHLD	DATPTR
	ORI	TRICK
	ORG	$-1
READ2:
	XRA	A
	STA	DATFLG
	XTHL
	JMP	X876+4
X876:
	CALL	TSTBYT
	DB	','	;','
	CALL	FNDVAR
	XTHL
	PUSH	D
	MOV	A,M
	CPI	','	;','
	JZ	GETDAT
	LDA	DATFLG
	ORA	A
	JNZ	FNDAT
	MVI	A,'?'
	CALL	CONOUT
	CALL	READLN
GETDAT:
	LDA	TYPFLG
	ORA	A
	JZ	VARTYP
	CALL	SKPSPC
	MOV	D,A
	MOV	B,A
	CPI	'"'
	JZ	STONLY
	MVI	D,':'
	MVI	B,','
	DCX	H
STONLY:
	CALL	CNTLEN2
	XCHG
	LXI	H,X8B9
	XTHL
	PUSH	D
	JMP	IZSTR
VARTYP:
	CALL	SKPSPC
	CALL	ASCFAC
	XTHL
	CALL	FMEM
	POP	H
X8B9:
	CALL	SKPSPC+1
	JZ	NOTERR
	CPI	','
	JNZ	INERR
NOTERR:
	XTHL
	CALL	SKPSPC+1
	JNZ	X876
	POP	D
	LDA	DATFLG
	ORA	A
	XCHG
	JNZ	NDP
	ORA	M
	XCHG
	RET
FNDAT:
	CALL	DATA
	ORA	A
	JNZ	X906
	INX	H
	MOV	A,M
	INX	H
	ORA	M
	MVI	E,06
	JZ	DOERMS
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	SHLD	AXLNO
	XCHG
X906:
	CALL	SKPSPC
	CPI	83H	;DATA CODE
	JNZ	FNDAT
	JMP	GETDAT
;
;NEXT STATEMENT ROUTINE
;
NEXT:
	LXI	D,0
NXNX:
	CNZ	FNDVAR
	SHLD	NOWAT
	CALL	FNSRCH
	JNZ	NFERR
	SPHL
	PUSH	D
	MOV	A,M
	INX	H
	PUSH	PSW
	PUSH	D
	CALL	MEMFAC
	XTHL
	PUSH	H
	CALL	XFE9
	POP	H
	CALL	FMEM	;STORE ACCUM
	POP	H	;IN HL ADR
	CALL	MBCDE	;LOAD BCDE
	PUSH	H
	CALL	X12B2
	POP	H
	POP	B
	SUB	B
	CALL	MBCDE
	JZ	NEXDON
	XCHG
	SHLD	LINENUM
	MOV	L,C
	MOV	H,B
	JMP	MORFOR
NEXDON:
	SPHL
	LHLD	NOWAT
	MOV	A,M
	CPI	','
	JNZ	PROCD
	CALL	SKPSPC
	CALL	NXNX
EXPR:
	CALL	EVAL	;EVULATE NUMERIC EXPRESSION
TSVAR:
	ORI	TRICK
	ORG	$-1
TSSTR:
	STC		;VERIFY IF STRING
TSTYPE:
	LDA	TYPFLG	;IF LOC = 0 = NUMERIC
	ADC	A
	RPE
	MVI	E,24	;TM ERROR
	JMP	DOERMS	;BASEX
;
;	EVULATES STRING OR NUMERIC EXPRESSION
;
EVAL:
	DCX	H
	MVI	D,0
X96A:
	PUSH	D
	MVI	C,1
	CALL	SPACHK2
	CALL	X9D7
	SHLD	TEMP1
X975:
	LHLD	TEMP1
X978:
	POP	B
	MOV	A,B
	CPI	78H
	CNC	TSVAR
	MOV	A,M
	MVI	D,0
X982:
	SUI	0ABH	;> TOKEN
	JC	X99C
	CPI	3	;SGN TOKEN
	JNC	X99C
;
;MUST BE EITHER <, =,OR > TOKEN VALUES
;
	CPI	1
	RAL
	XRA	D
	CMP	D
	MOV	D,A
	JC	SNERR2	;SN ERROR
	SHLD	ELBUF
	CALL	SKPSPC
	JMP	X982	;LOOP AGAIN
X99C:
	MOV	A,D
	ORA	A
	JNZ	XA90
	MOV	A,M
	SHLD	ELBUF
	SUI	0A4H	;+ CODE
	RC		;IS IT MATH ?
	CPI	7	;> CODE
	RNC
	MOV	E,A	;0 TO 6
	LDA	TYPFLG
	DCR	A
	ORA	E
	MOV	A,E
	JZ	XE69
	RLC
	ADD	E
	MOV	E,A	;3XE
;
;THREE BYTE MATH TABLE
;
	LXI	H,MTHTBL
	DAD	D
	MOV	A,B
	MOV	D,M
	CMP	D
	RNC
	INX	H
	CALL	TSVAR
X9C4:
	PUSH	B
	LXI	B,X975
	PUSH	B
	MOV	B,E
	MOV	C,D
	CALL	FACSTK	;INSERT FLOATAC
	MOV	E,B
	MOV	D,C
	MOV	C,M
	INX	H
	MOV	B,M
	INX	H
	PUSH	B
	LHLD	ELBUF
	JMP	X96A
X9D7:
	XRA	A
	STA	TYPFLG
	CALL	SKPSPC
	JC	ASCFAC
	CALL	TSTALPHA	;IS IT A TO Z ?
	JNC	LDFACC	;LETER,LOAD ACC
	CPI	0A4H	;+ CODE
	JZ	X9D7
	CPI	'.'	;.
	JZ	ASCFAC
	CPI	0A5H	;- CODE
	JZ	NEGFNC	;NEGATIVE
	CPI	'"'	;"
	JZ	CNTLEN1
	CPI	0A2H	;NOT CODE
	JZ	XAEB
	CPI	9FH	;FN CODE
	JZ	XCBF
	SUI	0AEH	;SGN CODE
	JNC	XA32
PARENS:
	CALL	TSTBYT
	DB	'('	;(
	CALL	EVAL
	CALL	TSTBYT
	DB	')'	;)
	RET
;
;NEGATIVE FUNCTION
;
NEGFNC:
	MVI	D,7DH
	CALL	X96A
	LHLD	TEMP1
	PUSH	H
	CALL	REVFAC
XA1C:
	CALL	TSVAR
	POP	H
	RET
;
;VARIABLE LETTER FUCTION & LOAD ACCUMULATOR
;
LDFACC:
	CALL	FNDVAR
XA24:
	PUSH	H
	XCHG
	SHLD	FACC
	LDA	TYPFLG
	ORA	A
	CZ	MEMFAC	;LOAD ACCUM
	POP	H
	RET
XA32:
	MVI	B,0
	RLC
	MOV	C,A
	PUSH	B
	CALL	SKPSPC
	MOV	A,C
	CPI	29H
	JC	EXFUNC
	CALL	TSTBYT
	DB	'('	;(
	CALL	EVAL
	CALL	TSTBYT
	DB	','	;,
	CALL	TSSTR
	XCHG
	LHLD	FACC
	XTHL
	PUSH	H
	XCHG
	CALL	XPRDE
	XCHG
	XTHL
	JMP	GOFNC
EXFUNC:
	CALL	PARENS
	XTHL
	LXI	D,XA1C
	PUSH	D
;
;LOAD BC WITH FUNCTION (X) TABLE ADDRESS
;
;AND JUMP TO SUBROUTINE
GOFNC:
	LXI	B,FNCTBL
	DAD	B
	MOV	C,M
	INX	H
	MOV	H,M
	MOV	L,C
	PCHL		;JMP TO FUNCTION
;
;OR MATH OPERATION
;
BOLOR:
	ORI	TRICK
	ORG	$-1
;
;AND MATH OPERATION
;
BOLAND:
	XRA	A
	PUSH	PSW
	CALL	TSVAR
	CALL	FACCDE
	POP	PSW
	XCHG
	POP	B
	XTHL
	XCHG
	CALL	BCDEF
	PUSH	PSW
	CALL	FACCDE
	POP	PSW
	POP	B
	MOV	A,C
	LXI	H,XC8D
	JNZ	XA8B
	ANA	E
	MOV	C,A
	MOV	A,B
	ANA	D
	PCHL
XA8B:
	ORA	E
	MOV	C,A
	MOV	A,B
	ORA	D
	PCHL
XA90:
	LXI	H,XAA2
	LDA	TYPFLG
	RAR
	MOV	A,D
	RAL
	MOV	E,A
	MVI	D,64H
	MOV	A,B
	CMP	D
	RNC
	JMP	X9C4
;
;IF   THEN ENTRY
;
XAA2:
	DW	XAA4
XAA4:
	MOV	A,C
	ORA	A
	RAR
	POP	B
	POP	D
	PUSH	PSW
	CALL	TSTYPE
	LXI	H,XAE1
	PUSH	H
	JZ	X12B2
	XRA	A
	STA	TYPFLG
	PUSH	D
	CALL	USST
	POP	D
	CALL	ONSTACK
	CALL	ONSTACK
	CALL	XEB7
	CALL	MBCDE
	POP	H
	XTHL
	MOV	D,L
	POP	H
XAC9:
	MOV	A,E
	ORA	D
	RZ
	MOV	A,D
	SUI	1
	RC
	XRA	A
	CMP	E
	INR	A
	RNC
	DCR	D
	DCR	E
	LDAX	B
	CMP	M
	INX	H
	INX	B
	JZ	XAC9
	CMC
	JMP	X1246
XAE1:
	INR	A
	ADC	A
	POP	B
	ANA	B
	ADI	255
	SBB	A
	JMP	X124B
;
;NOT STATEMENT ROUTINE
;
XAEB:
	MVI	D,5AH
	CALL	X96A
	CALL	TSVAR
	CALL	FACCDE
	MOV	A,E
	CMA
	MOV	C,A
	MOV	A,D
	CMA
	CALL	XC8D
	POP	B
	JMP	X975
XB02:
	CALL	SKPSPC+1
	RZ
	CALL	TSTBYT
	DB	','	;,
;
;DIM(I,J)   STATEMENT ROUTINE
;
DIM:
	LXI	B,XB02
	PUSH	B
	ORI	TRICK
	ORG	$-1
FNDVAR:
	XRA	A
	STA	DIMWRK
	MOV	B,M
XB11:
	CALL	TSTALPHA	;A TO Z ?
	JC	SNERR2	;SN ERROR
	XRA	A
	MOV	C,A
	STA	TYPFLG
	CALL	SKPSPC
	JC	USENUM
	CALL	TSTALPHA	;A TO Z ?
	JC	NOTNA
USENUM:
	MOV	C,A
PASSEX:
	CALL	SKPSPC
	JC	PASSEX
	CALL	TSTALPHA	;A TO Z ?
	JNC	PASSEX
NOTNA:
	SUI	'$'	;$ CHAR STRING
	JNZ	GOTNAM	;NOT STRING
	INR	A
	STA	TYPFLG
	RRC
	ADD	C
	MOV	C,A
	CALL	SKPSPC
GOTNAM:
	LDA	DISABL
	ADD	M
	SUI	'('	;(
	JZ	XB90
	XRA	A
	STA	DISABL
	PUSH	H
	LHLD	ENDVAR
	XCHG
	LHLD	ENDSRC
VARSRC:
	CALL	CMPDEHL
	JZ	XB69
	MOV	A,C
	SUB	M
	INX	H
	JNZ	VARNE
	MOV	A,B
	SUB	M
VARNE:
	INX	H
	JZ	VARFND
	INX	H
	INX	H
	INX	H
	INX	H
	JMP	VARSRC
XB69:
	POP	H
	XTHL
	PUSH	D
	LXI	D,XA24
	CALL	CMPDEHL
	POP	D
	JZ	XB8F
	XTHL
	PUSH	H
VARNF:
	PUSH	B
	LXI	B,6
	LHLD	ENDARY
	PUSH	H
	DAD	B
	POP	B
	PUSH	H
	CALL	COMPCOP
	POP	H
	SHLD	ENDARY
	MOV	H,B
	MOV	L,C
	SHLD	ENDVAR
BLENTRY:
	CALL	ZTSTDE
	JNZ	BLENTRY
	POP	D
	MOV	M,E
	INX	H
	MOV	M,D
	INX	H
VARFND:
	XCHG
	POP	H
	RET
XB8F:
	STA	FACC+3
	LXI	H,MSGRDY-1
	SHLD	FACC
	POP	H
	RET
XB90:
	PUSH	H
	LHLD	DIMWRK
	XTHL
	MOV	D,A	;A=0
SBSCR:
	PUSH	D
	PUSH	B
	CALL	PEXEV
	POP	B
	POP	PSW
	XCHG
	XTHL
	PUSH	H
	XCHG
	INR	A
	MOV	D,A
	MOV	A,M
	CPI	','	;,
	JZ	SBSCR
	CALL	TSTBYT
	DB	')'	;)
	SHLD	TEMP1
	POP	H
	SHLD	DIMWRK
	PUSH	D
	LHLD	ENDVAR
XBB7:
	MVI	A,TRICK
	ORG	$-1
SARTB:
	DAD	D
	XCHG
	LHLD	ENDARY
	CALL	CMPDEHL-1
	JZ	NOARY
	MOV	A,M
	CMP	C
	INX	H
	JNZ	NTTARY
	MOV	A,M
	CMP	B
NTTARY:
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	JNZ	SARTB
	LDA	DIMWRK
	ORA	A
	MVI	E,18
	JNZ	DOERMS
	POP	PSW
	SUB	M
	JZ	XC44
BSERR:
	MVI	E,16
	JMP	DOERMS
NOARY:
	LXI	D,4
	POP	PSW
	MOV	M,C
	INX	H
	MOV	M,B
	INX	H
	MOV	C,A
	CALL	SPACHK2
	INX	H
	INX	H
	SHLD	ELBUF
	MOV	M,C
	INX	H
	LDA	DIMWRK
	RAL
	MOV	A,C
MORDIM:
	LXI	B,11
	JNC	NODIM
	POP	B
	INX	B
NODIM:
	MOV	M,C
	INX	H
	MOV	M,B
	INX	H
	PUSH	PSW
	PUSH	H
	CALL	MLT16
	XCHG
	POP	H
	POP	PSW
	DCR	A
	JNZ	MORDIM
	PUSH	PSW
	MOV	B,D
	MOV	C,E
	XCHG
	DAD	D
	JC	BSERR
	CALL	TSTOM
	SHLD	ENDARY
ZERARY:
	CALL	ZTSTDE
	JNZ	ZERARY
	INX	B
	MOV	D,A
	LHLD	ELBUF
	MOV	E,M
	XCHG
	DAD	H
	DAD	B
	XCHG
	DCX	H
	DCX	H
	MOV	M,E
	INX	H
	MOV	M,D
	INX	H
	POP	PSW
	JC	XC66
XC44:
	MOV	B,A
	MOV	C,A
	MOV	A,M
	INX	H
	MVI	D,TRICK
	ORG	$-1
FNDEL:
	POP	H
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	XTHL
	PUSH	PSW
	CALL	CMPDEHL
	JNC	BSERR
	PUSH	H
	CALL	MLT16
	POP	D
	DAD	D
	POP	PSW
	DCR	A
	MOV	B,H
	MOV	C,L
	JNZ	FNDEL
	DAD	H
	DAD	H
	POP	B
	DAD	B
	XCHG
XC66:
	LHLD	TEMP1
	RET
;
;FIND FRE(X) ROUTINE
;
FRE:
	LHLD	ENDARY
	XCHG
	LXI	H,0
	DAD	SP
	LDA	TYPFLG
	ORA	A
	JZ	FREEN
	CALL	USST
	CALL	PACK
	LHLD	STACK
	XCHG
	LHLD	STRPTR	;NEXT AVAIL STRING BYTE
FREEN:
	MOV	A,L
	SUB	E
	MOV	C,A
	MOV	A,H
	SBB	D
XC8D:
	MOV	B,C
;
;PUT ARGUMENT OF USER IN AB TO RETURN
;
FACAB:
	MOV	D,B
	MVI	E,0
	LXI	H,TYPFLG
	MOV	M,E
	MVI	B,90H
	JMP	X1250
;
;FIND POS(X) ROUTINE
;
POS:
	LDA	CHRCT	;CURSOR POSITION
BAFACC:
	MOV	B,A
	XRA	A
	JMP	FACAB
;
;DEF INE FN(X) STATEMENT ROUTINE
;
DEF:
	CALL	XD02
	CALL	ERRIM
	LXI	B,DATA
	PUSH	B
	PUSH	D
	CALL	TSTBYT
	DB	'('
	CALL	FNDVAR
	CALL	TSVAR
	CALL	TSTBYT
	DB	')'	;)
	CALL	TSTBYT
	DB	0ACH	;TOKEN WHAT
	MOV	B,H
	MOV	C,L
	XTHL
	JMP	BCDEM
;
;Y = FUNCTION (X) ROUTINE
;
XCBF:
	CALL	XD02
	PUSH	D
	CALL	PARENS
	CALL	TSVAR
	XTHL
	CALL	ONSTACK
	POP	D
	CALL	ONSTACK
	POP	H
	CALL	ONSTACK
	CALL	ONSTACK
	DCX	H
	DCX	H
	DCX	H
	DCX	H
	PUSH	H
	CALL	CMPDEHL
	PUSH	D
	MVI	E,34
	JZ	DOERMS
	CALL	FMEM
	POP	H
	CALL	EXPR
	CALL	SKPSPC+1
	JNZ	SNERR2
	POP	H
	POP	D
	POP	B
BCDEM:
	MOV	M,C
	INX	H
	MOV	M,B
	JMP	DEMEM
ERRIM:
	PUSH	H
	LHLD	LINENUM
	INX	H
	MOV	A,H
	ORA	L
	POP	H
	RNZ
	MVI	E,22
	JMP	DOERMS
XD02:
	CALL	TSTBYT
	DB	9FH	;FN CODE
	MVI	A,80H
	STA	DISABL
	ORA	M
	MOV	B,A
	CALL	XB11
	JMP	TSVAR
;
;FIND STR$(X) ROUTINE
;
STR$:
	CALL	TSVAR
	CALL	FACASC
	CALL	CNTLEN
	CALL	USST
	LXI	B,XF02
	PUSH	B
XD21:
	MOV	A,M
	INX	H
	INX	H
	PUSH	H
	CALL	GSTSP
	POP	H
	MOV	C,M
	INX	H
	MOV	B,M
	CALL	SSTMP
	PUSH	H
	MOV	L,A
	CALL	XEA6
	POP	D
	RET
XD35:
	CALL	GSTSP
SSTMP:
	LXI	H,SLCTR
	PUSH	H
	MOV	M,A	;CHAR COUNT
	INX	H
;
;STORE START ADDRESS
;
DEMEM:
	INX	H
	MOV	M,E
	INX	H
	MOV	M,D
	POP	H
	RET
;
;COUNT LENGTH OF STRING
;
CNTLEN:
	DCX	H
CNTLEN1:
	MVI	B,'"'
	MOV	D,B
CNTLEN2:
	PUSH	H	;SAVE START ADR
	MVI	C,255
CNTLEN3:
	INX	H
	MOV	A,M
	INR	C
	ORA	A	;END CHARACTER
	JZ	CNTLEN4
	CMP	D
	JZ	CNTLEN4
	CMP	B
	JNZ	CNTLEN3
CNTLEN4:
	CPI	'"'
	CZ	SKPSPC
	XTHL
	INX	H
	XCHG
	MOV	A,C
	CALL	SSTMP
XD67:
	LXI	D,SLCTR
	LHLD	WKBFPT
	SHLD	FACC
	MVI	A,1
	STA	TYPFLG
	CALL	COPY4
	CALL	CMPDEHL
	SHLD	WKBFPT
	POP	H
	MOV	A,M
	RNZ
	MVI	E,30
	JMP	DOERMS
;
;PRINTS OUT MESSAGE
;
PTMSG:
	INX	H
PRMSG:
	CALL	CNTLEN
MSGOUT:
	CALL	USST
	CALL	MBCDE	;GET BCDE
	INR	E	;FROM RAM
;
;PRINT CHARACTER LOOP
;
MSGO2:
	DCR	E
	RZ
	LDAX	B
	CALL	CONOUT	;ECHO
	CPI	CR
	CZ	ZERCPOS
	INX	B
	JMP	MSGO2
GSTSP:
	ORA	A
	MVI	C,TRICK
	ORG	$-1
XD9E:
	POP	PSW
	PUSH	PSW
	LHLD	STACK	;STACK LEVEL 0
	XCHG
	LHLD	STRPTR	;END RAM
	CMA
	MOV	C,A
	MVI	B,255
	DAD	B
	INX	H
	CALL	CMPDEHL
	JC	XDB8
	SHLD	STRPTR
	INX	H
	XCHG
IGNORE:
	POP	PSW
	RET
XDB8:
	POP	PSW
	MVI	E,26	;OS ERROR
	JZ	DOERMS	;BASEX
	CMP	A
	PUSH	PSW
	LXI	B,XD9E
	PUSH	B
PACK:
	LHLD	MAXRAM
XDC7:
	SHLD	STRPTR
	LXI	H,0
	PUSH	H
	LHLD	STACK
	PUSH	H
	LXI	H,WKBUF
XDD5:
	XCHG
	LHLD	WKBFPT
	CALL	CMPDEHL-1
	LXI	B,XDD5
	JNZ	XE21
	LHLD	ENDSRC
XDE4:
	XCHG
	LHLD	ENDVAR
	CALL	CMPDEHL-1
	JZ	XDF8
	MOV	A,M
	INX	H
	INX	H
	ORA	A
	CALL	XE24
	JMP	XDE4
XDF7:
	POP	B
XDF8:
	XCHG
	LHLD	ENDARY
	CALL	CMPDEHL-1
	JZ	XE44
	CALL	MBCDE
	MOV	A,E
	PUSH	H
	DAD	B
	ORA	A
	JP	XDF7
	SHLD	ELBUF
	POP	H
	MOV	C,M
	MVI	B,0
	DAD	B
	DAD	B
	INX	H
XE15:
	XCHG
	LHLD	ELBUF
	CALL	CMPDEHL-1
	JZ	XDF8
	LXI	B,XE15
XE21:
	PUSH	B
	ORI	80H
XE24:
	MOV	A,M
	INX	H
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	RP
	ORA	A
	RZ
	MOV	B,H
	MOV	C,L
	CALL	X4A
	MOV	H,B
	MOV	L,C
	RC
	POP	H
	XTHL
	CALL	CMPDEHL
	XTHL
	PUSH	H
	MOV	H,B
	MOV	L,C
	RNC
	POP	B
	POP	PSW
	POP	PSW
	PUSH	H
	PUSH	D
	PUSH	B
	RET
XE44:
	POP	D
	POP	H
	MOV	A,L
	ORA	H
	RZ
	DCX	H
	MOV	B,M
	DCX	H
	MOV	C,M
	PUSH	H
	DCX	H
	DCX	H
	MOV	L,M
	MVI	H,0
	DAD	B
	MOV	D,B
	MOV	E,C
	DCX	H
	MOV	B,H
	MOV	C,L
	LHLD	STRPTR
	CALL	COMPCOP2
	POP	H
	MOV	M,C
	INX	H
	MOV	M,B
	MOV	L,C
	MOV	H,B
	DCX	H
	JMP	XDC7
XE69:
	PUSH	B
	PUSH	H
	LHLD	FACC
	XTHL
	CALL	X9D7
	XTHL
	CALL	TSSTR
	MOV	A,M
	PUSH	H
	LHLD	FACC
	PUSH	H
	ADD	M
	MVI	E,28
	JC	DOERMS
	CALL	XD35
	POP	D
	CALL	XEB7
	XTHL
	CALL	XEB6
	PUSH	H
	LHLD	STTAD
	XCHG
	CALL	XEA0
	CALL	XEA0
	LXI	H,X978
	XTHL
	PUSH	H
	JMP	XD67
XEA0:
	POP	H
	XTHL
	CALL	ONSTACK
	MOV	C,M
	INX	H
	MOV	B,M
	POP	H
XEA6:
	INR	L
XEA7:
	DCR	L
	RZ
	LDAX	B
	STAX	D
	INX	B
	INX	D
	JMP	XEA7
XEB0:
	CALL	TSSTR
USST:
	LHLD	FACC
XEB6:
	XCHG
XEB7:
	CALL	XED8
	XCHG
	RNZ
	PUSH	D
	MOV	D,B
	MOV	E,C
	DCX	D
	MOV	C,M
	CALL	X4A
	JNZ	XED7
	MOV	B,A
	DAD	B
	SHLD	STRPTR
XED7:
	POP	H
	RET
XED8:
	LHLD	WKBFPT
	DCX	H
	MOV	B,M
	DCX	H
	MOV	C,M
	DCX	H
	DCX	H
	CALL	CMPDEHL
	RNZ
	SHLD	WKBFPT
	RET
;
;FIND LEN(X) ROUTINE
;
LEN:
	LXI	B,BAFACC
	PUSH	B
XEDD:
	CALL	XEB0
	XRA	A
	MOV	D,A
	STA	TYPFLG
XEE0:
	MOV	A,M
	ORA	A
	RET
;
;FIND ASC(X) ROUTINE
;
ASC:
	CALL	XEDD
	JZ	FCERR	;FUNCTION CALL ERROR
	INX	H
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	LDAX	D
	JMP	BAFACC
;
;FIND CHR$(X) ROUTINE
;
CHR$:
	MVI	A,01
	CALL	XD35
	CALL	XFAE
	LHLD	STTAD
	MOV	M,E
XF02:
	POP	B
	JMP	XD67
;
;FIND LEFT$(X) ROUTINE
;
LEFT$:
	CALL	XF91
	XRA	A
XF0A:
	XTHL
	MOV	C,A
XF0C:
	PUSH	H
	MOV	A,M
	CMP	B
	JC	XF14
	MOV	A,B
	LXI	D,TRICK
	ORG	$-2
XF14:
	MVI	C,0
	PUSH	B
	CALL	GSTSP
	POP	B
	POP	H
	PUSH	H
	INX	H
	INX	H
	MOV	B,M
	INX	H
	MOV	H,M
	MOV	L,B
	MVI	B,0
	DAD	B
	MOV	B,H
	MOV	C,L
	CALL	SSTMP
	MOV	L,A
	CALL	XEA6
	POP	D
	CALL	XEB7
	JMP	XD67
;
;FIND RIGHT$(X) ROUTINE
;
RIGHT$:
	CALL	XF91
	POP	D
	PUSH	D
	LDAX	D
	SUB	B
	JMP	XF0A
;
;FIND MID$(X) ROUTINE
;
MID$:
	XCHG
	MOV	A,M
	CALL	XF94
	PUSH	B
	MVI	E,255
	CPI	')'
	JZ	XF52
	CALL	TSTBYT
	DB	','	;,
	CALL	XPRDE
XF52:
	CALL	TSTBYT
	DB	')'	;)
	POP	PSW
	XTHL
	LXI	B,XF0C
	PUSH	B
	DCR	A
	CMP	M
	MVI	B,0
	RNC
	MOV	C,A
	MOV	A,M
	SUB	C
	CMP	E
	MOV	B,A
	RC
	MOV	B,E
	RET
;
;WAIT STATEMENT ROUTINE
;
WAIT:
	CALL	GETPRT
	PUSH	PSW
	MVI	E,0
	CALL	SKPSPC+1
	JZ	WAIT2
	CALL	TSTBYT
	DB	','
	CALL	XPRDE
	JMP	WAIT2
XF91:
	XCHG
	CALL	TSTBYT
	DB	')'	;)
XF94:
	POP	B
	POP	D
	PUSH	B
	MOV	B,E
	INR	B
	DCR	B
	RNZ
	JMP	FCERR	;FUNCTION CALL ERROR
GETPRT:
	CALL	XPRDE
	STA	XF89+1
	STA	XF75+1
	CALL	TSTBYT
	DB	','	;,
	JMP	XPRDE
SXPRDE:
	CALL	SKPSPC
XPRDE:
	CALL	EXPR
XFAE:
	CALL	FACDEP
	MOV	A,D
	ORA	A
	JNZ	FCERR	;CF ERROR
	CALL	SKPSPC+1
	MOV	A,E
	RET
;
;FIND VAL(X) ROUTINE
;
VAL:
	CALL	XEDD
	JZ	ZFEXP
	MOV	E,A
	INX	H
	INX	H
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A
	PUSH	H
	DAD	D
	MOV	B,M
	MOV	M,D
	XTHL
	PUSH	B
	MOV	A,M
	CALL	ASCFAC
	POP	B
	POP	H
	MOV	M,B
	RET
;
;FIND PEEK(X) ROUTINE
;
PEEK:
	CALL	FACCSN
	CALL	CP2INT
	LDAX	D
	JMP	BAFACC
;
;POKE I,J STATEMENT ROUTINE
;
POKE:
	CALL	EXPR
	CALL	FACCSN
	CALL	CP2INT
	PUSH	D
	CALL	TSTBYT
	DB	','	;,
	CALL	XPRDE
	POP	D
	STAX	D
	RET
CP2INT:
	JM	FACCDE
	LDA	FACC+3
	CPI	91H
	JMP	X640
XFE6:
	LXI	H,TBLSQR1
XFE9:
	CALL	MBCDE	;LOAD BCDE
	JMP	XFF8
XFEF:
	CALL	MBCDE	;LOAD BCDE
	LXI	H,TRICK
	ORG	$-2
;
;FLOATING POINT SUBSTRACT
;
FMINUS:
	POP	B
	POP	D
XFF5:
	CALL	REVFAC	;GET ABS(X)
XFF8:
	MOV	A,B
	ORA	A
	RZ
	LDA	FACC+3
	ORA	A
	JZ	BCDEF
	SUB	B
	JNC	X1012
	CMA
	INR	A
	XCHG
	CALL	FACSTK
	XCHG
	CALL	BCDEF
	POP	B
	POP	D
X1012:
	CPI	19H
	RNC
	PUSH	PSW
	CALL	X129D
	MOV	H,A
	POP	PSW
	CALL	SHFACL
	ORA	H
	LXI	H,FACC
	JP	X1038
	CALL	ADMCDE
	JNC	X107E
	INX	H
	INR	M
	JZ	OVERR
	MVI	L,1
	CALL	X10D5
	JMP	X107E
X1038:
	XRA	A
	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
X1046:
	CC	X10AB
X1049:
	MOV	L,B
	MOV	H,E
	XRA	A
X104C:
	MOV	B,A
	MOV	A,C
	ORA	A
	JNZ	X106B
	MOV	C,D
	MOV	D,H
	MOV	H,L
	MOV	L,A
	MOV	A,B
	SUI	8
	CPI	0E0H
	JNZ	X104C
ZFEXP:
	XRA	A
SFEXP:
	STA	FACC+3
	RET
FNORM:
	DCR	B
	DAD	H
	MOV	A,D
	RAL
	MOV	D,A
	MOV	A,C
	ADC	A
	MOV	C,A
X106B:
	JP	FNORM
	MOV	A,B
	MOV	E,H
	MOV	B,L
	ORA	A
	JZ	X107E
	LXI	H,FACC+3
	ADD	M
	MOV	M,A
	JNC	ZFEXP
	RZ
X107E:
	MOV	A,B
X107F:
	LXI	H,FACC+3
	ORA	A
	CM	X1090
	MOV	B,M
	INX	H
	MOV	A,M
	ANI	80H
	XRA	C
	MOV	C,A
	JMP	BCDEF
X1090:
	INR	E
	RNZ
	INR	D
	RNZ
	INR	C
	RNZ
	MVI	C,80H
	INR	M
	RNZ
;
;OVERFLOW ERROR
;
OVERR:
	MVI	E,10
	JMP	DOERMS
ADMCDE:
	MOV	A,M
	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
X10AB:
	LXI	H,X243
	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
SHFACL:
	MVI	B,0
SHFL2:
	SUI	8
	JC	SHFL3
	MOV	B,E
	MOV	E,D
	MOV	D,C
	MVI	C,0
	JMP	SHFL2
SHFL3:
	ADI	09
	MOV	L,A
SHFL4:
	XRA	A
	DCR	L
	RZ
	MOV	A,C
X10D5:
	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	SHFL4
;
;LOG CONSTANTS TABLE
;
TBLOG1:
	DB	0,0,0,81H
;
;LOG CONSTANTS TABLE B
;
TBLOG2:
	DB	3,0AAH,56H,19H
	DB	80H,0F1H,22H,76H
	DB	80H,45H,0AAH,38H
	DB	82H
;
;FIND LOG(X) ROUTINE
;
LOG:
	CALL	FACCSN
	JPE	FCERR
	LXI	H,FACC+3
	MOV	A,M
	LXI	B,8035H
	LXI	D,4F3H
	SUB	B
	PUSH	PSW
	MOV	M,B
	PUSH	D
	PUSH	B
	CALL	XFF8
	POP	B
	POP	D
	INR	B
	CALL	X1190
	LXI	H,TBLOG1
	CALL	XFEF
	LXI	H,TBLOG2
	CALL	X1570
	LXI	B,8080H
	LXI	D,0
	CALL	XFF8
	POP	PSW
	CALL	X13BC
X1129:
	LXI	B,8031H
	LXI	D,7218H
	LXI	H,TRICK
	ORG	$-2
FMULT:
	POP	B
	POP	D
X1132:
	CALL	FACCSN
	RZ
	MVI	L,0
	CALL	X1200
	MOV	A,C
	STA	X1168+1
	XCHG
	SHLD	X1163+1
	LXI	B,0
	MOV	D,B
	MOV	E,B
	LXI	H,X1049
	PUSH	H
	LXI	H,X1152
	PUSH	H
	PUSH	H
	LXI	H,FACC
X1152:
	MOV	A,M
	INX	H
	ORA	A
	JZ	X117D
	PUSH	H
	XCHG
	MVI	E,8
	JMP	X115C	;MULT LOOP
X117D:
	MOV	B,E
	MOV	E,D
X117F:
	MOV	D,C
	MOV	C,A
	RET
X1182:
	CALL	FACSTK
	LXI	B,8420H
	LXI	D,0
	CALL	BCDEF
;
;FLOATING POINT DIVIDE
;
FDIV:
	POP	B
	POP	D
X1190:
	CALL	FACCSN
	JZ	DIVERR
	MVI	L,255
	CALL	X1200
	INR	M
	INR	M
	DCX	H
	MOV	A,M
	STA	X11BE+1
	DCX	H
	MOV	A,M
	STA	X11BA+1
	DCX	H
	MOV	A,M
	STA	X11B6+1
	MOV	B,C
	XCHG
	XRA	A
	MOV	C,A
	MOV	D,A
	MOV	E,A
	STA	X11C1+1
	JMP	X11B3	;DIVIDE LOOP
X1200:
	MOV	A,B
	ORA	A
	JZ	X1222
	MOV	A,L
	LXI	H,FACC+3
	XRA	M
	ADD	B
	MOV	B,A
	RAR
	XRA	B
	MOV	A,B
	JP	X1221
	ADI	80H
	MOV	M,A
	JZ	X117B
	CALL	X129D
	MOV	M,A
	DCX	H
	RET
X121E:
	CALL	FACCSN
	CMA
	POP	H
X1221:
	ORA	A
X1222:
	POP	H
	JP	ZFEXP
	JMP	OVERR
X1229:
	CALL	FBCDE
	MOV	A,B
	ORA	A
	RZ
	ADI	2
	JC	OVERR
	MOV	B,A
	CALL	XFF8
	LXI	H,FACC+3
	INR	M
	RNZ
	JMP	OVERR
FACCSN:
	LDA	FACC+3
	ORA	A
	RZ
X1240:
	LDA	FACC+2
	CPI	TRICK	;SKIP CMA INST
	ORG	$-1
X1244:
	CMA
	RAL
X1246:
	SBB	A
	RNZ
	INR	A
	RET
;
;FIND SGN(X) ROUTINE
;
SGN:
	CALL	FACCSN
X124B:
	MVI	B,88H	;EXP BYTE
	LXI	D,0	;LOWER BYTES
X1250:
	LXI	H,FACC+3	;MSB BYTE
	MOV	C,A
	MOV	M,B
	MVI	B,0
	INX	H
	MVI	M,80H
	RAL
	JMP	X1046
;
;FIND ABS(X) ROUTINE
;
ABS:
	CALL	FACCSN
	RP
REVFAC:
	LXI	H,FACC+2
	MOV	A,M
	XRI	80H
	MOV	M,A
	RET
;
;INSERT FLOATING POINT ACCUM IN STACK
;
FACSTK:
	XCHG
	LHLD	FACC
	XTHL
	PUSH	H
	LHLD	FACC+2
	XTHL
	PUSH	H
	XCHG
	RET
;
;STORE DATA IN FLOATING POINT ACCUM.
;
MEMFAC:
	CALL	MBCDE
BCDEF:
	XCHG
	SHLD	FACC
	MOV	H,B
	MOV	L,C
	SHLD	FACC+2
	XCHG
	RET
;
;LOAD BCDE FROM FLOATING POINT ACCUM
;
FBCDE:
	LXI	H,FACC
MBCDE:
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	MOV	C,M
	INX	H
	MOV	B,M
X128D:
	INX	H
	RET
;
;STORE FLOATING POINT ACCUM AT HL ADR
;
FMEM:
	LXI	D,FACC
COPY4:
	MVI	B,4
COPMEM:
	LDAX	D
	MOV	M,A
	INX	D
	INX	H
	DCR	B
	JNZ	COPMEM
	RET
X129D:
	LXI	H,FACC+2
	MOV	A,M
	RLC
	STC
	RAR
	MOV	M,A
	CMC
	RAR
	INX	H
	INX	H
	MOV	M,A
	MOV	A,C
	RLC
	STC
	RAR
	MOV	C,A
	RAR
	XRA	M
	RET
X12B2:
	MOV	A,B
	ORA	A
	JZ	FACCSN
	LXI	H,X1244
	PUSH	H
	CALL	FACCSN
	MOV	A,C
	RZ
	LXI	H,FACC+2
	XRA	M
	MOV	A,C
	RM
	CALL	X12CA
	RAR
	XRA	C
	RET
X12CA:
	INX	H
	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
X12DD:
	MOV	B,A
	MOV	C,A
	MOV	D,A
	MOV	E,A
	ORA	A
	RZ
	PUSH	H
	CALL	FBCDE
	CALL	X129D
	XRA	M
	MOV	H,A
	CM	X1301
	MVI	A,98H
	SUB	B
	CALL	SHFACL
	MOV	A,H
	RAL
	CC	X1090
	MVI	B,0
	CC	X10AB
	POP	H
	RET
X1301:
	DCX	D
	MOV	A,D
	ANA	E
	INR	A
	RNZ
	DCR	C
	RET
;
;FIND INT(X) ROUTINE
;
INT:
	LXI	H,FACC+3
	MOV	A,M
	CPI	98H
	LDA	FACC
	RNC
	MOV	A,M
	CALL	X12DD
	MVI	M,98H
	MOV	A,E
	PUSH	PSW
	MOV	A,C
	RAL
	CALL	X1046
	POP	PSW
	RET
MLT16:
	LXI	H,0
	MOV	A,B
	ORA	C
	RZ
	MVI	A,10H
MLT161:
	DAD	H
	JC	BSERR
	XCHG
	DAD	H
	XCHG
	JNC	MLT162
	DAD	B
	JC	BSERR
MLT162:
	DCR	A
	JNZ	MLT161
	RET
;
;CONVERT NUMBER TO FLOATING POINT
;
ASCFAC:
	CPI	'-'	;- SIGN
	PUSH	PSW
	JZ	ASCF1
	CPI	'+'	;+ SIGN
	JZ	ASCF1
	DCX	H
ASCF1:
	CALL	ZFEXP
	MOV	B,A
	MOV	D,A
	MOV	E,A
	CMA
	MOV	C,A
ASCF2:
	CALL	SKPSPC
	JC	EVNUM
	CPI	'.'	;. POINT
	JZ	ASCF4
	CPI	'E'	;E EXPONENT
	JNZ	ASCF5
	CALL	SKPSPC
	PUSH	H
	LXI	H,ASCF3
	XTHL
	DCR	D
	CPI	0A5H	;- TOKEN
	RZ
	CPI	'-'	;- SIGN
	RZ
	INR	D
	CPI	'+'	;+ SIGN
	RZ
	CPI	0A4H	;+ TOKEN
	RZ
	POP	PSW
	DCX	H
ASCF3:
	CALL	SKPSPC
	JC	X13C7
	INR	D
	JNZ	ASCF5
	XRA	A
	SUB	E
	MOV	E,A
	INR	C
ASCF4:
	INR	C
	JZ	ASCF2
ASCF5:
	PUSH	H
	MOV	A,E
	SUB	B
ASCF6:
	CP	X139D
	JP	ASCF7
	PUSH	PSW
	CALL	X1182
	POP	PSW
	INR	A
ASCF7:
	JNZ	ASCF6
	POP	D
	POP	PSW
	CZ	REVFAC
	XCHG
	RET
X139D:
	RZ
X139E:
	PUSH	PSW
	CALL	X1229
	POP	PSW
	DCR	A
	RET
EVNUM:
	PUSH	D
	MOV	D,A
	MOV	A,B
	ADC	C
	MOV	B,A
	PUSH	B
	PUSH	H
	PUSH	D
	CALL	X1229
	POP	PSW
	SUI	'0'
	CALL	X13BC
	POP	H
	POP	B
	POP	D
	JMP	ASCF2
X13BC:
	CALL	FACSTK
	CALL	X124B
FPLUS:
	POP	B
	POP	D
	JMP	XFF8
X13C7:
	MOV	A,E
	RLC
	RLC
	ADD	E
	RLC
	ADD	M
	SUI	'0'
	MOV	E,A
	JMP	ASCF3
;
;PRINT 'IN ' MESSAGE
;
PRNTIN:
	PUSH	H	;LINE #
	LXI	H,MSGIN	;IN MESS ADR
	CALL	PRMSG	;PRINT 'IN '
	POP	H	;LINE #
PRNTLN:
	XCHG
	XRA	A
	MVI	B,98H	;EXP BYTE
	CALL	X1250
	LXI	H,PTMSG
	PUSH	H
FACASC:
	LXI	H,ASCBF
	PUSH	H
	CALL	FACCSN
	MVI	M,' '	;SPACE
	JP	FACPL
	MVI	M,'-'	;- SIGN
FACPL:
	INX	H
	MVI	M,'0'	;'0' ASCII
	JZ	X149B
	PUSH	H
	CM	REVFAC
	XRA	A
	PUSH	PSW
	CALL	X14A1
X1401:
	LXI	B,9143H
	LXI	D,4FF8H
	CALL	X12B2
	JPO	X141E
	POP	PSW
	CALL	X139E
	PUSH	PSW
	JMP	X1401
X1415:
	CALL	X1182
	POP	PSW
	INR	A
	PUSH	PSW
	CALL	X14A1
X141E:
	CALL	XFE6
	INR	A
	CALL	X12DD
	CALL	BCDEF
	LXI	B,306H	;#DIGITS IN ANS
	POP	PSW
	ADD	C
	INR	A
	JM	X1439
	CPI	8
	JNC	X1439
	INR	A
	MOV	B,A
	MVI	A,2
X1439:
	DCR	A
	DCR	A
	POP	H
	PUSH	PSW
	LXI	D,TBLSQR2
X143F:
	DCR	B
	JNZ	X1440
	MVI	M,'.'
	INX	H
	MVI	M,'0'
	INX	H
X1440:
	DCR	B
	MVI	M,'.'
	CZ	X128D
	PUSH	B
	PUSH	H
	PUSH	D
	CALL	FBCDE	;FLOATAC TO BCDE
	POP	H
	MVI	B,'0'-1
X144E:
	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	X144E
	CALL	ADMCDE
	INX	H
	CALL	BCDEF
	XCHG
	POP	H
	MOV	M,B
	INX	H
	POP	B
	DCR	C
	JNZ	X1440
	DCR	B
	JZ	EXPASC
X1473:
	DCX	H
	MOV	A,M
	CPI	'0'	;ZERO
	JZ	X1473
	CPI	'.'	;E	EXPONENT
	CNZ	X128D
EXPASC:
	POP	PSW
	JZ	EXP0ASC
	MVI	M,'E'
	INX	H
	MVI	M,'+'	;+ SIGN
	JP	EXPPASC
	MVI	M,'-'	;- SIGN
	CMA
	INR	A
EXPPASC:
	MVI	B,'0'-1
EXPASC2:
	INR	B
	SUI	10
	JNC	EXPASC2
	ADI	'9'+1
	INX	H
	MOV	M,B
X149B:
	INX	H
	MOV	M,A
	INX	H
EXP0ASC:
	MOV	M,C
	POP	H
	RET
X14A1:
	LXI	B,9474H
	LXI	D,23F7H
	CALL	X12B2
	POP	H
	JPO	X1415
	PCHL
;
;SQUARE ROOT TABLES
;
TBLSQR1:
	DB	0,0,0,80H
TBLSQR2:
	DB	0A0H,86H,1,10H
	DB	27H,0,0E8H,3
	DB	0,64H,0,0
	DB	0AH,0,0,1
	DB	0,0
LDNAF:
	LXI	H,REVFAC
	XTHL
	PCHL
;
;FIND SQR(X) ROUTINE
;
SQR:
	CALL	FACSTK
	LXI	H,TBLSQR1
	CALL	MEMFAC
FEXP:
	POP	B
	POP	D
	CALL	FACCSN
	JZ	EXP
	MOV	A,B
	ORA	A
	JZ	SFEXP
	PUSH	D
	PUSH	B
	MOV	A,C
	ORI	7FH
	CALL	FBCDE
	JP	X14F7
	PUSH	D
	PUSH	B
	CALL	INT
	POP	B
	POP	D
	PUSH	PSW
	CALL	X12B2
	POP	H
	MOV	A,H
	RAR
X14F7:
	POP	H
	SHLD	FACC+2
	POP	H
	SHLD	FACC
	CC	LDNAF
	CZ	REVFAC
	PUSH	D
	PUSH	B
	CALL	LOG
	POP	B
	POP	D
	CALL	X1132
;
;FIND EXP(X) ROUTINE
;
EXP:
	CALL	FACSTK
	LXI	B,8138H
	LXI	D,0AA3BH
	CALL	X1132
	LDA	FACC+3
	CPI	88H
	JNC	X121E
	CALL	INT
	ADI	80H
	ADI	2
	JC	X121E
	PUSH	PSW
	LXI	H,TBLOG1
	CALL	XFE9
	CALL	X1129
	POP	PSW
	POP	B
	POP	D
	PUSH	PSW
	CALL	XFF5
	CALL	REVFAC
	LXI	H,TBLEXP
	CALL	X157F
	LXI	D,0
	POP	B
	MOV	C,D
	JMP	X1132
;
;EXPONENTIAL TABLE
;
TBLEXP:
	DB	8,40H,2EH,94H
	DB	74H,70H,4FH,2EH
	DB	77H,6EH,2,88H
	DB	7AH,0E6H,0A0H,2AH
	DB	7CH,50H,0AAH,0AAH
	DB	7EH,0FFH,0FFH,7FH
	DB	7FH,0,0,80H
	DB	81H,0,0,0
	DB	81H
X1570:
	CALL	FACSTK
	LXI	D,FMULT
	PUSH	D
	PUSH	H
	CALL	FBCDE
	CALL	X1132
	POP	H
X157F:
	CALL	FACSTK
	MOV	A,M
	INX	H
	CALL	MEMFAC
	MVI	B,TRICK
	ORG	$-1
X1588:
	POP	PSW
	POP	B
	POP	D
	DCR	A
	RZ
	PUSH	D
	PUSH	B
	PUSH	PSW
	PUSH	H
	CALL	X1132
	POP	H
	CALL	MBCDE
	PUSH	H
	CALL	XFF8
	POP	H
	JMP	X1588
;
;FIND RND(X)	RANDOM NUMBER ROUTINE
;
RND:
	CALL	FACCSN
	JM	X15BD
	LXI	H,RNDVAL	;LOAD SEED ADR
	CALL	MEMFAC
	RZ
	LXI	B,9835H
	LXI	D,447AH
	CALL	X1132
	LXI	B,6828H
	LXI	D,0B146H
	CALL	XFF8
X15BD:
	CALL	FBCDE
	MOV	A,E
	MOV	E,C
	MOV	C,A
	MVI	M,80H
	DCX	H
	MOV	B,M
	MVI	M,80H
	CALL	X1049
	LXI	H,RNDVAL	;LOAD SEED ADR
	JMP	FMEM	;STORE ACCUM
;
;FIND COS(X) ROUTINE
;
COS:
	LXI	H,TBLCOS1
	CALL	XFE9
;
;FIND SIN(X) ROUTINE
;
SIN:
	CALL	FACSTK
	LXI	B,8349H
	LXI	D,0FDBH
	CALL	BCDEF
	POP	B
	POP	D
	CALL	X1190
	CALL	FACSTK
	CALL	INT
	POP	B
	POP	D
	CALL	XFF5
	LXI	H,TBLSIN1
	CALL	XFEF
	CALL	FACCSN
	STC
	JP	X1608
	CALL	XFE6
	CALL	FACCSN
	ORA	A
X1608:
	PUSH	PSW
	CP	REVFAC
	LXI	H,TBLSIN1
	CALL	XFE9
	POP	PSW
	CNC	REVFAC
	LXI	H,TBLSIN2
	JMP	X1570
;
;COSINE CONSTANT TABLE
;
TBLCOS1:
	DB	0DBH,0FH,49H,81H
;
;SINE COSINE CONSTANTS TABLE
;
TBLSIN1:
	DB	0,0,0,127
TBLSIN2:
	DB	5,0BAH,0D7H,1EH
	DB	86H,64H,26H,99H
	DB	87H,58H,34H,23H
	DB	87H,0E0H,5DH,0A5H
	DB	86H,0DAH,0FH,49H
	DB	83H
;
;FIND TAN(X) ROUTINE
;
TAN:
	CALL	FACSTK
	CALL	SIN
	POP	B
	POP	H
	CALL	FACSTK
	XCHG
	CALL	BCDEF
	CALL	COS
	JMP	FDIV
;
;FIND ATN(X) ROUTINE
;
ATN:
	CALL	FACCSN
	CM	LDNAF
	CM	REVFAC
	LDA	FACC+3
	CPI	81H
	JC	X889
	LXI	B,8100H
	MOV	D,C
	MOV	E,C
	CALL	X1190
	LXI	H,XFEF
	PUSH	H
X889:
	LXI	H,TBLTAN
	CALL	X1570
	LXI	H,TBLCOS1
	RET
;
;ARCTANGENT CONSTANTS TABLE
;
TBLTAN:
	DB	9,4AH,0D7H,3BH
	DB	78H,2,6EH,84H
	DB	7BH,0FEH,0C1H,2FH
	DB	7CH,74H,31H,9AH
	DB	7DH,84H,3DH,5AH
	DB	7DH,0C8H,7FH,91H
	DB	7EH,0E4H,0BBH,4CH
	DB	7EH,6CH,0AAH,0AAH
	DB	7FH,0,0,0
	DB	81H
;
;COLD START UP LOCATION
;
START:
	MVI	M,23	;E=23,BASIC FLAG
	SHLD	INFLG	;SAVE FOR LATER
	MOV	A,L	;GET LO BYTE FOR COMPARE
	LXI	H,BASFL	;POINT AT CRT OUTPUT FLAG
	MVI	M,0	;SET IT TO CRT MODE
	CPI	KEYFL AND 255	;IS IT KEYBOARD
	JZ	$+5	;NOT KEYBOARD
	MVI	M,14	;SETUP PORT 1 OUTPUT
	LXI	H,XROM
	LXI	D,SRAM+2
MOVIT:
	MOV	A,M
	STAX	D
	INX	D
	INX	H
	MOV	A,L
	SUI	RAMEND AND 255
	JNZ	MOVIT
	LHLD	KERDY	;CLEAR KEY FLAG
	MOV	M,A
	RET
MCR:
	CALL	CRLF	;PRETEND USER TYPED CR
ALLMEM:
	LXI	H,XRAM	;START OF USER RAM
TESTM:
	INX	H
	MOV	A,M	;GET NEXT MEMORY BYTE
	CMA		;CHANGE IT
	MOV	M,A	;WRITE MEMORY
	CMP	M	;DID IT WRITE ?
	CMA		;GET ORGINAL BYTE BACK
	MOV	M,A	;RESTORE MEMORY
	JZ	TESTM	;DO IT AGAIN
	DCX	H	;THAT MEMORY WAS BAD
	JMP	RAM8K	;THIS IS TOP OF GOOD MEMORY
INIT:
	MVI	A,5AH	;SETUP AUTO INIT FLAG
	STA	ASCBF
	LXI	H,KEYFL	;PRETEND WE ARE THE KEYBOARD
	CALL	START
	JMP	X1691
INITOF:
	XRA	A	;CLEAR AUTO INIT FLAG
	STA	ASCBF
X1691:
	LXI	H,-1
	SHLD	LINENUM
	LXI	H,WKBUF
	SHLD	WKBFPT
;
;SET HL TO AUTHOR MESSAGE
;
X16A2:
	LXI	H,M8001
	CALL	PRMSG	;ECHO ISC 8001
	LDA	ASCBF	;IS THIS POWERUP ?
	CPI	5AH
	JZ	MCR	;YES, USE ALL AVAILABLE MEMORY
	CALL	READLN	;SETUP INPUT FLAG AND RETURN
	INX	H
	MOV	A,M
	ORA	A
	JZ	ALLMEM
;
;SET HL TO LINE BUFFER
;
	CALL	TOBINY	;INPUT END OF RAM
	ORA	A
	JNZ	X16A2	;SN ERROR
	XCHG
	LXI	D,07FFFH	;FIGURE IS RAM AFTER START
	DAD	D
	JC	ALLMEM	;TOO MUCH
	MOV	A,M
	CMA
	MOV	M,A
	CMP	M
	CMA
	MOV	M,A	;RESTORE BYTE
	JNZ	ALLMEM
;
;HL = END OF RAM
;
RAM8K:
	LXI	D,-50	;-50
	SHLD	MAXRAM	;STORE END
	SHLD	STRPTR	;STORE END
	DAD	D	;HL-50
	SPHL		;LEVEL 0 STACK
	SHLD	STACK	;SAVE FOR RESTA
;
;LOAD DE WITH START OF RAM
;
	LXI	D,XRAM
	XCHG
	XRA	A
	MOV	M,A	;A=0
	INX	H
	SHLD	STRTSRC	;START OF RAM
	MOV	M,A
	INX	H
	MOV	M,A
	INX	H
	SHLD	ENDSRC
	MVI	A,97H
	STA	PUP
	CALL	TSTOM	;ST RAM<SP-38?
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	CALL	PRNTLN	;CAL BYT FREE
	LXI	H,MBYTE
	CALL	PRMSG	;ECHO MESS
	CALL	CLRPTR	;NEW ROUTINE
	JMP	PMPLIN
MBYTE:
	DB	' BYTES FRE'
	DB	0C5H,0
M8001:
	DB	6,1,14,11,'DISK BASIC 8001 '
	DB	29,19,'V6.78 COPYRIGHT (C)'
	DB	21,' BY COMPUCOLOR'
	DB	LF,11,13
MMEMO:
	DB	18,'MAXIMUM RAM AVAILABLE'
	DB	' ?',0
;
; 'BASIC' INTERFACE TO FCS - VERSION 1.0
;
; COPYRIGHT (C) 1977
;
; BY INTELLIGENT SYSTEMS CORPORATION
;
; PROGRAMMED BY JIM RIEDER
;
; CONSTANTS :
;
ESYN	EQU	09H
EFNF	EQU	42
;
; EXTERNAL VARIABLE REFERENCES :
;
FNAM	EQU	FPB+2
FTYP	EQU	FPB+8
FLAD	EQU	FPB+11H
FSAD	EQU	FPB+13H
FHAN	EQU	FPB+1AH
FXBC	EQU	FPB+22H
LOAD:
	CALL	BSUB
	PUSH	H	;SAVE END PNTR
	JZ	LARY	;LOAD ARRAYS
	JM	LDAT	;LOAD DATA
	POP	D	;GET END PNTR
	LXI	H,IOBUF	;POINT TO INPUT BUFFER
	MVI	M,':'	;CAUSE "READY" IF NO MORE
BL02:
	INX	D
	INX	H
	LDAX	D	;GET NEXT CHAR.
	MOV	M,A	;STORE IN INPUT BUFFER
	ANA	A	;END OF LINE ?
	JNZ	BL02	;NO: LOOP
	LHLD	STRTSRC	;GET START PNTR
	PUSH	H	;SAVE IT
	CALL	BR1	;READ THE FILE
	POP	D	;GET START PNTR
	LHLD	FXBC	;GET NO. BYTES READ
	DAD	D	;COMPUTE END PNTR
	LDA	IOBUF+1
	CPI	89H	;RUN TOKEN VALUE
	JZ	LSTOR
	ANA	A
	JZ	LSTOR
	XCHG
	POP	H
	LHLD	ENDSRC
	CALL	CMPDEHL
	JC	OMERR
	JMP	LSTOR+3
LSTOR:
	SHLD	ENDSRC	;STORE END PNTR
	LXI	H,-1
	SHLD	LINENUM	;SET LINE NUMBER
	LXI	H,LINBF	;POINT TO INPUT BUFFER
	JMP	LINEIN+3	;EXECUTE REST OF LINE
LARY:
	CALL	FARY	;FIND ARRAY
	JMP	CMLO1	;GO READ ARRAY
LDAT:
	LHLD	MAXRAM	;GET END OF MEMORY ADDRESS
	INX	H	;ADJUST IT
	XCHG		;PUT INTO D&E
	LXI	H,0	;SET UPPER LIMIT
CMLO1:
	CALL	BR2	;READ THE FILE
	JMP	CMEX	;THAT'S ALL
SAVE:
	CALL	BSUB	;PARSE FILENAME
	PUSH	H	;SAVE END PNTR
	JZ	SARY	;SAVE ARRAYS
	JM	SDAT	;SAVE DATA
	LHLD	STRTSRC	;GET START PNTR
	XCHG		;PUT INTO D&E
	LHLD	ENDSRC	;GET END PNTR
	JMP	CMSA1	;
SARY:
	CALL	FARY	;FIND ARRAY
CMSA1:
	CALL	SUBHD	;COMPUTE BYTE COUNT
	MOV	B,H	;MOVE IT ...
	MOV	C,L	;... TO B&C
	JMP	CMSA2	;
SDAT:
	LHLD	MAXRAM	;GET END OF MEMORY PNTR
	INX	H	;ADJUST IT
	MOV	C,M	;GET BYTE ...
	INX	H	;... COUNT ...
	MOV	B,M	;...
	DCX	H	;
	XCHG		;PUT PNTR INTO D&E
	INX	B	;ADJUST ...
	INX	B	;... BYTE COUNT
CMSA2:
	LHLD	STRTSRC
	SHLD	FLAD	;SET ZERO LOAD ADDRESS
	LHLD	ENDSRC
	SHLD	FSAD	;SET ZERO START ADDRESS
	CALL	WF2	;WRITE THE FILE
	JC	BER1	;ERROR
CMEX:
	POP	H	;RESTORE END STRING PNTR
	JMP	SKPSPC+1	;RETURN TO BASIC
BR1:
	XCHG		;D&E = START PNTR
	LXI	H,-28
	DAD	SP
BR2:
	CALL	SUBHD	;H&L = MAX. BYTES AVAILABLE
	MOV	B,H	;MOVE IT ...
	MOV	C,L	;... TO B&C
	CALL	RF2	;READ THE FILE
	JC	BER1	;ERROR
	RET		;RETURN TO CALLER
BSUB:
	CALL	EVAL
	PUSH	H
	CALL	XEDD
	JZ	SNERR2	;SN ERROR
	INX	H
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	LXI	H,DBFE
	MOV	B,A
	MVI	A,20
	CMP	B
	JC	BER2
BS01:
	LDAX	D
	MOV	M,A
	INX	H
	INX	D
	DCR	B
	JNZ	BS01	;NO: LOOP
	MVI	M,0
	LXI	H,DBFE
	LXI	D,FPB
	LXI	B,TTAB
	CALL	PFSPC
	JC	BER1
	CALL	SPNOR
BS02:
	MVI	B,ESYN
	JNZ	BER1
	LXI	D,TTAB	;POINT TO TYPE TABLE
	MVI	C,2	;SET COUNTER
BS05:
	LXI	H,FTYP	;POINT TO FILE TYPE
	MVI	B,3	;SET COUNTER
BS06:
	LDAX	D	;GET CHAR. FROM TABLE
	INX	D
	CMP	M	;MATCH ?
	INX	H
	JZ	BS08	;YES
	DCR	B	;ADJUST COUNTER
BS07:
	INX	D	;SKIP TO ...
	DCR	B	;... NEXT ...
	JNZ	BS07	;... ENTRY
	DCR	C	;ANY MORE ?
	JP	BS05	;YES: TRY NEXT ONE
	MVI	B,15	;INVALAD TYPE
	JMP	BER1	;PRINT ERROR MESSAGE
BS08:
	DCR	B	;HAVE ALL 3 MATCHED ?
	JNZ	BS06	;NO: CHECK NEXT
	POP	H	;RESTORE END PNTR
	DCR	C	;TEST TYPE CODE
	RET		;RETURN TO CALLER
FARY:
	LHLD	FNAM	;GET 1ST TWO CHAR. OF NAME
	MOV	C,L	;C=1ST CHAR.
	MOV	B,H	;B=2ND CHAR.
	MVI	A,32	;SET SPACE
	XRA	B	;IS 2ND CHAR. A SPACE ?
	JNZ	FA01	;NO: LEAVE IT ALONE
	MOV	B,A	;SET 2ND CHAR. = ZERO
FA01:
	LHLD	ENDVAR	;GET ARRAY START POINTER
	MVI	A,TRICK
	ORG	$-1
FA02:
	DAD	D	;STEP TO NEXT ARRAY
	XCHG		;D&E=START PNTR
	LHLD	ENDARY	;GET ARRAY END POINTER
	CALL	CMPDH	;ANY MORE ARRAYS ?
	JC	FA03	;YES: TRY NEXT ONE
	MVI	B,EFNF
BER1:
	CALL	EMESS
	LXI	H,FHAN	;POINT TO FHANDLER
	MVI	A,-4	;SET "OFF" FUNCTION
	CALL	CHDLR	;CALL HANDLER
BER2:
	MVI	E,36	;SAVE LOAD ERROR = SL
	JMP	DOERMS	;ERROR RET TO BASIC
FA03:
	XCHG		;H&L=ARRAY POINTER
	MOV	A,M	;GET 2ND CHAR. OF NAME
	INX	H
	XRA	B	;XOR WITH 2ND CHAR.
	MOV	D,A	;COPY RESULT
	MOV	A,M	;GET 1ST CHAR. OF NAME
	INX	H
	XRA	C	;XOR WITH 1ST CHAR.
	ORA	D	;OR WITH PREVIOUS RESULT
	MOV	E,M	;GET LOBYTE OF BYTE COUNT
	INX	H
	MOV	D,M	;GET HIBYTE OF BYTE COUNT
	INX	H
	JNZ	FA02	;NO MATCH: TRY NEXT ONE
	XCHG		;D&E PNTS TO NO. OF DIMEMSIONS
	DAD	D	;H&L PNTS TO END
	LDAX	D	;GET NUMBER OF DIMENSIONS
	INX	D
FA04:
	INX	D	;SKIP OVER ...
	INX	D	;... DIMENSION
	DCR	A	;IS THAT ALL ?
	JNZ	FA04	;NO: SKIP ANOTHER
	RET		;RETURN TO CALLER
TTAB:
	DB	'BAS'
	DB	'ARY'
	DB	'DAT'
USER1:
	CALL	CP2INT
	CALL	USER
	MOV	A,D
	MOV	B,E
	JMP	FACAB
XROM	EQU	$
XSET	EQU	SRAM+2-$
INFLG	EQU	SRAM
USER	EQU	$+XSET
	JMP	POPHRT-1	;FUNCTION CALL ERROR
ADR4	EQU	$+XSET
	JMP	BASOUT	;LIST OUTPUT FUNCTION
CHRCT	EQU	$+XSET
	DB	0
NOCHA	EQU	$+XSET
	DB	64
PJUMP:	EQU	$+XSET
	JMP	PJUMP
;
;RANDOM SEED VALUE MUST BE IN RAM
;
RNDVAL	EQU	$+XSET
	DB	52H,0C7H,4FH,80H
;
;FIND INP(X) ROUTINE
;
INP	EQU	$+XSET
	CALL	XFAE
	STA	XF6D+1
XF6D	EQU	$+XSET
	IN	00
	JMP	BAFACC
;
;OUT STATEMENT ROUTINE
;
OUTSTMT	EQU	$+XSET
	CALL	GETPRT
XF75	EQU	$+XSET
	OUT	00	;VARIABLE OUTPU
	RET
;
;GENERAL INPUT TEST ROUTINE
;
WAIT2	EQU	$+XSET
	POP	B
XF89	EQU	$+XSET
	IN	0	;VARIABLEINPUT
	XRA	E
	ANA	B
	JNZ	XF89
	RET
;
;MULTIPLY LOOP MUST BE IN RAM
;
X115C	EQU	$+XSET
	RAR
	MOV	D,A
	MOV	A,C
	JNC	X116A
	PUSH	D
X1163	EQU	$+XSET
	LXI	D,0
	DAD	D
	POP	D
X1168	EQU	$+XSET
	ACI	00	;DATA
X116A	EQU	$+XSET
	RAR
	MOV	C,A
	MOV	A,H
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	MOV	A,B
	RAR
	MOV	B,A
	DCR	E
	MOV	A,D
	JNZ	X115C
	XCHG
X117B	EQU	$+XSET
	POP	H
	RET
;
;DIVIDE LOOP MUST BE IN RAM
;
X11B3	EQU	$+XSET
	PUSH	H
	PUSH	B
	MOV	A,L
X11B6	EQU	$+XSET
	SUI	00	;DATA
	MOV	L,A
	MOV	A,H
X11BA	EQU	$+XSET
	SBI	0	;DATA
	MOV	H,A
	MOV	A,B
X11BE	EQU	$+XSET
	SBI	00	;DATA
	MOV	B,A
X11C1	EQU	$+XSET
	MVI	A,0	;DATA
	SBI	0
	CMC
	JNC	X11D0
	STA	X11C1+1
	POP	PSW
	POP	PSW
	STC
	JNC	TRICK	;SKIP 2 INST
	ORG	$-2
X11D0	EQU	$+XSET
	POP	B
	POP	H
	MOV	A,C
	INR	A
	DCR	A
	RAR
	JM	X107F
	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	X11C1+1
	RAL
	STA	X11C1+1
	MOV	A,C
	ORA	D
	ORA	E
	JNZ	X11B3
	PUSH	H
	LXI	H,FACC+3
	DCR	M
	POP	H
	JNZ	X11B3
	JMP	OVERR
RAMEND	EQU	$
XRAM	EQU	$+XSET
;
;	BASIC FILE SYSTEM - VERSION	BFS.SRC;17
;
;	WRITTEN BY GREGORY F. WHITTEN
;
;	LAST UPDATED	FEBRUARY 8, 1978
;
;	START ADDRESS OF BASIC FILE SYSTEM
;
BFSORG	EQU	$
;
;	FCS INTERFACE ADDRESSES
;
FNEW	EQU	1	;NEW FILE OPEN CODE
;
;	FCS WORKSPACE ADDRESSES
;
	ORG	FPB	;SYSTEM FILE POINTER BLOCK
	DS	1	;OPEN TYPE CODE
FATR:
	DS	1	;ATTRIBUTE BYTE
	DS	6	;FILE NAME
	DS	3	;FILE TYPE
FVER:
	DS	1	;FILE VERSION NUMBER
FSBK:
	DS	2	;STARTING BLOCK NUMBER
FSIZ:
	DS	2	;NUMBER OF BLOCKS
FLBC:
	DS	1	;BYTE COUNT FOR LAST BLOCK
	DS	2	;LOAD ADDRESS FOR "IMAGE" FILE
	DS	2	;START ADDRESS FOR "IMAGE" FILE
FSPR:
	DS	1	;SPARE
FDBK:
	DS	1	;DIRECTORY BLOCK NUMBER
FDEN:
	DS	1	;DIRECTORY ENTRY NUMBER
FAUX:
	DS	2	;NEW FILE CLOSING SIZE, OR
			;AUX BYTE COUNT FOR SEQUENTIAL ROUTINE
	DS	2	;HANDLER ADDRESS
FFCN:
	DS	1	;HANDLER FUNCTION CODE
FDRV:
	DS	1	;DRIVE NUMBER
FBLK:
	DS	2	;BLOCK NUMBER FOR TRANSFER
FBUF:
	DS	2	;BUFFER POINTER FOR TRANSFER
	DS	2	;BYTE COUNT FOR TRANSFER
FPTR:
	DS	2	;BBUF POINTER FOR SEQUENTIAL ROUTINES
FPBE:
			;END OF SYSTEM FPB
	ORG	DBFE
	DS	18	;TEMPORARY 18 BYTE BLOCK FOR DIRECTORY
;
;	BASIC FILE INFORMATION BLOCK
;
BFIBSZ	EQU	FBLK-FPB	;SIZE OF BASIC FILE BLOCK
	ORG	FPB
BFTYP:
	DS	1	;BASIC FILE TYPE
;
;	RANDOM FILES
;
	ORG	FATR
NBUF:
	DS	1	;NUMBER OF BUFFERS
SPBUF:
	DS	1	;SECTORS PER BUFFER
BPBUF:
	DS	2	;BYTES PER BUFFER
CURREC:
	DS	2	;CURRENT RECORD NUMBER
ACCESS:
	DS	2	;CURRENT FILE ACCESS NUMBER
	ORG	FLAD
NR:
	DS	2	;NUMBER OF RECORDS
RSIZ:
	DS	2	;RECORD SIZE
RPBUF:
	DS	1	;RECORDS PER BUFFER
	ORG	DBFE
WRFLAG:
	DS	1	;WRITE FLAG
FILNUM:
	DS	1	;FILE NUMBER
RFPTR:
	DS	2	;RANDOM FILE POINTER
RECNUM:
	DS	2	;RECORD NUMBER
CURBYT:
	DS	2	;CURRENT BYTE IN RECORD
SPGP:
			;STRING POINTER FOR GET/PUT
BUFACC:
	DS	2	;LEAST RECENTLY USED ACCESS NUMBER
RECPTR:
			;POINTER TO RECORD
BUFPTR:
	DS	2	;POINTER TO BUFFER
;
;	BASIC FILE STATEMENTS
;
;	RANDOM FILES ONLY
;
	ORG	BFSORG
;
;	DISK BASIC ERROR CODES
;
ERRTBL	EQU	$
ERRNEV	EQU	$-ERRTBL
	DB	'E','V'+80H	;NO ERROR VECTOR
ERRBFN	EQU	$-ERRTBL
	DB	'B','F'+80H	;BAD FILE NAME
ERRFNO	EQU	$-ERRTBL
	DB	'N','O'+80H	;FILE NOT OPEN
ERRFAO	EQU	$-ERRTBL
	DB	'A','O'+80H	;FILE ALREADY OPEN
ERRFSE	EQU	$-ERRTBL
	DB	'F','S'+80H	;FILE SIZE ERROR
ERRROV	EQU	$-ERRTBL
	DB	'R','O'+80H	;RECORD OVERFLOW
ERREOF	EQU	$-ERRTBL
	DB	'E','F'+80H	;END OF FILE
ERRCOF	EQU	$-ERRTBL
	DB	'C','O'+80H	;CAN'T OPEN FILE
ERRCCF	EQU	$-ERRTBL
	DB	'C','C'+80H	;CAN'T CLOSE FILE
ERRREA	EQU	$-ERRTBL
	DB	'R','E'+80H	;FILE READ ERROR
ERRWRI	EQU	$-ERRTBL
	DB	'W','E'+80H	;FILE WRITE ERROR
;
;	FILE STATEMENT
;
FILEX:
	CALL	EVSTR	;EVALUATE STRING
	JZ	SNERR2	;SYNTAX ERROR - NULL STRING
	LDAX	D	;GET FIRST CHARACTER
	CPI	'A'
	JZ	FILATR	;FILE ATTRIBUTES
	CPI	'C'
	JZ	FILCLO	;CLOSE FILES
	CPI	'D'
	JZ	FILDUM	;DUMP FILES
	CPI	'E'
	JZ	FILERR	;GET FILE ERROR INFO
	CPI	'N'
	JZ	FILNEW	;CREATE RANDOM FILE
	CPI	'R'
	JZ	FILROP	;OPEN RANDOM FILE
	CPI	'T'
	JZ	FILTRP	;SET FILE ERROR TRAPS
	JMP	SNERR2	;SYNTAX ERROR - INVALID FILE OPTION
;
;*****	ATTRIBUTES	*****
;
FILATR:
	CALL	GETCBF	;GET BASIC FILE
	POP	D	;RESTORE TEXT POINTER
	LHLD	CURREC	;GET CURRENT RECORD
	CALL	STOVAR	;SAVE IT
	XCHG		;TEXT POINTER IN HL
	CALL	SKPSPC+1
	RZ		;RETURN IF END OF STATEMENT
	XCHG
	LHLD	NR	;GET NUMBER OF RECORDS
	CALL	STOVAR
	LHLD	RSIZ	;GET RECORD SIZE
	CALL	STOVAR
	LDA	RPBUF	;GET RECORDS PER BUFFER
	MOV	L,A
	MVI	H,0
	CALL	STOVAR
FILAT2:
	XCHG		;RESTORE TEXT POINTER
	JMP	SKPSPC+1	;DONE
;
;*****	CLOSE	*****
;
FILCLO:
	CALL	DUMPBF	;DUMP FILE BUFFERS
	PUSH	H	;SAVE TEXT PTR
	CALL	FREEBF	;FREE BASIC FILE SPACE
	POP	H	;RESTORE TEXT PTR
	CALL	SKPSPC+1	;SKIP TO NEXT TOKEN
	JNZ	FILCLO	;GET NEXT FILE IF NOT EOS
	RET		;DONE
;
;*****	DUMP	*****
;
FILDUM:
	CALL	DUMPBF	;DUMP FILE BUFFERS
	CALL	SKPSPC+1	;SKIP TO NEXT TOKEN
	JNZ	FILDUM	;GET NEXT FILE IF NOT EOS
	RET		;DONE
;
;	DUMP FILE BUFFERS FOR A BASIC RANDOM FILE
;
DUMPBF:
	CALL	GETCBF	;GET BASIC FILE
	CALL	DUMPFL	;DUMP FILE BUFFERS
	POP	H	;RESTORE TEXT PTR
	RET		;DONE
;
;	FREE BASIC FILE SPACE
;
;				AND ERASE ARRAYS
FREEBF:
	LHLD	RFPTR	;LOAD POINTER TO FILE
FREEAR:
	PUSH	H	;SAVE IT
	DCX	H	;BACK UP POINTER TO SIZE
	MOV	D,M	;HI BYTE
	DCX	H
	MOV	E,M	;LO BYTE
	DCX	H	;PAST NAME OF FILE
	DCX	H	;4TH BYTE
	XTHL		;SWAP WITH TOS
	DAD	D	;POINTER TO END OF CURRENT FILE
	XCHG		;INTO DE
	POP	B	;POINTER TO BEGINNING OF FILE
	LHLD	ENDARY	;END OF ARRAYS
FREBF1:
	CALL	CMPHD	;MOVED EVERYTHING?
	JZ	FREBF2	;YES
	LDAX	D	;D -> SOURCE BYTE
	STAX	B	;B -> DESTINATION BYTE
	INX	D	;BUMP POINTERS
	INX	B	;BY 1
	JMP	FREBF1
FREBF2:
	MOV	H,B	;B CONTAINS NEW END OF ARRAYS
	MOV	L,C
	SHLD	ENDARY	;SAVE NEW END
	RET		;DONE
;
;*****	ERROR	*****
;
FILERR:
	PUSH	H	;SAVE TEXT POINTER
	XRA	A	;ZERO
	CALL	FNDBFA	;FIND ERROR VECTOR
	MVI	B,ERRNEV	;ERROR - NO ERROR VECTOR
	JC	PROCER	;PROCESS ERROR
	POP	D	;RESTORE TEXT POINTER
	INX	H
	INX	H
	MOV	B,M	;FILE NUMBER
	INX	H
	MOV	C,M	;ERROR NUMBER
	PUSH	B	;SAVE IT
	INX	H
	MOV	C,M	;LINE NUMBER
	INX	H
	MOV	B,M	;HI BYTE
	POP	H	;GET FILE AND ERROR NUMBERS
	PUSH	B	;SAVE LINE NUMBER
	PUSH	H	;SAVE FILE AND ERROR NUMBERS
	MOV	L,H
	MVI	H,0
	CALL	STOVAR	;GET FILE NUMBER
	POP	H
	MVI	H,0
	CALL	STOVAR	;GET ERROR NUMBER
	POP	H
	CALL	STOVAR	;GET LINE NUMBER
	JMP	FILAT2	;DONE
;
;*****	CLRPTR	*****
;
FILNEW:
	CALL	FILNAM	;GET FILE NAME
	MVI	A,FNEW	;SET OPEN FILE TYPE
	CALL	FOPEN	;OPEN BASIC FILE
	CALL	FILSCN	;SCAN FOR FILE SIZE INFO
	SHLD	FAUX	;SAVE NEW FILE SIZE
	MVI	A,80H	;SET LAST BYTE COUNT TO 128
	STA	FLBC	;TO INSURE FCS KNOWS ABOUT EVERYTHING
	LXI	H,FPB	;LOAD POINTER TO FILE POINTER BLOCK
	CALL	FCLOSE	;CLOSE THE FILE WITH NEW INFORMATION
FILEXT:
	POP	H	;RESTORE TEXT POINTER
	JMP	SKPSPC+1	;RETURN TO BASIC
;
;*****	RANDOM OPEN	*****
;
FILROP:
	CALL	EVCFNO	;EVALUATE FILE NUMBER
	PUSH	PSW	;STACK FILE NUMBER
	CALL	FILNAM	;GET FILE NAME
	POP	PSW	;GET FILE NUMBER
	STA	FILNUM	;SAVE IT
	XRA	A	;SET OPEN TYPE - OLD
	CALL	FOPEN	;OPEN BASIC FILE
	CALL	FCLOSE	;CLOSE FILE
	LHLD	ELBUF	;RESTORE TEXT POINTER
	CALL	EVC1B	;GET NUMBER OF BUFFERS
	STA	NBUF	;SAVE IT
	CALL	SKPSPC+1	;GET NEXT TOKEN
	JZ	FILRO2	;EOS - CONTINUE OPEN
	CPI	';'	;TEST FOR SEMICOLON
	JNZ	SNERR2	;SYNTAX ERROR - BAD TOKEN
	INX	H	;BUMP PAST SEMICOLON
	CALL	EV2BYT	;GET NUMBER OF RECORDS
	JZ	SNERR2	;SYNTAX ERROR - MUST BE GREATER THAN 0
	CALL	FILSC1	;GET FILE SIZE
	CALL	FILCHK	;CHECK FILE SIZE
	POP	H	;RESTORE TEXT POINTER
FILRO2:
	PUSH	H	;SAVE TEXT POINTER
	CALL	FINDBF	;FIND FILE
	MVI	B,ERRFAO	;ERROR - FILE ALREADY OPEN
	JNC	PROCER	;PROCESS ERROR
	LXI	H,0	;ZERO HL
	SHLD	CURREC	;CURRENT RECORD
	SHLD	ACCESS	;CURRENT ACCESS
	CALL	FILSIZ	;COMPUTE FILE SIZE
	MOV	A,E
	STA	SPBUF	;SAVE SECTORS PER BUFFER
	PUSH	B	;SAVE BYTES PER BUFFER
	CALL	FILCHK	;CHECK FILE SIZE
	POP	H	;RESTORE BYTES PER BUFFER
	LXI	D,127
	DAD	D
	MOV	A,L
	ANI	128
	MOV	L,A
	SHLD	BPBUF	;SAVE BYTES PER BUFFER
	LXI	D,4H
	DAD	D	;BPBUF+4
	LDA	NBUF
	MOV	E,A
	MVI	D,0	;GET NBUF
	CALL	MULHD	;FILE SPACE FOR BUFFERS
	PUSH	H	;SAVE BUFFER LENGTH
	LXI	D,BFIBSZ+4
	DAD	D	;ADD IN SIZE OF INFO BLOCK
	XCHG
	LHLD	ENDARY	;END OF ARRAYS
	PUSH	H	;SAVE OLD END
	DAD	D	;NEW END OF ARRAYS
	CALL	TSTOM	;TEST FOR SPACE
	SHLD	ENDARY	;NEW END OF ARRAYS
	POP	H	;GET OLD END / START OF FILE AREA
	LDA	FILNUM	;
	MOV	M,A	;SAVE FILE NUMBER
	INX	H
	XRA	A
	MOV	M,A	;ZERO 2ND CHAR
	INX	H
	XCHG		;BFIB POINTER INTO DE
	POP	B	;GET BUFFER LENGTH
	PUSH	B	;KEEP IT ON TOP OF STACK
	LXI	H,BFIBSZ
	DAD	B	;ARRAY ENTRY LENGTH
	XCHG
	MOV	M,E	;PUT LENGTH AFTER FILE NUMBER
	INX	H
	MOV	M,D
	INX	H	;POINTS TO BFIB START
	CALL	STOBFB	;STORE BASIC FILE BLOCK
	POP	B	;GET FILE BUFFER LENGTH
FILRO5:
	XRA	A	;ZERO
	MOV	M,A
	INX	H	;CLEAR FILE BUFFER AREA
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	FILRO5	;NOT DONE YET
	JMP	FILEXT	;DONE
;
;*****	TRAP	*****
;
FILTRP:
	CALL	SKPSPC+1
	JNZ	FILTR1	;SCAN FOR NEW LINE NUMBER
	PUSH	H	;SAVE TEXT POINTER
	XRA	A	;ZERO
	CALL	FNDBFA	;FIND ERROR VECTOR
	CNC	FREEBF	;FREE IT IF PRESENT
	JMP	FILEXT	;DONE
FILTR1:
	CALL	TSTBYT
	DB	','	;DEMAND A COMMA
	CALL	TOBINY	;GET LINE NUMBER
	PUSH	H	;SAVE TEXT POINTER
	PUSH	D	;SAVE LINE NUMBER
FILTR2:
	XRA	A	;ZERO
	CALL	FNDBFA	;FIND ERROR VECTOR
	JNC	FILTR3	;FOUND IT
	LXI	D,10	;LENGTH OF ERROR VECTOR
	LHLD	ENDARY	;END OF ARRAYS
	PUSH	H	;SAVE OLD END
	DAD	D	;NEW END
	CALL	TSTOM	;TEST FOR SPACE
	SHLD	ENDARY	;SAVE NEW END
	POP	H	;OLD END OF ARRAYS
	XRA	A
	MOV	M,A
	INX	H
	MOV	M,A	;ZERO FILE NUMBER
	INX	H
	MVI	M,6	;SET ERROR VECTOR LENGTH
	INX	H
	MOV	M,A	;ZERO HI BYTE
	INX	H
	SHLD	RFPTR	;SAVE POINTER TO ERROR VECTOR
FILTR3:
	LHLD	RFPTR	;GET ADDRESS OF ERROR VECTOR
	POP	D	;GET LINE NUMBER
	MOV	M,E
	INX	H
	MOV	M,D	;STORE LINE NUMBER
	INX	H
	XRA	A
	MOV	M,A	;ZERO FILE NUMBER
	INX	H
	MOV	M,A	;ZERO ERROR NUMBER
	INX	H
	DCR	A	;-1
	MOV	M,A
	INX	H
	MOV	M,A	;LINE NUMBER IS -1
	JMP	FILEXT	;DONE
;
;	PUT STATEMENT
;
PUTX:
	MVI	A,80H	;WRITE FLAG ON
	CALL	RFINFO	;FIND RECORD AND CURRENT OFFSET
PUTNXT:
	PUSH	H	;SAVE ORIGINAL TEXT POINTER
	CALL	EVAL	;EVALUATE EXPRESSION
	LDA	TYPFLG	;GET TYPE
	ANA	A	;TEST IT
	JNZ	PUTSTR	;STRING EXPRESSION
	POP	B	;UNSTACK OLD TEXT POINTER
	LXI	D,FACC	;POINTER TO EXPRESSION RESULT
	MVI	A,4	;LENGTH OF NUMBER
	MOV	B,A	;COPY INTO B
	MOV	C,B	;COPY INTO C
	JMP	PUTMOV	;PREPARE TO MOVE IT
PUTSTR:
	CALL	UNSTKS	;UNSTACK STRING TEMPORARY
	CALL	EVB1B	;EVALUATE LENGTH EXPRESSION
	XTHL		;SWAP TEXT POINTERS
	PUSH	PSW	;SAVE MOVE LENGTH
	CALL	EVSTR	;REEVALUATE STRING EXPRESSION
	CALL	UNSTKS	;UNSTACK STRING TEMPORARY
	MOV	C,A	;STRING LENGTH
	POP	PSW	;MOVE LENGTH
	MOV	B,A	;INTO B
	POP	H	;RESTORE TEXT POINTER
PUTMOV:
	PUSH	H	;SAVE TEXT POINTER
	PUSH	B	;SAVE LENGTHS
	CALL	FIXUP	;READJUST POINTERS, ETC.
	POP	B	;RESTORE LENGTHS
	INR	C
	INR	B
PUTMV1:
	DCR	B
	JZ	PUTEND	;DONE WITH MOVE
	DCR	C
	JNZ	PUTMV2	;NOT FINISHED WITH STRING
	INR	C
	MVI	A,' '	;BLANK FILL
	JMP	PUTMV3	;CONTINUE
PUTMV2:
	LDAX	D	;GET NEXT CHAR
PUTMV3:
	MOV	M,A	;SAVE IT
	INX	H
	INX	D
	JMP	PUTMV1	;NEXT CHARACTER
PUTEND:
	POP	H	;RESTORE TEXT POINTER
	CALL	SKPSPC+1
	RZ		;END OF STATEMENT
	CALL	TSTBYT
	DB	','	;DEMAND COMMA
	JMP	PUTNXT	;GET NEXT LIST ENTRY
;
;	GET STATEMENT
;
GETX:
	XRA	A	;WRITE FLAG OFF
	CALL	RFINFO	;FIND RECORD AND CURRENT OFFSET
GETNXT:
	PUSH	H	;SAVE ORIGINAL TEXT POINTER
	CALL	FNDVAR	;POINTER TO VARIABLE
	LDA	TYPFLG	;GET TYPE
	ANA	A	;TEST IT
	JNZ	GETSTR	;STRING VARIABLE
	POP	B	;UNSTACK OLD TEXT POINTER
	MVI	A,4	;LENGTH OF NUMERIC VARIABLE
	JMP	GETMOV	;PREPARE FOR MOVE
GETSTR:
	CALL	EVB1B	;EVALUATE LENGTH EXPRESSION
	XTHL		;SWAP TEXT POINTERS
	PUSH	PSW	;SAVE LENGTH
	CALL	FNDVAR	;RECOMPUTE POINTER TO VARIABLE IN DE
	POP	PSW	;RESTORE LENGTH
	PUSH	D	;SAVE VARIABLE POINTER
	CALL	GSTSP	;GET STRING SPACE
	POP	H	;POINTER TO VARIABLE
	MOV	M,A	;SET LENGTH
	INX	H
	INX	H
	MOV	M,E	;SAVE POINTER TO STRING
	INX	H
	MOV	M,D
	POP	H	;RESTORE PROPER TEXT POINTER
GETMOV:
	PUSH	H	;SAVE TEXT POINTER
	CALL	FIXUP	;FIXUP EVERYTHING FOR MOVE
	CALL	MOVDH	;D <- H
	POP	H	;RESTORE TEXT POINTER
	CALL	SKPSPC+1	;GET NEXT TOKEN
	RZ		;END OF STATEMENT
	CALL	TSTBYT
	DB	','	;DEMAND A COMMA
	JMP	GETNXT	;GET NEXT LIST ITEM
;
;	UNSTACK STRING TEMPORARY
;
UNSTKS:
	PUSH	H	;SAVE HL, DE, AND A
	PUSH	D
	PUSH	PSW
	CALL	USST	;UNSTACK TEMPORARY
	POP	PSW
	POP	D
	POP	H
	RET
;
;	FIX UP ROUTINE FOR GET AND PUT
;
FIXUP:
	PUSH	D	;SAVE ORG/DEST
	PUSH	PSW	;SAVE LENGTH
	LHLD	CURBYT	;GET CURRENT BYTE OFFSET
	PUSH	H	;SAVE IT
	CALL	ADHLA	;ADD LENGTH TO OFFSET
	XCHG		;INTO DE
	LHLD	RSIZ	;GET RECORD SIZE
	CALL	CMPHD	;RSIZ-CURBYT
	MVI	B,ERRROV	;ERROR - RECORD OVERFLOW
	JC	PROCER	;PROCESS ERROR
	XCHG
	SHLD	CURBYT	;SAVE NEW CURRENT BYTE
	LHLD	RFPTR
	PUSH	H	;SAVE IT
	CALL	FINDBF	;FIND FILE
	POP	D	;GET OLD LOCATION
	CALL	SUBHD	;COMPUTE OFFSET
	XCHG
	LHLD	RECPTR	;GET RECORD POINTER
	DAD	D	;ADD IN OFFSET
	SHLD	RECPTR	;SAVE NEW RECORD POINTER
	POP	D	;GET OLD BYTE OFFSET
	DAD	D	;NEW LOCATION FOR TRANSFER
	POP	PSW	;GET LENGTH
	POP	D	;GET ORG/DEST
	MOV	B,A	;LENGTH INTO B
	RET
;
;	BFS UTILITY ROUTINES
;
;	BASIC FILE OPEN AND CLOSE
FOPEN:
	CALL	OPENX	;OPEN FILE
	MVI	B,ERRCOF	;ERROR - CAN'T OPEN FILE
	JC	PROCER	;PROCESS ERROR
	RET
FCLOSE:
	CALL	CLX	;CLOSE FILE
	MVI	B,ERRCCF	;ERROR - CAN'T CLOSE FILE
	JC	PROCER	;PROCESS ERROR
	RET
;
;	FILE SIZE CHECK
;
FILCHK:
	XCHG		;DE = NEW SIZE
	LHLD	FSIZ	;ORIGINAL SIZE
	CALL	CMPHD	;OLD - NEW
	MVI	B,ERRFSE	;ERROR - FILE SIZE ERROR
	JC	PROCER	;PROCESS ERROR
	LDA	RPBUF	;GET BLOCKING FACTOR
	ANA	A	;TEST IT
	JZ	PROCER	;PROCESS ERROR
	RET
;
;	FILE SIZE SCAN
;
FILSCN:
	LHLD	ELBUF	;RESTORE TEXT POINTER
	CALL	EVC2BP	;GET 2 BYTE INT
FILSC1:
	SHLD	NR	;SAVE NUMBER OF RECORDS
	XCHG
	CALL	EVC2BP
	SHLD	RSIZ	;SAVE RECORD SIZE
	XCHG
	CALL	EVC1B
	STA	RPBUF	;SAVE RECORDS PER BUFFER
	CALL	SKPSPC+1	;SCAN FOR STATEMENT END
	JNZ	SNERR2	;SYNTAX ERROR - EXTRA GARBAGE
	XTHL		;SWAP TEXT POINTER AND RETURN ADDRESS
	PUSH	H	;SAVE RETURN ADDRESS
FILSIZ:
	LHLD	NR	;B <- NR
	MOV	B,H
	MOV	C,L
	LHLD	RSIZ	;D <- RSIZ
	XCHG
	LHLD	RPBUF	;H <- RPBUF
	MVI	H,0	;ZERO HI BYTE
FILSZA:
	PUSH	H	;SAVE RECORDS PER BUFFER
	CALL	MULHD	;BYTES PER BUFFER
	MOV	D,H
	MOV	E,L	;COPY BPBUF INTO DE
	XTHL		;SWAP BPBUF WITH RPBUF
	PUSH	H	;SAVE RPBUF
	LXI	H,07FH	;BLOCK SIZE - 1
	DAD	D
	LXI	D,7
	XCHG		;SWAP ARGUMENTS
	CALL	SHRHD	;DIVIDE BY 128 GIVING SPBUF
	XTHL		;SWAP SPBUF AND RPBUF
	PUSH	H	;SAVE RPBUF
	DAD	B	;ADD NR
	DCX	H	;NR+RPBUF-1
	POP	D	;LOAD RPBUF
	XCHG		;SWAP ARGUMENTS
	CALL	DIVHD	;BUFFERS PER FILE
	POP	D	;GET SPBUF
	PUSH	D	;SAVE IT AGAIN
	CALL	MULHD	;HL <- FILSIZ
	POP	D	;DE <- SPBUF
	POP	B	;BC <- BPBUF
	RET		;DONE
;
;	SCAN FOR FILE NAME
;
FILRND:
	DB	'RND'	;DEFAULT RANDOM FILE TYPE
FILNAM:
	CALL	EVCSTR	;GET FILE NAME
	JZ	FILNER	;BAD FILE NAME
	SHLD	ELBUF	;SAVE TEXT POINTER
	LXI	H,DBFE	;TEMPORARY NAME BUFFER
	MOV	B,A	;NUMBER OF CHARACTERS INTO B
	CPI	17	;MAXIMUM NAME SIZE
	JNC	FILNER	;BAD FILE NAME
FILNA1:
	LDAX	D	;MOVE CHARACTERS
	MOV	M,A
	INX	H	;ONE BY ONE
	INX	D
	DCR	B
	JNZ	FILNA1	;MOVE SOME MORE
	MVI	M,0	;END WITH ZERO
	LXI	H,DBFE	;NAME BUFFER
	LXI	D,FPB	;FILE POINTER BLOCK
	LXI	B,FILRND	;DEFAULT TYPE
	CALL	PFSPC	;PARSE FILE NAME
	JC	FILNER	;BAD FILE NAME
	CALL	SPNOR	;SKIP SPACES
	RZ		;FILE NAME IS GOOD
FILNER:
	MVI	B,ERRBFN	;ERROR - BAD FILE NAME
;
;	PROCESS ERRORS
;
PROCER:
	PUSH	B	;SAVE ERROR NUMBER
	CALL	RESET	;RESET DEVICES
	XRA	A	;LOOK FOR ERROR VECTOR
	CALL	FNDBFA
	POP	B	;RESTORE ERROR NUMBER
	JNC	PROCE1	;FOUND ERROR VECTOR
	MOV	E,B	;ERROR NUMBER INTO E
	CALL	RSTSTK	;RESET POINTERS
	CALL	CRLF	;OUTPUT CR-LF
	CMA
	CALL	CONOUT	;OUTPUT 255 TO CLEAR PLOT MODE
	MVI	A,0DH	;CR
	CALL	ZERCPOS-3	;OUTPUT CR
	LXI	H,ERRTBL	;LOAD ERROR TABLE ADDRESS
	JMP	DOERMS+12H	;PRETEND A REGULAR BASIC ERROR
PROCE1:
	MOV	E,M
	INX	H
	MOV	D,M	;LINE NUMBER INTO DE
	INX	H
	PUSH	D	;SAVE LINE NUMBER
	LDA	FILNUM
	MOV	M,A	;SAVE FILE NUMBER IN ERROR VECTOR
	INX	H
	MOV	M,B	;SAVE ERROR NUMBER
	INX	H
	XCHG
	LHLD	LINENUM	;GET OFFENDING LINE NUMBER
	XCHG
	MOV	M,E
	INX	H
	MOV	M,D	;SAVE LINE NUMBER
	LXI	H,PROCD
	XTHL		;SETUP BREAK AS RETURN
	PUSH	H	;SAVE TRAP LINE NUMBER
	LHLD	NOWAT	;RESTORE TEXT POINTER
	POP	D	;RESTORE LINE NUMBER
	JMP	GOTO+3	;PRETEND WE ARE A GOTO STATEMENT
;
;	FIND BASIC FILE - FIND ARRAY
;
FINDBF:
	LDA	FILNUM	;GET FILE NUMBER
FNDBFA:
	MOV	C,A
	MVI	B,0
FINDAR:
	LHLD	ENDVAR	;START OF ARRAYS
	MVI	A,TRICK	;SKIP 1 INSTRUCTION
	ORG	$-1
FNDBF1:
	DAD	D	;ADD LENGTH TO GET NEXT ENTRY
	XCHG
	LHLD	ENDARY	;END OF ARRAYS
	CALL	CMPHD
	XCHG
	JZ	FNDBF9	;NOT FOUND
	MOV	A,M	;2ND CHAR
	INX	H
	CMP	C	;TEST FOR FILE NUMBER
	JNZ	FNDBF2	;NOT EQUAL
	MOV	A,M	;1ST CHAR
	CMP	B
FNDBF2:
	INX	H
	MOV	E,M	;LOAD ARRAY LENGTH
	INX	H
	MOV	D,M
	INX	H
	JNZ	FNDBF1	;DID NOT FIND IT
	SHLD	RFPTR	;SAVE RANDOM FILE POINTER/ARRAY PTR
			;CARRY IS CLEAR
	RET		;DONE
FNDBF9:
	STC		;NO FILE/ARRAY
	RET
;
;	GET BASIC FILE
;
GETCBF:
	CALL	TSTBYT
	DB	','	;DEMAND A COMMA
GETBFL:
	CALL	EVFNUM	;EVALUATE FILE NUMBER
	XTHL
	PUSH	H	;PUT TEXT POINTER BEFORE RETURN ADDRESS
	CALL	FINDBF	;FIND FILE BLOCK
	MVI	B,ERRFNO	;ERROR - FILE NOT OPEN
	JC	PROCER	;PROCESS THE ERROR
;
;	GET AND STORE BASIC FILE BLOCKS
;
GETBFB:
	LXI	D,FPB
	MVI	B,BFIBSZ
	JMP	MOVDH	;D <- H
STOBFB:
	LXI	D,FPB
	MVI	B,BFIBSZ
	JMP	MOVHD	;H <- D
;
;	BFS SCANNING ROUTINES
;
;	EVALUATE A STRING EXPRESSION
EVCSTR:
	CALL	TSTBYT	;SCAN FOR COMMA
	DB	','
EVSTR:
	CALL	EVAL	;EVALUATE EXPRESSION
	PUSH	H	;SAVE TEXT POINTER
	CALL	XEDD	;CHECK FOR STRING - LENGTH IN A
	INX	H
	INX	H
	MOV	E,M	;DE -> FIRST CHAR
	INX	H
	MOV	D,M
	POP	H
	RET		;DONE
;
;	EVALUATE A FILE NUMBER
;
EVCFNO:
	CALL	TSTBYT
	DB	','	;DEMAND COMMA
EVFNUM:
	CALL	EV1BYT	;EVALUATE A 1 BYTE INT
	JM	SNERR2	;SYNTAX ERROR - CAN'T BE NEGATIVE
	STA	FILNUM	;SAVE FILE NUMBER (1 - 127)
	RET
;
;	EVALUATE A 2 BYTE POSITIVE INTEGER
;
EVS2B:
	CALL	SKPSPC+1	;SCAN FOR NEXT TOKEN
	CPI	';'	;SEMICOLON
	JZ	RFINF1	;BACK TO RFINFO
EVC2B:
	CALL	TSTBYT	;SCAN FOR COMMA
	DB	','
EV2BYT:
	CALL	EXPEVP	;EVALUATE A 2 BYTE INTEGER
	MOV	A,D
	ORA	E	;TEST VALUE
	XCHG		;PUT VALUE IN HL
	RET		;DONE
EVC2BP:
	CALL	EVC2B	;EVALUATE 2 BYTE INT
	JZ	SNERR2	;SYNTAX ERROR - MUST BE GREATER THAN 0
	RET
;
;	EVALUATE A 1 BYTE POSITIVE INTEGER
;
EVC1B:
	CALL	TSTBYT	;SCAN FOR COMMA
	DB	','
EV1BYT:
	CALL	XPRDE	;EVALUATE A 1 BYTE INT
	ANA	A	;TEST IT
	JZ	SNERR2	;SYNTAX ERROR - CAN'T BE 0
	RET
EVB1B:
	CALL	TSTBYT	;EVALUATE A BRACKETED EXPRESSION
	DB	'['
	CALL	EV1BYT
	PUSH	PSW	;SAVE VALUE
	CALL	TSTBYT
	DB	']'
	POP	PSW	;RESTORE VALUE
	RET
;
;	SCANNING ROUTINE FOR GET AND PUT
;
RFINFO:
	STA	WRFLAG	;SAVE WRITE FLAG
	CALL	GETBFL	;GET FILE BLOCK
	LXI	H,0	;ZERO
	SHLD	RECNUM	;RECORD NUMBER
	SHLD	CURBYT	;CURRENT BYTE
	POP	H	;RESTORE TEXT POINTER
	CALL	EVS2B	;EVALUATE EXPRESSION
	SHLD	RECNUM	;SAVE RECORD NUMBER
	XCHG		;HL = TEXT POINTER
	CALL	EVS2B	;EVALUATE EXPRESSION
	JZ	SNERR2	;SYNTAX ERROR - MUST BE GREATER THAN 0
	DCX	H	;DECREMENT BY 1
	SHLD	CURBYT	;SAVE CURRENT BYTE
	XCHG
	MVI	B,TRICK	;SKIP 1 INSTRUCTION
	ORG	$-1
RFINF1:
	POP	B	;UNSTACK UNUSED RETURN ADDRESS
	CALL	TSTBYT	;DEMAND A SEMICOLON
	DB	';'
	PUSH	H	;SAVE TEXT POINTER
	LHLD	RECNUM	;GET RECORD NUMBER
	MOV	A,H
	ORA	L	;TEST IT
	JNZ	RFINF2	;OKAY
	LHLD	CURREC	;GET CURRENT RECORD
	INX	H	;BUMP TO NEXT
	SHLD	RECNUM	;SAVE NEW RECORD NUMBER
RFINF2:
	SHLD	CURREC	;SAVE CURRENT RECORD
	XCHG
	LHLD	NR	;GET NUMBER OF RECORDS
	CALL	CMPHD	;NR - RECNUM
	MVI	B,ERREOF	;ERROR - END OF FILE
	JC	PROCER	;PROCESS ERROR
	CALL	FINDRC	;FIND RECORD
	LHLD	RFPTR	;GET FILE POINTER
	CALL	STOBFB	;STORE FILE BLOCK
	POP	H	;RESTORE TEXT POINTER
	RET		;DONE
;
;	STORE BASIC VARIABLE
;
STOVAR:
	PUSH	H	;SAVE VALUE
	XCHG		;TEXT POINTER BACK IN HL
	CALL	TSTBYT
	DB	','	;DEMAND A COMMA
	CALL	FNDVAR	;GET VARIABLE
	LDA	TYPFLG	;GET TYPE
	ANA	A	;TEST IT
	JNZ	SNERR2	;SYNTAX ERROR - MUST BE NUMERIC VARIABLE
	XTHL		;SWAP TEXT POINTER AND VALUE
	PUSH	D	;SAVE DESTINATION
	MOV	A,H
	MOV	B,L
	CALL	FACAB	;FLOAT AB INTO ACCUMULATOR
	LXI	H,FACC	;ADDRESS OF ACCUMULATOR
	POP	D	;DESTINATION
	MVI	B,4	;LENGTH
	CALL	MOVDH	;D <- H
	POP	D	;RESTORE TEXT POINTER TO DE
	RET		;DONE
;
;	RANDOM FILE ROUTINES - FCS LEVEL
;
;	FIND RECORD
;
FINDRC:
	CALL	BUFINI	;INITIALIZE BUFFER LOOP
FINDR1:
	SHLD	BUFPTR	;SAVE CURRENT BUFFER POINTER
	MOV	E,M
	INX	H
	MOV	D,M	;GET BASE RECORD FOR CURRENT BUFFER
	INX	H
	PUSH	H	;POINTER TO ACCESS NUMBER
	MOV	A,D
	ORA	E	;TEST BASE RECORD
	JZ	FINDR2	;EMPTY BUFFER - GET NEXT ONE
	LHLD	RECNUM	;GET RECORD NUMBER
	CALL	SUBHD	;SUBTRACT BASE RECORD
	JC	FINDR2	;NOT IN THIS BUFFER
	LDA	RPBUF	;GET RECORDS PER BUFFER
	MOV	E,A	;PUT IN LO BYTE OF DE
	MVI	D,0	;ZERO HI BYTE
	CALL	SUBHD	;SUBTRACT RECORDS PER BUFFER
	JC	FINDR3	;FOUND RIGHT BUFFER
FINDR2:
	POP	H	;RESTORE BUFFER POINTER
	CALL	BUFFIN-2	;GET NEXT BUFFER
	JNZ	FINDR1	;STILL SOME MORE
	CALL	GETBUF	;GET BUFFER CONTAINING RECORD FROM FILE
	MVI	D,TRICK	;SKIP 1 INSTR
	ORG	$-1
FINDR3:
	POP	H	;RESTORE POINTER TO ACCESS NUMBER
	LHLD	ACCESS	;LOAD CURRENT FILE ACCESS NUMBER
	LXI	D,7FFFH	;MAXIMUM ACCESS NUMBER ALLOWED
	CALL	CMPHD	;COMPARE THEM
	JNZ	FINDR5	;DO NOT HAVE TO RESET ACCESS NUMBERS
	CALL	BUFINI	;SET UP BUFFER LOOP
FINDR4:
	INX	H
	INX	H	;POINTS TO ACCESSES
	MVI	M,0	;ZERO LO BYTE
	INX	H
	MOV	A,M	;GET HI BYTE
	ANI	80H	;SAVE WRITE FLAG
	MOV	M,A	;STORE BACK IN MEMORY
	CALL	BUFFIN-1	;GET NEXT BUFFER
	JNZ	FINDR4	;RESET SOME MORE BUFFER ACCESSES
	LXI	H,0	;CURRENT ACCESS IS NOW ZERO
FINDR5:
	INX	H	;BUMP CURRENT ACCESS NUMBER
	SHLD	ACCESS	;SAVE CURRENT ACCESS
	XCHG		;PUT ACCESS NUMBER IN DE
	LHLD	BUFPTR	;GET CURRENT BUFFER POINTER
	INX	H
	INX	H	;POINT TO ACCESSES
	MOV	M,E	;SAVE LO BYTE
	INX	H
	LDA	WRFLAG	;GET WRITE FLAG
	ORA	M	;OR WITH OLD ACCESS BYTE
	ANI	080H	;SAVE ONLY WRITE FLAG
	ORA	D	;OR WITH HI BYTE
	MOV	M,A	;SAVE HI BYTE
	LHLD	BUFPTR	;GET BUFFER POINTER
	MOV	E,M	;GET BASE RECORD NUMBER
	INX	H
	MOV	D,M
	INX	H
	PUSH	H	;SAVE POINTER TO BUFFER
	LHLD	RECNUM	;GET RECORD NUMBER
	CALL	SUBHD	;COMPUTE RECORD OFFSET
	XCHG		;TO DE
	LHLD	RSIZ	;GET RECORD SIZE
	CALL	MULHD	;COMPUTE OFFSET
	POP	D	;RESTORE POINTER
	DAD	D
	INX	H
	INX	H
	SHLD	RECPTR	;SAVE POINTER TO RECORD
	RET		;DONE
;
;	GET FILE BUFFER CONTAINING A RECORD
;
GETBUF:
	LHLD	ACCESS	;GET CURRENT ACCESS
	SHLD	BUFACC	;SAVE AS LEAST RECENTLY USED
	CALL	BUFINI	;SET UP BUFFER LOOP
	SHLD	BUFPTR	;SAVE 1ST BUFFER AS LRU
GETBU1:
	PUSH	H	;SAVE CURRENT BUFFER POINTER
	MOV	A,M
	INX	H
	ORA	M	;TEST RECORD NUMBER
	INX	H
	JNZ	GETBU2	;NOT AN EMPTY BUFFER
	POP	H	;UNSTACK CURRENT BUFFER POINTER
	SHLD	BUFPTR	;SAVE AS BUFFER POINTER
	JMP	GETBU4	;GO READ IN CLUSTER
GETBU2:
	MOV	E,M	;GET BUFFER ACCESS NUMBER
	INX	H
	MOV	A,M	;GET BYTE
	ANI	07FH	;MASK OFF WRITE FLAG
	MOV	D,A	;PUT IN D
	LHLD	BUFACC	;GET CURRENT LRU
	CALL	CMPHD	;LRU - BUFFER ACCESS
	JC	GETBU3	;NOT LRU BUFFER
	XCHG
	SHLD	BUFACC	;SAVE NEW LRU ACCESS NUMBER
	POP	H	;GET CURRENT BUFFER POINTER
	SHLD	BUFPTR	;NEW LRU BUFFER POINTER
	MVI	D,TRICK	;SKIP 1 INSTR
	ORG	$-1
GETBU3:
	POP	H	;UNSTACK BUFFER POINTER
	CALL	BUFFIN-4	;TEST FOR MORE BUFFERS
	JNZ	GETBU1	;STILL SOME MORE TO CHECK
	CALL	WRBUF	;WRITE BUFFER OUT
GETBU4:
	LHLD	RECNUM	;GET RECORD NUMBER
	CALL	CSCTR	;COMPUTE SECTOR NUMBER
;
;	READ BUFFER
;
RDBUF:
	PUSH	H	;SAVE SECTOR NUMBER
	CALL	SETUP	;SET UP TRANSFER PARAMETERS
	CALL	RD	;READ BUFFER IN
	MVI	B,ERRREA	;ERROR - READ ERROR
	JC	PROCER	;PROCESS ERROR
	LHLD	BUFPTR	;GET BUFFER POINTER
	POP	D	;GET BASE RECORD NUMBER
	MOV	M,E
	INX	H
	MOV	M,D	;SAVE BASE RECORD NUMBER IN BUFFER
	RET		;DONE
;
;	WRITE BUFFER
;
WRBUF:
	LHLD	BUFPTR	;GET BUFFER POINTER
	MOV	E,M
	INX	H
	MOV	D,M	;GET BASE RECORD NUMBER
	INX	H
	INX	H	;POINT TO WRITE FLAG
	MOV	A,M	;GET WRITE FLAG
	ANA	A	;TEST IT
	RP		;BUFFER NOT WRITTEN ON - DON'T WRITE
	ANI	07FH	;MASK OFF WRITE FLAG
	MOV	M,A	;PUT BACK IN MEMORY
	XCHG		;HL = BASE RECORD NUMBER
	CALL	CSCTR	;COMPUTE SECTOR OFFSET
	CALL	SETUP	;SET UP TRANSFER PARAMETERS
	CALL	WR	;WRITE BUFFER OUT
	MVI	B,ERRWRI	;ERROR - WRITE ERROR
	JC	PROCER	;PROCESS ERROR
	RET		;DONE
;
;	COMPUTE SECTOR OFFSET
;
CSCTR:
	DCX	H	;DECREMENT RECORD NUMBER BY 1
	LDA	RPBUF	;GET RECORD PER BUFFER
	MOV	E,A	;SET LO BYTE
	MVI	D,0	;ZERO HI BYTE
	XCHG		;SWAP ARGUMENTS
	CALL	DIVHD	;DIVIDE THEM GIVING BUFFER OFFSET
	PUSH	H	;SAVE IT
	LDA	SPBUF	;GET SECTORS PER BUFFER
	MOV	E,A	;SET LO BYTE
	MVI	D,0	;ZERO HI BYTE
	CALL	MULHD	;GET SECTOR OFFSET
	XTHL		;SWAP WITH TOS (BUFFER OFFSET)
	LDA	RPBUF	;GET RECORDS PER BUFFER
	MOV	E,A	;SET LO BYTE
	MVI	D,0	;ZERO HI BYTE
	CALL	MULHD	;GET BASE RECORD NUMBER - 1
	INX	H	;BUMP UP TO PROPER VALUE
	POP	D	;GET SECTOR OFFSET
	RET		;DONE
;
;	SET UP TRANSFER PARAMETERS
;
SETUP:
	LHLD	FSBK	;GET STARTING FILE BLOCK
	DAD	D	;ADD IN OFFSET
	SHLD	FBLK	;SET START BLOCK FOR TRANSFER
	LHLD	BUFPTR	;GET ADDRESS FOR TRANSFER
	LXI	D,4H	;BUMP BY 4 TO DATA AREA
	DAD	D	;ADD
	SHLD	FBUF	;TRANSFER BUFFER ADDRESS
	LHLD	BPBUF	;GET BYTES PER BUFFER
	SHLD	FXBC	;SET TRANSFER BYTE COUNT
	LXI	H,FHAN	;SET HANDLER ADDRESS
	RET		;FINISHED SETUP
;
;	DUMP FILE BUFFERS
;
DUMPFL:
	CALL	BUFINI	;LOOP THROUGH BUFFERS
DUMPF1:
	SHLD	BUFPTR	;SET BUFFER POINTER
	PUSH	H
	PUSH	B
	CALL	WRBUF	;WRITE BUFFER
	POP	B
	POP	H
	CALL	BUFFIN-4	;TEST IF DONE
	JNZ	DUMPF1	;DUMP NEXT BUFFER
	RET
;
;	BUFFER LOOP INITIALIZATION
;
BUFINI:
	LHLD	RFPTR	;GET FILE POINTER
	LXI	D,BFIBSZ	;GET FILE BLOCK SIZE
	DAD	D	;COMPUTE START OF FIRST BUFFER
	LDA	NBUF	;GET NUMBER OF BUFFERS
	MOV	B,A	;INTO B
	RET
;
;	BUFFER LOOP INCREMENTATION
;
	INX	H
	INX	H
	INX	H
	INX	H
BUFFIN:
	XCHG
	LHLD	BPBUF	;GET BYTES PER BUFFER
	DAD	D	;POINT TO NEXT BUFFER
	DCR	B	;DECREMENT BUFFER COUNT
	RET		;ZERO - DONE, NONZERO - NOT DONE
	JMP	0	;PLEASE LEAVE THIS FOR ERROR
			;CHECKING ON ASM BASIC/E
	END
