goapple2/source/applesoft/S.D365
2014-05-09 17:59:16 -07:00

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 *--------------------------------