	TITLE	'FAST FLOATING POINT (ATARI)'
	SUBTTL 'SYSTEM EQUATES USED'
;
;	FAST FLOATING POINT ROM FOR THE ATARI 800/400 (TM ATARI, INC)
;	  Written by Charles W. Marslett, August-November, 1981
;	  Copyright 1981, Charles W. Marslett
;	  Copyright 1982 and 1984, Charles W. Marslett
;
;	Permission is granted by the author for any use whatsoever of this
;	  code, so long as this notice remains in the source code, and so
;	  long as the source to this routine, however modified or unmodified,
;	  is made available for a nominal cost.
;
;	SPEED IMPROVED OVER ATARI ROM, IN MOST CASES BY A FACTOR OF 3.
;	ERRORS IN LOG AND DIVIDE ALGORITHMS CORRECTED.
;	ACCURACY IN EXP FUNCTION IMPROVED (I THINK).
;
;	REVISION A, ASCII-->FLOATING CONVERSION OF 9 DIGITS ONLY (LIKE ATARI),
;		19 NOVEMBER 1981.
;	REVISION B, RETURNED TO USING REDARG IN LOG (LIKE ATARI), TO ALLOW
;		INCLUSION OF SIN/COS/SQR CONSTANTS FOR BASIC CARTRIDGE
;		27 NOVEMBER 1981.
;	REVISION C, ELIMINATED USE OF DEGRAD AND FRX IN THE FMUL/FDIV CODE AND
;		FURTHER SPEEDED UP FMUL BY UNROLLING SHIFT LOOP, 30-NOV-81
;	REVISION D, INSERTED COPYRIGHT NOTICE IN THE ROM, 1-DEC-81
;	REVISION E, ADDED ASCII HEX DISPLAY ROUTINE, 4-MAR-82
;	REVISION F, MODIFIED EXP AND LOG FUNCTIONS FOR THE 600XL
;		AND 800XL BASIC ROM POWER ROUTINE BUG, 17-JUNE-84
;
ROMBASE =	$D800		;STARTING ADDRESS OF F.P. ROM
FPREC	=	6		;NUMBER OF BYTES IN A F.P. NUMBER
;
;	BASE PAGE DEFINITIONS
;
	ORG	$D4
FR0	DS	FPREC
FRE	DS	FPREC
FR1	DS	FPREC
FR2	DS	FPREC
FRX	DS	FPREC
EEXP	=	FRX+1
NSIGN	=	FRX+2
ESIGN	=	FRX+3
FCHRFLG =	FRX+4
DIGRT	=	FRX+5
CIX	DS	1
INBUFF	DS	2
Z1	DS	2
Z2	DS	2
Z3	DS	2
DEGRAD	DS	1		;DEGREE OR RADIAN UNITS FOR BASIC
FLPTR	DS	2
FPTR2	DS	2
;
;	POLYNOMIAL WORK AREA
;
	ORG	$57E
LBPR1	DS	1
LBPR2	DS	1
LBUFF	DS	$60
PLYARG	DS	FPREC
FSCR	DS	FPREC
FSCR1	DS	FPREC
	DS	128-$60-FPREC-FPREC-FPREC
LBFEND	=	*-1
	SUBTTL 'FLOATING POINT/ASCII CONVERSION ROUTINES'
;
;	ASCII TO FLOATING POINT CONVERSION ROUTINE (ADDR=D800)
;
	ORG	ROMBASE
AFP	JSR	SKBLK		;SKIP ANY LEADING BLANKS
	JSR	NXTCH		;LOAD THE NEXT CHARACTER
	BCS	EXIT		;IF NOT NUMERIC, EXIT
	LDX	#FRX		;ZERO FRX AND FR0
	JSR	ZF1
	JSR	ZFR0
	DEC	DIGRT		;STORE -1 INTO DIGRT
;
CHRLP	STA	FCHRFLG		;CLEAR THE FIRST CHARACTER INDICATION
	JSR	GETCH		;GET THE NEXT CHARACTER
	BCS	INVLD		;IF NOT NUMERIC
	LDX	FR0
	BNE	NOTZER		;IF FR0 IS NORMALIZED
	JSR	SH0L4		;ELSE, SHIFT CONTENTS LEFT 4 BITS
	ORA	FR0+FPREC-1
	STA	FR0+FPREC-1	;MERGE IN NEW DIGIT
	LDX	DIGRT
	BMI	CHRLP0		;IF STILL AN INTEGER, JUST LOOP BACK
;
DECFND	INC	DIGRT		;ELSE, BUMP NUMBER OF DECIMAL PLACES
;
NOTZER	LDX	DIGRT		;FILLED UP THE 10 DIGITS FOR THE NUMBER
	BPL	CHRLP0		;IF AFTER DECIMAL, IGNORE REMAINING DIGIT
	INC	EEXP		;IF NOT, BUMP THE EXPONENT BY 1
CHRLP0	LDA	#$FF		;RESET FIRST CHARACTER FLAG
	BNE	CHRLP
;
INVLD	CMP	#'.'		;FOUND DECIMAL?
	BNE	NODEC0		;YES, START DECIMAL PLACE COUNTER
	LDX	DIGRT		;BY MAKING NEGATIVE DIGRT POSITIVE
	BMI	DECFND		;IF NOT NEGATIVE, SECOND '.' ENDS FIELD
;
NODEC0	CMP	#'E'
	BNE	NOEXP		;IF NOT 'E', THEN NO EXPONENT SUBFIELD
	LDX	CIX
	JSR	GETCH
	BCC	NOESG		;X CONTAINS 'CIX' BEFORE PARSING EXPONENT
	CMP	#'+'
	BEQ	SKESG
	CMP	#'-'
	BNE	RSTEXP		;IF NO + OR - AFTER 'E' THEN NO EXPONENT
	STA	ESIGN		;MARK NEGATIVE IF '-' FOUND
SKESG	JSR	GETCH		;IN ANY CASE, SEE IF NEXT CHARACTER IS NUMERIC
	BCS	RSTEXP		;IF NOT, NO EXPONENT SUBFIELD
EXPLP	TAY			;SAVE NEXT DIGIT
	LDA	FRX
	ASL	A
	ASL	A		;MULTIPLY PREVIOUS TOTAL BY 10
	ADC	FRX
	ASL	A
	STA	FRX		;THEN ADD TO THIS DIGIT (IN Y)
	TYA
	ADC	FRX
NOESG	STA	FRX		;AND UPDATE FRX
	JSR	GETCH
	BCC	EXPLP		;IF NO OVERFLOW AND NEXT CHARACTER NUMERIC
	BCS	NUMEND		;IF NONNUMERIC, END OF THE NUMBER
;
;	STUFF A BYTE INTO THE TEXT BUFFER (CONVERTING TO ASCII IF REQ.)
;
CVASC	ORA	#'0'		;CONVERT DIGIT TO ASCII CHARACTER
;
STUFF	STA	LBUFF,Y		;STORE BYTE INTO BUFFER
	INY			;BUMP THE INDEX
EXIT	RTS
;
;	CONDITIONALLY PUT A DECIMAL POINT IN A BUFFER
;
CDPNT	DEC	Z2
	BNE	EXIT		;IF NO POINT TO BE STUFFED
	LDA	#'.'		;ELSE, PUT IT IN
	BNE	STUFF
;
NOEXP	LDX	FCHRFLG
	BNE	NUMEND
	CMP	#'+'
	BEQ	CHRLP0		;IF LEADING '+', IGNORE IT
	CMP	#'-'
	BNE	NUMEND		;IF LEADING '-', SET NEGATIVE FLAG
	STA	NSIGN
	BEQ	CHRLP0
