BUFERP	RMB	2	Pointer to text buffer
DIGCNT	RMB	1	HOLDS SIG DIGIT COUNT FOR FCONVI
DIGFLG	RMB	1	DIGIT FLAG FOR FCONVI
*
DIGMAX	EQU	10	Max number fo digits allowed
ML	RMB	1	Multiplier digit for FMUL, FDIV
*
MSIGN	RMB	1	Holds sign of result
MEXP	RMB	1	Holds exp, must preceed FAC
FAC1	RMB	1	FAC, Floating accumulator
FAC2	RMB	1
FAC3	RMB	1
FAC4	RMB	1
FAC5	RMB	1
FAC6	RMB	1
FACEXT1	RMB	6	FAC Extention
DPFLAG	RMB	1	Decimal point count for FCONVI
DPCOUNT	RMB	1	Decimal place count for FCONVI
EXPOVF	RMB	1	Exponent overflow flag
CTNB	RMB	1	Holds carry (0..199) to next byte
FACX	RMB	2	Holds pointer to floating ACC
FCVIRT	RMB	2	Return address for floating conversion
LOOPX	RMB	2	2 byte loop counter
	PAGE
*	FLOATING INPUT CONVERSION ROUTINES
*	A,B CONTAIN MAX # OF CHARS TO EAT (INCLUDING BLANKS)
*	X REG CONTAINS POINTER TO CHARACTER STRING TO CONVERT
*	RESULT IS CONVERTED TO FLOATING POINT FORMAT AND OUTPUT TO BO
*	DOES NOT EAT THE CR OR ANY OTHER DELIMITER
*	ROUTINE WILL EAT STRINGS OF THE FOLLOWING FORMAT:
*	<0 OR MORE BLANKS> FOLLOWED BY
*	<'+' OR '-' OR NOTHING> FOLLOWED BY
*	<1 OR MORE DIGITS WHICH MAY CONTAIN A '.' ANYWHERE IN THIS FIELD
*	FIELD MAY CONTAIN UP TO 10 SIGNIFICANT DIGITS
*	(LEADING ZEROES ARE NOT CONSIDERED SIGNIFICANT
*	EXAMPLE:
*	0.000000103456789
*	THE "0.000000" PART IS NOT CONSIDERED SIGNIFICANT,
*	WHILE THE "103456789" PART IS CONSIDERED SIGNIFICANT)
*	MAY NOT BE > 127 NON-SIG ZEROS RIGHT OF DP & PRECEEDING SIG DIGITS
*	EXCESS SIGNIFICANT DIGITS ARE READ AND IGNORED> FOLLOWED BY
*	<'e', 'E' OR NOT A 'E'> (DONE IF NOT 'E', ELSE...) FOLLOWED BY
*	<'+' OR '-' OR NOTHING> FOLLOWED BY
*	<UP TO 3 DIGITS NOT TO EXCEED 126> FOLLOWED BY
*	<NOT A DIGIT>
*
*	JSR	FCONVI
*	BRA	ALL OK
*	BRA	OVERFLOW
*	BRA	SYNTAX ERROR
*
FCONVI31	BSR	GETCHAR
LEFTDIG	BSR	ISDIG
	BRA	FCONVI32
	CMPA	#'.
	BNE	FCONVI33
	LDAA	DPFLAG
	BNE	FCONVI33
	INCA
	STAA	DPFLAG
	BRA	FCONVI31
FCONVI32	TFR	A,B	MULTIPLY LEFT DIGIT OF PAIR BY 10
	ASLA
	ASLA
	ABA
	ASLA
	STAA	0,X
FCONVI36	LDAA	DPFLAG
	BNE	FCONVI37
	INC	DPCOUNT
	BPL	FCONVI37
	LEAS	2,S
	JMP	SYNERR
FCONVI37	RTS
FCONVI33	PULX
	JMP	2,X
*
FCONVI34	BSR	GETCHAR
RIGHTDIG	BSR	ISDIG	PICK UP RIGHT HAND DIGIT OF PAIR
	BRA	FCONVI35
	CMPA	#'.
	BNE	FCONVI33
	LDAA	DPFLAG
	BNE	FCONVI33
	INCA
	STAA	DPFLAG
	BRA	FCONVI34
FCONVI35	ADDA	0,X	ADD RIGHT HAND DIGIT TO LEFTHAND ALREADY COLLECTED
	STA	,X+
	BRA	FCONVI36
	PAGE
