	ORG	3
; 
STAK	EQU	7100H
; 
; TINY BASIC INTERPRETER
; INTEGER ARITHMETIC
; WITH RND FUNCTION
; 
STRT:	LXI	SP,STAK
	NOP
	NOP
	NOP
	CALL	INIT	;INITIALIZE
	LXI	H,TOPL
	MVI	M,1
	SHLD	EFPN
ERNT:	XRA	A
	STA	LNUM
	MVI	E,'?'
	MVI	A,'>'
	CALL	DTIN+8
	CALL	LF
	LXI	H,IBUF
	SHLD	APNT
	CALL	NTST	;TEST FOR #
	JC	STMT	;NO #, XCT
	CALL	RPLN	;EDIT
	JMP	ERNT
; 
; INITIALIZATION ROUTINE
; 
INIT:	LXI	H,SYMT
	MVI	B,NSYM
	CALL	CLER
	STA	CHCT
	LHLD	EFPN
	INX	H
	SHLD	NMLC
	LXI	H,ASTR
	SHLD	ASTK
	LXI	H,VSTR
	SHLD	VSTK
	LXI	H,RSTR-1
	MOV	M,A
	INX	H
	MOV	M,A
	SHLD	RSTK
	RET
; 
; ZERO MEMORY
; 
CLER:	XRA	A
	MOV	M,A
	INX	H
	DCR	B
	JNZ	CLER+1
	RET
; 
; INPUT ROUTINE
; 
DTIN:	MVI	E,'?'
	MOV	A,E
	CALL	TVTO
	MVI	A,' '
	CALL	TVTO
DTN1:	LXI	H,IBUF
	NOP
	PUSH	H
	MVI	B,IBLN
	CALL	CLER
	POP	H
	MVI	B,IBLN-2
DTN2:	CALL	TVTI
	CMP	E
	JZ	DTN1
	CPI	18H
	JNZ	$+1	
APK	mvi	SP,STAK
	CALL	K
LF
	JMP	ERNT
	MOV	M,A
	CPI	13
	RZ
	DCR	B
	JM	ILTL
	INX	H
	JMP	DTN2
; 
; TEST INPUT FOR LINE NUMBER
; 
NTST:	CALL	SBLK
	CALL	TSTN
	RC
	MOV	B,H
	MOV	C,L
	CALL	ADEC
	MOV	A,H
	ORA	A
	JNZ	ERRM
	MOV	A,L
	CPI	APK
	JC	ERRM
	STA	FNUM
	MOV	H,B
	MOV	L,8
	SHLD	APNT	;SET APNT
	RET 
BLK:	LHLD	APNT
	MOV	A,M
	CPI	' '
	RNZ
	INX	H 
BL1:	SHLD	APNT
	JMP	SBLK+3
; 
; TEST FOR NUMERIC
; 

; 

TN:	LHLD	APNT
	MOV	A,M
TSN1:	CPI	'0'
	RC
	CPI	'9'+1
	CMC
	RET
; 
; CONVERT ASCII TO BINARY
; 
ADEC:	LXI	H,0
	LDAX	B
	CALL	TSN1
	RC
	MOV	D,H
	MOV	E,L
	DAD	H
	DAD	H
	DAD	D
	DAD	H
	SUI	'0'
	MOV	E,A
	MVI	D,0
	DAD	D
	INX	B
	JMP	ADEC+3
; 
; REPLACE LINE
; 
RPLN:	CALL	LNFD
	JNZ	INSL
	PUSH	H
	PUSH	H
	INX	H
	CALL	NXTL
	NOP
	POP	D
; 
; DELETE OLD LINE
; 
RPL1:	MOV	A,M
	STAX	D
	INX	D
	INX	H
	CPI	APK
	JNC	RPL1
	DCX	D
	XCHG
	SHLD	EFPN
	NOP
	POP	D
	LHLD	APNT
	MOV	A,M
	CPI	13
	RZ	NTCHG
; 
; INSERT NEW LINE - COUNT CHARS IN NEW LINE
; 
INSL:	XCHG
	LHLD	APNT
	LXI	B,1
SL1:	MOV	A,M
	INR	C
	INX	H
	CPI	13
	JNZ	INS1
	LHLD	EFPN
	NOP
	PUSH	H
	D	H
	DB
	MOV	A,H
	CPI	MMAX
	JNC	ERMO
	SHLD	EFPN	;NEW EOF
	POP	B
