S-C DocuMentor — Applesoft

               SAVE S.EFEA
               1010 *--------------------------------
               1020 *      "COS" FUNCTION
               1030 *--------------------------------
EFEA- A9 66    1040 COS    LDA #CON.PI.HALF     COS(X)=SIN(X + PI/2)
EFEC- A0 F0    1050        LDY /CON.PI.HALF
EFEE- 20 BE E7 1060        JSR FADD
               1070 *--------------------------------
               1080 *      "SIN" FUNCTION
               1090 *--------------------------------
EFF1- 20 63 EB 1100 SIN    JSR COPY.FAC.TO.ARG.ROUNDED
EFF4- A9 6B    1110        LDA #CON.PI.DOUB  REMOVE MULTIPLES OF 2*PI
EFF6- A0 F0    1120        LDY /CON.PI.DOUB  BY DIVIDING AND SAVING
EFF8- A6 AA    1130        LDX ARG.SIGN      THE FRACTIONAL PART
EFFA- 20 5E EA 1140        JSR DIV           USE SIGN OF ARGUMENT
EFFD- 20 63 EB 1150        JSR COPY.FAC.TO.ARG.ROUNDED
F000- 20 23 EC 1160        JSR INT      TAKE INTEGER PART
F003- A9 00    1170        LDA #0       <<< WASTED LINES, BECAUSE FSUBT >>>
F005- 85 AB    1180        STA SGNCPR   <<< CHANGES SGNCPR AGAIN        >>>
F007- 20 AA E7 1190        JSR FSUBT    SUBTRACT TO GET FRACTIONAL PART
               1200 *--------------------------------
               1210 *      (FAC) = ANGLE AS A FRACTION OF A FULL CIRCLE
               1220 *
               1230 *      NOW FOLD THE RANGE INTO A QUARTER CIRCLE
               1240 *
               1250 *      <<< THERE ARE MUCH SIMPLER WAYS TO DO THIS >>>
               1260 *--------------------------------
F00A- A9 70    1270        LDA #QUARTER      1/4 - FRACTION MAKES
F00C- A0 F0    1280        LDY /QUARTER      -3/4 <= FRACTION < 1/4
F00E- 20 A7 E7 1290        JSR FSUB
F011- A5 A2    1300        LDA FAC.SIGN      TEST SIGN OF RESULT
F013- 48       1310        PHA               SAVE SIGN FOR LATER UNFOLDING
F014- 10 0D    1320        BPL SIN.1         ALREADY 0...1/4
F016- 20 A0 E7 1330        JSR FADDH         ADD 1/2 TO SHIFT TO -1/4...1/2
F019- A5 A2    1340        LDA FAC.SIGN      TEST SIGN
F01B- 30 09    1350        BMI SIN.2         -1/4...0
               1360 *                        0...1/2
F01D- A5 16    1370        LDA SIGNFLG       SIGNFLG INITIALIZED = 0 IN "TAN"
F01F- 49 FF    1380        EOR #$FF          FUNCTION
F021- 85 16    1390        STA SIGNFLG      "TAN" IS ONLY USER OF SIGNFLG TOO
               1400 *--------------------------------
               1410 *      IF FALL THRU, RANGE IS 0...1/2
               1420 *      IF BRANCH HERE, RANGE IS 0...1/4
               1430 *--------------------------------
F023- 20 D0 EE 1440 SIN.1  JSR NEGOP
               1450 *--------------------------------
               1460 *      IF FALL THRU, RANGE IS -1/2...0
               1470 *      IF BRANCH HERE, RANGE IS -1/4...0
               1480 *--------------------------------
F026- A9 70    1490 SIN.2  LDA #QUARTER      ADD 1/4 TO SHIFT RANGE 
F028- A0 F0    1500        LDY /QUARTER      TO -1/4...1/4
F02A- 20 BE E7 1510        JSR FADD
F02D- 68       1520        PLA               GET SAVED SIGN FROM ABOVE
F02E- 10 03    1530        BPL .1 
F030- 20 D0 EE 1540        JSR NEGOP         MAKE RANGE 0...1/4
F033- A9 75    1550 .1     LDA #POLY.SIN     DO STANDARD SIN SERIES
F035- A0 F0    1560        LDY /POLY.SIN
F037- 4C 5C EF 1570        JMP POLYNOMIAL.ODD
               1580 *--------------------------------
               1590 *      "TAN" FUNCTION
               1600 *
               1610 *      COMPUTE TAN(X) = SIN(X) / COS(X)
               1620 *--------------------------------
