; THIS IS A FOUR FUNCTION FLOATING POINT MATH PACKAGE
; 
; EACH FUNCTION MAY BE EXPRESSED AS <BC> = <DE> # <HL> WHERE
; 
;	<BC> = ADDRESS OF RESULT
;	<DE> = ADDRESS OF FIRST ARGUMENT
;	<HL> = ADDRESS OF SECOND ARGUMENT
; 
;	AND # IS ONE OF THE FUNCTIONS +, -, *, /
; 
; ON ENTRY TO EACH FUNCTION, BC,DE, & HL SHOULD BE SET AS INDICATED 
; ABOVE.	ALL ADDRESSES ON ENTRY POINT TO THE EXPONENT PART OF THE 
; FLOATING POINT NUMBER.	EACH FLOATING POINT NUMBER CONSISTS OF 12 PACKED
; DECIMAL DIGITS, A SIGN, AND A BIASED BINARY EXPONENT
; 
; THE EXPONENT RANGE IS	-127 TO +127
; 
; THE NUMBER ZERO IS REPRESENTED BY ALL DIGITS ZERO AND THE EXPONENT ZERO
; 
; THE NUMBERS ARE STORED IN MEMORY STARTING AT THE LOW ORDER ADDRESS AS
; 6 BYTES OF DECIMAL DIGITS FOLLOWED BY THE SIGN FOLLOWED BY THE EXPONENT
; 
; THE NUMBERS ARE ASSUMED TO BE NORMALIZED.	THAT IS, EACH NUMBER
; CAN BE REPRESENTED AS	F**E	WHERE .1 <= F <1.0	AND E IS THE EXPONENT
; 
; 
PROCT	EQU	0
INTEL	EQU	1
CI	EQU	3803H
CO	EQU	3809H
CSTS	EQU	3812H
; 
; 
DIGIT	EQU	15
ASCR	EQU	0DH
MAXI	EQU	72	;MAXIMUM INPUT LINE LENGTH
STAT	EQU	0
DATA	EQU	1
DAV	EQU	40H
TBE	EQU	80H
; 
	ORG	100H
; 
CALC:	LXI	H,0	;ENTRY POINT FOR THE CALCULATOR
	DAD	SP
	SHLD	USRST	;SAVE USER'S STACK POINTER
CALC2:	LXI	SP,STACK
INIT:	LXI	H,INFES
	MVI	M,18H	;INITIALIZE FORMAT (FD12)
	INX	H
	MVI	M,60	;INITIALIZE TERMINAL WIDTH TO 60
; 
	LXI	H,INMES	;PRINT HEADER
	JMP	OMESS
INMES:	DB	'PROCESSOR TECHNOLOGY CORP.'
	DW	0A0DH
	DW	77577Q
	DB	'FLOATING POINT CALCULATOR'
	DB	0
	CALL	CRLF
; 
; THIS ROUTINE CLEARS ALL RAM STORAGE SPACE AND
; PRINTS "CLEAR" MESSAGE
; 
FRESH:	LXI	H,OPST
	MVI	C,MAXCL
	CALL	CLEAR
	LXI	H,CLMES
	CALL	OMESS
	JMP	READ
; 
; ALL ERRORS COME HERE FOR MESSAGE PRINTOUT
; 
ERCHK:	CALL	MSG
	JMP	READ
MSG:	LXI	H,OMESS
	PUSH	H	;OMESS ADDR
	JP	OVER
	LXI	H,UNMES
	RET
OVER:	RAR
	JNC	DIVZM
	LXI	H,OVMES
	RET
DIVZM:	LXI	H,DZMES
	RET
ERROR:	LXI	H,ERMES
	CALL	OMESS
	JMP	READ
; 
; THIS ROUTINE WILL OUTPUT AN ASCII MESSAGE..H&L 
; POINT TO THE BEGINNING AND THE ROUTINE TERMINATES
; WHEN IT FINDS A BINARY ZERO.	THE PROGRAM COUNTER IS 
; SET ONE BYTE PAST THE ZERO.
; 
OMESS:	CALL	CRLF
	MOV	B,M
	CALL	OUTB
	INX	H
	ORA	A
	JNZ	OMESS+3
	PCHL
; 
; ERROR MESSAGES USED BY OMESS
; 
ERMES:	DB	'THAT DOES NOT COMPUTE'
	DB	0
	RET
DZMES:	DB	'D/ZERO'
	DB	0
	RET
UNMES:	DB	'UNDERFLOW'
	DB	0
	RET
OVMES:	DB	'OVERFLOW'
	DB	0
	RET
CLMES:	DB	'CLEAR'
	DB	0
	RET
; 
; THIS ROUTINE READS DATA INTO AN INPUT BUFFER (IBUF)
; THE INPUT IS TERMINATED BY A CARRIAGE RETURN
; 
READ:	LXI	SP,STACK
	LXI	H,IBUF-1
	SHLD	ADDS
	INX	H
	CALL	CRLF
	MVI	E,MAXI
; 
READ2:	CALL	INB
	CPI	18H	;CHECK FOR CONTROL X
	JNZ	DEL
	MVI	B,'\'
	CALL	OUTB
	JMP	READ
; 
DEL:	CPI	7FH	;CHECK FOR RUBOUT
	JNZ	CHR
	MVI	A,MAXI
	CMP	E
	JZ	READ
	DCX	H
DEL2:	MVI	B,'_'	
	CALL	OUTB
	INR	E
	JMP	READ2
; 
CHR:	XRA	A
	ORA	E
	JZ	DEL2
	MOV	M,B	;STORE CHARACTER
	INX	H
	DCR	E
	MVI	A,ASCR
	CMP	B	;CHECK FOR CARRIAGE RETURN
	JZ	SCAN
	CALL	OUTB	;ECHO CHAR
	JMP	READ2	;GET MORE
; 
; THIS ROUTINE GETS CHARACTERS FROM THE INPUT BUFFER
; AND SCANS PAST BLANKS
; 
IBSCN:	LHLD	ADDS
	INX	H
	MOV	A,M
	CPI	' '
	JZ	IBSCN+3
	SHLD	ADDS
; 
; THIS ROUTINE CHECKS FOR ASCII NUMBERS (0-9)
; 
NMCHK:	CPI	'9'+1
	RNC
	CPI	'0'
	CMC
	RET
