mirror of
https://github.com/kanaka/mal.git
synced 2024-09-21 10:37:58 +03:00
115e430d02
Enable QBasic console mode usage and fix bugs in newline handling differences with C64 basic (cbm). To enable console mode for QBasic programs, have basicpp.py prefix the output with the QB64 specific console activation variables/functions. One change to basicpp.py to make this change more straightfowards is recursive includes so that includes can appear in more than just the top level step files. This allows us to conditionally include the right readline implementation. For QBasic in the special console mode (instead of the default full-screen UI mode) we need to use the LINE INPUT command in order to read input.
260 lines
7.1 KiB
QBasic
260 lines
7.1 KiB
QBasic
REM READ_TOKEN(RF=0, A$, RI) -> T$
|
|
REM READ_TOKEN(RF=1) -> T$
|
|
READ_TOKEN:
|
|
IF RF=1 THEN RF=2:T$="(":RETURN
|
|
IF RF=2 THEN RF=3:T$="do":RETURN
|
|
GOSUB SKIP_SPACES
|
|
REM PRINT "READ_TOKEN: "+STR$(RI)+", "+MID$(A$,RI,1)
|
|
GOSUB READ_CHAR
|
|
IF C$=";" THEN GOSUB SKIP_TO_EOL:GOTO READ_TOKEN
|
|
T$=C$
|
|
IF T$="(" OR T$=")" OR T$="[" OR T$="]" OR T$="{" OR T$="}" OR T$="'" OR T$="`" OR T$="@" THEN RETURN
|
|
GOSUB PEEK_CHAR: REM peek at next character
|
|
IF T$="~" AND C$<>"@" THEN RETURN
|
|
S1=0:S2=0: REM S1: INSTRING?, S2: ESCAPED?
|
|
IF T$=CHR$(34) THEN S1=1
|
|
READ_TOKEN_LOOP:
|
|
GOSUB PEEK_CHAR: REM peek at next character
|
|
IF C$="" THEN RETURN
|
|
IF S1 THEN GOTO READ_TOKEN_CONT
|
|
IF C$=" " OR C$="," OR C$=CHR$(13) OR C$=CHR$(10) THEN RETURN
|
|
IF C$="(" OR C$=")" OR C$="[" OR C$="]" OR C$="{" OR C$="}" THEN RETURN
|
|
READ_TOKEN_CONT:
|
|
GOSUB READ_CHAR
|
|
T$=T$+C$
|
|
IF T$="~@" THEN RETURN
|
|
IF S1=0 OR S2=1 THEN S2=0:GOTO READ_TOKEN_LOOP
|
|
REM S1=1 (INSTRING?) and S2=0 (not ESCAPED?)
|
|
IF C$=CHR$(92) THEN S2=1
|
|
IF C$=CHR$(34) THEN RETURN
|
|
GOTO READ_TOKEN_LOOP
|
|
|
|
|
|
REM READ_CHAR(A$, RI) -> C$
|
|
READ_CHAR:
|
|
RJ=1:GOSUB DO_READ_CHAR
|
|
RETURN
|
|
|
|
REM PEEK_CHAR(A$, RI) -> C$
|
|
PEEK_CHAR:
|
|
RJ=0:GOSUB DO_READ_CHAR
|
|
RETURN
|
|
|
|
REM DO_READ_CHAR(RJ, A$, RI):
|
|
REM - RI is position in A$
|
|
REM - RJ=1 is read, RJ=0 is peek
|
|
DO_READ_CHAR:
|
|
C$=""
|
|
IF RF>0 THEN GOTO READ_FILE_CHAR
|
|
IF RI<=LEN(A$) THEN C$=MID$(A$,RI,1):RI=RI+RJ
|
|
RETURN
|
|
|
|
REM READ_FILE_CHAR(RJ) -> C$
|
|
REM - RJ=1 is read, RJ=0 is peek
|
|
REM - D$ is global used for already read pending character
|
|
REM - EZ is global used for end of file state
|
|
READ_FILE_CHAR:
|
|
IF D$<>"" THEN C$=D$:IF RJ=0 THEN RETURN
|
|
IF D$<>"" AND RJ=1 THEN D$="":RETURN
|
|
D$=""
|
|
IF EZ>2 THEN C$=""
|
|
IF EZ=2 THEN C$=")"
|
|
IF EZ=1 THEN C$=CHR$(10)
|
|
IF EZ>0 THEN EZ=EZ+RJ:RETURN
|
|
#cbm GET#2,C$
|
|
#qbasic C$=INPUT$(1,2)
|
|
#qbasic IF EOF(2) THEN EZ=1:RETURN
|
|
IF RJ=0 THEN D$=C$
|
|
#cbm IF (ST AND 64) THEN EZ=1:RETURN
|
|
#cbm IF (ST AND 255) THEN EZ=1:ER=-1:E$="File read error"+STR$(ST)
|
|
RETURN
|
|
|
|
SKIP_SPACES:
|
|
GOSUB PEEK_CHAR: REM peek at next character
|
|
IF C$=" " OR C$="," OR C$=CHR$(13) OR C$=CHR$(10) THEN GOSUB READ_CHAR:GOTO SKIP_SPACES
|
|
RETURN
|
|
|
|
SKIP_TO_EOL:
|
|
GOSUB READ_CHAR
|
|
IF C$="" OR C$=CHR$(13) OR C$=CHR$(10) THEN RETURN
|
|
GOTO SKIP_TO_EOL
|
|
|
|
|
|
REM READ_FORM(A$, RI, RF) -> R
|
|
SUB READ_FORM
|
|
Q=T:GOSUB PUSH_Q: REM save current value of T
|
|
READ_FORM_RECUR:
|
|
IF ER<>-2 THEN GOTO READ_FORM_RETURN
|
|
GOSUB READ_TOKEN
|
|
REM PRINT "READ_FORM T$: ["+T$+"]"
|
|
IF T$="" THEN R=0:GOSUB INC_REF_R:GOTO READ_FORM_RETURN
|
|
IF T$="nil" THEN T=0:GOTO READ_NIL_BOOL
|
|
IF T$="false" THEN T=1:GOTO READ_NIL_BOOL
|
|
IF T$="true" THEN T=2:GOTO READ_NIL_BOOL
|
|
IF T$="'" THEN B$="quote":GOTO READ_MACRO
|
|
IF T$="`" THEN B$="quasiquote":GOTO READ_MACRO
|
|
IF T$="~" THEN B$="unquote":GOTO READ_MACRO
|
|
IF T$="~@" THEN B$="splice-unquote":GOTO READ_MACRO
|
|
IF T$="^" THEN B$="with-meta":GOTO READ_MACRO
|
|
IF T$="@" THEN B$="deref":GOTO READ_MACRO
|
|
C$=MID$(T$,1,1)
|
|
REM PRINT "C$: ["+C$+"]("+STR$(ASC(C$))+")"
|
|
IF C$>="0" AND C$<="9" THEN GOTO READ_NUMBER
|
|
IF C$="-" THEN GOTO READ_SYMBOL_MAYBE
|
|
|
|
IF C$=CHR$(34) THEN GOTO READ_STRING
|
|
IF C$=":" THEN GOTO READ_KEYWORD
|
|
REM set end character in Q and read the sequence
|
|
IF C$="(" THEN T=6:Q=41:GOTO READ_SEQ_START: REM ")"
|
|
IF C$="[" THEN T=7:Q=93:GOTO READ_SEQ_START: REM "]"
|
|
IF C$="{" THEN T=8:Q=125:GOTO READ_SEQ_START: REM "}"
|
|
IF C$=")" OR C$="]" OR C$="}" THEN R=-1:ER=-1:E$="unexpected "+C$:GOTO READ_FORM_RETURN
|
|
GOTO READ_SYMBOL
|
|
|
|
READ_NIL_BOOL:
|
|
REM PRINT "READ_NIL_BOOL"
|
|
R=T*2
|
|
GOSUB INC_REF_R
|
|
GOTO READ_FORM_RETURN
|
|
READ_NUMBER:
|
|
REM PRINT "READ_NUMBER"
|
|
T=2:L=VAL(T$):GOSUB ALLOC
|
|
GOTO READ_FORM_RETURN
|
|
READ_MACRO:
|
|
REM push macro type
|
|
Q=-1*(T$="^"):GOSUB PUSH_Q
|
|
|
|
REM B$ is set above
|
|
T=5:GOSUB STRING
|
|
REM push string
|
|
GOSUB PUSH_R
|
|
|
|
CALL READ_FORM
|
|
REM push first form
|
|
GOSUB PUSH_R
|
|
IF ER>-2 THEN GOTO READ_MACRO_DONE
|
|
|
|
GOSUB PEEK_Q_2
|
|
IF Q THEN GOTO READ_MACRO_3
|
|
|
|
READ_MACRO_2:
|
|
GOSUB PEEK_Q_1:B=Q
|
|
GOSUB PEEK_Q:A=Q
|
|
GOSUB LIST2
|
|
GOTO READ_MACRO_DONE
|
|
|
|
READ_MACRO_3:
|
|
CALL READ_FORM
|
|
GOSUB PEEK_Q_1:C=Q
|
|
B=R
|
|
GOSUB PEEK_Q:A=Q
|
|
GOSUB LIST3
|
|
AY=C:GOSUB RELEASE
|
|
|
|
READ_MACRO_DONE:
|
|
REM release values, list has ownership
|
|
AY=B:GOSUB RELEASE
|
|
AY=A:GOSUB RELEASE
|
|
|
|
REM pop the stack
|
|
GOSUB POP_Q: REM pop first form
|
|
GOSUB POP_Q: REM pop string
|
|
GOSUB POP_Q: REM pop macro type
|
|
T$="": REM necessary to prevent unexpected EOF errors
|
|
GOTO READ_FORM_RETURN
|
|
|
|
READ_STRING:
|
|
REM PRINT "READ_STRING"
|
|
C=ASC(MID$(T$,LEN(T$),1))
|
|
IF C<>34 THEN R=-1:ER=-1:E$="expected '"+CHR$(34)+"'":GOTO READ_FORM_RETURN
|
|
R$=MID$(T$,2,LEN(T$)-2)
|
|
S1$=CHR$(92)+CHR$(34):S2$=CHR$(34):GOSUB REPLACE: REM unescape quotes
|
|
#cbm S1$=CHR$(92)+"n":S2$=CHR$(13):GOSUB REPLACE: REM unescape newlines
|
|
#qbasic S1$=CHR$(92)+"n":S2$=CHR$(10):GOSUB REPLACE: REM unescape newlines
|
|
S1$=CHR$(92)+CHR$(92):S2$=CHR$(92):GOSUB REPLACE: REM unescape backslashes
|
|
REM intern string value
|
|
B$=R$:T=4:GOSUB STRING
|
|
GOTO READ_FORM_RETURN
|
|
READ_KEYWORD:
|
|
R$=CHR$(127)+MID$(T$,2,LEN(T$)-1)
|
|
B$=R$:T=4:GOSUB STRING
|
|
GOTO READ_FORM_RETURN
|
|
READ_SYMBOL_MAYBE:
|
|
C$=MID$(T$,2,1)
|
|
IF C$>="0" AND C$<="9" THEN GOTO READ_NUMBER
|
|
READ_SYMBOL:
|
|
REM PRINT "READ_SYMBOL"
|
|
B$=T$:T=5:GOSUB STRING
|
|
GOTO READ_FORM_RETURN
|
|
|
|
READ_SEQ_START:
|
|
SD=SD+1
|
|
|
|
GOSUB PUSH_Q: REM push return character
|
|
|
|
REM setup the stack for the loop, T has type
|
|
GOSUB MAP_LOOP_START
|
|
|
|
READ_SEQ_LOOP:
|
|
|
|
REM TODO: reduce redundancy with READ_TOKEN
|
|
GOSUB SKIP_SPACES
|
|
GOSUB PEEK_CHAR: REM peek at next character
|
|
IF C$="" THEN ER=-1:E$="unexpected EOF":GOTO READ_SEQ_DONE
|
|
IF C$=";" THEN GOSUB SKIP_TO_EOL:GOTO READ_SEQ_LOOP
|
|
Q=3:GOSUB PEEK_Q_Q
|
|
IF C$=CHR$(Q) THEN GOSUB READ_CHAR:GOTO READ_SEQ_DONE
|
|
|
|
CALL READ_FORM
|
|
M=R: REM value (or key for hash-maps)
|
|
|
|
REM if error, release the unattached element
|
|
IF ER<>-2 THEN AY=R:GOSUB RELEASE:GOTO READ_SEQ_DONE
|
|
|
|
REM if this is a hash-map, READ_FORM again
|
|
IF T=8 THEN GOSUB PUSH_R:CALL READ_FORM
|
|
IF T=8 THEN N=R:GOSUB POP_Q:M=Q: REM set key and value
|
|
|
|
REM update the return sequence structure
|
|
REM release N since list takes full ownership
|
|
C=1:GOSUB MAP_LOOP_UPDATE
|
|
|
|
GOTO READ_SEQ_LOOP
|
|
|
|
READ_SEQ_DONE:
|
|
SD=SD-1
|
|
REM cleanup stack and get return value
|
|
GOSUB MAP_LOOP_DONE
|
|
|
|
GOSUB POP_Q: REM pop end character ptr
|
|
GOTO READ_FORM_RETURN
|
|
|
|
READ_FORM_RETURN:
|
|
GOSUB POP_Q:T=Q: REM restore current value of T
|
|
|
|
END SUB
|
|
|
|
|
|
REM READ_STR(A$) -> R
|
|
READ_STR:
|
|
RI=1: REM index into A$
|
|
RF=0: REM not reading from file
|
|
SD=0: REM sequence read depth
|
|
CALL READ_FORM
|
|
RETURN
|
|
|
|
REM READ_FILE(A$) -> R
|
|
READ_FILE:
|
|
RF=1: REM reading from file
|
|
EZ=0: REM file read state (1: EOF)
|
|
SD=0: REM sequence read depth
|
|
D$="": REM pending read/peek character
|
|
#cbm OPEN 2,8,0,A$
|
|
#qbasic IF NOT _FILEEXISTS(A$) THEN ER=-1:E$="File not found":RETURN
|
|
#qbasic OPEN A$ FOR INPUT AS #2
|
|
REM READ_TOKEN adds "(do ... )"
|
|
CALL READ_FORM
|
|
CLOSE 2
|
|
EZ=0
|
|
RETURN
|