; FAST	FLOATING POINT	(ATARI)
; 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

//	.ou	fastfp.obj

	opt h-

ROMBASE =	$D800	; STARTING ADDRESS OF F.P. ROM
FPREC	=	6	; NUMBER OF BYTES IN A F.P. NUMBER

; BASE	PAGE DEFINITIONS
	.or	$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
	.or	$057E
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

; FLOATING	POINT/ASCII CONVERSION ROUTINES

; ASCII TO	FLOATING POINT CONVERSION ROUTINE (ADDR=D800)
	.or	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
	ASL		; MULTIPLY PREVIOUS TOTAL BY 10
	ADC	FRX
	ASL
	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
	LSR
	LSR
	LSR		; 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		; 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)
	.or	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		; 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	#$2F	; '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	#$8a+'0'; 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
	.by	"CPYRT.1984,MARSLETT"

; INTEGER TO FLOATING	POINT CONTINUATION
IFPSU	STY	FR0+5
	LDY	#16	; SIXTEEN BITS IN NUMBER TO BE CONVERTED
IFPS	ASL	FR0+1
	ROL		; 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		; ELSE, MULTIPLY BY 16 (NUMBER OF BITS * 2)
	ASL
	ASL
	ASL
	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)
	.he	60	; filler byte

	.or	AFP+$01AA
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)
	.or	AFP+$01D2
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	#$09	; CONVERSION USES A VERY FUNNY ALGORITHM
	ADC	#'9'
	CLD
	RTS

; FLOATING	POINT ADD/SUBTRACT CODE (SPREAD ABOUT YOU SEE)
	.BY	0	; filler byte

	.or	AFP+$01E7	; 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	#>LBUFF	; COPY ADDRESS OF LBUFF INTO INBUFF
	STA	INBUFF+1
	LDA	#<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

	.he	60	; filler byte

; ADD/SUBTRACT ROUTINES
	.or	AFP+$0260

; 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
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

; FLOATING	(DECIMAL) MULTIPLY ROUTINE
	.he	CA	; filler byte

	.or	AFP+$02D5	; 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		; 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)


	.he	4C 04	; filler bytes

; FLOATING	POINT DIVIDE (DECIMAL) ROUTINE ENTRY POINT
	.or	AFP+$0320	; 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
	LSR
	LSR
	LSR		; 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	#$0F
	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	#>HALF
	LDX	#<HALF
	JMP	FLD1R

; SKIP	OVER A STRING OF BLANKS IN INPUT BUFFER (ADDR=DBA1)
	.or	AFP+$03A1
SKBLK	LDY	CIX	; SKIP BLANKS IN BUFFER
	LDA	#$20	; (SPACE)
	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)
	.or	AFP+$03AF
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)
	.he	85	; filler byte

	.or	AFP+$03E4
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	#$3A	; '9'+1
	BCS	BADCH

GDCHR	CLC
	DEC	CIX	; ADJUST INDEX BACK (NOT INCREMENTED)
	RTS		; AND RETURN

	.or	AFP+$0400	; 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
	ASL		; SHIFT QUOTIENT DIGIT LEFT 4 BITS
	ASL
	ASL
	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
	.wo	0 1 3 7
	.wo	9 19 39 79
	.wo	99 199 399	799
	.wo	999 1999 3999 7999
	.wo	9999 19999	-25537 -1
	.wo	-1 -1 -1 -1

; GENERALLY USEFUL SUBROUTINES

; CONVERT PACKED DECIMAL MANTISSA (WITH DECIMAL INFORMATION)
;    TO AN	ASCII (NUMERIC) CHARACTER STRING
PRTDGT	LSR		; 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
	LSR		; POSITION HIGH 4-BIT DIGIT
	LSR
	LSR
	JSR	CVASC	; PUT THAT CHARACTER IN THE BUFFER
	LDA	FR0+FPREC,X
	AND	#$0F	; 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

	.he	95 00 ca 88 ; filler bytes

; POLYNOMIAL EVALUATION ROUTINE
	.or	AFP+$0522
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

; MEMORY	TO MEMORY MOVE SUBROUTINES

; LOAD	FLOATING REGISTER 0
	.or	AFP+$0589
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
	.or	AFP+$0598
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
	.or	AFP+$05B6
