PACK0:	INC	R0		;POINT AT FP_ACC1
	;
PACK1:	MOV	A,#8		;ADJUST NIBBLE POINTER
	MOV	R1,A
	ADD	A,R0
	MOV	R0,A
	CJNE	@R0,#5,$+3	;SEE IF ADJUSTING NEEDED
	JC	PACK3+1
	;
PACK2:	SETB	C
	CLR	A
	DEC	R0
	ADDC	A,@R0
	DA	A
	XCHD	A,@R0		;SAVE THE VALUE
	JNB	ACC.4,PACK3
	DJNZ	R1,PACK2
	;
	DEC	R0
	MOV	@R0,#1
	ACALL	INC_FP_EXP
	SJMP	PACK4
	;
PACK3:	DEC	R1
	MOV	A,R1
	CLR	C
	XCH	A,R0
	SUBB	A,R0
	MOV	R0,A
	;
PACK4:	MOV	R1,#FP_DIG12
	;
	; Now, pack
	;
PLOOP:	MOV	A,@R0
	SWAP	A		;FLIP THE DIGITS
	INC	R0
	XCHD	A,@R0
	ORL	6,A		;ACCUMULATE THE OR'ED DIGITS
	MOV	@R1,A
	INC	R0
	INC	R1
	CJNE	R1,#FP_SIGN,PLOOP
	MOV	A,R6
	JNZ	STORE_ALIGN_TEST_AND_EXIT
	MOV	FP_EXP,#0	;ZERO EXPONENT
	;
	;**************************************************************
	;
STORE_ALIGN_TEST_AND_EXIT:	;Save the number align carry and exit
	;
	;**************************************************************
	;
	ACALL	LOAD_POINTERS
	MOV	ARG_STACK,R1	;SET UP THE NEW STACK
	MOV	R0,#FP_EXP
	;
	; Now load the numbers
	;
STORE2:	MOV	A,@R0
	MOVX	@R1,A		;SAVE THE NUMBER
	DEC	R0
	DEC	R1
	CJNE	R0,#FP_CARRY,STORE2
	;
	CLR	A		;NO ERRORS
	;
PRET:	RET			;EXIT
	;
$EJECT
INC_FP_EXP:
	;
	INC	FP_EXP
	MOV	A,FP_EXP
	JNZ	PRET		;EXIT IF NOT ZERO
	POP	ACC		;WASTE THE CALLING STACK
	POP	ACC
	AJMP	OVERFLOW_AND_EXIT
	;
;***********************************************************************
;
UNPACK_R0:	; Unpack BCD digits and load into nibble locations
;
;***********************************************************************
	;
	PUSH	R1B0
	MOV	R1,#FP_NIB8
	;
ULOOP:	MOVX	A,@R0
	ANL	A,#0FH
	MOV	@R1,A		;SAVE THE NIBBLE
	MOVX	A,@R0
	SWAP	A
	ANL	A,#0FH
	DEC	R1
	MOV	@R1,A		;SAVE THE NIBBLE AGAIN
	DEC	R0
	DEC	R1
	CJNE	R1,#FP_NIB1-1,ULOOP
	;
	POP	R1B0
	;
LOAD7:	RET
	;
$EJECT
	;**************************************************************
	;
OVERFLOW_AND_EXIT:	;LOAD 99999999 E+127,  SET OV BIT, AND EXIT
	;
	;**************************************************************
	;
	MOV	R0,#FP_DIG78
	MOV	A,#99H
	;
OVE1:	MOV	@R0,A
	DEC	R0
	CJNE	R0,#FP_CARRY,OVE1
	;
	MOV	FP_EXP,#0FFH
	ACALL	STORE_ALIGN_TEST_AND_EXIT
	;
	SETB	ACC.OVERFLOW
	RET
	;
$EJECT
	;**************************************************************
	;
UNDERFLOW_AND_EXIT:	;LOAD 0, SET UF BIT, AND EXIT
	;
	;**************************************************************
	;
	ACALL	ZERO_AND_EXIT
	CLR	A
	SETB	ACC.UNDERFLOW
	RET
	;
	;**************************************************************
	;
