07-28-2023, 03:37 PM
(This post was last modified: 07-28-2023, 03:38 PM by James D Jarvis.)
Run a tiny basic interpreter inside a qb64 program. Sorry no string variables at this point. I implemented a crude but simple means of passing variables into and out of the array space the interpreter uses. Will also load and save tiny basic programs. I added a few commands to the interpreter but most of the original work was done by one Ed Davis.
Code: (Select All)
'tiny basic in a subroutine
' vesion 0.1.j2823
' a tiny basic interpreter that can run in a qb64 program
'based on code by Ed Davis posted in a facebbok group
'
'it's crude and sloppy and not done yet but it works due to the good work of people before me.
'
'the original tiny basic implmentation this was based on used integer basic and only allowed 26 single letter variables
'altered things (poorly for now) to allow a larger number of variables and floating point numbers.
'there isn't support for string variables for now.
' valid variable names must start with a letter and may contain any mixture of alphanumeric characters and $
'variable names are not case sensistive so Aaa and AAA woudl be the smae variable.
'it's sloppy but A100A woudl be a valid variable name
'
'eventually I'll get string variables into this and some simple graphics, there's some bits of code in here now to get that going
'but it's nowhere near done yet
'
'all output from the interperter will go to current program screen when the interpreter is called
'code will immediatley execute if typed without a line number
'line numbers from 1 to 9999 are valid
'$dynamic
Screen _NewImage(800, 500, 32)
Const true = -1, false = 0, c_maxlines = 9999, c_maxvars = 200, c_at_max = 1000, c_g_stack = 100
Dim Shared As String c_tab, c_squote, c_dquote
c_tab = Chr$(9): c_squote = Chr$(39): c_dquote = Chr$(34)
Dim Shared pgm(c_maxlines) As String ' program stored here
Dim Shared vars(c_maxvars) As Double
Dim Shared var_type(c_maxvars) As String 'not really using this yet
Dim Shared var_name(c_maxvars) As String
Dim Shared var_string(c_maxvars) As String
Dim Shared stringflag As String
Dim Shared pen_x, pen_y As Single
Dim Shared gstackln(c_g_stack) As Integer ' gosub line stack
Dim Shared gstacktp(c_g_stack) As Integer ' gosub textp stack
Dim Shared gsp As Long
Dim Shared atarry(0 To c_at_max) As Double ' the @ array
Dim Shared forvar(c_maxvars) As Integer
Dim Shared forlimit(c_maxvars) As Integer
Dim Shared forline(c_maxvars) As Integer
Dim Shared forpos(c_maxvars) As Integer
Dim Shared As String tok, toktype ' current token, and it's type
Dim Shared As String tok2, toktype2 ' current token, and it's type
Dim Shared As String thelin, thech ' current program line, current character
Dim Shared As Integer curline, textp ' position in current line
Dim Shared num As Double ' last number read by scanner
Dim Shared As Integer errors, tracing, need_colon
Dim Shared dump_array(0 To c_at_max) As Double
declare function accept(s as string)
declare function expression(minprec as double)
declare function getfilename$(action as string)
declare function getvarindex
declare function inputexpression(s as string)
declare function parenexpr&
Dim pl$(1 To 12)
pl$(1) = "cls"
pl$(2) = "print" + Chr$(34) + "Hello" + Chr$(34)
pl$(3) = "for x = 1 to 10"
pl$(4) = "print x"
pl$(5) = " a = a +x: @(x)=a"
pl$(6) = "next x"
pl$(7) = "print" + Chr$(34) + "Done" + Chr$(34)
pl$(8) = "print a"
pl$(9) = "arraydump"
pl$(10) = "print " + Chr$(34) + "Type Run to execute the program and Quit to exit" + Chr$(34)
Call tiny_basic("list", pl$())
Cls
Print "Back in main program": Print
Print "Variables passed from interpreter"
For x = 1 To 10
Print dump_array(x)
Next x
ReDim pl$(2)
Print
Print "press any key to coniunue": Sleep
pl$(1) = "print " + Chr$(34) + "Type your own program" + Chr$(34) + ":print :help"
Call tiny_basic("run", pl$())
End
Sub tiny_basic (icmd$, pl$())
Dim loadlines, prox
loadlines = UBound(pl$)
For prox = 1 To loadlines
pgm(prox) = pl$(prox)
Next
icmd$ = LCase$(icmd$)
Select Case icmd$
Case "run"
tok = "run"
Call docmd
Case "list"
tok = "list"
Call docmd
Case "new"
tok = "new"
Call docmd
End Select
If Command$ <> "" Then
toktype = "string": tok = c_dquote + Command$
Call loadstmt
tok = "run": Call docmd
Else
' Call help
End If
Do
errors = false
Line Input "tinyb> ", pgm(0)
If pgm(0) <> "" Then
Call initlex(0)
If toktype = "number" Then
Call validlinenum
If Not errors Then pgm(num) = Mid$(pgm(0), textp)
Else
Call docmd
End If
End If
Loop Until toktype = "exit"
ReDim pgm(0 To c_maxlines) As String
End Sub
Sub docmd
Do
If tracing And Left$(tok, 1) <> ":" Then Print curline; tok; thech; Mid$(thelin, textp)
need_colon = true
Select Case tok
Case "bye", "quit": Call nexttok: toktype = "exit": Exit Sub
Case "end", "stop": Call nexttok: Exit Sub
Case "clear": Call nexttok: Call clearvars: Exit Sub
Case "help": Call nexttok: Call help: Exit Sub
Case "list": Call nexttok: Call liststmt: Exit Sub
Case "load", "old": Call nexttok: Call loadstmt: Exit Sub
Case "new": Call nexttok: Call newstmt: Exit Sub
Case "run": Call nexttok: Call runstmt
Case "save": Call nexttok: Call savestmt: Exit Sub
Case "tron": Call nexttok: tracing = true
Case "troff": Call nexttok: tracing = false
Case "cls": Call nexttok: Cls
Case "for": Call nexttok: Call forstmt
Case "gosub": Call nexttok: Call gosubstmt
Case "goto": Call nexttok: Call gotostmt
Case "if": Call nexttok: Call ifstmt
Case "input": Call nexttok: Call inputstmt
Case "next": Call nexttok: Call nextstmt
Case "print", "?": Call nexttok: Call printstmt
Case "pen": Call nexttok: Call penstmt
Case "return": Call nexttok: Call returnstmt
Case "@": Call nexttok: Call arrassn
Case "arraydump": Call nexttok: Call arraydump 'puts @() into array dump_array() for use in main program
Case "arrayload": Call nexttok: Call arrayload 'reads dump_array into @() to pass data from main program
Case ":", "" ' handled below
Case "beep": Call nexttok: Call dobeep
Case Else
If tok = "let" Then Call nexttok
If toktype = "ident" Then
Call assign
Else
Print "Unknown token '"; tok; "' at line:"; curline; " Col:"; textp; " : "; thelin: errors = true
End If
End Select
If errors Then Exit Sub
If tok = "" Then
While tok = ""
If curline = 0 Or curline >= c_maxlines Then Exit Sub
Call initlex(curline + 1)
Wend
ElseIf tok = ":" Then Call nexttok
ElseIf need_colon And Not accept(":") Then
Print ": expected but found: "; tok
Exit Sub
End If
Loop
End Sub
Sub help
Print "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Tiny Basic (QBASIC) --------ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
Print "³ bye, clear, cls, end/stop, help, list, load/save, new, run, tron/off³Û"
Print "³ for <var> = <expr1> to <expr2> ... next <var> ³Û"
Print "³ gosub <expr> ... return ³Û"
Print "³ goto <expr> ³Û"
Print "³ if <expr> then <statement> ³Û"
Print "³ input [prompt,] <var> ³Û"
Print "³ <var>=<expr> ³Û"
Print "³ arraydump ³Û"
Print "³ beep, print <expr|string>[,<expr|string>][;] ³Û"
Print "³ rem <anystring> or ' <anystring> ³Û"
Print "³ Operators: ^, * / \ mod + - < <= > >= = <>, not, and, or ³Û"
Print "³ Integer variables a..z, and array @(expr) ³Û"
Print "³ Functions: abs(expr), asc(ch), rnd(expr), rnd(expr),sgn(expr) ³Û"
Print "³ sin(expr), cos(expr), tan(expr) ³Û"
Print "³ sindeg(expr), cosdeg(expr), tandeg(expr) ³Û"
Print "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ"
Print " ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß"
End Sub
Sub assign
Dim var As Long
var = getvarindex: Call nexttok
Call expect("=")
vars(var) = expression(0)
If stringflag <> "" Then
var_string(var) = stringflag
End If
If tracing Then Print "*** "; Chr$(var + Asc("a")); " = "; vars(var)
End Sub
Sub dobeep
Beep
End Sub
Sub arraydump
'dump array so it can be passed to main program
For x = 1 To c_at_max
dump_array(x) = atarry(x)
Next x
End Sub
Sub arrayload
'loads array from dump_aeeay to pass varaibles from main program
For x = 1 To c_at_max
atarry(x) = dump_array(x)
Next x
End Sub
Sub arrassn ' array assignment: @(expr) = expr
Dim As Long n, atndx
atndx = parenexpr
If tok <> "=" Then
Print "Array Assign: Expecting '=', found:"; tok: errors = true
Else
Call nexttok ' skip the "="
n = expression(0)
atarry(atndx) = n
If tracing Then Print "*** @("; atndx; ") = "; n
End If
End Sub
Sub forstmt ' for i = expr to expr
Dim As Long var, n, forndx
var = getvarindex
Call assign
' vars(var) has the value; var has the number value of the variable in 0..25
forndx = var
forvar(forndx) = vars(var)
If tok <> "to" Then
Print "For: Expecting 'to', found:"; tok: errors = true
Else
Call nexttok
n = expression(0)
forlimit(forndx) = n
' need to store iter, limit, line, and col
forline(forndx) = curline
If tok = "" Then forpos(forndx) = textp Else forpos(forndx) = textp - 2
End If
End Sub
Sub gosubstmt ' for gosub: save the line and column
gsp = gsp + 1
gstackln(gsp) = curline
gstacktp(gsp) = textp
Call gotostmt
End Sub
Sub gotostmt
num = expression(0)
Call validlinenum
Call initlex(num)
End Sub
Sub ifstmt
need_colon = false
If expression(0) = 0 Then Call skiptoeol: Exit Sub
If tok = "then" Then Call nexttok
If toktype = "number" Then Call gotostmt
End Sub
Sub inputstmt ' "input" [string ","] var
Dim var As Double, st As String
If toktype = "string" Then
Print Mid$(tok, 2);
Call nexttok
Call expect(",")
Else
Print "? ";
End If
var = getvarindex: Call nexttok
Line Input st
If st = "" Then st = "0"
Select Case Left$(st, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
vars(var) = Val(st)
Case "-"
If Mid$(st, 2, 1) >= "0" And Mid$(st, 2, 1) <= "9" Then vars(var) = Val(st)
Case Else
'vars(var) = Asc(st)
Print "string tok "; tok
var_string(var) = tok
Print
End Select
End Sub
Sub liststmt
Dim i As Integer
For i = 1 To c_maxlines
If pgm(i) <> "" Then Print i; " "; pgm(i)
Next i
Print
End Sub
Sub loadstmt
Dim n As Long, filename As String
Call newstmt
filename = getfilename("Load")
If filename = "" Then Exit Sub
Open filename For Input As #1
n = 0
While Not EOF(1)
Line Input #1, pgm(0)
Call initlex(0)
If toktype = "number" And num > 0 And num <= c_maxlines Then
n = num
Else
n = n + 1: textp = 1
End If
pgm(n) = Mid$(pgm(0), textp)
Wend
Close #1
curline = 0
End Sub
Sub newstmt
Dim i As Integer
Call clearvars
For i = 1 To c_maxlines
pgm(i) = ""
Next i
End Sub
Sub nextstmt
Dim forndx As Long
' tok needs to have the variable
forndx = getvarindex
forvar(forndx) = forvar(forndx) + 1
vars(forndx) = forvar(forndx)
If forvar(forndx) <= forlimit(forndx) Then
curline = forline(forndx)
textp = forpos(forndx)
Call initlex2
Else
Call nexttok
End If
End Sub
' "print" [[#num "," ] expr { "," [#num ","] expr }] [","] {":" stmt} eol
' expr can also be a literal string
Sub penstmt
penx_x = Val(tok)
Call nexttok
pen_y = Val(tok)
PSet (pen_x, pen_y), _RGB32(255, 255, 255)
End Sub
Sub printstmt
Dim As Single printnl, printwidth, n
Dim junk As String
printnl = true
Do While tok <> ":" And tok <> "" And tok <> "else"
printnl = true
printwidth = 0
If accept("#") Then
If num <= 0 Then Print "Expecting a print width, found:"; tok: Exit Sub
printwidth = num
Call nexttok
If Not accept(",") Then Print "Print: Expecting a ',', found:"; tok: Exit Sub
End If
If toktype = "string" Then
junk = Mid$(tok, 2)
Call nexttok
Else
n = expression(0)
junk = LTrim$(Str$(n))
End If
printwidth = printwidth - Len(junk)
If printwidth <= 0 Then Print junk; Else Print Space$(printwidth); junk;
If accept(",") Or accept(";") Then printnl = false Else Exit Do
Loop
If printnl Then Print
End Sub
Sub returnstmt ' exit sub from a subroutine
curline = gstackln(gsp)
textp = gstacktp(gsp)
gsp = gsp - 1
Call initlex2
End Sub
Sub runstmt
Call clearvars
Call initlex(1)
End Sub
Sub savestmt
Dim i As Long, filename As String
filename = getfilename("Save")
If filename = "" Then Exit Sub
Open filename For Output As #1
For i = 1 To c_maxlines
If pgm(i) <> "" Then Print #1, i; pgm(i)
Next i
Close #1
End Sub
Function getfilename$ (action As String)
Dim filename As String
If toktype = "string" Then
filename = Mid$(tok, 2)
Else
Print action; ": ";
Line Input filename
End If
If filename <> "" Then
If InStr(filename, ".") = 0 Then filename = filename + ".bas"
End If
getfilename = filename
End Function
Sub validlinenum
If num <= 0 Or num > c_maxlines Then Print "Line number out of range": errors = true
End Sub
Sub clearvars
Dim i As Integer
For i = 1 To c_maxvars
vars(i) = 0
var_name(i) = ""
var_string(i) = ""
Next i
gsp = 0
End Sub
Function parenexpr&
Call expect("("): If errors Then Exit Function
parenexpr = expression(0)
Call expect(")")
End Function
Function expression (minprec As Double)
Dim n As Double
' handle numeric operands - numbers and unary operators
If 0 Then ' to allow elseif
ElseIf toktype = "number" Then n = num: Call nexttok
ElseIf tok = "(" Then n = parenexpr
ElseIf tok = "not" Then Call nexttok: n = Not expression(3)
ElseIf tok = "abs" Then Call nexttok: n = Abs(parenexpr)
ElseIf tok = "asc" Then Call nexttok: expect ("("): n = Asc(Mid$(tok, 2, 1)): Call nexttok: expect (")")
ElseIf tok = "rnd" Then Call nexttok: n = (Rnd * parenexpr)
ElseIf tok = "irnd" Then Call nexttok: n = Int(Rnd * parenexpr) + 1
ElseIf tok = "sgn" Then Call nexttok: n = Sgn(parenexpr)
ElseIf tok = "sin" Then Call nexttok: n = Sin(parenexpr)
ElseIf tok = "cos" Then Call nexttok: n = Cos(parenexpr)
ElseIf tok = "tan" Then Call nexttok: n = Tan(parenexpr)
ElseIf tok = "sindeg" Then Call nexttok: n = Sin(parenexpr * _Pi / 360)
ElseIf tok = "cosdeg" Then Call nexttok: n = Cos(parenexpr * _Pi / 360)
ElseIf tok = "tandeg" Then Call nexttok: n = Tan(parenexpr * _Pi / 360)
ElseIf toktype = "ident" Then n = vars(getvarindex): Call nexttok
ElseIf tok = "@" Then Call nexttok: n = atarry(parenexpr)
ElseIf tok = "-" Then Call nexttok: n = -expression(7)
ElseIf tok = "+" Then Call nexttok: n = expression(7)
Else Print "syntax error: expecting an operand, found: ", tok: errors = true: Exit Function
End If
Do ' while binary operator and precedence of tok >= minprec
If 0 Then ' to allow elseif
ElseIf minprec <= 1 And tok = "or" Then Call nexttok: n = n Or expression(2)
ElseIf minprec <= 2 And tok = "and" Then Call nexttok: n = n And expression(3)
ElseIf minprec <= 4 And tok = "=" Then Call nexttok: n = Abs(n = expression(5))
ElseIf minprec <= 4 And tok = "<" Then Call nexttok: n = Abs(n < expression(5))
ElseIf minprec <= 4 And tok = ">" Then Call nexttok: n = Abs(n > expression(5))
ElseIf minprec <= 4 And tok = "<>" Then Call nexttok: n = Abs(n <> expression(5))
ElseIf minprec <= 4 And tok = "<=" Then Call nexttok: n = Abs(n <= expression(5))
ElseIf minprec <= 4 And tok = ">=" Then Call nexttok: n = Abs(n >= expression(5))
ElseIf minprec <= 5 And tok = "+" Then Call nexttok: n = n + expression(6)
ElseIf minprec <= 5 And tok = "-" Then Call nexttok: n = n - expression(6)
ElseIf minprec <= 6 And tok = "*" Then Call nexttok: n = n * expression(7)
ElseIf minprec <= 6 And tok = "/" Then Call nexttok: n = n / expression(7)
ElseIf minprec <= 6 And tok = "\" Then Call nexttok: n = n \ expression(7)
ElseIf minprec <= 6 And tok = "mod" Then Call nexttok: n = n Mod expression(7)
ElseIf minprec <= 8 And tok = "^" Then Call nexttok: n = CLng(n ^ expression(9))
Else Exit Do
End If
Loop
expression = n
End Function
Function inputexpression (s As String)
Dim As Long save_curline, save_textp
Dim As String save_thelin, save_thech, save_tok, save_toktype
save_curline = curline: save_textp = textp: save_thelin = thelin: save_thech = thech: save_tok = tok: save_toktype = toktype
pgm(0) = s
Call initlex(0)
inputexpression = expression(0)
curline = save_curline: textp = save_textp: thelin = save_thelin: thech = save_thech: tok = save_tok: toktype = save_toktype
End Function
Function getvarindex
If toktype <> "ident" Then Print "Not a variable:"; tok: errors = true: Exit Function
' Print "***(getvarindex)*** tok "; tok
foundv = 0
Do
vv = vv + 1
If vv < c_maxvars Then
If var_name(vv) = tok Then
foundv = vv
ElseIf var_name(vv) = "" Then
var_name(vv) = tok
foundv = vv
End If
End If
Loop Until foundv <> 0 Or vv > c_maxvars
getvarindex = foundv
End Function
Sub expect (s As String)
If accept(s) Then Exit Sub
Print "("; curline; ") expecting "; s; " but found "; tok; " =>"; pgm(curline): errors = true
End Sub
Function accept (s As String)
accept = false
If tok = s Then accept = true: Call nexttok
End Function
Sub initlex (n As Integer)
curline = n: textp = 1
Call initlex2
End Sub
Sub initlex2
need_colon = false
thelin = pgm(curline)
thech = " "
Call nexttok
End Sub
Sub nexttok
tok = "": toktype = ""
While thech <= " "
If thech = "" Then Exit Sub
Call getch
Wend
tok = thech: Call getch
Select Case tok
Case "a" To "z", "A" To "Z": Call readident: If tok = "rem" Then Call skiptoeol
Case "0" To "9": Call readdbl
Case c_squote: Call skiptoeol
Case c_dquote: Call readstr
Case "#", "(", ")", "*", "+", ",", "-", "/", ":", ";", "<", "=", ">", "?", "@", "\", "^":
toktype = "punct"
If (tok = "<" And (thech = ">" Or thech = "=")) Or (tok = ">" And thech = "=") Then
tok = tok + thech
Call getch
End If
Case Else: Print "("; curline; ") "; "What?"; tok; " : "; thelin: errors = true
End Select
End Sub
Sub skiptoeol
tok = "": toktype = ""
textp = Len(thelin) + 1
End Sub
Sub readdbl
toktype = "number"
While thech >= "0" And thech <= "9" Or thech = "." Or thech = "-"
tok = tok + thech
Call getch
Wend
num = Val(tok)
End Sub
Sub readident
toktype = "ident"
While (thech >= "a" And thech <= "z") Or (thech >= "A" And thech <= "Z") Or thech = "$" Or (thech >= "0" And thech <= "9")
tok = tok + thech
Call getch
Wend
tok = LCase$(tok)
End Sub
Sub readstr ' store double quote as first char of string, to distinguish from idents
toktype = "string"
While thech <> c_dquote ' while not a double quote
If thech = "" Then Print "String not terminated": errors = true: Exit Sub
tok = tok + thech
Call getch
Wend
Call getch ' skip closing double quote
End Sub
Sub getch
If textp > Len(thelin) Then
thech = ""
Else
thech = Mid$(thelin, textp, 1)
textp = textp + 1
End If
End Sub