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
	PUSH	H
	MVI	B,IBLN
	CALL	CLER
	POP	H
	MVI	B,IBLN-2
DTN2:	CALL	TVTI
	CMP	E
	JZ	DTN1
	CPI	18H
	JNZ	$+12
	LXI	SP,STAK
	CALL	CRLF
	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	2
	JC	ERRM
	STA	FNUM
	MOV	H,B
	MOV	L,C
	SHLD	APNT	;SET APNT
	RET
SBLK:	LHLD	APNT
	MOV	A,M
	CPI	' '
	RNZ
	INX	H
SBL1:	SHLD	APNT
	JMP	SBLK+3
; 
; TEST FOR NUMERIC
; 
TSTN:	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
	POP	D
; 
; DELETE OLD LINE
; 
RPL1:	MOV	A,M
	STAX	D
	INX	D
	INX	H
	CPI	2
	JNC	RPL1
	DCX	D
	XCHG
	SHLD	EFPN
	POP	D
	LHLD	APNT
	MOV	A,M
	CPI	13
	RZ
	XCHG
; 
; INSERT NEW LINE - COUNT CHARS IN NEW LINE
; 
INSL:	XCHG
	LHLD	APNT
	LXI	B,1
INS1:	MOV	A,M
	INR	C
	INX	H
	CPI	13
	JNZ	INS1
	LHLD	EFPN
	PUSH	H
	DAD	B
	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	INS2
; 
; 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	2
	RC
	CMP	B
	RNC
	INX	H
	CALL	NXTL
	JMP	LNF1
; 
; GET NEXT LINE START
; 
NXTL:	MOV	A,M
	INX	H
	CPI	13
	RZ
	JNC	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	33	;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	PRD2
	MVI	B,16
BUM1:	LHLD	PRD1
	CALL	HLRS
	SHLD	PRD1
	LHLD	PRD2
	JNC	BUM2
	POP	D
	DAD	D
	PUSH	D
BUM2:	CALL	HLRS
	SHLD	PRD2
	DCR	B
	JNZ	BUM1
	POP	D
	LHLD	PRD1
	CALL	HLRS
	RET
; 
; BUDV - BINARY DIVIDE
; 
BUDV:	CALL	HLCM
	PUSH	H
	MVI	B,17
	ORA	A
BUD1:	LHLD	DVD2
	CALL	HLLS
	SHLD	DVD2
	DCR	B
	JZ	BUD2
	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,192
	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+2
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	TST
STM1:	CALL	TSTV
	JC	ERRS
	LXI	D,EQMS
	CALL	TST
	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'+128
	LXI	D,PRMS
	CALL	TST
PRT1:	LXI	D,QUMS
	CALL	TST
	CALL	PRS
PRT2:	LXI	D,CMMS
	CALL	TST
	CALL	SPNZ
	JMP	PRT1
CMMS:	DB	','+128
	LXI	D,SMMS
	CALL	TST
	LHLD	APNT
	MOV	A,M
	CPI	13
	JZ	SMM2
	CPI	':'
	JNZ	PRT1
	JMP	SMM2
SMMS:	DB	';'+128
	CALL	CRLF
	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	PRT2
PRMS:	DB	'P','R'+128
	LXI	D,IFMS
	CALL	TST
	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	TST
	XRA	A
	STA	CHCT
	CALL	DTIN
INM1	CALL	TSTV
	JC	ERRS
	CALL	NCOV
	CALL	STOR
	LXI	D,CMM1
	CALL	TST
	JMP	INM1
CMM1:	DB	','+128
	XRA	A
	STA	CHCT
	CALL	DONE
	JMP	NXT
INMS:	DB	'I','N'+128
	LXI	D,RTMS
	CALL	TST
	CALL	DONE
	JMP	RSTO
RTMS:	DB	'RE','T'+128
	LXI	D,ENMS
	CALL	TST
	JMP	ENDM
ENMS:	DB	'EN','D'+128
	LXI	D,LSMS
	CALL	TST
	JMP	LIST
LSMS:	DB	'LIS','T'+128
	LXI	D,RNMS
	CALL	TST
	CALL	INIT
	LXI	H,TOPL
	MOV	A,M
	CPI	2
	JC	ERRM
	JMP	NXT1-4
RNMS:	DB	'RU','N'+128
	LXI	D,CLMS
	CALL	TST
	JMP	STRT
CLMS:	DB	'CLEA','R'+128
	LXI	D,TPMS
	CALL	TST
	JMP	TAPE
TPMS:	DB	'TAP','E'+128
	LXI	D,LDMS
	CALL	TST
	LXI	H,TOPL
	CALL	TPIN
	SHLD	EFPN
	JMP	ERNT
LDMS:	DB	'LOA','D'+128
	LXI	D,DMSG
	CALL	TST
LDMX:	CALL	TSTV
	JNC	DMER
	LXI	D,DMC2
	CALL	TST
	JMP	LDMX:
DMC2:	DB	','+128
	CALL	DONE
	JMP	NXT
