'Tiny Basic interpreter in Oxygen Basic. Uses long as base type. By Ed Davis.
#lookahead
uses console
indexbase 0

Declare Sub ExitProcess Lib "kernel32.dll" (ByVal uExitCode As Long)
Declare Function GetCommandLine Lib "kernel32.dll" Alias "GetCommandLineA" () as char*

const long c_maxlines = 1000, c_maxvars = 26, c_at_max = 1500, c_g_stack = 100
string c_tab = chr(9), c_squote = chr(39), c_dquote = chr(34)
global as long c_default=0, c_ident=1, c_number=2, c_string=3, c_punct=4

global as string pgm[c_maxlines]    ' program stored here
global as long vars[c_maxvars]      ' variable store
global as long gstackln[c_g_stack]  ' gosub line stack
global as long gstacktp[c_g_stack]  ' gosub textp stack
global as long gsp                  ' gosub stack index
global as long atarry[c_at_max]     ' the @ array
global as long forvar[c_maxvars]
global as long forlimit[c_maxvars]
global as long forline[c_maxvars]
global as long forpos[c_maxvars]

global as string tok                ' current token
global as string thelin, thech      ' current program line, current character
global as long curline, textp       ' position in current line
global as long num                  ' last number read by scanner
global as long toktype, errors, tracing
global as long hi_index             ' highest used index in pgm

call main

sub main
  dim string command = getarg()
  call newstmt  ' resets gsp, hi_index
  if command <> "" then
    pgm[0] = "run " + c_dquote + command + c_dquote
    call initlex(0)
    call docmd
  else
    call help
  end if
  do
    errors = False
    print "tb> ": pgm[0] = rtrim(input())
    if pgm[0] <> "" then
      call initlex(0)
      if toktype <> c_number then
        call docmd
      else
        if validlinenum then
          dim as long n, i, deleted

          deleted = False
          n = findline(num) ' see function for details

          if n < 0 then     ' replace line
              n = abs(n)
              ' if just a number, delete that line
              if textp > len(pgm[0]) then
                for i = n to hi_index - 1
                  pgm[i] = pgm[i + 1]
                next i
                hi_index -= 1
                deleted = True
              end if
          elseif n > 0 then ' insert line
              for i = hi_index + 1 to n step -1
                  pgm[i] = pgm[i - 1]
              next i
              hi_index += 1
          else              ' append
              hi_index += 1
              n = hi_index
          end if

          if not deleted then pgm[n] = pgm[0]
        end if
      end if
    end if
  loop
end sub

function getarg() as string ' skip over program name and return any arguments
  string st = ltrim(rtrim(GetCommandLine()))
  int p = instr(st, " ")    ' space delimiter?
  if p < 1 then return ""   ' nope no arguments
  return ltrim(mid(st, p + 1))   ' everything after the program name
end function

sub docmd   ' main command loop
  dim as long need_colon
  do while not errors
    if tracing and left(tok, 1) <> ":" then print idxtoline(curline) + " " + tok + thech + mid(thelin, textp) + cr
    need_colon = False
    select
    case tok = "bye" or tok = "quit" : call nexttok: ExitProcess(2)
    case tok = "end" or tok = "stop" : call nexttok: exit sub
    case tok = "load" or tok = "old" : call nexttok: call loadstmt: exit sub
    case tok = "new"         : call nexttok: call newstmt:  exit sub
    case tok = "gosub"       : call nexttok: call gosubstmt
    case tok = "goto"        : call nexttok: call gotostmt
    case tok = "if"          : call nexttok: call ifstmt
    case tok = "next"        : call nexttok: call nextstmt    ' colon checked in rtn
    case tok = "return"      : call nexttok: call returnstmt  ' colon checked in rtn
    case tok = "run"         : call nexttok: call runstmt
    case tok = "clear"       : call nexttok: call clearstmt  :need_colon = True
    case tok = "cls"         : call nexttok: cls             :need_colon = True
    case tok = "for"         : call nexttok: call forstmt    :need_colon = True
    case tok = "help"        : call nexttok: call help       :need_colon = True
    case tok = "input"       : call nexttok: call inputstmt  :need_colon = True
    case tok = "list"        : call nexttok: call liststmt   :need_colon = True
    case tok = "print" or tok = "?" : call nexttok: call printstmt  :need_colon = True
    case tok = "save"        : call nexttok: call savestmt   :need_colon = True
    case tok = "troff"       : call nexttok: tracing = False :need_colon = True
    case tok = "tron"        : call nexttok: tracing = True  :need_colon = True
    case tok = ":" or tok = "" : call nexttok
    case else
        if tok = "let" then call nexttok
        if toktype = c_ident then
          call assign
        elseif tok = "@" then
          call nexttok: call arrassn
        else
          print "Unknown token '"; tok; "' at line:"; idxtoline(curline); " Col:"; textp; " : "; thelin: errors = True
        end if
    end select

    if tok = "" then
      while tok = "" and not errors
        if curline = 0 or curline >= hi_index then
          errors = True
        else
          call initlex(curline + 1)
        end if
      wend
    elseif need_colon and not accept(":") then
      print ": expected but found: " + tok + cr: errors = True
    end if
  loop