; 
; THIS ROUTINE SCANS THE INPUT LINE, BRANCHES TO 
; NECESSARY SUBROUTINES, AND CONVERTS ASCII NUMBERS
; TO BINARY AND BCD PACKS THEM INTO REGISTER 'BC'
; OF THE SOFTWARE PUSH-DOWN STACK FOR LATER USE
; 
SCAN:	CALL	CRLF
	LXI	H,TEMP	;CLEAR TEMPORARY STORAGE AREAS
	MVI	C,7
	CALL	CLEAR
	STA	ERRI	;CLEAR ERROR FLAG BYTE
; 
SCANC:	LXI	D,0
	LXI	H,BC
SCAN0:	SHLD	BCADD
SCANP:	LXI	H,SCANP
	PUSH	H
	XRA	A
	STA	XSIGN
	LDA	TEMP
	ORA	A	;ANY TEMPORARY CHARS?
	JZ	SCANG
	CALL	NMCHK	;CHECK IF NUMBER
	JMP	SCANG+3
; 
SCANG:	CALL	IBSCN
	JC	SCANX
	CPI	'.'	;RADIX?
	JZ	SCAN5
	CPI	'E'	;EXPONENT?
	JZ	EXCON
	LXI	H,OPST
	STA	TEMP
	MOV	C,A
	MVI	A,10H	;ANY NUMBERS IN BC YET?
	ANA	M
	JNZ	ENTR2	;YES-PUSH SOFTWARE STACK
	STA	TEMP
	MVI	B,80H
	MOV	A,C
	CPI	'S'	;SUBTOTAL?
	JNZ	PCHK
	MOV	A,B
; 
PUT:	ORA	M
	MOV	M,A
	RET
PCHK:	CPI	'P'	;PRINT?
	JNZ	SCNQ
	MOV	A,B
	RLC
	JMP	PUT
SCNQ:	CPI	'Q'	;SQUARE ROOT?
	JNZ	SCN
	MVI	A,1
	STA	SQR
	RET
SCN:	CPI	'##'	;FLAG FOR LEADING UNARY SIGN
	JZ	SCAN3-4
	CALL	CHKOP
	JNZ	SCAN3
	MOV	B,A
	LDA	OPSTR
	ORA	A
	JZ	SCAN2	;IT'S AN OPERATOR
	MOV	A,C
	CPI	2
	JNC	SCAN2
SQN:	STA	SIGN	;IT'S A SIGN
	RET
; 
SCAN2:	LDA	SQR
	ORA	A
	JNZ	SQN
	MOV	A,B
	STA	OPSTR
	RET
; 
SCAN3:	CALL	FINDR	;CHECK IF REGISTER (A,B,C,D)
	JM	DLMT	;NO GO-CHECK FOR DELIMITERS
	PUSH	H
	CALL	IBSCN
	CPI	'='	;FIND REG AND SET DESTINATION
	JZ	SCAN4
	DCX	H	;MOVE DATA IN REG (N) TO BC
	SHLD	ADDS
	LXI	D,HL-1
	POP	H
	MVI	C,DIGIT+2
	CALL	UP
	JMP	ENT1	;SKIP FILE AND MOVE REG TO STACK
; 
SCAN4:	MVI	A,3
	DCR	A
	CMP	C
	JNZ	SCAN4+2
	LXI	H,OPST
	INR	A
	RLC	;A=8,B=6,C=4,D=2
	ORA	M
	MOV	M,A
	POP	H
	SHLD	DEST
	RET
; 
SCAN5:	XRA	A	;FOUND RADIX
	ORA	D	;ANY DIGITS YET?
	JNZ	SCAN6
	ADI	0C0H	;SET ECNT - & STOP COUNTING DIGITS
	ORA	E
	MOV	E,A
	RET
SCAN6:	MVI	A,80H	;SET ECNT TO COUNT DIGITS
	ORA	E
	MOV	E,A
	RET
; 
SCANX:	ANI	0FH	;FOUND NUMBER-REMOVE ASCII BIAS
	MOV	B,A
	LXI	H,OPST	;SET FIRST CHARACTER FLAG
	MVI	A,30H
	ORA	M
	MOV	M,A
	XRA	A
	ORA	B	;IS CHARACTER ZERO
	JNZ	PACK
	ORA	D	;LEADING ZERO?
	JNZ	PACK
	ORA	E
	MOV	E,A
	RZ
	INR	E	;ECNT+1
	RET
; 
; THIS SUBROUTINE BCD PACKS DIGITS INTO REG BC
; 
PACK:	MOV	A,E
	RAL
	JC	$+4
	INR	E
	MOV	A,E
	STA	ECNT
	INR	D
	MOV	A,D
	ANI	7FH	;REMOVE TOP/BOTTOM FLAG
	CPI	DIGIT*2	;LIMIT INPUT DIGITS
	RNC
	XRA	A
	ORA	D
	JM	BOTM
; 
TOP:	ORI	80H	;SET MSB FOR TOP FLAG
	MOV	D,A
	MOV	A,B
	LHLD	BCADD	;GET BC ADDRESS
	RLC
	RLC
	RLC
	RLC
	MOV	M,A	;SAVE CHR IN BC
	RET
; 
BOTM:	ANI	7FH	;STRIP MSB (BOTTOM FLAG)
	MOV	D,A
	MOV	A,B
	LHLD	BCADD
	ORA	M	;OR IN TOP NUMBER
	MOV	M,A	;PUT NUMBER BACK IN BC
	INX	H
	POP	B
	JMP	SCAN0
; 
; THIS ROUTINE CHECKS FOR STATEMENT DELIMITERS
;	( : \ , \ ; \ <CR> )
; 
DLMT:	LXI	H,TEMP
	MOV	M,A
	INX	H	;TO OPST
	MOV	A,M
	MOV	B,A
	PUSH	PSW
	ANI	0EH	;ANY REGISTER NAMES TO PRINT?
	JZ	DL2
	MOV	L,A
	MOV	A,B
	ANI	100Q
	JZ	DL1
	MVI	A,12Q
	MVI	B,'A'-1
ALPH:	INR	B	;FIND REGISTER NAME
	DCR	A
	DCR	A
	CMP	L
	JNZ	ALPH
DOUT:	CALL	OUTB	;PRINT NAME
	MVI	B,'='
	CALL	OUTB
