FLOATING_POINT_OUTPUT:	; Output the number, format is in location 25
	;
	; IF FORMAT = 00 - FREE FLOATING
	;           = FX - EXPONENTIAL (X IS THE NUMBER OF SIG DIGITS)
	;           = NX - N = NUM BEFORE RADIX, X = NUM AFTER RADIX
	;                  N + X = 8 MAX
	;
	;***************************************************************
	;
	ACALL	MDES1		;GET THE NUMBER TO OUTPUT, R0 IS POINTER
	ACALL	POP_AND_EXIT	;OUTPUT POPS THE STACK
	MOV	A,R7
	MOV	R6,A		;PUT THE EXPONENT IN R6
	ACALL	UNPACK_R0	;UNPACK THE NUMBER
	MOV	R0,#FP_NIB1	;POINT AT THE NUMBER
	MOV	A,FORMAT	;GET THE FORMAT
	MOV	R3,A		;SAVE IN CASE OF EXP FORMAT
	JZ	FREE		;FREE FLOATING?
	CJNE	A,#0F0H,$+3	;SEE IF EXPONENTIAL
	JNC	EXPOUT
	;
	; If here, must be integer USING format
	;
	MOV	A,R6		;GET THE EXPONENT
	JNZ	$+4
	MOV	R6,#80H
	MOV	A,R3		;GET THE FORMAT
	SWAP	A		;SPLIT INTEGER AND FRACTION
	ANL	A,#0FH
	MOV	R2,A		;SAVE INTEGER
	ACALL	NUM_LT		;GET THE NUMBER OF INTEGERS
	XCH	A,R2		;FLIP FOR SUBB
	CLR	C
	SUBB	A,R2
	MOV	R7,A
	JNC	$+8
	MOV	R5,#'?'		;OUTPUT A QUESTION MARK
	ACALL	SOUT1		;NUMBER IS TOO LARGE FOR FORMAT
	AJMP	FREE
	CJNE	R2,#00,USING0	;SEE IF ZERO
	DEC	R7
	ACALL	SS7
	ACALL	ZOUT		;OUTPUT A ZERO
	SJMP	USING1
	;
USING0:	ACALL	SS7		;OUTPUT SPACES, IF NEED TO
	MOV	A,R2		;OUTPUT DIGITS
	MOV	R7,A
	ACALL	OUTR0
	;
USING1:	MOV	A,R3
	ANL	A,#0FH		;GET THE NUMBER RIGHT OF DP
	MOV	R2,A		;SAVE IT
	JZ	PMT1		;EXIT IF ZERO
	ACALL	ROUT		;OUTPUT DP
	ACALL	NUM_RT
	CJNE	A,2,USINGX	;COMPARE A TO R2
	;
USINGY:	MOV	A,R2
	AJMP	Z7R7
	;
USINGX:	JNC	USINGY
	;
USING2:	XCH	A,R2
	CLR	C
	SUBB	A,R2
	XCH	A,R2
	ACALL	Z7R7		;OUTPUT ZEROS IF NEED TO
	MOV	A,R2
	MOV	R7,A
	AJMP	OUTR0
	;
	; First, force exponential output, if need to
	;
FREE:	MOV	A,R6		;GET THE EXPONENT
	JNZ	FREE1		;IF ZERO, PRINT IT
	ACALL	SOUT
	AJMP	ZOUT
	;
FREE1:	MOV	R3,#0F0H	;IN CASE EXP NEEDED
	MOV	A,#80H-DIGIT-DIGIT-1
	ADD	A,R6
	JC	EXPOUT
	SUBB	A,#0F7H
	JC	EXPOUT
	;
	; Now, just print the number
	;
	ACALL	SINOUT		;PRINT THE SIGN OF THE NUMBER
	ACALL	NUM_LT		;GET THE NUMBER LEFT OF DP
	CJNE	A,#8,FREE4
	AJMP	OUTR0
	;
