FAST FLOATING POINT source code for the ATARI ; Copyright (C) 1981 to 1984 by Newell Industries & Charles W. Marslett#
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