; 
DL1:	LHLD	DEST
	XCHG
	LXI	H,DE-1	;MOVE SOFTWARE STACK REG HL TO MEMORY REG
	MVI	C,DIGIT+2	;(A,B,C,D)
	CALL	UP
; 
DL2:	POP	B	;PRINT RESULTS IF ANY
	MVI	A,40H
	ANA	B
	JZ	DL3
	XRA	B
	STA	OPST
	CALL	OUTPUT
	CALL	SPACE
; 
DL3:	LXI	H,OPSTR
	MOV	A,M
	ORA	A
	JNZ	ENTR5	;CONTINUE IF MORE DATA
; 
	DCX	H	;CHECK FOR DELIMITERS
	DCX	H
	MOV	A,M	;GET DATA FROM TEMPORARY
	MVI	M,DIGIT-DIGIT
	CPI	ASCR	;CARRIAGE RETURN?
	JZ	READ	;NEXT LINE IN
	CPI	':'	;COLON?
	JNZ	DL4
	POP	H
	JMP	SCAN
DL4:	CPI	','	;COMMA?
	JNZ	DL5
	MVI	C,5	;PRINT FIVE SPACES
DL40:	CALL	SPACE
	DCR	C
	JNZ	DL40
	POP	H
	JMP	SCAN+3
DL5:	MVI	C,1	;PRINT ONE SPACE
	CPI	';'	;SEMICOLON?
	JZ	DL40
; 
; THIS ROUTINE CHECKS FOR COMMAND CHARACTERS
; AND JUMPS TO THE APPROPRIATE ROUTINES
; IF CHR IS NOT FOUND HERE, IT IS ILLEGAL
; 
CMD:	CPI	'X'
	JZ	EXIT
	CPI	'R'
	JZ	FRESH
	CPI	'F'
	JZ	FIXS
	CPI	'K'
	JZ	POPST
	CPI	'Q'
	JZ	ROOT
	CPI	'W'
	JZ	WIDE
	JMP	ERROR
	DS	40	;LEAVE ROOM FOR MORE COMMANDS!!!
; 
; THIS ROUTINE SETS THE TERMINAL WIDTH
; 
WIDE:	CALL	IBSCN
	RNC
	CALL	ASCDC
	MOV	A,E
	CPI	4	;MINIMUM WIDTH
	JC	ERROR
	STA	WIDTH
	RET
; 
; THIS ROUTINE IS USED TO ADJUST A NUMBER IN BC
; FOR INPUT TO THE SOFTWARE STACK.	IT THEN CALLS
; ROUTINES TO PUSH THE NUMBER ON THE STACK, AND CHECKS
; IF IMMEDIATE PRINTING OF A NUMBER IS WANTED
; 
ENTR2:	LXI	D,0
	CALL	FIXE	;NORMALIZE FLOATING POINT NUMBER
ENT1:	LXI	H,SCANC
	XTHL	;CHANGE RETURN ADDRESS ON STACK
	LDA	SIGN	;SET UNARY SIGN OF NUMBER
	ORA	A
	JZ	ENT2
	XRA	A
	STA	SIGN
	LDA	BC+DIGIT
	CMA
	STA	BC+DIGIT
ENT2:	CALL	ENTR	;PUSH SOFTWARE STACK
ENTR3:	LXI	H,OPST	;CHECK FOR IMMEDIATE 'PRINT' (P)
	MVI	A,1
	ANA	M
	JZ	ENTR4
	PUSH	H
	CALL	OUTPUT
	CALL	SPACE
	POP	H
ENTR4:	LDA	SQR
	ORA	A
	JNZ	ROOT	
QRET:	XRA	A
	STA	SQR
	MVI	A,356Q	;CLEAR PRINT AND 'OPERATION-OCCURRED' FLAGS
	ANA	M
	MOV	M,A
	INX	H
	MOV	A,M
	ORA	A
	RZ	;TO SCANC
	CPI	'##'	;CHECK IF LEADING UNARY
	JNZ	ENTR5
	MVI	M,DIGIT-DIGIT
	RET	;TO SCANC
ENTR5:	CALL	CHKOP	;CHECK FOR LEGAL OPERATOR
	JNZ	ERROR
; 
; THIS ROUTINE SETS UP ALL REGISTERS AND CALLS
; THE FLOATING POINT ROUTINES
; 
FPC:	MVI	A,-1	;FIND TYPE OF OPERATION
	LXI	H,FPCAL-2
FPC2:	INX	H
	INX	H
	INR	A
	CMP	C
	JNZ	FPC2
	MOV	E,M	;MOVE FLOATING POINT ROUTINE ADDR INTO D&E
	INX	H
	MOV	D,M
FPC3:	LXI	B,FPR
	PUSH	B	;SET UP RETURN FOR FLOATING POINT ROUTINES
	PUSH	D	;SET UP FLOATING POINT ADDRESS
	LXI	B,BC+DIGIT+1	;SET REGISTERS
	LXI	H,HL+DIGIT+1
	LXI	D,DE+DIGIT+1
	RET	;GO TO FLOATING POINT!
; 
; FLOATING POINT ROUTINE ADDRESSES
; 
FPCAL:	DW	FADD	
	DW	FSUB
	DW	FMULT
	DW	FDIV
; 
; THE FLOATING POINT ROUTINES RETURN HERE
; 
FPR:	LDA	ERRI	;CHECK FOR OVER-UNDER-D/ZERO ERRORS
	ORA	A
	JNZ	ERCHK	;PRINT MESSAGE IF ERROR
; 
	CALL	POP	;FIX SOFTWARE STACK
	LXI	H,BC
	LXI	D,HL
	LXI	B,DIGIT+2
	CALL	DOWN
; 
	XRA	A	;CHECK HERE IF SUBTOTAL PRINTOUT IS WANTED
	STA	OPSTR
	LXI	H,OPST
	MVI	A,100Q
	ORA	M
	MOV	M,A
	RAL
	RNC	;NO-RETURN TO SCANC
	ANI	7FH
	STC
	RAR
	MOV	M,A
	CALL	OUTPUT
	CALL	SPACE
	RET	;SCANC
