Zapple-II/BASIC5.S#000000

; 
; PROCESSOR TECHNOLOGY BASIC-5
; USING ZILOG OPCODES, COURTESY OF A SED FILE
; 
; SYSTEM GLOBAL EQUATES
; 
BDOS	EQU	0005H		;ADDRESS OF JUMP TO BDOS
CONIN	EQU	1		;CONSOLE IN
CONOUT	EQU	2		;CONSOLE OUT
CONSTS	EQU	11		;CONSOLE STATUS
FPSIZ	EQU	5
LINLEN	EQU	73		;# OF CHARS IN LEGAL INPUT LINE
FP123	EQU	FPSIZ-2
FPNIB	EQU	FP123*2
DIGIT	EQU	FPNIB/2
CR	EQU	15Q		;CARRIAGE RETURN
NULL	EQU	0
LF	EQU	12Q		;LINE FEED
ESC	EQU	3Q		;CONTROL C
EOF	EQU	1		;END OF FILE
BELL	EQU	7		;BELL CHARACTER
STESIZ	EQU	2+FPSIZ		;SYMBOL TABLE ELEMENT SIZE
OPBASE	EQU	'('
FTYPE	EQU	1		;CONTROL STACK FOR ENTRY TYPE
FORSZ	EQU	FPSIZ*2+2+2+1	;'FOR' CONTROL STACK ENTRY SIZE
GTYPE	EQU	2		;CONTROL STACK GOSUB ENTRY TYPE
ETYPE	EQU	0		;CONTROL STACK UNDERFLOW TYPE
UMINUS	EQU	61Q		;UNARY MINUS
; 
; STARTUP BASIC SYSTEM
; 
	ORG	100H
; 
START:	LD	SP,CMNDSP
	XOR	A
	LD	(NULLCT),A		;NULL COUNT.
	LD	HL,BASEND		;START OF USER MEMORY
	LD	(BOFA),HL		;IS RIGHT AFTER THE BASIC CODE.
	LD	HL,(BDOS+1)		;THE ADDRESS OF BDOS IS
	DEC	HL			; ** Bobbi / Qkumba fix **
	LD	(MEMTOP),HL		;THE END OF USER MEMORY.
ST0:	LD	HL,PLS			;"PROGRAM LOADED?" MESSAGE
	CALL	PRNT
	CALL	INLINE
	LD	A,(IBUF)
; 
; OPTIONAL ENTRY POINT FOR TAPE OR DISK ROUTINES
; 
; ALLOWS DIRECT PROGRAM INPUT FROM HIGH SPEED DEVICES
; SEE OPERATING INSTRUCTIONS FOR PROPER IMPLEMENTATION
; 
STAR1:	CP	'N'
	JP	Z,ST1		;IF NO PROGRAM CLEAR AND INITIALIZE
	CP	'Y'
	JP	NZ,ST0
	LD	HL,(BOFA)
ST2:	LD	A,(HL)		;FIND END OF PROGRAM
	CP	EOF
	JP	Z,ST3
	CALL	ADR
	JP	ST2
ST3:	LD	(EOFA),HL
	CALL	CCLEAR
	JP	ST4
ST1:	CALL	CSCR
ST4:	LD	A,2*FPNIB
	LD	(INFES),A
; INITIALIZE RANDOM NUMBER
	LD	DE,FRAND
	LD	HL,RANDS
	CALL	VCOPY		;FRAND=RANDOM NUMBER SEED
; 
; COMMAND PROCESSOR
; 
CMND1:	CALL	CRLF2
	LD	HL,RDYS		;PRINT READY MESSAGE
	CALL	PRNT
CMNDR:	LD	A,1		;SET DIRECT INPUT FLAG
	LD	(DIRF),A
	LD	SP,CMNDSP
	CALL	CRLF
CMND2:	CALL	INLINE		;GET INPUT LINE FROM OPERATOR
	CALL	PP		;PRE-PROCESS IT
	JP	C,CMND3
	CALL	LINE		;LINE NUMBER...GO EDIT
	JP	CMND2
CMND3:	CALL	CMND4
	JP	CMNDR
CMND4:	LD	HL,IBUF		;POINT TO COMMAND OR STATEMENT
	LD	(TXA),HL
	CALL	GC
	AND	240Q
	CP	240Q		;CHECK FOR COMMAND
	LD	DE,CMNDD
	JP	Z,ISTA1		;PROCESS COMMAND
	CALL	ISTAT		;PROCESS STATEMENT (IF ALLOWED)
	CALL	GCI
	CP	CR
	RET	Z
E1:	LD	BC,'BS'
	JP	ERROR
; ERROR MESSAGE PRINTOUT
E3:	LD	BC,'BA'
	JP	ERROR
E4:	LD	BC,'CS'
	JP	ERROR
E5:	LD	BC,'OB'
	JP	ERROR
E6:	LD	BC,'DM'
; 
ERROR:	PUSH	BC
	CALL	CRLF
	POP	BC
	CALL	CHOUT
	LD	B,C
	CALL	CHOUT
	LD	HL,ERS
ERM1:	CALL	PRNT
	LD	A,(DIRF)
	OR	A
	JP	NZ,CMND1
	LD	HL,INS
	CALL	PRNT
; FIND LINE NUMBER
	LD	HL,(BOFA)
ERM2:	LD	B,H
	LD	C,L
	LD	E,(HL)
	LD	D,0
	ADD	HL,DE
	EX	DE,HL
	LD	HL,TXA
	CALL	DCMP
	EX	DE,HL
	JP	C,ERM2
	INC	BC
	LD	A,(BC)
	LD	L,A
	INC	BC
	LD	A,(BC)
	LD	H,A
	LD	DE,IBUF		;USE IBUF TO ACCUMULATE THE LINE NUMBER STRING
	CALL	CNS
	LD	A,CR
	LD	(DE),A
	LD	HL,IBUF
	CALL	PRNTCR
	JP	CMND1
; 
; LINE EDITOR
; 
LINE:	LD	HL,(BOFA)	;CHECK FOR EMPTY FILE
FIN:	LD	A,(HL)		;CHECK IF APPENDING LINE AT END
	DEC	A
	JP	Z,APP
	EX	DE,HL
	INC	DE
	LD	HL,(IBLN)	;GET INPUT LINE NUMBER
	EX	DE,HL
	CALL	DCMP		;COMPARE WITH FILE LINE NUMBER
	DEC	HL
	JP	C,INSR		;LESS THAN
	JP	Z,INSR		;EQUAL
	LD	A,(HL)		;LENGTH OF LINE
	CALL	ADR		;JUMP FORWARD
	JP	FIN
; APPEND LINE AT END CASE
APP:	LD	A,(IBCNT)	;DON'T APPEND NULL LINE
	CP	4
	RET	Z
	CALL	FULL		;CHECK FOR ROOM IN FILE
	LD	HL,(EOFA)	;PLACE LINE IN FILE
	CALL	IMOV
	LD	(HL),EOF
	LD	(EOFA),HL
	RET
; INSERT LINE IN FILE CASE
INSR:	LD	B,(HL)		;OLD LINE COUNT
	LD	(INSA),HL	;INSERT LINE POINTER
	LD	A,(IBCNT)	;NEW LINE COUNT
	JP	C,LT		;JMP IF NEW LINE # NOT = OLD LINE NUMBER
	SUB	4
	JP	Z,LT1		;TEST IF SHOULD DELETE NULL LINE
	ADD	A,4
LT1:	SUB	B
	JP	Z,LIN1		;LINE LENGTHS EQUAL
	JP	C,GT
; EXPAND FILE FOR NEW OR LARGER LINE
LT:	LD	B,A
	LD	A,(IBCNT)
	CP	4		;DON'T INSERT NULL LINE
	RET	Z
	LD	A,B
	CALL	FULL
	LD	HL,(INSA)
	CALL	NMOV
	LD	HL,(EOFA)
	EX	DE,HL
	LD	(EOFA),HL
	INC	BC
	CALL	RMOV
	JP	LIN1
; CONTRACT FILE FOR SMALLER LINE
GT:	CPL
	INC	A
	CALL	ADR
	CALL	NMOV
	EX	DE,HL
	LD	HL,(INSA)
	CALL	NZ,LMOV
	LD	(HL),EOF
	LD	(EOFA),HL
; INSERT CURRENT LINE INTO FILE
LIN1:	LD	HL,(INSA)
	LD	A,(IBCNT)
	CP	4
	RET	Z
; INSERT CURRENT LINE AT ADDR HL
IMOV:	LD	DE,IBCNT
	LD	A,(DE)
	LD	C,A
	LD	B,0
; COPY BLOCK FROM BEGINNING
; HL IS DEST ADDR, DE IS SOURCE ADDR, BC IS COUNT
LMOV:	LD	A,(DE)
	LD	(HL),A
	INC	DE
	INC	HL
	DEC	BC
	LD	A,B
	OR	C
	JP	NZ,LMOV
	RET
; COPY BLOCK STARTING AT END
; HL IS DEST, DE IS SOURCE, BC IS COUNT
RMOV:	LD	A,(DE)
	LD	(HL),A
	DEC	HL
	DEC	DE
	DEC	BC
	LD	A,B
	OR	C
	JP	NZ,RMOV
	RET
;     COMPUTE FILE MOVE COUNT
; BC GETS (EOFA) - (HL), RET Z SET MEANS ZERO COUNT
NMOV:	LD	A,(EOFA)
	SUB	L
	LD	C,A
	LD	A,(EOFA+1)
	SBC	A,H
	LD	B,A
	OR	C
	RET
; ADD A TO HL
ADR:	ADD	A,L
	LD	L,A
	RET	NC
	INC	H
	RET
; CHECK FOR FILE OVERFLOW, LEAVES NEW EOFA IN DE
; A HAS INCREASE IN SIZE
FULL:	LD	HL,(EOFA)
	CALL	ADR
	EX	DE,HL
	LD	HL,MEMTOP
	CALL	DCMP
	JP	NC,E8
	RET
; 
;    COMMANDS
; 
CSCR:	LD	HL,(BOFA)
	LD	(HL),EOF
	LD	(EOFA),HL
; "CLEAR"
CCLEAR:	LD	HL,(EOFA)	;CLEAR FROM EOFA TO MEMTOP
	INC	HL
	LD	(MATA),HL
	EX	DE,HL
	LD	HL,MEMTOP		;END OF ASSIGNED MEMORY
CCLR1:	XOR	A
	LD	(DE),A
	CALL	DCMP
	INC	DE
	JP	NZ,CCLR1
	LD	HL,(MEMTOP)
	LD	(STAA),HL
	LD	HL,CSTKL+CSTKSZ-1
	LD	(HL),ETYPE
	LD	(CSTKA),HL
	LD	HL,ASTKL+ASTKSZ+FPSIZ-1
	LD	(ASTKA),HL
	RET
; "NULL"
CNULL:	CALL	INTGER
	JP	C,E3		;NO ARGUMENT SUPPLIED
	LD	A,L
	LD	(NULLCT),A
	JP	CMND1
; "LIST"
CLIST:	CALL	GC
	CP	CR
	LD	DE,0
	JP	Z,CL0		;JUMP IF NO ARGUMENT SUPPLIED
	CALL	INTGER		;ERROR DEFAULT IS LIST
CL0:	LD	HL,(BOFA)
CL1:	LD	A,(HL)
	DEC	A
	RET	Z
	INC	HL
	CALL	DCMP
	DEC	HL		;POINT TO COUNT CHAR AGAIN
	JP	C,CL2
	JP	Z,CL2
; INCREMENT TO NEXT LINE
	LD	A,(HL)
	CALL	ADR
	JP	CL1
CL2:	PUSH	DE
	LD	DE,IBUF		;AREA TO UNPREPROCESS TO
	CALL	UPPL
	INC	HL
	PUSH	HL
	LD	HL,IBUF
	CALL	PRNTCR
	CALL	PCHECK
	CALL	CRLF
	POP	HL
	POP	DE
	JP	CL1
; "RUN"
CRUN:	CALL	CCLEAR
	LD	HL,(BOFA)
	LD	A,(HL)
	DEC	A		;CHECK FOR NULL PROGRAM
	JP	Z,ENDX
	INC	HL
	INC	HL
	INC	HL
	LD	(TXA),HL
	LD	(RTXA),HL	;POINTER FOR 'READ' STATEMENT
	XOR	A
	LD	(DIRF),A	;CLEAR DIRECT FLAG AND FALL THROUGH TO DRIVER
	CALL	CRLF
; 
; INTERPRETER DRIVER
; 
ILOOP:	CALL	PCHECK
	CALL	ISTAT		;INTERPRET CURRENT STATEMENT
	CALL	JOE		;TEST FOR JUNK ON END
	JP	NC,ILOOP		;CONTINUE IF NOT AT END OF PROGRAM
	JP	ENDX		;EXECUTE END STATEMENT
; INTERPRET STATEMENT LOCATED BY TXA
ISTAT:	CALL	GC		;GET FIRST NON BLANK
	OR	A
	JP	P,LET		;MUST BE LET IF NOT RW
	CP	IRWLIM		;IS IT AN INITIAL RW
	JP	NC,E1
	LD	DE,STATD		;STATEMENT DISPATCH TABLE BASE
ISTA1:	CALL	GCI		;ADVANCE TEXT POINTER
	AND	37Q	
	RLCA		;MULTIPLY BY TWO PREPARING FOR TABLE LOOKUP
	LD	L,A
	LD	H,0
	ADD	HL,DE
	CALL	LHLI
	JP	(HL)		;BRANCK TO STATEMENT OR COMMAND
; 
; STATEMENTS
; 
; "LET"
LET:	CALL	VAR		;CHECK FOR VARIABLE
	JP	C,E1
	PUSH	HL		;SAVE VALUE ADDRESS
	LD	B,EQRW
	CALL	EATC
	CALL	EXPRB
	POP	DE		;DESTINATION ADDRESS
	CALL	POPA1		;COPY EXPR VALUE TO VARIABLE
	RET		;******* CALL, RET???!!!****************
; "FOR"
SFOR:	CALL	DIRT
	CALL	VAR		;CONTROL VARIABLE
	JP	C,E1
	PUSH	HL		;CONTROLVARIABLE VALUE ADDRESS
	LD	B,EQRW
	CALL	EATC
	CALL	EXPRB		;INITIAL VALUE
	POP	DE		;VARIABLE VALUE ADDRESS
	PUSH	DE		;SAVE
	CALL	POPA1		;SET INITIAL VALUE
	LD	B,TORW		;RW FOR 'TO'
	CALL	EATC
	CALL	EXPRB		;LIMIT VALUE COMPUTATION
	CALL	GC		;CHECK NEXT CHARACTER FOR POSSIBLE STEP EXPR
	CP	STEPRW
	JP	Z,FOR1
; USE STEP OF 1
	LD	DE,FPONE
	CALL	PSHA1
	JP	FOR2
; COMPUTE STEP VALUE
FOR1:	CALL	GCI		;EAT THE STEP RW
	CALL	EXPRB		;THE STEP VALUE