;
RSTEXP	STX	CIX		;RESTORE POINTER AT BEGINNING OF PARSE TRY
	LDA	#0
	STA	FRX		;REZERO EXPONENT
NUMEND	LDA	EEXP
	CLC
	ADC	#$88
	LDX	DIGRT
	BMI	NODP		;IF NO DECIMAL POINT ADJUSTMENT
	SEC
	SBC	DIGRT		;ELSE, SUBTRACT NUMBER OF DIGITS TO RIGHT OF DP
NODP	LDX	ESIGN		;CHECK EXPONENT SIGN
	BNE	SUBEXP		;IF NEGATIVE, SUBTRACT VALUE
	CLC
	ADC	FRX		;ELSE, ADD VALUE OF EXPONENT TO BASE ONE
	JMP	EXPOK
;
;	REST OF THE BYTE TO ASCII (HEX) CONVERSION ROUTINE
;
CTUHEX	PLA			;RESTORE ORIGINAL BYTE
	LSR	A
	LSR	A
	LSR	A
	LSR	A		;POSITION UPPER 4 BITS FOR CONVERSION
	JMP	HEXDGT		;RETURN THROUGH THE CONVERSION ROUTINE
;
EXP3DG	TXA
	SBC	#100		;TAKE THE 100 OUT OF THE EXPONENT
	TAX
	LDA	#'1'		;PRINT THE LEADING '1'
	BNE	NNEXP
;
SUBEXP	SEC
	SBC	FRX
EXPOK	LSR	A		;CONVERT TO POWERS OF 100
	BCC	EVEXP		;SKIP AROUND TIMES 10
	JSR	SH0L4
EVEXP	LDY	FR0
	BEQ	NORGT
	ADC	#1
	LDX	#FPREC-2
SH0R	LDY	FR0,X
	STY	FR0+1,X
	DEX
	BPL	SH0R
NORGT	LDX	NSIGN
	BEQ	NOXOR
	EOR	#$80
NOXOR	DEC	CIX		;BACK UP OVER THE FINAL (INVALID) CHARACTER
	JMP	IFPE		;STORE EXPONENT AND NORMALIZE
;
NOEXPF	JSR	PRTDGT		;GO PUT ASCII DIGIT STRING INTO BUFFER
	INY
	ORA	#$80
	BNE	PUTSGN		;GO PUT MINUS SIGN IN IF REQUIRED
;
;	RETURN A VALUE OF ASCII ZERO
;
ASCZER	LDA	#$80+'0'	;ZERO, END OF STRING
	BNE	STZERO
;
;	FLOATING POINT TO ASCII CONVERSION (ADDR=D8E6)
;
	ORG	AFP+$E6
FASC	JSR	INITBF		;PUT ADDRESS OF LBUFF INTO INBUFF
	LDA	FR0		;IS THE NUMBER ZERO?
	BEQ	ASCZER		;IF YES, RETURN ASCII ZERO
;
	ASL	A		;GET RID OF SIGN BIT
	SEC
	SBC	#$7E		;DO RANGE CHECK (>0.01 AND < 1E10)
	CMP	#12		;11 POSSIBLE DECIMAL POINTS (0-10)
	BCC	NOEXPF
	SBC	#2		;CONVERT TO SIGNED EXPONENT OF 10
	STA	EEXP		;AND SAVE IT FOR LATER PRINTING
	LDA	#3		;SET CODE FOR XX.XXXXXXXX, BIT0=1, EXP FORMAT
	JSR	PRTDGT
	INY
	LDA	#'E'		;FOLLOW DIGITS WITH AN 'E'
	JSR	STUFF
;
	LDA	#'+'		;ASSUME SIGN IS POSITIVE
	LDX	EEXP
	BPL	NNEXP		;IF EXPONENT IS POSITIVE
	LDA	#0		;COMPUTE ABSOLUTE VALUE OF EXPONENT
	SEC
	SBC	EEXP
	TAX
	LDA	#'-'		;THEN, DISPLAY A '-'
NNEXP	JSR	STUFF		;DISPLAY SIGN
	CPX	#100		;EXPONENT > 100?
	BCS	EXP3DG		;IF SO, GO PRINT 3 DIGIT EXPONENT (1XX)
	TXA			;RESTORE EXPONENT TO ACC
	INY			;ALLOW FOR 10-S DIGIT OF EXPONENT
	LDX	#'0'-1		;SET UP FOR CONVERT-TO-DECIMAL
	SEC
CVDLP	SBC	#10		;SUBTRACT 10 FROM ACC
	INX
	BCS	CVDLP		;AND CONTINUE DOING SO UNTIL CONVERTED
	ADC	#$80+'0'+10	;RESTORE THE LAST 10 SUBTRACTED
	STA	LBUFF,Y		;STUFF IT INTO THE BUFFER
	TXA			;MOVE 10-S DIGIT TO ACC
PUTSGN	STA	LBUFF-1,Y	;AND PUT IT INTO THE BUFFER
	LDA	FR0		;STRIP OFF LEADING ZERO?
	BPL	MINXIT		;IF NOT, ALL IS OK NOW
	DEC	INBUFF		;ELSE, MAKE ROOM FOR MINUS
	LDA	#'-'
STZERO	LDY	#0
	STA	(INBUFF),Y	;PUT MINUS IN THE BUFFER
MINXIT	RTS			;THEN FINALLY, WE EXIT
;
;	COPYRIGHT NOTICE IN THE ROM TEXT
;	COPYRIGHT 1984, C. W. MARSLETT
;
	DB	'CPYRT.1984,MARSLETT'
	SUBTTL 'FLOATING POINT/INTEGER CONVERSION ROUTINES'
;
;	INTEGER TO FLOATING POINT CONTINUATION
;
IFPSU	STY	FR0+5
	LDY	#16		;SIXTEEN BITS IN NUMBER TO BE CONVERTED
IFPS	ASL	FR0+1
	ROL	A		;FIND FIRST 1 BIT
	DEY
	BCS	IFPEN		;EXIT IF FOUND
	BPL	IFPS		;ELSE, CONTINUE LOOPING
	RTS			;ELSE, RETURN ZERO TO CALLER
;
IFPEN	SED
	STA	Z3		;SAVE UPPER BYTE OF INTEGER
IFPL	LDA	FR0+3
	ADC	FR0+3		;DOUBLE FR0 AND AND IN ONE BIT FROM INTEGER
	STA	FR0+3
	LDA	FR0+2
	ADC	FR0+2
	STA	FR0+2
	ROL	FR0+1		;UPPER TWO DIGITS MAY BE ROTATED (NEVER > 9)
	ROL	Z3
	DEY
	BPL	IFPL		;THEN GO BACK TO HANDLE THE NEXT BIT
;
	LDA	#$42		;GENERATE THE EXPONENT
	JMP	IFPE		;THEN STORE, NORMALIZE AND EXIT
;
;	FLOATING POINT TO INTEGER CONTINUATION
;
FPICTU	LDY	#0
	STY	FR0
	TAX
	BEQ	FFRAC		;IF PROPER FRACTION, GO DO ROUNDING
	ASL	A		;ELSE, MULTIPLY BY 16 (NUMBER OF BITS * 2)
	ASL	A
	ASL	A
	ASL	A
	TAX			;PUT INTO X REGISTER