; 
; THIS IS THE EXIT ROUTINE.	IT IS SET NOW TO RETURN
; TO THE BEGINNING OF THIS FLOATING POINT CALCULATOR
; PACKAGE.	IT MAY BE SET TO JUMP OR RETURN TO OTHER
; ROUTINES OR PROGRAMS.	IT WILL RESET THE STACK
; WITH THE VALUE IT HAD WHEN THE FLOATING POINT
; CALCULATOR WAS ENTERED.
; 
EXIT:	LHLD	USRST	;GET USER STACK ADDRESS
	SPHL	;RESET USER'S STACK
	JMP	CALC	;ENTER A RETURN OR JUMP HERE IF NEEDED
; 
; THIS ROUTINE IS USED TO CALCULATE THE SQUARE ROOT
; THE FORMULA IS B=(A/B+2)/2 WHERE A IS THE NUMBER TO BE
; ROOTED, AND B IS THE ESTIMATED SQUARE ROOT.
; 
ROOT:	INX	H	;SAVE OPERATION IF ANY
	MOV	A,M
	STA	ECNT
	LXI	D,BC+DIGIT+1
	LXI	H,HL+DIGIT
	XRA	A
	ORA	M
	JNZ	ERROR	;ERROR IF NEGATIVE ARG
	INX	H	
	ORA	M
	JZ	QRET	;Q=0 - MOVE ON
	SUI	128	;SUBTRACT EXPONENT BIAS
	JNC	ROOT2
	CMA
	INR	A	;MAKE NEGATIVE EXPONENT POSITIVE
; 
ROOT2:	STC
	RAR	
	STAX	D	;PUT ESTIMATE EXPONENT IN BC
	MVI	A,80H
	ANA	M	;CHECK IF NEGATIVE EXPONENT
	JNZ	RTPOS
	LDAX	D	;SWITCH IF NEGATIVE
	CMA
	INR	A
	STAX	D	;NEGATIVE EXPONENT ESTIMATE TO BC
; 
RTPOS:	DCX	H
	DCX	D
	MVI	C,DIGIT+1
	CALL	UP	;MOVE ESTIMATE TO BC
	LXI	H,DE	;MOVE DATA IN SOFTWARE STACK TO TEMPORARY
	LXI	D,REGE
	LXI	B,DIGIT+2
	CALL	DOWN
	CALL	ENTR	;PUSH SOFTWARE STACK
	MVI	A,(DIGIT/3)*4	;ITERATION COUNT
; 
ROOT3:	PUSH	PSW
	CALL	SETST
	LXI	D,FDIV	;DIVIDE A/B
	CALL	FPC3
	LXI	D,FADD
	CALL	FPC3	;ADD (A/B)+B
	MVI	A,20H
	STA	BC
	MVI	A,81H
	STA	BC+DIGIT+1	;MOVE IN A '2' FOR DIVIDE
	CALL	ENTR
	LXI	D,FDIV	;DIVIDE (A/B+B)/2
	CALL	FPC3
	POP	PSW
	DCR	A
	JNZ	ROOT3	;DO IT 8 TIMES
	LXI	H,REGE
	LXI	D,DE	;MOVE DATA FROM THE TEMPORARY TO DE IN STACK
	LXI	B,DIGIT+2
	CALL	DOWN
	LDA	ECNT	;GET PREVIOUS OPERATORS IF ANY
	LXI	H,OPSTR
	MOV	M,A
	XRA	A
	STA	ECNT
	DCX	H
	JMP	QRET	;DONE-BACK TO NORMAL
; 
SETST:	LXI	H,DE+DIGIT+1	;SET UP SOFTWARE STACK FOR SQR ROOT
	LXI	D,S4+DIGIT+1
	MVI	C,(DIGIT+2)*2
	JMP	UP
; 
; THIS ROUTINE IS USED TO SET REGISTER ADDRESSES 
; FOR MEMORY REGISTERS A,B,C,D
; 
FINDR:	LXI	H,REGB-1
	PUSH	D
	LXI	D,DIGIT+2
	LXI	B,4103H
FIND2:	CMP	B
	JZ	FEND
	DCR	C
	JM	FEND
	DAD	D	;GO TO NEXT REG
	INR	B
	JMP	FIND2
FEND:	POP	D
	RET
; 
; THESE ROUTINES ARE USED TO MANIPULATE THE 
; SOFTWARE STACK
; 
; POP STACK
; 
POPST:	LXI	H,HL
	LXI	D,BC
	MVI	C,DIGIT*5+2
	CALL	DOWN
	LXI	B,DIGIT+2
	LXI	H,BC
	LXI	D,S4
	CALL	DOWN
	JMP	ENTR3
; 
; RESET STACK AFTER OPERATION
; 
POP:	LXI	H,S3
	LXI	D,DE
	LXI	B,DIGIT*2+4
	CALL	DOWN
	RET
; 
; MOVE DATA FROM ADDRESS POINTED TO BY HL
; TO ADDRESS POINTED TO BY DE
; 
DOWN:	MOV	A,M
	STAX	D
	MOV	M,B	;PULL A ZERO
	INX	H
	INX	D
	DCR	C
	JNZ	DOWN
	RET
; 
; ENTER (PUSH) DATA ONTO STACK
; 
ENTR:	LXI	H,S3+DIGIT+1
	LXI	D,S4+DIGIT+1
	MVI	C,DIGIT*5+3
	CALL	UP
	LXI	H,BC
	MVI	C,DIGIT+2
	CALL	CLEAR	;CLEAR BC
	RET
; 
; MOVE DATA
; 
UP:	MOV	A,M
	STAX	D
	DCX	D
	DCX	H
	DCR	C
	JNZ	UP
	RET
; 
; THIS ROUTINE IS USED TO SET THE OUTPUT FORMAT
; 
FIXS:	CALL	FIXS2	;GET FORMAT SYMBOL
	JNZ	ERROR	;NO FORMAT?
	CALL	IBSCN
	JC	FIXS3
	CPI	'$'	;PRINT TRAILING ZEROS?
	JNZ	FIXS3
	MVI	A,200Q
	ORA	C
	MOV	C,A
	CALL	IBSCN
FIXS3:	PUSH	B	;SAVE OLD DECIMAL PLACE COUNT
	JC	FIXS4
	LDA	INFES
	RRC
	ANI	0FH
	JMP	FIXS5
FIXS4:	CALL	ASCDC	;CONVERT DECIMAL PLACE COUNT
	MOV	A,E
FIXS5:	CPI	DIGIT*2+1
	JC	FIXS6
	MVI	A,DIGIT*2
