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