; 
; MOV ALL LINES UP
; 
INS2:	LDAX	B
	MOV	M,A
	MOV	A,B
	SUB	D
	DCX	H 
	DCX	B
	JNZ	INS2
	MOV	A,C
	INR	A
	SUB	E
	JNZ	INSAPK
; 
; INSERT NEW LINE
; 
	LDA	FNUM
	STAX	D
	INX	D
	LHLD	APNT
INS3:	MOV	A,M
	STAX	D
	INX	H 
	INX	D
	CPI	13
	JNZ	INS3
	RET
; 
; LINE FINDER
; 
LNFD:	LXI	H,TOPL
	LDA	FNUM
	MOV	B,A
LNF1:	MOV	A,M
	CPI		
	RC
	CMP	B
	RNC
	INX	H 
	CALL	NXTLN
	JMP	LNF1
; 
; GET NEXT LINE START
; 
NXTL:	MOV	A,M
	INX	H
	CPI	13
	RZ
NJNC	NXTL
	DCX	H
	RET
; 
; RANDOM NUMBER GENERATOR
; 
RND:	CALL	ASPP
	MOV	A,L
	ORA	H
	JZ	GEN
	STA	LORD
	SHLD	HORD
GEN:	LDA	LORD
	MVI	C,15
	MOV	B,A
	ANI	L,3	;BITS 19 AND 24
	JPE	GEN1
	STC
GEN1:	LHLD	HORD
	CALL	HLRS
	SHLD	HORD
	MOV	A,B
	RAR
	DCR	C
	JNZ	GEN+5
	STA	LORD
	MVI	A,7FH
	ANA	H
	MOV	H,A
	CALL	ASPH
	RET 
; 
; HLCM - HL COMPLEMENT
; 
HLCM:	MOV	A,L
	CMA
	MOV	L,A
	MOV	A,H
	CMA
	MOV	H,A
	INX	H
	RET 
; 
; HLLS - HL LEFT SHIFT
; 
HLLS:	MOV	A,L
	RAL
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	RET
; 
; HLRS - HL RIGHT SHIFT
; 
HLRS:	MOV	A,H
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	RET
; 
; BUML - BINARY MULTIPLY
; 
BUML:	PUSH	H
	LXI	H,0
	SHLD	PRD	;APK
	MVI	B,16
BUM1:	LHLD	PRD1
	CALL	HLRS
	SHLD	PRD1
	LHLD	PRD	
	JNC	BUM	;APK
	POP	D
	DAD	D
	PUSH	D
BUM2:	CALL	HLRS
	SHLD	PRD	;APK
	DCR	B
	JNZ	BUM1
	NOP
	POP	D
	LHLD	PRD1
	CALL	HLRS
	RET
; 
; BUDV - BINARY DIVIDE
; 
BUDV:	CALL	HLCM
	PUSH	H
	MVI	B,17
	ORA	A
BUD1:	LHLD	DVD	
	CALL	HLLS
	SHLD	DVD	;APK
	DCR	B
	JZ	BUD	
	LHLD	DVD1
	CALL	HLLS
	SHLD	DVD1
	POP	D
	DCX	SP
	DCX	SP
	DAD	D
	JNC	BUD1
	SHLD	DVD1
	JMP	BUD1
BUD2:	POP	D
	RET
; 
; SPNZ - SPACE TO NEXT ZONE
; 
SPNZ:	LDA	CHCT
	MOV	B,A
	SUI	8
	JZ	$+6
	JNC	SPNZ+4
	MOV	C,A
	DCR	C
	MVI	A,' '
SPN3:	INR	C
	JP	SPN4
	CALL	TVTO
	INR	B
	JMP	SPN3
SPN4:	MOV	A,B
	STA	CHCT
	RET 
; 
; VSIN - INCREMENT VSTK
; 
VSIN:	CALL	STOV
	SHLD	VSTK
	RET
; 
; STOV - CHECK FOR OVERFLOW
; 
STOV:	LHLD	ASTK
	XCHG
	LHLD	VSTK
	INX	H
	INX	H
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	JNC	STOF
	RET
