'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

(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.