FAST FLOATING POINT source code for the ATARI ; Copyright (C) 1981 to 1984 by Newell Industries & Charles W. Marslett#
AtariWiki is very, very proud Newell Industries & Charles W. Marslett gave us the source code for the FAST FLOATING POINT routines.
Picture#
 |
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