FIXS6:	RLC
	POP	B
	ORA	C
	STA	INFES	;STORE NEW FORMAT
	XRA	A
	STA	TEMP	;CLEAR TEMPORARY STORAGE REGISTERS
	RET	;TO SCANC
; 
FIXS2:	CALL	IBSCN	;GET FORMAT SYMBOL
	MVI	C,0
	CPI	'D'	;DECIMAL PLACES
	RZ
	INR	C
	CPI	'E'	;EXPONENTIAL
	RZ
	MVI	C,40H
	CPI	'F'	;FLOAT-MANDATORY DECIMAL PLACE
	RET
; 
; THIS ROUTINE CHECKS OR OPERATORS (+,-,*,/)
; 
CHKOP:	MVI	C,0
	CPI	'+'
	RZ
	INR	C
	CPI	'-'
	RZ
	INR	C
	CPI	'*'
	RZ
	INR	C
	CPI	'/'
	RET
; 
; THIS ROUTINE IS USED TO CLEAR STORAGE AREAS
; THE STARTING ADDRESS IS IN H&L AND THE COUNT
; IS IN REG C
; 
CLEAR:	XRA	A
	MOV	M,A
	INX	H
	DCR	C
	JNZ	CLEAR+1
	RET
; 
; THIS ROUTINE CONVERTS THE ASCII EXPONENT O
; THE NUMBER IN THE INPUT BUFFER TO BINARY, AND
; NORMALIZES EXPONENT ACCORDING TO THE INPUT
; FORMAT OF THE NUMBER
; 
EXCON:	CALL	IBSCN	;GET CHAR
	JC	EXC3
	CPI	'+'	;CHECK FOR UNARY OPERATOR
	JZ	EXC2+3	;*************************?????????
	CPI	'-'
	JNZ	ERROR	;NO SIGN OR NUMBER?
	MVI	A,1
EXC2:	STA	XSIGN	;SAVE SIGN
	CALL	IBSCN
	JNC	ERROR	;NO NUMBER?
EXC3:	CALL	ASCDC	;CONVERT ASCII TO BINARY
	CALL	FIXE	;NORMALIZE EXPONENT
	JMP	ENT1	;GO ENTER NUMBER NOW
; 
; THIS ROUTINE CONVERTS ASCII TO BINARY
; THREE CONSECUTIVE NUMBERS < 128 MAY BE CONVERTED
; 
ASCDC:	XCHG
	LXI	H,0
ASC1:	LDAX	D
	CALL	NMCHK	;CHECK NUMERIC
	JNC	ASC2
	SUI	'0'	;REMOVE ASCII BIAS
	MOV	B,H
	MOV	C,L
	DAD	H
	DAD	H
	DAD	B
	DAD	H
	MOV	C,A
	MVI	B,0
	DAD	B
	INX	D
	JMP	ASC1
ASC2:	XCHG
	DCX	H
	SHLD	ADDS	;SAVE IBUF ADDRESS
	MOV	A,D
	ORA	A
	JNZ	ERROR	;TOO BIG >255
	MOV	A,E
	RAL
	JC	ERROR	;TOO BIG >127
	RAR	
	RET
; 
; THIS ROUTINE NORMALIZES THE INPUT NUMBER
; 
FIXE:	XCHG
	LDA	BC
	ORA	A	;IS IT ZERO?
	JZ	ZZ2
	CALL	CHKPN
	ADI	80H	;ADD EXPONENT BIAS
ZZ2:	STA	BC+DIGIT+1
	RET
; 
CHKPN:	LDA	ECNT	;GET DIGIT COUNT
	MOV	E,A
	ANI	3FH	;STRIP BITS 7&8
	MOV	B,A
	LDA	XSIGN
	ORA	A
	JZ	LPOS	;EXPONENT IS POSITIVE
	INR	H	;SET SIGN IN H
	MVI	A,40H	;L IS NEGATIVE
	ANA	E	;CHECK IF E IS NEGATIVE
	JZ	EPOS
	MOV	A,L	;BOTH E&L NEGATIVE
	MOV	L,B
	CALL	EPOS+1
	CMA
	INR	A
	RET	;BACK TO FIXE
; 
EPOS:	MOV	A,L	;E&L NEGATIVE
	CMA
	INR	A
	ADD	B
	RET	;TO FIXE
; 
LPOS:	MVI	A,40H	;EXPONENT POSITIVE
	ANA	E	;IS E NEGATIVE?
	JZ	BPOS
	MOV	A,B
	MOV	B,L
	JMP	EPOS+1
; 
BPOS:	MOV	A,B	;E&L POSITIVE
	ADD	L
	JM	ERSET
	RET
; 
ERSET:	XRA	A	;EXPONENT ERROR
	ORA	H	;GET EXPONENT SIGN
	JZ	ERSE2	;UNDERFLOW
	CMA
ERSE2:	INR	A	;OVERFLOW
	STA	ERRI	;STORE ERROR NUMBER
	JMP	ERCHK	;GO OUTPUT ERROR MESSAGE
; 
; 
;	THIS ROUTINE TAKES THE BCD NUMBER IN HL AND 
; CONVERTS IT FOR OUTPUT ACCORDING TO THE OUTPUT
; FORMAT
; 
OUTPUT: LXI	H,ABUF
	LDA	INFES	;GET OUTPUT FORMAT
	STA	FES	;STORE IT IN WORKING BUFFER
	LXI	B,HL
	MVI	E,DIGIT
	MVI	M,0	;CLEAR ROUND-OFF OVERFLOW BUFFER
	INX	H
; 
NEXT:	LDAX	B	;GET DIGIT AND UNPACK
	MOV	D,A
	RAR	
	RAR
	RAR
	RAR
	ANI	0FH	;REMOVE BOTTOM DIGIT
	MOV	M,A	;STORE TOP DIGIT IN OUTPUT BUFFER(ABUF)
	INX	H
	MOV	A,D	;NOW GET BOTTOM DIGIT
	ANI	0FH
	MOV	M,A	;STORE IT
	INX	H
	INX	B
	DCR	E
	JNZ	NEXT
	XRA	A
	MOV	M,A
	INX	H
	MOV	M,A
; 
FIX:	INX	B
	LDAX	B
	ORA	A	;EXPONENT ZERO?
	JZ	ZRO
	SBI	128	;REMOVE NORMALIZING BIAS
	JNZ	FIX2
	INR	M