end sub

sub help  ' I get by with a little help from my friends!
   print "Tiny Basic (O2)"                                                        + cr
   print ""                                                                       + cr
   print "  bye, clear, cls, end/stop, help, list, load/save, new, run, tron/off" + cr
   print "  for <var> = <expr1> to <expr2> ... next <var>                       " + cr
   print "  gosub <expr> ... return                                             " + cr
   print "  goto <expr>                                                         " + cr
   print "  if <expr> then <statement>                                          " + cr
   print "  input [prompt,] <var>                                               " + cr
   print "  <var>=<expr>                                                        " + cr
   print "  print <expr|string>[,<expr|string>][;]                              " + cr
   print "  rem <anystring>  or ' <anystring>                                   " + cr
   print "  Operators: ^, * / \ mod + - < <= > >= = <>, not, and, or            " + cr
   print "  Integer variables a..z, and array @(expr)                           " + cr
   print "  Functions: abs(expr), asc(ch), rnd(expr), sgn(expr)                 " + cr
   print ""                                                                       + cr
end sub

sub assign  ' ident = expr
  dim as long xvar
  xvar = getvarindex: call nexttok
  call expect("=")
  vars[xvar] = expression(0)
  if tracing then print "*** " + chr(xvar + asc("a")) + " = " + vars[xvar] + cr
end sub

sub arrassn   ' array assignment: @(expr) = expr
  dim as long atndx
  atndx = parenexpr
  call expect("=")
  atarry[atndx] = expression(0)
  if tracing then print "*** @(" + atndx + ") = " + atarry[atndx] + cr
end sub

sub clearstmt ' clear all variables
  dim as long i
  for i = 1 to c_maxvars
    vars[i] = 0
  next i
  for i = 0 to c_at_max
    atarry[i] = 0
  next i
  gsp = 0
end sub

sub forstmt   ' for i = expr to expr
  dim as long xvar, forndx

  xvar = getvarindex
  call assign
  ' vars[xvar] has the value; xvar has the number value of the variable in 0..25
  forndx = xvar
  forvar[forndx] = vars[xvar]
  if tok <> "to" then
    print "For: Expecting 'to', found:" + tok + cr: errors = True
  else
    call nexttok
    forlimit[forndx] = expression(0)
    ' need to store iter, limit, line, and col
    forline[forndx] = curline
    if tok = "" then forpos[forndx] = textp else forpos[forndx] = textp - 1
  end if
end sub

sub gosubstmt   ' gosub expr: for gosub: save the line and column
  gsp += 1
  num = expression(0)
  gstackln[gsp] = curline
  if tok = "" then gstacktp[gsp] = textp else gstacktp[gsp] = textp - 1
  call go(num, "gosub")
end sub

sub gotostmt  ' goto expr
  num = expression(0)
  call go(num, "goto")
end sub

sub ifstmt  ' if expr [then] {stmt} {: stmt}
  if expression(0) = 0 then call skiptoeol: exit sub
  if tok = "then" then call nexttok
  if toktype = c_number then call gotostmt
end sub

sub inputstmt   ' "input" [string ","] xvar
  dim as long xvar
  dim as string st
  if toktype = c_string then
    print mid(tok, 2)
    call nexttok
    call expect(",")
  else
    print "? "
  end if
  xvar = getvarindex: call nexttok
  st = rtrim(input())
  if st = "" then st = "0"
  if (left(st, 1) >= "0" and left(st, 1) <= "9") or left(st, 1) = "-" then
    vars[xvar] = val(st)
  else
    vars[xvar] = asc(st)
  end if
end sub

sub liststmt  ' show the current program
  dim as long i
  for i = 1 to hi_index
    print pgm[i] + cr
  next i
  print
end sub

sub loadstmt  ' load ["string"]
  dim as string filename, src, s
  dim as long start, pos

  filename = getfilename("Load")
  if filename = "" then exit sub
  call newstmt
  getfile(filename, src)
  if len(src) = 0 then return

  start = 1
  do
    pos = instr(start, src, chr(13))
    if pos <= 0 then exit do
    hi_index += 1
    pgm[hi_index] = mid(src, start, pos - start)
    start = pos + 1
    if mid(src, start, 1) = chr(10) then start += 1
  loop
  ' handle unterminated lines
  if start <= len(src) then
    hi_index += 1
    pgm[hi_index] = mid(src, start)
  end if

  curline = 1