;
CVTLP	ASL	FR0+4		;SHIFT NUMBER LEFT FOR CONVERSION
	ROL	FR0+3
	ROL	FR0+2
	ROL	FR0+1
	BCC	CVTST		;IF NO BIT, DO NO ADD
	LDA	FR0		;FIRST ADD LOW BITS
	ADC	BITTAB,X
	STA	FR0
	TYA			;THEN THE HIGH BITS
	ADC	BITTAB+1,X
	TAY			;STORE BACK INTO Y-REG
CVTST	DEX
	DEX
	BNE	CVTLP		;IF NOT SHIFTED OUT, LOOK AT NEXT BIT
;
FFRAC	LDA	FR0+1		;ROUND OFF FRACTION
	CMP	#$50
	BCC	FFEXIT
	INC	FR0
	BNE	FFEXIT
	INY			;ADD CARRY TO UPPER BYTE
FFEXIT	STY	FR0+1
	CLC
	RTS			;FINALLY, RETURN
;
;
;	INTEGER --> FLOATING POINT ENTRY POINT (ADDR=D9AA)
;
	ORG	AFP+$1AA
IFP	LDA	FR0+1
	LDX	FR0
	STX	FR0+1
	LDY	#0		;ZERO FR0+2 TO FR0+5
	STY	FR0+2
	STY	FR0+3
	STY	FR0+4
	BEQ	IFPSU		;GO FINISH SETUP (DUE TO LACK OF SPACE HERE)
;
FDIF5	LDA	FR0,X
	SBC	FR1+1,Y
	STA	FR0,X
	DEX
	DEY
	BPL	FDIF5
;
FDIF6	DEX
	BMI	FNME		;IF NO CARRY PROP. REQ.
	LDA	FR0+1,X
	SBC	#0
	STA	FR0+1,X
	BCC	FDIF6		;IF CARRY PROP. NOT COMPLETE
	BCS	FNORM		;IF DONE, GO NORMALIZE
;
;	FLOATING POINT NUMBER TO INTEGER CONVERSION (ADDR=D9D2)
;
	ORG	AFP+$1D2
FPI	LDA	FR0		;USED HEAVILY BY BASIC ! ! ! ! ! ! ! ! ! !
	CMP	#$43		;IS IT TOO BIG?
	BCS	ZFR0		;IF SO, EXIT WITH CARRY SET
	SBC	#$3E		;ELSE, SUBTRACT 3F (NOTE CARRY IS CLEARED)
	BCS	FPICTU		;IF CARRY, THEN AT LEAST ROUNDING NEEDED
	BCC	ZFR0		;IF LESS THAN 0.01, RETURN ZERO, NO CARRY
;
;	CONVERSION ROUTINE FOR A SINGLE HEX DIGIT
;
HEXDGT	SEC
	SED
	SBC	#$9		;CONVERSION USES A VERY FUNNY ALGORITHM
	ADC	#'9'
	CLD
	RTS
;
;	FLOATING POINT ADD/SUBTRACT CODE (SPREAD ABOUT YOU SEE)
;
	ORG	AFP+$1E7	;LINE UP ZFR0, ZF1 AND INITBF
FNME	BCS	FNORM
	SEC
	LDX	#FPREC-1
FNM0	LDA	#0
	SBC	FR0,X
	STA	FR0,X
	DEX
	BNE	FNM0
;
	LDA	FR0
	EOR	#$80
IFPE	STA	FR0
FNORM	CLD
	LDY	#FPREC-1
FNML	LDA	FR0+1
	BEQ	FNM2		;IF UNNORMALIZED, GET RID OF LEADING ZEROS
	CLC			;ELSE, CLEAR CARRY AND RETURN
	RTS
;
FNM3	LDX	#1-FPREC
FNM4	LDA	FR0+FPREC+1,X
	STA	FR0+FPREC,X
	INX
	BNE	FNM4
	DEY
	BNE	FNML		;GO BACK AND CHECK NEXT DIGIT PAIR
	BEQ	RZERO		;IF SHIFTED 5 TIMES, THEN = ZERO!
;
FR0BIG	EOR	#$FF		;IF THE OTHER WAY AROUND, COMPUTE 4-DIF
	ADC	#FPREC-2
	BCC	FNML		;IF SECOND NUMBER IS NON-SIGNIFICANT
	TAY
	SED
	LDA	FR0
	EOR	FR1
	BMI	FDIF5
	CLC			;CLEAR CARRY FOR ADD
FADD5	LDA	FR0,X
	ADC	FR1+1,Y
	STA	FR0,X
	DEX
	DEY
	BPL	FADD5
;
FADD6	DEX
	BMI	FHTST		;IF NO CARRY PROPOGATE REQUIRED
	LDA	FR0+1,X
	ADC	#0
	STA	FR0+1,X
	BCS	FADD6		;IF CARRY OUT, PROPOGATE TO NEXT BYTE
	BCC	FHTST
;
FNM2	STA	FR0+FPREC
FNMUL	LDA	FR0
	DEC	FR0
	EOR	FR0
	BPL	FNM3
RZERO	CLC			;RETURN A ZERO WITH CARRY CLEAR
;
;	ZERO FR0 (ADDR=DA44)
;
ZFR0	LDX	#FR0		;POINT AT FIRST BYTE TO BE ZEROED
;
;	ZERO ANY (6-BYTE) FLOATING REGISTER ON PAGE 0 (ADDR=DA46)
;
ZF1	LDY	#FPREC
;
;	ZERO ANY PART OR ALL OF PAGE ZERO (ADDR=DA48)
;
ZPG0	LDA	#0
ZF1LP	STA	0,X
	INX
	DEY
	BNE	ZF1LP
	RTS			;THEN RETURN
;
;	POINT INBUFF TO LBUFF (ADDR=DA51)
;
INITBF	LDA	#HIGH[LBUFF]	;COPY ADDRESS OF LBUFF INTO INBUFF
	STA	INBUFF+1
	LDA	#LOW[LBUFF]
	STA	INBUFF
	RTS
;
;	SHIFT 2-BYTE POINTER LEFT 1 BIT
;
DBLZ2	ASL	Z2+1		;SHIFT 0 INTO LOW BIT OF SECOND BYTE
	ROL	Z2		;SHIFT HIGH BYTE INTO LOW BIT OF FIRST
	RTS			;THEN RETURN
	SUBTTL 'ADD/SUBTRACT ROUTINES'
	ORG	AFP+$260
;
;	FLOATING SUBTRACT ENTRY POINT (ADDR=DA60)
;
FSUB	LDA	FR1
	EOR	#$80		;FLIP THE SECOND ARGUMENT-S SIGN
	STA	FR1		;BEFORE DOING AN ADD!
;
;	FLOATING ADD ENTRY POINT (ADDR=DA66)
;
FADD	LDX	#FPREC-1	;GET THE NUMBER OF MANTISSA BYTES INTO X
	LDA	FR1		;GET THE EXPONENT OF THE SECOND ARGUMENT
	AND	#$7F		;STRIP OFF THE SIGN BIT
	STA	Z2		;SAVE IT FOR EXPONENT COMPARE
	LDA	FR0		;GET THE EXPONENT OF THE FIRST ARGUMENT
	AND	#$7F		;STRIP OFF ITS SIGN BIT
	SEC
	SBC	Z2		;SUBTRACT SECOND EXPONENT
	BPL	FR0BIG		;IF THE FIRST IS GREATER, GO ON WITH IT
	ADC	#FPREC-1	;SEE IF THE FIRST IS EVEN SIGNIFICANT
	TAY			;STORE NUMBER OF SIGNIFICANT BYTES
	SED			;GO TO DECIMAL MODE FOR ARITHMETIC
	LDA	FR0		;COMPUTE REAL OPERATION (XOR OF SIGNS)
	EOR	FR1
	BMI	FDIF0		;IF DIFFERENT, THIS IS REALLY A SUBTRACT
	CLC			;CLEAR CARRY
	DEY			;Y=0?
	BMI	FADD1		;IF SO, SKIP ADD
