1010 *-------------------------------- 1020 * READ A LINE, AND STRIP OFF SIGN BITS 1030 *-------------------------------- 1040 INLIN LDX #$80 NULL PROMPT 1050 INLIN2 STX MON.PROMPT 1060 JSR MON.GETLN 1070 CPX #239 MAXIMUM LINE LENGTH 1080 BCC .1 1090 LDX #239 TRUNCATE AT 239 CHARS 1100 .1 LDA #0 MARK END OF LINE WITH $00 BYTE 1110 STA INPUT.BUFFER,X 1120 TXA 1130 BEQ .3 NULL INPUT LINE 1140 .2 LDA INPUT.BUFFER-1,X DROP SIGN BITS 1150 AND #$7F 1160 STA INPUT.BUFFER-1,X 1170 DEX 1180 BNE .2 1190 .3 LDA #0 (Y,X) POINTS AT BUFFER-1 1200 LDX #INPUT.BUFFER-1 1210 LDY /INPUT.BUFFER-1 1220 RTS 1230 *-------------------------------- 1240 INCHR JSR MON.RDKEY *** OUGHT TO BE "BIT $C010" *** 1250 AND #$7F 1260 RTS 1270 *-------------------------------- 1280 * TOKENIZE THE INPUT LINE 1290 *-------------------------------- 1300 PARSE.INPUT.LINE 1310 LDX TXTPTR INDEX INTO UNPARSED LINE 1320 DEX PREPARE FOR INX AT "PARSE" 1330 LDY #4 INDEX TO PARSED OUTPUT LINE 1340 STY DATAFLG CLEAR SIGN-BIT OF DATAFLG 1350 BIT LOCK IS THIS PROGRAM LOCKED? 1360 BPL PARSE NO, GO AHEAD AND PARSE THE LINE 1370 PLA YES, IGNORE INPUT AND "RUN" 1380 PLA THE PROGRAM 1390 JSR SETPTRS CLEAR ALL VARIABLES 1400 JMP NEWSTT START RUNNING 1410 *-------------------------------- 1420 PARSE INX NEXT INPUT CHARACTER 1430 .1 LDA INPUT.BUFFER,X 1440 BIT DATAFLG IN A "DATA" STATEMENT? 1450 BVS .2 YES (DATAFLG = $49) 1460 CMP #' ' IGNORE BLANKS 1470 BEQ PARSE 1480 .2 STA ENDCHR 1490 CMP #'" START OF QUOTATION? 1500 BEQ .13 1510 BVS .9 BRANCH IF IN "DATA" STATEMENT 1520 CMP #'? SHORTHAND FOR "PRINT"? 1530 BNE .3 NO 1540 LDA #TOKEN.PRINT YES, REPLACE WITH "PRINT" TOKEN 1550 BNE .9 ...ALWAYS 1560 .3 CMP #'0 IS IT A DIGIT, COLON, OR SEMI-COLON? 1570 BCC .4 NO, PUNCTUATION !"#$%&'()*+,-./ 1580 CMP #';'+1 1590 BCC .9 YES, NOT A TOKEN 1600 *-------------------------------- 1610 * SEARCH TOKEN NAME TABLE FOR MATCH STARTING 1620 * WITH CURRENT CHAR FROM INPUT LINE 1630 *-------------------------------- 1640 .4 STY STRNG2 SAVE INDEX TO OUTPUT LINE 1650 LDA #TOKEN.NAME.TABLE-$100 1660 STA FAC MAKE PNTR FOR SEARCH 1670 LDA /TOKEN.NAME.TABLE-$100 1680 STA FAC+1 1690 LDY #0 USE Y-REG WITH (FAC) TO ADDRESS TABLE 1700 STY TKN.CNTR HOLDS CURRENT TOKEN-$80 1710 DEY PREPARE FOR "INY" A FEW LINES DOWN 1720 STX TXTPTR SAVE POSITION IN INPUT LINE 1730 DEX PREPARE FOR "INX" A FEW LINES DOWN 1740 .5 INY ADVANCE POINTER TO TOKEN TABLE 1750 BNE .6 Y=Y+1 IS ENOUGH 1760 INC FAC+1 ALSO NEED TO BUMP THE PAGE 1770 .6 INX ADVANCE POINTER TO INPUT LINE 1780 .7 LDA INPUT.BUFFER,X NEXT CHAR FROM INPUT LINE 1790 CMP #' ' THIS CHAR A BLANK? 1800 BEQ .6 YES, IGNORE ALL BLANKS 1810 SEC NO, COMPARE TO CHAR IN TABLE 1820 SBC (FAC),Y SAME AS NEXT CHAR OF TOKEN NAME? 1830 BEQ .5 YES, CONTINUE MATCHING 1840 CMP #$80 MAYBE; WAS IT SAME EXCEPT FOR BIT 7? 1850 BNE .14 NO, SKIP TO NEXT TOKEN 1860 ORA TKN.CNTR YES, END OF TOKEN; GET TOKEN # 1870 CMP #TOKEN.AT DID WE MATCH "AT"? 1880 BNE .8 NO, SO NO AMBIGUITY 1890 LDA INPUT.BUFFER+1,X "AT" COULD BE "ATN" OR "A TO" 1900 CMP #'N "ATN" HAS PRECEDENCE OVER "AT" 1910 BEQ .14 IT IS "ATN", FIND IT THE HARD WAY 1920 CMP #'O "TO" HAS PRECEDENCE OVER "AT" 1930 BEQ .14 IT IS "A TO", FIN IT THE HARD WAY 1940 LDA #TOKEN.AT NOT "ATN" OR "A TO", SO USE "AT" 1950 *-------------------------------- 1960 * STORE CHARACTER OR TOKEN IN OUTPUT LINE 1970 *-------------------------------- 1980 .8 LDY STRNG2 GET INDEX TO OUTPUT LINE IN Y-REG 1990 .9 INX ADVANCE INPUT INDEX 2000 INY ADVANCE OUTPUT INDEX 2010 STA INPUT.BUFFER-5,Y STORE CHAR OR TOKEN 2020 LDA INPUT.BUFFER-5,Y TEST FOR EOL OR EOS 2030 BEQ .17 END OF LINE 2040 SEC 2050 SBC #': END OF STATEMENT? 2060 BEQ .10 YES, CLEAR DATAFLG 2070 CMP #TOKEN.DATA-':' "DATA" TOKEN? 2080 BNE .11 NO, LEAVE DATAFLG ALONE 2090 .10 STA DATAFLG DATAFLG = 0 OR $83-$3A = $49 2100 .11 SEC IS IT A "REM" TOKEN? 2110 SBC #TOKEN.REM-':' 2120 BNE .1 NO, CONTINUE PARSING LINE 2130 STA ENDCHR YES, CLEAR LITERAL FLAG 2140 *-------------------------------- 2150 * HANDLE LITERAL (BETWEEN QUOTES) OR REMARK, 2160 * BY COPYING CHARS UP TO ENDCHR. 2170 *-------------------------------- 2180 .12 LDA INPUT.BUFFER,X 2190 BEQ .9 END OF LINE 2200 CMP ENDCHR 2210 BEQ .9 FOUND ENDCHR 2220 .13 INY NEXT OUTPUT CHAR 2230 STA INPUT.BUFFER-5,Y 2240 INX NEXT INPUT CHAR 2250 BNE .12 ...ALWAYS 2260 *-------------------------------- 2270 * ADVANCE POINTER TO NEXT TOKEN NAME 2280 *-------------------------------- 2290 .14 LDX TXTPTR GET POINTER TO INPUT LINE IN X-REG 2300 INC TKN.CNTR BUMP (TOKEN # - $80) 2310 .15 LDA (FAC),Y SCAN THROUGH TABLE FOR BIT7 = 1 2320 INY NEXT TOKEN ONE BEYOND THAT 2330 BNE .16 ...USUALLY ENOUGH TO BUMP Y-REG 2340 INC FAC+1 NEXT SET OF 256 TOKEN CHARS 2350 .16 ASL SEE IF SIGN BIT SET ON CHAR 2360 BCC .15 NO, MORE IN THIS NAME 2370 LDA (FAC),Y YES, AT NEXT NAME. END OF TABLE? 2380 BNE .7 NO, NOT END OF TABLE 2390 LDA INPUT.BUFFER,X YES, SO NOT A KEYWORD 2400 BPL .8 ...ALWAYS, COPY CHAR AS IS 2410 *---END OF LINE------------------ 2420 .17 STA INPUT.BUFFER-3,Y STORE ANOTHER 00 ON END 2430 DEC TXTPTR+1 SET TXTPTR = INPUT.BUFFER-1 2440 LDA #INPUT.BUFFER-1 2450 STA TXTPTR 2460 RTS 2470 *-------------------------------- 2480 * SEARCH FOR LINE 2490 * 2500 * (LINNUM) = LINE # TO FIND 2510 * IF NOT FOUND: CARRY = 0 2520 * LOWTR POINTS AT NEXT LINE 2530 * IF FOUND: CARRY = 1 2540 * LOWTR POINTS AT LINE 2550 *-------------------------------- 2560 FNDLIN LDA TXTTAB SEARCH FROM BEGINNING OF PROGRAM 2570 LDX TXTTAB+1 2580 FL1 LDY #1 SEARCH FROM (X,A) 2590 STA LOWTR 2600 STX LOWTR+1 2610 LDA (LOWTR),Y 2620 BEQ .3 END OF PROGRAM, AND NOT FOUND 2630 INY 2640 INY 2650 LDA LINNUM+1 2660 CMP (LOWTR),Y 2670 BCC RTS.1 IF NOT FOUND 2680 BEQ .1 2690 DEY 2700 BNE .2 2710 .1 LDA LINNUM 2720 DEY 2730 CMP (LOWTR),Y 2740 BCC RTS.1 PAST LINE, NOT FOUND 2750 BEQ RTS.1 IF FOUND 2760 .2 DEY 2770 LDA (LOWTR),Y 2780 TAX 2790 DEY 2800 LDA (LOWTR),Y 2810 BCS FL1 ALWAYS 2820 .3 CLC RETURN CARRY = 0 2830 RTS.1 RTS 2840 *-------------------------------- 2850 * "NEW" STATEMENT 2860 *-------------------------------- 2870 NEW BNE RTS.1 IGNORE IF MORE TO THE STATEMENT 2880 SCRTCH LDA #0 2890 STA LOCK 2900 TAY 2910 STA (TXTTAB),Y 2920 INY 2930 STA (TXTTAB),Y 2940 LDA TXTTAB 2950 ADC #2 (CARRY WASN'T CLEARED, SO "NEW" USUALLY 2960 STA VARTAB ADDS 3, WHEREAS "FP" ADDS 2.) 2970 STA PRGEND 2980 LDA TXTTAB+1 2990 ADC #0 3000 STA VARTAB+1 3010 STA PRGEND+1 3020 *-------------------------------- 3030 SETPTRS 3040 JSR STXTPT SET TXTPTR TO TXTTAB - 1 3050 LDA #0 (THIS COULD HAVE BEEN ".HS 2C") 3060 *-------------------------------- 3070 * "CLEAR" STATEMENT 3080 *-------------------------------- 3090 CLEAR BNE RTS.2 IGNORE IF NOT AT END OF STATEMENT 3100 CLEARC LDA MEMSIZ CLEAR STRING AREA 3110 LDY MEMSIZ+1 3120 STA FRETOP 3130 STY FRETOP+1 3140 LDA VARTAB CLEAR ARRAY AREA 3150 LDY VARTAB+1 3160 STA ARYTAB 3170 STY ARYTAB+1 3180 STA STREND LOW END OF FREE SPACE 3190 STY STREND+1 3200 JSR RESTORE SET "DATA" POINTER TO BEGINNING 3210 *-------------------------------- 3220 STKINI LDX #TEMPST 3230 STX TEMPPT 3240 PLA SAVE RETURN ADDRESS 3250 TAY 3260 PLA 3270 LDX #$F8 START STACK AT $F8, 3280 TXS LEAVING ROOM FOR PARSING LINES 3290 PHA RESTORE RETURN ADDRESS 3300 TYA 3310 PHA 3320 LDA #0 3330 STA OLDTEXT+1 3340 STA SUBFLG 3350 RTS.2 RTS 3360 *-------------------------------- 3370 * SET TXTPTR TO BEGINNING OF PROGRAM 3380 *-------------------------------- 3390 STXTPT CLC TXTPTR = TXTTAB - 1 3400 LDA TXTTAB 3410 ADC #$FF 3420 STA TXTPTR 3430 LDA TXTTAB+1 3440 ADC #$FF 3450 STA TXTPTR+1 3460 RTS 3470 *-------------------------------- 3480 * "LIST" STATEMENT 3490 *-------------------------------- 3500 LIST BCC .1 NO LINE # SPECIFIED 3510 BEQ .1 ---DITTO--- 3520 CMP #TOKEN.MINUS IF DASH OR COMMA, START AT LINE 0 3530 BEQ .1 IS IS A DASH 3540 CMP #', COMMA? 3550 BNE RTS.2 NO, ERROR 3560 .1 JSR LINGET CONVERT LINE NUMBER IF ANY 3570 JSR FNDLIN POINT LOWTR TO 1ST LINE 3580 JSR CHRGOT RANGE SPECIFIED? 3590 BEQ .3 NO 3600 CMP #TOKEN.MINUS 3610 BEQ .2 3620 CMP #', 3630 BNE RTS.1 3640 .2 JSR CHRGET GET NEXT CHAR 3650 JSR LINGET CONVERT SECOND LINE # 3660 BNE RTS.2 BRANCH IF SYNTAX ERR 3670 .3 PLA POP RETURN ADRESS 3680 PLA (GET BACK BY "JMP NEWSTT") 3690 LDA LINNUM IF NO SECOND NUMBER, USE $FFFF 3700 ORA LINNUM+1 3710 BNE LIST.0 THERE WAS A SECOND NUMBER 3720 LDA #$FF MAX END RANGE 3730 STA LINNUM 3740 STA LINNUM+1 3750 LIST.0 LDY #1 3760 LDA (LOWTR),Y HIGH BYTE OF LINK 3770 BEQ LIST.3 END OF PROGRAM 3780 JSR ISCNTC CHECK IF CONTROL-C HAS BEEN TYPED 3790 JSR CRDO NO, PRINT 3800 INY 3810 LDA (LOWTR),Y GET LINE #, COMPARE WITH END RANGE 3820 TAX 3830 INY 3840 LDA (LOWTR),Y 3850 CMP LINNUM+1 3860 BNE .5 3870 CPX LINNUM 3880 BEQ .6 ON LAST LINE OF RANGE 3890 .5 BCS LIST.3 FINISHED THE RANGE 3900 *---LIST ONE LINE---------------- 3910 .6 STY FORPNT 3920 JSR LINPRT PRINT LINE # FROM X,A 3930 LDA #' ' PRINT SPACE AFTER LINE # 3940 LIST.1 LDY FORPNT 3950 AND #$7F 3960 LIST.2 JSR OUTDO 3970 LDA MON.CH IF PAST COLUMN 33, START A NEW LINE 3980 CMP #33 3990 BCC .1 < 33 4000 JSR CRDO PRINT 4010 LDA #5 AND TAB OVER 5 4020 STA MON.CH 4030 .1 INY 4040 LDA (LOWTR),Y 4050 BNE LIST.4 NOT END OF LINE YET 4060 TAY END OF LINE 4070 LDA (LOWTR),Y GET LINK TO NEXT LINE 4080 TAX 4090 INY 4100 LDA (LOWTR),Y 4110 STX LOWTR POINT TO NEXT LINE 4120 STA LOWTR+1 4130 BNE LIST.0 BRANCH IF NOT END OF PROGRAM 4140 LIST.3 LDA #$0D PRINT 4150 JSR OUTDO 4160 JMP NEWSTT TO NEXT STATEMENT 4170 *-------------------------------- 4180 GETCHR INY PICK UP CHAR FROM TABLE 4190 BNE .1 4200 INC FAC+1 4210 .1 LDA (FAC),Y 4220 RTS 4230 *-------------------------------- 4240 LIST.4 BPL LIST.2 BRANCH IF NOT A TOKEN 4250 SEC 4260 SBC #$7F CONVERT TOKEN TO INDEX 4270 TAX 4280 STY FORPNT SAVE LINE POINTER 4290 LDY #TOKEN.NAME.TABLE-$100 4300 STY FAC POINT FAC TO TABLE 4310 LDY /TOKEN.NAME.TABLE-$100 4320 STY FAC+1 4330 LDY #-1 4340 .1 DEX SKIP KEYWORDS UNTIL REACH THIS ONE 4350 BEQ .3 4360 .2 JSR GETCHR BUMP Y, GET CHAR FROM TABLE 4370 BPL .2 NOT AT END OF KEYWORD YET 4380 BMI .1 END OF KEYWORD, ALWAYS BRANCHES 4390 .3 LDA #' ' FOUND THE RIGHT KEYWORD 4400 JSR OUTDO PRINT LEADING SPACE 4410 .4 JSR GETCHR PRINT THE KEYWORD 4420 BMI .5 LAST CHAR OF KEYWORD 4430 JSR OUTDO 4440 BNE .4 ...ALWAYS 4450 .5 JSR OUTDO PRINT LAST CHAR OF KEYWORD 4460 LDA #' ' PRINT TRAILING SPACE 4470 BNE LIST.1 ...ALWAYS, BACK TO ACTUAL LINE