S-C DocuMentor — Applesoft
SAVE S.E913
1010 *--------------------------------
E913- 81 00 00
E916- 00 00 1020 CON.ONE .HS 8100000000
1030 *--------------------------------
E918- 03 1040 POLY.LOG .DA #3 # OF COEFFICIENTS - 1
E919- 7F 5E 56
E91C- CB 79 1050 .HS 7F5E56CB79 * X^7 +
E91E- 80 13 9B
E921- 0B 64 1060 .HS 80139B0B64 * X^5 +
E923- 80 76 38
E926- 93 16 1070 .HS 8076389316 * X^3 +
E928- 82 38 AA
E92B- 3B 20 1080 .HS 8238AA3B20 * X
1090 *--------------------------------
E92D- 80 35 04
E930- F3 34 1100 CON.SQR.HALF .HS 803504F334
E932- 81 35 04
E935- F3 34 1110 CON.SQR.TWO .HS 813504F334
E937- 80 80 00
E93A- 00 00 1120 CON.NEG.HALF .HS 8080000000
E93C- 80 31 72
E93F- 17 F8 1130 CON.LOG.TWO .HS 80317217F8
1140 *--------------------------------
1150 * "LOG" FUNCTION
1160 *--------------------------------
E941- 20 82 EB 1170 LOG JSR SIGN GET -1,0,+1 IN A-REG FOR FAC
E944- F0 02 1180 BEQ GIQ LOG (0) IS ILLEGAL
E946- 10 03 1190 BPL LOG.2 >0 IS OK
E948- 4C 99 E1 1200 GIQ JMP IQERR <= 0 IS NO GOOD
E94B- A5 9D 1210 LOG.2 LDA FAC FIRST GET LOG BASE 2
E94D- E9 7F 1220 SBC #$7F SAVE UNBIASED EXPONENT
E94F- 48 1230 PHA
E950- A9 80 1240 LDA #$80 NORMALIZE BETWEEN .5 AND 1
E952- 85 9D 1250 STA FAC
E954- A9 2D 1260 LDA #CON.SQR.HALF
E956- A0 E9 1270 LDY /CON.SQR.HALF
E958- 20 BE E7 1280 JSR FADD COMPUTE VIA SERIES OF ODD
E95B- A9 32 1290 LDA #CON.SQR.TWO POWERS OF
E95D- A0 E9 1300 LDY /CON.SQR.TWO (SQR(2)X-1)/(SQR(2)X+1)
E95F- 20 66 EA 1310 JSR FDIV
E962- A9 13 1320 LDA #CON.ONE
E964- A0 E9 1330 LDY /CON.ONE
E966- 20 A7 E7 1340 JSR FSUB
E969- A9 18 1350 LDA #POLY.LOG
E96B- A0 E9 1360 LDY /POLY.LOG
E96D- 20 5C EF 1370 JSR POLYNOMIAL.ODD
E970- A9 37 1380 LDA #CON.NEG.HALF
E972- A0 E9 1390 LDY /CON.NEG.HALF
E974- 20 BE E7 1400 JSR FADD
E977- 68 1410 PLA
E978- 20 D5 EC 1420 JSR ADDACC ADD ORIGINAL EXPONENT
E97B- A9 3C 1430 LDA #CON.LOG.TWO MULTIPLY BY LOG(2) TO FORM
E97D- A0 E9 1440 LDY /CON.LOG.TWO NATURAL LOG OF X
1450 *--------------------------------
1460 * FAC = (Y,A) * FAC
1470 *--------------------------------
E97F- 20 E3 E9 1480 FMULT JSR LOAD.ARG.FROM.YA
1490 *--------------------------------
1500 * FAC = ARG * FAC
1510 *--------------------------------
E982- D0 03 1520 FMULTT BNE .1 FAC .NE. ZERO
E984- 4C E2 E9 1530 JMP RTS.13 FAC = 0 * ARG = 0
1540 * <<< WHY IS LINE ABOVE JUST "RTS"? >>>
1550 *--------------------------------
1560 *
1570 *--------------------------------
E987- 20 0E EA 1580 .1 JSR ADD.EXPONENTS
E98A- A9 00 1590 LDA #0
E98C- 85 62 1600 STA RESULT INIT PRODUCT = 0
E98E- 85 63 1610 STA RESULT+1
E990- 85 64 1620 STA RESULT+2
E992- 85 65 1630 STA RESULT+3
E994- A5 AC 1640 LDA FAC.EXTENSION
E996- 20 B0 E9 1650 JSR MULTIPLY.1
E999- A5 A1 1660 LDA FAC+4
E99B- 20 B0 E9 1670 JSR MULTIPLY.1
E99E- A5 A0 1680 LDA FAC+3
E9A0- 20 B0 E9 1690 JSR MULTIPLY.1
E9A3- A5 9F 1700 LDA FAC+2
E9A5- 20 B0 E9 1710 JSR MULTIPLY.1
E9A8- A5 9E 1720 LDA FAC+1
E9AA- 20 B5 E9 1730 JSR MULTIPLY.2
E9AD- 4C E6 EA 1740 JMP COPY.RESULT.INTO.FAC
1750 *--------------------------------
1760 * MULTIPLY ARG BY (A) INTO RESULT
1770 *--------------------------------
1780 MULTIPLY.1
E9B0- D0 03 1790 BNE MULTIPLY.2 THIS BYTE NON-ZERO
E9B2- 4C DA E8 1800 JMP SHIFT.RIGHT.1 (A)=0, JUST SHIFT ARG RIGHT 8
1810 *--------------------------------
1820 MULTIPLY.2
E9B5- 4A 1830 LSR SHIFT BIT INTO CARRY
E9B6- 09 80 1840 ORA #$80 SUPPLY SENTINEL BIT
E9B8- A8 1850 .1 TAY REMAINING MULTIPLIER TO Y
E9B9- 90 19 1860 BCC .2 THIS MULTIPLIER BIT = 0
E9BB- 18 1870 CLC = 1, SO ADD ARG TO RESULT
E9BC- A5 65 1880 LDA RESULT+3
E9BE- 65 A9 1890 ADC ARG+4
E9C0- 85 65 1900 STA RESULT+3
E9C2- A5 64 1910 LDA RESULT+2
E9C4- 65 A8 1920 ADC ARG+3
E9C6- 85 64 1930 STA RESULT+2
E9C8- A5 63 1940 LDA RESULT+1
E9CA- 65 A7 1950 ADC ARG+2
E9CC- 85 63 1960 STA RESULT+1
E9CE- A5 62 1970 LDA RESULT
E9D0- 65 A6 1980 ADC ARG+1
E9D2- 85 62 1990 STA RESULT
E9D4- 66 62 2000 .2 ROR RESULT SHIFT RESULT RIGHT 1
E9D6- 66 63 2010 ROR RESULT+1
E9D8- 66 64 2020 ROR RESULT+2
E9DA- 66 65 2030 ROR RESULT+3
E9DC- 66 AC 2040 ROR FAC.EXTENSION
E9DE- 98 2050 TYA REMAINING MULTIPLIER
E9DF- 4A 2060 LSR LSB INTO CARRY
E9E0- D0 D6 2070 BNE .1 IF SENTINEL STILL HERE, MULTIPLY
E9E2- 60 2080 RTS.13 RTS 8 X 32 COMPLETED
2090 *--------------------------------
2100 * UNPACK NUMBER AT (Y,A) INTO ARG
2110 *--------------------------------
2120 LOAD.ARG.FROM.YA
E9E3- 85 5E 2130 STA INDEX USE INDEX FOR PNTR
E9E5- 84 5F 2140 STY INDEX+1
E9E7- A0 04 2150 LDY #4 FIVE BYTES TO MOVE
E9E9- B1 5E 2160 LDA (INDEX),Y
E9EB- 85 A9 2170 STA ARG+4
E9ED- 88 2180 DEY
E9EE- B1 5E 2190 LDA (INDEX),Y
E9F0- 85 A8 2200 STA ARG+3
E9F2- 88 2210 DEY
E9F3- B1 5E 2220 LDA (INDEX),Y
E9F5- 85 A7 2230 STA ARG+2
E9F7- 88 2240 DEY
E9F8- B1 5E 2250 LDA (INDEX),Y
E9FA- 85 AA 2260 STA ARG.SIGN
E9FC- 45 A2 2270 EOR FAC.SIGN SET COMBINED SIGN FOR MULT/DIV
E9FE- 85 AB 2280 STA SGNCPR
EA00- A5 AA 2290 LDA ARG.SIGN TURN ON NORMALIZED INVISIBLE BIT
EA02- 09 80 2300 ORA #$80 TO COMPLETE MANTISSA
EA04- 85 A6 2310 STA ARG+1
EA06- 88 2320 DEY
EA07- B1 5E 2330 LDA (INDEX),Y
EA09- 85 A5 2340 STA ARG EXPONENT
EA0B- A5 9D 2350 LDA FAC SET STATUS BITS ON FAC EXPONENT
EA0D- 60 2360 RTS
2370 *--------------------------------
2380 * ADD EXPONENTS OF ARG AND FAC
2390 * (CALLED BY FMULT AND FDIV)
2400 *
2410 * ALSO CHECK FOR OVERFLOW, AND SET RESULT SIGN
2420 *--------------------------------
2430 ADD.EXPONENTS
EA0E- A5 A5 2440 LDA ARG
2450 *--------------------------------
2460 ADD.EXPONENTS.1
EA10- F0 1F 2470 BEQ ZERO IF ARG=0, RESULT IS ZERO
EA12- 18 2480 CLC
EA13- 65 9D 2490 ADC FAC
EA15- 90 04 2500 BCC .1 IN RANGE
EA17- 30 1D 2510 BMI JOV OVERFLOW
EA19- 18 2520 CLC
EA1A- 2C 2530 .HS 2C TRICK TO SKIP
EA1B- 10 14 2540 .1 BPL ZERO OVERFLOW
EA1D- 69 80 2550 ADC #$80 RE-BIAS
EA1F- 85 9D 2560 STA FAC RESULT
EA21- D0 03 2570 BNE .2
EA23- 4C 52 E8 2580 JMP STA.IN.FAC.SIGN RESULT IS ZERO
2590 * <<< CRAZY TO JUMP WAY BACK THERE! >>>
2600 * <<< SAME IDENTICAL CODE IS BELOW! >>>
2610 * <<< INSTEAD OF BNE .2, JMP STA.IN.FAC.SIGN >>>
2620 * <<< ONLY NEEDED BEQ .3 >>>
EA26- A5 AB 2630 .2 LDA SGNCPR SET SIGN OF RESULT
EA28- 85 A2 2640 .3 STA FAC.SIGN
EA2A- 60 2650 RTS
2660 *--------------------------------
2670 * IF (FAC) IS POSITIVE, GIVE "OVERFLOW" ERROR
2680 * IF (FAC) IS NEGATIVE, SET FAC=0, POP ONE RETURN, AND RTS
2690 * CALLED FROM "EXP" FUNCTION
2700 *--------------------------------
2710 OUTOFRNG
EA2B- A5 A2 2720 LDA FAC.SIGN
EA2D- 49 FF 2730 EOR #$FF
EA2F- 30 05 2740 BMI JOV ERROR IF POSITIVE #
2750 *--------------------------------
2760 * POP RETURN ADDRESS AND SET FAC=0
2770 *--------------------------------
EA31- 68 2780 ZERO PLA
EA32- 68 2790 PLA
EA33- 4C 4E E8 2800 JMP ZERO.FAC
2810 *--------------------------------
EA36- 4C D5 E8 2820 JOV JMP OVERFLOW
2830 *--------------------------------
2840 * MULTIPLY FAC BY 10
2850 *--------------------------------
EA39- 20 63 EB 2860 MUL10 JSR COPY.FAC.TO.ARG.ROUNDED
EA3C- AA 2870 TAX TEXT FAC EXPONENT
EA3D- F0 10 2880 BEQ .1 FINISHED IF FAC=0
EA3F- 18 2890 CLC
EA40- 69 02 2900 ADC #2 ADD 2 TO EXPONENT GIVES (FAC)*4
EA42- B0 F2 2910 BCS JOV OVERFLOW
EA44- A2 00 2920 LDX #0
EA46- 86 AB 2930 STX SGNCPR
EA48- 20 CE E7 2940 JSR FADD.2 MAKES (FAC)*5
EA4B- E6 9D 2950 INC FAC *2, MAKES (FAC)*10
EA4D- F0 E7 2960 BEQ JOV OVERFLOW
EA4F- 60 2970 .1 RTS
2980 *--------------------------------
EA50- 84 20 00
EA53- 00 00 2990 CON.TEN .HS 8420000000
3000 *--------------------------------
3010 * DIVIDE FAC BY 10
3020 *--------------------------------
EA55- 20 63 EB 3030 DIV10 JSR COPY.FAC.TO.ARG.ROUNDED
EA58- A9 50 3040 LDA #CON.TEN SET UP TO PUT
EA5A- A0 EA 3050 LDY /CON.TEN 10 IN FAC
EA5C- A2 00 3060 LDX #0
3070 *--------------------------------
3080 * FAC = ARG / (Y,A)
3090 *--------------------------------
EA5E- 86 AB 3100 DIV STX SGNCPR
EA60- 20 F9 EA 3110 JSR LOAD.FAC.FROM.YA
EA63- 4C 69 EA 3120 JMP FDIVT DIVIDE ARG BY FAC
3130 *--------------------------------
3140 * FAC = (Y,A) / FAC
3150 *--------------------------------
EA66- 20 E3 E9 3160 FDIV JSR LOAD.ARG.FROM.YA
3170 *--------------------------------
3180 * FAC = ARG / FAC
3190 *--------------------------------
EA69- F0 76 3200 FDIVT BEQ .8 FAC = 0, DIVIDE BY ZERO ERROR
EA6B- 20 72 EB 3210 JSR ROUND.FAC
EA6E- A9 00 3220 LDA #0 NEGATE FAC EXPONENT, SO
EA70- 38 3230 SEC ADD.EXPONENTS FORMS DIFFERENCE
EA71- E5 9D 3240 SBC FAC
EA73- 85 9D 3250 STA FAC
EA75- 20 0E EA 3260 JSR ADD.EXPONENTS
EA78- E6 9D 3270 INC FAC
EA7A- F0 BA 3280 BEQ JOV OVERFLOW
EA7C- A2 FC 3290 LDX #-4 INDEX FOR RESULT
EA7E- A9 01 3300 LDA #1 SENTINEL
EA80- A4 A6 3310 .1 LDY ARG+1 SEE IF FAC CAN BE SUBTRACTED
EA82- C4 9E 3320 CPY FAC+1
EA84- D0 10 3330 BNE .2
EA86- A4 A7 3340 LDY ARG+2
EA88- C4 9F 3350 CPY FAC+2
EA8A- D0 0A 3360 BNE .2
EA8C- A4 A8 3370 LDY ARG+3
EA8E- C4 A0 3380 CPY FAC+3
EA90- D0 04 3390 BNE .2
EA92- A4 A9 3400 LDY ARG+4
EA94- C4 A1 3410 CPY FAC+4
EA96- 08 3420 .2 PHP SAVE THE ANSWER, AND ALSO ROLL THE
EA97- 2A 3430 ROL BIT INTO THE QUOTIENT, SENTINEL OUT
EA98- 90 09 3440 BCC .3 NO SENTINEL, STILL NOT 8 TRIPS
EA9A- E8 3450 INX 8 TRIPS, STORE BYTE OF QUOTIENT
EA9B- 95 65 3460 STA RESULT+3,X
EA9D- F0 32 3470 BEQ .6 32-BITS COMPLETED
EA9F- 10 34 3480 BPL .7 FINAL EXIT WHEN X=1
EAA1- A9 01 3490 LDA #1 RE-START SENTINEL
EAA3- 28 3500 .3 PLP GET ANSWER, CAN FAC BE SUBTRACTED?
EAA4- B0 0E 3510 BCS .5 YES, DO IT
EAA6- 06 A9 3520 .4 ASL ARG+4 NO, SHIFT ARG LEFT
EAA8- 26 A8 3530 ROL ARG+3
EAAA- 26 A7 3540 ROL ARG+2
EAAC- 26 A6 3550 ROL ARG+1
EAAE- B0 E6 3560 BCS .2 ANOTHER TRIP
EAB0- 30 CE 3570 BMI .1 HAVE TO COMPARE FIRST
EAB2- 10 E2 3580 BPL .2 ...ALWAYS
EAB4- A8 3590 .5 TAY SAVE QUOTIENT/SENTINEL BYTE
EAB5- A5 A9 3600 LDA ARG+4 SUBTRACT FAC FROM ARG ONCE
EAB7- E5 A1 3610 SBC FAC+4
EAB9- 85 A9 3620 STA ARG+4
EABB- A5 A8 3630 LDA ARG+3
EABD- E5 A0 3640 SBC FAC+3
EABF- 85 A8 3650 STA ARG+3
EAC1- A5 A7 3660 LDA ARG+2
EAC3- E5 9F 3670 SBC FAC+2
EAC5- 85 A7 3680 STA ARG+2
EAC7- A5 A6 3690 LDA ARG+1
EAC9- E5 9E 3700 SBC FAC+1
EACB- 85 A6 3710 STA ARG+1
EACD- 98 3720 TYA RESTORE QUOTIENT/SENTINEL BYTE
EACE- 4C A6 EA 3730 JMP .4 GO TO SHIFT ARG AND CONTINUE
3740 *--------------------------------
EAD1- A9 40 3750 .6 LDA #$40 DO A FEW EXTENSION BITS
EAD3- D0 CE 3760 BNE .3 ...ALWAYS
3770 *--------------------------------
EAD5- 0A 3780 .7 ASL LEFT JUSTIFY THE EXTENSION BITS WE DID
EAD6- 0A 3790 ASL
EAD7- 0A 3800 ASL
EAD8- 0A 3810 ASL
EAD9- 0A 3820 ASL
EADA- 0A 3830 ASL
EADB- 85 AC 3840 STA FAC.EXTENSION
EADD- 28 3850 PLP
EADE- 4C E6 EA 3860 JMP COPY.RESULT.INTO.FAC
3870 *--------------------------------
EAE1- A2 85 3880 .8 LDX #ERR.ZERODIV
EAE3- 4C 12 D4 3890 JMP ERROR
3900 *--------------------------------
3910 * COPY RESULT INTO FAC MANTISSA, AND NORMALIZE
3920 *--------------------------------
3930 COPY.RESULT.INTO.FAC
EAE6- A5 62 3940 LDA RESULT
EAE8- 85 9E 3950 STA FAC+1
EAEA- A5 63 3960 LDA RESULT+1
EAEC- 85 9F 3970 STA FAC+2
EAEE- A5 64 3980 LDA RESULT+2
EAF0- 85 A0 3990 STA FAC+3
EAF2- A5 65 4000 LDA RESULT+3
EAF4- 85 A1 4010 STA FAC+4
EAF6- 4C 2E E8 4020 JMP NORMALIZE.FAC.2
4030 *--------------------------------
4040 * UNPACK (Y,A) INTO FAC
4050 *--------------------------------
4060 LOAD.FAC.FROM.YA
EAF9- 85 5E 4070 STA INDEX USE INDEX FOR PNTR
EAFB- 84 5F 4080 STY INDEX+1
EAFD- A0 04 4090 LDY #4 PICK UP 5 BYTES
EAFF- B1 5E 4100 LDA (INDEX),Y
EB01- 85 A1 4110 STA FAC+4
EB03- 88 4120 DEY
EB04- B1 5E 4130 LDA (INDEX),Y
EB06- 85 A0 4140 STA FAC+3
EB08- 88 4150 DEY
EB09- B1 5E 4160 LDA (INDEX),Y
EB0B- 85 9F 4170 STA FAC+2
EB0D- 88 4180 DEY
EB0E- B1 5E 4190 LDA (INDEX),Y
EB10- 85 A2 4200 STA FAC.SIGN FIRST BIT IS SIGN
EB12- 09 80 4210 ORA #$80 SET NORMALIZED INVISIBLE BIT
EB14- 85 9E 4220 STA FAC+1
EB16- 88 4230 DEY
EB17- B1 5E 4240 LDA (INDEX),Y
EB19- 85 9D 4250 STA FAC EXPONENT
EB1B- 84 AC 4260 STY FAC.EXTENSION Y=0
EB1D- 60 4270 RTS
4280 *--------------------------------
4290 * ROUND FAC, STORE IN TEMP2
4300 *--------------------------------
4310 STORE.FAC.IN.TEMP2.ROUNDED
EB1E- A2 98 4320 LDX #TEMP2 PACK FAC INTO TEMP2
EB20- 2C 4330 .HS 2C TRICK TO BRANCH
4340 *--------------------------------
4350 * ROUND FAC, STORE IN TEMP1
4360 *--------------------------------
4370 STORE.FAC.IN.TEMP1.ROUNDED
EB21- A2 93 4380 LDX #TEMP1 PACK FAC INTO TEMP1
EB23- A0 00 4390 LDY /TEMP1 HI-BYTE OF TEMP1 SAME AS TEMP2
EB25- F0 04 4400 BEQ STORE.FAC.AT.YX.ROUNDED ...ALWAYS
4410 *--------------------------------
4420 * ROUND FAC, AND STORE WHERE FORPNT POINTS
4430 *--------------------------------
EB27- A6 85 4440 SETFOR LDX FORPNT
EB29- A4 86 4450 LDY FORPNT+1
4460 *--------------------------------
4470 * ROUND FAC, AND STORE AT (Y,X)
4480 *--------------------------------
4490 STORE.FAC.AT.YX.ROUNDED
EB2B- 20 72 EB 4500 JSR ROUND.FAC ROUND VALUE IN FAC USING EXTENSION
EB2E- 86 5E 4510 STX INDEX USE INDEX FOR PNTR
EB30- 84 5F 4520 STY INDEX+1
EB32- A0 04 4530 LDY #4 STORING 5 PACKED BYTES
EB34- A5 A1 4540 LDA FAC+4
EB36- 91 5E 4550 STA (INDEX),Y
EB38- 88 4560 DEY
EB39- A5 A0 4570 LDA FAC+3
EB3B- 91 5E 4580 STA (INDEX),Y
EB3D- 88 4590 DEY
EB3E- A5 9F 4600 LDA FAC+2
EB40- 91 5E 4610 STA (INDEX),Y
EB42- 88 4620 DEY
EB43- A5 A2 4630 LDA FAC.SIGN PACK SIGN IN TOP BIT OF MANTISSA
EB45- 09 7F 4640 ORA #$7F
EB47- 25 9E 4650 AND FAC+1
EB49- 91 5E 4660 STA (INDEX),Y
EB4B- 88 4670 DEY
EB4C- A5 9D 4680 LDA FAC EXPONENT
EB4E- 91 5E 4690 STA (INDEX),Y
EB50- 84 AC 4700 STY FAC.EXTENSION ZERO THE EXTENSION
EB52- 60 4710 RTS
4720 *--------------------------------
4730 * COPY ARG INTO FAC
4740 *--------------------------------
4750 COPY.ARG.TO.FAC
EB53- A5 AA 4760 LDA ARG.SIGN COPY SIGN
EB55- 85 A2 4770 MFA STA FAC.SIGN
EB57- A2 05 4780 LDX #5 MOVE 5 BYTES
EB59- B5 A4 4790 .1 LDA ARG-1,X
EB5B- 95 9C 4800 STA FAC-1,X
EB5D- CA 4810 DEX
EB5E- D0 F9 4820 BNE .1
EB60- 86 AC 4830 STX FAC.EXTENSION ZERO EXTENSION
EB62- 60 4840 RTS
4850 *--------------------------------
4860 * ROUND FAC AND COPY TO ARG
4870 *--------------------------------
4880 COPY.FAC.TO.ARG.ROUNDED
EB63- 20 72 EB 4890 JSR ROUND.FAC ROUND FAC USING EXTENSION
EB66- A2 06 4900 MAF LDX #6 COPY 6 BYTES, INCLUDES SIGN
EB68- B5 9C 4910 .1 LDA FAC-1,X
EB6A- 95 A4 4920 STA ARG-1,X
EB6C- CA 4930 DEX
EB6D- D0 F9 4940 BNE .1
EB6F- 86 AC 4950 STX FAC.EXTENSION ZERO FAC EXTENSION
EB71- 60 4960 RTS.14 RTS
S.E7A0