; 
; TAPE INPUT ROUTINE
; 
TPIN:	MVI	C,1
	LXI	D,8
	IN	TAPU
	ANA	C
	JNZ	TPIN+5
	MVI	B,19	;APK
	DCR	B
	JNZ	$-1
TPI2:	IN	TAPU
	ANA	C
	ADD	D
	RRC
	MOV	D,A
	MVI	B,128
	DCR	B
	JNZ	$-1
	DCR	E
	JNZ	TPI2
	MOV	M,A
	CMP	C
	RZ	
	INX	H 
	JMP	TPIN	;+APK
TVTI:	JMP	3F08H
TVTO:	PUSH	B
	MOV	C,A
	CALL	3809H
	POP	B
	RET 
; 
; END BLOCK 1
; STMT - STATEMENT PROCESSOR
; 
STMT:	LXI	D,LTMS
	CALL	
	INX	T
STM1:	CALL	TSTV
	JC	ERRS
	LXI	D,EQMS
	CALL	
ST
	CALL	EXPR
	CALL	DONE
	CALL	STOR
	JMP	NXT
EQMS:	DB	'='+128
	JMP	ERRS
LTMS:	DB	'LE','T'+128

	lxi	D,GOMS
	CALL	TST

	lxi	D,TOMS
	CALL	TST
	CALL	EXPR
	CALL	DONE
	JMP	XFER
TOMS:	DB	'T','O'+128
	LXI	D,SBMS
	CALL	TST
	CALL	EXPR
	CALL	DONE
	CALL	SAV
	JMP	XFER
SBMS:	DB	'SU','B'+128
	JMP	ERRS
GOMS:	DB	'G','O'+1	8
	LXI	D,PRMS
	CALL	TST
PRT1:	LXI	D,QUMS
	CALL	
	INX	T
	CALL	PRS
PRT2:	LXI	D,CMMS
	CALL	TST
K	CALL	SPNZ
N	JMP	PRT1
CMMS:	DB	','+18
	LXI	D,SMMS
	CALL	TST
	LHLD	APNT
	MOV	A,M
	CPI	13
	JZ	SMM
APK	CPI	':'
	JNZ	PRT1
	JMP	SMM	
SMMS:	DB	';'+128
	CALL	K
LF
	XRA	A
	STA	CHCT
SMM2:	CALL	DONE
	JMP	NXT
QUMS:	DB	'"'+128
	LHLD	APNT
	MOV	A,M
	CPI	13
	JZ	SMMS+1
	CPI	':'
	JZ	SMMS+1
	CALL	EXPR
	CALL	PRNV
	JMP	PRT	APKPRMS:	DB	'P','R'+128
	LXI	D,IFMS
	CALL	TST
K	CALL	EXPR
	CALL	RELP
	CALL	EXPR
	CALL	CMPR
	JNC	STMT
IFNX:	LHLD	APNT
	CALL	NXTL
	DCX	H
	SHLD	APNT
	JMP	NXT
IFMS:	DB	'I','F'+128
	LXI	D,INMS
	CALL	
	INX	T
	XRA	A
	STA	CHCT
	CALL	DTIN
INM1	CALL	TSTV
	JC	ERRS
	CALL	NCOV
	CALL	STOR
	LXI	D,CMM1
	CALL	
	INX	T
	JMP	INM1
CMM1:	DB	','+128
	XRA	A
	STA	CHCT
	CALL	DONE
	JMP	NXT
INMS:	DB	'I','N'+128
	LXI	D,RTMS
	CALL	
ST
K	CALL	DONE
	JMP	RSTO
RTMS:	DB	'RE','T'+1	8
K
I	D,ENMS
	CALL	
ST
	JMP	ENDM
ENMS:	DB	'EN','D'+128
	LXI	D,LSMS
	CALL	
ST
	JMP	LIST
KLSMS:	DB	'LIS','T'+128
	LXI	D,RNMS
	CALL	
ST
	CALL	INIT
	LXI	H,TOPL
	MOV	A,M
	CPI		APK	JC	ERRM
	JMP	NXT1-4
RNMS:	DB	'RU','N'+1	8
K	LXI	D,CLMS
	CALL	
ST
	JMP	STRT
CLMS:	DB	'CLEA','R'+128
	LXI	D,TPMS
	CALL	