ZERO_AND_EXIT:		;LOAD 0, SET ZERO BIT, AND EXIT
	;
	;**************************************************************
	;
	ACALL	FP_CLEAR
	ACALL	STORE_ALIGN_TEST_AND_EXIT
	SETB	ACC.ZERO
	RET			;EXIT
	;
	;**************************************************************
	;
FP_CLEAR:
	;
	; Clear internal storage
	;
	;**************************************************************
	;
	CLR	A
	MOV	R0,#FP_ACC8+1
	;
FPC1:	MOV	@R0,A
	DEC	R0
	CJNE	R0,#FP_TEMP,FPC1
	RET
	;
$EJECT
	;**************************************************************
	;
RIGHT:	; Shift ACCUMULATOR RIGHT the number of nibbles in R7
	; Save the shifted values in R4 if SAVE_ROUND is set
	;
	;**************************************************************
	;
	MOV	R4,#0		;IN CASE OF NO SHIFT
	;
RIGHT1:	CLR	C
	MOV	A,R7		;GET THE DIGITS TO SHIFT
	JZ	RIGHT5-1	;EXIT IF ZERO
	SUBB	A,#2		;TWO TO DO?
	JNC	RIGHT5		;SHIFT TWO NIBBLES
	;
	; Swap one nibble then exit
	;
RIGHT3:	PUSH	R0B0		;SAVE POINTER REGISTER
	PUSH	R1B0
	;
	MOV	R1,#FP_DIG78	;LOAD THE POINTERS
	MOV	R0,#FP_DIG56
	MOV	A,R4		;GET THE OVERFLOW REGISTER
	XCHD	A,@R1		;GET DIGIT 8
	SWAP	A		;FLIP FOR LOAD
	MOV	R4,A
	;
RIGHTL:	MOV	A,@R1		;GET THE LOW ORDER BYTE
	XCHD	A,@R0		;SWAP NIBBLES
	SWAP	A		;FLIP FOR STORE
	MOV	@R1,A		;SAVE THE DIGITS
	DEC	R0		;BUMP THE POINTERS
	DEC	R1
	CJNE	R1,#FP_DIG12-1,RIGHTL	;LOOP
	;
	MOV	A,@R1		;ACC = CH8
	SWAP	A		;ACC = 8CH
	ANL	A,#0FH		;ACC = 0CH
	MOV	@R1,A		;CARRY DONE
	POP	R1B0		;EXIT
	POP	R0B0		;RESTORE REGISTER
	RET
	;
RIGHT5:	MOV	R7,A		;SAVE THE NEW SHIFT NUMBER
	CLR	A
	XCH	A,FP_CARRY	;SWAP THE NIBBLES
	XCH	A,FP_DIG12
	XCH	A,FP_DIG34
	XCH	A,FP_DIG56
	XCH	A,FP_DIG78
	MOV	R4,A		;SAVE THE LAST DIGIT SHIFTED
	SJMP	RIGHT1+1
	;
$EJECT
	;***************************************************************
	;
LEFT:	; Shift ACCUMULATOR LEFT the number of nibbles in R7
	;
	;***************************************************************
	;
	MOV	R4,#00H		;CLEAR FOR SOME ENTRYS
	;
LEFT1:	CLR	C
	MOV	A,R7		;GET SHIFT VALUE
	JZ	LEFT5-1		;EXIT IF ZERO
	SUBB	A,#2		;SEE HOW MANY BYTES TO SHIFT
	JNC	LEFT5
	;
LEFT3:	PUSH	R0B0		;SAVE POINTER
	PUSH	R1B0
	MOV	R0,#FP_CARRY
	MOV	R1,#FP_DIG12
	;
	MOV	A,@R0		;ACC=CHCL
	SWAP	A		;ACC = CLCH
	MOV	@R0,A		;ACC = CLCH, @R0 = CLCH
	;
LEFTL:	MOV	A,@R1		;DIG 12
	SWAP	A		;DIG 21
	XCHD	A,@R0
	MOV	@R1,A		;SAVE IT
	INC	R0		;BUMP POINTERS
	INC	R1
	CJNE	R0,#FP_DIG78,LEFTL
	;
	MOV	A,R4
	SWAP	A
	XCHD	A,@R0
	ANL	A,#0F0H
	MOV	R4,A
	;
	POP	R1B0
	POP	R0B0		;RESTORE
	RET			;DONE
	;