FMOVE	LDX	#FPREC-1
FMOVL	LDA	FR0,X
	STA	FR1,X
	DEX
	BPL	FMOVL
OVFEXP	RTS

; EXPONENTIAL FUNCTIONS
	.or	AFP+$05C0
EXP	LDY	#>INVL10
	LDX	#<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
	ROR	FR1	; COPY SIGN TO 0.5 LOADED INTO FR1
	BPL	NODEC
	DEC	Z1+1
NODEC	JSR	FSUB

EVALG	LDY	#>FSCR	; SAVE V (REDUCED ARGUMENT) IN FSCR
	LDX	#<FSCR
	JSR	FST0R
	JSR	FMOVE
	JSR	FMUL	; SQUARE V
	LDY	#>EXPPLY
	LDX	#<EXPPLY
	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	#>C10
	LDX	#<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)
	.he	43 42 94	; filler bytes

	.or	AFP+$068D
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	#>FSCR	; SAVE DENOMINATOR IN FSCR
	LDX	#<FSCR
	JSR	FST0R
	JSR	LDARG	; RESTORE UNREDUCED ARGUMENT TO FR0
	JSR	FSUB
	JMP	FLDDIV


	.he	20	; filler byte

; LOGRITHMIC FUNCTIONS

	.or	AFP+$06AF	; PUT RIGHT BEFORE THE LOG ENTRY POINT
EXPPLY	.he	40 08 70 38 83 65 ;  8.70388365
	.he	40 69 01 09 31 26 ; 69.01093126
	.he	40 34 04 40 20 67 ; 34.04402067
	.he	40 59 94 21 33 27 ; 59.94213327
SQR10	.he	40 03 16 22 77 66 ;  3.16227766

; LOGRITHM	FUNCTIONS (BASE e, ADDR=DECD)
	.or	AFP+$06CD	; 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
	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	#>LOGPLY
	LDX	#<LOGPLY
	LDA	#3
	JSR	PLYONE	; CALCULATE DENOMINATOR OF RAT. FRACTION
	LDX	#<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	#<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


	.he	77 66	; filler bytes

; CONSTANTS USED IN THE FLOATING POINT PACKAGE
	.or	AFP+$076C	; REFERENCED BY BASIC SIN/COS ROUTINE
HALF	.he	3F 50 00 00 00 00 ; 0.5

; COEFFICIENTS USED IN THE LOG POLYNOMIALS
LOGPLY	.he	C0 08 19 08 00 45 ; -8.19080045
	.he	40 16 96 69 81 40 ; 16.96698140
	.he	C0 10 07 04 06 95 ;-10.07040695

LOG10E	=	*+4	; RETURN INSTRUCTION
	.he	BF 67 35 81 60 15 ; -0.6735816015
	.he	40 03 16 30 34 92 ;  3.16303492
	.he	C0 02 91 56 81 44 ; -2.91568144

	.he	3F 86 85 88 96 38 ; 0.8685889638
LN10	.he	40 02 30 25 85 09 ; 2.30258509

INVL10	.he	3F 43 42 94 48 19 ; 0.4342944819

C10	.he	40 10 00 00 00 00 ; 10

; POLYNOMIAL FOR SIN/COS FUNCTIONS (11 COEFFICIENTS)
	.or	AFP+$07AE
PLYSIN	.he	3E 16 05 44 49 00 ;  1.6054449E-03  REF BY BASIC SIN/COS ROUTINES
	.he	BE 95 68 38 45 00 ; -9.5683845E-03
	.he	3F 02 68 79 94 16 ;  0.0268799416
	.he	BF 04 92 78 90 80 ; -0.049278908
	.he	3F 07 03 15 20 00 ;  0.0703152
	.he	BF 08 92 29 12 44 ; -0.0892291244
	.he	3F 11 08 40 09 11 ;  0.1108400911
	.he	BF 14 28 31 56 04 ; -0.1428315604
	.he	3F 19 99 98 77 44 ;  0.1999987744
	.he	BF 33 33 33 31 13 ; -0.3333333113
NONE	.he	3F 99 99 99 99 99 ;  0.9999999999   ALMOST EQUAL TO 1.0 (USED FOR ROUNDOFF PROBLEM)

; SIN OF 45 DEG.
SIN45	.he	3F 78 53 98 16 34 ; 0.7853981634

; 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

	.en		; THE END!