; HERE THE STEP AND LIMIT ARE ON THE ARG STACK
FOR2:	LD	DE,-2		;PREPARE TO ALLOCATE 2 BYTES ON CONTROL STACK
	CALL	PSHCS		;RETURNS ADDRESS OF THOSE 2 BYTES IN HL
	EX	DE,HL
	CALL	JOE		;TEST FOR JUNK ON END
	JP	C,E4		;NO "FOR" STATEMENT AT END OF PROGRAM
	EX	DE,HL	;DE HAS LOOP TEST ADDR, HL HAS CONTROL STACK ADR
	LD	(HL),D		;HIGH ORDER TEXT ADDRESS BYTE
	DEC	HL
	LD	(HL),E		;LOW ORDER TEXT ADDRESS BYTE
	LD	DE,-FPSIZ		;ALLOCATE SPACE FOR LIMIT ON CONTROL STACK
	CALL	PSHCS
	PUSH	HL		;ADDR ON CONTROL STACK FOR LIMIT
	LD	DE,-FPSIZ		;ALLOCATE SPACE FOR STEP ON CONTROL STACK
	CALL	PSHCS
	CALL	POPAS		;COPY STEP VALUE TO CONTROL STACK
	POP	DE		;CONTROL STACK ADDR FOR LIMIT VLAUE
	CALL	POPA1		;LIMIT VALUE TO CONTROL STACK
	LD	DE,-3		;ALLOCATE SPACE FOR TEST ADDRESS AND CS ENTRY
	CALL	PSHCS
	POP	DE		;CONTROL VARIABLE ADDRESS
	LD	(HL),D		;HIGH ORDER BYTE OF CONTROL VAR ADDR
	DEC	HL
	LD	(HL),E		;LOW ORDER BYTE 
	DEC	HL
	LD	(HL),FTYPE		;SET CONTROL STACK ENTRY TYPE FOR "FOR"
	JP	NEXT5		;GO FINISH OFF CAREFULLY
; "NEXT"
NEXT:	CALL	DIRT
	LD	HL,(CSTKA)	;CONTROL STACK ADDRESS
	LD	A,(HL)		;STACK ENTRY TYPE BYTE
	DEC	A		;MUST BE FOR TYPE ELSE ERROR
	JP	NZ,E4		;IMPROPER NEXTING ERROR
	INC	HL		;CONTROL STACK POINTER TO CONTROL VAR ADDR
	PUSH	HL
	CALL	VAR		;CHECK VARIABLE, IN CASE USER WANTS
	JP	C,NEXT1		;SKIP CHECK IF VAR NOT THERE
	EX	DE,HL
	POP	HL		;CONTROL VARIABLE ADDRESS
	PUSH	HL		;SAVE IT AGAIN
	CALL	DCMP
	JP	NZ,E4		;IMPROPER NESTING IF NOT THE SAME
NEXT1:	POP	HL		;CONTROL VARIABLE ADDRESS
	PUSH	HL
	PUSH	HL
	LD	DE,FPSIZ+2-1		;COMPUTE ADDRESS TO STEP VALUE
	ADD	HL,DE
	EX	(SP),HL	;NOW ADDRESS TO VAR IN HL
	CALL	LHLI		;VARIABLE ADDRESS
	LD	B,H		;COPY VAR ADDRESS TO BC
	LD	C,L
	POP	DE		;STEP VALUE ADDRESS
	PUSH	DE
	CALL	FADD		;DO INCREMENT
	POP	HL		;STEP VALUE
	DEC	HL		;POINT TO SIGN OF STEP VALUE
	LD	A,(HL)		;SIGN 0=POS, 1=NEG
	LD	DE,FPSIZ+1
	ADD	HL,DE		;PUTS LIMIT ADDRESS IN HL
	EX	DE,HL
	POP	HL		;VARIABLE ADDRESS
	CALL	LHLI		;GET ADDRESS
	PUSH	DE		;SAVE CONTROL STACK POINTER TO GET TEXT ADDR
	OR	A		;SET CONDITIONS BASED ON SIGN OF STEP VALUE
	JP	Z,NEXT2		;REVERSE TEST ON NEGATIVE STEP VALUE
	EX	DE,HL
NEXT2:	LD	B,H		;SET UP ARGS FOR COMPARE
	LD	C,L
	CALL	RELOP		;TEST <=
	POP	DE		;TEXT ADDRESS
	JP	M,NEXT3		;STILL SMALLER?
	JP	Z,NEXT3		;JUMP IF WANT TO CONTINUE LOOP
; TERMINATE LOOP
	LD	HL,3		;REMOVE CSTACK ENTRY
	ADD	HL,DE
	LD	(CSTKA),HL
	RET
NEXT3:	INC	DE		;TEXT ADDRESS
	EX	DE,HL
	CALL	LHLI		;GET TEXT ADDRESS IN HL
; ITERATE, SKIPPING NORMAL JUNK ON END TEST AT ILOOP
NEXT4:	EX	DE,HL	;SAVE NEW TEXT ADDRESS IN DE
	CALL	JOE
	EX	DE,HL
NEXT6:	LD	(TXA),HL
NEXT5:	LD	HL,ILOOP
	EX	(SP),HL
	RET		;TO DISPATCHER SKIPPING JOE CALL THERE
; "IF"
SIF:	LD	B,1		;SPECIFY PRINCIPAL OPERATOR IS RELATIONAL
	CALL	EXPB1
	LD	HL,(ASTKA)	;ADDRESS ON BOOLEAN VALUE ON ARG STACK
	INC	(HL)		;SETS ZERO CONDITION IF RELATIONAL TEST TRUE
	PUSH	AF		;SAVE CONDITIONS TO TEST LATER
	CALL	POPAS		;REMOVE VALUE FROM ARG STACK COPY TO SELF
	POP	AF
	JP	NZ,REM		;IF TEST FALSE TREAT REST OF STATEMENT AS REM
; TEST SUCCEEDED
	LD	B,THENRW
	CALL	EATC
	CALL	INTGER		;CHECK IF LINE NUMBER IS DESIRED ACTION
	JP	C,ISTAT
	JP	GOTO1
; "GOTO"
SGOTO:	XOR	A
	LD	(DIRF),A	;CLEAR DIRECT STATEMENT FLAG
	CALL	INTGER		;RETURNS INTEGER IN HL IF LINE NUMBER PRESENT
	JP	C,E1		;SYNTAX ERROR NO LINE NUMBER
GOTO1:	EX	DE,HL	;LN IN DE
	CALL	FINDLN		;RETURNS TEST ADDRESS POINTS TO COUNT VALUE
GOTO2:	INC	HL	
	INC	HL
	INC	HL		;ADVANCE TEXT POINTER PAST LINE NUMBER ANDCOUNT
	JP	NEXT4
; "GOSUB"
GOSUB:	CALL	DIRT
	LD	DE,-3		;CREATE CONTROL STACK ENTRY
	CALL	PSHCS
	PUSH	HL		;SAVE STACK ADDRESS
	CALL	INTGER
	JP	C,E1
	EX	DE,HL	;LINE NUMBER TO DE
	CALL	JOE
	LD	B,H
	LD	C,L
	POP	HL		;STACK ADDRESS
	LD	(HL),B		;STACK RETURN ADDRESS RETURNED BY JOE
	DEC	HL
	LD	(HL),C
	DEC	HL
	LD	(HL),GTYPE		;MAKE CONTROL STACK ENTRY TYPE "GOSUB"
	CALL	FINDLN
	INC	HL
	INC	HL
	INC	HL
	JP	NEXT6
; "RETURN"
RETRN:	CALL	DIRT
	LD	(DIRF),A	;CLEARS DIRF IN ACC IS CLEAR
	LD	HL,(CSTKA)
RET1:	LD	A,(HL)
	OR	A		;CHECK FOR STACK EMPTY
	JP	Z,E4
	CP	GTYPE		;CHECK FOR GOSUB TYPE
	JP	Z,RET2
; REMOVE FOR TYPE ENTRY FROM STACK
	LD	DE,FORSZ
	ADD	HL,DE
	JP	RET1
; FOUND A GTYPE STACK ENTRY
RET2:	INC	HL
	LD	E,(HL)		;LOW ORDER TEXT ADDRESS
	INC	HL
	LD	D,(HL)		;HIGH ORDER TEXT ADDRESS
	INC	HL		;ADDRESS OF PREVIOUS CONTROL STACK ENTRY
	LD	(CSTKA),HL
	EX	DE,HL	;PUT TEXT ADDRESS IN HL
	LD	A,(HL)		;ADDRESS POINTS TO EOF IF GOSUB WAS LAST LINE
	DEC	A		;END OF FILE?
	JP	NZ,NEXT4
	JP	ENDX
; "DATA" AND "REM"
DATA:	CALL	DIRT		;DATA STATEMENT ILLEGAL AS DIRECT
REM:	CALL	GCI
	CP	CR
	JP	NZ,REM
	DEC	HL		;BACKUP POINTER SO NORMAL JOE WILL WORK
	LD	(TXA),HL
	RET
; "DIM"
DIM:	CALL	NAME		;LOOK FOR VARIABLE NAME
	JP	C,E1
	LD	A,C		;PREPARE TURN ON 80H BIT TO SIGNIFY MATRIX
	OR	80H	
	LD	C,A
	CALL	STLK
	JP	NC,E6		;ERROR IF NAME ALREADY EXISTS
	PUSH	HL		;SYMBOL TABLE ADDRESS
	LD	B,LPARRW
	CALL	EATC
	CALL	EXPRB
	LD	B,')'
	CALL	EATC
	CALL	PFIX		;RETURN INTEGER IN DE
	LD	HL,MATUB		;MAXIMUM SIZE FORM MATRIX
	CALL	DCMP
	JP	NC,E6
	POP	HL		;SYMBOL TABLE ADDRESS
	CALL	DIMS
	CALL	GC		;SEE IF MORE TO DO
	CP	','
	RET	NZ
	CALL	GCI		;EAT THE COMMA
	JP	DIM
; "STOP"
STOP:	CALL	DIRT
STOP1:	CALL	CRLF2
	LD	(BRKCHR),A
	LD	HL,STOPS
	JP	ERM1
; "END"
ENDX	EQU	CMND1
; "READ"
READ:	CALL	DIRT
	LD	HL,(TXA)
	PUSH	HL		;SAVE TXA TEMPORARILY
	LD	HL,(RTXA)	;THE 'READ' TXA
READ0:	LD	(TXA),HL
	CALL	GCI
	CP	','
	JP	Z,READ2		;PROCESS INPUT VALUE
	CP	DATARW
	JP	Z,READ2
	DEC	A
	JP	Z,READ4
; SKIP TO NEXT LINE
	CALL	REM		;LEAVES ADDRESS OF LAST CR IN HL
	INC	HL
	LD	A,(HL)
	DEC	A
	JP	Z,READ4
	INC	HL
	INC	HL
	INC	HL		;HL NOW POINTS TO FIRST BYTE ON NEXT LINE
	JP	READ0
; PROCESS VALUE
READ2:	CALL	EXPRB
	CALL	GC
	CP	','		;SKIP JOE TEST IF COMMA
	JP	Z,READ3
; JUNK ON END TEST
	CALL	JOE
READ3:	LD	HL,(TXA)
	LD	(RTXA),HL	;SAVE NEW "READ" TEXT ADDRESS
	POP	HL		;REAL TXA
	LD	(TXA),HL
	CALL	VAR
	JP	C,E1
	CALL	POPAS		;PUT READ VALUE INTO VARIABLE
	CALL	GC
	CP	','		;CHECK FOR ANOTHER VARIABLE
	RET	NZ
	CALL	GCI		;EAT THE COMMA
	JP	READ
READ4:	POP	HL		;PROGRAM TXA
	LD	(TXA),HL
	LD	BC,'RD'
	JP	ERROR
; "RESTORE"
RESTOR:	LD	HL,(BOFA)	;BEGINNING OF FILE POINTER
	INC	HL
	INC	HL
	INC	HL
	LD	(RTXA),HL
	RET
; "PRINT"
PRINT:	CALL	GC
	CP	CR		;CHECK FOR STAND ALONE PRINT
	JP	Z,CRLF
PRIN2:	CP	'"'
	JP	Z,PSTR		;PRINT THE STRING
	CP	TABRW	
	JP	Z,PTAB		;TABULATION
	CP	'%'
	JP	Z,PFORM		;SET FORMAT
	CP	CR
	RET	Z
	CP	';'
	RET	Z
	CALL	EXPRB		;MUST BE EXPRESSION TO PRINT
	LD	DE,FPSINK
	CALL	POPA1		;POP VALUE TO FPSINK
	LD	A,(PHEAD)
	CP	56
	CALL	NC,CRLF		;DO CRLF IF PRINT HEAD IS PAST 56
	LD	HL,FPSINK
	CALL	FPOUT
	LD	B,' '
	CALL	CHOUT
PR1:	CALL	GC		;GET DELIMITER
	CP	','
	JP	NZ,CRLF
PR0:	CALL	GCI
	CALL	GC
	JP	PRIN2
PSTR:	CALL	GCI		;GOBBLE THE QUOTE
	CALL	PRNT		;PRINT UP TO DOUBLE QUOTE
	INC	HL		;MOVE POINTER PAST DOUBLE QUOTE
	LD	(TXA),HL
	JP	PR1
PFORM:	LD	A,2*FPNIB
	LD	(INFES),A
	CALL	GCI		;GOBBLE PREVIOUS CHAR
PFRM1:	CALL	GCI
	LD	HL,INFES
	CP	'%'		;DELIMITER
	JP	Z,PR1
	LD	B,80H
	CP	'Z'		;TRAILING ZEROS?
	JP	Z,PF1
	LD	B,1
	CP	'E'		;SCIENTIFIC NOTATION?
	JP	Z,PF1
	CALL	NMCHK
	JP	NC,E1
	SUB	'0'		;NUMBER OF DECIMAL PLACES
	RLCA
	LD	B,A
	LD	A,(HL)
	AND	301Q
	LD	(HL),A
PF1:	LD	A,(HL)
	OR	B
	LD	(HL),A
	JP	PFRM1
PTAB:	CALL	GCI		;GOBBLE TAB RW
	LD	B,LPARRW
	CALL	EATC
	CALL	EXPRB
	LD	B,')'
	CALL	EATC
	CALL	PFIX
PTAB1:	LD	A,(PHEAD)
	CP	E
	JP	NC,PR1
	LD	B,' '
	CALL	CHOUT
	JP	PTAB1
; "INPUT"
INPUT:	CALL	GC
	CP	','
	JP	Z,NCRLF
	CALL	CRLF
INP0:	LD	B,'?'
	CALL	CHOUT
LINP:	CALL	INLINE
	LD	DE,IBUF
IN1:	PUSH	DE		;SAVE FOR FPIN
	CALL	VAR
	JP	C,E1
	POP	DE
	LD	B,0
	LD	A,(DE)
	CP	'+'		;LOOK FOR LEADING PLUS OR MINUS ON INPUT
	JP	Z,IN2
	CP	'-'
	JP	NZ,IN3
	LD	B,1
IN2:	INC	DE
IN3:	PUSH	BC
	PUSH	HL
	CALL	FPIN		;INPUT FP NUMBER
	JP	C,INERR
	POP	HL
	DEC	HL
	POP	AF
	LD	(HL),A
	CALL	GC
	CP	','
	RET	NZ	;DONE IF NO MORE
	CALL	GCI		;EAT THE COMMA
	LD	A,B		;GET THE TERMINATOR TO A
	CP	','
	JP	Z,IN1		;GET THE NEXT INPUT VALUE FROM STRING
; GET NEW LINE FROM USER
	LD	B,'?'
	CALL	CHOUT
	JP	INP0
NCRLF:	CALL	GCI
	JP	LINP		;NOW GET LINE
INERR:	LD	BC,'IN'
	JP	ERROR
; 
; EVALUATE AN EXPRESSION FROM TEXT
; HL TAKE OP TABLE ADDR OF PREVIOUS OPERATOR (NOT CHANGED)
; RESULT VALUE LEFT ON TOP OF ARG STACK, ARGF LEFT TRUE
; 
EXPRB:	LD	B,0
EXPB1:	LD	HL,OPBOL
	XOR	A
	LD	(RELTYP),A
; ZERO IN B MEANS PRINCIPAL OPERATOR MAY NOT BE RELATIONAL
EXPR:	PUSH	BC
	PUSH	HL		;PUSH OPTBA
	XOR	A
	LD	(ARGF),A