*	DIGIT CHECK ROUTINE
*	SKIP RETURN IF A IS NOT A DIGIT
*	RETURN W/BCD EQUIVALENT IF CHAR IS A DIGIT
*
ISDIG	CMPA	#'0
	BLT	ISDIG2
	CMPA	#'9
	BGT	ISDIG2
	STAA	DIGFLG
	SUBA	#'0
	RTS
ISDIG2	STAA	TEMPA	SKIP RETURN, PRESERVE A, X
	PULD
	ADDD	#2
	PSHD
	LDAA	TEMPA
	RTS
*
*	GET CHARACTER ROUTINE
*	GET CHAR @BUFERP BUMP X & RETURN
*
GETCHAR	STX	FACX
	LDX	LOOPX	CHECK MAX # OF CHARS READ
	BEQ	GETCHAR0
	DEX
	STX	LOOPX
	LDX	BUFERP
	LDA	,X+
GETCHAR2	STX	BUFERP
	LDX	FACX
	RTS
GETCHAR0	LDX	BUFERP
	INX
	CLRA
	BRA	GETCHAR2
	PAGE
FCONVI	STD	LOOPX	MAX # OF CHARS TO EAT
	CLRA
	STAA	DPFLAG
	STAA	DPCOUNT
	STAA	DIGFLG
	STX	BUFERP
	STX	FCVIRT	NOT USED RIGHT AWAY
	LDX	#0
	STX	FAC1
	STX	FAC3
	STX	FAC5
	STX	FACEXT1	10TH DIGIT GOES INTO LEFT HALF OF FACEXT1
FCONVI1	BSR	GETCHAR
	CMPA	#$20
	BEQ	FCONVI1	EAT BLANKS
	CMPA	#$09
	BEQ	FCONVI1
	CMPA	#'+
	BEQ	FCONVI2
	CMPA	#'-
	BNE	FCONVI3
	LDAA	#$80
	STAA	FAC1	MAKE SIGN NEG
*
*	IGNORE LEADING ZEROES
*
FCONVI2	BSR	GETCHAR	GO GET SOME DIGITS
FCONVI3	CMPA	#'0
	BNE	FCONVI50
	STAA	DIGFLG
	LDAA	DPFLAG
	BEQ	FCONVI2	NO DP SEEN YET
	DEC	DPCOUNT
	BMI	FCONVI2
	JMP	SYNERR	TOO MANY ZEROES
FCONVI50	CMPA	#'.
	BNE	FCONVI51
	STAA	DPFLAG
	BRA	FCONVI2
*
*	EAT SIGNIFICANT DIGITS
*
FCONVI51	LDX	#FAC2
	LDAB	#DIGMAX/2
	STAB	DIGCNT	USE THIS AS A COUNTER
	BRA	FCONVI4A
FCONVI4	JSR	GETCHAR
FCONVI4A	JSR	RIGHTDIG
	BRA	FCONVI5	ALL IS OK
	BRA	FCONVI8	2ND DP FOUND, OR NOT A DIGIT
FCONVI5	JSR	GETCHAR
	JSR	LEFTDIG
	BRA	FCONVI6	ALL IS OK
	BRA	FCONVI8	2ND DP FOUND, OR NOT A DIGIT
FCONVI6	DEC	DIGCNT
	BNE	FCONVI4	NOT DONE, KEEP GOING
	LDAA	DPFLAG	DECIMAL POINT SEEN ?
	BNE	FCONVI7B	B/ YES, COLLECT AND IGNORE REMAINING DIGITS
	BRA	FCONVI7A	SKIP INTO EXCESS DIGIT COLLECTION LOOP

FCONVI7	INC	DPCOUNT	BUMP # DIGITS SEEN BEFORE DECIMAL POINT
	BMI	SYNERRJ	B/ TOO MANY DIGITS TO LEFT OF DECIMAL POINT
FCONVI7A	JSR	GETCHAR
	JSR	ISDIG
	BRA	FCONVI7	SCAN OFF REMAINING DIGITS
	CMPA	#'.	DECIMAL POINT ?
	BNE	FCONVI8	B/ NOPE
FCONVI7B	JSR	GETCHAR	YES, COLLECT DIGITS AFTER DP
	JSR	ISDIG
	BRA	FCONVI7B