end sub

sub newstmt ' clears program and variable store
  dim as long i
  call clearstmt
  for i = 1 to c_maxlines
    pgm[i] = ""
  next i
  hi_index = 0
end sub

sub nextstmt  ' next ident - ident is required
  dim as long forndx

  ' 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 ' skip the ident for now
    if tok <> "" and tok <> ":" then
      print "Next: expected ':' before statement, but found:" + tok + cr: errors = True
    end if
  end if
end sub

' "print" [[#num "," ] expr { "," [#num ","] expr }] [","] {":" stmt} eol
' expr can also be a literal string
sub printstmt
  dim as long printnl, printwidth, n
  dim as string junk

  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 + cr: exit sub
      printwidth = num
      call nexttok
      if not accept(",") then print "Print: Expecting a ',', found:" + tok + cr: exit sub
    end if

    if toktype = c_string then
      junk = mid(tok, 2)
      call nexttok
    elseif toktype = c_ident and tok = "chr" and thech = "" then
        textp += 1 ' consume
        call nexttok      ' get (
        n = parenexpr
        junk = chr(n)
    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 cr
end sub

sub returnstmt ' exit from a subroutine
  curline = gstackln[gsp]
  textp   = gstacktp[gsp]
  gsp -= 1
  call initlex2
  if tok <> "" and tok <> ":" then
    print "Return: expected ':' before statement, but found:" + tok + cr: errors = True
  end if
end sub

sub runstmt ' run ["string"]
  call clearstmt
  if toktype = c_string then call loadstmt
  call initlex(1)
end sub

sub savestmt ' save ["string"]
  long i
  string filename, buf

  filename = getfilename("Save")
  if filename = "" then exit sub

  buf = ""
  for i = 1 to hi_Index
    if pgm[i] <> "" then buf += pgm[i] + cr
  next i
  putfile(filename, buf)
end sub

sub go(n as long, s as string)  ' transfer control to line n
  dim as long i

  if validlinenum then
    i = findline(n)
    if i < 0 then
      call initlex(abs(i))
    else
      print s + " target not found: " + n + cr: errors = True
    end if
  end if
end sub

' find the goal line
' found exact match, return -i
' found first greater, return i
' else goal is > all,  0
function findline(goal as long) as long
    dim as long lo, hi, closest, i, aline

    aline = idxtoline(hi_index)
    if toktype = c_number and goal > aline then return 0

    lo = 1
    hi = hi_index

    while lo <= hi
        i = lo + int((hi - lo) \ 2)
        aline = idxtoline(i)
        if aline = goal then
            return -i
        elseif aline < goal then
            closest = i
            lo = i + 1
        else
            hi = i - 1
        end if
    wend

    i = closest + 1
    while i <= hi_index
        call initlex(i)
        if aline < goal then
            i += 1
        else
            closest = i
            exit while
        end if
    wend

    return closest
end function

function getfilename(action as string) as string  ' if tok is a string use it, otherwise, prompt
  dim as string filename
  if toktype = c_string then
    filename = mid(tok, 2)
    call nexttok
  else
    print action + ": "
    filename = rtrim(input())
  end if
  if filename <> "" then
    if instr(filename, ".") = 0 then filename = filename + ".bas"
  end if
  return filename
end function

function validlinenum() as long ' make sure line number is in range
  if num <= 0 then print "Line number out of range" + cr: errors = True: return False
  return True
end function

function random(long n) as long
  static long seed = 123456789

  seed = seed * 8121 + 28411
  return (seed & 2147483647) mod n
end function

function parenexpr() as long
  long n
  call expect("("): if errors then return 0
  n = expression(0)
  call expect(")")
  return n
end function