EXPR1:	LD	A,(ARGF)
	OR	A
	JP	NZ,EXPR2
	CALL	VAR		;LOOK FOR VARIABLE PERHAPS SUBSCRIPTED
	CALL	NC,PSHAS
	JP	NC,EXPR2
	CALL	CONST
	JP	NC,EXPR2
	CALL	GC
	CP	LPARRW
	LD	HL,OPLPAR
	JP	Z,XLPAR
; ISN'T OR SHOULDN'T BE AN ARGUMENT
EXPR2:	CALL	GC
	CP	340Q		;CHECK FOR RESERVED WORD OPERATOR
	JP	NC,XOP
	CP	300Q		;CHECK FOR BUILT IN FUNCTION
	JP	NC,XBILT
; ILLEGAL EXPRESSION CHARACTER
	POP	HL		;GET OPTBA
	LD	A,(ARGF)
	OR	A
	JP	Z,E1
XDON1:	POP	AF
	LD	HL,RELTYP		;CHECK IF LEGAL PRINCIPAL OPERATOR
	CP	(HL)
	RET	Z
	JP	E1
XOP:	AND	37Q		;CLEANS OFF RW BITS
	LD	HL,(ARGF)	;TEST FOR ARGF TRUE
	DEC	L
	JP	Z,XOP1
; ARGF WAS FALSE, UNARY OPS ONLY POSSIBILITY
	CP	'-'-OPBASE
	JP	Z,XOPM
	CP	'+'-OPBASE
	JP	NZ,E1
	CALL	GCI		;EAT THE '+'
	JP	EXPR1
XOPM:	LD	A,UMINUS-OPBASE
XOP1:	CALL	OPADR
	POP	DE		;PREVIOUS OPTBA
	LD	A,(DE)
	CP	(HL)
	JP	NC,XDON1		;NON-INCREASING PRECEDENCE
; INCREASING PRECEDENCE CASE
	PUSH	DE		;SAVE PREVIOUS OPTBA
	PUSH	HL		;SAVE CURRENT OPTBA
	CALL	GCI		;TO GOBBLE OPERATOR
	POP	HL
	PUSH	HL
	LD	B,0		;SPECIFY NON-RELATIONAL
	CALL	EXPR
	POP	HL
; HL HAS OPTBA ADDRESS
; SET UP ARGS AND PERFORM OPERATION ACTION
XOP2:	PUSH	HL
	LD	A,(HL)
	LD	HL,(ASTKA)
	LD	B,H
	LD	C,L
	AND	1
	JP	NZ,XOP21
; DECREMENT STACK POINTER BY ONE VALUE BINARY CASE
	LD	DE,FPSIZ
	ADD	HL,DE
	LD	(ASTKA),HL
	LD	D,H
	LD	E,L
XOP21:	LD	HL,EXPR1
	EX	(SP),HL	;CHANGE RETURN LINK
	INC	HL		;SKIP OVER PRECEDENCE
	CALL	LHLI		;LOAD ACTION ADDRESS
	JP	(HL)
; 
; ACTION ROUTINE CONVENTION
; DE LEFT ARG AND RESULT FOR BINARY
; BC RIGHT ARG FOR BINARY, ARG AND RESULT FOR UNARY
; 
;         INTRINSIC FUNCTION PROCESSING
; 
XBILT:	CALL	GCI		;EAT TOKEN
	AND	77Q		;CLEAN OFF RW BITS
	LD	HL,(ARGF)	;BUILT IN FUNCTION MUST COME AFTER OPERATOR
	DEC	L
	JP	Z,E1
	CALL	OPADR		;OPTBA TO HL
XLPAR:	PUSH	HL
	LD	B,LPARRW
	CALL	EATC
	CALL	EXPRB
	LD	B,')'
	CALL	EATC
	POP	HL		;CODE FOR BUILT-IN FUNCTION
	JP	XOP2
; COMPUTE OPTABLE ADDRESS FOR OPERATOR IN ACC
OPADR:	LD	C,A
	LD	B,0
	LD	HL,OPTAB
	ADD	HL,BC
	ADD	HL,BC
	ADD	HL,BC		;OPTAB ENTRY ADDR IS 3*OP+BASE
	RET
; 
; PREPROCESSOR, UN-PREPROCESSOR
; PREPROCESS LINE IN IBUF BACK INTO IBUF
; SETS CARRY IF LINE HAS NO LINE NUMBER
; LEAVES CORRECT LENGTH OF LINE AFTER PREPROCESSING IN IBCN
; IF THERE IS A LINE NUMBER, IT IS LOCATED AT IBLN=IBUF-2
; TXA IS CLOBBERED
; 
PP:	LD	HL,IBUF		;FIRST CHARACTER OF INPUT LINE
	LD	(TXA),HL	;SO GCI WILL WORK
	CALL	INTGER		;SETS CARRY IF NO LINE NUMBER
	LD	(IBLN),HL	;STORE LINE NUMBER VALUE(EVEN IF NONE)
	PUSH	AF		;SAVE STATE OF CARRY BIT FOR RETURNING
	LD	HL,(TXA)	;ADDRESS OF NEXT CHARACTER IN IBUF
	LD	C,4		;SET UP INITIAL VALUE FOR COUNT
	LD	DE,IBUF		;INITIALIZE WRITE POINTER
; COME HERE TO CONTINUE PREPROCESSING
PPL:	PUSH	DE
	LD	DE,RWT		;BASE OF RWT
PPL1:	PUSH	HL		;SAVE TEXT ADDRESS
	LD	A,(DE)		;RW VALUE FOR THIS ENTRY IN RWT
	LD	B,A		;SAVE IN B IN CASE OF MATCH
PPL2:	INC	DE		;ADVANCE ENTRY POINTER TO NEXT BYTE
	LD	A,(DE)		;GET NEXT CHARACTER FROM ENTRY
	CP	(HL)		;COMPARE WITH CHARACTER IN TEXT
	JP	NZ,PPL3
	INC	HL		;ADVANCE TEXT POINTER
	JP	PPL2		;CONTINUE COMPARISON
; COME HERE WHEN COMPARISON OF BYTE FAILED
PPL3:	OR	A
	JP	M,PPL6		;JUMP IF FOUND MATCH
; SCAN TO BEGINNING ON NEXT ENTRY
PPL4:	INC	DE		;ADVANCE ENTRY POINTER
	LD	A,(DE)		;NEXT BYTE IS EITHER CHARACTER OR RW BYTE
	OR	A
	JP	P,PPL4		;KEEP SCANNING IF NOT RW BYTE
; NOW SEE IF AT END OF TABLE, AND FAIL OR RETURN CONDITION
	POP	HL		;RECOVER ORIGINAL TEXT POINTER
	XOR	-1		;CHECK FOR END OF TABLE BYTE
	JP	NZ,PPL1		;CONTINUE SCAN OF TABLE
; DIDN'T FIND AN ENTRY AT THE GIVER TEXT ADR
	POP	DE
	LD	A,(HL)		;GET THE TEXT CHARACTER
	CP	CR		;CHECK FOR END OF LINE
	JP	Z,PPL8		;GO CLEAN UP AND RETURN
	LD	(DE),A
	INC	DE
	INC	C
	INC	HL		;ADVANCE TEXT POINTER
	CP	'"'		;CHECK FOR QUOTED STRING POSSIBILITY
	JP	NZ,PPL		;RESTART RWT SEARCH AT NEXT CHARACTER POSITION
; HERE WE HAVE A QUOTED STRING, SO EAT TILL ENDQUOTE
PPL5:	LD	A,(HL)		;NEXT CHARACTER
	CP	CR
	JP	Z,PPL8		;NO STRING ENDQUOTE, LET INTERPRETER WORRY
	LD	(DE),A
	INC	DE
	INC	C
	INC	HL		;ADVANCE TEXT POINTER
	CP	'"'
	JP	Z,PPL		;BEGIN RWT SCAN FROM NEW CHARACTER POSITION
	JP	PPL5
; FOUND MATCH SO PUT RW VALUE IN TEXT
PPL6:	POP	AF		;REMOVE UNNEEDED TEST POINTER FROM STACK
	POP	DE
	LD	A,B
	LD	(DE),A
	INC	DE
	INC	C
	JP	PPL
; COME HERE WHEN DONE
PPL8:	LD	A,CR
	LD	(DE),A
	LD	HL,IBCNT		;SET UP COUNT IN CASE LINE OF LINE NUMBER
	LD	(HL),C
	POP	AF		;RESTORE CARRY CONDITION (LINE NUMBER FLAG)
	RET
; 
; UN-PREPROCESS LINE ADDRESSES IN HL TO DE BUFFER
; RETURN SOURCE ADDRESS OF CR IN HL ON RETURN
; 
UPPL:	INC	HL		;SKIP OVER COUNT BYTE
	PUSH	HL		;SAVE SOURCE TEXT POINTER
	CALL	LHLI		;LOAD LINE NUMBER VALUE
	CALL	CNS		;CONVERT LINE NUMBER
	LD	A,' '
	LD	(DE),A		;PUT BLANK AFTER LINE NUMBER
	INC	DE		;INCREMENT DESTINATION POINTER
	POP	HL
	INC	HL		;INCREMENT H PAST LINE NUMBER
UPP0:	INC	HL
	LD	A,(HL)		;NEXT TOKEN IN SOURCE
	OR	A
	JP	M,UPP1		;JUMP IF TOKEN IS RW
	LD	(DE),A		;PUT CHARACTER IN BUFFER
	CP	CR		;CHECK FOR DONE
	RET	Z
	INC	DE		;ADVANCE DESTINATION BUFFER ADDRESS
	JP	UPP0
; COME HERE WHEN RW BYTE DETECTED IN SOURCE
UPP1:	PUSH	HL		;SAVE SOURCE POINTER
	LD	HL,RWT		;BASE OF RWT
UPP2:	CP	(HL)		;SEE IF RW MATCHED RWT ENTRY
	INC	HL		;ADVANCE RWT POINTER
	JP	NZ,UPP2		;CONTINUE LOOKING IF NOT FOUND
; FOUND MATCH, ENTRY POINTER LOCATES FIRST CHARACTER
UPP3:	LD	A,(HL)		;CHARACTER OF RW
	OR	A		;CHECK FOR DONE
	JP	M,UPP4
	LD	(DE),A
	INC	DE
	INC	HL
	JP	UPP3
; COME HERE IF DONE WITH RW TRANSFER
UPP4:	POP	HL		;SOURCE POINTER
	JP	UPP0
; 
; CONSTANTS AND TABLES
; 
RDYS:	DEFM	'READY"'
PLS:	DEFM	'PROGRAM LOADED? "'
ERS:	DEFM	' ERROR"'
INS:	DEFM	' IN LINE "'
STOPS:	DEFM	'STOP"'
; 
	DEFB	0FFH		;FLAGS END OF SINE COEFFICIENT LIST
	DEFB	0
	DEFB	1*16
	DEFW	0
	DEFB	0
FPONE:	DEFB	129		;EXPONENT
; SINE COEFFICIENT LIST
; NOTE: THE FLOATING PNT 1 ABOVE IS A PART OF THIS TABLE
	DEFB	16H
	DEFB	66H
	DEFB	67H
	DEFB	1
	DEFB	128		;-.166667 E 0 (-1/3!)
	DEFB	83H
	DEFB	33H
	DEFB	33H
	DEFB	0
	DEFB	128-2		;.833333 E-2 (1/5!)
	DEFB	19H
	DEFB	84H
	DEFB	13H
	DEFB	1	
	DEFB	128-3		;-.198413 E-3 (-1/7!)
	DEFB	27H
	DEFB	55H
	DEFB	73H
	DEFB	0
	DEFB	128-5		;.275573 E-5 (1/9!)
	DEFB	25H
	DEFB	5
	DEFB	21H
	DEFB	1
SINX:	DEFB	128-7		;-.250521 E-7 (-1/11!)
; COSINE COEFFICIENT LIST
	DEFB	0FFH		;MARKS END OF LIST
	DEFB	0
	DEFB	10H
	DEFB	0
	DEFB	0
	DEFB	0
	DEFB	128+1		;/100000 E 1 (1/1!)
	DEFB	50H
	DEFB	0
	DEFB	0
	DEFB	1
MATUB:	DEFB	128		;-.500000 E 0 (-1/2!)
	DEFB	41H
	DEFB	66H
	DEFB	67H
	DEFB	0
RANDS:	DEFB	128-1		;.416667 E-1 (1/4!)
	DEFB	13H
	DEFB	88H
	DEFB	89H
	DEFB	1
	DEFB	128-2		;-.138889 E-2 (-1/6!)
	DEFB	24H
	DEFB	80H
	DEFB	16H
	DEFB	0
	DEFB	128-4		;.248016 E-4 (1/8!)
	DEFB	27H
	DEFB	55H
	DEFB	73H
	DEFB	1
COSX:	DEFB	128-6		;-.275573 E-6 (-1/10!)
	DEFB	20H
	DEFW	0
	DEFB	0
FPTWO:	DEFB	129
	DEFB	15H
	DEFB	70H
	DEFB	80H
	DEFB	0
PIC2:	DEFB	128+1		;PI/2
	DEFB	63H
	DEFB	66H
	DEFB	20H
	DEFB	0
PIC1:	DEFB	128		;2/PI
LCSTKA: DEFW	CSTKL
; 
; COMMAND TABLE
; 
CMNDD:	DEFW	CRUN		; 0
	DEFW	CLIST		; 1
	DEFW	CNULL		; 2
	DEFW	CSCR		; 3
	DEFW	START		; 4 SET UP MEMORY BOUNDS
	DEFW	TSAV		; 5 TAPE SAVE
	DEFW	TLOAD		; 6 TAPE LOAD
; STATEMENT TABLE
STATD:	DEFW	LET		; 0
	DEFW	NEXT		; 1
	DEFW	SIF		; 2
	DEFW	SGOTO		; 3
	DEFW	GOSUB		; 4
	DEFW	RETRN		; 5
	DEFW	READ		; 6
	DEFW	DATA		; 7
	DEFW	SFOR		; 10
	DEFW	PRINT		; 11
	DEFW	INPUT		; 12
	DEFW	DIM		; 13
	DEFW	STOP		; 14
	DEFW	ENDX		; 15
	DEFW	RESTOR		; 16
	DEFW	REM		; 17
	DEFW	CCLEAR		; 20
; 
; R/W WORD TABLE FORMAT IS RESERVED WORD FOLLOWED BY CHR
; OF RESERVED WORD.  LAST ENTRY IS FOLLOWED BY A 377Q
; RW'S THAT ARE SUBSTRINGS OF OTHER RW'S (E.G. >) MUST
; FOLLOW THE LARGER WORD. 
; 
RWT:	DEFB	200Q
	DEFM	'LET'
	DEFB	201Q
	DEFM	'NEXT'
	DEFB	202Q
	DEFM	'IF'
	DEFB	203Q	
	DEFM	'GOTO'
	DEFB	204Q	
	DEFM	'GOSUB'
	DEFB	205Q
	DEFM	'RETURN'
	DEFB	206Q
	DEFM	'READ'
	DEFB	207Q
	DEFM	'DATA'
DATARW	EQU	207Q
	DEFB	210Q
	DEFM	'FOR'
	DEFB	211Q
	DEFM	'PRINT'
	DEFB	211Q
	DEFM	':'
	DEFB	212Q	
	DEFM	'INPUT'
	DEFB	213Q	
	DEFM	'DIM'
	DEFB	214Q
	DEFM	'STOP'
	DEFB	215Q
	DEFM	'END'
	DEFB	216Q
	DEFM	'RESTORE'
	DEFB	217Q
	DEFM	'REM'
	DEFB	220Q
	DEFM	'CLEAR'
