307 lines
10 KiB
Plaintext
307 lines
10 KiB
Plaintext
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 <RETURN>
|
|
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 <RETURN>
|
|
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 *--------------------------------
|