FIX2:	JP	CHK13
	CMA	;IT'S A NEGATIVE EXPONENT
	INR	M
ZRO:	INR	A
CHK13:	INX	H	;CHECK IF EXPONENT > 12
	MOV	M,A
	MOV	E,A
	CPI	DIGIT*2
	INX	H
	JC	CHKX0
CHK40:	MVI	A,1	;FORCE EXPONENTIAL PRINTOUT
	ORA	M
	MOV	M,A
; 
CHKX0:	MOV	A,M	;CHECK IF EXPONENTIAL PRINTOUT
	RAR
	JNC	CHKX3
	ANI	1FH
	CPI	DIGIT*2
	JC	CHKX2
	MVI	A,DIGIT*2-1
CHKX2:	MOV	D,A
	INR	A
	JMP	ROUND
; 
CHKX3:	ANI	1FH	;ADD EXPONENT AND DECIMAL PLACES
	MOV	D,A
	ADD	E
	CPI	DIGIT*2+1
	MOV	B,A
	JC	CHKXN
	MOV	A,M
	CPI	100Q
	JNZ	CHK40
; 
CHKXN:	LDA	XSIGN	;CHECK EXPONENT SIGN
	ORA	A
	JNZ	XNEG	;IT'S NEGATIVE
	MOV	A,B
	JMP	ROUND
; 
XNEG:	MOV	A,D	;SUBTRACT EXPONENT AND DECIMAL PLACE COUNT
	SUB	E
	JNC	XN2
XN1:	LDA	INFES
	ORA	A
	JP	ZERO
	ANI	0EH
	JZ	ZERO
	RRC
	MOV	E,A
	DCR	E
	MVI	C,1
	LXI	H,ABUF-1
	JMP	NRND
XN2:	JZ	XN1
	JMP	ROUND
; 
CLEAN:	MVI	B,1FH	;CLEAR FLAGS
	ANA	B
	CPI	DIGIT*2+1
	RC
	MVI	A,DIGIT*2+1
	RET
; 
; THIS ROUTINE IS USED TO ROUND DATA TO THE 
; SPECIFIED PRECISION
; 
ROUND:	CALL	CLEAN
	MOV	C,A
	MVI	B,0
	LXI	H,ABUF+1
	DAD	B	;GET ROUND ADDRESS
	SHLD	ADD
	MOV	A,M
	CPI	5	;ROUND IF >= 5
	JC	TRL2-1
; 
LESS1:	DCX	H
	INR	M	;ROUND UP
	MOV	A,M
	ORA	A
	JZ	TRL2
	CPI	10	;CHECK IF ROUNDED NUMBER >9
	JNZ	TRAIL
	MVI	M,0
	JMP	LESS1
; 
; THIS ROUTINE IS USED TO ELIMINATE TRAILING ZEROS
; 
TRAIL:	LHLD	ADD
	DCX	H
TRL2:	LDA	FES	;CHECK IF TRAILING ZEROS ARE WANTED
	RAL
	JC	PRINT	;YES-GO PRINT DATA
; 
TRL3:	MOV	A,M	
	ORA	A	;IS IT A ZERO?
	JNZ	PRINT	;NO - GO PRINT
	DCX	H
	DCR	C	;YES-FIX OUTPUT DIGIT COUNT
	JM	ZERO
	JMP	TRL3
; 
; HERE START THE PRINT FORMAT ROUTINES
; 
PRINT:	LXI	H,ABUF
	MOV	A,M	;CHECK IF ROUNDED UP TO 1
	ORA	A
	JZ	NRND	;JUMP IF NOT
	MVI	B,1
	LDA	XSIGN	;IS EXPONENT NEGATIVE
	ORA	A
	JZ	POSR
	MVI	B,-1
; 
POSR:	LDA	EXPO	;GET EXPONENT
	ORA	A
	JNZ	PO2	;IS IT ZERO? (E+0)
	STA	XSIGN
	MVI	B,1
PO2:	ADD	B	;FIX EXPONENT COUNT
	STA	EXPO
	INR	E
	INR	C
	DCX	H
; 
NRND:	INX	H
	MOV	A,C
	CPI	DIGIT*2+1	;CHECK FOR MAXIMUM DIGITS OUT
	JNZ	$+4
	DCR	C
	LDA	HL+DIGIT
	RAR
	JNC	PRIN2
	CALL	NEG
	JMP	PRIN2+3
; 
PRIN2:	CALL	SPACE
	LDA	FES	;GET OUTPUT FORMAT
	RAR
	JC	XPRIN
	LDA	XSIGN	;GET EXPONENT SIGN
	ORA	A
	JZ	POSIT
; 
PRIN3:	MOV	A,C	;CHECK IF FRACTIONAL NUMBER
	ORA	A
	RZ
	RM
; 
PRIN4:	CALL	RADIX	;PRINT DECIMAL POINT
	XRA	A
	ORA	E
	JZ	PRIN5	;JUMP IF NO ZEROS TO PRINT
	CALL	ZERO	;FORCE PRINT A ZERO
	DCR	E
	JNZ	PRIN4+3
; 
PRIN5:	CALL	NOUT	;PRINT ASCII DIGIT
	JNZ	PRIN5
	RET
; 
POSIT:	CALL	NOUT
	DCR	E	;BUMP EXPONENT COUNT
	JNZ	POSIT
	JMP	PRIN3	;NOW PRINT DECIMAL POINT
; 
; GET HERE FOR EXPONENTIAL OUTPUT FORMAT
; 
XPRIN:	CALL	NOUT	
	JZ	NDEC	;INTEGER?
	CALL	RADIX	;NO...PRINT DECIMAL POINT
; 
XPRI2:	CALL	NOUT
	JNZ	XPRI2
; 
NDEC:	CALL	SPACE
	MVI	B,'E'
	CALL	OUTB
	LDA	XSIGN
	ORA	A
	JZ	XPRI3
	CALL	NEG	;PRINT EXPONENT SIGN (-)
	LDA	EXPO
	INR	A
	JMP	XOUT2
XPRI3:	MVI	B,'+'	;EXPONENT (+)
	CALL	OUTB
; 
; THIS ROUTINE IS USED TO CONVERT THE EXPONENT
; FROM BINARY TO ASCII AND PRINT THE RESULT
; 
XOUT:	LDA	EXPO
	DCR	A
