mirror of
https://github.com/zellyn/goapple2.git
synced 2024-12-01 21:50:13 +00:00
213 lines
8.2 KiB
Plaintext
213 lines
8.2 KiB
Plaintext
|
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 *--------------------------------
|