F03A- 20 21 EB 1630 TAN    JSR STORE.FAC.IN.TEMP1.ROUNDED
F03D- A9 00    1640        LDA #0       SIGNFLG WILL BE TOGGLED IF 2ND OR 3RD
F03F- 85 16    1650        STA SIGNFLG  QUADRANT
F041- 20 F1 EF 1660        JSR SIN      GET SIN(X)
F044- A2 8A    1670        LDX #TEMP3   SAVE SIN(X) IN TEMP3
F046- A0 00    1680        LDY /TEMP3
F048- 20 E7 EF 1690        JSR GO.MOVMF <<<FUNNY WAY TO CALL MOVMF! >>>
F04B- A9 93    1700        LDA #TEMP1   RETRIEVE X
F04D- A0 00    1710        LDY /TEMP1
F04F- 20 F9 EA 1720        JSR LOAD.FAC.FROM.YA
F052- A9 00    1730        LDA #0       AND COMPUTE COS(X)
F054- 85 A2    1740        STA FAC.SIGN
F056- A5 16    1750        LDA SIGNFLG
F058- 20 62 F0 1760        JSR TAN.1    WEIRD & DANGEROUS WAY TO GET INTO SIN
F05B- A9 8A    1770        LDA #TEMP3   NOW FORM SIN/COS
F05D- A0 00    1780        LDY /TEMP3
F05F- 4C 66 EA 1790        JMP FDIV
               1800 *--------------------------------
F062- 48       1810 TAN.1  PHA          SHAME, SHAME!
F063- 4C 23 F0 1820        JMP SIN.1
               1830 *--------------------------------
F066- 81 49 0F
F069- DA A2    1840 CON.PI.HALF .HS 81490FDAA2
F06B- 83 49 0F
F06E- DA A2    1850 CON.PI.DOUB .HS 83490FDAA2
F070- 7F 00 00
F073- 00 00    1860 QUARTER     .HS 7F00000000
               1870 *--------------------------------
F075- 05       1880 POLY.SIN .DA #5     POWER OF POLYNOMIAL
F076- 84 E6 1A
F079- 2D 1B    1890          .HS 84E61A2D1B  (2PI)^11/11!
F07B- 86 28 07
F07E- FB F8    1900          .HS 862807FBF8  (2PI)^9/9!
F080- 87 99 68
F083- 89 01    1910          .HS 8799688901  (2PI)^7/7!
F085- 87 23 35
F088- DF E1    1920          .HS 872335DFE1  (2PI)^5/5!
F08A- 86 A5 5D
F08D- E7 28    1930          .HS 86A55DE728  (2PI)^3/3!
F08F- 83 49 0F
F092- DA A2    1940          .HS 83490FDAA2  2PI
               1950 *--------------------------------
               1960 *  <<< NEXT TEN BYTES ARE NEVER REFERENCED >>>
               1970 *--------------------------------
F094- A6 D3 C1
F097- C8 D4    1980          .HS A6D3C1C8D4  OR "&SAHT" IN ASCII [exclusive-or each byte with $87 ]
F099- C8 D5 C4                                                   [to get the string "!TFOSORCIM"  ]
F09C- CE CA    1990          .HS C8D5C4CECA  OR "HUDNJ" IN ASCII [which is "MICROSOFT!" backwards.]
               2000 *--------------------------------
               2010 *      "ATN" FUNCTION
               2020 *--------------------------------
