S-C DocuMentor — Applesoft
SAVE S.D912
1010 *--------------------------------
1020 * "RUN" COMMAND
1030 *--------------------------------
D912- 08 1040 RUN PHP SAVE STATUS WHILE SUBTRACTING
D913- C6 76 1050 DEC CURLIN+1 IF WAS $FF (MEANING DIRECT MODE)
1060 * MAKE IT "RUNNING MODE"
D915- 28 1070 PLP GET STATUS AGAIN (FROM CHRGET)
D916- D0 03 1080 BNE .1 PROBABLY A LINE NUMBER
D918- 4C 65 D6 1090 JMP SETPTRS START AT BEGINNING OF PROGRAM
D91B- 20 6C D6 1100 .1 JSR CLEARC CLEAR VARIABLES
D91E- 4C 35 D9 1110 JMP GO.TO.LINE JOIN GOSUB STATEMENT
1120 *--------------------------------
1130 * "GOSUB" STATEMENT
1140 *
1150 * LEAVES 7 BYTES ON STACK:
1160 * 2 -- RETURN ADDRESS (NEWSTT)
1170 * 2 -- TXTPTR
1180 * 2 -- LINE #
1190 * 1 -- GOSUB TOKEN ($B0)
1200 *--------------------------------
D921- A9 03 1210 GOSUB LDA #3 BE SURE ENOUGH ROOM ON STACK
D923- 20 D6 D3 1220 JSR CHKMEM
D926- A5 B9 1230 LDA TXTPTR+1
D928- 48 1240 PHA
D929- A5 B8 1250 LDA TXTPTR
D92B- 48 1260 PHA
D92C- A5 76 1270 LDA CURLIN+1
D92E- 48 1280 PHA
D92F- A5 75 1290 LDA CURLIN
D931- 48 1300 PHA
D932- A9 B0 1310 LDA #TOKEN.GOSUB
D934- 48 1320 PHA
1330 GO.TO.LINE
D935- 20 B7 00 1340 JSR CHRGOT
D938- 20 3E D9 1350 JSR GOTO
D93B- 4C D2 D7 1360 JMP NEWSTT
1370 *--------------------------------
1380 * "GOTO" STATEMENT
1390 * ALSO USED BY "RUN" AND "GOSUB"
1400 *--------------------------------
D93E- 20 0C DA 1410 GOTO JSR LINGET GET GOTO LINE
D941- 20 A6 D9 1420 JSR REMN POINT Y TO EOL
D944- A5 76 1430 LDA CURLIN+1 IS CURRENT PAGE < GOTO PAGE?
D946- C5 51 1440 CMP LINNUM+1
D948- B0 0B 1450 BCS .1 SEARCH FROM PROG START IF NOT
D94A- 98 1460 TYA OTHERWISE SEARCH FROM NEXT LINE
D94B- 38 1470 SEC
D94C- 65 B8 1480 ADC TXTPTR
D94E- A6 B9 1490 LDX TXTPTR+1
D950- 90 07 1500 BCC .2
D952- E8 1510 INX
D953- B0 04 1520 BCS .2
D955- A5 67 1530 .1 LDA TXTTAB GET PROGRAM BEGINNING
D957- A6 68 1540 LDX TXTTAB+1
D959- 20 1E D6 1550 .2 JSR FL1 SEARCH FOR GOTO LINE
D95C- 90 1E 1560 BCC UNDERR ERROR IF NOT THERE
D95E- A5 9B 1570 LDA LOWTR TXTPTR = START OF THE DESTINATION LINE
D960- E9 01 1580 SBC #1
D962- 85 B8 1590 STA TXTPTR
D964- A5 9C 1600 LDA LOWTR+1
D966- E9 00 1610 SBC #0
D968- 85 B9 1620 STA TXTPTR+1
D96A- 60 1630 RTS.5 RTS RETURN TO NEWSTT OR GOSUB
1640 *--------------------------------
1650 * "POP" AND "RETURN" STATEMENTS
1660 *--------------------------------
D96B- D0 FD 1670 POP BNE RTS.5
D96D- A9 FF 1680 LDA #$FF
D96F- 85 85 1690 STA FORPNT <<< BUG: SHOULD BE FORPNT+1 >>>
1700 * <<< SEE "ALL ABOUT APPLESOFT", PAGES 100,101 >>>
D971- 20 65 D3 1710 JSR GTFORPNT TO CANCEL FOR/NEXT IN SUB
D974- 9A 1720 TXS
D975- C9 B0 1730 CMP #TOKEN.GOSUB LAST GOSUB FOUND?
D977- F0 0B 1740 BEQ RETURN
D979- A2 16 1750 LDX #ERR.NOGOSUB
D97B- 2C 1760 .HS 2C FAKE: BIT xxxx skips ahead to JMP ERROR
D97C- A2 5A 1770 UNDERR LDX #ERR.UNDEFSTAT
D97E- 4C 12 D4 1780 JMP ERROR
1790 *--------------------------------
D981- 4C C9 DE 1800 SYNERR.2 JMP SYNERR
1810 *--------------------------------
D984- 68 1820 RETURN PLA DISCARD GOSUB TOKEN
D985- 68 1830 PLA
D986- C0 42 1840 CPY #TOKEN.POP*2
D988- F0 3B 1850 BEQ PULL3 BRANCH IF A POP
D98A- 85 75 1860 STA CURLIN PULL LINE #
D98C- 68 1870 PLA
D98D- 85 76 1880 STA CURLIN+1
D98F- 68 1890 PLA
D990- 85 B8 1900 STA TXTPTR PULL TXTPTR
D992- 68 1910 PLA
D993- 85 B9 1920 STA TXTPTR+1
1930 *--------------------------------
1940 * "DATA" STATEMENT
1950 * EXECUTED BY SKIPPING TO NEXT COLON OR EOL
1960 *--------------------------------
D995- 20 A3 D9 1970 DATA JSR DATAN MOVE TO NEXT STATEMENT
1980 *--------------------------------
1990 * ADD (Y) TO TXTPTR
2000 *--------------------------------
D998- 98 2010 ADDON TYA
D999- 18 2020 CLC
D99A- 65 B8 2030 ADC TXTPTR
D99C- 85 B8 2040 STA TXTPTR
D99E- 90 02 2050 BCC .1
D9A0- E6 B9 2060 INC TXTPTR+1
2070 .1
D9A2- 60 2080 RTS.6 RTS
2090 *--------------------------------
2100 * SCAN AHEAD TO NEXT ":" OR EOL
2110 *--------------------------------
D9A3- A2 3A 2120 DATAN LDX #':' GET OFFSET IN Y TO EOL OR ":"
D9A5- 2C 2130 .HS 2C FAKE
2140 *--------------------------------
D9A6- A2 00 2150 REMN LDX #0 TO EOL ONLY
D9A8- 86 0D 2160 STX CHARAC
D9AA- A0 00 2170 LDY #0
D9AC- 84 0E 2180 STY ENDCHR
D9AE- A5 0E 2190 .1 LDA ENDCHR TRICK TO COUNT QUOTE PARITY
D9B0- A6 0D 2200 LDX CHARAC
D9B2- 85 0D 2210 STA CHARAC
D9B4- 86 0E 2220 STX ENDCHR
D9B6- B1 B8 2230 .2 LDA (TXTPTR),Y
D9B8- F0 E8 2240 BEQ RTS.6 END OF LINE
D9BA- C5 0E 2250 CMP ENDCHR
D9BC- F0 E4 2260 BEQ RTS.6 COLON IF LOOKING FOR COLONS
D9BE- C8 2270 INY
D9BF- C9 22 2280 CMP #'"'
D9C1- D0 F3 2290 BNE .2
D9C3- F0 E9 2300 BEQ .1 ...ALWAYS
2310 *--------------------------------
D9C5- 68 2320 PULL3 PLA
D9C6- 68 2330 PLA
D9C7- 68 2340 PLA
D9C8- 60 2350 RTS
2360 *--------------------------------
2370 * "IF" STATEMENT
2380 *--------------------------------
D9C9- 20 7B DD 2390 IF JSR FRMEVL
D9CC- 20 B7 00 2400 JSR CHRGOT
D9CF- C9 AB 2410 CMP #TOKEN.GOTO
D9D1- F0 05 2420 BEQ .1
D9D3- A9 C4 2430 LDA #TOKEN.THEN
D9D5- 20 C0 DE 2440 JSR SYNCHR
D9D8- A5 9D 2450 .1 LDA FAC CONDITION TRUE OR FALSE?
D9DA- D0 05 2460 BNE IF.TRUE BRANCH IF TRUE
2470 *--------------------------------
2480 * "REM" STATEMENT, OR FALSE "IF" STATEMENT
2490 *--------------------------------
D9DC- 20 A6 D9 2500 REM JSR REMN SKIP REST OF LINE
D9DF- F0 B7 2510 BEQ ADDON ...ALWAYS
2520 *--------------------------------
2530 IF.TRUE
D9E1- 20 B7 00 2540 JSR CHRGOT COMMAND OR NUMBER?
D9E4- B0 03 2550 BCS .1 COMMAND
D9E6- 4C 3E D9 2560 JMP GOTO NUMBER
D9E9- 4C 28 D8 2570 .1 JMP EXECUTE.STATEMENT
2580 *--------------------------------
2590 * "ON" STATEMENT
2600 *
2610 * ON <EXP> GOTO <LIST>
2620 * ON <EXP> GOSUB <LIST>
2630 *--------------------------------
D9EC- 20 F8 E6 2640 ONGOTO JSR GETBYT EVALUATE <EXP>, AS BYTE IN FAC+4
D9EF- 48 2650 PHA SAVE NEXT CHAR ON STACK
D9F0- C9 B0 2660 CMP #TOKEN.GOSUB
D9F2- F0 04 2670 BEQ ON.2
D9F4- C9 AB 2680 ON.1 CMP #TOKEN.GOTO
D9F6- D0 89 2690 BNE SYNERR.2
D9F8- C6 A1 2700 ON.2 DEC FAC+4 COUNTED TO RIGHT ONE YET?
D9FA- D0 04 2710 BNE .3 NO, KEEP LOOKING
D9FC- 68 2720 PLA YES, RETRIEVE CMD
D9FD- 4C 2A D8 2730 JMP EXECUTE.STATEMENT.1 AND GO.
DA00- 20 B1 00 2740 .3 JSR CHRGET PRIME CONVERT SUBROUTINE
DA03- 20 0C DA 2750 JSR LINGET CONVERT LINE #
DA06- C9 2C 2760 CMP #',' TERMINATE WITH COMMA?
DA08- F0 EE 2770 BEQ ON.2 YES
DA0A- 68 2780 PLA NO, END OF LIST, SO IGNORE
DA0B- 60 2790 RTS.7 RTS
2800 *--------------------------------
2810 * CONVERT LINE NUMBER
2820 *--------------------------------
DA0C- A2 00 2830 LINGET LDX #0 ASC # TO HEX ADDRESS
DA0E- 86 50 2840 STX LINNUM IN LINNUM.
DA10- 86 51 2850 STX LINNUM+1
DA12- B0 F7 2860 .1 BCS RTS.7 NOT A DIGIT
DA14- E9 2F 2870 SBC #'0'-1 CONVERT DIGIT TO BINARY
DA16- 85 0D 2880 STA CHARAC SAVE THE DIGIT
DA18- A5 51 2890 LDA LINNUM+1 CHECK RANGE
DA1A- 85 5E 2900 STA INDEX
DA1C- C9 19 2910 CMP /6400 LINE # TOO LARGE?
DA1E- B0 D4 2920 BCS ON.1 YES, > 63999, GO INDIRECTLY TO
2930 * "SYNTAX ERROR".
2940 *<<<<<DANGEROUS CODE>>>>>
2950 * NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
2960 * ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC
2970 * JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
2980 * FOR OTHER CALLS TO LINGET.
2990 *
3000 * YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
3010 * THEN TYPE "GO TO 437761".
3020 *
3030 * ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
3040 * THE PROBLEM. ($AB00 - $ABFF)
3045 * See 437760 to 440319 on Wikipedia 100000 (number)
3050 *<<<<<DANGEROUS CODE>>>>>
DA20- A5 50 3060 LDA LINNUM MULTIPLY BY TEN
DA22- 0A 3070 ASL
DA23- 26 5E 3080 ROL INDEX
DA25- 0A 3090 ASL
DA26- 26 5E 3100 ROL INDEX
DA28- 65 50 3110 ADC LINNUM
DA2A- 85 50 3120 STA LINNUM
DA2C- A5 5E 3130 LDA INDEX
DA2E- 65 51 3140 ADC LINNUM+1
DA30- 85 51 3150 STA LINNUM+1
DA32- 06 50 3160 ASL LINNUM
DA34- 26 51 3170 ROL LINNUM+1
DA36- A5 50 3180 LDA LINNUM
DA38- 65 0D 3190 ADC CHARAC ADD DIGIT
DA3A- 85 50 3200 STA LINNUM
DA3C- 90 02 3210 BCC .2
DA3E- E6 51 3220 INC LINNUM+1
DA40- 20 B1 00 3230 .2 JSR CHRGET GET NEXT CHAR
DA43- 4C 12 DA 3240 JMP .1 MORE CONVERTING
3250 *--------------------------------
3260 * "LET" STATEMENT
3270 *
3280 * LET <VAR> = <EXP>
3290 * <VAR> = <EXP>
3300 *--------------------------------
DA46- 20 E3 DF 3310 LET JSR PTRGET GET <VAR>
DA49- 85 85 3320 STA FORPNT
DA4B- 84 86 3330 STY FORPNT+1
DA4D- A9 D0 3340 LDA #TOKEN.EQUAL
DA4F- 20 C0 DE 3350 JSR SYNCHR
DA52- A5 12 3360 LDA VALTYP+1 SAVE VARIABLE TYPE
DA54- 48 3370 PHA
DA55- A5 11 3380 LDA VALTYP
DA57- 48 3390 PHA
DA58- 20 7B DD 3400 JSR FRMEVL EVALUATE <EXP>
DA5B- 68 3410 PLA
DA5C- 2A 3420 ROL
DA5D- 20 6D DD 3430 JSR CHKVAL
DA60- D0 18 3440 BNE LET.STRING
DA62- 68 3450 PLA
3460 *--------------------------------
DA63- 10 12 3470 LET2 BPL .1 REAL VARIABLE
DA65- 20 72 EB 3480 JSR ROUND.FAC INTEGER VAR: ROUND TO 32 BITS
DA68- 20 0C E1 3490 JSR AYINT TRUNCATE TO 16-BITS
DA6B- A0 00 3500 LDY #0
DA6D- A5 A0 3510 LDA FAC+3
DA6F- 91 85 3520 STA (FORPNT),Y
DA71- C8 3530 INY
DA72- A5 A1 3540 LDA FAC+4
DA74- 91 85 3550 STA (FORPNT),Y
DA76- 60 3560 RTS
3570 *--------------------------------
3580 * REAL VARIABLE = EXPRESSION
3590 *--------------------------------
DA77- 4C 27 EB 3600 .1 JMP SETFOR
3610 *--------------------------------
3620 LET.STRING
DA7A- 68 3630 PLA
3640 *--------------------------------
3650 * INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4
3660 *--------------------------------
DA7B- A0 02 3670 PUTSTR LDY #2 STRING DATA ALREADY IN STRING AREA?
DA7D- B1 A0 3680 LDA (FAC+3),Y (STRING AREA IS BTWN FRETOP
DA7F- C5 70 3690 CMP FRETOP+1 HIMEM)
DA81- 90 17 3700 BCC .2 YES, DATA ALREADY UP THERE
DA83- D0 07 3710 BNE .1 NO
DA85- 88 3720 DEY MAYBE, TEST LOW BYTE OF POINTER
DA86- B1 A0 3730 LDA (FAC+3),Y
DA88- C5 6F 3740 CMP FRETOP
DA8A- 90 0E 3750 BCC .2 YES, ALREADY THERE
DA8C- A4 A1 3760 .1 LDY FAC+4 NO. DESCRIPTOR ALREADY AMONG VARIABLES?
DA8E- C4 6A 3770 CPY VARTAB+1
DA90- 90 08 3780 BCC .2 NO
DA92- D0 0D 3790 BNE .3 YES
DA94- A5 A0 3800 LDA FAC+3 MAYBE, COMPARE LO-BYTE
DA96- C5 69 3810 CMP VARTAB
DA98- B0 07 3820 BCS .3 YES, DESCRIPTOR IS AMONG VARIABLES
DA9A- A5 A0 3830 .2 LDA FAC+3 EITHER STRING ALREADY ON TOP, OR
DA9C- A4 A1 3840 LDY FAC+4 DESCRIPTOR IS NOT A VARIABLE
DA9E- 4C B7 DA 3850 JMP .4 SO JUST STORE THE DESCRIPTOR
3860 *--------------------------------
3870 * STRING NOT YET IN STRING AREA,
3880 * AND DESCRIPTOR IS A VARIABLE
3890 *--------------------------------
DAA1- A0 00 3900 .3 LDY #0 POINT AT LENGTH IN DESCRIPTOR
DAA3- B1 A0 3910 LDA (FAC+3),Y GET LENGTH
DAA5- 20 D5 E3 3920 JSR STRINI MAKE A STRING THAT LONG UP ABOVE
DAA8- A5 8C 3930 LDA DSCPTR SET UP SOURCE PNTR FOR MONINS
DAAA- A4 8D 3940 LDY DSCPTR+1
DAAC- 85 AB 3950 STA STRNG1
DAAE- 84 AC 3960 STY STRNG1+1
DAB0- 20 D4 E5 3970 JSR MOVINS MOVE STRING DATA TO NEW AREA
DAB3- A9 9D 3980 LDA #FAC ADDRESS OF DESCRIPTOR IS IN FAC
DAB5- A0 00 3990 LDY /FAC
DAB7- 85 8C 4000 .4 STA DSCPTR
DAB9- 84 8D 4010 STY DSCPTR+1
DABB- 20 35 E6 4020 JSR FRETMS DISCARD DESCRIPTOR IF 'TWAS TEMPORARY
DABE- A0 00 4030 LDY #0 COPY STRING DESCRIPTOR
DAC0- B1 8C 4040 LDA (DSCPTR),Y
DAC2- 91 85 4050 STA (FORPNT),Y
DAC4- C8 4060 INY
DAC5- B1 8C 4070 LDA (DSCPTR),Y
DAC7- 91 85 4080 STA (FORPNT),Y
DAC9- C8 4090 INY
DACA- B1 8C 4100 LDA (DSCPTR),Y
DACC- 91 85 4110 STA (FORPNT),Y
DACE- 60 4120 RTS
S.D766