S-C DocuMentor — Applesoft
SAVE S.D766
1010 *--------------------------------
1020 * "FOR" STATEMENT
1030 *
1040 * FOR PUSHES 18 BYTES ON THE STACK:
1050 * 2 -- TXTPTR
1060 * 2 -- LINE NUMBER
1070 * 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE
1080 * 1 -- STEP SIGN
1090 * 5 -- STEP VALUE
1100 * 2 -- ADDRESS OF FOR VARIABLE IN VARTAB
1110 * 1 -- FOR TOKEN ($81)
1120 *--------------------------------
D766- A9 80 1130 FOR LDA #$80
D768- 85 14 1140 STA SUBFLG SUBSCRIPTS NOT ALLOWED
D76A- 20 46 DA 1150 JSR LET DO <VAR> = <EXP>, STORE ADDR IN FORPNT
D76D- 20 65 D3 1160 JSR GTFORPNT IS THIS FOR VARIABLE ACTIVE?
D770- D0 05 1170 BNE .1 NO
D772- 8A 1180 TXA YES, CANCEL IT AND ENCLOSED LOOPS
D773- 69 0F 1190 ADC #15 CARRY=1, THIS ADDS 16
D775- AA 1200 TAX X WAS ALREADY S+2
D776- 9A 1210 TXS
D777- 68 1220 .1 PLA POP RETURN ADDRESS TOO
D778- 68 1230 PLA
D779- A9 09 1240 LDA #9 BE CERTAIN ENOUGH ROOM IN STACK
D77B- 20 D6 D3 1250 JSR CHKMEM
D77E- 20 A3 D9 1260 JSR DATAN SCAN AHEAD TO NEXT STATEMENT
D781- 18 1270 CLC PUSH STATEMENT ADDRESS ON STACK
D782- 98 1280 TYA
D783- 65 B8 1290 ADC TXTPTR
D785- 48 1300 PHA
D786- A5 B9 1310 LDA TXTPTR+1
D788- 69 00 1320 ADC #0
D78A- 48 1330 PHA
D78B- A5 76 1340 LDA CURLIN+1 PUSH LINE NUMBER ON STACK
D78D- 48 1350 PHA
D78E- A5 75 1360 LDA CURLIN
D790- 48 1370 PHA
D791- A9 C1 1380 LDA #TOKEN.TO
D793- 20 C0 DE 1390 JSR SYNCHR REQUIRE "TO"
D796- 20 6A DD 1400 JSR CHKNUM <VAR> = <EXP> MUST BE NUMERIC
D799- 20 67 DD 1410 JSR FRMNUM GET FINAL VALUE, MUST BE NUMERIC
D79C- A5 A2 1420 LDA FAC.SIGN PUT SIGN INTO VALUE IN FAC
D79E- 09 7F 1430 ORA #$7F
D7A0- 25 9E 1440 AND FAC+1
D7A2- 85 9E 1450 STA FAC+1
D7A4- A9 AF 1460 LDA #STEP SET UP FOR RETURN
D7A6- A0 D7 1470 LDY /STEP TO STEP
D7A8- 85 5E 1480 STA INDEX
D7AA- 84 5F 1490 STY INDEX+1
D7AC- 4C 20 DE 1500 JMP FRM.STACK.3 RETURNS BY "JMP (INDEX)"
1510 *--------------------------------
1520 * "STEP" PHRASE OF "FOR" STATEMENT
1530 *--------------------------------
D7AF- A9 13 1540 STEP LDA #CON.ONE STEP DEFAULT=1
D7B1- A0 E9 1550 LDY /CON.ONE
D7B3- 20 F9 EA 1560 JSR LOAD.FAC.FROM.YA
D7B6- 20 B7 00 1570 JSR CHRGOT
D7B9- C9 C7 1580 CMP #TOKEN.STEP
D7BB- D0 06 1590 BNE .1 USE DEFAULT VALUE OF 1.0
D7BD- 20 B1 00 1600 JSR CHRGET STEP SPECIFIED, GET IT
D7C0- 20 67 DD 1610 JSR FRMNUM
D7C3- 20 82 EB 1620 .1 JSR SIGN
D7C6- 20 15 DE 1630 JSR FRM.STACK.2
D7C9- A5 86 1640 LDA FORPNT+1
D7CB- 48 1650 PHA
D7CC- A5 85 1660 LDA FORPNT
D7CE- 48 1670 PHA
D7CF- A9 81 1680 LDA #TOKEN.FOR
D7D1- 48 1690 PHA
1700 *--------------------------------
1710 * PERFORM NEXT STATEMENT
1720 *--------------------------------
D7D2- BA 1730 NEWSTT TSX REMEMBER THE STACK POSITION
D7D3- 86 F8 1740 STX REMSTK
D7D5- 20 58 D8 1750 JSR ISCNTC SEE IF CONTROL-C HAS BEEN TYPED
D7D8- A5 B8 1760 LDA TXTPTR NO, KEEP EXECUTING
D7DA- A4 B9 1770 LDY TXTPTR+1
D7DC- A6 76 1780 LDX CURLIN+1 =$FF IF IN DIRECT MODE
D7DE- E8 1790 INX $FF TURNS INTO $00
D7DF- F0 04 1800 BEQ .1 IN DIRECT MODE
D7E1- 85 79 1810 STA OLDTEXT IN RUNNING MODE
D7E3- 84 7A 1820 STY OLDTEXT+1
D7E5- A0 00 1830 .1 LDY #0
D7E7- B1 B8 1840 LDA (TXTPTR),Y END OF LINE YET?
D7E9- D0 57 1850 BNE COLON. NO
D7EB- A0 02 1860 LDY #2 YES, SEE IF END OF PROGRAM
D7ED- B1 B8 1870 LDA (TXTPTR),Y
D7EF- 18 1880 CLC
D7F0- F0 34 1890 BEQ GOEND YES, END OF PROGRAM
D7F2- C8 1900 INY
D7F3- B1 B8 1910 LDA (TXTPTR),Y GET LINE # OF NEXT LINE
D7F5- 85 75 1920 STA CURLIN
D7F7- C8 1930 INY
D7F8- B1 B8 1940 LDA (TXTPTR),Y
D7FA- 85 76 1950 STA CURLIN+1
D7FC- 98 1960 TYA ADJUST TXTPTR TO START
D7FD- 65 B8 1970 ADC TXTPTR OF NEW LINE
D7FF- 85 B8 1980 STA TXTPTR
D801- 90 02 1990 BCC .2
D803- E6 B9 2000 INC TXTPTR+1
2010 .2
2020 *--------------------------------
D805- 24 F2 2030 TRACE. BIT TRCFLG IS TRACE ON?
D807- 10 14 2040 BPL .1 NO
D809- A6 76 2050 LDX CURLIN+1 YES, ARE WE RUNNING?
D80B- E8 2060 INX
D80C- F0 0F 2070 BEQ .1 NOT RUNNING, SO DON'T TRACE
D80E- A9 23 2080 LDA #'#' PRINT "#"
D810- 20 5C DB 2090 JSR OUTDO
D813- A6 75 2100 LDX CURLIN
D815- A5 76 2110 LDA CURLIN+1
D817- 20 24 ED 2120 JSR LINPRT PRINT LINE NUMBER
D81A- 20 57 DB 2130 JSR OUTSP PRINT TRAILING SPACE
D81D- 20 B1 00 2140 .1 JSR CHRGET GET FIRST CHR OF STATEMENT
D820- 20 28 D8 2150 JSR EXECUTE.STATEMENT AND START PROCESSING
D823- 4C D2 D7 2160 JMP NEWSTT BACK FOR MORE
2170 *--------------------------------
D826- F0 62 2180 GOEND BEQ END4
2190 *--------------------------------
2200 * EXECUTE A STATEMENT
2210 *
2220 * (A) IS FIRST CHAR OF STATEMENT
2230 * CARRY IS SET
2240 *--------------------------------
2250 EXECUTE.STATEMENT
D828- F0 2D 2260 BEQ RTS.3 END OF LINE, NULL STATEMENT
2270 EXECUTE.STATEMENT.1
D82A- E9 80 2280 SBC #$80 FIRST CHAR A TOKEN?
D82C- 90 11 2290 BCC .1 NOT TOKEN, MUST BE "LET"
D82E- C9 40 2300 CMP #$40 STATEMENT-TYPE TOKEN?
D830- B0 14 2310 BCS SYNERR.1 NO, SYNTAX ERROR
D832- 0A 2320 ASL DOUBLE TO GET INDEX
D833- A8 2330 TAY INTO ADDRESS TABLE
D834- B9 01 D0 2340 LDA TOKEN.ADDRESS.TABLE+1,Y
D837- 48 2350 PHA PUT ADDRESS ON STACK
D838- B9 00 D0 2360 LDA TOKEN.ADDRESS.TABLE,Y
D83B- 48 2370 PHA
D83C- 4C B1 00 2380 JMP CHRGET GET NEXT CHR & RTS TO ROUTINE
2390 *--------------------------------
D83F- 4C 46 DA 2400 .1 JMP LET MUST BE <VAR> = <EXP>
2410 *--------------------------------
D842- C9 3A 2420 COLON. CMP #':'
D844- F0 BF 2430 BEQ TRACE.
D846- 4C C9 DE 2440 SYNERR.1 JMP SYNERR
2450 *--------------------------------
2460 * "RESTORE" STATEMENT
2470 *--------------------------------
2480 RESTORE
D849- 38 2490 SEC SET DATPTR TO BEGINNING OF PROGRAM
D84A- A5 67 2500 LDA TXTTAB
D84C- E9 01 2510 SBC #1
D84E- A4 68 2520 LDY TXTTAB+1
D850- B0 01 2530 BCS SETDA
D852- 88 2540 DEY
2550 *---SET DATPTR TO Y,A------------
D853- 85 7D 2560 SETDA STA DATPTR
D855- 84 7E 2570 STY DATPTR+1
D857- 60 2580 RTS.3 RTS
2590 *--------------------------------
2600 * SEE IF CONTROL-C TYPED
2610 *--------------------------------
D858- AD 00 C0 2620 ISCNTC LDA KEYBOARD
D85B- C9 83 2630 CMP #$83
D85D- F0 01 2640 BEQ .1
D85F- 60 2650 RTS
D860- 20 53 D5 2660 .1 JSR INCHR <<< SHOULD BE "BIT $C010" >>>
2670 CONTROL.C.TYPED
D863- A2 FF 2680 LDX #$FF CONTROL C ATTEMPTED
D865- 24 D8 2690 BIT ERRFLG "ON ERR" ENABLED?
D867- 10 03 2700 BPL .2 NO
D869- 4C E9 F2 2710 JMP HANDLERR YES, RETURN ERR CODE = 255
D86C- C9 03 2720 .2 CMP #3 SINCE IT IS CTRL-C, SET Z AND C BITS
2730 *--------------------------------
2740 * "STOP" STATEMENT
2750 *--------------------------------
D86E- B0 01 2760 STOP BCS END2 CARRY=1 TO FORCE PRINTING "BREAK AT.."
2770 *--------------------------------
2780 * "END" STATEMENT
2790 *--------------------------------
D870- 18 2800 END CLC CARRY=0 TO AVOID PRINTING MESSAGE
D871- D0 3C 2810 END2 BNE RTS.4 IF NOT END OF STATEMENT, DO NOTHING
D873- A5 B8 2820 LDA TXTPTR
D875- A4 B9 2830 LDY TXTPTR+1
D877- A6 76 2840 LDX CURLIN+1
D879- E8 2850 INX RUNNING?
D87A- F0 0C 2860 BEQ .1 NO, DIRECT MODE
D87C- 85 79 2870 STA OLDTEXT
D87E- 84 7A 2880 STY OLDTEXT+1
D880- A5 75 2890 LDA CURLIN
D882- A4 76 2900 LDY CURLIN+1
D884- 85 77 2910 STA OLDLIN
D886- 84 78 2920 STY OLDLIN+1
D888- 68 2930 .1 PLA
D889- 68 2940 PLA
D88A- A9 5D 2950 END4 LDA #QT.BREAK " BREAK" AND BELL
D88C- A0 D3 2960 LDY /QT.BREAK
D88E- 90 03 2970 BCC .1
D890- 4C 31 D4 2980 JMP PRINT.ERROR.LINNUM
D893- 4C 3C D4 2990 .1 JMP RESTART
3000 *--------------------------------
3010 * "CONT" COMMAND
3020 *--------------------------------
D896- D0 17 3030 CONT BNE RTS.4 IF NOT END OF STATEMENT, DO NOTHING
D898- A2 D2 3040 LDX #ERR.CANTCONT
D89A- A4 7A 3050 LDY OLDTEXT+1 MEANINGFUL RE-ENTRY?
D89C- D0 03 3060 BNE .1 YES
D89E- 4C 12 D4 3070 JMP ERROR NO
D8A1- A5 79 3080 .1 LDA OLDTEXT RESTORE TXTPTR
D8A3- 85 B8 3090 STA TXTPTR
D8A5- 84 B9 3100 STY TXTPTR+1
D8A7- A5 77 3110 LDA OLDLIN RESTORE LINE NUMBER
D8A9- A4 78 3120 LDY OLDLIN+1
D8AB- 85 75 3130 STA CURLIN
D8AD- 84 76 3140 STY CURLIN+1
D8AF- 60 3150 RTS.4 RTS
3160 *--------------------------------
3170 * "SAVE" COMMAND
3180 * WRITES PROGRAM ON CASSETTE TAPE
3190 *--------------------------------
D8B0- 38 3200 SAVE SEC
D8B1- A5 AF 3210 LDA PRGEND COMPUTE PROGRAM LENGTH
D8B3- E5 67 3220 SBC TXTTAB
D8B5- 85 50 3230 STA LINNUM
D8B7- A5 B0 3240 LDA PRGEND+1
D8B9- E5 68 3250 SBC TXTTAB+1
D8BB- 85 51 3260 STA LINNUM+1
D8BD- 20 F0 D8 3270 JSR VARTIO SET UP TO WRITE 3 BYTE HEADER
D8C0- 20 CD FE 3280 JSR MON.WRITE WRITE 'EM
D8C3- 20 01 D9 3290 JSR PROGIO SET UP TO WRITE THE PROGRAM
D8C6- 4C CD FE 3300 JMP MON.WRITE WRITE IT
3310 *--------------------------------
3320 * "LOAD" COMMAND
3330 * READS A PROGRAM FROM CASSETTE TAPE
3340 *--------------------------------
D8C9- 20 F0 D8 3350 LOAD JSR VARTIO SET UP TO READ 3 BYTE HEADER
D8CC- 20 FD FE 3360 JSR MON.READ READ LENGTH, LOCK BYTE
D8CF- 18 3370 CLC
D8D0- A5 67 3380 LDA TXTTAB COMPUTE END ADDRESS
D8D2- 65 50 3390 ADC LINNUM
D8D4- 85 69 3400 STA VARTAB
D8D6- A5 68 3410 LDA TXTTAB+1
D8D8- 65 51 3420 ADC LINNUM+1
D8DA- 85 6A 3430 STA VARTAB+1
D8DC- A5 52 3440 LDA TEMPPT LOCK BYTE
D8DE- 85 D6 3450 STA LOCK
D8E0- 20 01 D9 3460 JSR PROGIO SET UP TO READ PROGRAM
D8E3- 20 FD FE 3470 JSR MON.READ READ IT
D8E6- 24 D6 3480 BIT LOCK IF LOCKED, START RUNNING NOW
D8E8- 10 03 3490 BPL .1 NOT LOCKED
D8EA- 4C 65 D6 3500 JMP SETPTRS LOCKED, START RUNNING
D8ED- 4C F2 D4 3510 .1 JMP FIX.LINKS JUST FIX FORWARD POINTERS
3520 *--------------------------------
D8F0- A9 50 3530 VARTIO LDA #LINNUM SET UP TO READ/WRITE 3 BYTE HEADER
D8F2- A0 00 3540 LDY #0
D8F4- 85 3C 3550 STA MON.A1L
D8F6- 84 3D 3560 STY MON.A1H
D8F8- A9 52 3570 LDA #TEMPPT
D8FA- 85 3E 3580 STA MON.A2L
D8FC- 84 3F 3590 STY MON.A2H
D8FE- 84 D6 3600 STY LOCK
D900- 60 3610 RTS
3620 *--------------------------------
D901- A5 67 3630 PROGIO LDA TXTTAB SET UP TO READ/WRITE PROGRAM
D903- A4 68 3640 LDY TXTTAB+1
D905- 85 3C 3650 STA MON.A1L
D907- 84 3D 3660 STY MON.A1H
D909- A5 69 3670 LDA VARTAB
D90B- A4 6A 3680 LDY VARTAB+1
D90D- 85 3E 3690 STA MON.A2L
D90F- 84 3F 3700 STY MON.A2H
D911- 60 3710 RTS
3720 *--------------------------------
S.D52C