F09E- A5 A2    2030 ATN    LDA FAC.SIGN      FOLD THE ARGUMENT RANGE FIRST
F0A0- 48       2040        PHA               SAVE SIGN FOR LATER UNFOLDING
F0A1- 10 03    2050        BPL .1            .GE. 0
F0A3- 20 D0 EE 2060        JSR NEGOP         .LT. 0, SO COMPLEMENT
F0A6- A5 9D    2070 .1     LDA FAC           IF .GE. 1, FORM RECIPROCAL
F0A8- 48       2080        PHA               SAVE FOR LATER UNFOLDING
F0A9- C9 81    2090        CMP #$81          (EXPONENT FOR .GE. 1
F0AB- 90 07    2100        BCC .2            X < 1
F0AD- A9 13    2110        LDA #CON.ONE      FORM 1/X
F0AF- A0 E9    2120        LDY /CON.ONE
F0B1- 20 66 EA 2130        JSR FDIV
               2140 *--------------------------------
               2150 *      0 <= X <= 1
               2160 *      0 <= ATN(X) <= PI/8
               2170 *--------------------------------
F0B4- A9 CE    2180 .2     LDA #POLY.ATN     COMPUTE POLYNOMIAL APPROXIMATION
F0B6- A0 F0    2190        LDY /POLY.ATN
F0B8- 20 5C EF 2200        JSR POLYNOMIAL.ODD
F0BB- 68       2210        PLA               START TO UNFOLD
F0BC- C9 81    2220        CMP #$81          WAS IT .GE. 1?
F0BE- 90 07    2230        BCC .3            NO
F0C0- A9 66    2240        LDA #CON.PI.HALF  YES, SUBTRACT FROM PI/2
F0C2- A0 F0    2250        LDY /CON.PI.HALF
F0C4- 20 A7 E7 2260        JSR FSUB
F0C7- 68       2270 .3     PLA               WAS IT NEGATIVE?
F0C8- 10 03    2280        BPL RTS.20        NO
F0CA- 4C D0 EE 2290        JMP NEGOP         YES, COMPLEMENT
F0CD- 60       2300 RTS.20 RTS
               2310 *--------------------------------