CLRRW	EQU	220Q
IRWLIM	EQU	221Q		;LAST INITIAL RESERVED WORD VALUE+1
	DEFB	237Q
	DEFM	'STEP'
STEPRW	EQU	237Q
	DEFB	236Q
	DEFM	'TO'
TORW	EQU	236Q
	DEFB	235Q
	DEFM	'THEN'
THENRW	EQU	235Q
	DEFB	234Q
	DEFM	'TAB'
TABRW	EQU	234Q
	DEFB	240Q
	DEFM	'RUN'
RUNRW	EQU	240Q
	DEFB	241Q
	DEFM	'LIST'
LISTRW	EQU	241Q
	DEFB	242Q
	DEFM	'NULL'
NULLRW	EQU	242Q
	DEFB	243Q	
	DEFM	'SCR'
SCRRW	EQU	243Q
	DEFB	244Q
	DEFM	'MEM'
MEMRW	EQU	245Q		;******* WRONG CODE?*******
	DEFB	245Q
	DEFM	'TSAV'
	DEFB	246Q
	DEFM	'TLOAD'
LPARRW	EQU	'('-OPBASE+340Q
	DEFB	LPARRW
	DEFB	'('
	DEFB	'*'-OPBASE+340Q
	DEFB	'*'
PLSRW	EQU	'+'-OPBASE+340Q
	DEFB	PLSRW
	DEFB	'+'
MINRW	EQU	'-'-OPBASE+340Q
	DEFB	MINRW
	DEFB	'-'
	DEFB	'/'-OPBASE+340Q
	DEFB	'/'
	DEFB	67Q-OPBASE+340Q
	DEFM	'>='
	DEFB	70Q-OPBASE+340Q
	DEFM	'<='
	DEFB	71Q-OPBASE+340Q
	DEFM	'<>'
	DEFB	62Q-OPBASE+340Q
	DEFM	'=>'
	DEFB	63Q-OPBASE+340Q
	DEFM	'=<'
	DEFB	'<'-OPBASE+340Q
	DEFB	'<'
EQRW	EQU	'='-OPBASE+340Q
	DEFB	EQRW
	DEFB	'='
	DEFB	'>'-OPBASE+340Q
	DEFB	'>'
	DEFB	301Q
	DEFM	'ABS'
	DEFB	306Q
	DEFM	'INT'
	DEFB	314Q
	DEFM	'ARG'
	DEFB	315Q
	DEFM	'CALL'
	DEFB	316Q
	DEFM	'RND'
	DEFB	322Q
	DEFM	'SGN'
	DEFB	323Q
	DEFM	'SIN'
	DEFB	304Q
	DEFM	'SQR'
	DEFB	327Q
	DEFM	'TAN'
	DEFB	330Q
	DEFM	'COS'
	DEFB	377Q
; 
; OPERATION TABLE
; 
OPTAB:	DEFB	15
OPLPAR	EQU	OPTAB
	DEFW	ALPAR
	DEFB	15
	DEFW	AABS
	DEFB	10
	DEFW	AMUL
	DEFB	6
	DEFW	AADD
	DEFB	15
	DEFW	ASQR
	DEFB	6
	DEFW	ASUB
	DEFB	15
	DEFW	AINT
	DEFB	10
	DEFW	ADIV
OPBOL:	DEFB	1
	DEFW	0
	DEFB	13
	DEFW	ANEG
	DEFB	4
	DEFW	AGE
	DEFB	4
	DEFW	ALE
	DEFB	15
	DEFW	AARG	
	DEFB	15
	DEFW	ACALL
	DEFB	15
	DEFW	ARND
	DEFB	4
	DEFW	AGE
	DEFB	4
	DEFW	ALE
	DEFB	4
	DEFW	ANE
	DEFB	15
	DEFW	ASGN
	DEFB	15
	DEFW	ASIN
	DEFB	4
	DEFW	ALT
	DEFB	4
	DEFW	AEQ
	DEFB	4
	DEFW	AGT
	DEFB	15
	DEFW	ATAN
	DEFB	15
	DEFW	ACOS
; 
; ACTION ROUTINES FOR RELATIONAL OPERATORS
; 
AGT:	CALL	RELOP
	JP	Z,RFALSE
	JP	M,RTRUE
RFALSE: XOR	A
	LD	(DE),A
	RET
ALT:	CALL	RELOP
	JP	Z,RFALSE
	JP	M,RFALSE
RTRUE:	LD	A,-1
	LD	(DE),A
	RET
AEQ:	CALL	RELOP
	JP	Z,RTRUE
	JP	RFALSE
ANE:	CALL	RELOP
	JP	Z,RFALSE
	JP	RTRUE
AGE:	CALL	RELOP
	JP	Z,RTRUE
	JP	M,RTRUE
	JP	RFALSE
ALE:	CALL	RELOP
	JP	Z,RTRUE
	JP	M,RFALSE
	JP	RTRUE
; 
; COMMON ROUTINE FOR RELATIONAL OPERATOR ACTION
; LEFT ARG ADDR IN DE, SAVED
; RIGHT ARG ADDR IN BC
; ON RETURN SIGN SET=GT, ZERO SET =EQUAL
; 
RELOP:	PUSH	DE
	DEC	BC
	DEC	DE
	LD	H,B
	LD	L,C
	LD	A,(DE)
	SUB	(HL)
	INC	HL
	INC	DE
	JP	NZ,RLOP1		;TEST SIGNS OF ARGS IF DIFFERENT THEN RET
	LD	BC,FPSINK
	CALL	FSUB
	LD	A,(FPSINK)	;CHECK FOR ZERO RESULT
	OR	A
	JP	Z,RLOP1
	LD	A,(FPSINK-1)	;SIGN OF FPSINK
	RLCA
	DEC	A
RLOP1:	LD	A,1
	LD	(RELTYP),A	;SET RELTYP TRUE
	POP	DE
	RET
; 
; ACTION ROUTINES FOR ARITHMETIC OPERATORS
;         (CODE WASTERS)
; 
AADD:	LD	H,B
	LD	L,C
	LD	B,D
	LD	C,E
AADD1:	CALL	FADD
	JP	FPETST
ASUB:	LD	H,B
	LD	L,C
	LD	B,D
	LD	C,E
ASUB1:	CALL	FSUB
	JP	FPETST
AMUL:	LD	H,B
	LD	L,C
	LD	B,D
	LD	C,E
AMUL1:	CALL	FMUL
	JP	FPETST
ADIV:	LD	H,B
	LD	L,C
	LD	B,D
	LD	C,E
ADIV1:	CALL	FDIV
FPETST: XOR	A
	LD	(RELTYP),A
	LD	A,(ERRI)
	OR	A
	RET	Z
	LD	HL,(ASTKA)	;ZERO RESULT ON UNDERFLOW
FPET1:	LD	(HL),0	
ALPAR:	RET
; 
; UNARY AND BUILT IN FUNCTION ROUTINES
; 
ANEG:	LD	A,(BC)
	OR	A
	JP	Z,ANEG1
	DEC	BC
	LD	A,(BC)
	XOR	1
	LD	(BC),A
ANEG1:	XOR	A
	LD	(RELTYP),A
	RET
AABS:	DEC	BC
	XOR	A
	LD	(BC),A
	JP	ANEG1
ASGN:	CALL	ANEG1
	LD	D,B
	LD	E,C
	LD	A,(BC)		;GET EXPONENT
	OR	A
	JP	NZ,ASGN1
	LD	(DE),A		;MAKE ARGUMENT ZERO
	RET
ASGN1:	DEC	BC
	LD	A,(BC)
	OR	A
	LD	HL,FPONE
	JP	Z,VCOPY
	LD	HL,FPNONE
	JP	VCOPY
; 
; COMPUTE SIN(X)  X=TOP OF ARGUMENT STACK
; RETURN RESULT IN PLACE OF X
; 
ASIN:	CALL	QUADC		;COMPUTE QUADRANT
	LD	HL,(ASTKA)
	LD	D,H
	LD	E,L
	LD	BC,FTEMP
	CALL	AMUL1		;FTEMP=X*X
	POP	AF
	PUSH	AF		;A=QUADRANT
	RRA
	JP	C,SIN10		;QUAD. ODD, COMPUTE COSINE
; COMPUTE X*P(X*X) -- SINE
	LD	DE,FTEM1
	LD	HL,(ASTKA)
	CALL	VCOPY		;FTEM1=X*X
	LD	BC,SINX
	CALL	POLY		;P(X*X)
	CALL	PREPOP
	LD	HL,FTEM1
	CALL	AMUL1		;X*P(X*X)
;   COMPUTE SIGN OF RESULT
; POSITIVE FOR QUADRANTS 0,1.  NEGATIVE FOR 2,3
; NEGATE ABOVE FOR NEGATIVE ARGUMENTS
; 
SIN5:	POP	AF		;QUADRANT
	LD	B,A
	POP	AF		;SIGN
	RLCA		;SIGN, 2 TO THE 1ST BIT
	XOR	B		;QUADRANT, MAYBE MODIFIED FOR NEG. ARGUMENT
	LD	HL,(ASTKA)
	DEC	HL		;PTR TO SIGN
	SUB	2
	RET	M	;QUADRANT 0 OR 1
	INC	(HL)		;ELSE SET RESULT NEGATIVE
	RET
; COMPUTE P(X*X)  -- COSINE
SIN10:	LD	BC,COSX
	CALL	POLY		;P(X*X)
	JP	SIN5
; 
; COMPUTE COS(X)  X=TOP OF ARGUMENT STACK
; RETURN RESULT IN PLACE OF X
; COS(X) = SIN(X+PI/2)
; 
ACOS:	CALL	PREPOP
	LD	HL,PIC2		;PI/2
	CALL	AADD1		;TOS=TOS+PI/2
	JP	ASIN
; 
; COMPUTE TAN(X)  X=TOP OF ARGUMENT STACK
; RETURN RESULT IN PLACE OF X
; TAN(X)=SIN(X)/COS(X)
; 
ATAN:	LD	HL,(ASTKA)
	CALL	PSHAS		;PUSH COPY OF X ONTO ARG STACK
	CALL	ACOS		;COS(X)
	LD	DE,FTEM2
	CALL	POPA1		;FTEM2=COS(X)
	CALL	ASIN
	CALL	PREPOP
	LD	HL,FTEM2
	JP	ADIV1		;SIN(X)/COS(X)
; 
; COMPUTE SQR(X)  X=TOP OF ARGUMENT STACK
; RETURN RESULT IN PLACE OF X
; 
ASQR:	LD	HL,(ASTKA)
	LD	DE,FTEMP
	CALL	VCOPY		;SAVE X IN FTEMP
; COMPUTE EXPONENT OF FIRST GUESS AS EXPONENT OF X/2
	LD	HL,(ASTKA)
	LD	A,(HL)
	OR	A
	RET	Z	;X=0
	SUB	128	
	JP	M,SQR5		;NEGATIVE EXPONENT
	RRCA
	AND	127
	JP	SQR6
SQR5:	CPL
	INC	A
	RRCA
	AND	127
	CPL
	INC	A
SQR6:	ADD	A,128
	LD	(HL),A
; TEST FOR NEGATIVE ARGUMENT
	DEC	HL
	LD	A,(HL)
	LD	BC,'NA'
	OR	A
	JP	NZ,ERROR		;NEGATIVE ARGUMENT
; 
; DO NEWTON'S METHOD
; NEWGUESS=(X/OLDGUESS + OLDGUESS)/2
	LD	A,6		;DO 6 ITERATIONS
SQR20:	PUSH	AF		;SET NEW ITERATION COUNT
	LD	BC,FTEM1
	LD	DE,FTEMP		;FTEMP IS 'X'
	LD	HL,(ASTKA)	;GUESS
	CALL	ADIV1		;FTEM1=X/GUESS
	LD	DE,FTEM1
	LD	HL,(ASTKA)
	LD	B,H
	LD	C,L
	CALL	AADD1		;TOS=(X/GUESS)+GUESS
	CALL	PREPOP
	LD	HL,FPTWO
	CALL	ADIV1		;TOS=(X/GUESS+GUESS)/2
	POP	AF
	DEC	A		;DECREMENT COUNT
	JP	NZ,SQR20		;DO ANOTHER ITERATION
	RET
; 
; COMPUTE RND(X)  X=TOP OF ARGUMENT STACK
; FRAND IS UPDATED TO NEW RANDOM VALUE
; A RANDOM NUMBER IN THE RANGE 0<RND<1 IS RETURNED IN PLACE
; 
ARND:	CALL	PREPOP
	LD	DE,FRAND
	LD	HL,FRAND
	CALL	AMUL1		;TOS=FRAND*FRAND
; SET EXPONENT = 0
	LD	HL,(ASTKA)
	LD	(HL),128		;EXPONENT = 128 (0 IN EXTERNAL FORM)
; PERMUTE DIGITS OF X AS
; 123456 INTO 345612
	LD	BC,-4
	ADD	HL,BC
	LD	B,(HL)		;SAVE 12
	INC	HL	
	INC	HL
	CALL	PERMU		;56=12
	CALL	PERMU		;34=56
	CALL	PERMU		;12=34
; NORMALIZE NUMBER
RND5:	LD	HL,(ASTKA)	;TOS
	LD	BC,-FPSIZ+1
	ADD	HL,BC
	LD	A,(HL)		;FIRST DIGIT PAIR
	AND	15*16
	JP	NZ,RND10		;NUMBER IS NORMALIZED
; SHIFT LEFT ONE DIGIT
	LD	HL,(ASTKA)
	LD	A,(HL)		;EXPONENT
	DEC	A
	LD	(EXP),A
	CALL	LOAD		;TOS INTO TEMP
	LD	B,4
	CALL	LEFT		;SHIFT LEFT
	CALL	PREPOP
	CALL	STORE
	JP	RND5		;TEST IF NORMALIZED
; SAVE NEW RANDOM NUMBER IN FRAND CELL
RND10:	LD	DE,FRAND
	LD	HL,(ASTKA)
	CALL	VCOPY		;FRAND = TOS
	RET		;*****************CALL, RET????!!!!******
; PERMUTE DIGIT PAIRS
PERMU:	LD	A,(HL)
	LD	(HL),B
	LD	B,A
	DEC	HL
	RET
; 
; EVALUATE P(X) USING HORNER'S METHOD (X IS IN FTEMP)
; COEFFICIENT LIST POINTER IS IN BC
; RESULT REPLACES NUMBER ON TOP OF ARGUMENT STACK (Y)
; 
POLY:	LD	HL,(ASTKA)
	EX	DE,HL	;DE=PTR TO Y
	LD	H,B
	LD	L,C		;HL PTR TO COEFFICIENT LIST
	CALL	VCOPY		;Y=FIRST COEFFICIENT
; MULTIPLY BY X
POLY1:	PUSH	HL		;SAVE COEFF LIST POINTER
	CALL	PREPOP
	LD	HL,FTEMP
	CALL	AMUL1		;Y=Y*X
; ADD NEXT COEFF
	CALL	PREPOP
	POP	HL
	PUSH	HL		;HL = COEFF LIST POINTER
	CALL	AADD1		;Y=Y+COEFF
; BUMP POINTER TO NEXT COEFFICIENT
	POP	HL		;COEFF POINTER
	LD	BC,-FPSIZ-1
	ADD	HL,BC		;NEXT COEFF SIGN
	LD	A,(HL)
	INC	HL		;PTR TO EXPONENT
	OR	A	
	JP	P,POLY1		;PROCESS NEXT COEFFICIENT
	RET		;NEGATIVE SIGN (-1) ENDS LIST