FADD0	LDA	FR0+1,Y		;ELSE, ADD THE TWO SELECTED BYTES
	ADC	FR1,X
	STA	FR0,X
	DEX
	DEY
	BPL	FADD0		;AND LOOP UNTIL ALL ARE DONE
;
FADD1	LDA	FR1,X		;THEN PROPOGATE CARRY TO TOP OF LARGER ARGUMENT
	ADC	#0
	STA	FR0,X
	DEX
	BNE	FADD1
;
	LDA	FR1		;COPY EXPONENT FROM SECOND TO FIRST ARG
	STA	FR0
FHTST	BCC	FADDX		;IF NO CARRY, EXIT (ADD COMPLETE!)
	LDX	#FPREC-2	;ELSE, SHIFT MANTISSA RIGHT 1 BYTE
FADD2	LDA	FR0,X
	STA	FR0+1,X
	DEX
	BNE	FADD2		;UNTIL ENTIRE BYTE IS MOVED OVER
	LDA	#1		;PUT A '1' IN THE HIGH MANTISSA BYTE
	STA	FR0+1
	LDA	FR0		;THEN INCREMENT THE EXPONENT
	INC	FR0
	EOR	FR0		;SEE IF OVERFLOW (SIGN CHANGE FROM INCR.!)
	ROL	A
FADDX	CLD			;RETURN TO BINARY MODE
	RTS			;THEN RETURN (OV==>CY SET)
;
FDIF0	SEC			;SET THE CARRY FLAG
	DEY
	BMI	FDIF2		;SKIP SUBTRACT PHASE IF NO SIGNIFICANT BYTES
FDIF1	LDA	FR1,X		;SUBTRACT FR0 FROM FR1*10^N STORING IN FR0
	SBC	FR0+1,Y
	STA	FR0,X
	DEX
	DEY
	BPL	FDIF1
;
FDIF2	LDA	FR1,X
	SBC	#0
	STA	FR0,X		;PROPOGATE CARRIES
	DEX
	BNE	FDIF2
	LDA	FR1		;THEN COPY EXPONENT TO RESULT
	STA	FR0
	JMP	FNME		;AND DO NORMALIZATION
	SUBTTL 'FLOATING POINT (DECIMAL) MULTIPLY'
;
;	FLOATING (DECIMAL) MULTIPLY ROUTINE
;
	ORG	AFP+$2D5	;FORCE ADDRESS OF ROUTINE TO MATCH ATARI-S
NOOVFL	LDX	#FPREC-1	;SET UP MAJOR LOOP COUNTER FOR EITHER MUL/DIV
	STX	Z3
	SED			;DECIMAL MODE FOR ADD LOOPS
	RTS			;NOTE THAT X IS ALSO SET UP AS LOOP COUNTER TOO
;
FMUL	LDA	FR1
	BEQ	JZERO
	LDA	FR0
	BEQ	FDXIT		;IF ZERO FR0, JUST RETURN
;
	TAX			;SAVE FOR LATER ERROR CHECK
	SEC
	SBC	#$3F		;EXCESS 64 ADJUSTMENT
	CLC
	ADC	FR1
	JSR	MDEXP		;GO CHECK FOR OVER/UNDER-FLOW IN EXPONENT CALC
MOVEL	LDA	FR0,X
	STA	FRE,X
	STA	FR2,X
	LDA	#0		;THEN ZERO FR0 TO ACCUMULATE RESULT
	STA	FR0,X
	DEX
	BNE	MOVEL		;SETUP FOR MULTIPLY LOOP
	STA	FRE		;ZERO HIGH ORDER 2 DIGITS OF BOTH FRE AND FR2
	STA	FR2
	STA	Z3+1
	LDX	#FRE
	JSR	SHL4
	BEQ	LOOPE		;GO DO ACTUAL MULTIPLYING LOOP
;
MDEXP	STA	FR0
	TXA			;COMPUTE SIGN OF RESULT WITH XOR
	EOR	FR1
	EOR	FR0		;THEN SEE IF THE SIGNS ARE THE SAME
	BPL	NOOVFL		;IF NOT, THIS IS OVER/UNDERFLOW
;
	PLA			;FLUSH TOP RETURN ADDRESS
	PLA
	LDA	FR0		;RESTORE OVER(UNDER)FLOWED EXPONENT
	ROL	A		;IS IT OVERFLOW OR UNDERFLOW?
	BMI	JZERO		;IF UNDERFLOW, RETURN A ZERO FOR THE RESULT
OVFLDV	SEC			;IF OVERFLOW, RETURN GARBAGE AND CARRY SET!

	RTS
;
FDXIT	CLC			;RETURN ORIGINAL CONTENTS OF FR0 (ZERO)

	RTS			;WITH NO ERROR INDICATION
;
JZERO	JMP	RZERO		;RESULT IS UNDERFLOW (=0)
;
;
;	FLOATING POINT DIVIDE (DECIMAL) ROUTINE ENTRY POINT
;
	ORG	AFP+$320	;FDIV IS ATARI ENTRY POINT, FLDDIV USED BY REDARG
				;RFCONT IS USED BY LOG10
RFCONT	LDA	#3
	JSR	CTUEVL		;CALCULATE NUMERATOR
FLDDIV	JSR	FLD1P		;LOAD THE DIVISOR FROM LOC POINTED TO BY (FLPTR)
;
FDIV	LDA	FR1		;IS THIS DIVIDE BY ZERO?
	BEQ	OVFLDV		;IF SO, IT IS AN OVERFLOW!
	LDA	FR0
	BEQ	FDXIT
	TAX			;ELSE, COMPUTE RESULTANT EXPONENT
	SEC
	SBC	FR1
	CLC
	ADC	#$40		;EXCESS 64 ADJUSTMENT
	JSR	MDEXP		;GO CHECK FOR EXPONENT OVER OR UNDER FLOW
;
DSETUP	LDA	FR1,X		;LOOP CTR (X) ALREADY SET TO FPREC-1
	STA	FR2,X
	LDA	FR0,X
	STA	FR0+1,X		;PROVIDE A LEADING BYTE OF 0 FOR ALGORITHM
	DEX
	BNE	DSETUP
	STX	FR2
	STX	FR0+1		;STUFF ZERO AFTER SHIFTING FR0 RIGHT
	LDX	#FR2
	JSR	SHL4
	SEC
	LDX	#0-FPREC	;POINTER TO CURRENTLY GENERATED QUOTIENT BYTE
	JMP	SUB10E		;SKIP ZEROING 7-TH BYTE OF NUMBER
;
;	MAIN MULTIPLY LOOP
;
LOOP0	LDA	FR0+5
	STA	Z3+1
	LDA	FR0+4
	STA	FR0+5
	LDA	FR0+3		;SHIFT ACCUMULATED PRODUCT RIGHT ONE BYTE
	STA	FR0+4
	LDA	FR0+2
	STA	FR0+3
	LDA	FR0+1
	STA	FR0+2
	STY	FR0+1		;AND SHIFT IN 00 AT HIGH BYTE
