mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-07-03 15:51:20 +00:00
9ee89d6ff4
These tests use a variety of sample code (with some of the larger files removed, so they are not complete!) and verifies that they all compile successfully.
347 lines
6.6 KiB
QBasic
347 lines
6.6 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
|