Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
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
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
07-28-2023, 04:15 PM
(This post was last modified: 07-28-2023, 04:17 PM by James D Jarvis.)
here it is in the older code block
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
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
07-28-2023, 05:20 PM
(This post was last modified: 07-28-2023, 05:21 PM by bplus.)
Congratulations building your own interpreter is definitely a milestone in programming experience.
Besides novelty, what might this be used for?
I know the Evaluate parts from my interpreter are very handy for other things like graphing and doing functions without having to pre-define them in QB64.
Oh might be interesting to make a little IDE or editor for it?
b = b + ...
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
Why?
1. Novelty
2. evaluation expressions/formulas at runtime
3. allow for scripting of the application as external programs/scripts can be loaded
4. self modifying code.... this is stretch but not completely impossible.
A little ide for it could be cool indeed.
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
just updated the main tiny_basic sub. Realized a few minutes ago it wasn't as verssatile as the load statement, so I updated it to number the load statement does.
Code: (Select All) 'just the one subroutine, replace the earlier version with this one.
Sub tiny_basic (icmd$, pl$())
Dim loadlines, prox
loadlines = UBound(pl$)
n = 0
For prox = 1 To loadlines
pgm(0) = pl$(prox)
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)
Next prox
curline = 0
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
Posts: 1,510
Threads: 53
Joined: Jul 2022
Reputation:
47
I envisioned having a Lua virtual machine in this way. Primarily to take advantage of its tables (which could be used as associative arrays) and its regular expression parser.
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
07-28-2023, 09:17 PM
(07-28-2023, 06:06 PM)James D Jarvis Wrote: Why?
1. Novelty
2. evaluation expressions/formulas at runtime
3. allow for scripting of the application as external programs/scripts can be loaded
4. self modifying code.... this is stretch but not completely impossible.
A little ide for it could be cool indeed.
#4 Oh yeah! I did that with bat files back in 90's thanks for reminder! I had forgotten you can do that with code you don't have to compile.
b = b + ...
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
Experimented with Chain and Merge commands earlier and they seem to be working. Another little trick you can't really do with compiled code, not that you should want to but c'mon you know you do. Hopefully I'll get a chance to clean up a little more of the code and update it here this weekend.
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
07-31-2023, 01:41 PM
(This post was last modified: 07-31-2023, 06:57 PM by James D Jarvis.)
Most recent version. Chain and Merge seem to be working. They are meant to load tinybasic programs saved outside the main program.
EDIT: doh, had a bug i missed. fixed it.
Code: (Select All) 'tiny basic in a subroutine
' vesion 0.2.j3123
' 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
'added merge and chain commands. merge <filename> will add code to thecurrent program.
'chain <filename> will replace the currently loaded code. Variables created earlier will be retained.
'$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:a=0"
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) = "100 arraydump"
pl$(10) = "200 print " + Chr$(34) + "Type Run to execute the program and Quit to exit" + Chr$(34)
Call tiny_basic("new", 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$())
'icmd$ of "run" will load the program in the array pl$() and immediately execte it. previous vaiables will be retained if they were not cleared earlier.
'icmd$ of "list" will load the prigram in pl$() and list the code in the interpreter
'icmds$ of "new" will load the program in array pl$() and cler any previous variables.
Dim loadlines, prox
loadlines = UBound(pl$)
n = 0
For prox = 1 To loadlines
pgm(0) = pl$(prox)
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)
Next prox
curline = 0
icmd$ = LCase$(icmd$)
Select Case icmd$
Case "run"
tok = "run"
Call docmd
Case "list"
tok = "list"
Call docmd
Case "new"
tok = "run"
clearvars
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 mergestmt
'merge another tny basic program file with the one presently loaded
Dim last As Integer
Dim filename As String
last = 0
i = 0
For i = 1 To c_maxlines
If pgm(i) <> "" Then last = i
Next i
If last <= c_maxlines Then
filename = getfilename("Load")
If filename = "" Then Exit Sub
Open filename For Input As #1
n = last + 1
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 If
End Sub
Sub chainstmt
'load a new tinybasic file replacing the current, any previously defined variables will be retained
Dim n As Long, filename As String
ReDim pgm(c_maxlines)
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 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 "merge": Call nexttok: Call mergestmt: Exit Sub
Case "chain": Call nexttok: Call chainstmt: 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_array to pass variables 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
Print "string tok "; st
var_string(var) = st
vars(var) = Asc(Left$(st, 1))
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
ReDim pgm(c_maxlines) As String
' 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
ReDim vars(c_maxvars)
ReDim var_name(c_maxvars)
ReDim var_string(c_maxvars)
ReDim atarry(0 To c_at_max) As Double
'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 = (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
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
@James D Jarvis do you have any sample / demo programs to go with Tiny Basic? specially an example with chain and merge, you have me curious. I never used either in earlier Basics.
Developer of Naalaa did a nice one for Ed Davis Tiny can't recall the name of the classic game but pretty amazing for Tiny. Maybe @aurel remembers or @Ed Davis will pipe in here?
b = b + ...
|