ST
	JMP	TAPE
TPMS:	DB	'TAP','E'+128
	LXI	D,LDMS
	CALL	
ST
	LXI	H,TOPL
	CALL	
PIN
	SHLD	EFPNN
	JMP	ERNT
LDMS:	DB	'LOA','D'+1	8
K	LXI	D,DMSG
	CALL	TST
LDMX:	CALL	TSTV
	JNC	DMER
	LXI	D,DMC	APK	CALL	
ST
K	JMP	LDMX:
DMC	:	DB	','+128
	CALL	DONE
	JMP	NXT
DMSG:	DB	'DI','M'+128
	LXI	D,SZEM
	CALL	
ST
	CALL	SZER
	JMP	ERNT
SZEM:	DB	'SIZ','E'+128
	LXI	D,RMKS
	CALL	TST
	JMP	IFNX
RMKS:	DB	'RE','M'+1	8
K	LXI	D,CLRM
	CALL	
ST
;	CALL	CLRS	;THIS IS A NO-NO
	NOP
	NOP
	NOP
; 
	XRA	A
	STA	CHCT
	CALL	DONE
	JMP	NXT
CLRM:	DB	'CLR','S'+128
; END OF STATEMENT PROCESSOR
; IF NO MORE OPERATIONS ARE ADDED
; INPUT TESTS HERE
; 
; DEFAULT IS LET
; 
	JMP	STM1
; 
; 
	INX	T ROUTINE - STRING COMPARE
; ALTERNATE RETURN IF NO MATCH
; 
TST:	MVI	B,1
	LHLD	APNT

	INX	T1:	LDAX	D
	RAL
	JNC	
	INX	T	APK	DCR	B
	CMC

	INX	T	:	RAR
	CMP	M
	INX	H 
	INX	D
	JNZ	TST3
	MOV	A,B
	ORA	A
	JNZ	TST1
	CALL	SBL1
	RET 
; 
; SET ALT. RETURN
; 

	INX	T3:	MOV	A,B
	ORA	A
	JZ	TST5

	INX	T4:	LDAX	D
	INX	D
	RAL
	JNC	
	INX	T4
TST5:	XCHGNOPPOP	D
	PCHL	;ALT	RETURN
; 
; DONE - TEST FOR CR OR :
; 
DONE:	CALL	SBLK
	CPI	13
	RZ
	CPI	':'
	RZ
NJMP	ERRS
; 
; NXT - SETUP FOR NEXT LINE #
; 
NXT:	LHLD	APNT
	MOV	A,M
	INX	H
	CPI	':'
	JZ	NXT1
	MOV	A,M
	CPI		
	JC	EOFR
	STA	LNUM
	INX	H
NXT1:	CALL	SBL1
	JMP	STMT
; 
; XFER - NEW LINE FOR GO
; 
XFER:	CALL	ASPP
	MOV	A,H
	ORA	A
	JNZ	ERRM
	MOV	A,L
	CPI		
	JC	ERRM
XFE1:	STA	FNUM
	CALL	LNFD
	JNZ	ERML
	JMP	NXT1-4
; 
; SAV - SAVE RETURN LINE #
; 
SAV:	CALL	NXTL
	JC	EOFR
	MOV	B,M
	LXI	H,RSTR+8
	XCHG
	LHLD	RSTK
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	JNC	GSER
	MOV	M,B
	INX	H
	SHLD	RSTK
	RET
; 
; TSTV - TEST FOR VARIABLE
; 

	INX	TV:	MVI	C,0
	LHLD	APNT
	MOV	A,M
	CPI	'A'
	RC
	CPI	'Z'+1
	CMC
	RC
	MOV	B,A
	INX	H	
	MOV	A,M
	CPI	'('
	JNZ	$+9
	INX	H
	MVI	C,0E0H
	JMP	TSV1
	CPI	'1'
	JC	
SV1
	CPI	'7'
	JNC	
SV1
	INX	H
	ANI	7
	RRC
	RRC
	RRC
	MOV	C,A
TSV1:	CALL	SBL1
	MVI	A,1FH
	ANA	B
	ORA	C
	MOV	B,A
	MVI	C,-1
