S-C DocuMentor — Applesoft
SAVE S.EE8D
1010 *--------------------------------
1020 * "SQR" FUNCTION
1030 *
1040 * <<< UNFORTUNATELY, RATHER THAN A NEWTON-RAPHSON >>>
1050 * <<< ITERATION, APPLESOFT USES EXPONENTIATION >>>
1060 * <<< SQR(X) = X^.5 >>>
1070 *--------------------------------
EE8D- 20 63 EB 1080 SQR JSR COPY.FAC.TO.ARG.ROUNDED
EE90- A9 64 1090 LDA #CON.HALF SET UP POWER OF 0.5
EE92- A0 EE 1100 LDY /CON.HALF
EE94- 20 F9 EA 1110 JSR LOAD.FAC.FROM.YA
1120 *--------------------------------
1130 * EXPONENTIATION OPERATION
1140 *
1150 * ARG ^ FAC = EXP( LOG(ARG) * FAC )
1160 *--------------------------------
EE97- F0 70 1170 FPWRT BEQ EXP IF FAC=0, ARG^FAC=EXP(0)
EE99- A5 A5 1180 LDA ARG IF ARG=0, ARG^FAC=0
EE9B- D0 03 1190 BNE .1 NEITHER IS ZERO
EE9D- 4C 50 E8 1200 JMP STA.IN.FAC.SIGN.AND.EXP SET FAC = 0
EEA0- A2 8A 1210 .1 LDX #TEMP3 SAVE FAC IN TEMP3
EEA2- A0 00 1220 LDY #0
EEA4- 20 2B EB 1230 JSR STORE.FAC.AT.YX.ROUNDED
EEA7- A5 AA 1240 LDA ARG.SIGN NORMALLY, ARG MUST BE POSITIVE
EEA9- 10 0F 1250 BPL .2 IT IS POSITIVE, SO ALL IS WELL
EEAB- 20 23 EC 1260 JSR INT NEGATIVE, BUT OK IF INTEGRAL POWER
EEAE- A9 8A 1270 LDA #TEMP3 SEE IF INT(FAC)=FAC
EEB0- A0 00 1280 LDY #0
EEB2- 20 B2 EB 1290 JSR FCOMP IS IT AN INTEGER POWER?
EEB5- D0 03 1300 BNE .2 NOT INTEGRAL, WILL CAUSE ERROR LATER
EEB7- 98 1310 TYA MAKE ARG SIGN + AS IT IS MOVED TO FAC
EEB8- A4 0D 1320 LDY CHARAC INTEGRAL, SO ALLOW NEGATIVE ARG
EEBA- 20 55 EB 1330 .2 JSR MFA MOVE ARGUMENT TO FAC
EEBD- 98 1340 TYA SAVE FLAG FOR NEGATIVE ARG (0=+)
EEBE- 48 1350 PHA
EEBF- 20 41 E9 1360 JSR LOG GET LOG(ARG)
EEC2- A9 8A 1370 LDA #TEMP3 MULTIPLY BY POWER
EEC4- A0 00 1380 LDY #0
EEC6- 20 7F E9 1390 JSR FMULT
EEC9- 20 09 EF 1400 JSR EXP E ^ LOG(FAC)
EECC- 68 1410 PLA GET FLAG FOR NEGATIVE ARG
EECD- 4A 1420 LSR <<<LSR,BCC COULD BE MERELY BPL>>>
EECE- 90 0A 1430 BCC RTS.18 NOT NEGATIVE, FINISHED
1440 * NEGATIVE ARG, SO NEGATE RESULT
1450 *--------------------------------
1460 * NEGATE VALUE IN FAC
1470 *--------------------------------
EED0- A5 9D 1480 NEGOP LDA FAC IF FAC=0, NO NEED TO COMPLEMENT
EED2- F0 06 1490 BEQ RTS.18 YES, FAC=0
EED4- A5 A2 1500 LDA FAC.SIGN NO, SO TOGGLE SIGN
EED6- 49 FF 1510 EOR #$FF
EED8- 85 A2 1520 STA FAC.SIGN
EEDA- 60 1530 RTS.18 RTS
1540 *--------------------------------
EEDB- 81 38 AA
EEDE- 3B 29 1550 CON.LOG.E .HS 8138AA3B29 LOG(E) TO BASE 2
1560 *--------------------------------
EEE0- 07 1570 POLY.EXP .DA #7 ( # OF TERMS IN POLYNOMIAL) - 1
EEE1- 71 34 58
EEE4- 3E 56 1580 .HS 7134583E56 (LOG(2)^7)/8!
EEE6- 74 16 7E
EEE9- B3 1B 1590 .HS 74167EB31B (LOG(2)^6)/7!
EEEB- 77 2F EE
EEEE- E3 85 1600 .HS 772FEEE385 (LOG(2)^5)/6!
EEF0- 7A 1D 84
EEF3- 1C 2A 1610 .HS 7A1D841C2A (LOG(2)^4)/5!
EEF5- 7C 63 59
EEF8- 58 0A 1620 .HS 7C6359580A (LOG(2)^3)/4!
EEFA- 7E 75 FD
EEFD- E7 C6 1630 .HS 7E75FDE7C6 (LOG(2)^2)/3!
EEFF- 80 31 72
EF02- 18 10 1640 .HS 8031721810 LOG(2)/2!
EF04- 81 00 00
EF07- 00 00 1650 .HS 8100000000 1
1660 *--------------------------------
1670 * "EXP" FUNCTION
1680 *
1690 * FAC = E ^ FAC
1700 *--------------------------------
EF09- A9 DB 1710 EXP LDA #CON.LOG.E CONVERT TO POWER OF TWO PROBLEM
EF0B- A0 EE 1720 LDY /CON.LOG.E E^X = 2^(LOG2(E)*X)
EF0D- 20 7F E9 1730 JSR FMULT
EF10- A5 AC 1740 LDA FAC.EXTENSION NON-STANDARD ROUNDING HERE
EF12- 69 50 1750 ADC #$50 ROUND UP IF EXTENSION > $AF
EF14- 90 03 1760 BCC .1 NO, DON'T ROUND UP
EF16- 20 7A EB 1770 JSR INCREMENT.MANTISSA
EF19- 85 92 1780 .1 STA ARG.EXTENSION STRANGE VALUE
EF1B- 20 66 EB 1790 JSR MAF COPY FAC INTO ARG
EF1E- A5 9D 1800 LDA FAC MAXIMUM EXPONENT IS < 128
EF20- C9 88 1810 CMP #$88 WITHIN RANGE?
EF22- 90 03 1820 BCC .3 YES
EF24- 20 2B EA 1830 .2 JSR OUTOFRNG OVERFLOW IF +, RETURN 0.0 IF -
EF27- 20 23 EC 1840 .3 JSR INT GET INT(FAC)
EF2A- A5 0D 1850 LDA CHARAC THIS IS THE INETGRAL PART OF THE POWER
EF2C- 18 1860 CLC ADD TO EXPONENT BIAS + 1
EF2D- 69 81 1870 ADC #$81
EF2F- F0 F3 1880 BEQ .2 OVERFLOW
EF31- 38 1890 SEC BACK OFF TO NORMAL BIAS
EF32- E9 01 1900 SBC #1
EF34- 48 1910 PHA SAVE EXPONENT
1920 *--------------------------------
EF35- A2 05 1930 LDX #5 SWAP ARG AND FAC
EF37- B5 A5 1940 .4 LDA ARG,X <<< WHY SWAP? IT IS DOING >>>
EF39- B4 9D 1950 LDY FAC,X <<< -(A-B) WHEN (B-A) IS THE >>>
EF3B- 95 9D 1960 STA FAC,X <<< SAME THING! >>>
EF3D- 94 A5 1970 STY ARG,X
EF3F- CA 1980 DEX
EF40- 10 F5 1990 BPL .4
EF42- A5 92 2000 LDA ARG.EXTENSION
EF44- 85 AC 2010 STA FAC.EXTENSION
EF46- 20 AA E7 2020 JSR FSUBT POWER-INT(POWER) --> FRACTIONAL PART
EF49- 20 D0 EE 2030 JSR NEGOP
EF4C- A9 E0 2040 LDA #POLY.EXP
EF4E- A0 EE 2050 LDY /POLY.EXP
EF50- 20 72 EF 2060 JSR POLYNOMIAL COMPUTE F(X) ON FRACTIONAL PART
EF53- A9 00 2070 LDA #0
EF55- 85 AB 2080 STA SGNCPR
EF57- 68 2090 PLA GET EXPONENT
EF58- 20 10 EA 2100 JSR ADD.EXPONENTS.1
EF5B- 60 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
EF5C- 85 AD 2270 STA SERPNT SAVE ADDRESS OF COEFFICIENT TABLE
EF5E- 84 AE 2280 STY SERPNT+1
EF60- 20 21 EB 2290 JSR STORE.FAC.IN.TEMP1.ROUNDED
EF63- A9 93 2300 LDA #TEMP1 Y=0 ALREADY, SO Y,A POINTS AT TEMP1
EF65- 20 7F E9 2310 JSR FMULT FORM X^2
EF68- 20 76 EF 2320 JSR SERMAIN DO SERIES IN X^2
EF6B- A9 93 2330 LDA #TEMP1 GET X AGAIN
EF6D- A0 00 2340 LDY /TEMP1
EF6F- 4C 7F E9 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
EF72- 85 AD 2480 STA SERPNT POINTER TO COEFFICIENT TABLE
EF74- 84 AE 2490 STY SERPNT+1
2500 *--------------------------------
2510 SERMAIN
EF76- 20 1E EB 2520 JSR STORE.FAC.IN.TEMP2.ROUNDED
EF79- B1 AD 2530 LDA (SERPNT),Y GET N
EF7B- 85 A3 2540 STA SERLEN SAVE N
EF7D- A4 AD 2550 LDY SERPNT BUMP PNTR TO HIGHEST COEFFICIENT
EF7F- C8 2560 INY AND GET PNTR INTO Y,A
EF80- 98 2570 TYA
EF81- D0 02 2580 BNE .1
EF83- E6 AE 2590 INC SERPNT+1
EF85- 85 AD 2600 .1 STA SERPNT
EF87- A4 AE 2610 LDY SERPNT+1
EF89- 20 7F E9 2620 .2 JSR FMULT ACCUMULATE SERIES TERMS
EF8C- A5 AD 2630 LDA SERPNT BUMP PNTR TO NEXT COEFFICIENT
EF8E- A4 AE 2640 LDY SERPNT+1
EF90- 18 2650 CLC
EF91- 69 05 2660 ADC #5
EF93- 90 01 2670 BCC .3
EF95- C8 2680 INY
EF96- 85 AD 2690 .3 STA SERPNT
EF98- 84 AE 2700 STY SERPNT+1
EF9A- 20 BE E7 2710 JSR FADD ADD NEXT COEFFICIENT
EF9D- A9 98 2720 LDA #TEMP2 POINT AT X AGAIN
EF9F- A0 00 2730 LDY #0
EFA1- C6 A3 2740 DEC SERLEN IF SERIES NOT FINISHED,
EFA3- D0 E4 2750 BNE .2 THEN ADD ANOTHER TERM
EFA5- 60 2760 RTS.19 RTS FINISHED
2770 *--------------------------------
EFA6- 98 35 44
EFA9- 7A 2780 CON.RND.1 .HS 9835447A <<< THESE ARE MISSING ONE BYTE >>>
EFAA- 68 28 B1
EFAD- 46 2790 CON.RND.2 .HS 6828B146 <<< FOR FP VALUES >>>
2800 *--------------------------------
2810 * "RND" FUNCTION
2820 *--------------------------------
EFAE- 20 82 EB 2830 RND JSR SIGN REDUCE ARGUMENT TO -1, 0, OR +1
EFB1- AA 2840 TAX SAVE ARGUMENT
EFB2- 30 18 2850 BMI .1 = -1, USE CURRENT ARGUMENT FOR SEED
EFB4- A9 C9 2860 LDA #RNDSEED USE CURRENT SEED
EFB6- A0 00 2870 LDY /RNDSEED
EFB8- 20 F9 EA 2880 JSR LOAD.FAC.FROM.YA
EFBB- 8A 2890 TXA RECALL SIGN OF ARGUMENT
EFBC- F0 E7 2900 BEQ RTS.19 =0, RETURN SEED UNCHANGED
EFBE- A9 A6 2910 LDA #CON.RND.1 VERY POOR RND ALGORITHM
EFC0- A0 EF 2920 LDY /CON.RND.1
EFC2- 20 7F E9 2930 JSR FMULT
EFC5- A9 AA 2940 LDA #CON.RND.2 ALSO, CONSTANTS ARE TRUNCATED
EFC7- A0 EF 2950 LDY /CON.RND.2 <<<THIS DOES NOTHING, DUE TO >>>
2960 * <<<SMALL EXPONENT >>>
EFC9- 20 BE E7 2970 JSR FADD
EFCC- A6 A1 2980 .1 LDX FAC+4 SHUFFLE HI AND LO BYTES
EFCE- A5 9E 2990 LDA FAC+1 TO SUPPOSEDLY MAKE IT MORE RANDOM
EFD0- 85 A1 3000 STA FAC+4
EFD2- 86 9E 3010 STX FAC+1
EFD4- A9 00 3020 LDA #0 MAKE IT POSITIVE
EFD6- 85 A2 3030 STA FAC.SIGN
EFD8- A5 9D 3040 LDA FAC A SOMEWHAT RANDOM EXTENSION
EFDA- 85 AC 3050 STA FAC.EXTENSION
EFDC- A9 80 3060 LDA #$80 EXPONENT TO MAKE VALUE < 1.0
EFDE- 85 9D 3070 STA FAC
EFE0- 20 2E E8 3080 JSR NORMALIZE.FAC.2
EFE3- A2 C9 3090 LDX #RNDSEED MOVE FAC TO RND SEED
EFE5- A0 00 3100 LDY /RNDSEED
EFE7- 4C 2B EB 3110 GO.MOVMF JMP STORE.FAC.AT.YX.ROUNDED
3120 *--------------------------------
S.ED0A
