; 
; A FOCAL INTERPRETER FOR THE 8080
; 
; WRITTEN BY ROBERT ARNSTEIN          FALL 1975
;            5628 MEADOW CREST DRIVE
;            DALLAS, TEXAS 75230    (214) 368-6820
; 
; 
XXX	EQU	0	
PROCT	EQU	0		;ASSEMBLE FOR PROCESSOR TECHNOLOGY
INTEL	EQU	1		;ASSEMBLE FOR INTELLEC/80
INTRP	EQU	0
	IF	PROCT
	ORG	0
	JMP	RECOVER
SPAD:	DW	8192
	ENDIF
	IF	INTEL
	ORG	100H
	JMP	SKIPO
	CALL	FIXIO
	JMP	PRNTER
SKIPO:
	CALL	FIXIO
	JMP	RECOVER
FIXIO:
	LHLD	1
	LXI	B,3
	DAD	B
	SHLD	PTC3+1	;OVERLAY CALL TO CSTS
	SHLD	PC3+1
	DAD	B
	SHLD	XI33+1	;OVERLAY CALL TO CI
	DAD	B
	SHLD	PTC4+1	;OVERLAY CALL TO CO
	RET
SPAD:	DW	1D00H
	ENDIF
	IF	XXX
	ORG	0
	JMP	RECOVER
SPAD:	DW	8192
	ENDIF
SBANK	EQU	$
MULX4:
	ADI	0		;ADD OPERAND 3RD FRACTION
MULP3	EQU	$-1
	MOV	E,A		;4TH PARTIAL PRODUCT
	MOV	A,D		;3RD PARTIAL PRODUCT
	ACI	0		;ADD OPERAND 2ND FRACTION
MULP2	EQU	$-1
	MOV	D,A		;3RD PARTIAL PRODUCT
	MOV	A,C		;2ND PARTIAL PRODUCT
	ACI	0		;ADD OPERAND 1ST FRACTION
MULP1	EQU	$-1
	JMP	MULX5	
; RAM DIVIDE SUBROUTINE
DIVX5:
	SUI	0		;SUB DIVISOR 4TH FRACTION
OP4S	EQU	$-1
	MOV	A,L		;REMAINDER 3RD FRACTION
	SBI	0		;SUB DIVISOR 3RD FRACTION
OP3S	EQU	$-1
	MOV	L,A		;REMAINDER 3RD FRACTION
	MOV	A,H		;REMAINDER 2ND FRACTION
	SBI	0		;SUB DIVISOR 2ND FRACTION
OP2S	EQU	$-1
	MOV	H,A		;REMAINDER 2ND FRACTION
	MOV	A,E		;REMAINDER 1ST FRACTION
	SBI	0		;SUB DIVISOR 1ST FRACTION
OP1S	EQU	$-1
	MOV	E,A		;REMAINDER 1ST FRACTION
	MVI	A,0		;REMAINDER 4TH FRACTION
OP4A	EQU	$-1
	RET
DIVX6:
	ADI	0		;ADD DIVISOR 3RD FRACTION
OP3A	EQU	$-1
	MOV	L,A		;REMAINDER 3RD FRACTION
	MOV	A,H		;REMAINDER 2ND FRACTION
	ACI	0		;ADD DIVISOR 2ND FRACTION
OP2A	EQU	$-1
	MOV	H,A		;REMAINDER 2ND FRACTION
	MOV	A,E		;REMAINDER 1ST FRACTION
	ACI	0		;ADD DIVISOR 1ST FRACTION
OP1A	EQU	$-1
	MOV	E,A		;REMAINDER 1ST FRACTION
	MVI	A,0		;REMAINDER 4TH FRACTION
OP4X	EQU	$-1
	JMP	DIVX2
; 
; RAM LOCATIONS USED BY THE FLOATING POINT SYSTEM
; 
OVER	EQU	$ AND 0FFH
	DB	0		;INITIALLY CLEAR
PREX	EQU	OVER+1		;PREVIOUS EXPONENT
ACCE	EQU	PREX+1		;ACCUMULATOR EXPONENT
ACCS	EQU	ACCE+1		;ACCUMULATOR SIGN
ACC1	EQU	ACCS+1		;ACCUMULATOR 1ST FRACTION
ACC2	EQU	ACC1+1		;ACCUMULATOR 2ND FRACTION
ACC3	EQU	ACC2+1		;ACCUMULATOR 3RD FRACTION
SF	EQU	ACC3+1		;SUBTRACTION FLAG
	DS	20
	DS	30		;SCRATCH FOR FUNCTIONS
; 
; CHECKS STACK THEN CALLS ROUTINE POINTED TO BY H,L
; RECURSIVE SUBROUTINE CALL
; 
PUSHJ:	CALL	PCHK		;CHECK SP
	PCHL		;CALL ROUTINE
; 
; RECURSIVE SUBROUTINE RETURN
; 
RETRN:	LXI	H,FRST
	SHLD	O8àلن	0àل€ںàل€ں<0ں3<<ںON STACK, H,L POINT TO WHAT'S SAVED AFTER POINT BEHIND IT
; D,E,B,A,H,L DESTROYED
; 
PUSHF:	POP	D		;SAVE RETURN ADDRESS
	MVI	B,WORDS		;B IS COUNTER
PF1:	MOV	A,M		;GET A WORD
	INX	H
	PUSH	PSW		;SAVE ON STACK
	DCR	B		;COUNT DOWN
	JNZ	PF1		;LOOP
	PUSH	D		;RESTORE RETURN ADDRESS
	JMP	PCHK		;CHECK STACK AND RETURN
; 
; RESTORE DATA FROM STACK, H,L POINT TO PLACE TO PUT IT, DESTROYS A,D,E
; 
POPF:	POP	D		;SAVE RETURN ADDRESS
	LXI	B,WORDS		;SET UP LOOP CONTROL
	DAD	B
POPF1:	POP	PSW		;GET WORD
	DCX	H
	MOV	M,A		;RESTORE IT
	DCR	C		;COUNT DOWN
	JNZ	POPF1		;CONTINUE
	PUSH	D		;RESTORE RETURN ADDRESS
	RET
; 
; GETS A CHARACTER FROM COMBYF ADDRESS BY AXOUT
; CHECKS FOR TRAN. PUTS CHARACTER IN CHAR
; NO PARAMETERS
; UNPACK A CHARACTER. DESTROYS A,H,L,B,C,D
; 
GETC:	LXI	B,DMPSW		;POINT B TO DMP SWITCH
GETC2:	LHLD	AXOUT		;GET BUFFER ADDRESS
	MOV	A,M		;GET CHAR
	INX	H		;BUMP POINTER
	SHLD	AXOUT		;SAVE
	STA	CHAR		;SAVE CHAR
	CPI	'?'		;CHECK FOR ?
	JNZ	UT2		;NO TRACE
	LDA	DEBGSW		;TEST FOR TRACE ENABLED
	ANA	A		;SET FLAGS
	RNZ		;RET TRACE DISABLED
	LDAX	B		;GET DUMP SWITCH + FLIP
	ANA	A		;SET FLAG
	MVI	A,0
	JNZ	UT3
	MVI	A,1		;FLIP TO 1
UT3:	STAX	B
	JMP	GETC2		;GET NEXT CHARACTER INSTEAD
UT2:	LDAX	B		;GET DMPSW
	MOV	D,A		;SAVE
	LDA	DEBGSW		;LOAD DEBGSW
	ADD	D		;AND DMPSW
	RNZ		;IF BOTH ARE ZERO
	CALL	PRNTC		;THEN PRINT
	RET
; 
; SAVE CHAR IN BUFFER POINTED TO BY ACTIN
; IF CHAR IS RUBOUT LAST CHAR DELETED
; CHECKS FOR OVERFLOW
; PACK A CHARACTER. DESTROYS H,L,A
; 
PACKC:	LDA	CHAR		;GET CHAR
	LHLD	AXIN		;POINT H,L TO BUFFER
	CPI	RUBOUT		;IS CHAR RUBOUT?
	JZ	RUB1		;JUMP IF SO
	MOV	M,A		;STORE CHAR
	INX	H		;BUMP POINTER
	SHLD	AXIN		;SAVE POINTER
	INX	H		;TEST GOT OVERFLOW
	MVI	A,377Q		;BUFFER ENDS WITH 377
	CMP	M		;TEST
ERM1:	CZ	ERROR2		;CALL IF ERROR (OVERFLOW)
	RET
RUB1:	DCX	H		;BACKUP POINTER
	MVI	A,377Q		;377 BEGIN OF BUFFER
	CMP	M
	RZ		;RETURN IF BUFFER EMPTY
	SHLD	AXIN		;SAVE POINTER
	MVI	A,134Q		;ECHO RUBOUT
	CALL	PRNTC
	RET
; 
; ROUTINE MATCHES A CHAR WITH ONE IN A LIST AND BRANCHES
; TO CORRESPONDING ROUTINE.  RETURNS ON A NO-MATCH. B,C POINT
; TO CHAR LIST.  H,L POINT TO ADDRESS LIST UPON ENTRY
; ZERO ENDS CHAR CHECK LIST
; SORT AND BRANCH ON AC OR CHAR.  DESTROYS D
; 
SORTJ:	ANA	A		;IS AC=0?
	JNZ	SRT2		;AC <> 0, USE IT
	LDA	CHAR		;ELSE USE CHAR
SRT2:	MOV	D,A		;SAVE CHAR
SRT1:	LDAX	B		;GET 1ST COMPARE CHARACTER
	ANA	A		;SET FLAGS
	RZ		;ZERO = END OF LIST, NO MATCH
	CMP	D		;MATCH?
	JZ	MATCH		;JUMP IF FOUND
	INX	B		;CHECK NEXT CHAR
	INX	H		;ADVANCE POINTER
	INX	H		;TO NEXT ADDR IN TABLE
	JMP	SRT1		;CONTINUE SEARCH
MATCH:	MOV	E,M		;MATCH FOUND
	INX	H		;LOAD ADDRESS FROM
	MOV	D,M		;TABLE
	XCHG		;AND BRANCH TO IT
	POP	D		;REMOVE RET ADDR FROM STACK
	PCHL
; 
; ROUTINE TO CHECK CHAR AGAINST A TABLE
; B,C POINT TO TABLE
; NUMBER STORED IN SRTCN IS DISTANCE IN TABLE
; RETURNS TO PC+3 IF NOT FOUND
; SORT CHAR AGAINST TABLE.  DESTROYS B,C,H,L,A,D
; 
SORTC:	LXI	H,CHAR		;POINT H,L TO CHAR
	MVI	D,0		;RESET COUNTER
SRC2:	LDAX	B		;GET 1ST CHAR
	ANA	A		;SET FLAGS
	JZ	SEXC		;ZERO = END OF TABLE
	CMP	M		;TEST
	JZ	SRC1		;FOUND MATCH
	INR	D		;INCR COUNTER
	INX	B	
	JMP	SRC2		;CHECK NEXT
SRC1:	MOV	A,D		;GET COUNT
	STA	SRTCN		;SAVE COUNT
	RET
SEXC:	POP	H		;GET RET ADDRESS
	INX	H		;CALCULATE RETURN ADDRESS
	INX	H
	INX	H
	PCHL		;RETURN
; 
; IF A=0, PRINT CHAR, ELSE PRINT A
; PRINT ACCUM OR CHAR.  DESTROYS A
; 
	IF	XXX
PRNTC:	ANA	A		;SET FLAGS
	JNZ	PTC1		;ZERO = USE CHAR
	LDA	CHAR
PTC1:	MOV	E,A		;SAVE CHAR
	CPI	LF		;DON'T ECHO LINE FEED
	RZ	
	CPI	CR
	JNZ	XOUTL
	IN	KYBRD	
	ANI	7FH
	CPI	3		;CONTROL C?
	CZ	RECOVER		;BREAK
	MVI	A,CR
	CALL	XOUTL
	MVI	E,LF
XOUTL:	IN	TEST	
	ANA	A	
	JP	XOUTL
	MOV	A,E		;RESTORE CHAR
	OUT	CRT	
	RET
	ENDIF
; 
	IF	INTEL
PRNTC:	ANA	A
	JNZ	PTC1
	LDA	CHAR
PTC1:	CPI	LF		;DON'T ECHO LINE FEED
	RZ
	CPI	CR
	JNZ	XOUTL
PTC3:
	CALL	3812H
	ANA	A
	JP	PTC2
	CALL	XI33
	CPI	3		;CHECK FOR CONTROL C BREAK
	CZ	RECOVER
PTC2:	MVI	A,CR
	CALL	XOUTL
	MVI	A,LF
XOUTL:	MOV	C,A
PTC4:
	CALL	3809H
	RET
	ENDIF
; 
	IF	PROCT
PRNTC:	ANA	A
	JNZ	PTC1
	LDA	CHAR
PTC1:	CPI	LF
	RZ
	CPI	CR
	JNZ	XOUTL
	CALL	STAT
	ANA	A
	JP	PTC2
	CALL	XI33
	CPI	3
	CZ	RECOVER
PTC2:	MVI	A,CR
	CALL	XOUTL
	MVI	A,LF
	CALL	XOUTL
	MVI	A,0
; 
; XOUTL DRIVER
; 
XOUTL:	MOV	C,A		;SAVE TEMP IN C
TBE:	IN	0		;CHECK TBF
	RLC		;PUT IN CARRY
	NOP		;TO FOOL THE EXPERTS
	JNC	TBE
	MOV	A,C
	OUT	1
	RET
	ENDIF
; 
	IF	INTRP
PRNTC:	ANA	A
	JNZ	PTC1
	LDA	CHAR
PTC1:
XOUTL:	OUT	3
	RET
	ENDIF
; 
; READS A CHAR AND PRINTS ECHO IF NECESSARY
; READ DATA INTO A CHARACTER AND PRINT IT
; 
READC:	CALL	XI33		;READ A CHAR
	STA	CHAR		;SAVE IT
	LXI	B,ECHOLST		;POINT B TO LIST
	CALL	SORTC		;SORTC
	NOP		;RETURN + 3
	NOP
	RET		;YES, RETURN
	SUB	A		;CLEAR A
	JMP	PRNTC		;ECHO