LEFT5:	MOV	R7,A		;RESTORE COUNT
	CLR	A
	XCH	A,R4		;GET THE RESTORATION BYTE
	XCH	A,FP_DIG78	;DO THE SWAP
	XCH	A,FP_DIG56
	XCH	A,FP_DIG34
	XCH	A,FP_DIG12
	XCH	A,FP_CARRY
	SJMP	LEFT1+1
	;
$EJECT
MUL_NIBBLE:
	;
	; Multiply the nibble in R7 by the FP_NIB locations
	; accumulate the product in FP_ACC
	;
	; Set up the pointers for multiplication
	;
	ANL	A,#0FH		;STRIP OFF MS NIBBLE
	MOV	R7,A
	MOV	R0,#FP_ACC8
	MOV	R1,#FP_NIB8
	CLR	A
	MOV	FP_ACCX,A
	;
MNLOOP:	DEC	R0		;BUMP POINTER TO PROPAGATE CARRY
	ADD	A,@R0		;ATTEMPT TO FORCE CARRY
	DA	A		;BCD ADJUST
	JNB	ACC.4,MNL0	;DON'T ADJUST IF NO NEED
	DEC	R0		;PROPAGATE CARRY TO THE NEXT DIGIT
	INC	@R0		;DO THE ADJUSTING
	INC	R0		;RESTORE R0
	;
MNL0:	XCHD	A,@R0		;RESTORE INITIAL NUMBER
	MOV	B,R7		;GET THE NUBBLE TO MULTIPLY
	MOV	A,@R1		;GET THE OTHER NIBBLE
	MUL	AB		;DO THE MULTIPLY
	MOV	B,#10		;NOW BCD ADJUST
	DIV	AB
	XCH	A,B		;GET THE REMAINDER
	ADD	A,@R0		;PROPAGATE THE PARTIAL PRODUCTS
	DA	A		;BCD ADJUST
	JNB	ACC.4,MNL1	;PROPAGATE PARTIAL PRODUCT CARRY
	INC	B
	;
MNL1:	INC	R0
	XCHD	A,@R0		;SAVE THE NEW PRODUCT
	DEC	R0
	MOV	A,B		;GET BACK THE QUOTIENT
	DEC	R1
	CJNE	R1,#FP_NIB1-1,MNLOOP
	;
	ADD	A,FP_ACCX	;GET THE OVERFLOW
	DA	A		;ADJUST
	MOV	@R0,A		;SAVE IT
	RET			;EXIT
	;
$EJECT
	;***************************************************************
	;
LOAD_POINTERS:	; Load the ARG_STACK into R0 and bump R1
	;
	;***************************************************************
	;
	MOV	P2,#ARG_STACK_PAGE
	MOV	R0,ARG_STACK
	MOV	A,#FP_NUMBER_SIZE
	ADD	A,R0
	MOV	R1,A
	RET
	;
	;***************************************************************
	;
MUL_DIV_EXP_AND_SIGN:
	;
	; Load the sign into R7, R6. R5 gets the sign for
	; multiply and divide.
	;
	;***************************************************************
	;
	ACALL	FP_CLEAR	;CLEAR INTERNAL MEMORY
	;
MDES1:	ACALL	LOAD_POINTERS	;LOAD REGISTERS
	MOVX	A,@R0		;ARG 1 EXP
	MOV	R7,A		;SAVED IN R7
	MOVX	A,@R1		;ARG 2 EXP
	MOV	R6,A		;SAVED IN R6
	DEC	R0		;BUMP POINTERS TO SIGN
	DEC	R1
	MOVX	A,@R0		;GET THE SIGN
	MOV	R4,A		;SIGN OF ARG1
	MOVX	A,@R1		;GET SIGN OF NEXT ARG
	MOV	R3,A		;SIGN OF ARG2
	XRL	A,R4		;ACC GETS THE NEW SIGN
	MOV	R5,A		;R5 GETS THE NEW SIGN
	;
	; Bump the pointers to point at the LS digit
	;
	DEC	R0
	DEC	R1
	;
	RET
	;
$EJECT
	;***************************************************************
	;