; 
; PREPARE FOR OPERATION
; 
PREPOP:	LD	HL,(ASTKA)
	EX	DE,HL	;DE=ASTKA
	LD	B,D
	LD	C,E
	RET
; 
; QUADRANT COMPUTATION
; POPS TOP OF ARGUMENT STACK
; COMPUTE/GETS SIGN OF ARGUMENT, QUADRANT OF ARGUMENT
; AND INDEX INTO QUADRANT
; 
;        EXITS WITH:
; SP POINTING TO QUADRANT, MOD 4
; SP+2 POINTING TO SIGN OF ARGUMENT
; TOP OF ARGUMENT STACK HAS INDEX INTO QUADRANT
; 
QUADC:	LD	HL,(ASTKA)
	DEC	HL		;POINT TO SIGN
	LD	B,(HL)
	XOR	A
	LD	(HL),A		;ARG. SIGN=0
	LD	H,B
	EX	(SP),HL	;PUT SIGN ON STACK, POP RETURN
	PUSH	HL		;PUSH RETURN
; COMPUTE QUADRANT OF ABS(X)
	LD	HL,(ASTKA)
	CALL	PSHAS		;PUT COPY OF ARG ONOT STACK
	CALL	PREPOP
	LD	HL,PIC1		;2/PI
	CALL	AMUL1		;TOS=X*2/PI
	CALL	PREPOP
	CALL	AINT		;TOS=INT(X*2/PI)
	LD	HL,(ASTKA)
	CALL	PSHAS		;ANOTHER COPY
	CALL	PFIX		;POP TOS TO DE
	LD	A,E
	PUSH	AF		;QUADRANT
	CALL	PREPOP
	LD	HL,PIC2
	CALL	AMUL1		;TOS=INT(X*2/PI)
	LD	DE,FTEMP
	CALL	POPA1		;FTEMP=TOS
	CALL	PREPOP
	LD	HL,FTEMP
	CALL	ASUB1		;TOS=TOS-FTEMP
	POP	AF		;A=QUADRANT, LOW ORDER BYTE
	AND	3		;MOD 4
	POP	HL		;POP RETURN OFF STACK
	PUSH	AF		;SAVE QUADRANT ON STACK
	JP	(HL)		;DO RETURN
; SET UP ARG FOR USER CALL
AARG:	CALL	PFIX
	EX	DE,HL
	LD	(CALLA),HL
	LD	DE,FPSINK
	JP	PSHA1		;PUTS BACK THE ARG VALUE ON ARG STACK
; USED TO CALL USER ROUTINE
ACALL:	CALL	PFIX		;GET THE ADDRESS
	LD	HL,(CALLA)	;GET THE USER ARGUMENT
	EX	DE,HL
	LD	BC,ACAL1		;RETURN LINK FOR USER ROUTINE
	PUSH	BC
	JP	(HL)
ACAL1:	LD	DE,CALST
	CALL	CNS
	LD	A,CR
	LD	(DE),A
	LD	DE,CALST
	LD	HL,FPSINK
	CALL	FPIN
	LD	DE,FPSINK
	JP	PSHA1		;PUT THE RETURNED USER VALUE ON ARG STACK
; 
; INT FUNCTION ACTION ROUTINE
; 
AINT:	LD	A,(BC)
	SUB	129
	JP	P,AINT1
; ZERO IF VALUE LESS THAN 1
	XOR	A
	LD	D,5
AINT3:
	LD	(BC),A
	DEC	BC
	DEC	D
	JP	NZ,AINT3
	RET
; EXP > 0
AINT1:	SUB	FPNIB-1
	RET	NC
	LD	D,A		;COUNT
	DEC	BC
AINT2:	DEC	BC
	LD	A,(BC)
	AND	360Q
	LD	(BC),A
	INC	D
	RET	Z
	XOR	A
	LD	(BC),A
	INC	D
	JP	NZ,AINT2
	RET
; 
;        DIMENSION MATRIX
; SYMTAB ADDRESS IN HL, HL NOT CLOBBERED
; DE CONTAINS SIZE IN NUMBER OF ELEMENTS
; 
DIMS:	PUSH	HL
	INC	DE
	PUSH	DE
	LD	HL,0
	LD	C,FPSIZ
	CALL	RADD		;MULTIPLY NELTS BY BYTES PER VALUE
	EX	DE,HL
	LD	HL,(MATA)
	PUSH	HL
	ADD	HL,DE
	CALL	STOV		;CHECK THAT STORAGE NOT EXHAUSTED
	LD	(MATA),HL	;UPDATE MATRIX FREE POINTER
	POP	BC		;BASE ADDR
	POP	DE		;NELTS (NUMBER OF ELEMENTS)
	POP	HL		;SYMTAB ADDR
	PUSH	HL
	LD	(HL),D
	DEC	HL
	LD	(HL),E
	DEC	HL
	LD	(HL),B
	DEC	HL
	LD	(HL),C		;SYMTAB ENTRY NOW SET UP
	POP	HL
	RET
; 
;      FIND VARIABLE OPTIONALLY SUBSCRIPTED IN TEXT
; SETS CARRY IF NOT FOUND
; RETURNS ADDRESS OF VARIABLE IN HL
; UPDATES TXA IF FOUND
; 
VAR:	CALL	ALPHA
	RET	C
	CALL	NAME2
	CALL	GC
	CP	LPARRW
	JP	Z,VAR1		;TEST IF SUBSCRIPTED
; MUST BE SCALAR VARIABLE
	CALL	STLK		;RETURNS ENTRY ADDRESS IN HL
	OR	A		;CLEAR CARRY
	RET
; MUST BE SUBSCRIPTED
VAR1:	CALL	GCI		;GOBBLE LEFT PAREN
	LD	A,80H
	OR	C
	LD	C,A		;SET TYPE TO MATRIX
	CALL	STLK
	PUSH	HL		;SYMBOL TABLE
	LD	DE,10		;DEFAULT MATRIX SIZE
	CALL	C,DIMS		;DEFAULT DIMENSION MATRIX
	CALL	EXPRB		;EVALUATE SUBSCRIPT EXPRESSION
	CALL	PFIX		;DE NOW HAS INTEGER
	LD	B,')'
	CALL	EATC		;GOBBLE RIGHT PAREN
	POP	HL
	DEC	HL
	CALL	DCMP		;BOUNDS CHECK INDEX
	JP	NC,E5
	DEC	HL
	DEC	HL
	CALL	LHLI		;GET BASE ADDR
	LD	C,FPSIZ
	INC	DE		;BECAUSE BASE ADDR IS TO ELEMENT - 1
	CALL	RADD		;ADD INDEX, CLEAR CARRY
	RET		;******** CALL, RET????!!!!!**********
; 
;       JUNK ON END OF STATEMENT, TEST IF AT END OF FILE
; DOES NOT CLOBBER DE
; EATS CHARACTER AND LINE COUNT AFTER CR
; LEAVES NEW TXA IN HL
; SETS CARRY IF END OF FILE
; 
JOE:	CALL	GCI
	CP	';'
	RET	Z
	CP	CR
	JP	NZ,E1
	LD	A,(HL)
	DEC	A
	JP	Z,JOE2
	INC	HL
	INC	HL
	INC	HL		;SKIP OVER COUNT AND LINE NUMBER
JOE1:	LD	(TXA),HL
	RET
JOE2:	SCF
	JP	JOE1
; 
;       GET NAME FROM TEXT
; SETS CARRY IF NAME NOT FOUND
; IF SUCCEEDS RETURNS NAME IN BC, C=0 IF NO DIGIT IN NAME
; 
NAME:	CALL	ALPHA
	RET	C
NAME2:	LD	B,A
	LD	C,0
	CALL	DIG
	CCF
	RET	NC
	LD	C,A
	OR	A		;CLEAR CARRY
	RET
; 
;       SYMBOL TABLE LOOKUP
; BC CONTAIN NAME AND CLASS
; IF NOT FOUND THEN CREATE ZERO'ED ENTRY AND SET CARRY
; HL HAS ADDRESS ON RET
; 
STLK:	LD	HL,(MEMTOP)
	LD	DE,-STESIZ		;SET UP BASE AND INCREMENT FOR SEARCH LOOP
STLK0:	LD	A,(HL)
	OR	A
	JP	Z,STLK2		;TEST IF END OF TABLE
	CP	B
	JP	NZ,STLK1		;TEST IF ALPHA COMPARES
	DEC	HL
	LD	A,(HL)		;LOOK FOR DIGIT
	CP	C
	DEC	HL
	RET	Z	;CARRY CLEAR TOO, RETURN
	INC	HL
	INC	HL
STLK1:	ADD	HL,DE		;DIDN'T COMPARE, DECREMENT POINTER
	JP	STLK0
; ADD ENTRY TO SYMTAB
STLK2:	LD	(HL),B
	DEC	HL
	LD	(HL),C
	INC	HL
	EX	DE,HL
	ADD	HL,DE
	LD	(STAA),HL	;STORE NEW END OF STMTAB POINTER
	DEC	DE
	DEC	DE
	EX	DE,HL
	SCF
	RET
; 
;      GOBBLES NEXT TEXT CHARACTER IF ALPHABETIC
; SETS CARRY IF NOT
; NEXT CHAR IN ACC ON FAILURE
; 
ALPHA:	CALL	GC
	CP	'A'
	RET	C
	CP	'Z'+1
	CCF
	RET	C
	JP	DIGT1
; 
;      GOBBLES NEXT TEXT CHAR IF DIGIT
; SETS CARRY IF NOT
; NEXT CHAR IN ACC ON FAILURE
; 
DIG:	CALL	GC
	CP	'0'
	RET	C
	CP	'9'+1
	CCF
	RET	C
DIGT1:	INC	HL
	LD	(TXA),HL
	RET
; 
; COPYS FPSIZ BYTES AT ADDR HL TO ADDR DE
; ON EXIT HL POINTS TO ADR-1 OF LAST BYTE COPIED
; 
VCOPY:	LD	C,FPSIZ
VCOP1:	LD	A,(HL)
	LD	(DE),A
	DEC	HL
	DEC	DE
	DEC	C
	JP	NZ,VCOP1
	RET
; 
; PUSH VALUE ADDRESSED BY HL ONTO ARG STACK
; SETS ARGF, CLEARS CARRY
; 
PSHAS:	EX	DE,HL
PSHA1:	LD	HL,(ASTKA)
	LD	BC,-FPSIZ
	ADD	HL,BC
	LD	(ASTKA),HL	;DECREMENT ARG STACK POINTER
	EX	DE,HL
	CALL	VCOPY
	LD	A,1
	LD	(ARGF),A	;CLEAR ARGF
	OR	A
	RET
; 
; POP ARG STACK
; HL CONTAINS ADDRESS TO PUT POPPED VALUE INTO
; 
POPAS:	EX	DE,HL
POPA1:	LD	HL,(ASTKA)
	PUSH	HL
	LD	BC,FPSIZ
	ADD	HL,BC
	LD	(ASTKA),HL	;INCREMENT STACK POINTER
	POP	HL
	JP	VCOPY
; 
; PUSH FRAM ONTO CONTROL STACK
; TAKES MINUS AMOUNT TO SUB FROM CSTKA IN DE
; DOES OVERFLOW TEST AND RETURNS OLD CSTKA-1
; 
PSHCS:	LD	HL,(CSTKA)
	PUSH	HL
	ADD	HL,DE
	LD	(CSTKA),HL
	EX	DE,HL
	LD	HL,LCSTKA		;ADDR CONTAINS CSTKL
	CALL	DCMP
	JP	C,E4
	POP	HL
	DEC	HL
	RET
; 
; STORAGE OVERFLOW TEST
; TEST THAT VALUE IN HL IS BETWEEN MATA AND STA
; DOES NOT CLOBBER HL
; 
STOV:	EX	DE,HL
	LD	HL,MATA
	CALL	DCMP
	JP	C,E8
	LD	HL,STAA
	CALL	DCMP
	EX	DE,HL
	RET	C
E8:	LD	BC,'SO'
	JP	ERROR
; 
; INCREMENT TXA IF NEXT NON-BLANK CHAR IS EQUAL TO B
; ELSE SYNTAX ERROR
; 
EATC:	CALL	GCI
	CP	B
	RET	Z
	JP	E1
; 
; GET NEXT NON-BLANK CHAR INTO ACC
; INCREMENT PAST BLANKS ONLY
; 
GC:	CALL	GCI
	DEC	HL
	LD	(TXA),HL
	RET
; 
; GET NEXT NON-BLANK TEXT CHAR AND INCREMENT TXA
; DOES NOT CLOBBER DE,BC
; RETURN CHAR IN ACC
; 
GCI:	LD	HL,(TXA)
GCI0:	LD	A,(HL)
	INC	HL
	CP	' '
	JP	Z,GCI0
	LD	(TXA),HL
	RET
; 
; REPEAT ADD
; ADDS DE TO HL C TIMES
; 
RADD:	ADD	HL,DE
	DEC	C
	JP	NZ,RADD
	RET
; 
; PRINT MESSAGE ADDRESSED BY HL
; ENDS WITH CHARACTER PROVIDED IN C
; RETURN IN HL ADDRESS OF TERMINATOR
; 
PRNTCR: LD	C,CR
	JP	PRN1
PRNT:	LD	C,'"'
PRN1:	LD	A,(HL)		;GET NEXT CHAR
	LD	B,A		;FOR CHOUT
	CP	C		;END OF MESSAGE TEST
	RET	Z
	CP	CR
	JP	Z,E1		;NEVER PRINT A CR IN THIS ROUTINE
	CALL	CHOUT
	INC	HL
	JP	PRN1
; 
; 16 BIT UNSIGNED COMPARE
; COMPARE DE AGAINST VALUE ADDRESSED BY HL
; CLOBBERS A ONLY
; 
DCMP:	LD	A,E
	SUB	(HL)
	INC	HL
	LD	A,D
	SBC	A,(HL)
	DEC	HL
	RET	NZ
	LD	A,E
	SUB	(HL)
	OR	A		;CLEAR CARRY
	RET
; 
; INDIRECT LOAD HL THRU HL
; 
LHLI:	PUSH	AF
	LD	A,(HL)
	INC	HL
	LD	H,(HL)
	LD	L,A
	POP	AF
	RET
; 
; GET FP CONSTANT FROM TEXT
; PUSHES VALUE ON ARG STACK AND SETS ARGF FLAG
; SETS CARRY IF NOT FOUND
; 
CONST:	LD	HL,(TXA)	;PREPARE CALL FPIN
	EX	DE,HL
	LD	HL,FPSINK
	CALL	FPIN
	RET	C
	DEC	DE
	EX	DE,HL
	LD	(TXA),HL	;NOW POINTS TO TERMINATOR
	LD	DE,FPSINK
	CALL	PSHA1
	XOR	A
	INC	A		;SET A TO 1 AND CLEAR CARRY
	LD	(ARGF),A
	RET
; 
; DIRECT STATEMENT CHECKING ROUTINE
; 
DIRT:	LD	A,(DIRF)
	OR	A
	RET	Z
	LD	BC,'DI'
	JP	ERROR
; 
; FIND TEXT LINE WITH LINE NUMBER GIVEN IN DE
; RETURNS TEXT ADDRESS COUNT BYTE IN HL
; 
FINDLN:	LD	HL,(BOFA)
	LD	B,0
FIND1:	LD	C,(HL)
	LD	A,C
	CP	EOF
	JP	Z,LERR
	INC	HL
	CALL	DCMP
	DEC	HL
	RET	Z
	ADD	HL,BC
	JP	FIND1
LERR:	LD	BC,'LN'
	JP	ERROR