XOUT2:	MVI	C,100
	MVI	D,0
	CALL	CONV
	CPI	'0'	;SKIP LEADING ZEROS
	JZ	$+7
	INR	D
	CALL	OUTB
	MOV	A,E
	MVI	C,10
	CALL	CONV
	CPI	'0'
	JNZ	$+7
	DCR	D
	JNZ	$+6
	CALL	OUTB
	MOV	A,E
	ADI	'0'	;ADD ASCII BIAS
	MOV	B,A
	CALL	OUTB
	RET
; 
CONV:	MVI	B,'0'-1
	INR	B
	SUB	C
	JNC	CONV+2
	ADD	C
	MOV	E,A
	MOV	A,B
	RET
; 
; THIS ROUTINE ADDS ASCII BIAS TO A BCD DIGIT
;	AND CALLS THE OUTPUT ROUTINE
; 
NOUT:	MOV	A,M
	ADI	'0'
	MOV	B,A
	CALL	OUTB
	INX	H	
	DCR	C
	RET
; 
; COMMON SYMBOL LOADING ROUTINES
; 
NEG:	MVI	B,'-'
	JMP	OUTB
ZERO:	MVI	B,'0'
	JMP	OUTB
SPACE:	MVI	B,' '
	JMP	OUTB
RADIX:	MVI	B,'.'
	JMP	OUTB
; 
; OUTPUT DRIVER
; 
OUTB:	PUSH	B
	IF	PROCT
	IN	STAT	;STATUS PORT
	ANI	TBE+DAV	;CHECK FOR "ESCAPE"
	JP	OUTB+1
	ANI	DAV
	JZ	OUTB2
	IN	DATA
	ANI	7FH
	CPI	1BH	; ESCAPE
	JZ	READ	;STOP OUTPUT
OUTB2:	MOV	A,B
	CALL	9060H
	ENDIF
	IF	INTEL
	CALL	CSTS
	ORA	A
	JZ	OUTB2
	CALL	CI
	ANI	7FH
	CPI	1BH
	JZ	READ
OUTB2:	MOV	C,B
	CALL	CO
	ENDIF
; 
	CPI	0DH	;CHECK IF CARRIAGE RETURN FOR TERM WIDTH
	JZ	OUTR
	LDA	WIDTH
	MOV	C,A
	LDA	WIDEC
	INR	A	;UPDATE CHAR COUNT
	CMP	C
	JNZ	OUTR+1
	CALL	CRLF	;NEW LINE
OUTR:	XRA	A
	STA	WIDEC
	POP	B
	MOV	A,B
	RET
; 
; OUTPUT A CARRIAGE RETURN, LINE FEED
; FOLLOWED BY TWO DELETES
; 
CRLF:	MVI	B,0DH
	CALL	OUTB
	MVI	B,0AH
	CALL	OUTB
	MVI	B,7FH
	CALL	OUTB
	JMP	OUTB
; 
; INPUT DATA ROUTINE
; 
INB:
	IF	PROCT
	IN	STAT
	ANI	DAV
	JZ	INB
	IN	DATA
	ENDIF
	IF	INTEL
	CALL	CI
	ENDIF
	ANI	7FH
	MOV	B,A
	RET
; 
; GLOBAL PARAMETERS
; 
INFES:	DS	1
WIDTH:	DS	1
USRST:	DS	2
ADDS:	DS	2
ADD:	DS	2
BCADD:	DS	2
; 
WIDEC:	DS	1
TEMP:	DS	1
OPST:	DS	1
OPSTR:	DS	1
ECNT:	DS	1
SIGN:	DS	1
DEST:	DS	2
IBUF:	DS	73
ABUF:	DS	DIGIT*2+2
XSIGN:	DS	1
EXPO:	DS	1
FES:	DS	1
SQR:	DS	1
REGA:	DS	DIGIT+2
REGB:	DS	DIGIT+2
REGC:	DS	DIGIT+2
REGD:	DS	DIGIT+2
REGE:	DS	DIGIT+2
BC:	DS	DIGIT+2
HL:	DS	DIGIT+2
DE:	DS	DIGIT+2
S3:	DS	DIGIT+2
S4:	DS	DIGIT+2
MAXCL	EQU	$-OPST
; 
	DS	(DIGIT+2)*10
	DS	50
STACK:	DW	0
; 
FADD:	PUSH	B
	CALL	L0F77
	MVI	C,000H
L0DB8:	DCX	D
	XCHG	
	LDA	L0FFE
	XRA	M
	MOV	B,A
	XCHG	
	LDAX	D
	DCX	D
	XRA	C
	STA	L0FFE
	MOV	A,B
	ANI	001H
	JNZ	L0E05
	CALL	L0DE3
	JNC	L0DDE
	MVI	B,004H
	CALL	L0FBE
	LXI	H,EXP
	INR	M
	JZ	L0FE4
L0DDE:	POP	B
	CALL	L0FB0
	RET	
L0DE3:	LXI	H,BUF+DIGIT-1
	MVI	B,DIGIT
	ORA	A
L0DE9:	LDAX	D
	ADC	M
	DAA	
	MOV	M,A
	DCX	H
	DCX	D
	DCR	B
	JNZ	L0DE9
	RNC	
	INR	M
	RET	
FSUB:	PUSH	B
	CALL	L0F77
	LDA	L0FFE
	XRI	001H
	STA	L0FFE
	JMP	L0DB8
L0E05:	CALL	L0E51
	LXI	H,L0FFE
	JNC	L0E15
	MOV	A,M
	XRI	001H
	MOV	M,A
	JMP	L0E25
L0E15:	DCX	H
	MVI	B,DIGIT
L0E18:	MVI	A,09AH
	SBB	M
	ADI	000H
	DAA	
	MOV	M,A
	DCX	H
	DCR	B
	CMC	
	JNZ	L0E18
L0E25:	LXI	H,BUF
	XRA	A
	MVI	C,DIGIT
L0E2B:	CMP	M
	JNZ	L0E3A
	INX	H
	DCR	C
	JNZ	L0E2B
	STA	EXP
	JMP	L0DDE
L0E3A:	LDA	BUF
	ANI	0F0H
	JNZ	L0DDE
	LXI	H,EXP
	DCR	M
	JZ	L0FEC
	MVI	B,004H
	CALL	L0FD1
	JMP	L0E3A
