!!!FAST FLOATING POINT source code for the ATARI
__Copyright (C) 1981 to 1984 by Newell Industries & Charles W. Marslett__\\
\\
[{TableOfContents }]\\
\\
AtariWiki is very, very proud Newell Industries & Charles W. Marslett gave us the source code for the FAST FLOATING POINT routines for PD. Thank you so much Newell Industries & Charles W. Marslett, that is not a little gift, that is a giant leap for the community worldwide and will result in rewrite all Atari OS and burn them on EPROM. We further thank Robert 'Bob' Puff for converting the original [AMAC|https://atariwiki.org/wiki/Wiki.jsp?page=Atari%20Macro%20Assembler] source code into [MAC/65|https://atariwiki.org/wiki/Wiki.jsp?page=Mac65] source code. Thank you all so much, the community is in great debt for the work you have done! :-)\\
\\
Please don't misunderstand this work, it is 'just' fast or even up to 3.5 times faster than the original routines! Indeed, it is way more! The routines give the user reliable results, too! That is very important for calculations. Further, they maintain the jump addresses from the original routines from Atari. Therefore, no trouble, just have fun and enjoy.

!!Picture

[{Image src='Fastchip.jpg' width=655 height=452 }]
Ad from Newell Industries from 1981:

!!ATR image
* [FastChip.atr|FastChip.atr]

HEADER.M65, FASTFP1.M65:
  MAC/65 Tokenized source. Load the
  header file, and assemble from it.

FASTFP.OBJ:
  Object file produced from above
  files, when assembled at $D800.

FASTFP.ASM:
  Original AMAC source file (LISTed
  format).

LDFAST.M65:
  MAC/65 Tokenized source for a
  program to load D1:FASTFP.OBJ into
  the RAM under the OS in XL/XE
  machines.

LDFAST.ASM:
  Original AMAC source for above.

FASTFP.DOC:
  Original document file listing the
  routines contained in the faschip.

!!AMAC source code file
* [Fast Chip source code file for AMAC|FASTFP.ASM]

!!Source Code of the final revision F

{{{
	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
}}}

!!FLOATING POINT ROM ENTRY POINTS

{{{
           FLOATING POINT ROM ENTRY POINTS

Entry   Address  Function
Point
AFP       D800   Extract a floating point number from an ASCII
                     string (FR0<--[INBUFF+CIX])
FASC      D8E6   Convert a floating point number to an ASCII
                     string (returns pointer in INBUFF)
IFP       D9AA   Convert a 2-byte integer (FR0) to a floating
                     point number (in FR0)
FPI       D9D2   Convert a floating point number to an integer
ZFR0      DA44   Zero the floating point register (FR0)
ZF1       DA46   Zero 6 zero page bytes pointed to by "X"
ZPG0      DA48   Zero "Y" bytes pointed to by "X"
INITBF    DA51   Store the address of LBUFF in INBUFF
DBLZ2     DA5A   Shift Z2 left one bit (16-bit High/Low format)
FSUB      DA60   Subtract FR1 from FR0
FADD      DA66   Add FR1 to FR0 (result in FR0)
FMUL      DADB   Multiply FR0 by FR1 (result in FR0)
FDIV      DB28   Divide FR0 by FR1 (result in FR0)
SKBLK     DBA1   Skip 0 or more blanks pointed to by [INBUFF,CIX],
                     result modifies CIX
GCHAR     DBAF   Read a byte, convert it as an ASCII decimal
                     number, set CY if it is not
SH0L4     DBE4   Shift the contents of FR0 left 4 bits
NORMAL    DC00   Normalize the contents of FR0
PLYEVL    DD40   Evaluate the polynomial [Y.X](FR0), with A terms
FLD0R     DD89   Load FR0 from [Y.X]
FLD0P     DD8D   Load FR0 from [FLPTR]
FLD1R     DD98   Load FR1 from [Y.X]
FLD1P     DD9C   Load FR1 from [FLPTR]
FST0R     DDA7   Store FR0 into 6 bytes pointed to by [Y.X]
FST0P     DDAB   Store FR0 into [FLPTR]
FMOVE     DDB6   Copy FR0 over into FR1
EXP       DDC0   FR0 <-- exponential function of FR0
EXP10     DDCC   FR0 <-- 10 ^ FR0 (exponent of 10)
REDARG    DE95   FR0 <-- (FR0-[Y.X])/(FR0+[Y.X])
LOG       DECD   FR0 <-- natural log of FR0
LOG10     DED1   FR0 <-- base 10 log of FR0
HALF      DF6C   Constant = 0.5000000000
PLYSIN    DFAE   11 Constant table for SIN polynomial
NONE      DFEA   Constant = 0.9999999999
SIN45     DFF0   Constant = sin(45 deg.)


          Entry points not in the ATARI "D" ROM

RSTARG    DD22   Copy PLYARG over into FR1
LDARG     DD2D   Copy PLYARG over into FR0
PLYONE    DD38   Same as PLYEVL except implicit 1.0 coefficient
LDPLY     DD62   Copy [FPTR2] into FR1, add 6 to FPTR2
SAVARG    DD78   Store X into FPTR2, Y into FPTR2+1, copy FR0
                     over into PLYARG
}}}

!!Remark
drac030 from AtariAge found the last remaining thing to be changed in the hexdgt routine: SBC $9 should be changed into -> SBC #$9.