; 
; FIX FLOATING TO POSITIVE INTEGER
; RETURN INTEGER VALUE IN DE
; FP VALUE FROM TOP OF ARG STACK, POP ARG STACK
; 
PFIX:	LD	HL,(ASTKA)
	LD	B,H
	LD	C,L
	PUSH	HL
	CALL	AINT
	LD	HL,FPSINK
	CALL	POPAS
	POP	HL
	LD	C,(HL)		;EXPONENT
	DEC	HL
	LD	A,(HL)		;SIGN
	OR	A
	JP	NZ,E5		;NEGATIVE NO GOOD
	LD	DE,-FPSIZ+1
	ADD	HL,DE
	LD	DE,0
	LD	A,C
	OR	A
	RET	Z
	DEC	C		;SET UP FOR LOOP CLOSE TEST
PFIX1:	INC	HL
	LD	A,(HL)
	RRCA
	RRCA
	RRCA
	RRCA
	CALL	MUL10
	JP	C,E5
	DEC	C
	RET	P
	LD	A,(HL)
	CALL	MUL10
	JP	C,E5
	DEC	C
	JP	M,PFIX1
	RET
; 
; TAKE NEXT DIGIT IN A (MASK TO 17Q), ACCUMULATE TO DE
; PRESERVES ALL BUT A, DE
; 
MUL10:	PUSH	HL
	INC	SP
	INC	SP
	LD	H,D		;GET ORIGINAL VALUE TO HL
	LD	L,E
	ADD	HL,HL		;DOUBLE IT
	RET	C
	ADD	HL,HL		;AGAIN
	RET	C
	ADD	HL,DE		;PLUS ORIGINAL MAKES 5 TIMES ORIG
	RET	C
	ADD	HL,HL		;TIMES TWO MAKES TEN
	RET	C
	EX	DE,HL
	DEC	SP
	DEC	SP
	POP	HL
	AND	17Q
	ADD	A,E
	LD	E,A
	LD	A,D
	ADC	A,0		;PROPAGATE THE CARRY
	LD	D,A
	RET
; 
; GET INTEGER FROM TEXT
; SET CARRY IF NOT FOUND
; RETURN INTEGER VALUE IN HL
; RETURN TERMINATOR IN ACC
; 
INTGER: CALL	DIG
	RET	C
	LD	DE,0
	JP	INTG2
INTG1:	CALL	DIG
	LD	H,D
	LD	L,E
	CCF
	RET	NC
INTG2:	SUB	'0'
	CALL	MUL10
	JP	NC,INTG1
	RET
; 
; CONVERT INTEGER TO STRING
; DE CONTAINS ADDRESS OF STRING, RETURN UPDATED VALUE IN DE
; HL CONTAINS VALUE TO CONVERT
; 
CNS:	XOR	A		;SET FOR NO LEADING ZEROES
	LD	BC,-10000
	CALL	RSUB
	LD	BC,-1000
	CALL	RSUB
	LD	BC,-100
	CALL	RSUB
	LD	BC,-10
	CALL	RSUB
	LD	BC,-1
	CALL	RSUB
	RET	NZ
	LD	A,'0'
	LD	(DE),A
	INC	DE
	RET
; 
; TAKE VALUE IN HL
; SUB MINUS NUMBER IN BC THE MOST POSSIBLE TIMES
; PUT VALUE ON STRING AT DE
; IF A=0 THEN DON'T PUT ZERO ON STRING
; RETURN NON-ZERO IN A IF PUT ON STRING
; 
RSUB:	PUSH	DE
	LD	D,-1
RSUB1:	PUSH	HL
	INC	SP
	INC	SP
	INC	D
	ADD	HL,BC
	JP	C,RSUB1
	DEC	SP
	DEC	SP
	POP	HL
	LD	B,D
	POP	DE
	OR	B		;A GETS 0 IF A WAS 0 AND B IS 0
	RET	Z
	LD	A,'0'
	ADD	A,B
	LD	(DE),A
	INC	DE
	RET
; 
;	INPUT CHARACTER FROM TERMINAL
;	FORCE TO UPPER CASE.
; 
INCHAR:	PUSH	BC			;SAVE ALL THE REGISTERS
	PUSH	DE			;THAT MIGHT GET WALKED OVER
	PUSH	HL			;BY CP/M
	LD	C,CONIN			;LOAD UP FUNCTION CODE AND
	CALL	BDOS			;CALL THE SYSTEM.
	AND	07FH			;MASK OFF PARITY BIT.
	CP	'a'			;CHECK IF LOWER CASE
	JP	C,INCH1			;TOO LOW
	CP	'z'+1			;CHECK IF LOWER CASE
	JP	NC,INCH1		;TOO HIGH
	SUB	20H			;FORCE TO UPPER CASE
INCH1:	POP	HL			;RESTORE THE REGISTERS
	POP	DE			;THAT GOT PUSHED
	POP	BC			;GOING IN.
	LD	B,A			;COPY CHARACTER TO B AND
	RET				;RETURN.
; 
INL0:	CALL	CRLF
INLINE: LD	HL,IBUF
	LD	C,LINLEN
INL1:	CALL	INCHAR
	CP	7FH			;DELETE ?
	JP	Z,INL2
	CP	15H			;CONTROL U ?
	JP	Z,INL0
	LD	(HL),A
	LD	B,LF			;IN CASE ALL DONE.
	CP	CR
	JP	Z,CHOUT			;ECHO LF AND RETURN.
	INC	HL
	DEC	C
	JP	NZ,INL1
	LD	BC,'LL'
	JP	ERROR
INL2:	LD	A,C
	LD	B,BELL
	CP	LINLEN
	JP	Z,INL3
	DEC	HL
	LD	B,(HL)			;ECHO DELETED CHARACTER.
	INC	C
INL3:	CALL	CHOUT
	JP	INL1
; 
;	TEST CONSOLE STATUS
;
STATUS:	PUSH	BC			;SAVE ALL THE
	PUSH	DE			;REGISTERS USED BY
	PUSH	HL			;CP/M.
	LD	C,CONSTS		;FIRE OFF THE
	CALL	BDOS			;CONSOLE STATUS CALL.
	POP	HL			;RESTORE
	POP	DE			;ALL
	POP	BC			;REGISTERS.
	AND	01H			;SET FLAGS ON THE STATUS.
	RET				;RETURN
; 
;       OUTPUT ROUTINES
; 
CHOUT:	PUSH	BC			;PUSH THE REGISTERS
	PUSH	DE			;THAT GET WALKED OVER BY
	PUSH	HL			;OUR PAL CP/M.
	LD	C,CONOUT		;LOAD UP THE SYSTEM FUNCTION
	LD	E,B			;CODE, THEN CALL
	CALL	BDOS			;THE SYSTEM TO WRITE IT.
	POP	HL			;RESTORE
	POP	DE			;ALL THE REGISTERS
	POP	BC			;WE SAVED.
	LD	A,B			;GET A COPY OF THE CHARACTER.
;
CHCHK:	CP	CR
	JP	NZ,CHLF		;NOT CR, IS IT LF?
	XOR	A
	JP	PSTOR		;RETURN PHEAD TO ZERO
; 
CHLF:	CP	LF	
	JP	Z,NULCH		;IF LINE FEED PROCESS THE NULLS
	CP	40Q		;NO PHEAD INCREMENT IF CONTROL CHAR
	RET	C
	LD	A,(PHEAD)
	INC	A
PSTOR:	LD	(PHEAD),A
	RET
; 
NULCH:	LD	A,(NULLCT)	;OUTPUT NULL CHARS
	OR	A
	RET	Z
	PUSH	BC
	LD	C,A
	LD	B,NULL
CH2:	CALL	CHOUT		;OUTPUT COUNT "C" NULLS
	DEC	C
	JP	NZ,CH2
	POP	BC
	RET
; 
CRLF2:	CALL	CRLF
CRLF:	LD	B,CR
	CALL	CHOUT
	LD	B,LF
	JP	CHOUT
; 
; CHECK IF PANIC CHARACTER HAS BEEN HIT
; 
;PCHECK:LD	A,(BRKCHR)
;	OR	A
;	CALL	Z,STATUS
;	RET	Z
PCHECK:	CALL	STATUS			;ANYTHING TYPED
	RET	Z			;RET IF NO.
	CALL	INCHAR			;READ THE CHARACTER IN.
	CP	ESC
	JP	Z,STOP1
;	LD	(BRKCHR),A
	RET
; 
; GET INTEGER FROM TERMINAL
; DE CONTAINS STRING TO PRINT FIRST
; HL HAS 1 LESS THAN ACCEPTABLE LOWER BOUND
; THIS ROUTINE GOES TO START IF BAD NUMBER
; INTEGER VALUE RETURNED IN HL
; 
GINT:	PUSH	HL
	EX	DE,HL
	LD	A,(PHEAD)
	OR	A
	CALL	NZ,CRLF
	CALL	PRNT
	CALL	INLINE
	LD	HL,IBUF
	LD	(TXA),HL
	CALL	INTGER
	JP	C,START
	CP	CR
	JP	NZ,START
	POP	DE
	LD	(IBUF),HL	;USE IBUF AS A TEMP
	LD	HL,IBUF
	CALL	DCMP
	JP	NC,START
	LD	HL,(IBUF)	;GET THE VALUE BACK TO HL
	LD	A,(HL)
	CPL
	LD	(HL),A		;TRY TO STORE THERE
	CP	(HL)
	JP	NZ,START		;BAD OR MISSING MEMORY
	CPL
	LD	(HL),A		;PUT IT BACK LIKE IT WAS
	RET
; 
; OUTPUT FP NUMBER ADDRESSED BY HL
; 
FPOUT:	LD	BC,-DIGIT-1
	ADD	HL,BC
	LD	B,H
	LD	C,L
	LD	HL,ABUF		;OUTPUT BUFFER
	LD	A,(INFES)	;OUTPUT FORMAT
	LD	(FES),A	;STORE IT
	LD	E,DIGIT
	LD	(HL),0		;CLEAR ROUND-OFF OVERFLOW BUFFER
	INC	HL		;ABUF+1
; 
NXT:	LD	A,(BC)		;GET DIGIT AND UNPACK
	LD	D,A
	RRA	
	RRA
	RRA
	RRA
	AND	17Q		;REMOVE BOTTOM DIGIT
	LD	(HL),A		;STORE TOP DIGIT IN OUTPUT BUFFER (ABUF)
	INC	HL
	LD	A,D		;NOW GET BOTTOM DIGIT
	AND	17Q
	LD	(HL),A		;STORE IT
	INC	HL
	INC	BC
	DEC	E
	JP	NZ,NXT
	LD	A,(BC)
	LD	(FSIGN),A	;STORE SIGN OF NUMBER
	XOR	A
	LD	(HL),A		;CLEAR ROUND-OFF BUFFER (ABUF+13) 12 DIGIT NO ROUND
	LD	HL,XSIGN		;EXPONENT SIGN STORE
	LD	(HL),A		;CLEAR XSIGN
; 
FIX:	INC	BC		;GET EXPONENT
	LD	A,(BC)
	OR	A		;EXPONENT ZERO?
	JP	Z,ZERO
	SUB	128		;REMOVE EXPONENT BIAS
	JP	NZ,FIX2
	INC	(HL)		;INCREMENT XSIGN TO NEGATIVE FLAG(1) LATER ZERO
FIX2:	JP	P,CHK13
	CPL		;IT'S A NEGATIVE EXPONENT
	INC	(HL)		;INCREMENT XSIGN TO NEGATIVE (1)
ZRO:	INC	A
CHK13:	LD	HL,EXPO		;EXPONENT TEMP STORE
	LD	(HL),A
	LD	E,A
	CP	DIGIT*2
	LD	HL,FES		;FORMAT TEMP BYTE
	JP	C,CHKXO
CHK40:	LD	A,1		;FORCE EXPONENTIAL PRINTOUT
	OR	(HL)		;SET FORMAT FOR XOUT
	LD	(HL),A
; 
CHKXO:	LD	A,(HL)		;CHECK IF EXPONENTIAL FORMAT
	RRA
	JP	NC,CHKX3
	AND	17Q
	CP	DIGIT*2
	JP	C,CHKX2
	LD	A,DIGIT*2-1		;MAX DIGITS
CHKX2:	LD	D,A
	INC	A
	JP	ROUND
; 
CHKX3:	AND	17Q		;ADD EXPONENT AND DECIMAL PLACES
	LD	D,A
	ADD	A,E
	CP	DIGIT*2+1
	LD	B,A
	JP	C,CHKXN
	LD	A,(HL)
	AND	100Q
	JP	NZ,CHK40
; 
CHKXN:	LD	A,(XSIGN)	;CHECK EXPONENT SIGN
	OR	A
	JP	NZ,XNEG		;IT'S NEGATIVE
	LD	A,B
	JP	ROUND
; 
XNEG:	LD	A,D		;SUBTRACT EXPONENT AND DECIMAL PLACE COUNT
	SUB	E
	JP	NC,XN2
XN1:	LD	A,(INFES)
	OR	A
	JP	P,ZERO
	AND	16Q
	JP	Z,ZERO
	RRCA
	LD	E,A
	DEC	E
	LD	C,1
	LD	HL,ABUF-1
	JP	NRND
XN2:	JP	Z,XN1
	JP	ROUND
; 
CLEAN:	LD	B,37Q		;CLEAR FLAGS
	AND	B
	CP	DIGIT*2+1
	RET	C
	LD	A,DIGIT*2+1		;MAX DIGITS OUT
	RET
; 
; THIS ROUTINE IS USED TO ROUND DATA TO THE 
; SPECIFIED DECIMAL PLACE
; 
ROUND:	CALL	CLEAN
	LD	C,A
	LD	B,0
	LD	HL,ABUF+1
	ADD	HL,BC		;GET ROUND-OFF ADDRESS
	LD	(ADDT),HL
	LD	A,(HL)
	CP	5		;ROUND IF >=5
	JP	C,TRL2-1
; 
LESS1:	DEC	HL
	INC	(HL)		;ROUND UP
	LD	A,(HL)
	OR	A
	JP	Z,TRL2
	CP	10		;CHECK IF ROUNDED NUMBER >9
	JP	NZ,TRAIL
	LD	(HL),0
	JP	LESS1
; 
; THIS ROUTINE IS USED TO ELIMINATE TRAILING ZEROES
; 
TRAIL:	LD	HL,(ADDT)
	DEC	HL
TRL2:	LD	A,(FES)	;CHECK IF TRAILING ZEROES ARE WANTED
	RLA
	JP	C,FPRNT		;YES- GO PRINT DATA
TRL3:	LD	A,(HL)	
	OR	A		;IS IT A ZERO?
	JP	NZ,FPRNT		;NO - GO PRINT
	DEC	HL
	DEC	C		;YES - FIX OUTPUT DIGIT COUNT
	JP	M,ZERO
	JP	TRL3
; 
; HERE START THE PRINT FORMAT ROUTINES
; 
FPRNT:	LD	HL,ABUF
	LD	A,(HL)		;CHECK IF ROUNDED UP TO 1
	OR	A
	JP	Z,NRND		;JUMP IF NOT
	LD	B,1
	LD	A,(XSIGN)	;IS EXPONENT NEGATIVE?
	OR	A
	JP	Z,POSR
	LD	B,-1
; 
POSR:	LD	A,(EXPO)	;GET EXPONENT
	OR	A
	JP	NZ,PO2		;IS IT ZERO (E + 0)
	LD	(XSIGN),A
	LD	B,1
PO2:	ADD	A,B		;FIX EXPONENT COUNT
	LD	(EXPO),A
	INC	E
	INC	C
	DEC	HL
; 
NRND:	INC	HL
	LD	A,C
	CP	DIGIT*2+1		;CHECK FOR MAXIMUL DIGITS OUT
	JP	NZ,NRND1
	DEC	C
