S-C DocuMentor — Applesoft
SAVE S.D365
1010 *--------------------------------
1020 * CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH
1030 * THE STACK FOR A FRAME WITH THE SAME VARIABLE.
1040 *
1050 * (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT"
1060 * = $XXFF IF CALLED FROM "RETURN"
1070 * <<< BUG: SHOULD BE $FFXX >>>
1080 *
1090 * RETURNS .NE. IF VARIABLE NOT FOUND,
1100 * (X) = STACK PNTR AFTER SKIPPING ALL FRAMES
1110 *
1120 * .EQ. IF FOUND
1130 * (X) = STACK PNTR OF FRAME FOUND
1140 *--------------------------------
1150 GTFORPNT
D365- BA 1160 TSX
D366- E8 1170 INX
D367- E8 1180 INX
D368- E8 1190 INX
D369- E8 1200 INX
D36A- BD 01 01 1210 .1 LDA STACK+1,X "FOR" FRAME HERE?
D36D- C9 81 1220 CMP #TOKEN.FOR
D36F- D0 21 1230 BNE .4 NO
D371- A5 86 1240 LDA FORPNT+1 YES -- "NEXT" WITH NO VARIABLE?
D373- D0 0A 1250 BNE .2 NO, VARIABLE SPECIFIED
D375- BD 02 01 1260 LDA STACK+2,X YES, SO USE THIS FRAME
D378- 85 85 1270 STA FORPNT
D37A- BD 03 01 1280 LDA STACK+3,X
D37D- 85 86 1290 STA FORPNT+1
D37F- DD 03 01 1300 .2 CMP STACK+3,X IS VARIABLE IN THIS FRAME?
D382- D0 07 1310 BNE .3 NO
D384- A5 85 1320 LDA FORPNT LOOK AT 2ND BYTE TOO
D386- DD 02 01 1330 CMP STACK+2,X SAME VARIABLE?
D389- F0 07 1340 BEQ .4 YES
D38B- 8A 1350 .3 TXA NO, SO TRY NEXT FRAME (IF ANY)
D38C- 18 1360 CLC 18 BYTES PER FRAME
D38D- 69 12 1370 ADC #18
D38F- AA 1380 TAX
D390- D0 D8 1390 BNE .1 ...ALWAYS?
D392- 60 1400 .4 RTS
1410 *--------------------------------
1420 * MOVE BLOCK OF MEMORY UP
1430 *
1440 * ON ENTRY:
1450 * (Y,A) = (HIGHDS) = DESTINATION END+1
1460 * (LOWTR) = LOWEST ADDRESS OF SOURCE
1470 * (HIGHTR) = HIGHEST SOURCE ADDRESS+1
1480 *--------------------------------
D393- 20 E3 D3 1490 BLTU JSR REASON BE SURE (Y,A) < FRETOP
D396- 85 6D 1500 STA STREND NEW TOP OF ARRAY STORAGE
D398- 84 6E 1510 STY STREND+1
D39A- 38 1520 BLTU2 SEC
D39B- A5 96 1530 LDA HIGHTR COMPUTE # OF BYTES TO BE MOVED
D39D- E5 9B 1540 SBC LOWTR (FROM LOWTR THRU HIGHTR-1)
D39F- 85 5E 1550 STA INDEX PARTIAL PAGE AMOUNT
D3A1- A8 1560 TAY
D3A2- A5 97 1570 LDA HIGHTR+1
D3A4- E5 9C 1580 SBC LOWTR+1
D3A6- AA 1590 TAX # OF WHOLE PAGES IN X-REG
D3A7- E8 1600 INX
D3A8- 98 1610 TYA # BYTES IN PARTIAL PAGE
D3A9- F0 23 1620 BEQ .4 NO PARTIAL PAGE
D3AB- A5 96 1630 LDA HIGHTR BACK UP HIGHTR # BYTES IN PARTIAL PAGE
D3AD- 38 1640 SEC
D3AE- E5 5E 1650 SBC INDEX
D3B0- 85 96 1660 STA HIGHTR
D3B2- B0 03 1670 BCS .1
D3B4- C6 97 1680 DEC HIGHTR+1
D3B6- 38 1690 SEC
D3B7- A5 94 1700 .1 LDA HIGHDS BACK UP HIGHDS # BYTES IN PARTIAL PAGE
D3B9- E5 5E 1710 SBC INDEX
D3BB- 85 94 1720 STA HIGHDS
D3BD- B0 08 1730 BCS .3
D3BF- C6 95 1740 DEC HIGHDS+1
D3C1- 90 04 1750 BCC .3 ...ALWAYS
D3C3- B1 96 1760 .2 LDA (HIGHTR),Y MOVE THE BYTES
D3C5- 91 94 1770 STA (HIGHDS),Y
D3C7- 88 1780 .3 DEY
D3C8- D0 F9 1790 BNE .2 LOOP TO END OF THIS 256 BYTES
D3CA- B1 96 1800 LDA (HIGHTR),Y MOVE ONE MORE BYTE
D3CC- 91 94 1810 STA (HIGHDS),Y
D3CE- C6 97 1820 .4 DEC HIGHTR+1 DOWN TO NEXT BLOCK OF 256
D3D0- C6 95 1830 DEC HIGHDS+1
D3D2- CA 1840 DEX ANOTHER BLOCK OF 256 TO MOVE?
D3D3- D0 F2 1850 BNE .3 YES
D3D5- 60 1860 RTS NO, FINISHED
1870 *--------------------------------
1880 * CHECK IF ENOUGH ROOM LEFT ON STACK
1890 * FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION
1900 *--------------------------------
D3D6- 0A 1910 CHKMEM ASL
D3D7- 69 36 1920 ADC #54
D3D9- B0 35 1930 BCS MEMERR ...MEM FULL ERR
D3DB- 85 5E 1940 STA INDEX
D3DD- BA 1950 TSX
D3DE- E4 5E 1960 CPX INDEX
D3E0- 90 2E 1970 BCC MEMERR ...MEM FULL ERR
D3E2- 60 1980 RTS
1990 *--------------------------------
2000 * CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS
2010 * (Y,A) = ADDR ARRAYS NEED TO GROW TO
2020 *--------------------------------
D3E3- C4 70 2030 REASON CPY FRETOP+1 HIGH BYTE
D3E5- 90 28 2040 BCC .4 PLENTY OF ROOM
D3E7- D0 04 2050 BNE .1 NOT ENOUGH, TRY GARBAGE COLLECTION
D3E9- C5 6F 2060 CMP FRETOP LOW BYTE
D3EB- 90 22 2070 BCC .4 ENOUGH ROOM
2080 *--------------------------------
D3ED- 48 2090 .1 PHA SAVE (Y,A), TEMP1, AND TEMP2
D3EE- A2 09 2100 LDX #FAC-TEMP1-1
D3F0- 98 2110 TYA
D3F1- 48 2120 .2 PHA
D3F2- B5 93 2130 LDA TEMP1,X
D3F4- CA 2140 DEX
D3F5- 10 FA 2150 BPL .2
D3F7- 20 84 E4 2160 JSR GARBAG MAKE AS MUCH ROOM AS POSSIBLE
D3FA- A2 F7 2170 LDX #TEMP1-FAC+1 RESTORE TEMP1 AND TEMP2
D3FC- 68 2180 .3 PLA AND (Y,A)
D3FD- 95 9D 2190 STA FAC,X
D3FF- E8 2200 INX
D400- 30 FA 2210 BMI .3
D402- 68 2220 PLA
D403- A8 2230 TAY
D404- 68 2240 PLA DID WE FIND ENOUGH ROOM?
D405- C4 70 2250 CPY FRETOP+1 HIGH BYTE
D407- 90 06 2260 BCC .4 YES, AT LEAST A PAGE
D409- D0 05 2270 BNE MEMERR NO, MEM FULL ERR
D40B- C5 6F 2280 CMP FRETOP LOW BYTE
D40D- B0 01 2290 BCS MEMERR NO, MEM FULL ERR
D40F- 60 2300 .4 RTS YES, RETURN
2310 *--------------------------------
D410- A2 4D 2320 MEMERR LDX #ERR.MEMFULL
2330 *--------------------------------
2340 * HANDLE AN ERROR
2350 *
2360 * (X)=OFFSET IN ERROR MESSAGE TABLE
2370 * (ERRFLG) > 128 IF "ON ERR" TURNED ON
2380 * (CURLIN+1) = $FF IF IN DIRECT MODE
2390 *--------------------------------
D412- 24 D8 2400 ERROR BIT ERRFLG "ON ERR" TURNED ON?
D414- 10 03 2410 BPL .1 NO
D416- 4C E9 F2 2420 JMP HANDLERR YES
D419- 20 FB DA 2430 .1 JSR CRDO PRINT <RETURN>
D41C- 20 5A DB 2440 JSR OUTQUES PRINT "?"
D41F- BD 60 D2 2450 .2 LDA ERROR.MESSAGES,X
D422- 48 2460 PHA PRINT MESSAGE
D423- 20 5C DB 2470 JSR OUTDO
D426- E8 2480 INX
D427- 68 2490 PLA
D428- 10 F5 2500 BPL .2
D42A- 20 83 D6 2510 JSR STKINI FIX STACK, ET AL
D42D- A9 50 2520 LDA #QT.ERROR PRINT " ERROR" AND BELL
D42F- A0 D3 2530 LDY /QT.ERROR
2540 *--------------------------------
2550 * PRINT STRING AT (Y,A)
2560 * PRINT CURRENT LINE # UNLESS IN DIRECT MODE
2570 * FALL INTO WARM RESTART
2580 *--------------------------------
2590 PRINT.ERROR.LINNUM
D431- 20 3A DB 2600 JSR STROUT PRINT STRING AT (Y,A)
D434- A4 76 2610 LDY CURLIN+1 RUNNING, OR DIRECT?
D436- C8 2620 INY
D437- F0 03 2630 BEQ RESTART WAS $FF, SO DIRECT MODE
D439- 20 19 ED 2640 JSR INPRT RUNNING, SO PRINT LINE NUMBER
2650 *--------------------------------
2660 * WARM RESTART ENTRY
2670 *
2680 * COME HERE FROM MONITOR BY CTL-C, 0G, 3D0G, OR E003G
2690 *--------------------------------
2700 RESTART
D43C- 20 FB DA 2710 JSR CRDO PRINT <RETURN>
D43F- A2 DD 2720 LDX #']+$80 PROMPT CHARACTER
D441- 20 2E D5 2730 JSR INLIN2 READ A LINE
D444- 86 B8 2740 STX TXTPTR SET UP CHRGET TO SCAN THE LINE
D446- 84 B9 2750 STY TXTPTR+1
D448- 46 D8 2760 LSR ERRFLG CLEAR FLAG
D44A- 20 B1 00 2770 JSR CHRGET
D44D- AA 2780 TAX
D44E- F0 EC 2790 BEQ RESTART EMPTY LINE
D450- A2 FF 2800 LDX #$FF $FF IN HI-BYTE OF CURLIN MEANS
D452- 86 76 2810 STX CURLIN+1 WE ARE IN DIRECT MODE
D454- 90 06 2820 BCC NUMBERED.LINE CHRGET SAW DIGIT, NUMBERED LINE
D456- 20 59 D5 2830 JSR PARSE.INPUT.LINE NO NUMBER, SO PARSE IT
D459- 4C 05 D8 2840 JMP TRACE. AND TRY EXECUTING IT
2850 *--------------------------------
2860 * HANDLE NUMBERED LINE
2870 *--------------------------------
2880 NUMBERED.LINE
D45C- A6 AF 2890 LDX PRGEND SQUASH VARIABLE TABLE
D45E- 86 69 2900 STX VARTAB
D460- A6 B0 2910 LDX PRGEND+1
D462- 86 6A 2920 STX VARTAB+1
D464- 20 0C DA 2930 JSR LINGET GET LINE #
D467- 20 59 D5 2940 JSR PARSE.INPUT.LINE AND PARSE THE INPUT LINE
D46A- 84 0F 2950 STY EOL.PNTR SAVE INDEX TO INPUT BUFFER
D46C- 20 1A D6 2960 JSR FNDLIN IS THIS LINE # ALREADY IN PROGRAM?
D46F- 90 44 2970 BCC PUT.NEW.LINE NO
D471- A0 01 2980 LDY #1 YES, SO DELETE IT
D473- B1 9B 2990 LDA (LOWTR),Y LOWTR POINTS AT LINE
D475- 85 5F 3000 STA INDEX+1 GET HIGH BYTE OF FORWARD PNTR
D477- A5 69 3010 LDA VARTAB
D479- 85 5E 3020 STA INDEX
D47B- A5 9C 3030 LDA LOWTR+1
D47D- 85 61 3040 STA DEST+1
D47F- A5 9B 3050 LDA LOWTR
D481- 88 3060 DEY
D482- F1 9B 3070 SBC (LOWTR),Y
D484- 18 3080 CLC
D485- 65 69 3090 ADC VARTAB
D487- 85 69 3100 STA VARTAB
D489- 85 60 3110 STA DEST
D48B- A5 6A 3120 LDA VARTAB+1
D48D- 69 FF 3130 ADC #$FF
D48F- 85 6A 3140 STA VARTAB+1
D491- E5 9C 3150 SBC LOWTR+1
D493- AA 3160 TAX
D494- 38 3170 SEC
D495- A5 9B 3180 LDA LOWTR
D497- E5 69 3190 SBC VARTAB
D499- A8 3200 TAY
D49A- B0 03 3210 BCS .1
D49C- E8 3220 INX
D49D- C6 61 3230 DEC DEST+1
D49F- 18 3240 .1 CLC
D4A0- 65 5E 3250 ADC INDEX
D4A2- 90 03 3260 BCC .2
D4A4- C6 5F 3270 DEC INDEX+1
D4A6- 18 3280 CLC
3290 *--------------------------------
D4A7- B1 5E 3300 .2 LDA (INDEX),Y MOVE HIGHER LINES OF PROGRAM
D4A9- 91 60 3310 STA (DEST),Y DOWN OVER THE DELETED LINE.
D4AB- C8 3320 INY
D4AC- D0 F9 3330 BNE .2
D4AE- E6 5F 3340 INC INDEX+1
D4B0- E6 61 3350 INC DEST+1
D4B2- CA 3360 DEX
D4B3- D0 F2 3370 BNE .2
3380 *--------------------------------
3390 PUT.NEW.LINE
D4B5- AD 00 02 3400 LDA INPUT.BUFFER ANY CHARACTERS AFTER LINE #?
D4B8- F0 38 3410 BEQ FIX.LINKS NO, SO NOTHING TO INSERT.
D4BA- A5 73 3420 LDA MEMSIZ YES, SO MAKE ROOM AND INSERT LINE
D4BC- A4 74 3430 LDY MEMSIZ+1 WIPE STRING AREA CLEAN
D4BE- 85 6F 3440 STA FRETOP
D4C0- 84 70 3450 STY FRETOP+1
D4C2- A5 69 3460 LDA VARTAB SET UP BLTU SUBROUTINE
D4C4- 85 96 3470 STA HIGHTR INSERT NEW LINE.
D4C6- 65 0F 3480 ADC EOL.PNTR
D4C8- 85 94 3490 STA HIGHDS
D4CA- A4 6A 3500 LDY VARTAB+1
D4CC- 84 97 3510 STY HIGHTR+1
D4CE- 90 01 3520 BCC .1
D4D0- C8 3530 INY
D4D1- 84 95 3540 .1 STY HIGHDS+1
D4D3- 20 93 D3 3550 JSR BLTU MAKE ROOM FOR THE LINE
D4D6- A5 50 3560 LDA LINNUM PUT LINE NUMBER IN LINE IMAGE
D4D8- A4 51 3570 LDY LINNUM+1
D4DA- 8D FE 01 3580 STA INPUT.BUFFER-2
D4DD- 8C FF 01 3590 STY INPUT.BUFFER-1
D4E0- A5 6D 3600 LDA STREND
D4E2- A4 6E 3610 LDY STREND+1
D4E4- 85 69 3620 STA VARTAB
D4E6- 84 6A 3630 STY VARTAB+1
D4E8- A4 0F 3640 LDY EOL.PNTR
3650 *---COPY LINE INTO PROGRAM-------
D4EA- B9 FB 01 3660 .2 LDA INPUT.BUFFER-5,Y
D4ED- 88 3670 DEY
D4EE- 91 9B 3680 STA (LOWTR),Y
D4F0- D0 F8 3690 BNE .2
3700 *--------------------------------
3710 * CLEAR ALL VARIABLES
3720 * RE-ESTABLISH ALL FORWARD LINKS
3730 *--------------------------------
3740 FIX.LINKS
D4F2- 20 65 D6 3750 JSR SETPTRS CLEAR ALL VARIABLES
D4F5- A5 67 3760 LDA TXTTAB POINT INDEX AT START OF PROGRAM
D4F7- A4 68 3770 LDY TXTTAB+1
D4F9- 85 5E 3780 STA INDEX
D4FB- 84 5F 3790 STY INDEX+1
D4FD- 18 3800 CLC
D4FE- A0 01 3810 .1 LDY #1 HI-BYTE OF NEXT FORWARD PNTR
D500- B1 5E 3820 LDA (INDEX),Y END OF PROGRAM YET?
D502- D0 0B 3830 BNE .2 NO, KEEP GOING
D504- A5 69 3840 LDA VARTAB YES
D506- 85 AF 3850 STA PRGEND
D508- A5 6A 3860 LDA VARTAB+1
D50A- 85 B0 3870 STA PRGEND+1
D50C- 4C 3C D4 3880 JMP RESTART
D50F- A0 04 3890 .2 LDY #4 FIND END OF THIS LINE
D511- C8 3900 .3 INY (NOTE MAXIMUM LENGTH < 256)
D512- B1 5E 3910 LDA (INDEX),Y
D514- D0 FB 3920 BNE .3
D516- C8 3930 INY COMPUTE ADDRESS OF NEXT LINE
D517- 98 3940 TYA
D518- 65 5E 3950 ADC INDEX
D51A- AA 3960 TAX
D51B- A0 00 3970 LDY #0 STORE FORWARD PNTR IN THIS LINE
D51D- 91 5E 3980 STA (INDEX),Y
D51F- A5 5F 3990 LDA INDEX+1
D521- 69 00 4000 ADC #0 (NOTE: THIS CLEARS CARRY)
D523- C8 4010 INY
D524- 91 5E 4020 STA (INDEX),Y
D526- 86 5E 4030 STX INDEX
D528- 85 5F 4040 STA INDEX+1
D52A- 90 D2 4050 BCC .1 ...ALWAYS
4060 *--------------------------------
S.D260