; 
; PRINTS XX.XX ACCORDING TO LINENO
; PRINT C(LINENO)
; 
PRNTLN: LDA	LINENO+1		;GET LINENO
	CALL	PRNT		;PRINT 2 DIGITS
	MVI	A,'.'	
	CALL	PRNTC		;PRINT A "."
	LDA	LINENO
	CALL	PRNT		;PRINT STEP
	MVI	A,SPACE		;PRINT SPACE
	CALL	PRNTC
	RET
PRNT:	MOV	D,A		;SAVE
	ANI	0F0H		;GET FIRST DIGIT
	RRC
	RRC
	RRC
	RRC
	ADI	60Q		;CONVERT TO ASCII
	CPI	':'
	JM	$+5
	ADI	'A'-'9'-1
	CALL	PRNTC
	MOV	A,D		;GET SECOND
	ANI	0FH
	ADI	60Q
	CPI	':'
	JM	$+5
	ADI	'A'-'9'-1
	CALL	PRNTC
	RET
; 
; RETURNS NOT FOUND
; RETURNS + 3 FOUND
; THIS LN= FOUND LINE OR NEXT LARGER
; LASTLN = LESSER AND/OR LAST
; TEXTP IS SET
; 
FINDLN: 
	LXI	H,CFRS	
	SHLD	LASTLN		;INIT POINTERS
F2:	SHLD	THISLN
	INX	H
	INX	H		;POINT TO # IN LINE
	INX	H
	LDA	LINENO+1
	CMP	M
	JC	FEND3
	JNZ	FINDN
F3:	DCX	H
	LDA	LINENO
	CMP	M
	JC	FEND3
	JNZ	FINDN
F4:	POP	D
	INX	D
	INX	D
	INX	D
	PUSH	D
FEND3:	LHLD	THISLN
	INX	H
	INX	H
	INX	H
	INX	H
	SHLD	AXOUT
	RET
FINDN:	LHLD	THISLN
	SHLD	LASTLN
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A
	ORA	H
	JZ	FEND3
	JMP	F2
; 
; TERMINATE BUFFERED LINE
; INSERT LINE POINTERS. H=LASTLN, R=BUFR
; 
ENDLN:	LHLD	BUFR
	MOV	B,H
	MOV	C,L
	LHLD	AXIN
	XCHG
	LHLD	LASTLN
	MOV	A,M
	STAX	B
	INX	H
	INX	B
	MOV	A,M
	STAX	B
	DCX	H
	DCX	B
	LDA	BUFR
	MOV	M,A
	INX	H
	LDA	BUFR+1
	MOV	M,A
E3:	XCHG
	SHLD	BUFR
	SHLD	LASTV
	RET
; 
; NO PARAMETERS
; DELETES LEADING SPACES FROM COMMAND
; IGNORE SPACES AND LEADING ZEROES
; 
SPNOR:	LDA	CHAR		;GET CHAR
	CPI	' '		;IS IT A SPACE
	RNZ
	CALL	GETC		;GET NEXT CHAR
	JMP	SPNOR
