!!!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.