LOADR1_MANTISSA:
	;
	; Load the mantissa of R0 into FP_Digits
	;
	;***************************************************************
	;
	PUSH	R0B0		;SAVE REGISTER 1
	MOV	R0,#FP_DIG78	;SET UP THE POINTER
	;
LOADR1:	MOVX	A,@R1
	MOV	@R0,A
	DEC	R1
	DEC	R0
	CJNE	R0,#FP_CARRY,LOADR1
	;
	POP	R0B0
	RET
	;
$EJECT
	;***************************************************************
	;
HEXSCAN:	; Scan a string to determine if it is a hex number
		; set carry if hex, else carry = 0
	;
	;***************************************************************
	;
	ACALL	GET_DPTR_CHARACTER
	PUSH	DPH
	PUSH	DPL		;SAVE THE POINTER
	;
HEXSC1:	MOVX	A,@DPTR		;GET THE CHARACTER
	ACALL	DIGIT_CHECK	;SEE IF A DIGIT
	JC	HS1		;CONTINUE IF A DIGIT
	ACALL	HEX_CHECK	;SEE IF HEX
	JC	HS1
	;
	CLR	ACC.5		;NO LOWER CASE
	CJNE	A,#'H',HEXDON
	SETB	C
	SJMP	HEXDO1		;NUMBER IS VALID HEX, MAYBE
	;
HEXDON:	CLR	C
	;
HEXDO1:	POP	DPL		;RESTORE POINTER
	POP	DPH
	RET
	;
HS1:	INC	DPTR		;BUMP TO NEXT CHARACTER
	SJMP	HEXSC1		;LOOP
	;
HEX_CHECK:	;CHECK FOR A VALID ASCII HEX, SET CARRY IF FOUND
	;
	CLR	ACC.5		;WASTE LOWER CASE
	CJNE	A,#'F'+1,$+3	;SEE IF F OR LESS
	JC	HC1
	RET
	;
HC1:	CJNE	A,#'A',$+3	;SEE IF A OR GREATER
	CPL	C
	RET
	;
$EJECT
	;
PUSHR2R0:
	; 
	MOV	R3,#HIGH CONVT	;CONVERSION LOCATION
	MOV	R1,#LOW CONVT
	ACALL	CONVERT_BINARY_TO_ASCII_STRING
	MOV	A,#0DH		;A CR TO TERMINATE
	MOVX	@R1,A		;SAVE THE CR
	MOV	DPTR,#CONVT
	;
	; Falls thru to FLOATING INPUT
	;
$EJECT
	;***************************************************************
	;
FLOATING_POINT_INPUT:	; Input a floating point number pointed to by
			; the DPTR
	;
	;***************************************************************
	;
	ACALL	FP_CLEAR	;CLEAR EVERYTHING
	ACALL	GET_DPTR_CHARACTER
	ACALL	PLUS_MINUS_TEST
	MOV	MSIGN,C		;SAVE THE MANTISSA SIGN
	;
	; Now, set up for input loop
	;
	MOV	R0,#FP_ACCC
	MOV	R6,#7FH		;BASE EXPONENT
	SETB	F0		;SET INITIAL FLAG
	;
INLOOP:	ACALL	GET_DIGIT_CHECK
	JNC	GTEST		;IF NOT A CHARACTER, WHAT IS IT?
	ANL	A,#0FH		;STRIP ASCII
	ACALL	STDIG		;STORE THE DIGITS
	;
INLPIK:	INC	DPTR		;BUMP POINTER FOR LOOP
	SJMP	INLOOP		;LOOP FOR INPUT
	;
GTEST:	CJNE	A,#'.',GT1	;SEE IF A RADIX
	JB	FOUND_RADIX,INERR
	SETB	FOUND_RADIX
	CJNE	R0,#FP_ACCC,INLPIK
	SETB	FIRST_RADIX	;SET IF FIRST RADIX
	SJMP	INLPIK		;GET ADDITIONAL DIGITS
	;
