ASCII-World

''' TinyBASIC, by Nicholas Christopoulos
'' A SmallBASIC example :)

DIM variables(26) '' variables (one for each letter)
DIM stack(10) '' executor''s stack (GOSUB/FOR-NEXT/WHILE-WEND)
DIM labels(), program()

DEF varidx(name) = asc(left(name))-65

ip = -1 '' next command to execute (-1 = none, -2 = error)
sp = 0 '' stack pointer

CLS
print cat(2);"TinyBASIC v1";cat(-2)
print "A 450-line (with expression parser) SmallBASIC example"
print
print "Type HELP for catalog."
print "Type QUIT to exit..."
print
print "READY"
print

repeat
input "> ", inpstr
inpstr = trim(upper(inpstr))
cmd = trim(leftof(inpstr+" ", " ")) '' get command name
if len(cmd)
par = trim(rightof(inpstr, " "))
if isnumber(cmd) '' store command
addcmd val(cmd), par
else '' execute command
execute cmd, par
fi
fi
until cmd="QUIT"
end

'' Store command to memory
sub addcmd(num, cmd)
local i, ins, rep

ins = len(labels): rep = -1
for i = 0 to len(labels)-1
if labels(i) = num then rep=i:exit
if labels(i) > num then ins=i:exit
next
if rep = -1 '' new record
if len(cmd) '' no error, insert (or append)
insert labels, ins, num
insert program, ins, cmd
fi
else
if len(cmd) '' replace
program(rep) = cmd
else '' erase
delete labels, rep
delete program, rep
fi
fi
end

'' set value to a variable
sub setvar(varname, varval)
local idx

if len(varname)>1
TBError "ILLEGAL VARIABLES NAME, USE ONE-CHAR NAMES"
else
idx = varidx(varname)
varval = trim(varval)
if left(varvar) = chr(34) '' it is a string
variables(idx) = disclose(varval)
else '' it is an expression
variables(idx) = tbeval(varval)
fi
fi
end

'' execute a TB command
sub execute(cmd, par)
local idx, i, var, vstr
local parA, tstr, fstr, f, num

if cmd in ["END", "NEW"]
'' new program or end of program; syntax: NEW or END
ip = -1
sp = 0
if cmd="NEW"
erase labels, commands '' clear program
dim variables(26) '' clear variables
print:print "* DONE *":print
fi
elif cmd in ["QUIT", "REM"]
'' do nothing
elif cmd="LET"
'' assigns a value to a variable; syntax: LET variable = expression
sinput par; var, "=", vstr
setvar var, vstr
elif cmd="LIST"
'' prints the program, syntax: LIST
if len(labels)
for i=0 to len(labels)-1
print using "####: &"; labels(i); program(i)
next
else
TBError "NO PROGRAM IN MEMORY"
fi
elif cmd="RUN"
'' run the program, syntax: RUN
ip = 0
while ip<len(labels)
last_ip = ip

cmd = trim(leftof(program(ip)+" ", " "))
par = trim(rightof(program(ip), " "))
execute cmd, par

if ip = -2
print "* ERROR AT ";labels(last_ip);" *"
sp = 0
exit
elif ip = -1
print:print "* DONE *":print
sp = 0
exit
else
ip = ip + 1
fi
wend
elif cmd="INPUT"
'' get a value form console, syntax: INPUT [prompt,] variable
split par, ",", para, chr(34)+chr(34) use trim(x)
if len(para) = 0
ip = -2
else
if len(para) = 2
idx = 1
input disclose(para(i)); vstr
else
idx = 0
input "? ", vstr
fi
setvar para(idx), vstr
fi
elif cmd="PRINT"
'' print to console, syntax: PRINT [var1 [, varN]]
split par, ",", para, chr(34)+chr(34)+"()" use trim(x)
for vstr in para
if left(vstr)=chr(34) '' print string
print disclose(vstr); " ";
else '' print number (expression)
print tbeval(vstr); " ";
fi
next
print
elif cmd in ["GOTO", "GOSUB"]
'' Syntax: GOTO line or GOSUB line
search labels, val(par), idx
if idx = -1
TBError "LABEL "+par+" DOES NOT EXIST"
else
if cmd="GOSUB"
stack(sp) = ["R", ip] '' "R" = a ''return'' command  must read it
sp = sp + 1
fi
ip = idx-1
fi
elif cmd="RETURN"
'' syntax: RETURN
if sp > 0
sp = sp - 1
if stack(sp)(0) = "R" '' later you can add code for FOR and WHILE
ip = stack(sp)(1)
else
TBError "STACK MESS"
fi
else
TBError "STACK UNDERFLOW"
fi
elif cmd="IF"
'' IF! what else?. Syntax: IF expression THEN line [ ELSE line ]
sinput par; vstr, " THEN ", tstr, " ELSE ", fstr
if tbeval(vstr)
execute "GOTO",tstr
elif len(fstr)
execute "GOTO",fstr
fi
elif cmd="SAVE"
f=disclose(par)
if len(f)=0
TBError "MISSING: FILENAME"
else
if isarray(labels)
if instr(f, ".TBAS")=0 THEN f=f+".tbas" ELSE f=leftoflast(f, ".TBAS")+".tbas"
open f for output as #1
for i=0 to len(labels)-1
print #1; labels(i); " "; program(i)
next
close #1
print:print "* DONE *":print
else
TBError "NO PROGRAM IN MEMORY"
fi
fi
elif cmd="LOAD"
f=disclose(par)
if len(f)=0
TBError "MISSING: FILENAME"
else
ip = -1
sp = 0
erase labels, commands '' clear program
dim variables(26) '' clear variables
if instr(f, ".TBAS")=0 THEN f=f+".tbas" ELSE f=leftoflast(f, ".TBAS")+".tbas"
open f for input as #1
while not eof(1)
line input #1; vstr
num  = leftof (vstr, " ")
par  = rightof(vstr, " ")
addcmd val(num), par
wend
close #1
print:print "* DONE *":print
fi
elif cmd="FILES"
print files("*.tbas")
elif cmd="HELP"
PRINT
print "  ";cat(2);"TinyBASIC, v1";cat(-2)
PRINT
print "  * All variables are real numbers."
print "  * There are 26 variables, one for each letter"
print "  * INPUT return real number (not string)"
print "  * IF-THEN accepts only line-numbers (IF x THEN line ELSE line)"
print "  * PRINT uses only , as separator"
PRINT
print "  HELP";tab(15);"This screen"
print "  NEW";tab(15);"New program"
print "  RUN";tab(15);"Run program"
print "  LIST";tab(15);"Prints program to screen"
print "  SAVE";tab(15);"Saves program to disk"
print "  LOAD";tab(15);"Loads a program from disk"
print "  FILES";tab(15);"Prints the list of TB programs"
print "  REM";tab(15);"Remarks"
print "  GOTO";tab(15);"Transfers control to ..."
print "  LET";tab(15);"Assigns a value to a variable"
print "  PRINT";tab(15);"Prints an expression"
print "  INPUT";tab(15);"Inputs a value"
print "  IF";tab(15);" "
print "  GOSUB";tab(15);" "
print "  RETURN";tab(15);" "
print "  END";tab(15);"Terminate the program"
PRINT
else
TBError "BAD COMMAND"
fi
end

'' Run-time error
sub TBError(errmsg)
PRINT
print chr(7);"* ";errmsg;" *"
PRINT
ip = -2
end

'' ==== expression parser ====

'' evaluate an expression
def TBEval(expr)
local result, rmn, c

result = 0
expr = ltrim(expr)
if len(expr) then logical result, expr
TBEval = result
end

'' number
def valueof(byref expr)
local c, i, v

for i=1 to len(expr)
c = mid(expr, i, 1)
if not (c in "0123456789.") then exit
next
if i < len(expr)
v = left(expr, i-1)
expr = mid(expr, i)
else
v = expr
expr = ""
fi
valueof = val(v)
end

'' operators: ( ) or value
sub parenth(byref l, byref expr)
local op, vname

op = left(expr)
if op = "("
expr = mid(expr, 2)
logical l, expr
if left(expr)=")" then expr = mid(expr, 2)
else
if op in "0123456789."
l = valueof(expr)
'' elif, check for function
else '' variable
l = variables(varidx(expr))
expr = if(len(expr)>1, mid(expr, 2), "")
fi
fi
end

'' unary operators: - + NOT
sub unary(byref l, byref expr)
local op

if left(expr,3) = "NOT"
op="NOT"
expr = mid(expr,4)
elif left(expr,1) in ["-", "+"]
op=left(expr)
expr=mid(expr,2)
fi
parenth l, expr
if op="NOT"
l = NOT l
elif op="-"
l = -l
elif op="+"
'' ignore it
fi
end

'' operators: * /
sub muldiv(byref l, byref expr)
local op, r

unary l, expr
while left(expr) in "*/"
op = left(expr)
expr = mid(expr, 2)
unary r, expr
if op = "*"
l *= r
elif op = "/"
if r=0
TBError "DIVISION BY ZERO"
else
l /= r
fi
fi
wend
end

'' operators: + -
sub addsub(byref l, byref expr)
local op, r

muldiv l, expr
while left(expr) in "+-"
op = left(expr)
expr = mid(expr, 2)
muldiv r, expr
if op = "+"
l += r
elif op = "-"
l -= r
fi
wend
end

'' returns the logical operator
func getlogopr(expr)
local idx, op3, op2, op1

op3=["AND"]
op2=["OR", "<=", ">=", "=<", "=>", "<>"]
op1=["=", ">", "<"]
search op3, left(expr,3), idx
if idx >= 0 then getlogopr=op3(idx):exit
search op2, left(expr,2), idx
if idx >= 0 then getlogopr=op2(idx):exit
search op1, left(expr,1), idx
if idx >= 0 then getlogopr=op1(idx):exit
getlogopr=""
end

'' logical and comparation operators
sub logical(byref l, byref expr)
local op, r

addsub l, expr
while getlogopr(expr) <> ""
op = getlogopr(expr)
expr = mid(expr, len(op)+1)
addsub r, expr
if op = "AND"
l = l AND r
elif op = "OR"
l = l OR r
elif op = "="
l = (l = r)
elif op = "<"
l = l < r
elif op = ">"
l = l > r
elif op = ">=" or op = "=>"
l = l >= r
elif op = "<=" or op = "=<"
l = l <= r
elif op = "<>"
l = l <> r
fi
wend
end
'