K
I	H,SYMT-1
KTSV2:	INX	H
	INR	C
	MOV	A,M
	ORA	A
	JZ	TSV3
	MOV	A,C
	CPI	NSYM
	JNC	SMOE
	MOV	A,M
	CMP	B
	JNZ	TSV2
	INR	A
TSV3:	MOV	M,B
	PUSH	PSW
	PUSH	PSW
	MVI	D,0
	MOV	A,C
	RAL
	MOV	E,A
	LXI	H,VSTR
	DAD	D
	MOV	A,B
	SUI	0E0H
	JNC	
SV4
	CALL	ASPH
	POP	PSW
	CZ	VSINNOPPOP	PSW
	RET
; 
; STOR - STORE VAR. VALUE
; 
STOR:	CALL	ASPP
	PUSH	H
	CALL	ASPPNOPPOP	D
	MOV	M,E
	INX	H
	MOV	M,D
	RET 
; 
; RSTO - NEW # FOR RETURN
; 
RSTO:	LHLD	RSTK
	DCX	H
	MOV	A,M
	ORA	A
	JZ	RNER
	SHLD	RSTK
	JMP	XFE1
; 
; PRNV - PRINT VARIABLE
; 
PRNV:	CALL	ASPP
	CALL	DECA
	RET
; 
; TAPE - OUTPUT TO TAPE
; 
TAPE:	LXI	H,TOPL
	MOV	A,M
	CALL	
APO
	CPI		
	JC	ERNT
	INX	H
	JMP	TAPE+3
; 
; END BLOCK 2
; ASPH - PUSH HL TO ASTK
; 
ASPH:	PUSH	H
	CALL	STOV
	DCX	D
	POP	H
	MOV	A,L
	STAX	D
	DCX	D
	MOV	A,H
	STAX	D
	XCHG
	SHLD	ASTK
	RET
; 
; ASPP - POP HL FROM ASTK
; 
ASPP:	LHLD	ASTK
	XCHG
	LXI	H,ASTR
	CALL	HLCM
	DAD	D
	JC	SUFE
	XCHGN
	MOV	D,M
	INX	H
	MOV	E,M
	INX	H
	SHLD	ASTK
	XCHG
	RET
; 
; PRS - PRINT STRING
; 
PRS:	LHLD	APNT
	DCX	H
	MOV	A,M
	CPI	'"'
	JNZ	PRS+3
	INX	H
	LDA	CHCT
	MOV	B,A
PRS1:	MOV	A,M
	INX	H
	CPI	13
	JZ	CRER
	CPI	'"'
	JZ	PRS3
	INR	B
	CALL	
VTO
	JMP	PRS1
PRS3:	MOV	A,B
	STA	CHCT
	CALL	SBL1
	RET
; 
; DECA $ CNVV - OUTPUT #
; 
DECA:	MOV	A,H
	ORA	A
	JP	DEC1
	MVI	A,'-'
	CALL	TVTO
	LDA	CHCT
	INR	A
	STA	CHCT
	CALL	HLCM
DEC1:	LXI	B,5
	LXI	D,-10000
	CALL	CNVV
	LXI	D,-1000
	CALL	CNVV
	LXI	D,-100
	CALL	CNVV
K
I	D,-10
	CALL	CNVV
	LXI	D,-1
K	CALL	CNVV
K	RET
CNVV:	PUSH	B
	MVI	B,'0'-1
K	INR	B
	DAD	D
	MOV	A,H
	RAL
	JNC	CNVV+3
	XCHG
	CALL	HLCM
	DAD	D
	MOV	A,BNOPPOP	B
	CPI	'0'
	JZ	CNV	APKCNV1:	DCR	C
	CALL	
VTO
	LDA	CHCT
	INR	A
	STA	CHCT
	MVI	B,128
	RET
CNV	:	ADD	B
	JP	CNV3
	SUB	B
	JMP	CNV1
CNV3:	DCR	C
	JZ	CNV3-4
	RET
; 
; NCOV - INPUT # TO BINARY
; 
NCOV:	LHLD	APNT
	PUSH	H
	LHLD	TMP1
	LDA	CHCT
	ORA	A
	JNZ	NCO	APK	LXI	H,IBUF
NCO	:	CALL	SBL1
	CALL	EXPR
	CALL	SBLK
	INX	H
	SHLD	TMP1
	MOV	A,H
	STA	CHCT
	POP	H
	SHLD	APNT
	RET