FREE4:	ACALL	OUTR0
	ACALL	ZTEST		;TEST FOR TRAILING ZEROS
	JZ	U_RET		;DONE IF ALL TRAILING ZEROS
	ACALL	ROUT		;OUTPUT RADIX
	;
FREE2:	MOV	R7,#1		;OUTPUT ONE DIGIT
	ACALL	OUTR0
	JNZ	U_RET
	ACALL	ZTEST
	JZ	U_RET
	SJMP	FREE2		;LOOP
	;
EXPOUT:	ACALL	SINOUT		;PRINT THE SIGN
	MOV	R7,#1		;OUTPUT ONE CHARACTER
	ACALL	OUTR0
	ACALL	ROUT		;OUTPUT RADIX
	MOV	A,R3		;GET FORMAT
	ANL	A,#0FH		;STRIP INDICATOR
	JZ	EXPOTX
	;
	MOV	R7,A		;OUTPUT THE NUMBER OF DIGITS
	DEC	R7		;ADJUST BECAUSE ONE CHAR ALREADY OUT
	ACALL	OUTR0
	SJMP	EXPOT4
	;
EXPOTX:	ACALL	FREE2		;OUTPUT UNTIL TRAILING ZEROS
	;
EXPOT4:	ACALL	SOUT		;OUTPUT A SPACE
	MOV	R5,#'E'
	ACALL	SOUT1		;OUTPUT AN E
	MOV	A,R6		;GET THE EXPONENT
	JZ	XOUT0		;EXIT IF ZERO
	DEC	A		;ADJUST FOR THE DIGIT ALREADY OUTPUT
	CJNE	A,#80H,XOUT2	;SEE WHAT IT IS
	;
XOUT0:	ACALL	SOUT
	CLR	A
	SJMP	XOUT4
	;
XOUT2:	JC	XOUT3		;NEGATIVE EXPONENT
	MOV	R5,#'+'		;OUTPUT A PLUS SIGN
	ACALL	SOUT1
	SJMP	XOUT4
	;
XOUT3:	ACALL	MOUT
	CPL	A		;FLIP BITS
	INC	A		;BUMP
	;
XOUT4:	CLR	ACC.7
	MOV	R0,A
	MOV	R2,#0
	MOV	R1,#LOW CONVT	;CONVERSION LOCATION
	MOV	R3,#HIGH CONVT
	ACALL	CONVERT_BINARY_TO_ASCII_STRING
	MOV	R0,#LOW CONVT	;NOW, OUTPUT EXPONENT
	;
EXPOT5:	MOVX	A,@R0		;GET THE CHARACTER
	MOV	R5,A		;OUTPUT IT
	ACALL	SOUT1
	INC	R0		;BUMP THE POINTER
	MOV	A,R0		;GET THE POINTER
	CJNE	A,R1B0,EXPOT5	;LOOP
	;
U_RET:	RET			;EXIT
	;
OUTR0:	; Output the characters pointed to by R0, also bias ascii
	;
	MOV	A,R7		;GET THE COUNTER
	JZ	OUTR		;EXIT IF DONE
	MOV	A,@R0		;GET THE NUMBER
	ORL	A,#30H		;ASCII BIAS
	INC	R0		;BUMP POINTER AND COUNTER
	DEC	R7
	MOV	R5,A		;PUT CHARACTER IN OUTPUT REGISTER
	ACALL	SOUT1		;OUTPUT THE CHARACTER
	CLR	A		;JUST FOR TEST
	CJNE	R0,#FP_NIB8+1,OUTR0
	MOV	A,#55H		;KNOW WHERE EXIT OCCURED
	;
OUTR:	RET
	;
ZTEST:	MOV	R1,R0B0		;GET POINTER REGISTER
	;
ZT0:	MOV	A,@R1		;GET THE VALUE
	JNZ	ZT1
	INC	R1		;BUMP POINTER
	CJNE	R1,#FP_NIB8+1,ZT0
	;
ZT1:	RET
	;
NUM_LT:	MOV	A,R6		;GET EXPONENT
	CLR	C		;GET READY FOR SUBB
	SUBB	A,#80H		;SUB EXPONENT BIAS
	JNC	NL1		;OK IF NO CARRY
	CLR	A		;NO DIGITS LEFT
	;
