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

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