; 
; RELP - RELATIONAL OP TEST
; 
RELP:	LXI	D,M0
	CALL	
ST
	MVI	L,0
REL1:	MVI	H,0
	CALL	ASPH
	RET
M0:	DB	'='+1	8
K	LXI	D,M4
	CALL	
ST
K
I	D,M1
	CALL	
ST
	MVI	L,	APK	JMP	REL1
M1:	DB	'='+128
	LXI	D,M3
	CALL	TST
	MVI	L,3
	JMP	REL1
M3:	DB	'>'+1	8
K	MVI	L,1
	JMP	REL1
M4:	DB	'<'+128
	LXI	D,M41
	CALL	
ST
K	LXI	D,M5
	CALL	TST
	MVI	L,5
	JMP	REL1
M5:	DB	'='+128
K	LXI	D,M6
	CALL	TST
	MVI	L,3
	JMP	REL1
M6:	DB	'<'+128
	MVI	L,4
	JMP	REL1
M41:	DB	'>'+128
	JMP	REER
; 
; EXPR - EXPRESSION EVALUATOR
; CAN BE CALLED RECURSIVELY
; 
EXPR:	LXI	D,E0
	CALL	TST
	CALL	TERM
	CALL	ASPP
	CALL	HLCM
	CALL	ASPH
	JMP	E1
E0:	DB	'-'+1	8
K	LXI	D,E01
	CALL	
ST
	JMP	E01+1
E01:	DB	'+'+128
	CALL	
ERM
E1:	LXI	D,E	APK	CALL	TST
	CALL	
ERM
	CALL	IADD
	JMP	E1
E2:	DB	'+'+1	8
K	LXI	D,E3
	CALL	
ST
K	CALL	TERM
	CALL	ISUB
	JMP	E1
E3:	DB	'-'+128
	RET
; 
; TERM - TERM EVALUATOR
; CAN BE CALLED RECURSIVELY
; 
TERM:	CALL	FACT
	LXI	D,I1
	CALL	
ST
	CALL	FACT
	CALL	MULT
	JMP	TERM+3
I1:	DB	'*'+128
	LXI	D,I	APK	CALL	TST
	CALL	FACT
	CALL	DIVD
	JMP	TERM+3
I2:	DB	'/'+128
	RET
; 
; FACT - GET FACTORS
; 
FACT:	CALL	FNTS
	RNC
	CALL	
STV
	JC	F0
	JZ	UDVE
	CALL	ASPP
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
FAC1:	CALL	ASPH
	RET
F0:	CALL	
	INX	TN
	JC	F1
	MOV	B,H
	MOV	C,L
	CALL	ADEC
	MOV	D,B
	MOV	E,8
	XCHG
	CALL	SBL1
NTCHGN
	JMP	FAC1
F1:	LXI	D,F11
	CALL	