NL1:	MOV	R7,A		;SAVE THE COUNT
	RET
	;
NUM_RT:	CLR	C		;SUBB AGAIN
	MOV	A,#80H		;EXPONENT BIAS
	SUBB	A,R6		;GET THE BIASED EXPONENT
	JNC	NR1
	CLR	A
	;
NR1:	RET			;EXIT
	;
SPACE7:	MOV	A,R7		;GET THE NUMBER OF SPACES
	JZ	NR1		;EXIT IF ZERO
	ACALL	SOUT		;OUTPUT A SPACE
	DEC	R7		;BUMP COUNTER
	SJMP	SPACE7		;LOOP
	;
Z7R7:	MOV	R7,A
	;
ZERO7:	MOV	A,R7		;GET COUNTER
	JZ	NR1		;EXIT IF ZERO
	ACALL	ZOUT		;OUTPUT A ZERO
	DEC	R7		;BUMP COUNTER
	SJMP	ZERO7		;LOOP
	;
SS7:	ACALL	SPACE7
	;
SINOUT:	MOV	A,R4		;GET THE SIGN
	JZ	SOUT		;OUTPUT A SPACE IF ZERO
	;
MOUT:	MOV	R5,#'-'
	SJMP	SOUT1		;OUTPUT A MINUS IF NOT
	;
ROUT:	MOV	R5,#'.'		;OUTPUT A RADIX
	SJMP	SOUT1
	;
ZOUT:	MOV	R5,#'0'		;OUTPUT A ZERO
	SJMP	SOUT1
	;
SOUT:	MOV	R5,#' '		;OUTPUT A SPACE
	;
SOUT1:	AJMP	R5OUT
	;
$EJECT
	;***************************************************************
	;
CONVERT_ASCII_STRING_TO_BINARY:
	;
	;DPTR POINTS TO ASCII STRING
	;PUT THE BINARY NUMBER IN R2:R0, ERROR IF >64K
	;
	;***************************************************************
	;
CASB:	ACALL	HEXSCAN		;SEE IF HEX NUMBER
	MOV	ADD_IN,C	;IF ADD_IN IS SET, THE NUMBER IS HEX
	ACALL	GET_DIGIT_CHECK
	CPL	C		;FLIP FOR EXIT
	JC	RCASB
	MOV	R3,#00H		;ZERO R3:R1 FOR LOOP
	MOV	R1,#00H
	SJMP	CASB5
	;
CASB2:	INC	DPTR
	MOV	R0B0,R1		;SAVE THE PRESENT CONVERTED VALUE
	MOV	R0B0+2,R3	;IN R2:R0
	ACALL	GET_DIGIT_CHECK
	JC	CASB5
	JNB	ADD_IN,RCASB	;CONVERSION COMPLETE
	ACALL	HEX_CHECK	;SEE IF HEX NUMBER
	JC	CASB4		;PROCEED IF GOOD
	INC	DPTR		;BUMP PAST H
	SJMP	RCASB
	;
CASB4:	ADD	A,#9		;ADJUST HEX ASCII BIAS
	;
CASB5:	MOV	B,#10
	JNB	ADD_IN,CASB6
	MOV	B,#16		;HEX MODE
	;
CASB6:	ACALL	MULNUM		;ACCUMULATE THE DIGITS
	JNC	CASB2		;LOOP IF NO CARRY
	;
RCASB:	CLR	A		;RESET ACC
	MOV	ACC.OVERFLOW,C	;IF OVERFLOW, SAY SO
	RET			;EXIT
	;
$EJECT
	;
MULNUM10:MOV	B,#10
	;
	;***************************************************************
	;