;
LOOPE	LDX	Z3		;LOAD DIGIT PAIR BEING USED
	LDA	FR1,X		;GET NEXT DIGIT PAIR TO MULTIPLY BY
	BEQ	NOONE		;IF ZERO, SKIP BOTH MULTIPLY LOOPS
	LSR	A
	LSR	A
	LSR	A
	LSR	A		;EXTRACT UPPER DIGIT
	BEQ	NOTEN		;IF 10-S DIGIT IS ZERO
	LDX	#FRE		;GO ADD IN FRE-S (MULTIPLIER X 10)
	JSR	DOMULT
;
	LDX	Z3
NOTEN	LDA	FR1,X		;GET 1-S DIGIT FROM BYTE
	AND	#$F
	BEQ	NOONE		;IF ONES DIGIT IS ZERO, DONE!
	LDX	#FR2
	JSR	DOMULT
;
NOONE	DEC	Z3		;DONE WITH ALL DIGITS?
	BNE	LOOP0		;IF NOT, CONTINUE
	LDA	Z3+1		;COPY 6-TH QUOTIENT DIGIT TO FR0
	STA	FR0+6
FNDIV	CLD			;BACK OUT OF DECIMAL MODE
	LDA	FR0+1
	BNE	FDXIT		;IF ALREADY NORMALIZED, EXIT TO CALLER
	LDY	#FPREC		;ELSE, NORMALIZE WITH GUARD DIGIT
	JMP	FNMUL
;
;	LOAD 0.5 INTO FR1
;
GETHALF	LDY	#HIGH[HALF]
	LDX	#LOW[HALF]
	JMP	FLD1R
;
;	SKIP OVER A STRING OF BLANKS IN INPUT BUFFER (ADDR=DBA1)
;
	ORG	AFP+$3A1
SKBLK	LDY	CIX		;SKIP BLANKS IN BUFFER
	LDA	#' '
	BNE	FSTTST		;TEST FIRST CHARACTER
LPBLK	INY
FSTTST	CMP	(INBUFF),Y
	BEQ	LPBLK
	STY	CIX		;UPDATE INDEX INTO BUFFER
	RTS			;FOUND A NON-BLANK CHAR. RETURN!
;
;	GET A CHARACTER (AND TRY TO CONVERT IT TO DECIMAL) (ADDR=DBAF)
;
;
	ORG	AFP+$3AF
GCHAR	LDY	CIX		;GET POINTER INTO BUFFER
	LDA	(INBUFF),Y	;GET BYTE FROM BUFFER
	SEC
	SBC	#'0'		;CONVERT FROM ASCII TO BINARY
	CMP	#10		;SEE IF IT FALLS OFF ON THE OTHER SIDE
	RTS			;CARRY SET==>NOT A DIGIT
;
;	GET THE NEXT CHARACTER IF IT IS NOT A VALID NUMERIC CHARACTER
;
NXTCH	JSR	GETCH		;GET THE CURRENT CHARACTER
	BCC	GDCHR		;IF NUMERIC
	CMP	#'.'
	BEQ	DOTVLD		;DECIMAL, GO SEE IF VALID
	CMP	#'+'
	BEQ	SGNCHK		;PLUS OR MINUS, GO SEE IF VALID
	CMP	#'-'
	BNE	BADCH
;
SGNCHK	LDA	(INBUFF),Y
	CMP	#'.'		;IF FOLLOWED BY A DECIMAL, VALID
	BEQ	GDCHR
DOTVLD	LDA	(INBUFF),Y	;MAKE SURE ACC HAS NEXT CHARACTER IN IT!!
	CMP	#'0'
	BCS	MAYBE		;IF DIGIT FOLLOWS, SIGN IS VALID
;
BADCH	SEC			;IF INVALID, SET CARRY AND RETURN
	RTS
;
;	GET A CHARACTER FROM A TEXT BUFFER
;
GETCH	JSR	GCHAR		;GET A CHARACTER FROM BUFFER
	BCC	UPCIX		;IF DIGIT, UPDATE CIX
	LDA	(INBUFF),Y	;ELSE, RESTORE ACTUAL ASCII CODE
UPCIX	INY
	STY	CIX		;BUMP BOTH CIX AND Y-REG
	RTS			;AND RETURN
;
;	SHIFT FR0 LEFT 4 BIT POSITIONS (ADDR=DBE4)
;
	ORG	AFP+$3E4
SH0L4	LDX	#FR0
SHL4	LDY	#4
SHLM	ASL	5,X
	ROL	4,X
	ROL	3,X
	ROL	2,X
	ROL	1,X
	ROL	0,X
	DEY
	BNE	SHLM
	RTS
;
MAYBE	CMP	#'9'+1
	BCS	BADCH
;
GDCHR	CLC
	DEC	CIX		;ADJUST INDEX BACK (NOT INCREMENTED)
	RTS			;AND RETURN
;
	ORG	AFP+$400	;NORMALIZE ENTRY POINT
NORMAL	JMP	FNORM		;MOVED UP INTO THE FADD/FSUB ROUTINES
;
;
;	DIVISION LOOP (GENERATE RESULTANT FRACTION ONLY)
;
;
FDIVLP	STY	FRE+FPREC,X	;ZERO NEW LOW ORDER BYTE
	BMI	SUB10E		;THEN GO TO LOOP NORMAL ENTRY
;
SUB10N	INY			;ADD ANOTHER 10 TO QUOTIENT LOW BYTE
SUB10E	LDA	FRE+6,X
	SBC	FR2+5
	STA	FRE+6,X
	LDA	FRE+5,X
	SBC	FR2+4
	STA	FRE+5,X
	LDA	FRE+4,X
	SBC	FR2+3
	STA	FRE+4,X
	LDA	FRE+3,X
	SBC	FR2+2
	STA	FRE+3,X
	LDA	FRE+2,X
	SBC	FR2+1
	STA	FRE+2,X
	LDA	FRE+1,X
	SBC	FR2
	STA	FRE+1,X
	BCS	SUB10N		;IF NOT NEGATIVE YET, CONTINUE LOOPING
;
	TYA
	ASL	A
	ASL	A		;SHIFT QUOTIENT DIGIT LEFT 4 BITS
	ASL	A
	ASL	A
	ORA	#10		;THEN ADD IN UNITS DIGIT (FIRST GUESS)
	TAY			;RESTORE TO Y-REG
;
ADD01N	LDA	FRE+6,X
	ADC	FR1+5
	STA	FRE+6,X
	LDA	FRE+5,X
	ADC	FR1+4
	STA	FRE+5,X
	LDA	FRE+4,X
	ADC	FR1+3
	STA	FRE+4,X
	LDA	FRE+3,X
	ADC	FR1+2
	STA	FRE+3,X
	LDA	FRE+2,X
	ADC	FR1+1
	STA	FRE+2,X
	LDA	FRE+1,X
	ADC	#0
	STA	FRE+1,X
	DEY			;DECREMENT THE 1-S DIGIT
	BCC	ADD01N		;AND IF NOT POSITIVE, DO ANOTHER ADD OF DIVISOR
	STY	FRE+1,X		;ELSE, STORE RESULTANT 2 DIGITS
	TAY			;REZERO THE Y-ACCUMULATOR
	INX			;THEN SEE IF DIVIDE COMPLETED
	BMI	FDIVLP		;IF NOT, GO GENERATE NEXT 2 DIGITS
	JMP	FNDIV		;IF SO, GO NORMALIZE RESULT AND EXIT
;
DOMULT	TAY			;SAVE NUMBER OF TIMES TO ADD IN Y-REG
	CLC