NRND1:	LD	A,(FSIGN)	;CHECK IN NEGATIVE NUMBER
	RRA
	JP	NC,PRI22		;GO OUTPUT RADIX AND NUMBER
	CALL	NEG		;OUTPUT (-)
	JP	PRI21
; 
PRI22:	CALL	SPACE		;OUTPUT A SPACE
PRI21:	LD	A,(FES)	;GET OUTPUT FORMAT
	RRA		;CHECK IF EXPONENTIAL FORMAT
	JP	C,XPRIN
	LD	A,(XSIGN)	;GET EXPONENT SIGN
	OR	A		;CHECK IF NEGATIVE EXPONENT
	JP	Z,POSIT
	LD	A,C
	OR	A
	JP	NZ,PRIN4		;OUTPUT RADIX AND NUMBER
	CALL	ZERO		;NO DIGITS AFTER RADIX, OUTPUT ZERO AND DONE
	RET		;****** CALL, RET????!!!********
; 
PRIN4:	CALL	RADIX		;PRINT DECIMAL POINT
	XOR	A
	OR	E
	JP	Z,PRIN5		;JUMP IF NO ZEROES TO PRINT
	CALL	ZERO		;FORCE PRINT A ZERO
	DEC	E
	JP	NZ,PRIN4+3
; 
PRIN5:	CALL	NOUT		;PRINT ASCII DIGIT
	JP	NZ,PRIN5
	RET
; 
POSIT:	CALL	NOUT
	DEC	E		;BUMP EXPONENT COUNT
	JP	NZ,POSIT
	LD	A,C		;CHECK IF MORE DIGITS TO OUTPUT
	OR	A
	RET	Z	;NO, DONE
	RET	M
	JP	PRIN4		;NOW PRINT DECIMAL POINT
; 
; GET HERE FOR EXPONENTIAL OUTPUT FORMAT
; 
XPRIN:	CALL	NOUT
	JP	Z,NDEC		;INTEGER?
	CALL	RADIX		;NO....PRINT DECIMAL POINT
XPRI2:	CALL	NOUT
	JP	NZ,XPRI2
; 
NDEC:	LD	B,'E'		;OUTPUT 'E'
	CALL	CHOUT
	LD	A,(XSIGN)
	OR	A
	JP	Z,XPRI3
	CALL	NEG		;PRINT EXPONENT SIGN (-)
	LD	A,(EXPO)
	INC	A
	JP	XOUT2
XPRI3:	LD	B,'+'		;EXPONENT (+)
	CALL	CHOUT
; 
; THIS ROUTINE IS USED TO CONVERT THE EXPONENT
; FROM BINARY TO ASCII AND PRINT THE RESULT
; 
XOUT:	LD	A,(EXPO)
	DEC	A
XOUT2:	LD	C,100
	LD	D,0
	CALL	CONV
	CP	'0'		;SKIP LEADING ZEROES
	JP	Z,XO21
	INC	D
	CALL	CHOUT
XO21:	LD	A,E
	LD	C,10
	CALL	CONV
	CP	'0'
	JP	NZ,XO3
	DEC	D
	JP	NZ,XO4
XO3:	CALL	CHOUT
XO4:	LD	A,E
	ADD	A,'0'		;ADD ASCII BIAS
	LD	B,A
	CALL	CHOUT
	RET		;****** CALL, RET?????!!!!!*****
CONV:	LD	B,'0'-1
	INC	B
	SUB	C
	JP	NC,CONV+2
	ADD	A,C
	LD	E,A
	LD	A,B
	RET
; 
; THIS ROUTINE ADD ASCII BIAS TO A BCD DIGIT
; AND CALLS THE OUTPUT ROUTINE
; 
NOUT:	LD	A,(HL)
	ADD	A,'0'
	LD	B,A
	CALL	CHOUT
	INC	HL
	DEC	C		;DECREMENT TOTAL DIGITS OUT COUNT
	RET
; 
; COMMON SYMBOL LOADING ROUTINES
; 
NEG:	LD	B,'-'
	JP	CHOUT
ZERO:	LD	B,'0'
	JP	CHOUT
SPACE:	LD	B,' '
	JP	CHOUT
RADIX:	LD	B,'.'
	JP	CHOUT
; 
; CONVERTS FP STRING AT DE, UPDATE DE PAST TERMINATOR
; PUTS TERMINATOR IN B, PUTS FP NUMBER AT ADDRESS IN HL
; SETS CARRY IF NOT FOUND
; 
FPIN:	PUSH	HL
	PUSH	DE
	EX	DE,HL
	DEC	HL
	LD	(ADDS),HL
	LD	HL,OPST		;CLEAR TEMPORARY STORAGE AREAS AND BC BUFFER
	LD	C,DIGIT+6
	CALL	CLEAR
; 
SCANC:	LD	DE,0
	LD	HL,BCX		;BC=PACK BUFFER
SCAN0:	LD	(BCADD),HL	;PACK BUFFER POINTER
SCANP:	LD	HL,SCANP
	PUSH	HL		;USED FOR RETURN FROM OTHER ROUTINES
	XOR	A
	LD	(XSIGN),A	;CLEAR EXPONENT SIGN BYTE
; 
SCANG:	CALL	IBSCN
	JP	C,SCANX		;FOUND A NUMBER, GO PACK IT
	CP	'.'		;RADIX?
	JP	Z,SCAN5		;PROCESS RADIX POINTERS
	CP	'E'		;EXPONENT?
	JP	Z,EXCON		;FOUND 'E', GO PROCESS EXPONENT
; NOT A CHARACTER LEGAL IN NUMBER
	LD	B,A		;MOVE TERMINATOR TO B
	LD	A,(OPST)	;CHECK IF ANY DIGITS YET
	AND	20Q
	JP	NZ,ENTR2
; GET HERE IF LEGAL FP NUMBER NOT FOUND
FPIN1:	POP	HL		;SCANP LINK
	POP	DE		;TEXT POINTER
	POP	HL		;FP # ADDR
	SCF
	RET
; FOUND DECIMAL POINT
SCAN5:	XOR	A		;FOUND RADIX PROCESS RADIX POINTERS FOR EXP
	OR	D		;ANY DIGITS YET?
	JP	NZ,SCAN6
	ADD	A,300Q		;SET ECNT - STOP COUNTING DIGITS
	OR	E		;NO INT DIGITS, BIT 7 IS COUNT/DON'T COUNT FLAG
	LD	E,A		;BIT 6 IS NEGATIVE EXPONENT FLAG
	RET
SCAN6:	LD	A,200Q		;SET ECNT TO COUNT DIGITS
	OR	E
	LD	E,A
	RET
; 
SCANX:	AND	17Q		;FOUND NUMBER-REMOVE ASCII BIAS
	LD	B,A
	LD	HL,OPST		;SET FIRST CHARACTER FLAG
	LD	A,60Q
	OR	(HL)
	LD	(HL),A
	XOR	A
	OR	B		;IS CHARACTER ZERO?
	JP	NZ,PACK
	OR	D		;LEADING ZERO? IE. ANY INT DIGITS?
	JP	NZ,PACK
	OR	E
	LD	E,A
	RET	Z	;IF COUNTING YET
	INC	E		;ECNT+1-COUNT ZEROS FOR EXPONENT COUNT
	RET
; 
; THIS SUBROUTINE BCD PACKS DIGITS INTO REG BC
; 
PACK:	LD	A,E
	RLA
	JP	C,PACK1
	INC	E
PACK1:	LD	A,E
	LD	(ECNT),A	;DIGIT COUNT FOR EXPONENT COUNT
	INC	D		;TOTAL DIGIT COUNT (D ALSO HAS TOP/BOTM FLAG BIT 7)
	LD	A,D
	AND	177Q		;REMOVE TOP/BOTM FLAG
	CP	DIGIT*2+1		;LIMIT INPUT DIGITS
	RET	NC
	XOR	A
	OR	D
	JP	M,BOTM
; 
TOP:	OR	200Q		;SET MSB FOR TOP FLAG
	LD	D,A
	LD	A,B
	LD	HL,(BCADD)	;GET BC ADDRESS
	RLCA
	RLCA
	RLCA
	RLCA
	LD	(HL),A		;SAVE CHAR IN BC
	RET
; 
BOTM:	AND	177Q		;STRIP MSB (BOTTOM FLAG)
	LD	D,A
	LD	A,B
	LD	HL,(BCADD)
	OR	(HL)		;OR IN TOP NUMBER
	LD	(HL),A		;PUT NUMBER BACK IN BC
	INC	HL
	POP	BC
	JP	SCAN0
IBSCN:	LD	HL,(ADDS)	;INPUT BUFFER POINTER
	INC	HL		;GET NEXT BYTE
	LD	A,(HL)
	CP	' '
	JP	Z,IBSCN+3
	LD	(ADDS),HL	;NOTE: THIS ROUTINE FALLS THROUGH
; THIS ROUTINE CHECKS FOR ASCII NUMBERS
NMCHK:	CP	'9'+1
	RET	NC
	CP	'0'
	CCF
	RET
; 
; THIS ROUTINE IS USED TO ADJUST A NUMBER IN BC BUFFER
; AND RETURNS VALUE
; 
ENTR2:	LD	DE,0
ENT1:	PUSH	BC		;TERMINATOR
	CALL	FIXE		;NORMALIZE FLOATING POINT NUMBER
	POP	BC		;TERMINATOR
	POP	DE		;SCANP LINK
	POP	DE		;OLD TEXT ADDR
	POP	DE		;RETURN ADDR
	LD	C,DIGIT+2
	LD	HL,BCX+DIGIT+1
	CALL	VCOPY
	LD	HL,(ADDS)
	EX	DE,HL
	INC	DE
	OR	A
	RET
; 
; THIS ROUTINE IS USED TO CLEAR STORAGE AREAS
; THE STARTING ADDRESS IS IN HL AND THE COUNT
; IS IN C
; 
CLEAR:	XOR	A
	LD	(HL),A
	INC	HL
	DEC	C
	JP	NZ,CLEAR+1
	RET
; 
; THIS ROUTINE CONVERTS THE ASCII EXPONENT OF
; THE NUMBER IN THE INPUT BUFFER TO BINARY, AND
; NORMALIZES THE EXPONENT ACCORDING TO THE INPUT
; FORMAT OF THE NUMBER
; 
EXCON:	CALL	IBSCN		;GET CHARACTER
	JP	C,EXC3
	CP	PLSRW		;CHECK FOR UNARY SIGNS
	JP	Z,EXC4
	CP	'+'
	JP	Z,EXC4
	CP	'-'
	JP	Z,EXC2
	CP	MINRW
	JP	NZ,FPERR		;NO SIGN OR NUMBER?
EXC2:	LD	A,1
	LD	(XSIGN),A	;SAVE SIGN
EXC4:	CALL	IBSCN
	JP	NC,FPERR		;NO NUMBER?
EXC3:	CALL	ASCDC		;CONVERT ASCII TO BINARY
	JP	ENT1		;NORMALIZE NUMBER AND RETURN
; 
; THIS ROUTINE CONVERTS ASCII TO BINARY
; THREE CONSECUTIVE NUMBERS < 128 MAY BE CONVERTED
; 
ASCDC:	EX	DE,HL
	LD	HL,0
ASC1:	LD	A,(DE)		;GET CHR FROM INPUT BUFFER-NO SPACES ALLOWED
	CALL	NMCHK		;CHECK IF NUMBER
	JP	NC,ASC2
	SUB	'0'		;REMOVE ASCII BIAS
	LD	B,H
	LD	C,L
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,BC
	ADD	HL,HL
	LD	C,A
	LD	B,0
	ADD	HL,BC
	INC	DE
	JP	ASC1
ASC2:	EX	DE,HL
	LD	B,A		;SAVE TERMINATOR
	LD	(ADDS),HL	;SAVE IBUF ADDRESS
	LD	A,D
	OR	A
	JP	NZ,FPERR		;TOO BIG >255
	LD	A,E
	RLA
	JP	C,FPERR		;TOO BIG >127
	RRA
	RET
FPERR:	POP	BC		;ASCDC RET LINK
	JP	FPIN1
; 
; THIS ROUTINE NORMALIZES THE INPUT NUMBER
; 
FIXE:	EX	DE,HL
	LD	A,(BCX)
	OR	A		;IS IT ZERO?
	JP	Z,ZZ2
	CALL	CHKPN		;SET EXPONENT POSITIVE/NEGATIVE
	ADD	A,200Q		;ADD EXPONENT BIAS
ZZ2:	LD	(BCX+DIGIT+1),A	;STORE NORMALIZED EXPONENT IN BC
	RET
; 
CHKPN:	LD	A,(ECNT)	;GET EXPONENT COUNT-SET IN 'SCAN' ROUTINE
	LD	E,A
	AND	77Q		;STRIP BITS 7&8
	LD	B,A
	LD	A,(XSIGN)
	OR	A
	JP	Z,LPOS		;EXPONENT IS POSITIVE
	INC	H		;SET SIGN IN H ** THIS SHOULD BE INR H NOT INX H
	LD	A,100Q		;L IS NEGATIVE
	AND	E		;CHECK IF E IS NEGATIVE
	JP	Z,EPOS
	LD	A,L		;BOTH E & L NEGATIVE
	LD	L,B
	CALL	BPOS+1
	CPL
	INC	A
	RET		;BACK TO FIXE
; 
EPOS:	LD	A,L		;E&L NEGATIVE
	CPL
	INC	A		;TWO'S COMP A
	ADD	A,B
	RET		;TO FIXE
; 
LPOS:	LD	A,100Q		;EXPONENT POSITIVE
	AND	E		;IS E NEGATIVE?
	JP	Z,BPOS
	LD	A,B
	LD	B,L
	JP	EPOS+1
; 
BPOS:	LD	A,B		;E&L POSITIVE
	ADD	A,L
	RET	P
; 
	POP	HL
	JP	FPERR
	DEFB	10H
	DEFW	0
	DEFB	1
FPNONE: DEFB	129
; 
; FLOATING POINT MATH PACKAGE
; 
; EACH FUNCTION OPERATES AS FOLLOWS:  (BC) = (DE) # (HL)
;     WHERE  BC IS ADDRESS OF RESULT
;            DE IS ADDRESS OF 1ST ARGUMENT
;            HL IS ADDRESS OF 2ND ARGUMENT
;     AND # IS ONE OF THE OPERATORS  +,-,*,/
; 
; ON ENTRY ALL ADDRESS POINT TO THE EXPONENT PART OF THE
;     FLOATING POINT ARGUMENT
; 
; THE NUMBER ZERO IS REPRESENTED BY A ZERO EXPONENT
; 
; ALL NUMBERS ARE ASSUMED TO BE NORMALIZED
; 
FADD:	PUSH	BC
	CALL	EXPCK		;FETCH ARGUMENTS
	LD	C,0
ADSUM:	DEC	DE
	EX	DE,HL
	LD	A,(SIGN)
	XOR	(HL)		;FORM SIGN OF RESULT
	LD	B,A
	EX	DE,HL
	LD	A,(DE)
	DEC	DE
	XOR	C
	LD	(SIGN),A
	LD	HL,RCTRL		;ROUNDING CONTOL FLAG
	LD	A,(HL)
	OR	A
	INC	HL
	LD	A,(HL)		;GET ROUNDING DIGIT
	JP	Z,ADS8
	RLCA
	RLCA
	RLCA
	RLCA
ADS8:	ADD	A,0B0H		;FORCE CARRY IF DIGIT > 5
	LD	A,B
	RRA	
	JP	C,ADS1		;HAVE SUBTRACTION
	RLA		;RESTORE CARRY
	CALL	ADDX		;PERFORM ADDITION
	JP	NC,ADS2
	LD	B,4
	CALL	RIGHT
	LD	HL,EXP
	INC	(HL)		;INCREMENT EXPONENT
	JP	Z,OVER