FCONVI8	LDAB	DIGFLG	SEE IF SYNTAX OK SO FAR...
	BNE	FCONVI26
SYNERRJ	JMP	SYNERR	NO DIGITS FOUND YET, ERROR
*
*	SYNTAX OK SO FAR, TRY FOR EXPONENT
*
FCONVI26	LDX	BUFERP	REMEMBER THIS POINTER
	STX	FCVIRT
	CLRB
	STAB	DIGFLG	EXPONENT DIGIT FLAG
	STAB	MSIGN	EXPONENT SIGN
	STAB	MEXP	EXPONENT VALUE
	STAB	EXPOVF	EXPONENT OVERFLOW FLAG
	CMPA	#'e
	BEQ	FCONVI26A
	CMPA	#'E
	BNE	FCONVI13	GO CLEAN UP, NO ERRORS
FCONVI26A	JSR	GETCHAR
	CMPA	#'+
	BEQ	FCONVI9	B/ IGNORE LEADING PLUS
	CMPA	#'-
	BNE	FCONVI11
	LDAA	#$80
	STAA	MSIGN
FCONVI9	JSR	GETCHAR
	BRA	FCONVI11
*
*	COLLECT EXPONENT DIGITS
*
FCONVI10	JSR	GETCHAR
FCONVI11	JSR	ISDIG
	BRA	FCONVI12
	BRA	FCONVI90	GO CLEAN UP
FCONVI12	LDAB	MEXP
	ASLB		*2
	BCS	FCONVI91	CATCH THE OVERFLOW
	ASLB		*4
	BCS	FCONVI91	CATCH THE OVERFLOW
	ADDB	MEXP	*5
	BCS	FCONVI91	CATCH THE OVERFLOW
	ASLB		*10
	ABA
	STAA	MEXP
	BCC	FCONVI10
FCONVI91	LDAA	#1
	STAA	EXPOVF
	BRA	FCONVI10
FCONVI90	LDAA	DIGFLG	ANY EXPONENT DIGITS?
	BNE	FCONVI13
	LDX	FCVIRT	NO, BACKUP AND IGNORE E PHRASE
	STX	BUFERP
