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 1160 TSX 1170 INX 1180 INX 1190 INX 1200 INX 1210 .1 LDA STACK+1,X "FOR" FRAME HERE? 1220 CMP #TOKEN.FOR 1230 BNE .4 NO 1240 LDA FORPNT+1 YES -- "NEXT" WITH NO VARIABLE? 1250 BNE .2 NO, VARIABLE SPECIFIED 1260 LDA STACK+2,X YES, SO USE THIS FRAME 1270 STA FORPNT 1280 LDA STACK+3,X 1290 STA FORPNT+1 1300 .2 CMP STACK+3,X IS VARIABLE IN THIS FRAME? 1310 BNE .3 NO 1320 LDA FORPNT LOOK AT 2ND BYTE TOO 1330 CMP STACK+2,X SAME VARIABLE? 1340 BEQ .4 YES 1350 .3 TXA NO, SO TRY NEXT FRAME (IF ANY) 1360 CLC 18 BYTES PER FRAME 1370 ADC #18 1380 TAX 1390 BNE .1 ...ALWAYS? 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 *-------------------------------- 1490 BLTU JSR REASON BE SURE (Y,A) < FRETOP 1500 STA STREND NEW TOP OF ARRAY STORAGE 1510 STY STREND+1 1520 BLTU2 SEC 1530 LDA HIGHTR COMPUTE # OF BYTES TO BE MOVED 1540 SBC LOWTR (FROM LOWTR THRU HIGHTR-1) 1550 STA INDEX PARTIAL PAGE AMOUNT 1560 TAY 1570 LDA HIGHTR+1 1580 SBC LOWTR+1 1590 TAX # OF WHOLE PAGES IN X-REG 1600 INX 1610 TYA # BYTES IN PARTIAL PAGE 1620 BEQ .4 NO PARTIAL PAGE 1630 LDA HIGHTR BACK UP HIGHTR # BYTES IN PARTIAL PAGE 1640 SEC 1650 SBC INDEX 1660 STA HIGHTR 1670 BCS .1 1680 DEC HIGHTR+1 1690 SEC 1700 .1 LDA HIGHDS BACK UP HIGHDS # BYTES IN PARTIAL PAGE 1710 SBC INDEX 1720 STA HIGHDS 1730 BCS .3 1740 DEC HIGHDS+1 1750 BCC .3 ...ALWAYS 1760 .2 LDA (HIGHTR),Y MOVE THE BYTES 1770 STA (HIGHDS),Y 1780 .3 DEY 1790 BNE .2 LOOP TO END OF THIS 256 BYTES 1800 LDA (HIGHTR),Y MOVE ONE MORE BYTE 1810 STA (HIGHDS),Y 1820 .4 DEC HIGHTR+1 DOWN TO NEXT BLOCK OF 256 1830 DEC HIGHDS+1 1840 DEX ANOTHER BLOCK OF 256 TO MOVE? 1850 BNE .3 YES 1860 RTS NO, FINISHED 1870 *-------------------------------- 1880 * CHECK IF ENOUGH ROOM LEFT ON STACK 1890 * FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION 1900 *-------------------------------- 1910 CHKMEM ASL 1920 ADC #54 1930 BCS MEMERR ...MEM FULL ERR 1940 STA INDEX 1950 TSX 1960 CPX INDEX 1970 BCC MEMERR ...MEM FULL ERR 1980 RTS 1990 *-------------------------------- 2000 * CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS 2010 * (Y,A) = ADDR ARRAYS NEED TO GROW TO 2020 *-------------------------------- 2030 REASON CPY FRETOP+1 HIGH BYTE 2040 BCC .4 PLENTY OF ROOM 2050 BNE .1 NOT ENOUGH, TRY GARBAGE COLLECTION 2060 CMP FRETOP LOW BYTE 2070 BCC .4 ENOUGH ROOM 2080 *-------------------------------- 2090 .1 PHA SAVE (Y,A), TEMP1, AND TEMP2 2100 LDX #FAC-TEMP1-1 2110 TYA 2120 .2 PHA 2130 LDA TEMP1,X 2140 DEX 2150 BPL .2 2160 JSR GARBAG MAKE AS MUCH ROOM AS POSSIBLE 2170 LDX #TEMP1-FAC+1 RESTORE TEMP1 AND TEMP2 2180 .3 PLA AND (Y,A) 2190 STA FAC,X 2200 INX 2210 BMI .3 2220 PLA 2230 TAY 2240 PLA DID WE FIND ENOUGH ROOM? 2250 CPY FRETOP+1 HIGH BYTE 2260 BCC .4 YES, AT LEAST A PAGE 2270 BNE MEMERR NO, MEM FULL ERR 2280 CMP FRETOP LOW BYTE 2290 BCS MEMERR NO, MEM FULL ERR 2300 .4 RTS YES, RETURN 2310 *-------------------------------- 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 *-------------------------------- 2400 ERROR BIT ERRFLG "ON ERR" TURNED ON? 2410 BPL .1 NO 2420 JMP HANDLERR YES 2430 .1 JSR CRDO PRINT 2440 JSR OUTQUES PRINT "?" 2450 .2 LDA ERROR.MESSAGES,X 2460 PHA PRINT MESSAGE 2470 JSR OUTDO 2480 INX 2490 PLA 2500 BPL .2 2510 JSR STKINI FIX STACK, ET AL 2520 LDA #QT.ERROR PRINT " ERROR" AND BELL 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 2600 JSR STROUT PRINT STRING AT (Y,A) 2610 LDY CURLIN+1 RUNNING, OR DIRECT? 2620 INY 2630 BEQ RESTART WAS $FF, SO DIRECT MODE 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 2710 JSR CRDO PRINT 2720 LDX #']+$80 PROMPT CHARACTER 2730 JSR INLIN2 READ A LINE 2740 STX TXTPTR SET UP CHRGET TO SCAN THE LINE 2750 STY TXTPTR+1 2760 LSR ERRFLG CLEAR FLAG 2770 JSR CHRGET 2780 TAX 2790 BEQ RESTART EMPTY LINE 2800 LDX #$FF $FF IN HI-BYTE OF CURLIN MEANS 2810 STX CURLIN+1 WE ARE IN DIRECT MODE 2820 BCC NUMBERED.LINE CHRGET SAW DIGIT, NUMBERED LINE 2830 JSR PARSE.INPUT.LINE NO NUMBER, SO PARSE IT 2840 JMP TRACE. AND TRY EXECUTING IT 2850 *-------------------------------- 2860 * HANDLE NUMBERED LINE 2870 *-------------------------------- 2880 NUMBERED.LINE 2890 LDX PRGEND SQUASH VARIABLE TABLE 2900 STX VARTAB 2910 LDX PRGEND+1 2920 STX VARTAB+1 2930 JSR LINGET GET LINE # 2940 JSR PARSE.INPUT.LINE AND PARSE THE INPUT LINE 2950 STY EOL.PNTR SAVE INDEX TO INPUT BUFFER 2960 JSR FNDLIN IS THIS LINE # ALREADY IN PROGRAM? 2970 BCC PUT.NEW.LINE NO 2980 LDY #1 YES, SO DELETE IT 2990 LDA (LOWTR),Y LOWTR POINTS AT LINE 3000 STA INDEX+1 GET HIGH BYTE OF FORWARD PNTR 3010 LDA VARTAB 3020 STA INDEX 3030 LDA LOWTR+1 3040 STA DEST+1 3050 LDA LOWTR 3060 DEY 3070 SBC (LOWTR),Y 3080 CLC 3090 ADC VARTAB 3100 STA VARTAB 3110 STA DEST 3120 LDA VARTAB+1 3130 ADC #$FF 3140 STA VARTAB+1 3150 SBC LOWTR+1 3160 TAX 3170 SEC 3180 LDA LOWTR 3190 SBC VARTAB 3200 TAY 3210 BCS .1 3220 INX 3230 DEC DEST+1 3240 .1 CLC 3250 ADC INDEX 3260 BCC .2 3270 DEC INDEX+1 3280 CLC 3290 *-------------------------------- 3300 .2 LDA (INDEX),Y MOVE HIGHER LINES OF PROGRAM 3310 STA (DEST),Y DOWN OVER THE DELETED LINE. 3320 INY 3330 BNE .2 3340 INC INDEX+1 3350 INC DEST+1 3360 DEX 3370 BNE .2 3380 *-------------------------------- 3390 PUT.NEW.LINE 3400 LDA INPUT.BUFFER ANY CHARACTERS AFTER LINE #? 3410 BEQ FIX.LINKS NO, SO NOTHING TO INSERT. 3420 LDA MEMSIZ YES, SO MAKE ROOM AND INSERT LINE 3430 LDY MEMSIZ+1 WIPE STRING AREA CLEAN 3440 STA FRETOP 3450 STY FRETOP+1 3460 LDA VARTAB SET UP BLTU SUBROUTINE 3470 STA HIGHTR INSERT NEW LINE. 3480 ADC EOL.PNTR 3490 STA HIGHDS 3500 LDY VARTAB+1 3510 STY HIGHTR+1 3520 BCC .1 3530 INY 3540 .1 STY HIGHDS+1 3550 JSR BLTU MAKE ROOM FOR THE LINE 3560 LDA LINNUM PUT LINE NUMBER IN LINE IMAGE 3570 LDY LINNUM+1 3580 STA INPUT.BUFFER-2 3590 STY INPUT.BUFFER-1 3600 LDA STREND 3610 LDY STREND+1 3620 STA VARTAB 3630 STY VARTAB+1 3640 LDY EOL.PNTR 3650 *---COPY LINE INTO PROGRAM------- 3660 .2 LDA INPUT.BUFFER-5,Y 3670 DEY 3680 STA (LOWTR),Y 3690 BNE .2 3700 *-------------------------------- 3710 * CLEAR ALL VARIABLES 3720 * RE-ESTABLISH ALL FORWARD LINKS 3730 *-------------------------------- 3740 FIX.LINKS 3750 JSR SETPTRS CLEAR ALL VARIABLES 3760 LDA TXTTAB POINT INDEX AT START OF PROGRAM 3770 LDY TXTTAB+1 3780 STA INDEX 3790 STY INDEX+1 3800 CLC 3810 .1 LDY #1 HI-BYTE OF NEXT FORWARD PNTR 3820 LDA (INDEX),Y END OF PROGRAM YET? 3830 BNE .2 NO, KEEP GOING 3840 LDA VARTAB YES 3850 STA PRGEND 3860 LDA VARTAB+1 3870 STA PRGEND+1 3880 JMP RESTART 3890 .2 LDY #4 FIND END OF THIS LINE 3900 .3 INY (NOTE MAXIMUM LENGTH < 256) 3910 LDA (INDEX),Y 3920 BNE .3 3930 INY COMPUTE ADDRESS OF NEXT LINE 3940 TYA 3950 ADC INDEX 3960 TAX 3970 LDY #0 STORE FORWARD PNTR IN THIS LINE 3980 STA (INDEX),Y 3990 LDA INDEX+1 4000 ADC #0 (NOTE: THIS CLEARS CARRY) 4010 INY 4020 STA (INDEX),Y 4030 STX INDEX 4040 STA INDEX+1 4050 BCC .1 ...ALWAYS 4060 *--------------------------------