MULLP	LDA	Z3+1
	ADC	5,X
	STA	Z3+1
	LDA	FR0+5
	ADC	4,X
	STA	FR0+5
	LDA	FR0+4
	ADC	3,X
	STA	FR0+4
	LDA	FR0+3
	ADC	2,X
	STA	FR0+3
	LDA	FR0+2
	ADC	1,X
	STA	FR0+2
	LDA	FR0+1
	ADC	0,X
	STA	FR0+1
	DEY			;ALL ADDITIONS DONE?
	BNE	MULLP		;IF NOT GO DO THE NEXT ONE
	RTS			;ELSE, RETURN
;
;	TABLE TO CONVERT FROM DECIMAL TO BINARY (BITWISE) QUICKLY
;
BITTAB	=	*-2
	DW	0,1,3,7
	DW	9,19,39,79
	DW	99,199,399,799
	DW	999,1999,3999,7999
	DW	9999,19999,-25537,-1
	DW	-1,-1,-1,-1
	SUBTTL 'GENERALLY USEFUL SUBROUTINES'
;
;	CONVERT PACKED DECIMAL MANTISSA (WITH DECIMAL INFORMATION)
;	   TO AN ASCII (NUMERIC) CHARACTER STRING
;
PRTDGT	LSR	A		;GET NUMBER OF BYTES BEFORE DECIMAL POINT
	ROR	CIX		;SAVE LOW BIT AS E-FORMAT FLAG
	STA	Z2		;SAVE DIGITS BEFORE DECIMAL POINT
	LDX	#1-FPREC	;SET UP BYTE COUNTER FOR A F.P. NUMBER
	LDY	#0		;ZERO BOTH INDICES
	INC	Z2		;OFFSET FIRST DECREMENT
DGTLP	JSR	CDPNT		;CONDITIONALLY PRINT A DECIMAL POINT
	LDA	FR0+FPREC,X
	LSR	A
	LSR	A		;POSITION HIGH 4-BIT DIGIT
	LSR	A
	LSR	A
	JSR	CVASC		;PUT THAT CHARACTER IN THE BUFFER
	LDA	FR0+FPREC,X
	AND	#$F		;EXTRACT SECOND DIGIT
	JSR	CVASC		;AND PUT IT INTO THE BUFFER
	INX			;NEXT DIGIT PAIR
	BMI	DGTLP		;IF NOT FINISHED, PROCESS THEM
;
	JSR	CDPNT		;ELSE, SEE IF TRAILING DECIMAL REQ.
	LDA	#'0'		;CHECK FOR LEADING DECIMAL OR ZERO
	CMP	LBUFF
	BEQ	TRNKZE		;IF ZERO, CLIP IT OFF LEAVING 9 DIGIT RESULT
	BCC	DECSFT		;IF SIGNIFICANT DIGIT, MOVE DECIMAL IF IN E-FORMAT
	DEC	INBUFF		;ELSE, IT IS A DECIMAL, BACK UP AND INSERT A
	STA	LBUFF-1		;LEADING ZERO!
	BCS	ZSCAN		;THEN STRIP OFF TRAILING ZEROS
;
TRNKZE	INC	INBUFF		;STEP TO SECOND DIGIT (WHICH CANNOT BE ZERO!)
	BCS	ZSCAN
;
DECSFT	LDA	CIX		;SEE IF IN E-FORMAT TRANSLATION
	BPL	ZSCAN		;IF NOT, BUFFER IS OK, STRIP OFF TRAILING ZEROS
	LDA	LBUFF+1
	STA	LBUFF+2		;ELSE, MOVE DECIMAL POINT LEFT ONE DIGIT
	LDA	#'.'
	STA	LBUFF+1
	INC	EEXP		;AND ADJUST EXPONENT FOR THE MOVEMENT
;
;	SCAN TO ELIMINATE TRAILING ZEROES
;
ZSCAN	LDY	#11		;START WITH DIGIT 10 (AFTER FOLLOWING 'DEC')
ZSCNLP	DEY
	BEQ	LSTCHR		;IF FIRST CHARACTER, THEN USE 1 CHARACTER
	LDA	LBUFF,Y		;GET THE LAST CHARACTER
	CMP	#$30		;IS IT A TRAILING ZERO?
	BEQ	ZSCNLP		;IF SO, CONTINUE SCAN TIL NONZERO OR FIRST CHARACTER
	CMP	#'.'		;IF NOT, IS IT A DECIMAL POINT?
	BNE	TRXIT		;NO, THEN THIS IS THE LAST CHARACTER
	DEY			;YES, THEN DIGIT BEFORE IT IS THE LAST CHARACTER
LSTCHR	LDA	LBUFF,Y		;LOAD IT AND RETURN TO CALLER
TRXIT	RTS
	SUBTTL 'POLYNOMIAL EVALUATION ROUTINE'
	ORG	AFP+$522
RSTARG	LDX	#FPREC-1	;COPY PLYARG TO FR1
RSTALP	LDA	PLYARG,X
	STA	FR1,X
	DEX
	BPL	RSTALP
	RTS
;
LDARG	LDX	#FPREC-1
LDALP	LDA	PLYARG,X
	STA	FR0,X
	DEX
	BPL	LDALP
	RTS
;
PLYONE	JSR	SAVARG		;SAVE ARGUMENT AND POLYNOMIAL ADDRESS
CTUONE	STA	CIX		;SAVE ORDER OF POLYNOMIAL
	BNE	PLYADD		;ENTER LOOP WITH AN ADD
	RTS			;IF A=0, VALUE IS ARGUMENT
;
;	POLYNOMIAL EVALUATION ENTRY (ADDR=DD40)
;
PLYEVL	JSR	SAVARG		;SAVE FR0, X, Y AS ARGUMENTS
CTUEVL	STA	CIX		;SEE IF MORE THAN 1 TERM
	JSR	LDPLY		;LOAD FIRST COEFFICIENT
	DEC	CIX
	BNE	PLYENT		;IF OK, GO DO MULTIPLY AND ADD
	RTS			;ELSE, JUST RETURN
;
PLYLP	DEC	CIX		;END OF POLYNOMIAL?
	BEQ	PLYXIT		;YES, EXIT
	JSR	RSTARG		;RESTORE ARGUMENT
PLYENT	JSR	FMUL		;ARGUMENT TIMES PARTIAL SUM
	BCS	PLYXIT		;EXIT IF OVERFLOW HERE!
PLYADD	JSR	LDPLY		;LOAD NEXT COEFFICIENT IN FR1
	JSR	FADD		;ADD NEXT COEFFICIENT
	BCC	PLYLP
PLYXIT	RTS			;ELSE, RETURN
;
LDPLY	LDY	#FPREC-1	;INDEX BY Y SINCE INDIRECT REFERENCE
LDPLYL	LDA	(FPTR2),Y	;GET ARGUMENT BYTE
	STA	FR1,Y		;STORE IN FR1
	DEY
	BPL	LDPLYL		;DO ALL 6 BYTES
	CLC			;THEN ADVANCE THE POINTER
	LDA	FPTR2
	ADC	#FPREC		;BY THE LENGTH OF 1 FLOATING POINT NUMBER
	STA	FPTR2
	BCC	LDPXIT		;EXIT IF NO CARRY
	INC	FPTR2+1		;ELSE, BUMP UPPER BYTE
LDPXIT	RTS			;AND RETURN
;
SAVARG	STY	FPTR2+1
	STX	FPTR2		;STORE ADDRESS OF POLYNOMIAL