ST	;TEST FOR (
	CALL	EXPR	;RECURSIVE CALL
	LXI	D,FE1
	CALL	
ST
	RET
FE1:	DB	')'+128
	JMP	RPER
F11:	DB	'('+1	8
K	JMP	ERRS
; 
; FNTS - FUNCTION TEST
K; RND ONLY FUNCTION INITIALLY
; 
FNTS:	LXI	D,RNDM
	CALL	
ST
	CALL	EXPR	;RECURSIVE
	CALL	RND
	LXI	D,RPMS
	CALL	
ST
	ORA	A
	RET
RPMS:	DB	')'+1	8
K	JMP	RPER
RNDM:	DB	'RND'
	DB	'('+128
	STC
	RET
; 
; DIM SETUP AND HANDLING
; 
TSV4:	PUSH	H
	CALL	EXPR
	LXI	D,RPTV
	CALL	
ST
	JMP	$+7
RPTV:	DB	')'+128
	JMP	RPER
	CALL	ASPP
	XRA	A
	ORA	H
	JM	DMER
	ORA	L
	JZ	DMER
	XCHG
	POP	HNOPPOP	PSW
	JNZ	TSV6
; 
; NEW VAR
; NOPPUSH	D
	XCHG
	LHLD	NMLC
	XCHG
	MOV	M,E
	INX	H
	MOV	M,D
	POP	HN
	DAD	H
	DAD	D
	SHLD	NMLC
	MOV	A,H
	CPI	MMAX
	JNC	ERMO
	POP	PSW
	CALL	VSINN
	STC
	RET 
; 
; EXISTING DIM VAR
; 
TSV6:	DCX	D
	XCHG
	DAD	H
	LDAX	D
	ADD	L
	MOV	L,A
	INX	D
	LDAX	D
	ADC	H
	MOV	H,A
	CALL	ASPH
	POP	PSW
	RET
; 
; SIZE COMMAND
; 
SZER:	LHLD	EFPN
	XCHG
	LXI	H,TOPL
	CALL	HLCM
	DAD	D
	CALL	DECA
	MVI	A,5
	STA	CHCT
	CALL	SPNZ
	MVI	D,MMAX
	MVI	E,0
	LHLD	EFPN
	CALL	HLCM
	DAD	D
	CALL	DECA
	CALL	CRLF
	RET
; 
; END BLOCK 3
; CMPR - COMPARE 2 VALUES
; 
CMPR:	CALL	ASPPN
	PUSH	H
	CALL	ASPP
	XCHG
	POP	HNOPPUSH	D
	CALL	ASPH
	CALL	ISUB
	CALL	ASPP
	POP	B
; 
; HERE WITH X-Y IN HL
; 
	MOV	A,H
	ORA	A
	JNZ	CMP0
	ORA	L
	MOV	A,C
	JZ	CMP	APK	CPI	3
	RET 
CMP0:	MOV	A,C
	JP	$-4
	CPI	1
	RC
	CPI	4
	CMC
	RET
CMP	:	CPI	0
	RZ
	CPI		
	RZ
	CPI	5
	RET
; 
; ISUB/IADD - ADD - SUBTRACT
; 
ISUB:	CALL	ASPP
	CALL	HLCM
	JMP	IADD+3
IADD:	CALL	ASPP
	MOV	A,H
	ANI	128
K	RAR
	MOV	B,A
	PUSH	H
	CALL	ASPP
	MOV	A,H
	ANI	128
K	ADD	B
	POP	D
	DAD	D
	RAR	
	MOV	B,A
	MOV	A,H
	RAL
	MOV	A,B
	RAR	
	CPI	128
K	JZ	AOFE
	CPI	112
	JZ	AOFE
	CALL	ASPH
	RET
; 
; DIVD - INTEGER DIVIDE
; 
DIVD:	CALL	ASPP
	MOV	A,L
	ORA	H
	JZ	DZER
	MVI	A,128
	ANA	H
	MOV	B,A
	CM	HLCM
	PUSH	H
	CALL	ASPP
	MVI	A,128
	ANA	H
	ADD	B
	STA	TEMP
	MOV	A,H
	ORA	A
	CM	HLCM
	SHLD	DVD	APK	LXI	H,0
	SHLD	DVD1NOPPOP	H
	CALL	BUDV
	LDA	TEMP
	ORA	A
	CNZ	HLCM
	CALL	ASPH
	RET
; 
; MULT - INTEGER MULTIPLY
; 
MULT:	CALL	ASPP
	MVI	A,128
	ANA	H
	MOV	B,A
	CM	HLCM
	PUSH	H
	CALL	ASPP	
	MVI	A,128
	ANA	H
	ADD	B
	STA	TEMP
	MOV	A,H
	RAL
	CC	HLCM
	SHLD	PRD1
	POP	H
	CALL	BUML
	MOV	A,H
	RAL
	JC	MOFE
	XCHG
	LHLD	PRD	APK	MOV	A,L
	ORA	H
	JNZ	MOFE
	XCHG
	LDA	TEMP
	ORA	A
	CNZ	HLCM
	CALL	ASPH
	RET
; 
; TAPO - TAPE OUT ROUTINE
; 
TAPO:	MVI	C,9
	ORA	A
	RAL
TAP1:	OUT	TAPU
	MVI	B,128
TAP2:	DCR	B
	JNZ	TAP	APK	RAR
	DCR	C
	JNZ	TAP1
	RAR
	STC
	RAL
	OUT	TAPU
	MVI	B,255

AP3:	DCR	B
	JNZ	TAP3
	RAR	
	RET
; 
; LIST - LIST FILE ON TVT
; 
LIST:	MVI	A,1
	STA	FNUM
	MVI	A,	55
	STA	LNUM
	CALL	TSTN
	JC	LIS1
	MOV	B,H
	MOV	C,L
	CALL	ADEC
	MOV	A,L
	STA	FNUM
	STA	LNUM
	MOV	H,B
	MOV	L,C
	CALL	SBL1
	CALL	
	INX	TN
	JC	LIS1
	MOV	B,H
	MOV	C,L
	CALL	ADEC
	MOV	A,L
	STA	LNUM
;LIS1:	CALL	KLRS
LIS1:	NOP
	NOP
	NOP
	CALL	LNFD
	MOV	A,M
	CPI		
	JC	ERNT
	PUSH	H
	MVI	H,0
	MOV	L,A
	CPI	100
	JNC	LIS	APK	MVI	A,' '
	CALL	
VTO
	MOV	A,L
	CPI	10
	JNC	LIS	APK	MVI	A,' '
	CALL	
VTO
LIS2:	CALL	DECA
	POP	H
	INX	H
LIS3:	MOV	A,M
	CALL	
VTO
	INX	H
	CPI	13
	JNZ	LIS3
	CALL	LF
	MOV	B,M
	LDA	LNUM
	SUB	B
	JNC	LIS1+6
	JMP	ERNT
; 
; ERRS - ERROR HANDLING
; 
ERRS:	MVI	L,10
ERR1:	MVI	H,0
	LXI	SP,STAK
	CALL	K
LF
	CALL	DECA
	MVI	A,' '
	CALL	
VTO
	MVI	A,'A'
	CALL	TVTO
	MVI	A,'T'
	CALL	
VTO
	MVI	A,' '
	CALL	TVTO
	LDA	LNUM
	MOV	L,A
	MVI	H,0
	CALL	DECA
	CALL	KRLF
	JMP	ERNT
ERRM:	MVI	L,15
	JMP	ERR1
ERMO:	MVI	L,	0
	JMP	ERR1
EOFR:	LDA	LNUM
	ORA	A
	JZ	ERNT
	MVI	L,	5
	JMP	ERR1
ERML:	MVI	L,30
	JMP	ERR1
GSER:	MVI	L,35
	JMP	ERR1
SMOE:	MVI	L,40
	JMP	ERR1
STOF:	MVI	L,45
	JMP	ERR1
RNER:	MVI	L,50
	JMP	ERR1
CRER:	MVI	L,55
	JMP	ERR1
REER:	MVI	L,60
	JMP	ERR1
RPER:	MVI	L,65
	JMP	ERR1
UDVE:	MVI	L,70
	JMP	ERR1
AOFE:	MVI	L,75
	JMP	ERR1
MOFE:	MVI	L,80
	JMP	ERR1
DZER:	MVI	L,85
	JMP	ERR1
ENDM:	MVI	L,90
	JMP	ERR1
SUFE:	MVI	L,95
	JMP	ERR1
SLTL:	MVI	L,100
	JMP	ERR1
DMER:	MVI	L,105
	JMP	ERR1
CRLF:	MVI	A,0DH	;CARRIAGE RETURN
	CALL	
VTO
LF:	MVI	A,0AH	;LINE FEED
	JMP	TVTO
; 
; VARIABLE DEFINITIONS
; 
TVT	EQU	0
TAPU	EQU	1
CLRS	EQU	0E090H
NSYM	EQU	120
MMAX	EQU	20H
IBLN	EQU	74
; 
; STORAGE AREAS
; 
EFPN:	DS	
APKTMP1:	DS		
APKNMLC:	DS		
APKAPNT:	DS		
APKLNUM:	DS	1
FNUM:	DS	1
ASTK:	DS		
APKVSTK:	DS		
APKRSTK:	DS		
APKPRD1:	DS		
APKPRD2:	DS		
APKCHCT:	DS	1
TEMP:	DS	1
DVD1	EQU	PRD1
DVD	EQU	PRD	
HORD:	DS		
APKLORD:	DS	1
	DS	1
RSTR:	DS	8
SYMT:	DS	120
VSTR:	DS	256
ASTR	EQU	$
IBUF:	DS	74
TOPL	EQU	$
; 
	END