F0CE- 0B       2320 POLY.ATN .DA #11    POWER OF POLYNOMIAL
F0CF- 76 B3 83
F0D2- BD D3    2330          .HS 76B383BDD3
F0D4- 79 1E F4
F0D7- A6 F5    2340          .HS 791EF4A6F5
F0D9- 7B 83 FC
F0DC- B0 10    2350          .HS 7B83FCB010
F0DE- 7C 0C 1F
F0E1- 67 CA    2360          .HS 7C0C1F67CA
F0E3- 7C DE 53
F0E6- CB C1    2370          .HS 7CDE53CBC1
F0E8- 7D 14 64
F0EB- 70 4C    2380          .HS 7D1464704C
F0ED- 7D B7 EA
F0F0- 51 7A    2390          .HS 7DB7EA517A
F0F2- 7D 63 30
F0F5- 88 7E    2400          .HS 7D6330887E
F0F7- 7E 92 44
F0FA- 99 3A    2410          .HS 7E9244993A
F0FC- 7E 4C CC
F0FF- 91 C7    2420          .HS 7E4CCC91C7
F101- 7F AA AA
F104- AA 13    2430          .HS 7FAAAAAA13
F106- 81 00 00
F109- 00 00    2440          .HS 8100000000
               2450 *--------------------------------
               2460 *      GENERIC COPY OF CHRGET SUBROUTINE, WHICH
               2470 *      IS COPIED INTO $00B1...$00C8 DURING INITIALIZATION
               2480 *
               2490 *      CORNELIS BONGERS DESCRIBED SEVERAL IMPROVEMENTS 
               2500 *      TO CHRGET IN MICRO MAGAZINE OR CALL A.P.P.L.E.
               2510 *      (I DON'T REMEMBER WHICH OR EXACTLY WHEN)
               2520 *--------------------------------
               2530 GENERIC.CHRGET
F10B- E6 B8    2540        INC TXTPTR
F10D- D0 02    2550        BNE .1
F10F- E6 B9    2560        INC TXTPTR+1
F111- AD 60 EA 2570 .1     LDA $EA60    <<< ACTUAL ADDRESS FILLED IN LATER >>>
F114- C9 3A    2580        CMP #':'     EOS, ALSO TOP OF NUMERIC RANGE
F116- B0 0A    2590        BCS .2       NOT NUMBER, MIGHT BE EOS
F118- C9 20    2600        CMP #' '     IGNORE BLANKS
F11A- F0 EF    2610        BEQ GENERIC.CHRGET
F11C- 38       2620        SEC          TEST FOR NUMERIC RANGE IN WAY THAT
F11D- E9 30    2630        SBC #'0'     CLEARS CARRY IF CHAR IS DIGIT
F11F- 38       2640        SEC          AND LEAVES CHAR IN A-REG
F120- E9 D0    2650        SBC #-'0'
F122- 60       2660 .2     RTS
               2670 *--------------------------------
               2680 *      INITIAL VALUE FOR RANDOM NUMBER, ALSO COPIED
               2690 *      IN ALONG WITH CHRGET, BUT ERRONEOUSLY:
               2700 *  <<< THE LAST BYTE IS NOT COPIED >>>
               2710 *--------------------------------
F123- 80 4F C7
F126- 52 58    2720        .HS 804FC75258  APPROX. = .811635157
               2730 GENERIC.END
               2740 *--------------------------------
               2750 COLD.START
F128- A2 FF    2760        LDX #$FF     SET DIRECT MODE FLAG
F12A- 86 76    2770        STX CURLIN+1
F12C- A2 FB    2780        LDX #$FB     SET STACK POINTER, LEAVING ROOM FOR
F12E- 9A       2790        TXS          LINE BUFFER DURING PARSING
F12F- A9 28    2800        LDA #COLD.START   SET RESTART TO COLD.START
F131- A0 F1    2810        LDY /COLD.START   UNTIL COLDSTART IS COMPLETED
F133- 85 01    2820        STA GOWARM+1
F135- 84 02    2830        STY GOWARM+2
F137- 85 04    2840        STA GOSTROUT+1    ALSO SECOND USER VECTOR...
F139- 84 05    2850        STY GOSTROUT+2  ..WE SIMPLY MUST FINISH COLD.START!
F13B- 20 73 F2 2860        JSR NORMAL        SET NORMAL DISPLAY MODE
F13E- A9 4C    2870        LDA #$4C          "JMP" OPCODE FOR 4 VECTORS
F140- 85 00    2880        STA GOWARM        WARM START
F142- 85 03    2890        STA GOSTROUT      ANYONE EVER USE THIS ONE?
F144- 85 90    2900        STA JMPADRS       USED BY FUNCTIONS (JSR JMPADRS)
F146- 85 0A    2910        STA USR           "USR" FUNCTION VECTOR
F148- A9 99    2920        LDA #IQERR        POINT "USR" TO ILLEGAL QUANTITY
F14A- A0 E1    2930        LDY /IQERR        ERROR, UNTIL USER SETS IT UP
F14C- 85 0B    2940        STA USR+1
F14E- 84 0C    2950        STY USR+2
               2960 *--------------------------------
               2970 *      MOVE GENERIC CHRGET AND RANDOM SEED INTO PLACE
               2980 *
               2990 *  <<< NOTE THAT LOOP VALUE IS WRONG!          >>>
               3000 *  <<< THE LAST BYTE OF THE RANDOM SEED IS NOT >>>
               3010 *  <<< COPIED INTO PAGE ZERO!                  >>>
               3020 *--------------------------------
F150- A2 1C    3030        LDX #GENERIC.END-GENERIC.CHRGET-1
F152- BD 0A F1 3040 .1     LDA GENERIC.CHRGET-1,X
F155- 95 B0    3050        STA CHRGET-1,X
F157- 86 F1    3060        STX SPEEDZ        ON LAST PASS STORES $01)
F159- CA       3070        DEX
F15A- D0 F6    3080        BNE .1
               3090 *--------------------------------
F15C- 86 F2    3100        STX TRCFLG        X=0, TURN OFF TRACING
F15E- 8A       3110        TXA               A=0
F15F- 85 A4    3120        STA SHIFT.SIGN.EXT
F161- 85 54    3130        STA LASTPT+1
F163- 48       3140        PHA               PUT $00 ON STACK (WHAT FOR?)
F164- A9 03    3150        LDA #3       SET LENGTH OF TEMP. STRING DESCRIPTORS
F166- 85 8F    3160        STA DSCLEN   FOR GARBAGE COLLECTION SUBROUTINE
F168- 20 FB DA 3170        JSR CRDO     PRINT <RETURN>
F16B- A9 01    3180        LDA #1       SET UP FAKE FORWARD LINK
F16D- 8D FD 01 3190        STA INPUT.BUFFER-3
F170- 8D FC 01 3200        STA INPUT.BUFFER-4
F173- A2 55    3210        LDX #TEMPST  INIT INDEX TO TEMP STRING DESCRIPTORS
F175- 86 52    3220        STX TEMPPT
               3230 *--------------------------------
               3240 *      FIND HIGH END OF RAM
               3250 *--------------------------------