PUTARG	TAY			;SAVE ACC
	LDX	#FPREC-1	;COPY FR0 TO PLYARG
SAVALP	LDA	FR0,X
	STA	PLYARG,X
	DEX
	BPL	SAVALP		;LOOP UNTIL ALL 6 BYTES MOVED
	TYA			;RESTORE ACC
	RTS
	SUBTTL 'MEMORY TO MEMORY MOVE SUBROUTINES'
;
;	LOAD FLOATING REGISTER 0
;
	ORG	AFP+$589
FLD0R	STY	FLPTR+1		;STORE (Y,X) AS ADDRESS
	STX	FLPTR
FLD0P	LDY	#FPREC-1
FLD0L	LDA	(FLPTR),Y
	STA	FR0,Y
	DEY
	BPL	FLD0L		;COPY ALL BYTES OF THE NUMBER
	RTS
;
;	LOAD FLOATING REGISTER 1
;
	ORG	AFP+$598
FLD1R	STY	FLPTR+1		;STORE (Y,X) AS ADDRESS
	STX	FLPTR
FLD1P	LDY	#FPREC-1
FLD1L	LDA	(FLPTR),Y
	STA	FR1,Y
	DEY
	BPL	FLD1L		;COPY ALL BYTES
	RTS
;
;	STORE FLOATING REGISTER 0
;
FST0R	STY	FLPTR+1		;STORE (Y,X) AS ADDRESS OF TARGET
	STX	FLPTR
FST0P	LDY	#FPREC-1
FST0L	LDA	FR0,Y
	STA	(FLPTR),Y
	DEY
	BPL	FST0L		;LOOP UNTIL ENTIRE FIELD IS STORED
	RTS
;
;	MOVE FR0 TO FR1
;
	ORG	AFP+$5B6
FMOVE	LDX	#FPREC-1
FMOVL	LDA	FR0,X
	STA	FR1,X
	DEX
	BPL	FMOVL
OVFEXP	RTS
	SUBTTL 'EXPONENTIAL FUNCTIONS'
;
;	BASE e EXPONENTIAL FUNCTION
;
	ORG	AFP+$5C0
EXP	LDY	#HIGH[INVL10]
	LDX	#LOW[INVL10]
	JSR	FLD1R		;MULTIPLY ARGUMENT TO CONVERT FUNCTION TO EXP10
	JSR	FMUL
	BCS	OVFEXP		;IF OVERFLOW, RETURN CARRY SET
;
;	BASE 10 EXPONENTIAL FUNCTION
;
EXP10	JSR	FMOVE		;SAVE UNMODIFIED ARGUMENT (PRECISION REQ.)
	ASL	FR0
	LSR	FR0		;STRIP OFF SIGN BIT
	JSR	FPI		;CONVERT TO INTEGER
	SEC			;SAVE A BYTE BY SETTING CARRY BEFORE TEST
	LDA	FR1		;SEE WHAT SIGN WAS
	BPL	PLSEXP		;IF EXPONENT IS ALREADY POSITIVE
	LDA	#128
	SBC	FR0		;NEGATE RESULT OF IFP CALL IF NOT
	STA	Z1+1
	LDA	#0
	SBC	FR0+1
	BEQ	EXPRV
	JMP	RZERO
;
PLSEXP	LDA	FR0
	ADC	#127		;SEE IF EXPONENT IS IN RANGE
	STA	Z1+1
	BCS	OVFEXP		;IF EXPONENT BETWEEN 128 AND 255
	SEC			;RETURN ERROR
	LDA	FR0+1		;IS THE EXPONENT BETWEEN -128 AND 127?
	BNE	OVFEXP		;<-128 OR > 255
EXPRV	STA	Z1		;MARK RANGE AS UNSHIFTED
	JSR	IFP		;BACK TO FLOATING POINT
	ASL	FR0		;GET RID OF INTEGER SIGN (ALWAYS +)
	LDA	#$7F		;COPY COMPLIMENT OF SIGN OF FR1 TO CY
	CMP	FR1
	ROR	FR0		;PUT NEW SIGN BACK INTO FR0
	JSR	FADD		;GENERATE FRACTIONAL PART OF EXPONENT
;
	LDA	FR0		;SEE IF FRACTION > 0.25
	AND	#$7F
	CMP	#$3F		;IF EXPONENT NOT 3F THEN ITS NOT
	BNE	EVALG
	LDA	FR0+1		;ELSE, LOOK AT UPPER 2 DIGITS
	CMP	#$25
	BCC	EVALG		;IF < 25 THEN FRACTION IS OK
	STA	Z1		;MARK AS NEEDING ADJUSTMENT
	JSR	GETHALF
	LDA	FR0
	ASL	FR1
	ASL	A
	ROR	FR1		;COPY SIGN TO 0.5 LOADED INTO FR1
	BPL	NODEC
	DEC	Z1+1
NODEC	JSR	FSUB
;
EVALG	LDY	#HIGH[FSCR]	;SAVE V (REDUCED ARGUMENT) IN FSCR
	LDX	#LOW[FSCR]
	JSR	FST0R
	JSR	FMOVE
	JSR	FMUL		;SQUARE V
	LDY	#HIGH[EXPPLY]
	LDX	#LOW[EXPPLY]	;GENERATE P(V^2)
	LDA	#2		;2 TERM POLYNOMIAL
	JSR	PLYEVL
	JSR	FLD1P		;GET ORIGINAL ARGUMENT
	JSR	FMUL		;COMPUTE V*P(V^2)
	JSR	FST0P		;SAVE RESULT
	JSR	LDARG		;COPY ARG TO FR0
	LDA	#2
	JSR	CTUONE		;CONTINUE (ARG AND POLY PTR BOTH RETAINED)
	JSR	FLD1P		;GET NUMERATOR
	JSR	FSUB		;COMPUTE DENOMINATOR (Q-V*P)
	JSR	FMOVE		;PUT IN FR1
	JSR	FLD0P		;GET NUMERATOR
	JSR	FDIV
	JSR	GETHALF
	JSR	FADD
	JSR	FMOVE		;THEN DOUBLE RESULT
	JSR	FADD
	LDA	Z1		;SEE IF ADJUSTMENT REQUIRED
	BEQ	NOSQR
	JSR	LDPMUL		;ELSE, LOAD FR1 WITH SQR(10)
NOSQR	LSR	Z1+1		;THEN SEE IF *10 REQUIRED
	BCC	NOSFT		;IF NOT, SKIP TO EXPONENT BUILD
	LDY	#HIGH[C10]
	LDX	#LOW[C10]
	JSR	FLD1R		;MULTIPLY RESULT BY 10
	JSR	FMUL
NOSFT	CLC
	LDA	FR0
	ADC	Z1+1		;ADD EXPONENT TO ORIGINAL
	SBC	#$3F
	STA	FR0		;GENERATED EXP(X) COMPLETE!
	CLC			;TURN OFF CARRY (RANGE ERROR) FLAG
OVFLOG	RTS
;
;	REDUCE AN ARGUMENT WITH THE FORMULA REDARG=(ARG-K)/(ARG+K)
;	(ADDR=DE95)
;
	ORG	AFP+$68D
LOGRED	BCS	RARG1		;IF SO, SKIP MULTIPLY BY 10
	DEC	Z1
	STX	FR1+1		;CHANGING CONSTANT TO 0.05
	BCC	RARG1