MULNUM:	; Take the next digit in the acc (masked to 0FH)
	; accumulate in R3:R1
	;
	;***************************************************************
	;
	PUSH	ACC		;SAVE ACC
	PUSH	B		;SAVE MULTIPLIER
	MOV	A,R1		;PUT LOW ORDER BITS IN ACC
	MUL	AB		;DO THE MULTIPLY
	MOV	R1,A		;PUT THE RESULT BACK
	MOV	A,R3		;GET THE HIGH ORDER BYTE
	MOV	R3,B		;SAVE THE OVERFLOW
	POP	B		;GET THE MULTIPLIER
	MUL	AB		;DO IT
	MOV	C,OV		;SAVE OVERFLOW IN F0
	MOV	F0,C
	ADD	A,R3		;ADD OVERFLOW TO HIGH RESULT
	MOV	R3,A		;PUT IT BACK
	POP	ACC		;GET THE ORIGINAL ACC BACK
	ORL	C,F0		;OR CARRY AND OVERFLOW
	JC	MULX		;NO GOOD IF THE CARRY IS SET
	;
MUL11:	ANL	A,#0FH		;MASK OFF HIGH ORDER BITS
	ADD	A,R1		;NOW ADD THE ACC
	MOV	R1,A		;PUT IT BACK
	CLR	A		;PROPAGATE THE CARRY
	ADDC	A,R3
	MOV	R3,A		;PUT IT BACK
	;
MULX:	RET			;EXIT WITH OR WITHOUT CARRY
	;
	;***************************************************************
	;
CONVERT_BINARY_TO_ASCII_STRING:
	;
	;R3:R1 contains the address of the string
	;R2:R0 contains the value to convert
	;DPTR, R7, R6, and ACC gets clobbered
	;
	;***************************************************************
	;
	CLR	A		;NO LEADING ZEROS
	MOV	DPTR,#10000	;SUBTRACT 10000
	ACALL	RSUB		;DO THE SUBTRACTION
	MOV	DPTR,#1000	;NOW 1000
	ACALL	RSUB
	MOV	DPTR,#100	;NOW 100
	ACALL	RSUB
	MOV	DPTR,#10	;NOW 10
	ACALL	RSUB
	MOV	DPTR,#1		;NOW 1
	ACALL	RSUB
	JZ	RSUB2		;JUMP OVER RET
	;
RSUB_R:	RET
	;
RSUB:	MOV	R6,#-1		;SET UP THE COUNTER
	;
RSUB1:	INC	R6		;BUMP THE COUNTER
	XCH	A,R2		;DO A FAST COMPARE
	CJNE	A,DPH,$+3
	XCH	A,R2
	JC	FAST_DONE
	XCH	A,R0		;GET LOW BYTE
	SUBB	A,DPL		;SUBTRACT, CARRY IS CLEARED
	XCH	A,R0		;PUT IT BACK
	XCH	A,R2		;GET THE HIGH BYTE
	SUBB	A,DPH		;ADD THE HIGH BYTE
	XCH	A,R2		;PUT IT BACK
	JNC	RSUB1		;LOOP UNTIL CARRY
	;
	XCH	A,R0
	ADD	A,DPL		;RESTORE R2:R0
	XCH	A,R0
	XCH	A,R2
	ADDC	A,DPH
	XCH	A,R2
	;
FAST_DONE:
	;
	ORL	A,R6		;OR THE COUNT VALUE
	JZ	RSUB_R		;RETURN IF ZERO
	;
RSUB2:	MOV	A,#'0'		;GET THE ASCII BIAS
	ADD	A,R6		;ADD THE COUNT
	;
RSUB4:	MOV	P2,R3		;SET UP P2
	MOVX	@R1,A		;PLACE THE VALUE IN MEMORY
	INC	R1
	CJNE	R1,#00H,RSUB3	;SEE IF RAPPED AROUND
	INC	R3		;BUMP HIGH BYTE
	;
RSUB3:	RET			;EXIT
	;
$EJECT
	;***************************************************************
	;
HEXOUT:	; Output the hex number in R3:R1, supress leading zeros, if set
	;
	;***************************************************************
	;
	ACALL	SOUT		;OUTPUT A SPACE
	MOV	C,ZSURP		;GET ZERO SUPPRESSION BIT
	MOV	ADD_IN,C
	MOV	A,R3		;GET HIGH NIBBLE AND PRINT IT
	ACALL	HOUTHI
	MOV	A,R3
	ACALL	HOUTLO
	;
