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

---