Results 1 to 1 of 1

Thread: Tiny Basic interpreter, with (just) enough features to play Star Trek

  1. #1

    Thread Starter
    New Member
    Join Date
    Jul 2022
    Posts
    2

    Tiny Basic interpreter, with (just) enough features to play Star Trek

    Below is a VB.NET "Tiny Basic" interpreter, that has just enough features to play an old (1976) version of Star Trek.

    This is based on Dr. Li-Chen Wang's Palo Alto Tiny BASIC from 1976.

    Attached is a Tiny Basic version of the Star Trek game that this interpreter can run. The Star Trek game was found here: https://groups.io/g/ET-3400/topic/88950752#2212

    Tiny Basic commands and statements are case-insensitive.

    Commands:
    • bye or quit - to exit Tiny Basic
    • list - to list the program
    • load - to load another program from disk
    • new - to clear out the current program
    • run - to run the current program
    • save - to save the current program to disk


    Tiny Basic has 26 integer variables named a-z.

    There is also a single numeric array, denoted by @:

    To use the array:

    @(numeric-expression) = numeric-expression

    Statements:
    • gosub numeric-expression - call a subroutine
    • return - return from a subroutine
    • goto numeric-expression - transfer control to the specified line number
    • if expression then number or if expression then statement - in the first form, control is transferred to line "number". In the second form, statement can be any Tiny Basic statement.
    • input [string ","] var
    • print expr {",|;" expr} - expr can be a numeric-expression or a literal string.


    Multiple statements can appear on a line, separated by the colon ":".

    There is a single built-in function, rnd(numeric-expression), which returns a pseudo random number between 0 and numeric-expression - 1, inclusive.

    There are two modes - immediate and store.

    If you type a statement without a line number, it is executed immediately.
    If you type a statement with a line number, it is stored, and can later be run with the "run" command.

    Note that this is a "pure" (as opposed to a tokenizing, or AST, or byte-code) interpreter, so it isn't a speed demon.

    At around just 400 lines of code, hopefully it is easy enough to follow.

    Code:
    'Ed Davis. Tiny Basic that can play Star Trek
    'Supports: end, list, load, new run, save
    'gosub/return, goto, if, input, print, multi-statement lines (:)
    'a single numeric array: @(n), and rnd(n)
    
    imports system.console
    imports system.io
    
    module TinyBasic
    
    const c_maxlines = 7000, c_maxvars = 26, c_at_max = 1000, c_g_stack = 100
    
    dim pgm(c_maxlines) as string         ' program stored here
    dim vars(c_maxvars) as integer        ' variable store
    dim gstackln(c_g_stack) as integer    ' gosub line stack
    dim gstacktp(c_g_stack) as integer    ' gosub textp stack
    dim gsp as integer                    ' gosub stack index
    dim atarry(c_at_max) as integer       ' the @ array
    
    dim tok as string, toktype as string    ' current token, and it's type
    dim thelin as string, thech as string   ' current program line, current character
    dim curline as integer, textp as integer ' position in current line
    dim num as integer   ' last number read by scanner
    dim errors as boolean
    
    sub main()
      gsp = 0
      do
        errors = false
        write("> ")
        pgm(0) = ReadLine()
        if pgm(0) <> "" then
          initlex(0)
          if toktype = "number" then
            validlinenum()
            pgm(num) = mid(pgm(0), textp, len(pgm(0)) - textp + 1)
          else
            docmd()
          end if
        end if
      loop
    end sub
    
    sub docmd()
      do
        if accept("bye") or accept("quit") then
          end
        elseif accept("end") or accept("stop") then
          exit sub
        elseif accept("list")    then
          liststmt():   exit sub
        elseif accept("load")    then
          loadstmt():   exit sub
        elseif accept("new")     then
          newstmt():    exit sub
        elseif accept("run")     then
          runstmt()
        elseif accept("save")    then
          savestmt():   exit sub
        elseif accept("gosub")   then
          gosubstmt()
        elseif accept("goto")    then
          gotostmt()
        elseif accept("if")      then
          ifstmt()
        elseif accept("input")   then
          inputstmt()
        elseif accept("print") or accept("?")  then
          printstmt()
        elseif accept("return")  then
          returnstmt()
        elseif accept("@")       then
          arrassn()
        elseif accept(":")       then
          ' just continue
        elseif toktype = "ident" then
          assign()
        elseif tok = ""          then
          ' handled below
        else
          writeline("Unknown token " & tok & " at line " & curline): errors = true
        end if
    
        if errors or curline > c_maxlines then exit sub
        do while tok = ""
          if curline = 0 or curline >= c_maxlines then exit sub
          initlex(curline + 1)
        loop
      loop
    end sub
    
    sub gosubstmt()   ' for gosub: save the line and column
      gsp = gsp + 1
      gstackln(gsp) = curline
      gstacktp(gsp) = textp
    
      gotostmt()
    end sub
    
    sub assign()
      dim var as integer
      var = getvarindex(): nexttok()
      expect("=")
      vars(var) = expression(0)
    end sub
    
    sub arrassn()   ' array assignment: @(expr) = expr
      dim n as integer, atndx as integer
    
      atndx = parenexpr()
      if tok <> "=" then
        writeline("Array Assign: Expecting '=', found: " & tok): errors = true
      else
        nexttok()     ' skip the "="
        n = expression(0)
        atarry(atndx) = n
      end if
    end sub
    
    sub ifstmt
      dim b as boolean
      if expression(0) = 0 then skiptoeol(): exit sub
      b = accept("then")      ' "then" is optional
      if toktype = "number" then gotostmt()
    end sub
    
    sub inputstmt   ' "input" [string ","] var
      dim var as integer
      dim st as string
      if toktype = "string" then
        write(mid(tok, 2))
        nexttok()
        expect(",")
      else
        write("? ")
      end if
      var = getvarindex: nexttok()
      st = readline()
      if left(st, 1) >= "0" and left(st, 1) <= "9" then
        vars(var) = Convert.ToInt32(val(st))
      else
        vars(var) = asc(st) ' turn characters into their ascii value
      end if
    end sub
    
    sub liststmt()
      dim i as integer
      for i = 1 to c_maxlines
        if pgm(i) <> "" then writeline(i & " " & pgm(i))
      next i
      writeline("")
    end sub
    
    sub loadstmt()
      dim n as integer, filename as string
      dim f as StreamReader
    
      newstmt()
      if toktype = "string" then
        filename = mid(tok, 2)
      else
        write("Load? "): filename = ReadLine()
      end if
      if filename = "" then exit sub
      if instr(filename, ".") = 0 then filename = filename + ".bas"
    
      f = new StreamReader(filename)
      n = 0
      do until f.peek = -1
        pgm(0) = f.ReadLine()
        initlex(0)
        if toktype = "number" and num > 0 and num <= c_maxlines then
          pgm(num) = mid(pgm(0), textp, len(pgm(0)) - textp + 1)
          n = num
        else
          n = n + 1
          pgm(n) = pgm(0)
        end if
      loop
      f.Close()
      curline = 0
    end sub
    
    sub newstmt()
      dim i as integer
      clearvars()
      for i = 1 to c_maxlines
        pgm(i) = ""
      next i
    end sub
    
    ' "print" expr { "," expr }] [","] {":" stmt} eol
    ' expr can also be a literal string
    sub printstmt()
      dim printnl as boolean
    
      printnl = true
      do while tok <> ":" and tok <> ""
        printnl = true
    
        if toktype = "string" then
          write(mid(tok, 2))
          nexttok()
        else
          write(ltrim(str(expression(0))))
        end if
    
        if accept(",") then
          write(" ")
          printnl = false
        elseif accept(";") then
          printnl = false
        else
          exit do
        end if
      loop
    
      if printnl then writeline("")
    end sub
    
    sub returnstmt()    ' return from a subroutine
      curline = gstackln(gsp)
      textp   = gstacktp(gsp)
      gsp = gsp - 1
      initlex2()
    end sub
    
    sub runstmt()
      clearvars()
      initlex(1)
    end sub
    
    sub gotostmt()
      num = expression(0)
      validlinenum()
      initlex(num)
    end sub
    
    sub savestmt()
      dim i as integer, filename as string
      dim f as StreamWriter
    
      if toktype = "string" then
        filename = mid(tok, 2)
      else
        write("Save? "): filename = readline()
      end if
      if filename = "" then exit sub
      if instr(filename, ".") = 0 then filename = filename + ".bas"
      f = new StreamWriter(filename, false)
      for i = 1 to c_maxlines
        if pgm(i) <> "" then f.writeline(i & " " & pgm(i))
      next i
      f.close()
    end sub
    
    sub validlinenum()
      if num <= 0 or num > c_maxlines then writeline("Line number out of range"): errors = true
    end sub
    
    sub clearvars()
      dim i as integer
      for i = 1 to c_maxvars
        vars(i) = 0
      next i
      gsp = 0
    end sub
    
    function parenexpr() as integer
      dim n as integer
    
      expect("("): if errors then return 0
      n = expression(0)
      expect(")")
      return n
    end function
    
    function expression(minprec as integer) as integer
      dim n as integer
    
      ' handle numeric operands - numbers and unary operators
      if accept("-") then
        n = -expression(4)
      elseif accept("+") then
        n =  expression(4)
      elseif tok = "("  then
        n =  parenexpr
      elseif accept("rnd") then
        n = Convert.ToInt32(rnd * parenexpr)
      elseif toktype = "number" then
        n = num: nexttok()
      elseif toktype = "ident"  then
        n = vars(getvarindex): nexttok()
      elseif accept("@")  then
        n = atarry(parenexpr)
      else
        writeline("syntax error: expecting an operand, found: " & tok): errors = true: return 0
      end if
    
      do  ' while binary operator and precedence of tok >= minprec
        if minprec <= 1 and tok = "="  then
          nexttok(): n = Convert.ToInt32(n =  expression(2))
        elseif minprec <= 1 and tok = "<"  then
          nexttok(): n = Convert.ToInt32(n <  expression(2))
        elseif minprec <= 1 and tok = ">"  then
          nexttok(): n = Convert.ToInt32(n >  expression(2))
        elseif minprec <= 1 and tok = "<>" then
          nexttok(): n = Convert.ToInt32(n <> expression(2))
        elseif minprec <= 1 and tok = "<=" then
          nexttok(): n = Convert.ToInt32(n <= expression(2))
        elseif minprec <= 1 and tok = ">=" then
          nexttok(): n = Convert.ToInt32(n >= expression(2))
        elseif minprec <= 2 and tok = "+"  then
          nexttok(): n = n +  expression(3)
        elseif minprec <= 2 and tok = "-"  then
          nexttok(): n = n -  expression(3)
        elseif minprec <= 3 and tok = "*"  then
          nexttok(): n = n *  expression(4)
        elseif minprec <= 3 and tok = "/"  then
          nexttok(): n = n \  expression(4)
        else
          exit do
        end if
      loop
    
      return n
    end function
    
    function getvarindex() as integer
      if toktype <> "ident" then writeline("Not a variable:" & tok): errors = true: return 0
      return asc(left(tok, 1)) - asc("a")
    end function
    
    sub expect(s as string)
      if accept(s) then exit sub
      writeline("(" & curline & ") expecting " & s & " but found " & tok & " =>" & pgm(curline)): errors = true
    end sub
    
    function accept(s as string) as boolean
      if tok = s then nexttok(): return true
      return false
    end function
    
    sub initlex(n as integer)
      curline = n
      textp = 1
      initlex2()
    end sub
    
    sub initlex2()
      thelin = pgm(curline)
      thech = " "
      nexttok()
    end sub
    
    sub skiptoeol()
      tok = "": toktype = ""
      textp = len(thelin) + 1
    end sub
    
    sub nexttok()
      tok = "": toktype = ""
      do while thech <= " "
        if thech = "" then exit sub
        getch()
      loop
    
      toktype = "punct"
      tok = thech + mid(thelin, textp, 1)
      if tok = ">=" or tok = "<=" or tok = "<>" then
        getch(): getch(): exit sub
      end if
      tok = thech
      if instr("()*+,-/:;<=>?@", thech) > 0 then getch(): exit sub
      if tok = chr(34) then readstr(): exit sub    ' double quote
      if (tok >= "a" and thech <= "z") or (tok >= "A" and thech <= "Z") then
        readident()
        if tok = "rem" then skiptoeol()
        exit sub
      end if
      if tok >= "0" and thech <= "9" then readint(): exit sub
      if tok = chr(39) then skiptoeol(): exit sub  'single quote
      toktype = ""
      writeline("What?" & thech & thelin): getch(): errors = true
    end sub
    
    ' leave the " as the beginning of the string, so it won't get confused with other tokens
    ' especially in the print routines
    sub readstr()
      toktype = "string"
      getch()
      do while thech <> chr(34)  ' while not a double quote
        if thech = "" then writeline("String not terminated"): errors = true: exit sub
        tok = tok + thech
        getch()
      loop
      getch()
    end sub
    
    sub readint()
      tok = "": toktype = "number"
      do while thech >= "0" and thech <= "9"
        tok = tok + thech
        getch()
      loop
      num = Convert.ToInt32(val(tok))
    end sub
    
    sub readident()
      tok = "": toktype = "ident"
      do while (thech >= "a" and thech <= "z") or (thech >= "A" and thech <= "Z")
        tok = tok + lcase(thech)
        getch()
      loop
    end sub
    
    sub getch()
      ' Any more text on this line?
      if textp > len(thelin) then thech = "": exit sub
      thech = mid(thelin, textp, 1)
      textp = textp + 1
    end sub
    
    end module
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width