*
*	CLEAN UP HERE
*
FCONVI13	LDAA	FAC2	IF FAC2 IS ZERO, WE'RE OK
	BNE	FCONVI14	B/ NONZERO DIGIT SEEN
	STAA	FAC1
	BRA	UNDERFLOW	(IT ISN'T REALLY, JUST AN OK EXIT)
FCONVI14	LDAA	EXPOVF
	BNE	OVERFLOW	EXPONENT OVERFLOW, SEMANTIC ERROR
	LDAB	MEXP
	BEQ	FCONVI15
	LDAA	MSIGN
	BPL	FCONVI16
	NEGB
	LDAA	#$FF
	BRA	FCONVI16
FCONVI15	CLRA
*
*	A,B HAVE 16 BIT SIGNED VALUE REPRESENTING THE VALUE OF
*	THE SPECIFIED EXPONENT. ADD TO THAT THE # OF DIGITS LEFT OF
*	THE DP
*
FCONVI16	STD	FACX
	LDAB	DPCOUNT	SIGN EXTEND THE DP COUNT
	CLRA
	ROLB
	SBCA	#0
	ASRD
	ADDB	FACX+1	*** CANNOT OPTIMIZE FOR 6809 ****
	ADCA	FACX
*
*	IF A <> 0 OR A <> $FF, ERROR
*
	BEQ	FCONVI22
	CMPA	#$FF
	BEQ	FCONVI22
	TSTA
	BPL	OVERFLOW
UNDERFLOW	LDX	#FZERO
	BRA	FCONVI21
*
*	NOW NORMALIZE IF EXP IS ODD
*
FCONVI22	ASRD
	BCS	FCONVI18	B/ NO NORMALIZE
	PSHB		SIGN IS PROPOGATED, SAVE EXPONENT
	CLRA		MAKE FORWARD CARRY = 0
	LDAB	#10	MULTIPLIER...
	STAB	ML
	LDX	#FACEXT1	MULTIPLY COLLECTED RESULT BY TEN
	JSR	FDIVNORMDIGIT
	JSR	FDIVNORMDIGIT
	JSR	FDIVNORMDIGIT
	JSR	FDIVNORMDIGIT
	JSR	FDIVNORMDIGIT
	JSR	FDIVNORMDIGIT	PROCESS MSD
*	ASSERT:	(A)=0 (NO CARRY!)
	PULB
	CLC
FCONVI18	ADCB	#$40	ADD BIAS
	BVS	OVERFLOW
	BLE	UNDERFLOW
	ORAB	FAC1	PICK UP THE SIGN
	STAB	FAC1
	LDX	#FAC1
	BRA	FCONVI21
OVERFLOW	LDAA	FAC1
	BPL	FCONVI20
	LDX	#MINFINITY
	BRA	FCONVI25
FCONVI20	LDX	#INFINITY
FCONVI25	PULD
	ADDD	#2
	BRA	FCONVI21A
FCONVI21	PULD
FCONVI21A	STD	FCVIRT
	JSR	FLOUT
	LDD	FCVIRT
	PSHD
	RTS

SYNERR	LDX	#FZERO
	JSR	FLOUT
	PULD
	ADDD	#4
	PSHD
	RTS
	PAGE
	IF	(*/256)=((*+9999//256)/256)
*	EITHER THIS CONDITIONAL IF IS ON, OR THE ONE FOLLOWING MULBASE 100 IS ON
MULDIV100	EQU	*	CONVERTS MSB OF PRODUCT TO APPROX PRODUCT/100
	RPT	9999//256
	(*-MULDIV100)*256/100	(PRODUCT-(PRODUCT MOD 256))/100
MULDIV100.A	EQU	*
	RPT	9999//256
	(*-MULDIV100.A)*256\100	REMAINDER FOR ABOVE
	FIN
*
*	DIGIT MULTIPLY
*	MULTIPLIES REG B BY ML, RETURNS RESULT IN A,B
*
MULBASE100	EQU	*	ML*(B) -> (A,B) BASE 100 WITH BINARY DIGITS
	IF	M6800
	CLRA		ZERO PARTIAL PRODUCT
	RORB		LOOK AT LSB OF MULTIPLIER
	BCC	*+5	B/ =0, LEAVE PARTIAL PRODUCT AS ZERO
	LDAA	ML	USE MULTIPLICAND AS 1ST PARTIAL PRODUCT
	LSRA		SHIFT PARTIAL PRODUCT ONE BIT RIGHT
	RORB		SHIFT OUT MULTIPLIER BIT
	BCC	*+5	B/ MULTIPLIER BIT IS ZERO
	ADDA	ML	IS ONE, ADD MULTIPLICAND TO PARTIAL PRODUCT
	RORA		SHIFT PARTIAL PRODUCT ONE BIT RIGHT
	RORB		SHIFT OUT MULTIPLIER BIT
	BCC	*+5	B/ MULTIPLIER BIT IS ZERO
	ADDA	ML	IS ONE, ADD MULTIPLICAND TO PARTIAL PRODUCT
	RORA		SHIFT PARTIAL PRODUCT ONE BIT RIGHT
	RORB		SHIFT OUT MULTIPLIER BIT
	BCC	*+5	B/ MULTIPLIER BIT IS ZERO
	ADDA	ML	IS ONE, ADD MULTIPLICAND TO PARTIAL PRODUCT
	RORA		SHIFT PARTIAL PRODUCT ONE BIT RIGHT
	RORB		SHIFT OUT MULTIPLIER BIT
	BCC	*+5	B/ MULTIPLIER BIT IS ZERO
	ADDA	ML	IS ONE, ADD MULTIPLICAND TO PARTIAL PRODUCT
	RORA		SHIFT PARTIAL PRODUCT ONE BIT RIGHT
	RORB		SHIFT OUT MULTIPLIER BIT
	BCC	*+5	B/ MULTIPLIER BIT IS ZERO
	ADDA	ML	IS ONE, ADD MULTIPLICAND TO PARTIAL PRODUCT
	RORA		SHIFT PARTIAL PRODUCT ONE BIT RIGHT
	RORB		SHIFT OUT MULTIPLIER BIT
	BCC	*+5	B/ MULTIPLIER BIT IS ZERO
	ADDA	ML	IS ONE, ADD MULTIPLICAND TO PARTIAL PRODUCT
	RORA		ONE MORE RIGHT SHIFT COMPLETE 6809 COMPATIBLE MULTIPLY
	RORB		BINARY PRODUCT OF (A)*(B) IS IN (A,B)
	LSRA		AND ANOTHER FOR BETTER LUCK
	RORB
	ELSE	M6801!M6809
	LDA	ML
	MUL
	FIN
*	NOW ADJUST BINARY PRODUCT TO MAKE INTO BASE 100
CONVERTTOBASE100	EQU	*	(A,B)<=9999 GETS CONVERTED TO BASE 100
	STAA	TEMPB	ASSERT: (A)<=INT(99*99/256)=38?
	LDAA	#MULDIV100/256	COMPUTE APPROX PRODUCT DIVIDED BY 100
	STAA	TEMPA
	LDX	TEMPA
	LDAA	MULDIV100&$FF,X	= (PRODUCT MOD 256)/100
	ADDB	(MULDIV100&$FF)+9999//256,X	= (PRODUCT MOD 256) MOD 100
	BCC	*+6	B/ PRODUCT MOD 256 + (PRODUCT - (PRODUCT MOD 256)) MOD 100
	ADDA	#2	REMAINDER >= 256, ADJUST LEFT HAND DIGIT
	SUBB	#200	ADJUST REMAINDER
	BPL	*+5	B/ (B)<=127 (.5 OF THE TIME)
	INCA		(B)>=128, ADJUST LEFT HAND DIGIT
	SUBB	#100	ADJUST REMAINDER
	CMPB	#100	(B) STILL TO BIG ?
	BCS	*+5	B/ NO, GET OUT!
	INCA		ADJUST LEFT HAND DIGIT
	SUBB	#100	MAKES RIGHT HAND DIGIT LEGAL
	RTS		TOTAL: 131 CYCLES FOR MULTIPLY AND CONVERT
	IFUND	MULDIV100
	IF	(*/256)=((*+9999//256)/256)
*	EITHER THIS CONDITIONAL IF IS ON, OR THE ONE PRECEEDING MULBASE 100 IS ON
MULDIV100	EQU	*	CONVERTS MSB OF PRODUCT TO APPROX PRODUCT/100
	RPT	9999//256
	(*-MULDIV100)*256/100	(PRODUCT-(PRODUCT MOD 256))/100
MULDIV100.A	EQU	*
	RPT	9999//256
	(*-MULDIV100.A)*256\100	REMAINDER FOR ABOVE
	FIN
	FIN
	PAGE
FDIVNORM	EQU	*-1	MULTIPLICATIVE FACTOR USED TO NORMALIZE DIVISOR
	RPT	100/2-1	(SEE KNUTH VOL 2 PAGE 237)
	FCB	100/(*-FDIVNORM+1)
*
*
*	MULTIPLY DIGIT AT (X) BY ML AND ADD (A); STORE BACK AT (X)
*	RETURN (A) = UPPER BASE 100 DIGIT OF @(X)*ML+(A)
*	DECREMENT X
*
FDIVNORMDIGIT	EQU	*
	STAA	CTNB	SAVE CARRY TO NEXT BYTE
	STX	FACX	LOOKS LIKE GOOD IDEA...
	LDAB	0,X	GET DIGIT TO BE MULTIPLIED
	JSR	MULBASE100	MULTIPLY IT BY ML, PRODUCT GOES TO (A,B)
	ADDB	CTNB	ADD CARRY FROM LAST DIGIT COLUMN
	CMPB	#100	DO BASE 100 ADJUST
	BCS	*+5	B/ DIGIT IS OK
	INCA		BUMP CARRY TO NEXT DIGIT COLUMN
	SUBB	#100	MAKE DIGIT VALID
	LDX	FACX	STORE MODIFIED DIGIT
	STAB	0,X
	DEX		AS PROMISED
	RTS		WITH CARRY TO NEXT BYTE IN (A)


FZERO	FCB	0,0,0,0,0,0
MINFINITY	FCB	$FF,99,99,99,99,99,99
INFINITY	FCB	$7F,99,99,99,99,99,99
	PAGE
*
* FLOATING OUTPUT TO BO ROUTINE
*
*	X-REG  Points to floating value on entry
*
FLOUT	LDAA	#6
	STAA	LOOPX

FLOUTLOOP
	STX	BUFERP
	LDAA	0,X
	JSR	PUTB
	LDX	BUFERP
	INX
	DEC	LOOPX
	BNE	FLOUTLOOP
	RTS