; 
; GET A LINE # FROM CHARACTERS
; IF ALL, LINENO IS
; FORM LINENO (TWO BYTES) AS BCD CHAR LINE #
; GROUP # IN BYTES IF LINENO, LINE # IN BYTE 2
; RETURNS RESULT IN LINENO AND IN D,E
; UNPACK AND FORM A LINE NUMBER.  DESTROYS A,E
; 
GETLN:	CALL	SPNOR		;IGNORE LEADING SPACES
	LDA	CHAR
	CPI	'A'		;"ALL" IS SPECIAL
	JZ	ALL
	CALL	TESTN		;TEST1
	JMP	GZERR		;ILLEGAL GROUP ZERO ISE
	JMP	GZERR		;OTHER 
	LDA	CHAR
	ANI	0FH		;ISOLATE DIGIT
	MOV	E,A		;SAVE DIGIT
	CALL	GETC		;GET NEXT
	CALL	TESTN		;TEST2
	JMP	GT1		;PERIOD (ONE DIGIT GROUP #)
	JMP	GZERR		;OTHER	
	MOV	A,E		;GET HIGH ORDER OVER DIGIT
	RLC
	RLC
	RLC
	RLC
	MOV	E,A		;FIX GROUP
	LDA	CHAR
	ANI	0FH
	PUSH	PSW		;SAVE A
	CALL	GETC		;GET NEXT CHAR
	POP	PSW
GT1:	ORA	E
	JZ	GZERR		;ILLEGAL GROUP ZERO
	STA	LINENO+1
	CALL	TESTN
	JMP	GT2		;PERIOD
	JMP	GERR		;OTHER
	JMP	GZERR		;TOO LARGE GROUP
GT2:	CALL	GETC		;GET NEXT CHAR
	CALL	TESTN		;TEST3
	JMP	GZERR		;PERIOD
	JMP	GERR		;OTHER
	LDA	CHAR
	ANI	0FH		;GET DIGIT
	RLC
	RLC
	RLC
	RLC
	MOV	E,A		;SAVE
	CALL	GETC		;READ LAST CHAR
	CALL	TESTN		;TEST4
	JMP	GERR		;PERIOD
	JMP	GT4		;OTHER
	LDA	CHAR		;DIGIT
	ANI	0FH
GT3:	ORA	E
	MOV	E,A
	CALL	GETC		;CHECK SIZE
	CALL	TESTN		;TEST
	JMP	GERR		;PERIOD
	JMP	GT4		;OK
GZERR:	CALL	ERROR2		;OTHER :ILLEGAL GROUP ZERO
GT4:	MOV	A,E	
	STA	LINENO		;SAVE
	ANA	A
	JZ	GROUP		;STEP IS 0
	MVI	A,200Q		;STEP
	STA	NAGSW
	RET
GROUP:	SUB	A		;GROUP
	STA	NAGSW
	RET
ALL:	MVI	A,1
	STA	NAGSW		;ALL
	MVI	A,RUBOUT
	STA	CHAR
	LXI	H,1
	SHLD	LINENO
	RET
GERR:	CALL	ERROR4		;BAD LINE @
; 
; RETURNS IF PERIOD
; RETURNS+3 IF NON-DIGIT
; RETURNS+6 IF DIGIT
; NO PARAMETERS
; TEST FOR PERIOD,OTHER,NUMBER.  DESTROYS H,L,B,C,A
; 
TESTN:	LXI	B,3		;PC INCREMENT
	POP	H		;GET RETURN ADDRESS
	LDA	CHAR		;GET CHAR TO TEST
	CPI	'.'		;IS IT A PERIOD
	JZ	B1		;BRANCH IF YES
	CPI	3AH	
	JP	B3
	CPI	30H	
	JM	B3
	DAD	B		;IT'S A DIGIT
B3:	DAD	B
B1:	SUB	A		;CLEAR ACCUMULATOR
	PCHL
; 
; TEST SRTCN FOR LEFT PAREN
; RETURN+3 IF SO
; SKIP IF 5<SORTCN<11 (I.E., ANL.PAR)
; 
TSTLPR: LDA	SRTCN
	MOV	B,A
	SUI	9		;<12?
	RP
	POP	H		;GET RETURN ADDRESS
	MOV	A,B
	SUI	6		;>5?
	JM	T2		;NO
	INX	H
	INX	H
	INX	H
	PCHL
T2:	SUB	A
	PCHL
; 
; SKIP IF G(AC)=G(LINENO)
; 
TSTGRP: MOV	B,A
	LDA	LINENO+1
	CMP	B
	MOV	A,B
	RNZ
	XTHL
	INX	H
	INX	H
	INX	H
	XTHL
	RET
; 
; TEST THE NATURE OF AN ALPHABETIC
; RETURNS TERM
; RETURNS+3 NUMBER
; RETURNS+6 F
; RETURNS+9 ALPHANUMERIC
; TERM: NUMBER: FUNCTION: LETTER AND IGNORE SPACES
; 
TESTC:	PUSH	B
	PUSH	D
	CALL	SPNOR		;IGNORE SPACES
	LXI	B,TERMS		;TEST TERMINATIONS
	CALL	SORTC
	POP	D
	POP	B
	RET		;SORTCN IS SET
	POP	D
	POP	B
	POP	H		;NOT TERM
	INX	H
	INX	H
	INX	H
	LDA	CHAR
	CPI	'F'		;IS IT "F"?
	JZ	XT3		;YES
	PUSH	H
	PUSH	B
	PUSH	D
	CALL	TESTN
	POP	D
	POP	B
	RET		;PERIOD
	JMP	XT2		;OTHER
	POP	D
	POP	B
	RET		;NUMBER
XT2:	POP	D
	POP	B
	POP	H
	INX	H
	INX	H
	INX	H
XT3:	INX	H
	INX	H
	INX	H
	PCHL		;RET: T:N:F:A
; 
; UNCHAIN A LINE, RECOVER SPACE
; REMOVE OLD LINE OF TEXT
; 
DELETE: CALL	FINDLN		;FIND THE LINE
	RET		;ALREADY GONE
	NOP
	NOP
	SUB	A
	STA	TEMP+1
	MVI	E,4		;COUNT POINTER AND LINE NUMBER
	MVI	A,1		;DISABLE TRACE
	STA	DEBGSW
D1:	CALL	GETC		;MEASURE LENGTH OF LINE TO DELETE
	INR	E
	LDA	CHAR
	CPI	CR
	JNZ	D1
	MOV	A,E
	STA	TEMP		;SAVE COUNT
	CMA		;		;AND NEGATIVE COUNT
	INR	A
	STA	CNTR
	LHLD	THISLN		;CHECK FOR FINISHED
	INX	H
	INX	H		;POINT TO LINE #
	MOV	A,M
	INX	H
	ORA	M		;CHECK FOR LINE ZERO
	JZ	START		;IGNORE LINE ZERO DELETE
	LHLD	THISLN
	MOV	B,H		;SET UP POINTER
	MOV	C,L
	LHLD	LASTLN		;DISCONNECT
	LDAX	B
	MOV	M,A
	INX	H
	INX	B
	LDAX	B
	DCX	B
	MOV	M,A
	LXI	H,CFRS		;START AT LINE 0
DOK:	MOV	E,M		;GET NEXT LINE
	MOV	A,E
	INX	H
	MOV	D,M		;D,E POINT TO NEXT LINE
	ORA	D
	JZ	DONE		;CHECK FOR FINISHED
	DCX	H
	MOV	A,D
	CMP	B
	JC	D2		;THIS LN >?
	JNZ	D3		;NOT EQUAL
	MOV	A,E
	CMP	C		;TEST LOW ORDER
	JC	D2		;GREATER
D3:	PUSH	H		;SAVE POINTER
	LHLD	CNTR		;SET DISPLACEMENT
D4:	DAD	D		;ADD DISP<D
	SHLD	TEMP2		;SAVE
	POP	H		;RESTORE POINTER
	LDA	TEMP2		;GET NEW POINTER
	MOV	M,A		;REPLACE OLD
	INX	H
	LDA	TEMP2+1
	MOV	M,A
	XCHG		;GET NEXT
	JMP	DOK		;CONTINUE
D2:	PUSH	H		;THISLN<		;SAVE POINTER
	LXI	H,0		;DISP IS 0
	JMP	D4
; 
; GARBAGE COLLECTION (LINE DELETED)
; 
DONE:	LHLD	THISLN		;GARBAGE COLLECTION
	PUSH	H		;XRT
	XCHG
	LHLD	TEMP		;GET DISP
	DAD	D		;ADD
	PUSH	H		;XRT2
	LHLD	BUFR
	XCHG
	LHLD	CNTR
	DAD	D		;CALCULATE NEW END OF BUFR
	SHLD	BUFR
	LHLD	AXIN
	MOV	A,H
	CMA		;CALCULATE COUNT FOR LINE MOVEMENT
	MOV	H,A
	MOV	A,L
	CMA
	MOV	L,A
	POP	D		;XRT2
	PUSH	D		;SAVE
	DAD	D	
	MOV	B,H
	MOV	C,L		;B,C HOLD COUNT
	LHLD	AXIN
	XCHG
	LHLD	CNTR
	DAD	D		;CALCULATE NEW AXIN POINTER
	SHLD	AXIN
	POP	D		;XRT2
	POP	H		;XRT
DN1:	LDAX	D		;MEMORY SHIFT LOOP
	MOV	M,A
	INX	B
	INX	H
	INX	D
	MOV	A,B		;FINISHED
	ORA	C	
	JNZ	DN1		;NO
	JMP	DELETE
; 
; ERRORS
; 
ERROR2:
ERROR3:
ERROR4:
ERROR6:
ERROR5	EQU	$
ERR2:	POP	H		;GET ERROR NUMBER
	SHLD	LINENO
	JMP	R3
RECOVER:	LXI	H,0		;SET UP INIT COUNTER
	SHLD	LINENO
R3:	MVI	B,40Q	
	LXI	H,OPTR0		;FIX I/O BUFFERS
	SHLD	AXIN
R2:	MVI	M,0		;CLEAR BUFFER
	INX	H
	DCR	B
	JNZ	R2
	LHLD	SPAD
	SPHL
	MVI	A,CR
	CALL	PRNTC
	MVI	A,'?'
	CALL	PRNTC		;PRINT
	CALL	PRNTLN		;PRINT ERROR
	LHLD	PC
	INX	H
	INX	H
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A
	ORA	H		;AND LINE # UNLESS ZERO
	JZ	R4
	SHLD	LINENO		;GET LOC. OR ERROR
	MVI	A,'@'		;PRINT @
	CALL	PRNTC
	MVI	A,SPACE
	CALL	PRNTC		;PRINT SPACE
	CALL	PRNTLN		;PRINT LINE @
R4:	MVI	A,CR
	CALL	PRNTC
	JMP	START
; 
; READS KEYBOARD, RETURNS CHARACTER IN A
; INPUT WAIT
; 
	IF	XXX
XI33:	IN	KYBRD		;READ KEYBOARD
	ANA	A		;SET FLAGS
	JP	XI33		;NOTHING READ
	ANI	7FH		;STRIP PARITY
	RET
	ENDIF
	IF	INTEL
XI33:	CALL	3803H
	ANI	7FH
	RET
	ENDIF
	IF	INTRP
XI33:	IN	0
	ANI	7FH
	RET
	ENDIF
; 
	IF	PROCT
STAT:	IN	0		;GET DEV STATUS
	ANI	40H	
	RZ		;RETURN IF ZERO (NO CHAR)
	SUB	A		;MAKE IT FF
	DCR	A
	RET
XI33:
IN8:	CALL	STAT
	JZ	IN8
	IN	1
	ANI	127
	RET
	ENDIF
; 
; CHECK STACK FOR OVERFLOW, H,L,D,E,A DESTROYED
; 
PCHK:	PUSH	H		;SAVE H&L
	PUSH	D		;SAVE D&E
	LXI	H,0		;CLEAR H,L
	DAD	SP		;GET SP
	XCHG
	LHLD	LASTV		;SUBTRACT
	MOV	A,H
	CMA
	MOV	H,A
	MOV	A,L
	CMA
	MOV	L,A
	INX	H
	DAD	D		;LOWEST LOCATION
	MOV	A,H
	ANA	A		;TEST
ERM4:	CM	ERROR5
	JNZ	PCHK2
	ORA	L
	SUI	10		;WITHIN TEN STACK LOCATIONS
	CC	ERROR3		;IF < 0 THEN STACK OVERFLOW
PCHK2:	POP	D
	POP	H
	RET		;STACK OK
;  
; COMMAND INPUT DRIVER
; 
START:	LXI	H,CFRSX		;GET PC => 0
	SHLD	PC
	MVI	A,0C3H		;SET UP RESTART AT 0
	STA	0
	LXI	H,RECOVER
	SHLD	1
	SUB	A
	STA	OVER+SCRB		;CLEAR OVERFLOW
	STA	LIST3+1		;RESET MODIFY
	STA	DEBGSW
	MVI	A,1	
	STA	DMPSW		;INIT UNPACK AND TRACE SWITCH
IBAR:	LHLD	SPAD		;GET STACK START LOC
	SPHL		;SET STACK POINTER
	LXI	H,COMBUF
	SHLD	AXIN
	MVI	A,'*'
	CALL	PRNTC
IGNOR:	CALL	READC
	SUB	A
	LXI	B,LIST7
	LXI	H,INLIST
	CALL	SORTJ
	CALL	PACKC
	JMP	IGNOR
; 
; COMMAND INPUT PROCESSOR
; 
IRETN:	CALL	PACKC		;PUT CR IN BUFFER
	SUB	A
	CALL	PRNTC
	LXI	H,COMBUF		;INITIALIZE TEXTP
GONE:	SHLD	AXOUT		;SAVE IN POINTER
	CALL	GETC		;READ 1ST CHARACTER
	LHLD	SPAD		;GET STACK START LOC
	SPHL		;SET STACK POINTER
	CALL	SPNOR		;IGNORE LEADING BLANKS
	CALL	TESTN		;IS THERE A LINE #
	JMP	GZERR		;PERIOD. ILLEGAL 1ST CHAR
	JMP	INPTX		;IMMEDIATE COMMAND
	MVI	A,1
	STA	DEBGSW		;DISABLE TRACE
	CALL	GETLN		;READ LINE NUMBER
	LDA	NAGSW		;TEST FOR SINGLE LINE
	CPI	200Q
ERM6:	CNZ	ERROR3		;BAD LINE
	LHLD	BUFR		;SET POINTERS
	INX	H
	INX	H
	XCHG
	LHLD	LINENO		;SAVE LINE #
	XCHG
	MOV	M,E
	INX	H
	MOV	M,D
	INX	H
	SHLD	AXIN
	CALL	SPNOR		;IGNORE SPACES AFTER LINE #
	JMP	SRETN
	CALL	GETC		;READ 1ST CHAR AFTER LINE @
SRETN:	CALL	PACKC		;SAVE TEXT
	LDA	CHAR
	CPI	CR		;TEST END OF LINE
	JNZ	SRETN-3		;NOT END
	CALL	DELETE		;REMOVE OLD LINE IF ANY
	CALL	ENDLN		;INSERT NEW LINE
	JMP	START		;REINITIALIZE POINTERS
INPTX:	LXI	H,PROC		;CALL PROC
	CALL	PUSHJ
	LHLD	PC		;CHECK NEXT LINE
	MOV	A,M		;END OF PROGRAM?
	MOV	E,A
	INX	H
	MOV	D,M
	ORA	M
	XCHG
	JZ	START		;YES
	SHLD	PC
	INX	H
	INX	H
	INX	H
	INX	H
	JMP	GONE		;PROCESS NEXT COMMAND
; 
; RECURSIVE OPERATE, EXECUTE OR CALL
; 
DO:	CALL	GETLN		;EXECUTE ONE LINE,GROUP OR CALL
	LHLD	PC
	PUSH	H		;SAVE PC
	LHLD	TEXTP
	PUSH	H
DGRP:	LXI	H,NAGSW		;SAVE NAGSW, CHAR, LINENO
	CALL	PUSHF
	LDA	NAGSW		;CHECK SW
	ANA	A
	JM	DOONE		;ONE LINE
	CALL	FINDLN		;INIT FOR GROUP, SET THISLN
	NOP
	NOP
	NOP
	LHLD	THISLN
	SHLD	PC
	INX	H
	INX	H
	INX	H
	MOV	A,M		;SET GROUP NO
	DCX	H
	CALL	TSTGRP		;CHECK VALIDITY
	CALL	ERROR2		;NO SUCH GROUP
DGRP1:	LXI	H,PROCESS		;PROCESS COMMAND
	CALL	PUSHJ
	LXI	H,NAGSW
	CALL	POPF		;RESTORE
	LHLD	PC		;CHECK EOT
	MOV	A,M
	INX	H
	ORA	M
	JZ	DCONT		;DONE
	DCX	H
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	INX	H
	INX	H		;POINT TO LINENO
	LDA	NAGSW		;CHECK FOR GROUP
	ANA	A	
	JZ	DR3
	JP	DR2		;DO ALL
DR3:	INX	H
	MOV	A,M
	DCX	H
	CALL	TSTGRP
	JMP	DCONT		;NOT IN GROUP
DR2:	MOV	E,M		;GET NEXT LINENO
	INX	H
	MOV	D,M
	XCHG
	SHLD	LINENO
	JMP	DGRP		;CONTINUE SUBROUTINE
DOONE:	CALL	FINDLN		;FIND THE LINE
ERM8:	CALL	ERROR2		;NO SUCH LINE
	LXI	H,PROCESS		;EXECUTE IT
	CALL	PUSHJ
	LXI	H,NAGSW		;RESTORE CHAR
	CALL	POPF
DCONT:	POP	H		;RESTORE TEXT POINTERS
	SHLD	TEXTP
	POP	H		;RESTORE PC
	SHLD	PC
	JMP	PROC		;CONTINUE PROCESSING
; 
; PRIMARY CONTROL AND TRANSFER
; 
GOTO:	CALL	GETLN		;READ LINE #
	CALL	FINDLN		;LOCATE IT
ERM9:	CALL	ERROR2		;NOT THERE
	LHLD	THISLN		;SET PC
	SHLD	PC
PROCESS: CALL GETC		;TEST END OF LINE
PROC:	LDA	CHAR		;FIRST CHAR READY = USE PROC
	CPI	CR
	JNZ	PC2
PC1:	RET		;EXIT PROCESS
PC2:	LXI	B,GLIST		;IGNORE SPACE AND :
	CALL	SORTC
	JMP	PROCESS
	LDA	CHAR		;SAVE COMMAND CHARACTER
	PUSH	PSW
P4:	CALL	GETC		;GO TO TERMINATOR
	LXI	B,GLIST
	CALL	SORTC
	JMP	PC3
	JMP	P4
PC3:
	IF	INTEL
	CALL	3812H		;CHECK FOR C.C. BREAK
	ANA	A
	JP	PC3A		;NO CHAR AVAIL
	CALL	XI33		;GET CHAR
	CPI	3		;CONTROL C?
	CZ	RECOVER
	ENDIF
	IF	XXX
	IN	KYBRD		;C.C. BREAK CHECK
	ANI	07FH	
	CPI	3		;CONTROL C?
	CZ	RECOVER		;BREAK
	ENDIF
	IF	PROCT
	CALL	STAT
	ANA	A
	JP	PC3A
	CALL	XI33
	CPI	3
	CZ	RECOVER
	ENDIF
PC3A:	POP	PSW
	LXI	B,COMLST		;DO COMMAND
	LXI	H,COMGO
	CALL	SORTJ
	CALL	ERROR2		;ILLEGAL COMMAND
; 
; OUTPUT COMMAND TEXT
; 
WRITE:	MVI	A,1
	STA	DEBGSW		;DISABLE TRACE
	CALL	GETLN		;GET LINENO
W5:	CALL	FINDLN		;SEARCH FOR LINE
	JMP	WTESTG		;NOT THERE OR GROUP
	LHLD	LINENO
	MOV	A,H
	ORA	L
	JZ	W3
	CALL	PRNTLN		;PRINT LINE # AND Q SP
W3:	CALL	GETC
	SUB	A
	CALL	PRNTC		;PRINT LINE TEXT
	LDA	CHAR
	CPI	CR		;TEST END OF LINE
	JNZ	W3
	LHLD	THISLN
	MOV	A,M
	MOV	E,A
	INX	H
	MOV	D,M
	ORA	M		;TEST END OF TEXT
	XCHG
WTST2:	JZ	W6		;EXIT, DO NEXT ????? LINE
	INX	H
	INX	H		;POINT TO LINENO OF NEXT
	LDA	NAGSW
	ANA	A
	JM	W4
	INX	H
	MOV	A,M
	DCX	H
W4:	CALL	TSTGRP		;TRY NEXT LINENO FOR GROUP
	JMP	WX
WALL:	XCHG		;SET LINENO
	LDAX	D
	MOV	L,A
	INX	D
	LDAX	D
	MOV	H,A
	SHLD	LINENO
	JMP	W5
WTESTG: LHLD	THISLN		;INIT GROUP PRINTOUT
	MOV	A,H
	ORA	L
	JMP	WTST2
W6:	STA	DEBGSW
	RET
WX:	LDA	NAGSW
	ANA	A
	JM	W6
	JZ	W6
	SUB	A
	CALL	PRNTC		;PRINT CR
	JMP	WALL
; 
; COMPUTED TRANSFER
; 
JUMP:	CALL	SPNOR		;IGNORE BLANKS
	CALL	EVAL		;EVALUATE INSIDES
	MVI	E,32
	CALL	FIX		;TAKE INTEGER
	MOV	A,D
	JMP	I3		;USE IF TO BRANCH
; 
; CONDITIONAL TRANSFER PROCESS
; 
IFX:	CALL	TESTC		;IGNORE SPACES AND TEST
	CALL	EVAL		;IT
	NOP		;N- DUMP THE (EFOPE
	MVI	E,0
	LXI	B,0		;F- SKIP
	CALL	TST
	MVI	A,0
	JZ	IZ
	JP	IP
IF3:	LHLD	COMGO+8		;TRANSFER
	PCHL
IP:	INR	A
IZ:	INR	A
I3:	STA	TEMP
	SUB	A
	LXI	B,TLIST
	LXI	H,ILIST
	CALL	SORTJ		;SEARCH FOR CR
	CALL	GETC
	JMP	I3+3
IF1:	CALL	GETC
	LDA	TEMP
	DCR	A
	JNZ	I3
	JMP	IF3
; 
; LOOP CONTROL AND ASSIGNMENT
; FOR AND SET
; SET IS FOR WITH NO LOOP CONTROL
; 
SETX:
FOR:	LXI	H,GETVAR		;LOOPS, ETC.
	CALL	PUSHJ		;LOOK FOR "=" NEXT
	PUSH	H
	CALL	SPNOR		;IGNORE SPACES
	LDA	CHAR
	CPI	'='
ERM10:	CNZ	ERROR4		;LEFT OF = BAD, FOR OR SET
	CALL	GETC
	CALL	EVAL
	POP	H
	SHLD	PT1
	CALL	TST
	LHLD	PT1
	CALL	STR
	SUB	A
	LXI	B,TLIST
	LXI	H,FLST1
	CALL	SORTJ		;TEST LAST CHAR FROM EVAL
	CALL	ERROR4		;EXCESS R-PAR
FINCR:	LHLD	PT1		;SAVE VARIABLE ADDRESS
	PUSH	H
	LXI	H,EVAL-3		;EVALUATE INCREMENT IF ANY
	CALL	PUSHJ
	SUB	A
	LXI	B,TLIST
	LXI	H,FLST2
	CALL	SORTJ		;TEST TERMINATORS
	CALL	ERROR4		;ILLEGAL TERMINATOR IN FOR
FLIMIT: CALL	TST
	LXI	H,FLARG
	CALL	STR
	LXI	H,FLARG
	CALL	PUSHF
	LXI	H,EVAL-3		;GET LIMIT (NO ERROR DETECTED)
	CALL	PUSHJ
	CALL	TST
	LXI	H,FLARG
	CALL	STR
FCONT:	LXI	H,FLARG		;SAVE LIMIT
	CALL	PUSHF
	LXI	H,TEXTP
	CALL	PUSHF		;SAVE TEXT OF OBJECT STMTS
	LXI	H,PROCESS
	CALL	PUSHJ		;DO OBJECT
	LXI	H,TEXTP
	CALL	POPF		;RESTORE REMAINING TEXT
	LXI	H,FLARG
	CALL	POPF		;GET LIMIT
	LXI	H,ITER1
	CALL	POPF		;GET INC
	POP	H
	SHLD	PT1		;GET VARIABLE ADDRESS
	CALL	LOD
	LXI	H,ITER1
	CALL	AD
	LHLD	PT1
	CALL	STR
	LXI	H,ITER1
	CALL	LOD
	CALL	TST
	PUSH	PSW
	LHLD	PT1
	CALL	LOD
	POP	PSW
	LXI	H,FLARG
	JP	OLDTST
	CALL	SB
	RM
	JMP	FORMR
OLDTST: CALL	SB
	JZ	FORMR
	RP
FORMR:	LHLD	PT1
	PUSH	H		;SAVE ADDRESS
	LXI	H,ITER1
	CALL	PUSHF		;SAVE INC AGAIN
	JMP	FCONT
FINFIN: LXI	H,FLTONE
	CALL	PUSHF		;SET INC TO ONE
	CALL	TST
	LXI	H,FLARG
	CALL	STR
	JMP	FCONT
; 
; INPUT-OUTPUT STATEMENTS
; 
ASK:	SUB	A		;REMEMBER WHICH CALL
	CMA
TYPE:	STA	ATSW
TASK:	SUB	A
	STA	DEBGSW		;RE-ENABLE TRACE
	LXI	B,ALIST		;SPECIAL CHAR?
	LXI	H,ATLIST
	CALL	SORTJ
	LDA	ATSW
	INR	A		;TEST QUOTE SWITCH
	JNZ	TYPE2		;TYPE
	LXI	H,GETVAR
	CALL	PUSHJ		;DO ASK-SET UP PT1
	LDA	CHAR		;SAVE IN-LINE CHAR
	PUSH	PSW
	PUSH	H
	MVI	A,':'		;TYPE COLON
	CALL	PRNTC
	LXI	H,IOBUF
	SHLD	AXIN
AK2:	CALL	READC
	CALL	PACKC
	SUB	A
	LXI	B,SPECIAL
	LXI	H,INFIX
	CALL	SORTJ
	JMP	AK2
AK3:	CALL	PACKC
	LHLD	AXOUT
	PUSH	H
	LXI	H,IOBUF
	SHLD	AXOUT
	CALL	EVAL-3
	POP	H
	SHLD	AXOUT
	CALL	TST
	POP	H
	CALL	STR
AK5:	POP	PSW
	STA	CHAR
	JMP	ASK		;CONTINUE
AK4:	POP	H
	JMP	AK5
TYPE2:	LXI	H,EVAL		;DO TYPE
	CALL	PUSHJ
	LXI	H,IOBUF
	CALL	OU
	LXI	H,IOBUF
	MVI	B,13
TYP:	MOV	A,M
	ADI	60Q
	CALL	PRNTC
	DCR	B
	INX	H
	JNZ	TYP
	JMP	TYPE
TQUOT:	MVI	A,1		;DISABLE TRACE
	STA	DEBGSW
TQ2:	CALL	GETC		;TYPE LITERALS
	SUB	A
	LXI	B,TLST2
	LXI	H,TLST3
	CALL	SORTJ
	SUB	A
	CALL	PRNTC
	JMP	TQ2
TINTR:	CALL	GETC		;PASS %
	CALL	GETLN		;READ FORMAT CONTROL
	LHLD	LINENO
	SHLD	FISW		;SAVE FORMAT CODE
	JMP	TASK
TCRL2:	MVI	A,CR		;SPLAR=CR ALONE
	CALL	PRNTC
TCRLF:	MVI	A,CR		;) IS BOTH
	CALL	XOUTL
TASK4:	CALL	GETC		;MOVE TO NEXT CHARACTER
	JMP	TASK
; 
; SEARCH ROUTINES
; 
MODIFY: CALL	GETLN		;READ LINENO
	CALL	FINDLN		;LOOK IT UP
ERM13:	CALL	ERROR2		;NON-EXISTENCE
	CALL	PRNTLN
	LHLD	BUFR		;SET POINTERS
	INX	H
	INX	H
	LXI	D,LINENO		;COPY SAME LINE #
	LDAX	D
	MOV	M,A
	INX	D
	INX	H
	LDAX	D
	MOV	M,A
	INX	H
	SHLD	AXIN		;FOR INPUT
SCONT:	CALL	XI33		;READ, NO ECHO
	STA	LIST3+1		;SAVE SEARCH CHAR
	MVI	A,1
	STA	DEBGSW		;NO BREAKS
SCHAR:	CALL	GETC		;TYPE + TEST -F.F.
	SUB	A
	CALL	PRNTC		;TYPE
	SUB	A
	LXI	B,LIST3
	LXI	H,LISTGO
	CALL	SORTJ		;LOOK FOR MATCH
	CALL	PACKC		;SAVE NEW LINE
	JMP	SCHAR
SBAR:	LHLD	BUFR		;RESTART BUFFER ADDRESS
	INX	H
	INX	H
	INX	H
	INX	H
	SHLD	AXIN		;SET POINTERS
SFOUND: CALL	READC		;READ KEYBOARD
	SUB	A
	LXI	B,LIST6	
	LXI	H,SRNLST
	CALL	SORTJ	
SGOT:	CALL	PACKC		;PACK CHAR
	JMP	SFOUND		;MORE
; 
; GET A VARIABLE FROM VARIABLE LIST
; EXIT H&L POINT TO VALUE PART OF LIST
; PUSHES AXOUT PAST VARNAME
; 
GETVAR: CALL	SPNOR		;IGNORE BLANKS
	LDA	CHAR		;GET FIRST CHARACTER OF NAME
	MOV	B,A		;SAVE
	PUSH	B
	CALL	GETC		;GET SECOND CHARACTER OF NAME
	POP	B
	CALL	TESTC
	JMP	NOTA
	NOP	
	NOP
	NOP
	NOP
	NOP
	NOP
	LDA	CHAR
	MOV	C,A		;ALPHA SAVE
	PUSH	B
	JMP	GV2
NOTA:	MVI	C,'@'		;SUBSTITUTE FOR SECOND CHAR IF MISSING
	PUSH	B
	JMP	GV2B
GV2:	CALL	GETC
GV2B:	CALL	TESTC
	JMP	GV2A		;TERMINATOR
	JMP	GV2		;N
	JMP	GV2		;FUNCTION
	JMP	GV2		;VARIABLE
GV2A:	CALL	TSTLPR
	JMP	NOSUB
	CALL	ECALL
	LXI	H,ACCE+SCRB
	CALL	PUSHF
	LHLD	PT1
	CALL	LOD
	MVI	E,32
	CALL	FIX		;CONVERT TO FIXED
	MOV	E,D		;SAVE SUBSCRIPT
	MOV	D,C		;LEAST SIGNIFICANT PORTION
	XCHG
	SHLD	TEMP
	LXI	H,ACCE+SCRB
	CALL	POPF
	LHLD	TEMP
	PUSH	H
	LHLD	AXOUT		;POINT POINTER PAST VARNAME
	DCX	H
GV5:	MOV	A,M
	CPI	')'
ERM14:	CNZ	ERROR4
	CALL	GETC
GV6A:	CALL	TESTC
	JMP	FNOVR-2		;TERM
	JMP	GV6		;N
	JMP	GV6		;FUNCTION
GV6:	CALL	GETC		;VARIABLE
	JMP	GV6A
NOSUB:	LXI	D,0		;NO SUBSCRIPT MEANS MAKE IT ZERO
	PUSH	D
	POP	D
	POP	B
FNOVR:	LHLD	STRTV		;DCHECK VARLST
GV3:	LDA	LASTV		;FISRT HALF OF END OF VAR CHECK
	CMP	L
	JZ	HC
GV4:	MOV	A,M
	CMP	B		;CHECK VARNAME
	INX	H
	JNZ	NOPE1
	MOV	A,M
	CMP	C		;CHECK VARNAME 2ND CHAR
	INX	H
	JNZ	NOPE2
	MOV	A,M
	CMP	D		;CHECK SUBSRCIPT
	INX	H
	JNZ	NOPE3
	MOV	A,M
	CMP	E		;CHECK 2ND HALF OF SUBSCRIPT
	INX	H
	RZ		;RETURN IF FOUND
	JMP	NOPE
NOPE1:	INX	H
NOPE2:	INX	H
NOPE3:	INX	H
NOPE:	INX	H
	INX	H	
	INX	H
	INX	H
	JMP	GV3		;TRY NEXT VARIABLE
HC:	LDA	LASTV+1		;CHECK 2ND HALF OF VARS
	CMP	H
	JNZ	GV4		;NOT END OF VARS
	MOV	M,B		;NOT CREATED YET
	INX	H
	MOV	M,C
	INX	H
	MOV	M,D
	INX	H
	MOV	M,E
	INX	H		;NOW CREATED
	PUSH	H		;SAVE POINTER TO VALUE
	SUB	A
	MOV	M,A
	INX	H
	INX	H
	INX	H
	INX	H
	SHLD	LASTV		;MADE VARIABLE SAVE NEW END OF LIST
	POP	H	
	RET		;RETURN POINTER TO VALUE
;  
ECALL:	LXI	H,ACCE+SCRB		;
	CALL	PUSHF
	LDA	LASTOP
	PUSH	PSW
	LDA	STE
	PUSH	PSW
	LXI	H,EVAL-3
	CALL	PUSHJ
	POP	PSW
	STA	STE
	POP	PSW
	STA	LASTOP
	CALL	TST
	LXI	H,FLAC
	SHLD	PT1
	CALL	STR
	LXI	H,ACCE+SCRB
	CALL	POPF
	RET
	CALL	GETC
EVAL:	SUB	A
	STA	STE
	LDA	CHAR
	CPI	'+'		;TEST FOR UNARY +
	JZ	ENUM
	CPI	'-'		;TEST FOR UNARY -
	JZ	ENUM
EVALC:	CALL	TESTC
	JMP	ETRM1		;TERM
	JMP	ENUM		;N
	JMP	EFUN		;FUNCTION
VARGET: CALL	GETVAR		;VARIABLE
	SHLD	PT1
	JMP	EDO
OPNEXT: LDA	SRTCN
	STA	LASTOP
	CALL	TESTC
	JMP	ETRMN		;TERM
ERM15:	CALL	ERROR4		;N
ERM16:	CALL	ERROR4		;FUNCTION
	CALL	ERROR4		;VARIABLE
ETRM1:	LDA	SRTCN
	CPI	6		;NULL PARFNS
	JZ	ELPAR
ETRMN:	CALL	TSTLPR		;OP MISSING
	JMP	ETR2
	CALL	ERROR4
ETR2:	CALL	GETC
	JMP	EVALC
ENUM:	LXI	H,DATBUF
	PUSH	H
ENLP:	LXI	B,TERMS
	CALL	SORTC
	JMP	NUMD
ENL3:	POP	H
	LDA	CHAR
	SUI	60Q
	MOV	M,A
	INX	H
	CPI	'E'-60Q
	JNZ	ENL2
	PUSH	H
	CALL	GETC
	CALL	SPNOR
	JMP	ENL3
ENL2:	PUSH	H
	CALL	GETC
	JMP	ENLP
NUMD:	POP	H
	MVI	M,0FFH
	CALL	TST
	LXI	H,FLARG
	CALL	STR
	LXI	H,DATBUF
	CALL	INP
	LXI	H,FLAC
	SHLD	PT1
	CALL	STR
	LXI	H,FLARG
	CALL	LOD
	JMP	EDO
EFUN:	LXI	H,ACCE+SCRB
	CALL	PUSHF		;SAVE ACCUM
	CALL	GETC
	CALL	GETC
	LDA	CHAR
	PUSH	PSW		;SAVE FUNCTION CODE
FUN3:	CALL	GETC		;MOVE TO EXPRESSION
	CALL	TESTC
	JMP	FUN2		;TERM
	JMP	FUN3		;N
	JMP	FUN3		;FUNCTION
	JMP	FUN3		;VARIABLE
FUN2:	CALL	TSTLPR		;MUST BE A (
	CALL	ERROR6		;NO PAREN
FUN4:	CALL	ECALL		;EVALUATE FUNTION INPUT
	POP	PSW		;RESTORE FUNCTION CODE
	LXI	H,EFUN3		;GET RETURN ADDRESS
	PUSH	H		;SAVE ON STACK
	LXI	B,FNTBL		;GET FUNCTION CODES
	LXI	H,FNTBF		;ADDRESS OF FUNCTIONS
	CALL	SORTJ		;GOTO FUNCTION
	CALL	ERROR6		;BAD FUNCTION CODE
EFUN3:	LXI	H,ACCE+SCRB
	CALL	POPF		;RETURN FROM FUNCTIONS, RESTORE ACCUM
	JMP	ELPR2
ETERM:
EDO:	LDA	STE
	ANA	A
	MVI	A,1
	STA	STE
	JNZ	EFST
	LXI	H,LOD
	SHLD	FLOP+1
	JMP	FLOP-3
EFST:	LDA	LASTOP
	LXI	H,OPTBL
ELP:	DCR	A
	INX	H
	INX	H
	JZ	EFND
	JMP	ELP
EFND:	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	SHLD	FLOP+1
	LHLD	PT1
FLOP:	CALL	LOD
	LDA	OVER+SCRB
	ANA	A
ERM21:	CNZ	ERROR6		;OVERFLOW
	LDA	SRTCN
	SUI	9
	JM	OPNEXT
	RET
ELPAR:	LDA	LASTOP
	PUSH	PSW
	LDA	STE
	PUSH	PSW
	CALL	ECALL
	POP	PSW
	STA	STE
	POP	PSW
	STA	LASTOP
ELPR2:	CALL	GETC
	CALL	TESTC		;SET SRTCN
	JMP	ETERM
	JMP	ETERM
	JMP	ETERM
	JMP	ETERM
; 
; ERASE SINGLE LINES,GROUPS,OR VARIABLES
; 
ERASE:	MVI	A,1		;TURN OFF TRACE
	STA	DEBGSW
	CALL	TESTC		;TEST SECOND WORD IF ANY
	JMP	ERVX		;ERASE VARIABLES
	JMP	ERL		;LINES OR GRUOPS
ERM22:	CALL	ERROR3
	LDA	CHAR		;ALL TEXT
	CPI	'A'
	CNZ	ERROR3		;BAD ARG IN ERASE
ERT:	LXI	H,BUFBEG		;ERASE ALL TEXT
	SHLD	BUFR
	LXI	H,CFRS
	MVI	M,0
	INX	H
	MVI	M,0
ERV:	LHLD	STRTV		;ERASE VARIABLES
	SHLD	LASTV
	JMP	START		;FIX POINTERS
ERL:	CALL	GETLN		;ERASE LINES
	LHLD	BUFR		;PROTECT REST OF LINE
	SHLD	AXIN
ERG:	CALL	DELETE		;EXTRACT A LINE
	LHLD	THISLN
	INX	H
	INX	H
	SHLD	THISLN
	LDA	NAGSW
	ANA	A
	JM	ER1
	INX	H
	MOV	A,M
ER1:	CALL	TSTGRP		;SKIP
	JMP	ERV
	LHLD	THISLN		;
	LXI	D,LINENO
	MOV	A,M
	STAX	D
	INX	H
	INX	D
	MOV	A,M
	STAX	D
	JMP	ERG
ERVX:	LHLD	STRTV		;INITIATE VARIABLE BY INDIRECT COMMAND
	SHLD	LASTV
	RET
; 
;SYMBOL TABLE TYPE OUT ROUTINE
; 
TDUMP:	MVI	A,'N'
	CALL	PRNTC
	MVI	A,'I'
	CALL	PRNTC
	RET
; 
; FLOATING POINT FUNCTIONS
;  INPUT TO FLOATING POINT FUNCTIONS IS POINTED TO BY PT1 (LHLD PT1)
;  INPUT IS 4 BYTES LONG. IT USUALLY COMES FROM THE ARGUMENT TO THE FUNCTION.
;  OUTPUT FROM FLOATING POINT FUNCTIONS SHOULD BE FOUR BYTES POINTED TO BY
;  PT1.
; 
XUSR:	RET
; 
; INVERSE DIVIDE ROUTINE
; 
IDV:	PUSH	H		;
	CALL	TST		;FLOATING POINT ACCUM TO REGISTERS
	MVI	L,IDVT
	CALL	STR		;DIVISOR TO STORAGE
	POP	H
	CALL	LOD		;DIVIDE TO FLAC
	MVI	L,IDVT		;ADDRESS DIVISOR
	JMP	DIV		;RETURN THROUGH DIVIDE ROUTINE
; 
; SUBROUTINE FOR THE EVALUATION OF ELEMENTARY FUNCTION MACLAURIN SERIES
; 
;  ENTRY FMACE FOR EXPONENTIAL TYPE SERIES,E.G.
;  ENTRY FMACL FOR LOGRITHMIC TYPE SERIES,E.G.
;  ARCTAN(Z)=Z/1-Z**3/3+Z**5/5 ...
;   S(I-1)=(1./A(I)+X*S(I)), S(N)=0.
; 
;  IN BOTH SERIES DEL**2(A(I)) MUST BE CONSTANT
; ENTER WITH X IN FMACX, A(N) IN D, D(A(N-1)) IN C, D**2(A(1)) IN B
; RESULTS IN FMACS, WHEN A(I)<0.
; 
; 2 LEVELS OF STACK USED BEYOND FLOATING POINT PACKAGE
FMACL:	XRA	A		;CLEAR A REG FOR LOG TYPE SERIES
	LXI	H,FMACS		;POINT TO SIGMA
	MOV	M,A		;ZERO STORED
	LXI	H,FMACB		;PRESET BRANCH B
	JMP	FMACC		;JOINT CODE
FMACE:	LHLD	FONE		;MOVE 1.0 TO SIGMA FOR EXP TYPE SERIES
	SHLD	FMACS
	LHLD	FONE+2
	SHLD	FMACS+2
	LXI	H,FMACA		;PRESET BRANCH A
FMACC:	SHLD	FMACG		;STORE PRESET BRANCH
	MVI	E,32		;COUNT FOR FLOATING OF A(I)
FMACD:	PUSH	B		;CHAIN RULE LOOP
	PUSH	D		;SAVE A(I), D(A(I)), D**2(A(1))
	XRA	A		;ZERO THE LEAD POSITIONS OF A(I)
	MOV	B,A	
	MOV	C,A
	CALL	FLT		;FLOAT A(I)
	MVI	L,FMACT		;INTO TEMP
	CALL	STR
	MVI	L,FMACX		;LOAD THE ARGUMENT
	CALL	LOD
	MVI	L,FMACS		;SIGMA SO FAR
	CALL	MUL
	LHLD	FMACG		;CHOOSE THE BRANCH
	PCHL
FMACA:	LXI	H,FMACT
	CALL	DIV
	LXI	H,FONE		;POINTS TO 1.0
	JMP	FMACF		;REJOIN COMMON CODE
FMACB:	LXI	H,FMACS
	CALL	STR		;X*SIGMA
	LXI	H,FONE		;LOAD 1.0
	CALL	LOD
	MVI	L,FMACT	
	CALL	DIV		;1/A(I)
	MVI	L,FMACS	
FMACF:	CALL	AD
	MVI	L,FMACS	
	CALL	STR
	POP	D		;A(I) AND 32
	POP	B		;D(A) AND D**2(A)
	MOV	A,D
	SUB	C
	RZ		;DONE IF ZERO
	RC		;OR NEGATIVE
	MOV	D,A		;A(I-1)
	MOV	A,C		;D(A(I-1))
	SUB	B
	MOV	C,A		;D(A(I-2))
	JMP	FMACD		;NEXT ITERATION
; 
; ??????????????
; 
FONE:	DB	81H
	DB	0
	DB	0
	DB	0
FPIV2:	DB	81H
	DB	49H
	DB	0FH
	DB	0DCH		;PI/2
FLN2:	DB	80H
	DB	31H
	DB	72H
	DB	18H		;LN 2
; 
; SINE-COSINE USING MACLAURIN SERIES
; 
; ENTRY FSIN FOR SIN(X)
; ENTRY FCOS FOR COS(X)
;       ENTER WITH X IN RADIANS IN FLOATING POINT ACCUMULATOR
; (IF ABS(X) > 2**24*PI, OVERFLOW FLAG IS SET
; 
; WRITTEN BY O.C. JUELICH, 165-796, B6
; MISSILE SYSTEMS DIVISION, ROCKWELL INTERNATIONAL CORP.
; APRIL 1975
; 
; ENTRIES TO FLOATING PACKAGE
; 
; 3 LEVELS OF STACK USED BEYOND FLOATING POINT PACKAGE
; 
FCOS:	LHLD	PT1
	CALL	LOD
FCOS0:	CALL	CHS		;COMPLEMENT THE ANGLE
	LXI	H,FPIV2
	CALL	AD
	JMP	FSIN0
FSIN:
	LHLD	PT1
	CALL	LOD
FSIN0:	CALL	TST		;FETCH ARGUMENT
	MVI	L,FSINX	
	CALL	STR
	LXI	H,FPIV2		;REDUCE X TO REVOLUTIONS * 4
	CALL	DIV
	MVI	E,26
	CALL	FIX
	JC	OVERF		;QUIT IF ANGLE TOO LARGE
	MVI	E,26
	MVI	D,0		;WIPE OUT FRACTIONAL REVOLUTIONS
	CALL	FLT		;INTEGER PART OF REVOLUTIONS
	LXI	H,FPIV2		;TO RADIANS
	CALL	MUL
	CALL	CHS		;SUBTRACT INTEGRAL PART
FSINA:	MVI	L,FSINX		;SUM IS REDUCED
	CALL	AD
	MVI	L,FSINX		;SAVE IT
	CALL	STR
	CALL	ABS		;FORCE ANGLE INTO REDUCED RANGE
	LXI	H,FPIV2
	CALL	SB
	JM	FSINB		;IF NEGATIVE OR ZERO
	JZ	FSINB		;THEN ANGLE IS REDUCED
	LXI	H,FPIV2		;ABS(X)-PI
	CALL	SB
	MOV	E,A		;SAVE A REGISTER
	MVI	L,FSINX+1
	MOV	A,M
	ANI	80H		;SIGN OF X
	XRI	80H		;INVERTED
	XRA	B		;-SIGN(X)*(ABS(X)-PI)
	MOV	B,A
	MOV	A,E		;RESTORE A REGISTER
	DCX	H		;POINT TO FSINX
	CALL	STR		;REDUCED X
	CALL	ZRO		;CLEAR ACCUMULATOR
	JMP	FSINA		;REPEAT UNTIL ABS(X) <= PI/2
; 
FSINB:	MVI	L,FSINX	
	CALL	LOD
	MVI	L,FSINX
	CALL	MUL
	CALL	CHS		;-X**2
	MVI	L,FMACX	
	CALL	STR		;TO MACLAURIN SERIES
	MVI	D,72		;9*8, I1 TERM DISCARDED, 18 BITS PRECISION
	MVI	C,30		;9*8-7*6
	MVI	B,8		;(9*8-7*6)-(7*6-5*4)
	CALL	FMACE
	MVI	L,FMACS		;SUM OF SERIES/X
	CALL	LOD
	MVI	L,FSINX	
	CALL	MUL
	CPI	81H		;SEE IF TAIL NEEDS CLEANING
	JC	FSINC		;NO, MAGNITUDE IS < 1./
	MVI	L,ACC2
	XRA	A		;ZEROES FOR THE TAIL
	MOV	M,A
	INR	L
	MOV	M,A
FSINC:	CALL	TST		;RESTORE FLAGS AND REGISTERS
	LHLD	PT1
	CALL	STR
	RET
; 
; ARCTAN ROUTINE USING MACLAURIN SERIES
; ENTRY FATAN FOR ARCTAN(X), WITH X IN FLOATING ACCUMULATOR
; RESULT RETURNED IN FLOATING ACCUMULATOR
; WRITTEN BY O.C. JUELICH
; 
; FOUR LEVELS OF STACK USED BEYOND FLOATING POINT PACKAGE
; 
ARTN:	
	LHLD	PT1
	CALL	LOD
FATAN:	CALL	TST		;GET F.P. ACC. INTO REGISTERS
	RZ
	CPI	81H		;TEST EXPONENT
	JC	FATN1		;RETURN TO CALLER FROM FATN1
	LXI	H,FONE		;1.0
	CALL	IDV		;1.0/X
	CALL	FATN1		;GET ARCTAN(1/X)
	MVI	L,FATNU		;SIGN(T)*(PI/2-ABS(T))
	CALL	STR
	LXI	H,FPIV2		;PI/2
	CALL	LOD
	MOV	E,A		;SAVE A-REGISTER
	MVI	L,FATNU+1
	MOV	A,M		;TO A-REGISTER
	ANI	80H
	ORA	B		;ATTACH TO PI/2
	MOV	B,A
	MOV	A,E		;RESTORE A REGISTER
	MVI	L,FATNT		;SAVE SIGN(T)*PI/2
	CALL	STR
	MVI	L,FATNT	
	CALL	LOD
	MVI	L,FATNU		;-SIGN(T) * (PI/2-ABS(T))
	CALL	SB		;=SIGN(T)*ABS(T)=T
	LHLD	PT1
	CALL	STR
	RET
; 
; EVALUATE ARCTAN OF ARGUMENTS & 1.
; 
FATN1:	MVI	L,FATNT		;POINT TO TEMP
	CALL	STR
	MVI	L,FATNT	
	CALL	MUL		;TAN(T)**2
	LXI	H,FONE
	CALL	AD
	CALL	FSQRT
	LXI	H,FONE
	CALL	AD		;1.0+SQRT(TAN(T)**2+1.0)
	MVI	L,FATNT		;TAN(T)
	CALL	IDV		;TAN(T/2)
	MVI	L,FATNT	
	CALL	STR
	MVI	L,FATNU	
	INR	A		;2*TAN(T/2)
	CALL	STR
	MVI	L,FATNT	
	CALL	MUL
	CALL	CHS		;-TAN(T/2)**2
	MVI	L,FMACX	
	CALL	STR
	MVI	D,11		;TERM 13 DISCARDED, 16 BITS PRECISION IN RANGE
	MVI	C,2		;(11-9)
	MVI	B,0		;(11-9)-(9-7)
	CALL	FMACL
	MVI	L,FMACS		;(T/2)/TAN(T/2)
	CALL	LOD
	MVI	L,FATNU		;*(2*TAN(T/2))
	CALL	MUL
	PUSH	H
	LHLD	PT1
	CALL	STR
	POP	H
	RET
; 
; EXPONENTIAL AND HYPERBOLIC SINE ROUTINE
; USING MACLAURIN SERIES FOR SINH
; ENTRY FEXP FOR EXP(X)
; ENTRY FSINH FOR FSINH(X)
;       ENTER WITH X IN FLOATING POINT ACCUMULATOR
;       RETURNS WITH FUNCTION IN FLOATING POINT ACCUMULATOR
;       IF FUNCTION EXCEEDS 2**127, OVERFLOW FLAG IS SET
; WRITTEN BY O.C. JUELICH
; 5 LEVELS OF STACK USED BEYOND FLOATING POINT PACKAGE
; 
FHYS:
	LHLD	PT1
	CALL	LOD
FSINH:	CALL	TST		;FETCH FLOATING POINT ACCUM
	MVI	L,FSNHX		;SAVE ARGUMENT
	CALL	STR
	MVI	L,FSNHD		;ADDRESS DOUBLING COUNTER
	MVI	M,0
	SUI	80H		;REMOVE OFFSET FROM A
	JM	FSNHA		;DOUBLING COUNT AND X ARE O.K.
	CPI	8		;ELIMINATE OVERSIZE DOUBLING
	JP	OVERF		;RETURN THROUGH OVERFLOW ROUTINE
	MOV	M,A		;SAVE THE DOUBLING ARGUMENTS
	MVI	L,FSNHX		;BRING ARGUMENT INTO RANGE
	MVI	M,80H
	CALL	LOD
FSNHA:	MVI	L,FSNHX	
	CALL	MUL		;X**2
	MVI	L,FMACX	
	CALL	STR
	MVI	D,42		;7*6, 9 TERM DISCARDED, 18 BITS PRECISION
	MVI	C,22		;7*6-5*4
	MVI	B,8		;(7*6-5*4)-(5*4-3*2)
	CALL	FMACE
	MVI	L,FMACS	
	CALL	LOD
	MVI	L,FSNHX	
	CALL	MUL
	MVI	L,FSNHX		;SINH(X)
	CALL	STR
	MVI	L,FSNHX		;SINH(X)**2
	CALL	MUL
	LXI	H,FONE		;1.0
	CALL	AD
	CALL	FSQRT		;COSH(X) FOR DOUBLING AND FOR EXP(X)
	MVI	L,FMACX		;TEMP
	CALL	STR
FSNHB:	MVI	L,FSNHD		;ADDRESS DOUBLING COUNT
	DCR	M		;TALLY AT LOOP TOP
	JM	FSNHC		;DONE WHEN NEGATIVE
	MVI	L,FMACX		;COSH(X/2)
	CALL	LOD
	MVI	L,FSNHX		;SINH(X/2)
	CALL	MUL
	INR	A		;2.*SINH(X/2)*COSH(X/2)
	MVI	L,FSNHX		;SINH(X)
	CALL	STR
	MVI	L,FMACX		;COSH(X)
	CALL	LOD
	MVI	L,FMACX	
	CALL	MUL
	MVI	L,ACCE		;2.*COSH(X/2)**2
	INR	M
	LXI	H,FONE		;-1.
	CALL	SB
	MVI	L,FMACX		;=COSH(X)
	CALL	STR
	JMP	FSNHB		;TEST THE DOUBLING COUNT
FSNHC:	MVI	L,FSNHX	
	CALL	LOD
	PUSH	H
	LHLD	PT1
	CALL	STR
	POP	H
	RET
FEXP:
	LHLD	PT1
	CALL	LOD
FEXP0:	CALL	TST
	JP	FEXPP
	MVI	L,OVER		;SAVE OVERFLOW FLAG
	MOV	E,M
	MVI	M,0		;CLEAR OVERFLOW FLAG
	MVI	L,FEXOV-SCR
	MOV	M,E		;OLD FLAG TO SAVE CELL
	CALL	ABS
	CALL	FEXPP		;EXP(-X) IN ACC
	MVI	L,FEXOV	
	MOV	E,M		;GET OLD OVERFLOW FLAG BACK
	MVI	L,OVER	
	MOV	A,M		;PICK UP NEW ONE TO TEST
	MOV	M,E		;RESTORE OLD OVERFLOW FLAG
	ANA	A		;SET FLAGS
	JNZ	ZRO		;RECIPROCALL OF OVERFLOW IS ZERO
	LXI	H,FONE
	CALL	IDV		;1./EXP(-X)=EXP(X)
	LHLD	PT1
	CALL	STR
	RET
FEXPP:	CALL	FSINH		;SINH(X)
	MVI	L,FMACX		;+COSH(X)
	CALL	AD		;=EXP(X)
	PUSH	H
	LHLD	PT1
	CALL	STR
	POP	H
	RET
; 
; NATURAL LOGARITHM ROUTINE USING MACLAURIN SERIES
; ENTRY FLOG FOR LN(ABS(X)), WITH X IN FLOATING POINT ACCUMULATOR
;       RESULT IS RETURNED IN FLOATING POINT ACCUMULATOR
;       IF X = 0 THE OVERFLOW FLAG IS SET
; 3 LEVELS OF STACK USED
; 
FLOG:	LHLD	PT1
	CALL	LOD
FLOG0:	CALL	ABS		;FORCE ARGUMENT POSITIVE, SET ZERO FLAG
	JZ	OVERF		;RETURN THROUGH OVERFLOW ROUTINE
	SUI	81H		;REMOVE EXPONENT OFFSET
	MVI	L,FLOGE 
	MOV	M,A
	MVI	A,81H		;NORMALIZE ARGUMENT
	MVI	L,FLOGX 
	CALL	STR		;CALL IT X
	MVI	L,FLOGX 
	CALL	LOD
	LXI	H,FONE
	CALL	AD
	MVI	L,FMACS 
	CALL	STR		;X+1.0
	MVI	L,FLOGX 
	CALL	LOD
	LXI	H,FONE
	CALL	SB		;X-1./
	MVI	L,FMACS 
	CALL	DIV
	MVI	L,FLOGX 
	CALL	STR		;(X-1.0)/(X+1.0)
	MVI	L,FLOGX 
	CALL	MUL
	MVI	L,FMACX 
	CALL	STR		;((X-1.0)/(X+1.0)*2
	MVI	D,9		;DISCARD 11 TERM FOR 18 BIT PRECISION
	MVI	C,2		;9-7
	MVI	B,0		;(9-7)-(7-5)
	CALL	FMACL
	MVI	L,FMACS 
	INR	M		;DOUBLE THE SUM
	CALL	LOD
	MVI	L,FLOGX
	CALL	MUL		;LOGARITHM OF FRACTIONAL PART
	MVI	L,FLOGX 
	CALL	STR
	MVI	L,FLOGE 
	MOV	A,M		;EXPONENT AS INTEGER
	MVI	B,0
	MOV	C,B
	MOV	D,B
	MVI	E,8		;BINARY SCALE FOR EXPONENT
	CALL	FLT
	LXI	H,FLN2
	CALL	MUL		;LOGARITHM OF 2**EXPONENT
	MVI	L,FLOGX 
	CALL	AD
	LHLD	PT1
	CALL	STR
	RET
XSQT:	LHLD	PT1		;POINT TO INPUT
	CALL	LOD		;LOAD IT
; 
; ONE LEVEL OF STACK USED BEYOND FLOATING PACKAGE
; 
FSQRT:	CALL	ABS		;FORCE ARG POSITIVE, SET ZERO FLAG
	RZ		;RETURN ON ZERO
	MVI	L,FSQRN		;STORAGE FOR ARGUMENT
	CALL	STR
	ANA	A		;RESET CARRY BIT
	RAR		;HALVE THE EXPONENT
	ADI	40H		;RESTORE THE OFFSET
	MVI	L,FSQRX		;STORE THE FIRST
; 
; ITERATE
; 
	CALL	STR
	MVI	D,5		;ITERATION COUNT
	PUSH	D		;STACKED
FSQRL:	MVI	L,FSQRN		;LOAD THE ARGUMENT
	CALL	LOD
	MVI	L,FSQRX		;DIVIDE BY ITERATE
	CALL	DIV
	MVI	L,FSQRX		;ADD ITERATE
	CALL	AD
	SUI	1		;HALVE THE RESULT
	MVI	L,FSQRX		;RESTORE NEXT ITERATE
	CALL	STR
	POP	D		;RESTORE ITERATION COUNT
	DCR	D		;TALLY
	JZ	FSQRE		;EXIT WHEN COUNT EXHAUSTED
	PUSH	D		;SAVE IT OTHERWISE
	JMP	FSQRL		;TO NEXT ITERATION
FSQRE:	MVI	L,FSQRX		;RESULT TO ACCUMULATOR
	CALL	LOD
	PUSH	H
	LHLD	PT1		;POINT TO OUTPUT
	CALL	STR
	POP	H
	RET
; 
; PSEUDO RANDOM NUMBER GENERATOR
; 
XRAN:	LXI	H,RAN0+3
	MVI	B,8
	MOV	A,M
RN1:	RLC
	RLC
	RLC
	XRA	M
	RAL
	RAL
	DCX	H
	DCX	H
	DCX	H
	MVI	C,4
RN2:	MOV	A,M
	RAL
	MOV	M,A
	INX	H
	DCR	C
	JNZ	RN2
	DCX	H
	DCR	B
	JNZ	RN1
	LXI	H,RAN0
	CALL	LOD
	LHLD	PT1
	MVI	A,80H
	CALL	STR
	RET
XABS:	LHLD	PT1		;GET VALUE TO OPERATE ON
	CALL	LOD
	CALL	ABS
	LHLD	PT1		;GET ADDRESS TO PUT IT
	CALL	STR
	RET
XINT:	LHLD	PT1		;GET VALUE TO OPERATE ON
	CALL	LOD
	MVI	E,32		;SCALING FACTOR IS 32
	CALL	FIX		;TAKE INTEGER
	MVI	E,32
	CALL	FLT		;FLOAT RESULT
	LHLD	PT1		;GET RESTORE ADDRESS
	CALL	STR
	RET
XSGN:	LHLD	PT1		;GET ADDRESS OF OPERAND
	CALL	LOD
	CALL	TST		;TEST IFRT
	JZ	XSG1		;ZERO
	JM	XSG2		;LESS THAN ZERO
	LXI	H,FLTONE		;>0, RESULT=1
	CALL	LOD		;LOAD 1
XSG3:	LHLD	PT1		;GET POINTER TO RESULT
	CALL	STR		;STORE RESULT
	RET
XSG1:	SUB	A		;MAKE EXPONENT ZERO
	JMP	XSG3		;RESULT IS ZERO
XSG2:	LXI	H,FLTONE		;<0
	CALL	LOD		;GET ONE
	CALL	CHS		;MAKE IT NEG
	JMP	XSG3
; 
; RAISE TO A POWER
; ARGUMENT MUST BE POSITIVE NUMBER
; (WORKS LIKE A FLOATING POINT PACKAGE ROUTINE)
; 
FLEX:	LXI	H,ACCE+SCRB
	CALL	PUSHF
	LHLD	PT1
	CALL	LOD
	CALL	TST
	JZ	ZFEX
	MVI	E,32
	CALL	FIX
	MOV	E,D
	MOV	D,C
	XCHG
	SHLD	TEMP
	LXI	H,ACCE+SCRB
	CALL	POPF
	SUB	A
	STA	ACC3
	CALL	TST
ERM24:	CM	ERROR6		;NEGATIVE BASE
	LXI	H,FLAC
	CALL	STR
FLLP:	LHLD	TEMP
	DCX	H
	MOV	A,H
	ORA	L
	RZ
	SHLD	TEMP
	LXI	H,FLAC
	CALL	MUL
	JMP	FLLP
ZFEX:	LXI	H,FLAC
	CALL	POPF
	LXI	H,FLTONE
	CALL	LOD
	RET
LIBRARY:	
	RET
; 
; FLOATING POINT PACKAGE
; 
ARITH	EQU	$ 
ARITHB	EQU	$ SHR 8
INIT	EQU	$
; 
; STR ENTRY POINT
; 
STR0:	MOV	M,E
	INR	L
STR:	MOV	M,A
STR1:	INR	L
	MOV	M,B
	INR	L
	MOV	M,C
	INR	L
	MOV	M,D
	RET
; 
; FLOATING POINT ZERO SUBROUTINE
; 
ZRO:	MVI	H,SCRB
ZRO1:	MVI	L,ACCE
	XRA	A
	MOV	M,A
	RET
; 
; FLOATING POINT CHS ROUTINE
; 
CHS:	MVI	A,200Q
	DB	6		;MVI	B,XX	INSTRUCTION TO SKIP NEXT BYTE
; 
; FLOATING POINT ABS ROUTINE
; 
ABS:	XRA	A	
	MVI	H,SCRB
	MVI	L,ACCS
	ANA	M
	XRI	200Q
	MOV	M,A
; 
; FLOATING POINT TST ENTRY POINT
; 
TST:	MVI	H,SCRB
TST1:	MVI	L,ACCE
	MOV	A,M
	ANA	A
	JZ	ZRO
	MOV	E,A
	INR	L
	MOV	A,M
	INR	L
	XRA	M
	INR	L
	MOV	C,M
	INR	L
	MOV	D,M
	JMP	ADD12
; 
; FLOATING POINT LOAD ENTRY POINT
; 
LOD:	MOV	A,M
	ANA	A
	JZ	ZRO
	MOV	E,A
	INR	L
	MOV	A,M
	INR	L
	MOV	C,M
	INR	L
	MOV	D,M
	MOV	L,A
LOD1:	ORI	200Q
	MOV	B,A
	XRA	L
	MVI	H,SCRB
	MVI	L,ACCE
	CALL	STR0
	XRA	B
	MOV	B,A
	ORI	1
	MOV	A,E
	RET
; 
; FLOATING POINT MULTIPLY ROUTINE
; 
MUL:	MOV	A,M
	ANA	A
	CNZ	MDEX
	JZ	ZRO
	JC	OVERF
	CALL	MULX
	MOV	A,B
	ANA	A
	JM	RNDA
	MVI	L,ACCE
	MOV	A,M
	SBI	1
	MOV	M,A
	RZ
	CALL	LSH
RNDA:	CALL	ROND
	JC	OVERF
	MOV	B,A
	ORI	1
	MOV	A,E
	RET
; 
; FLOATING POINT DIVIDE ROUTINE
; 
DIV:	XRA	A
	SUB	M
	CPI	1
	CNC	MDEX
	JC	OVERF
	JZ	ZRO1
	MOV	C,A
	CALL	DIVX
	MVI	H,SCRB
	JC	RNDA
OVERF:	MVI	H,SCRB
	MVI	L,OVER
	MVI	A,-1
	MOV	M,A
	RLC
	RET
	DB	0		;CHECK SUM WORD
; 
; FLOATING POINT SUBTRACT ENTRY POINT
; 
SB:	MVI	A,200Q
	DB	6		;MVI	B,XX	INSTRUCTION TO SKIP NEXT BYTE
; 
; FLOATING POINT ADD ROUTINE
; 
AD:	XRA	A	
	MOV	E,M
	INR	L
	XRA	M
	MOV	B,A
	INR	L
	MOV	C,M
	INR	L
	MOV	D,M
	MVI	H,SCRB
	MVI	L,ACCE
	MOV	A,M
	DCR	L
	MOV	M,A
	MOV	A,E
	ANA	A
	JZ	TST1
	MOV	L,B
	MOV	A,B
	ORI	200Q
	MOV	B,A
	XRA	L
	MVI	L,ACCS
	XRA	M
	MVI	L,SF
	MOV	M,A
	MVI	L,ACCE
	MOV	A,M
	ANA	A
	JZ	ADD17
	SUB	E
	JC	ADD2
	JM	TST1
	CPI	31Q
	JC	ADD3
	JMP	TST1
ADD2:	JP	ADD17
	CPI	347Q
	JC	ADD17
	MOV	M,E
	MOV	E,A
	MVI	L,SF
	MOV	A,M
	MVI	L,ACCS
	XRA	M
	MOV	M,A
	XRA	A
	SUB	E
	INR	L
	MOV	E,M
	MOV	M,B
	MOV	B,E
	INR	L
	MOV	E,M
	MOV	M,C
	MOV	C,E
	INR	L
	MOV	E,M
	MOV	M,D
	MOV	D,E
ADD3:	CALL	RSH
	MVI	L,SF
	MOV	A,M
	ANA	A
	MVI	L,ACC3
	JM	ADD9
	MOV	A,M
	ADD	D
	MOV	D,A
	DCR	L
	MOV	A,M
	ADC	C
	MOV	C,A
	DCR	L
	MOV	A,M
	ADC	B
	MOV	B,A
	JNC	ADD11
	RAR
	MOV	B,A
	MOV	A,C
	RAR
	MOV	C,A
	MOV	A,D
	RAR
	MOV	D,A
	RAR
	MOV	E,A
	MVI	L,ACCE
	MOV	A,M
	ADI	1
	JC	OVERF
	MOV	M,A
	JMP	ADD11
ADD9:	XRA	A
	SUB	E
	MOV	E,A
	MOV	A,M
	SBB	D
	MOV	D,A
	DCR	L
	MOV	A,M
	SBB	C
	MOV	C,A
	DCR	L
	MOV	A,M
	SBB	B
	MOV	B,A
ADD10:	CC	COMP
	CP	NORM
	JP	ZRO1
ADD11:	CALL	ROND
	JC	OVERF
ADD12:	MOV	B,A
	MVI	L,PREX
	MOV	A,E
	SUB	M
	MOV	L,A
	MOV	A,B
	ORI	1
	MOV	A,E
	MOV	E,L
	RET
ADD17:	MVI	L,SF
	MOV	A,M
	MVI	L,ACCS
	XRA	M
	DCR	L
	CALL	STR0
	XRA	B
	JMP	ADD12
	DB	0		;CHECKSUM WORD
MDEX:	MOV	B,A
	INR	L
	MOV	C,M
	INR	L
	MOV	D,M
	INR	L
	MOV	E,M
	MVI	H,SCRB
	MVI	L,ACCE
	MOV	A,M
	ANA	A
	RZ
	ADD	B
	MOV	B,A
	RAR	
	XRA	B
	MOV	A,B
	MVI	B,200Q
	JP	OVUN
	SUB	B
	RZ
	MOV	M,A
	INR	L
	MOV	A,M
	XRA	C
	ANA	B
	MOV	M,A
	MOV	A,C
	ORA	B
	RET
OVUN:	RLC
	RC
	XRA	A
	RET
LSH:	MOV	A,E
	RAL
	MOV	E,A
LSH1:	MOV	A,D
	RAL
	MOV	D,A
	MOV	A,C
	RAL
	MOV	C,A
	MOV	A,B
	ADC	A
	MOV	B,A
	RET
RSH:	MVI	E,0
RSH0:	MVI	L,10Q
RSH1:	CMP	L
	JM	RSH2
	MOV	E,D
	MOV	D,C
	MOV	C,B
	MVI	B,0
	SUB	L
	JNZ	RSH1
RSH2:	ANA	A
	RZ
	MOV	L,A
RSH3:	ANA	A
	MOV	A,B
	RAR
	MOV	B,A
	MOV	A,C
	RAR
	MOV	C,A
	MOV	A,D
	RAR
	MOV	D,A
	MOV	A,E
	RAR
	MOV	E,A
	DCR	L
	JNZ	RSH3
	RET
COMP:	DCR	L
	MOV	A,M
	XRI	200Q
	MOV	M,A
COMP1:	XRA	A
	MOV	L,A
	SUB	E
	MOV	E,A
	MOV	A,L
	SBB	D
	MOV	D,A
	MOV	A,L
	SBB	C
	MOV	C,A
	MOV	A,L
	SBB	B
	MOV	B,A
	RET
NORM:	MVI	L,40Q
NORM1:	MOV	A,B
	ANA	A
	JNZ	NORM3
	MOV	B,C
	MOV	C,D
	MOV	D,E
	MOV	E,A
	MOV	A,L
	SUI	10Q
	MOV	L,A
	JNZ	NORM1
	RET
NORM2:	DCR	L
	MOV	A,E
	RAL
	MOV	E,A
	MOV	A,D
	RAL
	MOV	D,A
	MOV	A,C
	RAL
	MOV	C,A
	MOV	A,B
	ADC	A
	MOV	B,A
NORM3:	JP	NORM2
	MOV	A,L
	SUI	40Q
	MVI	L,ACCE
	ADD	M
	MOV	M,A
	RZ
	RAR	
	ANA	A
	RET
ROND:	MVI	L,ACCE
	MOV	A,E
	ANA	A
	MOV	E,M
	CM	RNDR
	RC
	MOV	A,B
	INR	L
	XRA	M
	JMP	STR1
RNDR:	INR	D
	RNZ
	INR	C
	RNZ
	INR	B
	RNZ
	MOV	A,E
	ADI	1
	MOV	E,A
	MVI	B,200Q
	MOV	M,A
	RET
MULX:	MVI	L,MULP1
	MOV	M,A
	MVI	L,MULP2
	MOV	M,D
	MVI	L,MULP3
	MOV	M,E
	XRA	A
	MOV	E,A
	MOV	D,A
	MVI	L,ACC3
	CALL	MULX2
	MVI	L,ACC2
	CALL	MULX1
	MVI	L,ACC1
MULX1:	MOV	A,D
	MOV	E,C
	MOV	D,B
MULX2:	MOV	B,M
	MOV	L,A
	XRA	A
	MOV	C,A
	SUB	B
	JC	MULX3
	MOV	C,D
	MOV	D,E
	RET
MULX5:	MOV	C,A
	JNC	MULX3
	INR	B
	ANA	A
MULX3:	MOV	A,L
	ADC	A
	RZ
	MOV	L,A
	MOV	A,E
	RAL
	MOV	E,A
	MOV	A,D
	RAL
	MOV	D,A
	MOV	A,C
	RAL
	MOV	C,A
	MOV	A,B
	RAL
	MOV	B,A
	JNC	MULX3
	MOV	A,E
	JMP	MULX4
DIVX:	MVI	L,ACC3
	MOV	A,M
	SUB	E
	MOV	M,A
	DCR	L
	MOV	A,M
	SBB	D
	MOV	M,A
	DCR	L
	MOV	A,M
	SBB	C
	MOV	M,A
	MOV	A,C
	RAL
	MOV	A,C
	RAR
	MVI	L,OP1S
	MOV	M,A
	MVI	L,OP1A
	MOV	M,A
	MOV	A,D
	RAR
	MVI	L,OP2S
	MOV	M,A
	MVI	L,OP2A
	MOV	M,A
	MOV	A,E
	RAR
	MVI	L,OP3S
	MOV	M,A
	MVI	L,OP3A
	MOV	M,A
	MVI	B,0
	MOV	A,B
	RAR
	MVI	L,OP4S
	MOV	M,A
	MVI	L,OP4A
	MOV	M,A
	MVI	L,OP4X
	MOV	M,A
	MVI	L,ACC1
	MOV	A,M
	INR	L
	MOV	D,M
	INR	L
	MOV	E,M
	ANA	A
	JM	DIVX4
	MVI	L,ACCE
	MOV	C,M
	INR	C
	RZ
	MOV	M,C
	MOV	L,E
	MOV	H,D
	MOV	E,A
	MVI	D,1
	MOV	C,B
DIVX1:	XRA	A
	CALL	DIVX5
DIVX2:	RLC
	MOV	A,B
	RAL
	RC
	RAR
	MOV	A,L
	RAL
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	CALL	LSH
	MOV	A,D
	RRC
	JC	DIVX1
DIVX3:	MOV	A,L
	JMP	DIVX6
DIVX4:	MOV	L,E
	MOV	H,D
	MOV	E,A
	MOV	D,B
	MOV	C,B
	JMP	DIVX3
	DB	0		;CHECKSUM WORD
; 
; FORMAT CONVERSION PACKAGE
; 
ADRL	EQU	SF+1
ADRH	EQU	ADRL+1
TMP1	EQU	ADRH+1
TMP2	EQU	TMP1+1
TMP3	EQU	TMP2+1
VALE	EQU	TMP3+1
VAL1	EQU	VALE+1
VAL2	EQU	VAL1+1
VAL3	EQU	VAL2+1
TMP4	EQU	VAL3+1
; 
FLT:	MOV	L,E
	MOV	E,D
	MOV	D,C
	MOV	C,B
	MOV	B,A
	MOV	A,L
	XRI	200Q
	MVI	H,SCRB
	MVI	L,ACCE
	MOV	M,A
	INR	L
	MVI	M,200Q
	INR	L
	MOV	A,B
	ANA	A
	RAL
	JMP	ADD10
FIX:	MVI	H,SCRB
	MVI	L,ACCE
	MOV	A,M
	ANA	A
	JZ	FIX1
	MOV	A,E
	ADI	177Q
	SUB	M
	RC
	CPI	37Q
	JNC	FIX1
	ADI	1
	MVI	L,ACC1
	MOV	B,M
	INR	L
	MOV	C,M
	INR	L
	MOV	D,M
	CALL	RSH
	MVI	L,ACCS
	MOV	A,M
	ANA	A
	CP	COMP
	MVI	A,1
	ORA	B
	MOV	A,B
	MOV	B,C
	MOV	C,D
	MOV	D,E
	RET
FIX1:	XRA	A
	MOV	B,A
	MOV	C,A
	MOV	D,A
	RET
	DB	0		;CHECKSUM WORD
INP:	MOV	E,M
	CALL	SVAD
	INR	L
	MVI	M,200Q
	MVI	L,ACCE
	MOV	M,D
	MOV	A,E
	CPI	360Q
	JZ	INP1
	CPI	373Q
	JZ	INP1
	CPI	375Q
	JNZ	INP2
	MVI	L,TMP3
	MOV	M,D
INP1:	CALL	CHAD
	MOV	A,M
	MVI	H,SCRB
INP2:	MVI	B,0
	CPI	376Q
	JZ	INP3
	CPI	25Q
	JZ	INP4
	CPI	12Q
	JNC	INP8
	MVI	L,TMP4
	MOV	M,A
	LXI	H,FTEN
	CALL	MUL
	MVI	L,VALE
	CALL	STR
	INR	L
	MOV	A,M
	MVI	B,0
	MOV	C,B
	MOV	D,B
	MVI	E,8
	CALL	FLT
	MVI	L,VALE
	CALL	AD
	MVI	L,TMP2
	MOV	A,M
	ANA	A
	JZ	INP1
	DCR	L
	MOV	B,M
	DCR	B
	MOV	M,B
	JMP	INP1
INP3:	MVI	L,TMP2
	XRA	M
	MOV	M,A
	JNZ	INP1
	JMP	INP8
INP4:	CALL	CHAD
	MOV	A,M
	MOV	B,A
	SUI	375Q
	MOV	E,A
	JZ	INP5
	ADI	2
	MOV	A,B
	JNZ	INP6
INP5:	INR	L
	MOV	A,M
INP6:	MVI	B,0
	CPI	12Q
	JNC	INP8
	MOV	B,A
	INR	L
	MOV	A,M
	CPI	12Q
	JNC	INP7
	MOV	C,A
	MOV	A,B
	ADD	A
	ADD	A
	ADD	B
	ADD	A
	ADD	C
	MOV	B,A
INP7:	MOV	A,E
	ANA	A
	JNZ	INP8
	SUB	B
	MOV	B,A
INP8:	MVI	H,SCRB
	MVI	L,TMP3
	MOV	C,M
	MVI	L,ACCS
	MOV	M,C
	MOV	A,B
INP9:	MVI	L,TMP1
	ADD	M
	JZ	TST
	MOV	M,A
	LXI	H,FTEN
	JP	INP10
	CALL	DIV
	MVI	A,1
	JMP	INP9
INP10:	CALL	MUL
	RC
	MVI	A,-1
	JMP	INP9
OU:
	DCR	L
	CALL	SVAD
	CALL	TST
	MVI	L,VALE
	CALL	STR
	CALL	CHAD
	MVI	M,360Q
	ANA	A
	JZ	OUT3
	MOV	E,A
	MOV	A,B
	ANA	A
	MOV	A,E
	JP	OUT1
	MVI	M,375Q
OUT1:	CPI	176Q
OUT2:	LXI	H,FTEN
	JC	OUT4
	CPI	201Q
	JC	OUT5
	CALL	DIV
OUT3:	MVI	H,SCRB
	MVI	L,TMP2
	MOV	E,M
	INR	E
	MOV	M,E
	JMP	OUT2
OUT4:	CALL	MUL
	MVI	L,TMP2
	MOV	E,M
	DCR	E
	MOV	M,E
	JMP	OUT1
OUT5:	CALL	ABS
	LXI	H,RND0
	CALL	AD
	CPI	201Q
	JNC	OUT2
	MVI	L,TMP2
	MOV	A,M
	MOV	E,A
	CPI	8
	JC	OUT6
	MVI	E,1
OUT6:	SUB	E
	MOV	M,A
	MVI	A,7
	SUB	E
	INR	L
	MOV	M,A
	DCR	E
	MOV	A,E
OUT7:	MVI	L,TMP1
	ADD	M
	MOV	M,A
	JM	OUT8
	LXI	H,FTEN
	CALL	MUL
	MVI	E,8
	CALL	FIX
	CALL	CHAD
	MOV	M,A
	XRA	A
	MVI	E,8
	CALL	FLT
	MVI	A,-1
	JMP	OUT7
OUT8:	MVI	L,TMP3
	MOV	A,M
	MVI	M,-1
	ANA	A
	JM	OUT9
	CALL	CHAD
	MVI	M,376Q
	MVI	H,SCRB
	JMP	OUT7
OUT9:	DCR	L
	ANA	M
	JZ	OUT13
	MVI	B,373Q
	JP	OUT10
	MVI	B,375Q
	MOV	C,A
	XRA	A
	SUB	C
OUT10:	MVI	C,-1
OUT11:	MOV	D,A
	INR	C
	SUI	12Q
	JNC	OUT11
	MVI	A,25Q
OUT12:	CALL	CHAD
	CALL	STR
	MVI	H,SCRB
	MVI	L,VALE
	JMP	LOD
OUT13:	MVI	A,360Q
	MOV	B,A
	MOV	C,A
	MOV	D,A
	JMP	OUT12
SVAD:	MOV	A,L
	MOV	B,H
	MVI	C,0
	MOV	D,C
	MVI	H,SCRB
	MVI	L,ADRL
	CALL	STR
	RET
CHAD:	MVI	H,SCRB
	MVI	L,ADRL
	MOV	E,M
	INR	E
	MOV	M,E
	INR	L
	MOV	H,M
	MOV	L,E
	RET
FTEN:	DB	204Q
	DB	40Q
	DB	0,0
RND0:	DB	150Q,126Q,277Q,255Q		;.00000005
	DB	0		;CHECKSUM WORD
; 
; CONSTANTS, VARIABLES AND TABLES
; 
WORDS	EQU	4		;LENGTH
RUBOUT	EQU	7FH	
TEST	EQU	2		;UART STATUS PORT
CRT	EQU	3		;CRT OUTPUT PORT
SPACE	EQU	' '
CR	EQU	15Q		;CARRIAGE RETURN
LF	EQU	12Q
KYBRD	EQU	0
AXIN:	DW	0		;STORAGE INDEX
TEXTP	EQU	$
AXOUT:	DW	FRSTX		;OUTPUT INDEX
PC:	DW	FLTZER		;PROGRAM COUNTER
THISLN: DW	0		;LINE POINTER FROM FINDLN
LASTLN: DW	0		;BACK POINTER FROM FINDL
DEBGSW: DB	0		;DEBUG SWITCH: NONZERO FOR LITERAL
PT1:	DW	0		;VARIABLE POINTER
LASTV:	DW	BUFBEG		;ADDRESS OF LAST VARIABLE
SRTCN:	DB	0		;RESULT OF SORTDC
LASTOP: DB	0		;LAST OPERATION FOR EVAL
EFOP	EQU	$		;FUNCTION CODE
ATSW:	DB	0		;ASK-TYPE SWITCH
CNTR:	DB	0F0H		;DELETE AND ERROR COUNTER
	DB	0FFH
STE:	DB	0
STRTV	EQU	$
BUFR:	DW	BUFBEG		;NEXT LOC
NAGSW:	DB	1		;SWITCH (200=ONE, 1=ALL, 0=GROUP)
CHAR:	DB	15Q
LINENO: DW	0		;LINE NO FROM GETLN (BCD)
LIST6	EQU	$		;INPUT LIST FOR SFOUND
	DB	14Q		;F.F.
	DB	7		;BELL
LIST7	EQU	$
	DB	3		;CONTROL C FOR DEBUGGING
	DB	137Q		;LEFT ARROW
	DB	LF
LIST3	EQU	$		;EXCRETION LIST
	DB	15Q		;LIST BRANCHER
	DB	0
	DB	0		;END OF LIST
OPTBL	EQU	$		;FLOATING POINT CALL ADDRESSES
	DW	RECOVER
	DW	AD
	DW	SB
	DW	DIV
	DW	MUL
	DW	FLEX
	DW	RECOVER
DMPSW:	DB	0		;SEARCH CHAR-VARIABLE: 0-TRACE
FNTBF	EQU	$		;FUNCTION ADDRESSES
	DW	XABS
	DW	XSGN
	DW	XINT
	DW	XRAN
	DW	ARTN
	DW	FEXP
	DW	FLOG
	DW	FSIN
	DW	FCOS
	DW	XSQT
	DW	XUSR
	DW	FHYS
FNTBL	EQU	$		;LIST OF CODED FUNCTION NAMES
	DB	'B'
	DB	'G'
	DB	'N'
	DB	'A'
	DB	'T'
	DB	'X'
	DB	'L'
	DB	'I'
	DB	'O'
	DB	'Q'
	DB	'S'
	DB	'Y'
	DB	0		;END
INLIST	EQU	$		;INPUT CONTROL CHARACTERS
	DW	RECOVER		;C.C. = BREAK
	DW	IBAR		;B.A.= RESTART
	DW	IGNOR		;L.F.= IGNORE
	DW	IRETN		;C.R. = TERMINATE STRING
FLST2:	DW	FLIMIT		;=STANDARD
	DW	FINFIN		;=SHORT
	DW	ERROR5		;CR=DUMB
FLST1:	DW	FINCR		;=STANDARD FORMAT
	DW	PROCESS		;=SET: PLUS,...
	DW	PC1		;C.R. = SET COMMAND
COMMENTS	EQU PC1
ILIST:	DW	IF1		;,
	DW	PROCESS		;;
	DW	PC1		;CR
COMLST	EQU	$		;COMMAND DECODE LIST-SPEED OPTIMIZED
	DB	'S'		;SET
	DB	'F'		;FOR
	DB	'I'		;IF
	DB	'D'		;DO
	DB	'G'		;GOTO
	DB	'C'		;COMMENT
	DB	'A'		;ASK
	DB	'T'		;TYPE
	DB	'L'		;LIBRARY
	DB	'E'		;ERASE
	DB	'W'		;WRITE
	DB	'M'		;MODIFY
	DB	'Q'		;QUIT
	DB	'R'		;RETURN
	DB	'J'		;JUMP
	DB	0		;END
COMGO	EQU	$
	DW	SETX
	DW	FOR
	DW	IFX
	DW	DO
	DW	GOTO
	DW	COMMENTS
	DW	ASK
	DW	TYPE
	DW	LIBRARY
	DW	ERASE
	DW	WRITE
	DW	MODIFY
	DW	START		;QUIT
	DW	RETRN
	DW	JUMP		;COMPUTED TRANSFER
SRNLST	EQU	$
	DW	SCHAR		;F.F. = CONTINUE
	DW	SCONT		;BELL = CHANGE SEARCH CHAR
	DW	RECOVER		;C.C. = BREAK
	DW	SBAR		;B.A. = RESTART
	DW	SCONT+3		;L.F. = FINISH LINE AS WAS
LISTGO	EQU	$
	DW	SRETN		;C.R. = END LINE HERE, AS IS
	DW	SGOT		;CHAR = SEARCH CHAR
ALIST	EQU	$		;ASK-TYPE LIST OF CONTROLS
	DB	'%'
	DB	'"'
	DB	21H		;)
	DB	43Q
	DB	'$'
GLIST:	DB	' '
TLIST:	DB	','
	DB	';'
	DB	CR
	DB	0
RAN0:	DW	1234H
	DW	1234H
ATLIST	EQU	$		;ASK-TYPE CONTROL CHAR TABLE
	DW	TINTR		;%-FORMAT DELIMITER
	DW	TQUOT		;"-LITERAL DELIMITER
	DW	TCRL2		;)-CR&LF
	DW	TCRLF		;#-CR ONLY
	DW	TDUMP		;$-DUMP SYMBOL TABLE
	DW	TASK4		;SP-TERMINATOR FOR NAMES
	DW	TASK4		;,-TERMINATOR FOR EXPRESSIONS
	DW	PROCESS		;;-TERMINATOR FOR COMMAND
	DW	PC1		;CR-TERMINATOR FOR STRINGS
ECHOLST:	DB	CR
	DB	RUBOUT
	DB	0
TERMS	EQU	$
	DB	' '
	DB	'+'
	DB	'-'
	DB	'/'
	DB	'*'
	DB	'^'
	DB	'('
	DB	'['
	DB	'<'
	DB	')'
	DB	']'
	DB	'>'
	DB	','
	DB	';'
	DB	CR
	DB	'='
	DB	0
FLARG:	DW	0		;DATA STORAGE
	DW	0
TLST3	EQU	$		;LITERAL TERMINATORS
	DW	TASK4		;"
	DW	PC1		;CR=AUTOMATIC QUOTE MATCH
INFIX	EQU	$		;DATA CONTROL CHARACTERS
	DW	ERROR4		;LEFT ARROW = KILL
	DW	AK2		;RUBOUT = IGNORE
	DW	AK2		;LF = IGNORE
	DW	AK4		;ALTMODE
	DW	AK3		;CR INFIN
	DW	RECOVER		;C.C.
FLTONE: DB	81H
	DB	0
FLTZER: DW	0
	DW	0
FLTTWO: DB	82H
	DB	0
	DW	0
FLAC:	DS	4
FISW:	DB	104Q		;FLOATING OUTPUT FORMAT
SPECIAL EQU	$		;INPUT CHARACTERS
	DB	137Q		;LEFT ARROW
	DB	RUBOUT
	DB	LF
	DB	33Q		;ALT MODE
	DB	CR
	DB	3		;C.C.
	DB	0		;END
ITER1:	DW	0
TEMP:	DW	0
TEMP2:	DW	0
TLST2:	DB	'"'		;QUOTE
	DB	CR		;FUNCTION OR NUMBER NOT AN ARG
	DB	0
	DB	0FFH
DATBUF: DB	'                                        '
	DB	0FFH
IOBUF:	DB	'                                        '
COMEIN: DB	0FFH
	DB	'                                                  '
	DB	'                              '
COMEOUT EQU	$
	DB	0FFH
FRST:	DW	0		;TEXT POINTER
	DW	0		;DUMMY LINE NUMBER
FRSTX:	DB	CR		;DUMMY END OF LINE
BUFBEG	EQU	$
COMBUF	EQU	COMEIN+1		;COMMAND BUFFER START
CFRS	EQU	FRST		;ADDRESS OF FIRST LINE (DUMMY)
CFRSX	EQU	FLTZER		;POINTER TO ZERO DATA
OPTR0	EQU	IOBUF		;OUTPUT POINTERS
SCR	EQU	SBANK AND 0FFH
SCRB	EQU	SBANK SHR 8
FSQRN	EQU	SCR+40H
FSQRX	EQU	SCR+44H
IDVT	EQU	SCR+40H
FMACX	EQU	SCR+40H
FMACS	EQU	SCR+44H
FMACT	EQU	SCR+48H
FMACG	EQU	SCR+4CH
FSINX	EQU	SCR+50H
FATNT	EQU	SCR+50H
FATNU	EQU	SCR+54H
FSNHD	EQU	SCR+4EH
FEXOV	EQU	SCR+4FH
FSNHX	EQU	SCR+50H
FLOGE	EQU	SCR+4EH
FLOGX	EQU	SCR+50H
; 
PRNTER:
	LXI	H,ERRMS
PERR4:	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	XCHG
	SHLD	LINENO
	PUSH	D
	CALL	PRNTLN
	POP	H
PERR1:
	MOV	A,M
	INX	H
	CPI	CR
	JZ	PERR2
	CALL	XOUTL
	JMP	PERR1
PERR2:
	CALL	XOUTL
	MOV	A,M
	INX	H
	ORA	A
	JZ	PERR3
	CALL	XOUTL
	JMP	PERR4
PERR3:
	MVI	A,LF
	CALL	XOUTL
	RST	0
; 
ERRMS:
	DW	0
	DB	' RESTART (CONTROL C)',CR,LF
	DW	ERM1+3
	DB	' INPUT BUFFER FULL',CR,LF
	DW	GZERR+3
	DB	' BAD LINE NUMBER',CR,LF
	DW	GERR+3
	DB	' BAD LINE NUMBER',CR,LF
	DW	ERM4+3
	DB	' IRRECOVERABLE MEMORY OVERFLOW (RELOAD)',CR,LF
	DW	PCHK2
	DB	' RECOVERABLE MEMORY OVERFLOW (ENTER ERASE)',CR,LF
	DW	ERM6+3
	DB	' BAD LINE NUMBER',CR,LF
	DW	DGRP1
	DB	' NO SUCH GROUP (LINE NUMBER)',CR,LF
	DW	ECA:+3
	DB	' -DO- REFERENCES MISSING LINE',CR,LF
	DW	ERM9+3
	DB	' -GO TO- REFERENCES MISSING LINE',CR,LF
	DW	WRITE
	DB	' INVALID COMMAND',CR,LF
	DW	ERM10+3
	DB	' LEFT OF EQUAL BAD, FOR  OR  SET',CR,LF
	DW	FINCR
	DB	' BAD EXPRESSION IN FOR',CR,LF
	DW	FLIMIT
	DB	' BAD EXPRESSION IN FOR',CR,LF
	DW	ERM13+3
	DB	' MISSING LINE REFERENCED BY MODIFY',CR,LF
	DW	ERM14+3
	DB	' MISSING  )  IN SUBSCRIPT',CR,LF
	DW	ERM15+3
	DB	' BPPEXPRESSION',CR,LF
	DW	ERM16+3
	DB	' BAD EXPRESSION',CR,LMOV	BDW	ETRM1
	DB	' BAD EXPRESSION',CR,LF
	DW	ETR2
	DB	' MISSSINAOPERATOR IN EXPRESSION',CRRIELF
	DW	FUN4
	DB	' MISSING  (',CR,LF
	DW	EFUN3
	DB	' BAD FUNCTION NAME',CR,LF
	DW	ERM21+3
	DB	' ARITHMETIC OVERFLOW',CR,LF
	DW	ERM22+3
	DB	' BAD ARGUMENT TO ERASE',CR,LF
	DW	ERT
	DB	' BAD ARGUMENT TO ERASE',CR,LF
	DW	ERM24+3
	DB	' NEGATIVE ARGUMENT TO RAISE TO A POWER',CR,0
; 
	END	PRNTER