DMSG:	DB	'DI','M'+128
	LXI	D,SZEM
	CALL	TST
	CALL	SZER
	JMP	ERNT
SZEM:	DB	'SIZ','E'+128
	LXI	D,RMKS
	CALL	TST
	JMP	IFNX
RMKS:	DB	'RE','M'+128
	LXI	D,CLRM
	CALL	TST
;	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
; 
; TST ROUTINE - STRING COMPARE
; ALTERNATE RETURN IF NO MATCH
; 
TST:	MVI	B,1
	LHLD	APNT
TST1:	LDAX	D
	RAL
	JNC	TST2
	DCR	B
	CMC
TST2:	RAR
	CMP	M
	INX	H
	INX	D
	JNZ	TST3
	MOV	A,B
	ORA	A
	JNZ	TST1
	CALL	SBL1
	RET
; 
; SET ALT. RETURN
; 
TST3:	MOV	A,B
	ORA	A
	JZ	TST5
TST4:	LDAX	D
	INX	D
	RAL
	JNC	TST4
TST5:	XCHG
	POP	D
	PCHL	;ALT	RETURN
; 
; DONE - TEST FOR CR OR :
; 
DONE:	CALL	SBLK
	CPI	13
	RZ
	CPI	':'
	RZ
	JMP	ERRS
; 
; NXT - SETUP FOR NEXT LINE #
; 
NXT:	LHLD	APNT
	MOV	A,M
	INX	H
	CPI	':'
	JZ	NXT1
	MOV	A,M
	CPI	2
	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	2
	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
; 
TSTV:	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	TSV1
	CPI	'7'
	JNC	TSV1
	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
	LXI	H,SYMT-1
TSV2:	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	TSV4
	CALL	ASPH
	POP	PSW
	CZ	VSIN
	POP	PSW
	RET
; 
; STOR - STORE VAR. VALUE
; 
STOR:	CALL	ASPP
	PUSH	H
	CALL	ASPP
	POP	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	TAPO
	CPI	2
	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
	XCHG
	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	TVTO
	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
	LXI	D,-10
	CALL	CNVV
	LXI	D,-1
	CALL	CNVV
	RET
CNVV:	PUSH	B
	MVI	B,'0'-1
	INR	B
	DAD	D
	MOV	A,H
	RAL
	JNC	CNVV+3
	XCHG
	CALL	HLCM
	DAD	D
	MOV	A,B
	POP	B
	CPI	'0'
	JZ	CNV2
CNV1:	DCR	C
	CALL	TVTO
	LDA	CHCT
	INR	A
	STA	CHCT
	MVI	B,128
	RET
CNV2:	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	NCO2
	LXI	H,IBUF
NCO2:	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	TST
	MVI	L,0
REL1:	MVI	H,0
	CALL	ASPH
	RET
M0:	DB	'='+128
	LXI	D,M4
	CALL	TST
	LXI	D,M1
	CALL	TST
	MVI	L,2
	JMP	REL1
M1:	DB	'='+128
	LXI	D,M3
	CALL	TST
	MVI	L,3
	JMP	REL1
M3:	DB	'>'+128
	MVI	L,1
	JMP	REL1
M4:	DB	'<'+128
	LXI	D,M41
	CALL	TST
	LXI	D,M5
	CALL	TST
	MVI	L,5
	JMP	REL1
M5:	DB	'='+128
	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	'-'+128
	LXI	D,E01
	CALL	TST
	JMP	E01+1
E01:	DB	'+'+128
	CALL	TERM
E1:	LXI	D,E2
	CALL	TST
	CALL	TERM
	CALL	IADD
	JMP	E1
E2:	DB	'+'+128
	LXI	D,E3
	CALL	TST
	CALL	TERM
	CALL	ISUB
	JMP	E1
E3:	DB	'-'+128
	RET
; 
; TERM - TERM EVALUATOR
; CAN BE CALLED RECURSIVELY
; 
TERM:	CALL	FACT
	LXI	D,I1
	CALL	TST
	CALL	FACT
	CALL	MULT
	JMP	TERM+3
I1:	DB	'*'+128
	LXI	D,I2
	CALL	TST
	CALL	FACT
	CALL	DIVD
	JMP	TERM+3
I2:	DB	'/'+128
	RET
; 
; FACT - GET FACTORS
; 
FACT:	CALL	FNTS
	RNC
	CALL	TSTV
	JC	F0
	JZ	UDVE
	CALL	ASPP
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
FAC1:	CALL	ASPH
	RET
F0:	CALL	TSTN
	JC	F1
	MOV	B,H
	MOV	C,L
	CALL	ADEC
	MOV	D,B
	MOV	E,C
	XCHG
	CALL	SBL1
	XCHG
	JMP	FAC1
