mirror of
https://github.com/QB64Official/qb64.git
synced 2024-09-01 16:20:18 +00:00
347 lines
6.9 KiB
QBasic
347 lines
6.9 KiB
QBasic
|
DECLARE SUB LLISTSTMT ()
|
||
|
DECLARE SUB LPRINTSTMT ()
|
||
|
DECLARE SUB INITGETSYM (N AS INTEGER)
|
||
|
DECLARE SUB VALIDLINENUM ()
|
||
|
DECLARE SUB DOCMD ()
|
||
|
DECLARE SUB CLEARVARS ()
|
||
|
DECLARE SUB LISTSTMT ()
|
||
|
DECLARE SUB GOTOSTMT ()
|
||
|
DECLARE SUB IFSTMT ()
|
||
|
DECLARE SUB INPUTSTMT ()
|
||
|
DECLARE SUB PRINTSTMT ()
|
||
|
DECLARE SUB SKIPTOEOL ()
|
||
|
DECLARE SUB IDSTMT ()
|
||
|
DECLARE SUB GETSYM ()
|
||
|
DECLARE SUB EXPECT (S AS STRING)
|
||
|
DECLARE SUB GOTOLINE ()
|
||
|
DECLARE FUNCTION EXPRESSION% ()
|
||
|
DECLARE FUNCTION ADDEXPR% ()
|
||
|
DECLARE FUNCTION TERM% ()
|
||
|
DECLARE FUNCTION FACTOR% ()
|
||
|
DECLARE FUNCTION GETVARINDEX% ()
|
||
|
DECLARE FUNCTION ACCEPT% (S AS STRING)
|
||
|
DECLARE SUB GETCH ()
|
||
|
DECLARE SUB READSTR ()
|
||
|
DECLARE SUB READIDENT ()
|
||
|
DECLARE SUB READINT ()
|
||
|
|
||
|
DIM SHARED CH$, THELIN$, PGM$(2000), TOK$
|
||
|
|
||
|
|
||
|
DIM SHARED VARS(26) AS INTEGER, CURLINE AS INTEGER, NUM AS INTEGER
|
||
|
DIM SHARED TEXTP AS INTEGER, ERRORS AS INTEGER
|
||
|
|
||
|
|
||
|
DO
|
||
|
ERRORS = 0
|
||
|
LINE INPUT "> ", PGM$(0)
|
||
|
IF PGM$(0) <> "" THEN
|
||
|
CALL INITGETSYM(0)
|
||
|
IF LEFT$(TOK$, 1) >= "0" AND LEFT$(TOK$, 1) <= "9" THEN
|
||
|
CALL VALIDLINENUM
|
||
|
PGM$(NUM) = MID$(PGM$(0), TEXTP, LEN(PGM$(0)) - TEXTP + 1)
|
||
|
ELSE
|
||
|
CALL DOCMD
|
||
|
END IF
|
||
|
END IF
|
||
|
LOOP
|
||
|
|
||
|
FUNCTION ACCEPT% (S AS STRING)
|
||
|
ACCEPT% = 0
|
||
|
IF TOK$ = S THEN ACCEPT% = 1: CALL GETSYM
|
||
|
END FUNCTION
|
||
|
|
||
|
FUNCTION ADDEXPR%
|
||
|
DIM N
|
||
|
N = TERM%
|
||
|
ADDEL:
|
||
|
IF TOK$ = "+" THEN CALL GETSYM: N = N + TERM%: GOTO ADDEL
|
||
|
IF TOK$ = "-" THEN CALL GETSYM: N = N - TERM%: GOTO ADDEL
|
||
|
ADDEXPR% = N
|
||
|
END FUNCTION
|
||
|
|
||
|
SUB CLEARVARS
|
||
|
DIM I AS INTEGER
|
||
|
FOR I = 1 TO 26
|
||
|
VARS(I) = 0
|
||
|
NEXT I
|
||
|
END SUB
|
||
|
|
||
|
SUB DOCMD
|
||
|
DIM I AS INTEGER
|
||
|
AGAIN:
|
||
|
IF ERRORS <> 0 THEN EXIT SUB
|
||
|
WHILE TOK$ = ""
|
||
|
IF CURLINE = 0 OR CURLINE >= 1999 THEN EXIT SUB
|
||
|
CALL INITGETSYM(CURLINE + 1)
|
||
|
WEND
|
||
|
IF ACCEPT("STOP") OR ACCEPT("END") THEN EXIT SUB
|
||
|
IF ACCEPT("NEW") THEN
|
||
|
CALL CLEARVARS
|
||
|
FOR I = 1 TO 1999
|
||
|
PGM$(I) = ""
|
||
|
NEXT I
|
||
|
EXIT SUB
|
||
|
END IF
|
||
|
IF ACCEPT("BYE") THEN END
|
||
|
IF ACCEPT("LIST") THEN CALL LISTSTMT: GOTO AGAIN
|
||
|
IF ACCEPT("LLIST") THEN CALL LLISTSTMT: GOTO AGAIN
|
||
|
IF ACCEPT("RUN") THEN
|
||
|
CALL CLEARVARS
|
||
|
CALL INITGETSYM(1)
|
||
|
GOTO AGAIN
|
||
|
END IF
|
||
|
IF ACCEPT("GOTO") THEN CALL GOTOSTMT: GOTO AGAIN
|
||
|
IF ACCEPT("IF") THEN CALL IFSTMT: GOTO AGAIN
|
||
|
IF ACCEPT("INPUT") THEN CALL INPUTSTMT: GOTO AGAIN
|
||
|
IF ACCEPT("PRINT") THEN CALL PRINTSTMT: GOTO AGAIN
|
||
|
IF ACCEPT("LPRINT") THEN CALL LPRINTSTMT: GOTO AGAIN
|
||
|
IF ACCEPT("REM") THEN CALL SKIPTOEOL: GOTO AGAIN
|
||
|
IF LEFT$(TOK$, 1) >= "A" AND LEFT$(TOK$, 1) <= "Z" THEN
|
||
|
CALL IDSTMT
|
||
|
GOTO AGAIN
|
||
|
END IF
|
||
|
PRINT "UNKNOWN TOKEN "; TOK$; " AT LINE "; CURLINE
|
||
|
END SUB
|
||
|
|
||
|
SUB EXPECT (S AS STRING)
|
||
|
IF ACCEPT(S) <> 0 THEN EXIT SUB
|
||
|
ERRORS = 1
|
||
|
PRINT "EXPECTING "; S; " BUT FOUND "; TOK$
|
||
|
END SUB
|
||
|
|
||
|
FUNCTION EXPRESSION%
|
||
|
DIM N
|
||
|
N = ADDEXPR%
|
||
|
EXPRL:
|
||
|
IF TOK$ = "=" THEN CALL GETSYM: N = N = ADDEXPR%: GOTO EXPRL
|
||
|
IF TOK$ = "<" THEN CALL GETSYM: N = N < ADDEXPR%: GOTO EXPRL
|
||
|
IF TOK$ = ">" THEN CALL GETSYM: N = N > ADDEXPR%: GOTO EXPRL
|
||
|
IF TOK$ = "<>" THEN CALL GETSYM: N = N <> ADDEXPR%: GOTO EXPRL
|
||
|
IF TOK$ = "<=" THEN CALL GETSYM: N = N <= ADDEXPR%: GOTO EXPRL
|
||
|
IF TOK$ = ">=" THEN CALL GETSYM: N = N >= ADDEXPR%: GOTO EXPRL
|
||
|
EXPRESSION% = N
|
||
|
END FUNCTION
|
||
|
|
||
|
FUNCTION FACTOR%
|
||
|
IF ACCEPT("-") THEN
|
||
|
FACTOR% = -FACTOR%
|
||
|
EXIT FUNCTION
|
||
|
END IF
|
||
|
IF ACCEPT("(") THEN
|
||
|
FACTOR% = EXPRESSION
|
||
|
CALL EXPECT(")")
|
||
|
EXIT FUNCTION
|
||
|
END IF
|
||
|
IF LEFT$(TOK$, 1) >= "0" AND LEFT$(TOK$, 1) <= "9" THEN
|
||
|
FACTOR% = NUM
|
||
|
CALL GETSYM
|
||
|
EXIT FUNCTION
|
||
|
END IF
|
||
|
IF LEFT$(TOK$, 1) >= "A" AND LEFT$(TOK$, 1) <= "Z" THEN
|
||
|
FACTOR% = VARS(GETVARINDEX)
|
||
|
EXIT FUNCTION
|
||
|
END IF
|
||
|
PRINT "UNEXPECTED SYM "; TOK$; " IN FACTOR": ERRORS = 1
|
||
|
END FUNCTION
|
||
|
|
||
|
SUB GETCH
|
||
|
IF TEXTP > LEN(THELIN$) THEN CH$ = "": EXIT SUB
|
||
|
CH$ = MID$(THELIN$, TEXTP, 1)
|
||
|
TEXTP = TEXTP + 1
|
||
|
END SUB
|
||
|
|
||
|
SUB GETSYM
|
||
|
TOK$ = ""
|
||
|
WHILE CH$ <= " "
|
||
|
IF CH$ = "" THEN EXIT SUB
|
||
|
CALL GETCH
|
||
|
WEND
|
||
|
|
||
|
|
||
|
TOK$ = CH$
|
||
|
IF INSTR(",;=+-*/()", CH$) > 0 THEN CALL GETCH: EXIT SUB
|
||
|
IF CH$ = "<" THEN
|
||
|
CALL GETCH
|
||
|
IF CH$ = "=" OR CH$ = ">" THEN
|
||
|
TOK$ = TOK$ + CH$
|
||
|
CALL GETCH
|
||
|
END IF
|
||
|
EXIT SUB
|
||
|
END IF
|
||
|
IF CH$ = ">" THEN
|
||
|
CALL GETCH
|
||
|
IF CH$ = "=" THEN TOK$ = TOK$ + CH$: CALL GETCH
|
||
|
EXIT SUB
|
||
|
END IF
|
||
|
IF CH$ = CHR$(34) THEN CALL READSTR: EXIT SUB
|
||
|
IF CH$ >= "A" AND CH$ <= "Z" THEN CALL READIDENT: EXIT SUB
|
||
|
IF CH$ >= "0" AND CH$ <= "9" THEN CALL READINT: EXIT SUB
|
||
|
PRINT "WHAT->"; CH$: ERRORS = 1
|
||
|
END SUB
|
||
|
|
||
|
FUNCTION GETVARINDEX%
|
||
|
IF LEFT$(TOK$, 1) < "A" OR LEFT$(TOK$, 1) > "Z" THEN
|
||
|
PRINT "NOT A VARIABLE": ERRORS = 1: EXIT FUNCTION
|
||
|
END IF
|
||
|
GETVARINDEX% = ASC(LEFT$(TOK$, 1)) - ASC("A")
|
||
|
CALL GETSYM
|
||
|
END FUNCTION
|
||
|
|
||
|
SUB GOTOLINE
|
||
|
CALL VALIDLINENUM
|
||
|
CALL INITGETSYM(NUM)
|
||
|
END SUB
|
||
|
|
||
|
SUB GOTOSTMT
|
||
|
IF LEFT$(TOK$, 1) >= "0" AND LEFT$(TOK$, 1) <= "9" THEN
|
||
|
CALL GOTOLINE
|
||
|
EXIT SUB
|
||
|
END IF
|
||
|
PRINT "LINE NUMBER MUST FOLLOW GOTO": ERRORS = 1
|
||
|
END SUB
|
||
|
|
||
|
SUB IDSTMT
|
||
|
DIM VAR AS INTEGER
|
||
|
VAR = GETVARINDEX
|
||
|
CALL EXPECT("=")
|
||
|
VARS(VAR) = EXPRESSION
|
||
|
END SUB
|
||
|
|
||
|
SUB IFSTMT
|
||
|
DIM B AS INTEGER
|
||
|
IF EXPRESSION = 0 THEN CALL SKIPTOEOL: EXIT SUB
|
||
|
B = ACCEPT("THEN")
|
||
|
IF LEFT$(TOK$, 1) >= "0" AND LEFT$(TOK$, 1) <= "9" THEN
|
||
|
CALL GOTOLINE
|
||
|
END IF
|
||
|
END SUB
|
||
|
|
||
|
SUB INITGETSYM (N AS INTEGER)
|
||
|
CURLINE = N
|
||
|
TEXTP = 1
|
||
|
THELIN$ = PGM$(CURLINE)
|
||
|
CH$ = " "
|
||
|
CALL GETSYM
|
||
|
END SUB
|
||
|
|
||
|
SUB INPUTSTMT
|
||
|
DIM VAR AS INTEGER
|
||
|
IF TOK$ = CHR$(34) THEN
|
||
|
PRINT MID$(TOK$, 2, LEN(TOK$) - 1);
|
||
|
CALL GETSYM
|
||
|
CALL EXPECT(",")
|
||
|
ELSE
|
||
|
PRINT "? ";
|
||
|
END IF
|
||
|
VAR = GETVARINDEX
|
||
|
INPUT VARS(VAR)
|
||
|
END SUB
|
||
|
|
||
|
SUB LISTSTMT
|
||
|
DIM I AS INTEGER
|
||
|
FOR I = 1 TO 1999
|
||
|
IF PGM$(I) <> "" THEN PRINT I; " "; PGM$(I)
|
||
|
NEXT I
|
||
|
PRINT
|
||
|
END SUB
|
||
|
|
||
|
SUB LLISTSTMT
|
||
|
OPEN "LPT1" FOR OUTPUT AS #1
|
||
|
DIM I AS INTEGER
|
||
|
FOR I = 1 TO 1999
|
||
|
IF PGM$(I) <> "" THEN PRINT #1, I; " "; PGM$(I)
|
||
|
NEXT I
|
||
|
PRINT
|
||
|
CLOSE #1
|
||
|
END SUB
|
||
|
|
||
|
SUB LPRINTSTMT
|
||
|
OPEN "LPT1" FOR OUTPUT AS #1
|
||
|
DIM LPRINTNL AS INTEGER
|
||
|
LPRINTNL = 1
|
||
|
DO WHILE TOK$ <> ""
|
||
|
LPRINTNL = 1
|
||
|
IF LEFT$(TOK$, 1) = CHR$(34) THEN
|
||
|
PRINT #1, MID$(TOK$, 2, LEN(TOK$) - 1);
|
||
|
CALL GETSYM
|
||
|
ELSE
|
||
|
PRINT #1, EXPRESSION;
|
||
|
END IF
|
||
|
IF ACCEPT(",") = 0 AND ACCEPT(";") = 0 THEN EXIT DO
|
||
|
PRINTNL = 0
|
||
|
LOOP
|
||
|
IF PRINTNL <> 0 THEN PRINT #1, ""
|
||
|
CLOSE #1
|
||
|
END SUB
|
||
|
|
||
|
SUB PRINTSTMT
|
||
|
DIM PRINTNL AS INTEGER
|
||
|
PRINTNL = 1
|
||
|
DO WHILE TOK$ <> ""
|
||
|
PRINTNL = 1
|
||
|
IF LEFT$(TOK$, 1) = CHR$(34) THEN
|
||
|
PRINT MID$(TOK$, 2, LEN(TOK$) - 1);
|
||
|
CALL GETSYM
|
||
|
ELSE
|
||
|
PRINT EXPRESSION;
|
||
|
END IF
|
||
|
|
||
|
|
||
|
IF ACCEPT(",") = 0 AND ACCEPT(";") = 0 THEN EXIT DO
|
||
|
PRINTNL = 0
|
||
|
LOOP
|
||
|
IF PRINTNL <> 0 THEN PRINT
|
||
|
END SUB
|
||
|
|
||
|
SUB READIDENT
|
||
|
TOK$ = ""
|
||
|
WHILE CH$ >= "A" AND CH$ <= "Z"
|
||
|
TOK$ = TOK$ + CH$
|
||
|
CALL GETCH
|
||
|
WEND
|
||
|
END SUB
|
||
|
|
||
|
SUB READINT
|
||
|
TOK$ = ""
|
||
|
WHILE CH$ >= "0" AND CH$ <= "9"
|
||
|
TOK$ = TOK$ + CH$
|
||
|
CALL GETCH
|
||
|
WEND
|
||
|
NUM = VAL(TOK$)
|
||
|
END SUB
|
||
|
|
||
|
SUB READSTR
|
||
|
TOK$ = CHR$(34)
|
||
|
CALL GETCH
|
||
|
WHILE CH$ <> CHR$(34)
|
||
|
IF CH$ = "" THEN
|
||
|
PRINT "STRING NOT TERMINATED": ERRORS = 1: EXIT SUB
|
||
|
END IF
|
||
|
TOK$ = TOK$ + CH$
|
||
|
CALL GETCH
|
||
|
WEND
|
||
|
CALL GETCH
|
||
|
END SUB
|
||
|
|
||
|
SUB SKIPTOEOL
|
||
|
WHILE CH$ <> ""
|
||
|
CALL GETCH
|
||
|
WEND
|
||
|
CALL GETSYM
|
||
|
END SUB
|
||
|
|
||
|
FUNCTION TERM%
|
||
|
DIM N
|
||
|
N = FACTOR%
|
||
|
TERML:
|
||
|
IF TOK$ = "*" THEN CALL GETSYM: N = N * FACTOR%: GOTO TERML
|
||
|
IF TOK$ = "/" THEN CALL GETSYM: N = N / FACTOR%: GOTO TERML
|
||
|
TERM% = N
|
||
|
END FUNCTION
|
||
|
|
||
|
SUB VALIDLINENUM
|
||
|
IF NUM > 0 AND NUM <= 1999 THEN EXIT SUB
|
||
|
PRINT "LINE NUMBER OUT OF RANGE": ERRORS = 1
|
||
|
END SUB
|