HEX2X:	CLR	ADD_IN		;DON'T SUPPRESS ZEROS
	MOV	A,R1		;GET LOW NIBBLE AND PRINT IT
	ACALL	HOUTHI
	MOV	A,R1
	ACALL	HOUTLO
	MOV	R5,#'H'		;OUTPUT H TO INDICATE HEX MODE
	;
SOUT_1:	AJMP	SOUT1
	;
HOUT1:	CLR	ADD_IN		;PRINTED SOMETHING, SO CLEAR ADD_IN
	ADD	A,#90H		;CONVERT TO ASCII
	DA	A
	ADDC	A,#40H
	DA	A		;GOT IT HERE
	MOV	R5,A		;OUTPUT THE BYTE
	SJMP	SOUT_1
	;
HOUTHI:	SWAP	A		;SWAP TO OUTPUT HIGH NIBBLE
	;
HOUTLO:	ANL	A,#0FH		;STRIP
	JNZ	HOUT1		;PRINT IF NOT ZERO
	JNB	ADD_IN,HOUT1	;OUTPUT A ZERO IF NOT SUPRESSED
	RET
	;
$EJECT
	;
GET_DIGIT_CHECK:	; Get a character, then check for digit
	;
	ACALL	GET_DPTR_CHARACTER
	;
DIGIT_CHECK:	;CHECK FOR A VALID ASCII DIGIT, SET CARRY IF FOUND
	;
	CJNE	A,#'9'+1,$+3	;SEE IF ASCII 9 OR LESS
	JC	DC1
	RET
	;
DC1:	CJNE	A,#'0',$+3	;SEE IF ASCII 0 OR GREATER
	CPL	C
	RET
	;

r5out:	push	acc		; me
	mov	a,r5		; me
	call	sndchr		; me
	pop	acc		; me
	ret			; me
;
SQ_ERR:	JMP	BADPRM		; me

	;***************************************************************
	;
IFIX:	; Convert a floating point number to an integer, put in R3:R1
	;
	;***************************************************************
	;
	CLR	A		;RESET THE START
	MOV	R3,A
	MOV	R1,A
	MOV	R0,ARG_STACK	;GET THE ARG STACK
	MOV	P2,#ARG_STACK_PAGE
	MOVX	A,@R0		;READ EXPONENT
	CLR	C
	SUBB	A,#81H		;BASE EXPONENT
	MOV	R4,A		;SAVE IT
	DEC	R0		;POINT AT SIGN
	MOVX	A,@R0		;GET THE SIGN
	JNZ	SQ_ERR		;ERROR IF NEGATIVE
	JC	INC_ASTKA	;EXIT IF EXPONENT IS < 81H
	INC	R4		;ADJUST LOOP COUNTER
	MOV	A,R0		;BUMP THE POINTER REGISTER
	SUBB	A,#FP_NUMBER_SIZE-1
	MOV	R0,A
	;
I2:	INC	R0		;POINT AT DIGIT
	MOVX	A,@R0		;GET DIGIT
	SWAP	A		;FLIP
	CALL	FP_BASE+20	;ACCUMULATE
	JC	SQ_ERR
	DJNZ	R4,$+4
	SJMP	INC_ASTKA
	MOVX	A,@R0		;GET DIGIT
	CALL	FP_BASE+20
	JC	SQ_ERR
	DJNZ	R4,I2
;
; Pop the ARG STACK and check for overflow
INC_ASTKA:
	MOV	A,#FP_NUMBER_SIZE	;number to pop
	SJMP	SETREG+1
;
;Push ARG STACK and check for underflow
DEC_ASTKA:
	MOV	A,#-FP_NUMBER_SIZE
	ADD	A,ARG_STACK
	CJNE	A,#0,$+3
	JC	E4YY
	MOV	ARG_STACK,A
	MOV	R1,A
	MOV	R3,#ARG_STACK_PAGE