;
REDARG	JSR	FLD1R		;GET K FROM MEMORY INTO FR1
RARG1	JSR	PUTARG		;SAVE UNREDUCED ARGUMENT IN PLYARG
	JSR	FADD		;COMPUTE ARG+K
	LDY	#HIGH[FSCR]	;SAVE DENOMINATOR IN FSCR
	LDX	#LOW[FSCR]
	JSR	FST0R
	JSR	LDARG		;RESTORE UNREDUCED ARGUMENT TO FR0
	JSR	FSUB
	JMP	FLDDIV
	SUBTTL 'LOGRITHMIC FUNCTIONS'
	ORG	AFP+$6AF	;PUT RIGHT BEFORE THE LOG ENTRY POINT
EXPPLY	DB	$40,$08,$70,$38,$83,$65
	DB	$40,$69,$01,$09,$31,$26
;
	DB	$40,$34,$04,$40,$20,$67
	DB	$40,$59,$94,$21,$33,$27
;
SQR10	DB	$40,$03,$16,$22,$77,$66
;
;	LOGRITHM FUNCTIONS (BASE e, ADDR=DECD)
;
	ORG	AFP+$6CD	;ATARI DEFINED ENTRY POINT
LOG	LDA	#$80		;SET FLAG TO INDICATE THIS IS NOT BASE 10 LOG
	BNE	LOGS
;
;	LOGRITHM FUNCTIONS (BASE 10, ADDR=DED1)
;
LOG10	LDA	#0
LOGS	STA	Z1+1		;STORE FLAG TO INDICATE WHICH CLASS OF LOGS
	LDA	FR0
	ASL	A
	BCS	OVFLOG		;IF LOG OVERFLOW (NEGATIVE ARG.)
	SBC	#$7D
	STA	Z1		;SAVE RANGE DATA
	LDA	FR0+1		;IS NUMBER > 0.1?
	CMP	#$10
	BCS	NOLSFT		;IF SO, SHIFT DENOMINATOR RIGHT 1 DIGIT
	DEC	Z1		;UPDATE EXPONENT FOR LEADING ZERO ELIMINATED
	JSR	SH0L4		;ELSE, SHIFT NUMERATOR LEFT 1 DIGIT
NOLSFT	LDA	#$3F		;INITIAL VALUE FOR EXPONENT
	STA	FR0
	JSR	GETHALF		;REDUCTION CONSTANT = 0.50
	JSR	FMUL		;HALVE ARGUMENT
	LDA	FR0+1
	LDX	#$05
	CMP	#$16		;IS THE REDUCED ARGUMENT > 0.32 (SQR(0.1))
;
	JSR	LOGRED		;REDUCE ARGUMENT VIA Z=(X-1)/(X+1)
	LDX	FR0
	BPL	LNORM
	INC	FR0+4-$BF,X		;FORCE NEGATIVE ROUNDING
	INC	FR0+4-$BF,X
LNORM
	JSR	FST0P		;THEN STORE Z IN 'FSCR'
	JSR	FMOVE
	JSR	FMUL		;SQUARE IT
	LDY	#HIGH[LOGPLY]
	LDX	#LOW[LOGPLY]
	LDA	#3
	JSR	PLYONE		;CALCULATE DENOMINATOR OF RAT. FRACTION
	LDX	#LOW[FSCR1]
	JSR	FST0R+2		;NOTE THAT HIGH BYTE OF FLPTR IS UNCHANGED
	JSR	LDARG		;PUT ARGUMENT BACK INTO FR0
	JSR	RFCONT		;CALC. DENOM. & R(Z), THE RAT. FRAC.
;
	JSR	RSTARG		;THEN MULTIPLY BY 'Z'
	JSR	FMUL
	JSR	LDPLY
	JSR	FADD
	LDX	#LOW[FSCR]
	JSR	FLD1R+2		;NOTE THAT HIGH BYTE OF FLPTR IS UNCHANGED
	JSR	FMUL
	JSR	PUTARG
	INX			;CONVERT X (FROM FMOVE) TO ZERO
	STX	FR0+1		;ZERO HIGH BYTE OF INTEGER (EXPONENT)
	LDA	Z1
	BPL	INTPRT		;IF EXPONENT IS NEGATIVE, THEN GET ABSOLUTE VALUE
	SEC
	TXA			;ZERO ACC
	SBC	Z1		;SUBTRACT FROM 0 (NEGATE)
INTPRT	STA	FR0		;STORE Z1 OR -Z1 AS APPROPRIATE
	JSR	IFP
	ASL	FR0		;NEXT, CHANGE SIGN OF RESULT IF NEGATIVE
	ASL	Z1
	ROR	FR0
	JSR	GETHALF
	JSR	FMUL
	JSR	FMOVE
	JSR	LDARG
;
	JSR	FADD		;ADD INTEGER TO FRACTION
	JSR	FADD
	LDA	Z1+1
	BEQ	LOG10E		;IF LOG BASE 10
LDPMUL	JSR	LDPLY		;ELSE, MULTIPLY RESULT BY LN(10)
	JMP	FMUL
;
;	CONSTANTS USED IN THE FLOATING POINT PACKAGE
;
	ORG	AFP+$76C	;REFERENCED BY BASIC SIN/COS ROUTINE
HALF	DB	$3F,$50,$00,$00,$00,$00
;
;	COEFFICIENTS USED IN THE LOG POLYNOMIALS
;
LOGPLY	DB	$C0,$08,$19,$08,$00,$45	; -8.19080045
	DB	$40,$16,$96,$69,$81,$40; 16.96698140
	DB	$C0,$10,$07,$04,$06,$95	;-10.07040695
;
LOG10E	=	*+4	;RETURN INSTRUCTION
	DB	$BF,$67,$35,$81,$60,$15;-0.6735816015
	DB	$40,$03,$16,$30,$34,$92	; 3.16303492
	DB	$C0,2,$91,$56,$81,$44	;-2.91568144
;
	DB	$3F,$86,$85,$88,$96,$38;  0.8685889638
LN10	DB	$40,$2,$30,$25,$85,$9;  2.30258509
;
INVL10	DB	$3F,$43,$42,$94,$48,$19
;
C10	DB	$40,$10,$00,$00,$00,$00
;
;	POLYNOMIAL FOR SIN/COS FUNCTIONS (11 COEFFICIENTS)
;
	ORG	AFP+$7AE
PLYSIN	DB	$3E,$16,$05,$44,$49,$00 ;REF BY BASIC SIN/COS ROUTINES
	DB	$BE,$95,$68,$38,$45,$00
	DB	$3F,$02,$68,$79,$94,$16
	DB	$BF,$04,$92,$78,$90,$80
	DB	$3F,$07,$03,$15,$20,$00
	DB	$BF,$08,$92,$29,$12,$44
	DB	$3F,$11,$08,$40,$09,$11
	DB	$BF,$14,$28,$31,$56,$04
	DB	$3F,$19,$99,$98,$77,$44
	DB	$BF,$33,$33,$33,$31,$13
NONE	DB	$3F,$99,$99,$99,$99,$99 ;ALMOST EQUAL TO 1.0 (USED FOR ROUNDOFF PROBLEM)
;
;	SIN OF 45 DEG.
;
SIN45	DB	$3F,$78,$53,$98,$16,$34
;
;	CONVERT A BYTE TO TWO HEX DIGITSIN (A,X)
;
CVTHEX	PHA			;SAVE UPPER DIGIT
	AND	#$0F
	JSR	HEXDGT		;CONVERT LOWER DIGIT
	TAX
	JMP	CTUHEX		;RESTORE AND CONVERT UPPER DIGIT
	END