GT1:	JB	F0,INERR	;ERROR IF NOT CLEARED
	CJNE	A,#'e',$+5	;CHECK FOR LOWER CASE
	SJMP	$+5
	CJNE	A,#'E',FINISH_UP
	ACALL	INC_AND_GET_DPTR_CHARACTER
	ACALL	PLUS_MINUS_TEST
	MOV	XSIGN,C		;SAVE SIGN STATUS
	ACALL	GET_DIGIT_CHECK
	JNC	INERR
	;
	ANL	A,#0FH		;STRIP ASCII BIAS OFF THE CHARACTER
	MOV	R5,A		;SAVE THE CHARACTER IN R5
	;
GT2:	INC	DPTR
	ACALL	GET_DIGIT_CHECK
	JNC	FINISH1
	ANL	A,#0FH		;STRIP OFF BIAS
	XCH	A,R5		;GET THE LAST DIGIT
	MOV	B,#10		;MULTIPLY BY TEN
	MUL	AB
	ADD	A,R5		;ADD TO ORIGINAL VALUE
	MOV	R5,A		;SAVE IN R5
	JNC	GT2		;LOOP IF NO CARRY
	MOV	R5,#0FFH	;FORCE AN ERROR
	;
FINISH1:MOV	A,R5		;GET THE SIGN
	JNB	XSIGN,POSNUM	;SEE IF EXPONENT IS POS OR NEG
	CLR	C
	SUBB	A,R6
	CPL	A
	INC	A
	JC	FINISH2
	MOV	A,#01H
	RET
	;
POSNUM:	ADD	A,R6		;ADD TO EXPONENT
	JNC	FINISH2
	;
POSNM1:	MOV	A,#02H
	RET
	;
FINISH2:XCH	A,R6		;SAVE THE EXPONENT
	;
FINISH_UP:
	;
	MOV	FP_EXP,R6	;SAVE EXPONENT
	CJNE	R0,#FP_ACCC,$+5
	ACALL	FP_CLEAR	;CLEAR THE MEMORY IF 0
	MOV	A,ARG_STACK	;GET THE ARG STACK
	CLR	C
	SUBB	A,#FP_NUMBER_SIZE+FP_NUMBER_SIZE
	MOV	ARG_STACK,A	;ADJUST FOR STORE
	AJMP	PACK
	;
STDIG:	CLR	F0		;CLEAR INITIAL DESIGNATOR
	JNZ	STDIG1		;CONTINUE IF NOT ZERO
	CJNE	R0,#FP_ACCC,STDIG1
	JNB	FIRST_RADIX,RET_X
	;
DECX:	DJNZ	R6,RET_X
	;
INERR:	MOV	A,#0FFH
	;
RET_X:	RET
	;
STDIG1:	JB	DONE_LOAD,FRTEST
	CLR	FIRST_RADIX
	;
FRTEST:	JB	FIRST_RADIX,DECX
	;
FDTEST:	JB	FOUND_RADIX,FDT1
	INC	R6
	;
FDT1:	JB	DONE_LOAD,RET_X
	CJNE	R0,#FP_ACC8+1,FDT2
	SETB	DONE_LOAD
	;
FDT2:	MOV	@R0,A		;SAVE THE STRIPPED ACCUMULATOR
	INC	R0		;BUMP THE POINTER
	RET			;EXIT
	;
$EJECT
	;***************************************************************
	;
	; I/O utilities
	;
	;***************************************************************
	;
INC_AND_GET_DPTR_CHARACTER:
	;
	INC	DPTR
	;
GET_DPTR_CHARACTER:
	;
	MOVX	A,@DPTR		;GET THE CHARACTER
	CJNE	A,#' ',PMT1	;SEE IF A SPACE
	;
	; Kill spaces
	;
	SJMP	INC_AND_GET_DPTR_CHARACTER
	;
PLUS_MINUS_TEST:
	;
	CJNE	A,#0E3H,$+5	;SEE IF A PLUS, PLUS TOKEN FROM BASIC
	SJMP	PMT3
	CJNE	A,#'+',$+5
	SJMP	PMT3
	CJNE	A,#0E5H,$+5	;SEE IF MINUS, MINUS TOKEN FROM BASIC
	SJMP	PMT2
	CJNE	A,#'-',PMT1
	;
PMT2:	SETB	C
	;
PMT3:	INC	DPTR
	;
PMT1:	RET
	;
$EJECT
	;***************************************************************
	;