ADS2:	POP	BC		;GET RESULTS ADDRESS
	CALL	STORE		;SAVE RESULTS
	RET		;******* CALL, RET????!!!!********
ZEREX:	POP	HL
	JP	ADS2
ADDX:	LD	HL,BUF+DIGIT-1
	LD	B,DIGIT
ADD1:	LD	A,(DE)
	ADC	A,(HL)
	DAA
	LD	(HL),A
	DEC	HL
	DEC	DE
	DEC	B
	JP	NZ,ADD1
	RET	NC
	INC	(HL)
	RET
; 
; FLOATING POINT SUBTRACTION
; 
FSUB:	PUSH	BC
	CALL	EXPCK		;GET ARGUMENTS 
	LD	A,(SIGN)
	XOR	1		;COMPLEMENT SIGN
	LD	(SIGN),A
	JP	ADSUM
ADS1:	RLA		;RESTORE CARRY
	CCF		;COMPLEMENT FOR ROUNDING
	CALL	SUBX		;SUBTRACT ARGUMENTS
	LD	HL,SIGN
	JP	C,ADS4
	LD	A,(HL)		;GET SIGN
	XOR	1		;COMPLEMENT
	LD	(HL),A
ADS7:	DEC	HL
	LD	B,DIGIT
ADS3:	LD	A,9AH
	SBC	A,(HL)		;COMPLEMENT RESULT
	ADD	A,0
	DAA
	LD	(HL),A
	DEC	HL
	DEC	B
	CCF
	JP	NZ,ADS3
ADS4:	LD	HL,BUF
	LD	BC,DIGIT
ADS5:	LD	A,(HL)
	OR	A
	JP	NZ,ADS6
	INC	HL
	INC	B
	INC	B
	DEC	C
	JP	NZ,ADS5
	XOR	A		;********* NOT NEEDED
	LD	(EXP),A
	JP	ADS2
ADS6:	CP	10H
	JP	NC,ADS9
	INC	B
ADS9:	LD	HL,EXP
	LD	A,(HL)
	SUB	B
	JP	Z,UNDER
	JP	C,UNDER
	LD	(HL),A
	LD	A,B
	RLCA
	RLCA
	LD	B,A
	CALL	LEFT
	JP	ADS2
SUBX:	LD	HL,BUF+DIGIT-1
	LD	B,DIGIT
SUB1:	LD	A,99H
	ADC	A,0
	SUB	(HL)
	EX	DE,HL
	ADD	A,(HL)
	DAA
	EX	DE,HL
	LD	(HL),A
	DEC	HL
	DEC	DE
	DEC	B
	JP	NZ,SUB1
	RET
; 
; FLOATING POINT MULTIPLY
; 
FMUL:	PUSH	BC
	LD	A,(HL)
	OR	A		;ARGUMENT = 0?
	JP	Z,FMUL1+2
	LD	A,(DE)	
	OR	A		;ARGUMENT =0?
	JP	Z,FMUL1+2
	ADD	A,(HL)		;FORM RESULT EXPONENT
	JP	C,FMOVR
	JP	P,UNDER
	JP	FMUL1
FMOVR:	JP	M,OVER
FMUL1:	SUB	128		;REMOVE EXCESS BIAS
	LD	(EXP),A	;SAVE EXPONENT
	DEC	DE
	DEC	HL
	LD	A,(DE)
	XOR	(HL)		;FORM RESULT SIGN
	DEC	HL
	DEC	DE
	PUSH	HL
	LD	HL,SIGN		;GET SIGN ADDRESS
	LD	(HL),A		;SAVE SIGN
	DEC	HL
	XOR	A
	LD	B,DIGIT+2
FMUL2:	LD	(HL),A		;ZERO WORKING BUFFER
	DEC	HL
	DEC	B
	JP	NZ,FMUL2
	LD	A,(EXP)
	OR	A
	JP	Z,ZEREX
	LD	C,DIGIT
	LD	HL,HOLD1+DIGIT
; GET MULTIPLIER INTO HOLDING REGISTER
FMUL3:	LD	A,(DE)
	LD	(HL),A		;PUT IN REGISTER
	DEC	HL
	DEC	DE
	DEC	C
	JP	NZ,FMUL3
	LD	(HL),C
	DEC	HL
	LD	B,250		;SET LOOP COUNT
FMUL4:	LD	DE,DIGIT+1
	LD	C,E
	ADD	HL,DE
	EX	DE,HL
	ADD	HL,DE		;H,L=NEXT HOLDING REGISTER
	INC	B
	JP	P,FMUL8		;FINISHED
FMUL5:	LD	A,(DE)		;GET DIGITS
	ADC	A,A		;TIMES 2
	DAA
	LD	(HL),A		;PUT IN HOLDING REGISTER
	DEC	DE
	DEC	HL
	DEC	C
	JP	NZ,FMUL5
	INC	B		;INCREMENT LOOP COUNT
	JP	NZ,FMUL4
; 
; FORM 10X BY ADDING 8X AND 2X
; FIRST GET 8X
	INC	HL
	LD	DE,HOLD5		;NEXT HOLDING REGISTER
	LD	C,DIGIT+1
	LD	B,C
FMUL6:	LD	A,(HL)
	LD	(DE),A
	INC	HL
	INC	DE
	DEC	C
	JP	NZ,FMUL6
	LD	HL,HOLD2+DIGIT		;GET 2X
	DEC	DE
FMUL7:	LD	A,(DE)
	ADC	A,(HL)		;FORM 10X
	DAA
	LD	(DE),A
	DEC	DE
	DEC	HL
	DEC	B
	JP	NZ,FMUL7
	LD	B,249
	EX	DE,HL
	JP	FMUL4
FMUL8:	EX	DE,HL
	INC	HL
	LD	(HL),DIGIT+1		;SET NEXT LOOP COUNT
; PERFORM ACCUMULATION OF PRODUCT
FMUL9:	POP	BC		;GET MULTIPLIER
	LD	HL,HOLD8+DIGIT+1	
	DEC	(HL)		;DECREMENT LOOP COUNT
	JP	Z,FMU14		;FINISHED
	LD	A,(BC)
	DEC	BC
	PUSH	BC
	DEC	HL
	EX	DE,HL
FMU10:	ADD	A,A		;CHECK FOR BIT IN CARRY
	JP	C,FMU11		;FOUND A BIT
	JP	Z,FMU12		;ZERO - FINISHED THIS DIGIT
	LD	HL,-DIGIT-1
	ADD	HL,DE		;POINT TO NEXT HOLDING REGISTER
	EX	DE,HL
	JP	FMU10
FMU11:	LD	C,A
	OR	A		;CLEAR CARRY
	CALL	ADDX		;ACCUMULATE PRODUCT
	LD	A,(DE)
	ADD	A,(HL)
	DAA
	LD	(HL),A
	LD	A,C
	DEC	DE
	JP	FMU10
; ROTATE RIGHT 1 BYTE
FMU12:	LD	B,8
	CALL	RIGHT
	JP	FMUL9
FMU14:	LD	A,(BUF)
	AND	0F0H		;CHECK IF NORMALIZING
	JP	Z,FMU17
	LD	A,D
	AND	0F0H
	LD	HL,SIGN-1
	JP	FMU18
FMU17:	LD	B,4
	LD	HL,EXP
	DEC	(HL)
	JP	Z,UNDER
	CALL	LEFT		;NORMALIZE
	LD	A,D		;GET DIGIT SHIFTED OFF
; PERFORM ROUNDING
	RRCA
	RRCA
	RRCA
	RRCA
FMU18:	CP	50H
	JP	C,FMU16
	INC	A
	AND	0FH
	LD	C,DIGIT
FMU15:	ADC	A,(HL)
	DAA
	LD	(HL),A
	LD	A,0
	DEC	HL
	DEC	C
	JP	NZ,FMU15
; CHECK FOR ROUNDING OVERFLOW
	JP	NC,ADS2		;NO OVERFLOW
	INC	HL
	LD	(HL),10H
	LD	HL,EXP
	INC	(HL)
	JP	NZ,ADS2
	JP	OVER
; ROUNDING NOT NEEDED
FMU16:	AND	0FH
	ADD	A,(HL)
	LD	(HL),A
	JP	ADS2
; 
; FLOATING POINT DIVISION
; 
FDIV:	PUSH	BC
	LD	A,(HL)		;FETCH DIVISOR EXP
	OR	A		;DIVIDE BY ZERO?
	JP	Z,DIVZ
	LD	A,(DE)
	OR	A		;DIVIDEND 0?
	JP	Z,INSP
	SUB	(HL)
	JP	C,DIVUN
	JP	M,OVER
	JP	FDI1
DIVUN:	JP	P,UNDER
FDI1:	ADD	A,129		;FORM QUOTIENT EXP
	LD	(EXPD),A
	EX	DE,HL
	PUSH	DE
	CALL	LOAD		;FETCH DIVIDEND
	POP	DE
	EX	DE,HL
	LD	A,(SIGN)
	DEC	HL
	XOR	(HL)		;FORM QUOTIENT SIGN
	LD	(SIGND),A
	EX	DE,HL
	DEC	DE
	LD	BC,HOLD1
DIV0:	LD	L,DIGIT+DIGIT
DIV1:	PUSH	BC
	PUSH	HL
	LD	C,0		;QUOTIENT DIGIT = 0
DIV3:	SCF		;SET CARRY
	LD	HL,BUF+DIGIT-1
	LD	B,DIGIT
DIV4:	LD	A,99H
	ADC	A,0
	EX	DE,HL
	SUB	(HL)
	EX	DE,HL
	ADD	A,(HL)
	DAA
	LD	(HL),A
	DEC	HL
	DEC	DE
	DEC	B
	JP	NZ,DIV4
	LD	A,(HL)
	CCF
	SBC	A,0
	LD	(HL),A
	RRA	
	LD	HL,DIGIT
	ADD	HL,DE
	EX	DE,HL
	INC	C		;INCREMENT QUOTIENT
	RLA
	JP	NC,DIV3
	OR	A		;CLEAR CARRY
	CALL	ADDX		;RESTORE DIVIDEND
	LD	HL,DIGIT
	ADD	HL,DE
	EX	DE,HL
	PUSH	BC
	LD	B,4
	CALL	LEFT		;SHIFT DIVIDEND
	POP	BC
	DEC	C
	POP	HL
	LD	H,C
	POP	BC
	LD	A,L
	JP	NZ,DIV5
	CP	DIGIT+DIGIT
	JP	NZ,DIV5
	LD	HL,EXPD
	DEC	(HL)
	CALL	Z,UNDER
	JP	DIV0
DIV5:	RRA
	LD	A,H
	JP	NC,DIV6
	LD	A,(BC)
	RLCA
	RLCA
	RLCA
	RLCA
	ADD	A,H
	LD	(BC),A		;STORE QUOTIENT
	INC	BC
	JP	DIV7
DIV6:	LD	(BC),A		;STORE QUOTIENT
DIV7:	DEC	L		;DECREMENT DIGIT COUNT
	JP	NZ,DIV1
	LD	HL,EXPD
	POP	BC
	CALL	STORO
	RET		;***** CALL, RET????!!!!!*******
; 
; FETCH AND ALIGN ARGUMENTS FOR
; ADDITION AND SUBTRACTION
; 
EXPCK:	LD	A,(DE)
	SUB	(HL)		;DIFFERENCE OF EXPONENTS
	LD	C,0
	JP	NC,EXPC1
	INC	C
	EX	DE,HL
	CPL
	INC	A
EXPC1:	LD	B,A
	LD	A,(DE)
	LD	(EXP),A
	LD	A,B
	CP	DIGIT+DIGIT
	JP	C,EXPC2
	LD	A,DIGIT+DIGIT
EXPC2:	RLCA
	RLCA
	LD	B,A
	AND	4
	LD	(RCTRL),A	;SET ROUNDING CONTROL
	PUSH	BC
	PUSH	DE
	CALL	LOAD		;LOAD SMALLER VALUE
	LD	A,8*DIGIT+16
	SUB	B
	CP	8*DIGIT+16
	JP	Z,EXPC3
	AND	0F8H
	RRA
	RRA
	RRA
	ADD	A,E
	LD	E,A
	LD	A,D
	ADC	A,0
	LD	D,A
	LD	A,(DE)		;GET ROUNDING DIGIT
	LD	(RDIGI),A	;SAVE
EXPC3:	CALL	RIGHT		;ALIGN VALUES
	POP	DE
	POP	BC
	RET
; LOAD ARGUMENT INTO BUFFER
LOAD:	LD	DE,SIGN
	LD	C,DIGIT+1
	DEC	HL
LOAD1:	LD	A,(HL)
	LD	(DE),A
	DEC	HL	
	DEC	DE
	DEC	C
	JP	NZ,LOAD1
	XOR	A
	LD	(DE),A
	DEC	DE
	LD	(DE),A
	LD	(RDIGI),A	;ZERO ROUNDING DIGIT
	RET
; STORE RESULTS IN MEMORY
STORE:	LD	HL,EXP
STORO:	LD	E,DIGIT+2
STOR1:	LD	A,(HL)
	LD	(BC),A
	DEC	BC
	DEC	HL
	DEC	E
	JP	NZ,STOR1
	RET
; SHIFT RIGHT NUMBER OF DIGITS
; IN B/4
RIGHT:	LD	C,DIGIT+1
RIGH1:	LD	HL,BUF-1
	LD	A,B
	SUB	8		;CHECK IF BYTE CAN BE SHIFTED
	JP	NC,RIGH3
	DEC	B
	RET	M
	OR	A
RIGH2:	LD	A,(HL)
	RRA
	LD	(HL),A
	INC	HL
	DEC	C
	JP	NZ,RIGH2
	JP	RIGHT
; SHIFT RIGHT ONE BYTE
RIGH3:	LD	B,A
	XOR	A
RIGH4:	LD	D,(HL)
	LD	(HL),A
	LD	A,D
	INC	HL
	DEC	C
	JP	NZ,RIGH4
	JP	RIGHT
; SHIFT LEFT NUMBER OF DIGITS
; IN B/4
LEFT:	LD	C,DIGIT+1
	LD	HL,SIGN-1
LEF1:	LD	A,B
	SUB	8
	JP	NC,LEF3
	DEC	B
	RET	M
	OR	A
LEF2:	LD	A,(HL)
	RLA
	LD	(HL),A
	DEC	HL
	DEC	C
	JP	NZ,LEF2
	JP	LEFT
; SHIFT LEFT ONE BYTE
LEF3:	LD	B,A
	XOR	A
LEF4:	LD	D,(HL)
	LD	(HL),A
	LD	A,D
	DEC	HL
	DEC	C
	JP	NZ,LEF4
	JP	LEFT
; SET FLAGS FOR OVERFLOW, UNDERFLOW,
; AND DIVIDE BY ZERO
DIVZ:
OVER:	LD	BC,'FP'
	JP	ERROR
UNDER:	LD	A,-1
	LD	(ERRI),A
INSP:	INC	SP
	INC	SP
	RET
; 
; FLOATING POINT RAM
; 
HOLD1:	DEFS	DIGIT+1
HOLD2:	DEFS	DIGIT+1
HOLD3:	DEFS	DIGIT+1
HOLD4:	DEFS	DIGIT+1
HOLD5:	DEFS	DIGIT+1
HOLD6:	DEFS	DIGIT+1
HOLD7:	DEFS	DIGIT+1
HOLD8:	DEFS	DIGIT+1
	DEFS	1
ERRI:	DEFS	1		;ERROR FLAG
	DEFS	1
BUF:	DEFS	DIGIT		;WORKING BUFFER
SIGN:	DEFS	1		;SIGN BIT
EXP:	DEFS	1		;EXPONENT
RC