SRT:	RET
;
POPAS:	ACALL	INC_ASTKA
	AJMP	VARCOP		;COPY THE VARIABLE
;
PUSHAS:	ACALL	DEC_ASTKA
	AJMP	VARCOP
;
SETREG:	CLR	A		;DON'T POP ANYTHING
	MOV	R0,ARG_STACK
	MOV	R2,#ARG_STACK_PAGE
	MOV	P2,R2
	ADD	A,R0
	JC	E4YY
	MOV	ARG_STACK,A
	MOVX	A,@R0
A_D:	RET
	;
DEC3210:DEC	R0		;BUMP THE POINTER
	CJNE	R0,#0FFH,$+4	;SEE IF OVERFLOWED
	DEC	R2		;BUMP THE HIGH BYTE
	DEC	R1		;BUMP THE POINTER
	CJNE	R1,#0FFH,DEC_R	;SEE IF OVERFLOWED
	DEC	R3		;CHANGE THE HIGH BYTE
DEC_R:	RET			;EXIT
;


;Routine to copy bottom arg on stack to address in DPTR.
;Does not work over page boundaries.
;Bugs fixed by JKJ/IRC
MOVAS:  ACALL   SETREG          ;SET UP R2:R0
        MOV     R3,DPH
        MOV     R1,DPL
M_C:    MOV     P2,R2           ;SET UP THE PORTS
	MOVX	A,@R0		;READ THE VALUE
	MOV	P2,R3		;PORT TIME AGAIN
	MOVX	@R1,A		;SAVE IT
        INC     R0
        INC     R1
        DJNZ    R4,M_C          ;LOOP
	RET			;EXIT


; VARCOP - Copy a variable from R2:R0 to R3:R1
VARCOP:	MOV	R4,#FP_NUMBER_SIZE	;LOAD THE LOOP COUNTER
V_C:	MOV	P2,R2		;SET UP THE PORTS
	MOVX	A,@R0		;READ THE VALUE
	MOV	P2,R3		;PORT TIME AGAIN
	MOVX	@R1,A		;SAVE IT
        ACALL   DEC3210
	DJNZ	R4,V_C		;LOOP
	RET			;EXIT
;
E4YY:	MOV	DPTR,#EXA
	JMP	PRTERR		; me

	; integer operator - INT
AINT:	ACALL	SETREG		;SET UP THE REGISTERS, CLEAR CARRY
	SUBB	A,#129		;SUBTRACT EXPONENT BIAS
	JNC	AI1		;JUMP IF ACC > 81H
	;
	; Force the number to be a zero
	;
	ACALL	INC_ASTKA	;BUMP THE STACK
	;
P_Z:	MOV	DPTR,#ZRO	;PUT ZERO ON THE STACK
	AJMP	PUSHC
ZRO:	DB	0,0,0,0,0,0
	;
AI1:	SUBB	A,#7
	JNC	AI3
	CPL	A
	INC	A
	MOV	R3,A
	DEC	R0		;POINT AT SIGN
	;
AI2:	DEC	R0		;NOW AT LSB'S
	MOVX	A,@R0		;READ BYTE
	ANL	A,#0F0H		;STRIP NIBBLE
	MOVX	@R0,A		;WRITE BYTE
	DJNZ	R3,$+3
	RET
	CLR	A
	MOVX	@R0,A		;CLEAR THE LOCATION
	DJNZ	R3,AI2
AI3:	RET			;EXIT
	;
	; PUSHC - Push constant pointed by DPTR on to the arg stack
PUSHC:	ACALL	DEC_ASTKA
	MOV	P2,R3
	MOV	R3,#FP_number_SIZe	;LOOP COUNTER
PCL:	CLR	A		;SET UP A
	MOVC	A,@A+DPTR	;LOAD IT
	MOVX	@R1,A		;SAVE IT
	INC	DPTR		;BUMP POINTERS
	DEC	R1
	DJNZ	R3,PCL		;LOOP
	RET			;EXIT
;

EXA:	DB	'A-STACK',0