FAST FLOATING POINT source code for the ATARI#
Copyright (C) 1981 to 1984 by Newell Industries & Charles W. MarslettAtariWiki 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
source code into MAC/65 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#
 |
ATR image#
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#
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