1010 *-------------------------------- 1020 * "SQR" FUNCTION 1030 * 1040 * <<< UNFORTUNATELY, RATHER THAN A NEWTON-RAPHSON >>> 1050 * <<< ITERATION, APPLESOFT USES EXPONENTIATION >>> 1060 * <<< SQR(X) = X^.5 >>> 1070 *-------------------------------- 1080 SQR JSR COPY.FAC.TO.ARG.ROUNDED 1090 LDA #CON.HALF SET UP POWER OF 0.5 1100 LDY /CON.HALF 1110 JSR LOAD.FAC.FROM.YA 1120 *-------------------------------- 1130 * EXPONENTIATION OPERATION 1140 * 1150 * ARG ^ FAC = EXP( LOG(ARG) * FAC ) 1160 *-------------------------------- 1170 FPWRT BEQ EXP IF FAC=0, ARG^FAC=EXP(0) 1180 LDA ARG IF ARG=0, ARG^FAC=0 1190 BNE .1 NEITHER IS ZERO 1200 JMP STA.IN.FAC.SIGN.AND.EXP SET FAC = 0 1210 .1 LDX #TEMP3 SAVE FAC IN TEMP3 1220 LDY #0 1230 JSR STORE.FAC.AT.YX.ROUNDED 1240 LDA ARG.SIGN NORMALLY, ARG MUST BE POSITIVE 1250 BPL .2 IT IS POSITIVE, SO ALL IS WELL 1260 JSR INT NEGATIVE, BUT OK IF INTEGRAL POWER 1270 LDA #TEMP3 SEE IF INT(FAC)=FAC 1280 LDY #0 1290 JSR FCOMP IS IT AN INTEGER POWER? 1300 BNE .2 NOT INTEGRAL, WILL CAUSE ERROR LATER 1310 TYA MAKE ARG SIGN + AS IT IS MOVED TO FAC 1320 LDY CHARAC INTEGRAL, SO ALLOW NEGATIVE ARG 1330 .2 JSR MFA MOVE ARGUMENT TO FAC 1340 TYA SAVE FLAG FOR NEGATIVE ARG (0=+) 1350 PHA 1360 JSR LOG GET LOG(ARG) 1370 LDA #TEMP3 MULTIPLY BY POWER 1380 LDY #0 1390 JSR FMULT 1400 JSR EXP E ^ LOG(FAC) 1410 PLA GET FLAG FOR NEGATIVE ARG 1420 LSR <<<LSR,BCC COULD BE MERELY BPL>>> 1430 BCC RTS.18 NOT NEGATIVE, FINISHED 1440 * NEGATIVE ARG, SO NEGATE RESULT 1450 *-------------------------------- 1460 * NEGATE VALUE IN FAC 1470 *-------------------------------- 1480 NEGOP LDA FAC IF FAC=0, NO NEED TO COMPLEMENT 1490 BEQ RTS.18 YES, FAC=0 1500 LDA FAC.SIGN NO, SO TOGGLE SIGN 1510 EOR #$FF 1520 STA FAC.SIGN 1530 RTS.18 RTS 1540 *-------------------------------- 1550 CON.LOG.E .HS 8138AA3B29 LOG(E) TO BASE 2 1560 *-------------------------------- 1570 POLY.EXP .DA #7 ( # OF TERMS IN POLYNOMIAL) - 1 1580 .HS 7134583E56 (LOG(2)^7)/8! 1590 .HS 74167EB31B (LOG(2)^6)/7! 1600 .HS 772FEEE385 (LOG(2)^5)/6! 1610 .HS 7A1D841C2A (LOG(2)^4)/5! 1620 .HS 7C6359580A (LOG(2)^3)/4! 1630 .HS 7E75FDE7C6 (LOG(2)^2)/3! 1640 .HS 8031721810 LOG(2)/2! 1650 .HS 8100000000 1 1660 *-------------------------------- 1670 * "EXP" FUNCTION 1680 * 1690 * FAC = E ^ FAC 1700 *-------------------------------- 1710 EXP LDA #CON.LOG.E CONVERT TO POWER OF TWO PROBLEM 1720 LDY /CON.LOG.E E^X = 2^(LOG2(E)*X) 1730 JSR FMULT 1740 LDA FAC.EXTENSION NON-STANDARD ROUNDING HERE 1750 ADC #$50 ROUND UP IF EXTENSION > $AF 1760 BCC .1 NO, DON'T ROUND UP 1770 JSR INCREMENT.MANTISSA 1780 .1 STA ARG.EXTENSION STRANGE VALUE 1790 JSR MAF COPY FAC INTO ARG 1800 LDA FAC MAXIMUM EXPONENT IS < 128 1810 CMP #$88 WITHIN RANGE? 1820 BCC .3 YES 1830 .2 JSR OUTOFRNG OVERFLOW IF +, RETURN 0.0 IF - 1840 .3 JSR INT GET INT(FAC) 1850 LDA CHARAC THIS IS THE INETGRAL PART OF THE POWER 1860 CLC ADD TO EXPONENT BIAS + 1 1870 ADC #$81 1880 BEQ .2 OVERFLOW 1890 SEC BACK OFF TO NORMAL BIAS 1900 SBC #1 1910 PHA SAVE EXPONENT 1920 *-------------------------------- 1930 LDX #5 SWAP ARG AND FAC 1940 .4 LDA ARG,X <<< WHY SWAP? IT IS DOING >>> 1950 LDY FAC,X <<< -(A-B) WHEN (B-A) IS THE >>> 1960 STA FAC,X <<< SAME THING! >>> 1970 STY ARG,X 1980 DEX 1990 BPL .4 2000 LDA ARG.EXTENSION 2010 STA FAC.EXTENSION 2020 JSR FSUBT POWER-INT(POWER) --> FRACTIONAL PART 2030 JSR NEGOP 2040 LDA #POLY.EXP 2050 LDY /POLY.EXP 2060 JSR POLYNOMIAL COMPUTE F(X) ON FRACTIONAL PART 2070 LDA #0 2080 STA SGNCPR 2090 PLA GET EXPONENT 2100 JSR ADD.EXPONENTS.1 2110 RTS <<< WASTED BYTE HERE, COULD HAVE >>> 2120 * <<< JUST USED "JMP ADD.EXPO..." >>> 2130 *-------------------------------- 2140 * ODD POLYNOMIAL SUBROUTINE 2150 * 2160 * F(X) = X * P(X^2) 2170 * 2180 * WHERE: X IS VALUE IN FAC 2190 * Y,A POINTS AT COEFFICIENT TABLE 2200 * FIRST BYTE OF COEFF. TABLE IS N 2210 * COEFFICIENTS FOLLOW, HIGHEST POWER FIRST 2220 * 2230 * P(X^2) COMPUTED USING NORMAL POLYNOMIAL SUBROUTINE 2240 * 2250 *-------------------------------- 2260 POLYNOMIAL.ODD 2270 STA SERPNT SAVE ADDRESS OF COEFFICIENT TABLE 2280 STY SERPNT+1 2290 JSR STORE.FAC.IN.TEMP1.ROUNDED 2300 LDA #TEMP1 Y=0 ALREADY, SO Y,A POINTS AT TEMP1 2310 JSR FMULT FORM X^2 2320 JSR SERMAIN DO SERIES IN X^2 2330 LDA #TEMP1 GET X AGAIN 2340 LDY /TEMP1 2350 JMP FMULT MULTIPLY X BY P(X^2) AND EXIT 2360 *-------------------------------- 2370 * NORMAL POLYNOMIAL SUBROUTINE 2380 * 2390 * P(X) = C(0)*X^N + C(1)*X^(N-1) + ... + C(N) 2400 * 2410 * WHERE: X IS VALUE IN FAC 2420 * Y,A POINTS AT COEFFICIENT TABLE 2430 * FIRST BYTE OF COEFF. TABLE IS N 2440 * COEFFICIENTS FOLLOW, HIGHEST POWER FIRST 2450 * 2460 *-------------------------------- 2470 POLYNOMIAL 2480 STA SERPNT POINTER TO COEFFICIENT TABLE 2490 STY SERPNT+1 2500 *-------------------------------- 2510 SERMAIN 2520 JSR STORE.FAC.IN.TEMP2.ROUNDED 2530 LDA (SERPNT),Y GET N 2540 STA SERLEN SAVE N 2550 LDY SERPNT BUMP PNTR TO HIGHEST COEFFICIENT 2560 INY AND GET PNTR INTO Y,A 2570 TYA 2580 BNE .1 2590 INC SERPNT+1 2600 .1 STA SERPNT 2610 LDY SERPNT+1 2620 .2 JSR FMULT ACCUMULATE SERIES TERMS 2630 LDA SERPNT BUMP PNTR TO NEXT COEFFICIENT 2640 LDY SERPNT+1 2650 CLC 2660 ADC #5 2670 BCC .3 2680 INY 2690 .3 STA SERPNT 2700 STY SERPNT+1 2710 JSR FADD ADD NEXT COEFFICIENT 2720 LDA #TEMP2 POINT AT X AGAIN 2730 LDY #0 2740 DEC SERLEN IF SERIES NOT FINISHED, 2750 BNE .2 THEN ADD ANOTHER TERM 2760 RTS.19 RTS FINISHED 2770 *-------------------------------- 2780 CON.RND.1 .HS 9835447A <<< THESE ARE MISSING ONE BYTE >>> 2790 CON.RND.2 .HS 6828B146 <<< FOR FP VALUES >>> 2800 *-------------------------------- 2810 * "RND" FUNCTION 2820 *-------------------------------- 2830 RND JSR SIGN REDUCE ARGUMENT TO -1, 0, OR +1 2840 TAX SAVE ARGUMENT 2850 BMI .1 = -1, USE CURRENT ARGUMENT FOR SEED 2860 LDA #RNDSEED USE CURRENT SEED 2870 LDY /RNDSEED 2880 JSR LOAD.FAC.FROM.YA 2890 TXA RECALL SIGN OF ARGUMENT 2900 BEQ RTS.19 =0, RETURN SEED UNCHANGED 2910 LDA #CON.RND.1 VERY POOR RND ALGORITHM 2920 LDY /CON.RND.1 2930 JSR FMULT 2940 LDA #CON.RND.2 ALSO, CONSTANTS ARE TRUNCATED 2950 LDY /CON.RND.2 <<<THIS DOES NOTHING, DUE TO >>> 2960 * <<<SMALL EXPONENT >>> 2970 JSR FADD 2980 .1 LDX FAC+4 SHUFFLE HI AND LO BYTES 2990 LDA FAC+1 TO SUPPOSEDLY MAKE IT MORE RANDOM 3000 STA FAC+4 3010 STX FAC+1 3020 LDA #0 MAKE IT POSITIVE 3030 STA FAC.SIGN 3040 LDA FAC A SOMEWHAT RANDOM EXTENSION 3050 STA FAC.EXTENSION 3060 LDA #$80 EXPONENT TO MAKE VALUE < 1.0 3070 STA FAC 3080 JSR NORMALIZE.FAC.2 3090 LDX #RNDSEED MOVE FAC TO RND SEED 3100 LDY /RNDSEED 3110 GO.MOVMF JMP STORE.FAC.AT.YX.ROUNDED 3120 *--------------------------------