F1:	LXI	D,F11
	CALL	TST	;TEST FOR (
	CALL	EXPR	;RECURSIVE CALL
	LXI	D,FE1
	CALL	TST
	RET
FE1:	DB	')'+128
	JMP	RPER
F11:	DB	'('+128
	JMP	ERRS
; 
; FNTS - FUNCTION TEST
; RND ONLY FUNCTION INITIALLY
; 
FNTS:	LXI	D,RNDM
	CALL	TST
	CALL	EXPR	;RECURSIVE
	CALL	RND
	LXI	D,RPMS
	CALL	TST
	ORA	A
	RET
RPMS:	DB	')'+128
	JMP	RPER
RNDM:	DB	'RND'
	DB	'('+128
	STC
	RET
; 
; DIM SETUP AND HANDLING
; 
TSV4:	PUSH	H
	CALL	EXPR
	LXI	D,RPTV
	CALL	TST
	JMP	$+7
RPTV:	DB	')'+128
	JMP	RPER
	CALL	ASPP
	XRA	A
	ORA	H
	JM	DMER
	ORA	L
	JZ	DMER
	XCHG
	POP	H
	POP	PSW
	JNZ	TSV6
; 
; NEW VAR
; 
	PUSH	D
	XCHG
	LHLD	NMLC
	XCHG
	MOV	M,E
	INX	H
	MOV	M,D
	POP	H
	DAD	H
	DAD	D
	SHLD	NMLC
	MOV	A,H
	CPI	MMAX
	JNC	ERMO
	POP	PSW
	CALL	VSIN
	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	ASPP
	PUSH	H
	CALL	ASPP
	XCHG
	POP	H
	PUSH	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	CMP2
	CPI	3
	RET
CMP0:	MOV	A,C
	JP	$-4
	CPI	1
	RC
	CPI	4
	CMC
	RET
CMP2:	CPI	0
	RZ
	CPI	2
	RZ
	CPI	5
	RET
; 
; ISUB/IADD - ADD - SUBTRACT
; 
ISUB:	CALL	ASPP
	CALL	HLCM
	JMP	IADD+3
IADD:	CALL	ASPP
	MOV	A,H
	ANI	128
	RAR
	MOV	B,A
	PUSH	H
	CALL	ASPP
	MOV	A,H
	ANI	128
	ADD	B
	POP	D
	DAD	D
	RAR	
	MOV	B,A
	MOV	A,H
	RAL
	MOV	A,B
	RAR	
	CPI	128
	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	DVD2
	LXI	H,0
	SHLD	DVD1
	POP	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	PRD2
	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	TAP2
	RAR
	DCR	C
	JNZ	TAP1
	RAR
	STC
	RAL
	OUT	TAPU
	MVI	B,255
TAP3:	DCR	B
	JNZ	TAP3
	RAR	
	RET
; 
; LIST - LIST FILE ON TVT
; 
LIST:	MVI	A,1
	STA	FNUM
	MVI	A,255
	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	TSTN
	JC	LIS1
	MOV	B,H
	MOV	C,L
	CALL	ADEC
	MOV	A,L
	STA	LNUM
;LIS1:	CALL	CLRS
LIS1:	NOP
	NOP
	NOP
	CALL	LNFD
	MOV	A,M
	CPI	2
	JC	ERNT
	PUSH	H
	MVI	H,0
	MOV	L,A
	CPI	100
	JNC	LIS2
	MVI	A,' '
	CALL	TVTO
	MOV	A,L
	CPI	10
	JNC	LIS2
	MVI	A,' '
	CALL	TVTO
LIS2:	CALL	DECA
	POP	H
	INX	H
LIS3:	MOV	A,M
	CALL	TVTO
	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	CRLF
	CALL	DECA
	MVI	A,' '
	CALL	TVTO
	MVI	A,'A'
	CALL	TVTO
	MVI	A,'T'
	CALL	TVTO
	MVI	A,' '
	CALL	TVTO
	LDA	LNUM
	MOV	L,A
	MVI	H,0
	CALL	DECA
	CALL	CRLF
	JMP	ERNT
ERRM:	MVI	L,15
	JMP	ERR1
ERMO:	MVI	L,20
	JMP	ERR1
EOFR:	LDA	LNUM
	ORA	A
	JZ	ERNT
	MVI	L,25
	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
ILTL:	MVI	L,100
	JMP	ERR1
DMER:	MVI	L,105
	JMP	ERR1
CRLF:	MVI	A,0DH	;CARRIAGE RETURN
	CALL	TVTO
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	2
TMP1:	DS	2
NMLC:	DS	2
APNT:	DS	2
LNUM:	DS	1
FNUM:	DS	1
ASTK:	DS	2
VSTK:	DS	2
RSTK:	DS	2
PRD1:	DS	2
PRD2:	DS	2
CHCT:	DS	1
TEMP:	DS	1
DVD1	EQU	PRD1
DVD2	EQU	PRD2
HORD:	DS	2
LORD:	DS	1
	DS	1
RSTR:	DS	8
SYMT:	DS	120
VSTR:	DS	256
ASTR	EQU	$
IBUF:	DS	74
TOPL	EQU	$
; 
	END
QU	PRD2
HORD:	DS	2
LORD:	DS	1