function expression(minprec as long) as long
  long n, n2

  ' handle numeric operands - numbers and unary operators
  select
  case toktype = c_number : n = num: call nexttok
  case tok = "("   : n =  parenexpr
  case tok = "not" : call nexttok: n = (expression(3) = 0)
  case tok = "abs" : call nexttok: n = abs(parenexpr)
  case tok = "asc" : call nexttok: call expect("("): n = asc(mid(tok, 2, 1)): call nexttok: call expect(")")
  case tok = "rnd" or tok = "irnd" : call nexttok: n = parenexpr(): n = random(n) + 1
  case tok = "sgn" : call nexttok: n = sgn(parenexpr)
  case toktype = c_ident : n = vars[getvarindex]: call nexttok
  case tok = "@"   : call nexttok: n = parenexpr: n = atarry[n]
  case tok = "-"   : call nexttok: n = -expression(7)
  case tok = "+"   : call nexttok: n =  expression(7)
  case else : print "(" + idxtoline(curline) + ") syntax error: expecting an operand, found: " + tok + cr: errors = True: return 0
  end select

  do  ' while binary operator and precedence of tok >= minprec
    select
    case minprec <= 1 and tok = "or"  : call nexttok: n2 = expression(2): n = n or n2
    case minprec <= 2 and tok = "and" : call nexttok: n2 = expression(3): n = n and n2
    case minprec <= 4 and tok = "="   : call nexttok: n = abs(n = expression(5))
    case minprec <= 4 and tok = "<"   : call nexttok: n = abs(n < expression(5))
    case minprec <= 4 and tok = ">"   : call nexttok: n = abs(n > expression(5))
    case minprec <= 4 and tok = "<>"  : call nexttok: n = abs(n <> expression(5))
    case minprec <= 4 and tok = "<="  : call nexttok: n = abs(n <= expression(5))
    case minprec <= 4 and tok = ">="  : call nexttok: n = abs(n >= expression(5))
    case minprec <= 5 and tok = "+"   : call nexttok: n += expression(6)
    case minprec <= 5 and tok = "-"   : call nexttok: n -= expression(6)
    case minprec <= 6 and tok = "*"   : call nexttok: n = n * expression(7)
    case minprec <= 6 and (tok = "/" or tok = "\") : call nexttok: n = (n \ expression(7))
    case minprec <= 6 and tok = "mod" : call nexttok: n = (n mod expression(7))
    case minprec <= 8 and tok = "^"   : call nexttok: n = (n ^ expression(9))
    case else : exit do
    end select
  loop

  return n
end function

function getvarindex() as long ' return the index in var store, in 0..25
  if toktype <> c_ident then print "(" + idxtoline(curline) + ") Not a variable:" + tok + cr: return True
  return asc(left(tok, 1)) - asc("a")
end function

sub expect(s as string)
  if not accept(s) then
    print "(" + idxtoline(curline) + ") expecting " + s + " but found " + tok + " =>" + pgm[curline] + cr: errors = True
  end if
end sub

function accept(s as string) as long
  if tok = s then call nexttok: return True else return False
end function

sub initlex(n as long)  ' if not line 0, skip the line number
  curline = n: textp = 1
  call initlex2
  if n <> 0 and toktype = c_number then call nexttok
end sub

sub initlex2  ' entry point to continue where we left off
  thelin = pgm[curline]
  call nexttok
end sub

sub nexttok
  tok = "": toktype = c_default: thech = ""
  do while textp <= len(thelin)
    thech = mid(thelin, textp, 1)
    select case toktype
      case c_default
        if 0 then '
        elseif thech <= " " then:     rem just skip space, cf, lf
        elseif isalpha(thech) then:   toktype = c_ident
        elseif isdigit(thech) then:   toktype = c_number
        elseif ispunct(thech) then:   toktype = c_punct
        elseif thech = c_dquote then: toktype = c_string
        elseif thech = c_squote then: call skiptoeol: exit sub
        else: print "(" + idxtoline(curline) + "," + textp + ") " + "What>" + tok + "< " + thelin + cr: errors = True: exit sub
        end if
      case c_ident:  if not isalpha(thech) then exit do
      case c_number: if not isdigit(thech) then exit do
      case c_string: if thech = c_dquote then textp += 1: exit sub
      case c_punct
        if (tok = "<" and (thech = ">" or thech = "=")) or (tok = ">" and thech = "=") then
          tok += thech
          textp += 1
        end if
        exit sub
    end select
    if toktype <> c_default then tok += thech
    textp += 1
  loop
  if toktype = c_number then num = val(tok)
  if toktype = c_string then print "String not terminated" + cr: errors = True
  if toktype = c_ident then
    tok = lcase(tok)
    if tok = "rem" then call skiptoeol
  end if
end sub

sub skiptoeol
  tok = "": toktype = c_default
  textp = len(thelin) + 1
end sub

function isdigit(c as string) as bool {return (c >= "0" and c <= "9") or (c = ".")}
function isalpha(c as string) as bool {return (c >= "a" and c <= "z") or (c >= "A" and c <= "Z")}
function ispunct(c as string) as bool {return instr(",#()*+-/:;<=>?@\^", c) > 0}

function idxtoline(n as long)  as long ' return the line number at line n
  dim as string s
  dim as long p
  s = ltrim(pgm[n])
  p = instr(s, " ")
  if p <= 0 then return val(s) else return val(left(s, p - 1))
end function