F177- A9 00    3260        LDA #$0800   SET UP POINTER TO LOW END OF RAM
F179- A0 08    3270        LDY /$0800
F17B- 85 50    3280        STA LINNUM
F17D- 84 51    3290        STY LINNUM+1
F17F- A0 00    3300        LDY #0
F181- E6 51    3310 .2     INC LINNUM+1      TEST FIRST BYTE OF EACH PAGE
F183- B1 50    3320        LDA (LINNUM),Y    BY COMPLEMENTING IT AND WATCHING
F185- 49 FF    3330        EOR #$FF          IT CHANGE THE SAME WAY
F187- 91 50    3340        STA (LINNUM),Y
F189- D1 50    3350        CMP (LINNUM),Y    ROM OR EMPTY SOCKETS WON'T TRACK
F18B- D0 08    3360        BNE .3            NOT RAM HERE
F18D- 49 FF    3370        EOR #$FF          RESTORE ORIGINAL VALUE
F18F- 91 50    3380        STA (LINNUM),Y
F191- D1 50    3390        CMP (LINNUM),Y    DID IT TRACK AGAIN?
F193- F0 EC    3400        BEQ .2            YES, STILL IN RAM
F195- A4 50    3410 .3     LDY LINNUM        NO, END OF RAM
F197- A5 51    3420        LDA LINNUM+1
F199- 29 F0    3430        AND #$F0          FORCE A MULTIPLE OF 4096 BYTES
F19B- 84 73    3440        STY MEMSIZ  (BAD RAM MAY HAVE YIELDED NON-MULTIPLE)
F19D- 85 74    3450        STA MEMSIZ+1
F19F- 84 6F    3460        STY FRETOP        SET HIMEM AND BOTTOM OF STRINGS
F1A1- 85 70    3470        STA FRETOP+1
F1A3- A2 00    3480        LDX #$0800        SET PROGRAM POINTER TO $0800
F1A5- A0 08    3490        LDY /$0800
F1A7- 86 67    3500        STX TXTTAB
F1A9- 84 68    3510        STY TXTTAB+1
F1AB- A0 00    3520        LDY #0            TURN OFF SEMI-SECRET LOCK FLAG
F1AD- 84 D6    3530        STY LOCK
F1AF- 98       3540        TYA               A=0 TOO
F1B0- 91 67    3550        STA (TXTTAB),Y    FIRST BYTE IN PROGRAM SPACE = 0
F1B2- E6 67    3560        INC TXTTAB        ADVANCE PAST THE $00
F1B4- D0 02    3570        BNE .4
F1B6- E6 68    3580        INC TXTTAB+1
F1B8- A5 67    3590 .4     LDA TXTTAB
F1BA- A4 68    3600        LDY TXTTAB+1
F1BC- 20 E3 D3 3610        JSR REASON        SET REST OF POINTERS UP
F1BF- 20 4B D6 3620        JSR SCRTCH        MORE POINTERS
F1C2- A9 3A    3630        LDA #STROUT       PUT CORRECT ADDRESSES IN TWO
F1C4- A0 DB    3640        LDY /STROUT       USER VECTORS
F1C6- 85 04    3650        STA GOSTROUT+1
F1C8- 84 05    3660        STY GOSTROUT+2
F1CA- A9 3C    3670        LDA #RESTART
F1CC- A0 D4    3680        LDY /RESTART
F1CE- 85 01    3690        STA GOWARM+1
F1D0- 84 02    3700        STY GOWARM+2
F1D2- 6C 01 00 3710        JMP (GOWARM+1)    SILLY, WHY NOT JUST "JMP RESTART"
               3720 *--------------------------------