L0E51:	LXI	H,BUF+DIGIT-1
	MVI	B,DIGIT
	STC	
L0E57:	MVI	A,099H
	ACI	000H
	XCHG	
	SUB	M
	XCHG	
	ADD	M
	DAA	
	MOV	M,A
	DCX	H
	DCX	D
	DCR	B
	JNZ	L0E57
	RET	
FMULT:	PUSH	B
	MOV	A,M
	ORA	A
	JZ	L0E82
	LDAX	D
	ORA	A
	JZ	L0E82
	ADD	M
	JC	L0E7D
	JP	L0FEC
	JMP	L0E80
L0E7D:	JM	L0FE4
L0E80:	SUI	080H
L0E82:	STA	EXP
	DCX	D
	DCX	H
	LDAX	D
	XRA	M
	STA	L0FFE
	DCX	H
	DCX	D
	MOV	C,L
	MOV	B,H
	MVI	A,DIGIT+1
	LXI	H,L0FF7
L0E95:	MVI	M,0
	INX	H
	DCR	A
	JNZ	L0E95
	LXI	H,DIGIT+DIGIT
L0E9F:	LDAX	B
L0EA0:	PUSH	H
	ANI	0FH
	PUSH	B
	MOV	C,A
	JZ	L0EB5
L0EA8:	CALL	L0DE3
	XCHG	
	LXI	D,DIGIT
	DAD	D
	XCHG	
	DCR	C
	JNZ	L0EA8
L0EB5:	MVI	B,4
	CALL	L0FBE
	POP	B
	POP	H
	DCR	L
	JZ	L0ECF
	DCR	H
	JP	L0E9F
	INR	H
	INR	H
	LDAX	B
	RAR	
	RAR	
	RAR	
	RAR	
	DCX	B
	JMP	L0EA0
L0ECF:	LDA	BUF
	ANI	0F0H
	JNZ	L0DDE
	MVI	B,004H
	LXI	H,EXP
	DCR	M
	JZ	L0FEC
	CALL	L0FD1
	JMP	L0DDE
FDIV:	PUSH	B
	MOV	A,M
	ORA	A
	JZ	L0FF1
	LDAX	D
	ORA	A
	JZ	L0FE9
	SUB	M
	JC	L0EFB
	JM	L0FE4
	JMP	L0EFE
L0EFB:	JP	L0FEC
L0EFE:	ADI	081H
	STA	EXP
	XCHG	
	CALL	L0F9B
	POP	B
	XCHG	
	LDA	L0FFE
	DCX	H
	XRA	M
	STA	L0FFE
	XCHG	
	DCX	D
	LXI	H,-DIGIT-1
	DAD	B
	MOV	B,H
	MOV	C,L
L0F19:	MVI	L,DIGIT+DIGIT
L0F1B:	PUSH	B
	PUSH	H
	MVI	C,0
L0F1F:	CALL	L0E51
	MOV	A,M
	CMC	
	SBI	0
	MOV	M,A
	RAR	
	LXI	H,DIGIT
	DAD	D
	XCHG	
	INR	C
	RAL	
	JNC	L0F1F
	CALL	L0DE3
	LXI	H,DIGIT
	DAD	D
	XCHG	
	PUSH	B
	MVI	B,4
	CALL	L0FD1
	POP	B
	DCR	C
	POP	H
	MOV	H,C
	POP	B
	MOV	A,L
	JNZ	L0F58
	CPI	DIGIT+DIGIT
	JNZ	L0F58
	LXI	H,EXP
	DCR	M
	CZ	L0FEC
	JMP	L0F19
L0F58:	RAR	
	MOV	A,H
	JNC	L0F68
	LDAX	B
	RLC	
	RLC	
	RLC	
	RLC	
	ADD	H
	STAX	B
	INX	B
	JMP	L0F69
L0F68:	STAX	B
L0F69:	DCR	L
	JNZ	L0F1B
	LDA	L0FFE
	STAX	B
	LDA	EXP
	INX	B
	STAX	B
	RET	
L0F77:	LDAX	D
	SUB	M
	MVI	C,000H
	JNC	L0F82
	INR	C
	XCHG	
	CMA	
	INR	A
L0F82:	MOV	B,A
	LDAX	D
	STA	EXP
	MOV	A,B
	CPI	DIGIT+DIGIT
	JC	L0F8F
	MVI	A,DIGIT+DIGIT
L0F8F:	RLC	
	RLC	
	MOV	B,A
	PUSH	B
	CALL	L0F9B
	CALL	L0FBE
	POP	B
	RET	
L0F9B:	PUSH	D
	LXI	D,L0FFE
	MVI	C,DIGIT+1
	DCX	H
L0FA2:	MOV	A,M
	STAX	D
	DCX	H
	DCX	D
	DCR	C
	JNZ	L0FA2
	XRA	A
	STAX	D
	DCX	D
	STAX	D
	POP	D
	RET	
L0FB0:	LXI	H,EXP
	MVI	E,DIGIT+2
L0FB5:	MOV	A,M
	STAX	B
	DCX	B
	DCX	H
	DCR	E
	JNZ	L0FB5
	RET	
L0FBE:	LXI	H,BUF-1
	DCR	B
	RM	
	ORA	A
	MVI	C,DIGIT+1
L0FC6:	MOV	A,M
	RAR	
	MOV	M,A
	INX	H
	DCR	C
	JNZ	L0FC6
	JMP	L0FBE
L0FD1:	LXI	H,BUF+DIGIT-1
	DCR	B
	RM	
	ORA	A
	MVI	C,DIGIT+1
L0FD9:	MOV	A,M
	RAL	
	MOV	M,A
	DCX	H
	DCR	C
	JNZ	L0FD9
	JMP	L0FD1
L0FE4:	MVI	A,001H
L0FE6:	STA	ERRI
L0FE9:	INX	SP
	INX	SP
	RET	
L0FEC:	MVI	A,-1
	JMP	L0FE6
L0FF1:	MVI	A,2
	JMP	L0FE6
ERRI:	DB	0	
L0FF7:	DB	0	
BUF:	DS	DIGIT
L0FFE:	DB	0
EXP:	DB	84H
	END
C:	MVI	A,-1
	JMP	L0FE6
L0FF1:	MVI	A,2
	JMP	L0FE6
ERRI:	DB	0