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 *--------------------------------
S.EE8D