348 lines
13 KiB
Plaintext
348 lines
13 KiB
Plaintext
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 <RETURN>
|
|
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 <RETURN>
|
|
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 <RETURN>
|
|
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
|