Author Topic: QBASIC/QB64 subset interpreter  (Read 777 times)

0 Members and 1 Guest are viewing this topic.

Offline Ed Davis

  • Newbie
  • Posts: 34
QBASIC/QB64 subset interpreter
« on: July 03, 2021, 03:03:26 PM »
QBASIC/QB64 subset interpreter by Ed Davis.
----------------------------------------------------------------------------------
Currently supports:

Double and string variables only. No dim for these.
One or two dimensional arrays.
All standard operators, with hopefully the correct precedence.

String operators:
+
=, <>, <, >, <=, >=


Numeric binary operators
^,
*, /
\
mod,
+, -,
shl,<<, shr,>>
=, <>, <, >, <=, >=,
and,
or,
xor,
eqv,
imp,

Numeric unary operators
not, -, +

Commands supported:

bye, quit - exits the interpreter
clear     - clears variables
dump      - shows info about arrays
edit      - edits the current or default program
files     - shows a list of files
help      - simple help screen
list      - lists current program
list vars - iists variables
load, old - loads a program into the interpreter
new       - discards the current program
reload    - reloads the current program from disk
run       - runs the current program
save      - saves the current program
ston      - turns stepping on
stoff     - turns stepping off
tron      - turns tracing on
troff     - turns tracing off

Statements:

Iteration:
  do [while|until]
    stmts
  loop

  or

  do
    stmts
  loop [while|until]

  exit do

  while stmts wend - exit while

  for index = n to expr [step n]
  next

  exit for

Control transfer:
  gosub, return
  goto - buggy if you jump outside of loops or multiline if

Selection:
singleline or multiline if
  if elseif else end if

const - declare numeric or string constants

dim - declares double or string arrays

end, stop, system - exits program to interpreter

Other commands:

chdir circle cls color draw environ input line locate mid$ paint
palette play preset print, ? pset randomize rem screen shell
sleep sound swap view width window

QB64 commands:

_delay _display _freeimage _fullscreen _limit _printstring
_screenmove _title

Numeric functions:

abs acos acosh acot acoth acsc acsch asc asec asech asin asinh
atanh atn, atan cdbl cint clng cos cosh cot coth csc csch csng
csrlin cvd cvi exp false frac fix instr int len ln log log10 peek
point pos rnd screen sec sech sgn sin sinh sqr, sqrt tan tanh
timer true ubound val

QB64 Numeric functions:

_atan2 _ceil _d2g _d2r _fontwidth _fontheight _g2d _g2r _height
_instrrev _keydown _keyhit _mousebutton _mouseinput _mousex
_mousey _newimage _pi _r2d _r2g _rgb _rgba _rgba32 _rgb32 _round
_width

String Functions:

chr$ command$ date$ environ$ hex$ inkey$ lcase$ left$" lpad$
ltrim$ mid$ mki$ oct$ replace$ right$ rpad$ rtrim$ space$ str$
string$ time$ trim$ ucase$

QB64 string functions:

_clipboard$ _cwd$ _os$ _startdir$ _title$ _trim$

No other numeric data types besides double. Only suffix accepted is $ for strings.
Only one or two dimensional arrays
No subs or functions.
No dim.
Lots of other stuff missing.

You can run a single line of code at the ">" prompt:

>n=1:lim=25:while n<=lim:k=3:p=1:n=n+2:while k*k<=n and p:p=(n\k)*k<>n:k=k+2:wend:while p:print n; " is prime":exit while:wend:wend

You'll get:

  3 is prime
  5 is prime
  7 is prime
  11 is prime
  13 is prime
  17 is prime
  19 is prime
  23 is prime

Or you can just use it as a fancy calculator:

>3 + 4/(2*3*4) - 4/(4*5*6) + 4/(6*7*8) - 4/(8*9*10) + 4/(10*11*12) - 4/(12*13*14)
3.1408

To run an example:

Start the interpreter

You'll get a prompt.  type:  run filename
For example:

>run matrix.bas

Or:

>load matrix.bas
>run

To edit a program, type "edit".  If no program is loaded, it will edit "default.bas".
It uses notepad.exe by default, unless the EDITOR environment variable is defined, in which case it will use whatever that points to.

You can single step:

>load matrix.bas
>tron
>ston
>run

Press enter to keep on stepping

After a run, you can show variables:

>list vars

I'm sure there are lots of bugs^H^H^H^Hfeatures, so beware!

The interpreter:
Code: QB64: [Select]
  1. ' QBASIC/QB64 subset interpreter by Ed Davis.
  2. ' ------------------------------------------------------------------------------------------
  3.  
  4.  
  5. '------------------------------------------------------------------------
  6. '  03 Jul 2021 todo
  7. '  [x] store/retrieve variables like eval-ed4
  8. '  [x] const id[$] = number|string {, const id[$] = number|string}
  9. '  [ ] consolidate loop handling data structures
  10. '  [x] arrays
  11. '      [x]  parse
  12. '      [x]  allocate 1 dimensional
  13. '      [x]  allocate 2 dimensional
  14. '      [x]  assign (idstmt, stridstmt)
  15. '      [x]  reference (strfactor, primary)
  16. '  [ ] Subs
  17. '  [ ] Functions
  18. '  [ ] Shared variables
  19. '  getvarindex& (getstrindex$), used in:
  20. '  forstmt:    to reference the "i" variable
  21. '  inputstmt:  to reference the "input" variable: input "", numeric_store(i)
  22. '  swapstmt:   reference: swap(numeric_store(i1), numeric_store(i2))
  23. '  assignment: numeric_store(i) = value
  24. '  primary:    primary# = numeric_store(i)
  25. 'idstmt (stridstmt) - only called by assignment
  26. '------------------------------------------------------------------------
  27. ' Currently supports:
  28. '
  29. ' Double and string variables only. No dim for these.
  30. ' One or two dimensional arrays.
  31. ' All standard operators, with hopefully the correct precedence.
  32. '
  33. ' String operators:
  34. ' +
  35. ' =, <>, <, >, <=, >=
  36. '
  37. '
  38. ' Numeric binary operators
  39. ' ^,
  40. ' *, /
  41. ' \
  42. ' mod,
  43. ' +, -,
  44. ' shl,<<, shr,>>
  45. ' =, <>, <, >, <=, >=,
  46. ' and,
  47. ' or,
  48. ' xor,
  49. ' eqv,
  50. ' imp,
  51. '
  52. ' Numeric unary operators
  53. ' not, -, +
  54. '
  55. ' Commands supported:
  56. '
  57. ' bye, quit - exits the interpreter
  58. ' clear     - clears variables
  59. ' dump      - shows info about arrays
  60. ' edit      - edits the current or default program
  61. ' files     - shows a list of files
  62. ' help      - simple help screen
  63. ' list      - lists current program
  64. ' list vars - iists variables
  65. ' load, old - loads a program into the interpreter
  66. ' new       - discards the current program
  67. ' reload    - reloads the current program from disk
  68. ' run       - runs the current program
  69. ' save      - saves the current program
  70. ' ston      - turns stepping on
  71. ' stoff     - turns stepping off
  72. ' tron      - turns tracing on
  73. ' troff     - turns tracing off
  74. '
  75. ' Statements:
  76. '
  77. ' Iteration:
  78. '   do [while|until]
  79. '     stmts
  80. '   loop
  81. '
  82. '   or
  83. '
  84. '   do
  85. '     stmts
  86. '   loop [while|until]
  87. '
  88. '   exit do
  89. '
  90. '   while stmts wend - exit while
  91. '
  92. '   for index = n to expr [step n]
  93. '   next
  94. '
  95. '   exit for
  96. '
  97. ' Control transfer:
  98. '   gosub, return
  99. '   goto - buggy if you jump outside of loops or multiline if
  100. '
  101. ' Selection:
  102. ' singleline or multiline if
  103. '   if elseif else end if
  104. '
  105. ' const - declare numeric or string constants
  106. '
  107. ' dim - declares double or string arrays
  108. '
  109. ' end, stop, system - exits program to interpreter
  110. '
  111. ' Other commands:
  112. '
  113. ' chdir circle cls color draw environ input line locate mid$ paint
  114. ' palette play preset print, ? pset randomize rem screen shell
  115. ' sleep sound swap view width window
  116. '
  117. ' QB64 commands:
  118. '
  119. ' _delay _display _freeimage _fullscreen _limit _printstring
  120. ' _screenmove _title
  121. '
  122. ' Numeric functions:
  123. '
  124. ' abs acos acosh acot acoth acsc acsch asc asec asech asin asinh
  125. ' atanh atn, atan cdbl cint clng cos cosh cot coth csc csch csng
  126. ' csrlin cvd cvi exp false frac fix instr int len ln log log10 peek
  127. ' point pos rnd screen sec sech sgn sin sinh sqr, sqrt tan tanh
  128. ' timer true ubound val
  129. '
  130. ' QB64 Numeric functions:
  131. '
  132. ' _atan2 _ceil _d2g _d2r _fontwidth _fontheight _g2d _g2r _height
  133. ' _instrrev _keydown _keyhit _mousebutton _mouseinput _mousex
  134. ' _mousey _newimage _pi _r2d _r2g _rgb _rgba _rgba32 _rgb32 _round
  135. ' _width
  136. '
  137. ' String Functions:
  138. '
  139. ' chr$ command$ date$ environ$ hex$ inkey$ lcase$ left$" lpad$
  140. ' ltrim$ mid$ mki$ oct$ replace$ right$ rpad$ rtrim$ space$ str$
  141. ' string$ time$ trim$ ucase$
  142. '
  143. ' QB64 string functions:
  144. '
  145. ' _clipboard$ _cwd$ _os$ _startdir$ _title$ _trim$
  146. '
  147. ' No other numeric data types besides double. Only suffix accepted is $ for strings.
  148. ' Only up to two dimensional arrays
  149. ' No subs or functions.
  150. ' No dim.
  151. ' Lots of other stuff missing.
  152. '------------------------------------------------------------------------------------------
  153.  
  154. declare function any_expr&(p as integer)
  155. declare function bool_expr&
  156. declare function numeric_expr#
  157. declare function numeric_expr2#(p as integer)
  158. declare function find_matching_else$
  159. declare function gettoeol$
  160. declare function instrfun&
  161. declare function is_multi_line_if&
  162. declare function is_stmt_end&
  163. declare function peek_ch$
  164. declare function pop_num#
  165. declare function pop_str$
  166. declare function primary#
  167. declare function storeline&
  168. declare function strexpression$
  169. declare function strfactor$
  170.  
  171. declare sub clearprog
  172. declare sub clearvars
  173. declare sub colorstmt
  174. declare sub docmd(interactive as integer)
  175. declare sub elsestmt
  176. declare sub endifstmt
  177. declare sub exitstmt
  178. declare sub expect(s as string)
  179. declare sub filesstmt
  180. declare sub find_matching_sline_if
  181. declare sub find_matching_pair(s1 as string, s2 as string)
  182. declare sub forstmt
  183. declare sub getsym
  184. declare sub gosubline(target as integer)
  185. declare sub gosubstmt
  186. declare sub gotoline(target as integer)
  187. declare sub gotostmt
  188. declare sub idstmt
  189. declare sub ifstmt
  190. declare sub initvars
  191. declare sub inputstmt
  192. declare sub lineinputstmt
  193. declare sub linestmt
  194. declare sub liststmt
  195. declare sub loadprog(fn as string)
  196. declare sub locatestmt
  197. declare sub midstmt
  198. declare sub multi_ifstmt(cond as integer)
  199. declare sub nextstmt
  200. declare sub printstmt
  201. declare sub randomizer
  202. declare sub returnstmt
  203. declare sub saveprog
  204. declare sub showhelp
  205. declare sub skiptoeol
  206. declare sub stridstmt
  207. declare sub validlinenum(n as integer)
  208. declare sub wendstmt
  209. declare sub whilestmt(first as integer)
  210.  
  211. const true = -1, false = 0
  212. const e         = 2.71828182845905
  213. const halfpi    = 1.5707963267949
  214. const pi        = 3.14159265358979
  215. const max_store = 512
  216. const varssize  = 64
  217. const stacksize = 512
  218. const pgmsize   = 3000
  219. const tyunknown=0, tyident=1, tystrident=2, tynum=3, tystring=4
  220. const left_side = 0, right_side = 1
  221.  
  222. dim shared the_ch as string    ' last char read from input
  223. dim shared sym as string       ' last symbol read
  224. dim shared symtype as integer  ' type of last symbol read
  225. dim shared the_num as double   ' last number read
  226. dim shared pgm(pgmsize) as string ' lines of text stored here
  227. dim shared curline as integer  ' number of current line in pgm
  228. dim shared thelin as string    ' text of current line
  229. dim shared textp as integer    ' positionn in thelin
  230. dim shared curr_filename as string
  231.  
  232. type do_loop_t
  233.   lline as integer
  234.   loff  as integer
  235.  
  236. ' do/while/for/if tracking
  237. dim shared loopvars(varssize) as integer, looplines(varssize) as integer
  238. dim shared loopmax(varssize) as double, loopstep(varssize) as double
  239. dim shared loopoff(varssize) as integer
  240. dim shared stackp as integer, loopp as integer
  241. dim shared gosubstack(stacksize) as integer, gosuboffstack(stacksize) as integer
  242. dim shared while_sp as integer, while_line(varssize) as integer, while_off(varssize) as integer
  243. dim shared do_sp as integer, do_loop(stacksize) as do_loop_t
  244. dim shared if_sp as integer, if_stack(stacksize) as integer
  245.  
  246. ' for arrays:  make sure the user specified index is between lo_bnd..hi_bnd inclusive
  247. ' then, computed index = v.index + user_index - v.lo_bnd
  248. type names_t
  249.     vname    as string
  250.     symtype  as integer ' variable name
  251.     index    as long    ' index into string table; numeric table; or string/numeric array table
  252.     is_const as integer
  253.     lo_bnd   as long
  254.     hi_bnd   as long
  255.     lo_bnd2  as long    ' only if 2 dimensional
  256.     hi_bnd2  as long    ' only if 2 dimensional
  257.     multi    as integer ' true if 2 dimensional
  258.     a_len    as long    ' non-zero if array
  259.     a_width  as long    ' used in computing index when 2 dimensional
  260.  
  261. ' variable names
  262. dim shared var_names(1 to max_store) as names_t, var_names_max as integer
  263.  
  264. ' string and numeric values
  265. dim shared string_store(1 to max_store) as string, str_store_max as integer
  266. dim shared numeric_store(1 to max_store) as double, num_store_max as integer
  267.  
  268. ' string and numeric arrays
  269. redim shared string_arr_store(0) as string: dim shared str_arr_stor_max as long
  270. redim shared numeric_arr_store(0) as double: dim shared num_arr_stor_max as long
  271.  
  272. ' used by expression parser
  273. dim shared str_stack(varssize) as string
  274. dim shared num_stack(varssize) as double
  275. dim shared str_st_ndx as integer, num_st_ndx as integer
  276.  
  277. dim shared endif_count as integer
  278. dim shared wend_count  as integer
  279. dim shared next_count  as integer
  280. dim shared loop_count  as integer
  281.  
  282. dim shared stepping as integer
  283. const right_assoc = 0, left_assoc = 1, unaryminus_prec = 13, unaryplus_prec = 13, unarynot_prec = 6
  284.  
  285. 'for performance timing
  286. 'dim shared scantime as double
  287. 'dim shared starttime as double
  288. 'dim shared nsyms as long
  289.  
  290. dim shared ctype_arr(255) as integer
  291. const ct_unknown=0, ct_alpha=1, ct_digit=2, ct_period=3, ct_punc1=4
  292. const ct_dquote=5, ct_squote=6, ct_amp=7, ct_lt=8, ct_gt=9
  293.  
  294. '---------------------------------------------------------------------------------------------------
  295. ' Listed here since I can not remember them:
  296. ' % = integer (16 bit)
  297. ' & = long    (32 bit)
  298. ' ! = single  (default)
  299. ' # = double
  300. ' $ = string
  301. '---------------------------------------------------------------------------------------------------
  302. ' Maybe add:
  303. ' min(x, x1, x2...), max(...), ave(...), sum(...)
  304. '#define floor(x) ((x*2.0-0.5)shr 1)
  305. '#define ceil(x) (-((-x*2.0-0.5)shr 1))
  306. '---------------------------------------------------------------------------------------------------
  307.  
  308. call init_scanner
  309. tracing = false
  310. stepping = false
  311.  
  312. str_st_ndx = 0
  313. num_st_ndx = 0
  314.  
  315. '------------------------------------------------------------------------
  316. ' main loop
  317. '------------------------------------------------------------------------
  318. dim cmd$
  319. quit = false
  320.  
  321. 'starttime = timer
  322. cmd$ = command$
  323. if command$(1) = "-t" then
  324.     cmd$ = ltrim$(rtrim$(mid$(command$, 4)))
  325.     if cmd$ <> "" then quit = true
  326.     _dest 0
  327.  
  328. if cmd$ <> "" then
  329.   pgm(0) = "run " + cmd$
  330.   call initgetsym(0, 1)
  331.   call docmd(false)
  332.   call showhelp
  333.  
  334. if quit then call showtime: if errors then system 1 else system
  335.  
  336.   line input "> ", pgm(0)
  337.   if pgm(0) <> "" then
  338.     call initgetsym(0, 1)
  339.     call docmd(true)
  340.   end if
  341.  
  342. ' show timings
  343. sub showtime
  344.   'dim total_time as double
  345.   'total_time = timer - starttime
  346.  
  347.   'print "Total time: "; total_time; " Scan time: "; scantime; " Parse time: "; total_time - scantime; " Symbols: "; nsyms
  348.   'sleep
  349.  
  350. function at_line$
  351.   at_line$ = "": if curline > 0 then at_line$ = "(" + str$(curline) + ")"
  352.  
  353. function rest_of_line$
  354.   rest_of_line$ = sym + " " + the_ch + " " + mid$(thelin, textp)
  355.  
  356. sub dump_tables
  357.  
  358.   print "name", "index", "lo", "hi", "len"
  359.   for i = 1 to var_names_max
  360.     print var_names(i).vname, var_names(i).index, var_names(i).lo_bnd, var_names(i).hi_bnd, var_names(i).a_len
  361.   next
  362.  
  363. '------------------------------------------------------------------------
  364. ' command processor
  365. '------------------------------------------------------------------------
  366. sub docmd(interactive as integer)
  367. 'print "docmd"
  368.   errors = false
  369.  
  370.   restart_loop:
  371.   stackp = 0    ' these were -1 ??? @review
  372.   loopp   = 0   ' these were -1 ??? @review
  373.   while_sp = 0
  374.   do_sp = 0
  375.   if_sp = 0
  376.  
  377.   do
  378.     loop_top:
  379.     if errors then exit sub
  380.     while sym = "" and curline > 0 and curline < pgmsize
  381.       call initgetsym(curline + 1, 1)
  382.     wend
  383.     if tracing then print "["; curline; "] "; sym; " "; the_ch; " "; ltrim$(mid$(thelin, textp))
  384.     if stepping then sleep
  385.     select case sym
  386.       case "":            exit sub
  387.       case "bye", "quit": call getsym: call showtime:  if errors then system 1 else system
  388.       case "clear":       call getsym: call clearvars: exit sub
  389.       case "edit":        call getsym: call editstmt:  exit sub
  390.       case "help":        call getsym: call showhelp:  exit sub
  391.       case "list":        call getsym: call liststmt:  exit sub
  392.       case "load", "old": call getsym: call loadprog(""):  exit sub
  393.       case "new":         call getsym: call initvars: call clearprog: tracing = false: exit sub
  394.       case "reload":      call getsym: call loadprog(curr_filename): exit sub
  395.       case "run":         call getsym: call runprog: interactive = false: goto restart_loop
  396.       case "save":        call getsym: call saveprog:  exit sub
  397.       case "stop", "end", "system": call getsym:       exit sub
  398.       case "dump":        call getsym: call dump_tables
  399.  
  400.       case "chdir":       call getsym: call chdircmd
  401.       case "circle":      call getsym: call circlestmt
  402.       case "cls":         call getsym: cls
  403.       case "color":       call getsym: call colorstmt
  404.       case "const":       call getsym: call conststmt
  405.       case "dim":         call getsym: call dimstmt
  406.       case "do":          call getsym: call dostmt(true)
  407.       case "draw":        call getsym: call drawstmt
  408.       case "else":        call getsym: call elsestmt
  409.       case "elseif":      call getsym: call elseifstmt
  410.       case "endif":       call getsym: call endifstmt
  411.       case "environ":     call getsym: call environstmt
  412.       case "exit":        call getsym: call exitstmt
  413.       case "for":         call getsym: call forstmt
  414.       case "gosub":       call getsym: call gosubstmt: goto loop_top
  415.       case "goto":        call getsym: call gotostmt:  goto loop_top
  416.       case "if":          call getsym: call ifstmt:    goto loop_top
  417.       case "input":       call getsym: call inputstmt
  418.       case "line":        call getsym: call lineinputstmt
  419.       case "loop":        call getsym: call loopstmt
  420.       case "locate":      call getsym: call locatestmt
  421.       case "mid$":        call getsym: call midstmt
  422.       case "next":        call getsym: call nextstmt
  423.       case "paint":       call getsym: call paintstmt
  424.       case "palette":     call getsym: call palettestmt
  425.       case "preset":      call getsym: call presetstmt
  426.       case "print", "?":  call getsym: call printstmt
  427.       case "pset":        call getsym: call psetstmt
  428.       case "randomize":   call getsym: call randomizer
  429.       case "rem", "'":    call getsym: call skiptoeol
  430.       case "return":      call getsym: call returnstmt: goto loop_top
  431.       case "screen":      call getsym: call screenstmt
  432.       case "shell":                    call shellstmt
  433.       case "sleep":       call getsym: call sleepstmt
  434.       case "swap":        call getsym: call swapstmt
  435.       case "view":        call getsym: call viewstmt
  436.       case "wend":        call getsym: call wendstmt
  437.       case "while":       call getsym: call whilestmt(true)
  438.       case "width":       call getsym: call widthstmt
  439.       case "window":      call getsym: call windowstmt
  440.  
  441.       case "files":       call getsym: call filesstmt
  442.       case "play":        call getsym: play strexpression$
  443.       case "sound":       call getsym: call soundstmt
  444.       case "_delay":      call getsym: _delay numeric_expr#
  445.       case "_display":    call getsym: _display
  446.       case "_freeimage":  call getsym: call freeimage
  447.       case "_fullscreen": call getsym: _fullscreen
  448.       case "_limit":      call getsym: call limitstmt
  449.       case "_printstring":call getsym: call printstringstmt
  450.       case "_screenmove": call getsym: call screenmovestmt
  451.       case "_title":      call getsym: call titlestmt
  452.  
  453.       case "troff": call getsym: tracing  = false
  454.       case "tron":  call getsym: tracing  = true
  455.       case "stoff": call getsym: stepping = false
  456.       case "ston":  call getsym: stepping = true
  457.  
  458.       ' need to account for:
  459.       '  - assignment
  460.       '    let ...
  461.       '    [str]ident = expression
  462.       '    [str]ident(expression [, expression]) = expression
  463.       '  - labels
  464.       '    ident:
  465.       '  - non-assignment, including labels
  466.       '
  467.       case else
  468.         if left$(sym, 1) = "_" then
  469.           print "Unknown command: "; sym: errors = true
  470.         elseif accept&("let") then
  471.           call assignment
  472.         elseif symtype = tyident or symtype = tystrident then
  473.           if peek_ch$ = "=" then
  474.             call assignment
  475.           elseif peek_ch$ = "(" and instr(mid$(pgm(curline), textp), "=") > 0 then
  476.             call array_assignment
  477.           elseif symtype = tyident and the_ch = ":" then
  478.             call getsym
  479.           elseif interactive then
  480.             call printstmt
  481.           elseif sym <> ":" and sym <> "" then
  482.             print at_line$; "Stmt expected, found:"; rest_of_line$: errors = true
  483.           end if
  484.         elseif interactive then
  485.           call printstmt
  486.         elseif sym <> ":" and sym <> "" then
  487.           print at_line$; "Stmt expected, found:"; rest_of_line$: errors = true
  488.         end if
  489.     end select
  490.  
  491.     if errors then
  492.       exit sub
  493.     elseif sym = ":" then
  494.       call getsym
  495.     elseif sym <> "else" and sym <> "" then
  496.       print at_line$; "Extra stmts:"; rest_of_line$: errors = true
  497.       print "symtype:"; symtype; " sym:"; sym; " ch:"; the_ch
  498.     end if
  499.   loop
  500.  
  501. '------------------------------------------------------------------------
  502. ' variable storage/retrieval
  503. '------------------------------------------------------------------------
  504.  
  505. ' find position of vname in var_names
  506. function find_vname&(vname as string)
  507.  
  508.   for i = 1 to var_names_max
  509.     if var_names(i).vname = vname then
  510.       find_vname& = i
  511.       exit function
  512.     end if
  513.   next
  514.  
  515.   find_vname& = 0
  516.  
  517. ' helper function for 2d arrays
  518. function ar_scale(i as long, lo as long)
  519.   ar_scale = i - (lo - 1)
  520.  
  521. ' get the index of "a" in either string_arr_store or numeric_arr_store
  522. ' pointing to: a(expr [, expr])
  523. function get_array_index&(ident as string)
  524.   dim i as integer, index as long, index2 as long, lo as long, lo2 as long
  525.   dim x as long
  526.  
  527.   call getsym
  528.   i = find_vname&(ident)
  529.   if i = 0 then print at_line$; "Array has not been declared: "; ident: errors = true: exit function
  530.   expect("(")
  531.   index = numeric_expr#
  532.  
  533.   if var_names(i).multi then
  534.     expect(",")
  535.     index2 = numeric_expr#
  536.   end if
  537.  
  538.   expect(")")
  539.   if var_names(i).a_len = 0 then
  540.     print at_line$; "'"; ident; "' is not declared as an array": errors = true: exit function
  541.   end if
  542.  
  543.   ' verfiy that the index is within range
  544.   if index < var_names(i).lo_bnd or index > var_names(i).hi_bnd then
  545.     print at_line$; "Index is out of range:"; index; "("; var_names(i).lo_bnd; ","; var_names(i).hi_bnd; ")": errors = true: exit function
  546.   end if
  547.   if var_names(i).multi then
  548.     if index2 < var_names(i).lo_bnd2 or index2 > var_names(i).hi_bnd2 then
  549.       print at_line$; "Index two is out of range:"; index2: errors = true: exit function
  550.     end if
  551.   end if
  552.  
  553.   ' compute the actual index
  554.   lo = var_names(i).lo_bnd
  555.   if var_names(i).multi then
  556.     lo2 = var_names(i).lo_bnd2
  557.     x = var_names(i).index + (var_names(i).a_width * (ar_scale(index2, lo2) - 1) + ar_scale(index, lo)) - 1
  558.   else
  559.     x = var_names(i).index + ar_scale(index, lo) - 1
  560.     'x = var_names(i).index + index - (var_names(i).lo_bnd - 1) - 1
  561.   end if
  562.   'print "index: "; x
  563.  
  564.   if tracing then print ident;"(";index;")[";x;"] =";
  565.   get_array_index& = x
  566.  
  567. ' primary: if var does not exist, create it.  Return the var store index
  568. ' sym is the numeric variable name
  569. function getvarindex&(side as integer)
  570.   dim i as integer, ident as string, ident_type as integer
  571.  
  572.   ident = sym: ident_type = symtype
  573.   call getsym
  574.  
  575.   if ident_type = tystrident then
  576.     print at_line$; "type mismatch": errors = true
  577.   elseif ident_type <> tyident then
  578.     print at_line$; "not a variable": errors = true
  579.   else
  580.     ' see if variable exists
  581.     i = find_vname&(ident)
  582.     if i > 0 then
  583.       getvarindex& = var_names(i).index
  584.       if side = left_side and var_names(i).is_const then print at_line$; "Cannot update const variable: "; ident: errors = true
  585.       exit function
  586.     end if
  587.  
  588.     'if side = right_side then print at_line$; "Reference to unassigned variable: "; ident: errors = true
  589.  
  590.     ' create a new variable
  591.     num_store_max = num_store_max + 1
  592.     var_names_max = var_names_max + 1
  593.  
  594.     var_names(var_names_max).vname   = ident
  595.     var_names(var_names_max).symtype = ident_type
  596.     var_names(var_names_max).index   = num_store_max
  597.     numeric_store(num_store_max)     = 0    ' default value
  598.  
  599.     getvarindex& = num_store_max
  600.   end if
  601.  
  602. function getstrindex&(side as integer)
  603.   dim i as integer, ident as string, ident_type as integer
  604.  
  605.   ident = sym: ident_type = symtype
  606.   call getsym
  607.  
  608.   if ident_type = tyident then
  609.     print at_line$; "type mismatch": errors = true
  610.   elseif ident_type <> tystrident then
  611.     print at_line$; "not a variable": errors = true
  612.   else
  613.     ' see if variable exists
  614.     i = find_vname&(ident)
  615.     if i > 0 then
  616.       getstrindex& = var_names(i).index
  617.       if side = left_side and var_names(i).is_const then print at_line$; "Cannot update const variable: "; ident: errors = true
  618.       exit function
  619.     end if
  620.  
  621.     'if side = right_side then print at_line$; "Reference to unassigned variable: "; ident: errors = true
  622.  
  623.     ' create a new variable
  624.     str_store_max = str_store_max + 1
  625.     var_names_max = var_names_max + 1
  626.  
  627.     var_names(var_names_max).vname   = ident
  628.     var_names(var_names_max).symtype = ident_type
  629.     var_names(var_names_max).index   = str_store_max
  630.     string_store(str_store_max)      = ""    ' default value
  631.  
  632.     getstrindex& = str_store_max
  633.   end if
  634.  
  635. ' a(expr)
  636. ' when called, sym pointing at the ident
  637. function get_numeric_array_value#
  638.   dim ident as string, ident_type as integer, x as long, n as double
  639.  
  640.   ident = sym: ident_type = symtype
  641.   x = get_array_index&(ident)
  642.   n = numeric_arr_store(x)
  643.   get_numeric_array_value# = n
  644.  
  645. ' a(expr)
  646. ' when called, sym pointing at the ident
  647. function get_string_array_value$
  648.   dim ident as string, ident_type as integer, x as long, s as string
  649.  
  650.   ident = sym: ident_type = symtype
  651.   x = get_array_index&(ident)
  652.   s = string_arr_store(x)
  653.   get_string_array_value$ = s
  654.  
  655. sub stridstmt
  656.   dim i as integer, vname as string
  657.  
  658.   vname = sym
  659.   'print "stridstmt"
  660.   i = getstrindex&(left_side)
  661.   expect("=")
  662.   string_store(i) = strexpression$
  663.   if tracing then print vname, string_store(i)
  664.  
  665. sub idstmt
  666.   dim i as integer, vname as string
  667.  
  668.   vname = sym
  669.   i = getvarindex&(left_side)
  670.   expect("=")
  671.   numeric_store(i) = numeric_expr#
  672.   if tracing then print vname, numeric_store(i)
  673.  
  674. ' ident = expression
  675. sub assignment
  676.   if symtype = tyident then
  677.     call idstmt
  678.   elseif symtype = tystrident then
  679.     call stridstmt
  680.   else
  681.     print at_line$; "Expecting assignment stmt, found: "; sym: errors = true
  682.   end if
  683.  
  684. ' ident(expression [, expression]) = expression
  685. sub array_assignment
  686.   dim ident as string, ident_type as integer
  687.   dim s as string, n as double, x as long
  688.  
  689.   ident = sym: ident_type = symtype
  690.   x = get_array_index&(ident)
  691.  
  692.   expect("=")
  693.  
  694.   if ident_type = tystrident then
  695.     s = strexpression$
  696.     'assign string
  697.     string_arr_store(x) = s
  698.     if tracing then print s
  699.   else
  700.     n = numeric_expr#
  701.     'assign number
  702.     numeric_arr_store(x) = n
  703.     if tracing then print n
  704.   end if
  705.  
  706. '------------------------------------------------------------------------
  707. ' statement parsing
  708. '------------------------------------------------------------------------
  709.  
  710. sub showhelp
  711.   print "bye or quit -- exit"
  712.   print "help        -- show this screen"
  713.   print "clear       -- clear variables"
  714.   print "edit        -- edit current program"
  715.   print "list        -- show source"
  716.   print "list vars   -- show variables"
  717.   print "load        -- load program from disk"
  718.   print "new         -- clear program in memory"
  719.   print "reload      -- reload program from disk"
  720.   print "run         -- run program in memory"
  721.   print "save        -- save program to disk"
  722.   print ""
  723.   print "cls         -- clear screen"
  724.   print "tron        -- tracing on"
  725.   print "troff       -- tracing off"
  726.   print "ston        -- stepping on"
  727.   print "stoff       -- stepping off"
  728.  
  729. function getfn$(prompt as string)
  730.   dim filespec as string
  731.   if symtype = tystring or symtype = tystrident then
  732.     filespec = strexpression$
  733.   elseif sym <> "" then
  734.     filespec = sym                 ' gettoeol destroys sym
  735.     filespec = filespec + gettoeol$
  736.   else
  737.     print prompt; ": ";
  738.     line input filespec
  739.   end if
  740.   if filespec <> "" then
  741.     if instr(filespec, ".") = 0 then filespec = filespec + ".bas"
  742.   end if
  743.   getfn$ = filespec
  744.  
  745. sub clearvars
  746.  
  747.   for i = 1 to str_store_max
  748.     string_store(i) = ""
  749.   next
  750.  
  751.   for i = 1 to num_store_max
  752.     numeric_store(i) = 0
  753.   next
  754.  
  755. sub initvars
  756.  
  757.   clearvars
  758.   for i = 1 to var_names_max
  759.     var_names(i).vname = ""
  760.     var_names(i).index = 0
  761.   next
  762.  
  763.   str_store_max = 0: num_store_max = 0: var_names_max = 0
  764.  
  765. sub loadprog(fn as string)
  766.   initvars
  767.   clearprog
  768.  
  769.   if fn = "" then curr_filename = getfn$("Program file") else curr_filename = fn
  770.   if curr_filename = "" then exit sub
  771.   open curr_filename for input as 1
  772.  
  773.   n = 0
  774.   while not eof(1)
  775.     line input #1, pgm(0)
  776.     'if pgm(0) <> "" then
  777.       if storeline& then
  778.         n = the_num + 1
  779.       else
  780.         n = n + 1
  781.         pgm(n) = pgm(0)
  782.       end if
  783.     'end if
  784.   wend
  785.  
  786.   close #1
  787.   curline = 0
  788.  
  789. sub editstmt
  790.   dim editor as string
  791.   editor = environ$("EDITOR")
  792.   if editor = "" then editor = "notepad.exe"
  793.   if curr_filename = "" then curr_filename = "default.bas"
  794.   shell editor + " " + curr_filename
  795.   call loadprog(curr_filename)
  796.  
  797. sub runprog
  798.   if sym <> "" then call loadprog("")
  799.   call initgetsym(1, 1)
  800.  
  801. sub saveprog
  802.   dim filespec as string
  803.   filespec = getfn$("Save as")
  804.   if filespec = "" then exit sub
  805.   open filespec for output as 1
  806.   if err = 8 then
  807.      print at_line$; "*** error: you don't have permission to write to that file."
  808.      exit sub
  809.   end if
  810.   for i = 1 to pgmsize
  811.     if len(pgm(i)) then print #1, i; " "; pgm(i)
  812.   next
  813.   close #1
  814.  
  815. sub liststmt
  816.   if sym = "vars" then
  817.     for i = 1 to var_names_max
  818.       if var_names(i).a_len > 0 then
  819.           print "Array:"; var_names(i).vname, " index: "; var_names(i).index;
  820.           print string_store(var_names(i).index); " size: "; var_names(i).a_len;
  821.           print " type: "; var_names(i).symtype
  822.       elseif right$(var_names(i).vname, 1) = "$" then
  823.           print "String:"; var_names(i).vname, " index: "; var_names(i).index;
  824.           print string_store(var_names(i).index);
  825.           print " type: "; var_names(i).symtype
  826.       elseif var_names(i).vname <> "" then
  827.           print "Number:"; var_names(i).vname, " index: "; var_names(i).index;
  828.           print numeric_store(var_names(i).index);
  829.           print " type: "; var_names(i).symtype
  830.       end if
  831.     next
  832.   else
  833.     for i = 1 to pgmsize
  834.       if pgm(i) <> "" then print i; " "; pgm(i)
  835.     next
  836.   end if
  837.  
  838. sub chdircmd
  839.   chdir strexpression$
  840.  
  841. ' CIRCLE [STEP] (x!,y!),radius![,[color%] [,[start!] [,[end!] [,aspect!]]]]
  842. sub circlestmt
  843.   dim x as single, y as single, radius as single, clr as long
  844.   dim arcbeg as single, arcend as single, elipse as single
  845.  
  846.   expect("(")
  847.   x = numeric_expr#
  848.   expect(",")
  849.   y = numeric_expr#
  850.   expect(")")
  851.   expect(",")
  852.   radius = numeric_expr#
  853.  
  854.   '[,[color%] [,[start!] [,[end!] [,aspect!]]]]
  855.   if accept&(",") then           ' color
  856.     if accept&(",") then         ' arcbeg
  857.       if accept&(",") then       ' arcend
  858.         if accept&(",") then     ' elipse
  859.           elipse = numeric_expr#
  860.           circle (x, y), radius, , , , elipse
  861.         else
  862.           arcend = numeric_expr#
  863.           if accept&(",") then
  864.             elipse = numeric_expr#
  865.             circle (x, y), radius, , , arcend, elipse
  866.           else
  867.             circle (x, y), radius, , , arcend
  868.           end if
  869.         end if
  870.       else
  871.         arcbeg = numeric_expr#
  872.         if accept&(",") then       ' arcend
  873.           if accept&(",") then     ' elipse
  874.             elipse = numeric_expr#
  875.             circle (x, y), radius, , arcbeg, , elipse
  876.           else
  877.             arcend = numeric_expr#
  878.             if accept&(",") then
  879.               elipse = numeric_expr#
  880.               circle (x, y), radius, , arcbeg, arcend, elipse
  881.             else
  882.               circle (x, y), radius, , arcbeg, arcend
  883.             end if
  884.           end if
  885.         end if
  886.       end if
  887.     else
  888.       ' [,[start!] [,[end!] [,aspect!]]]]
  889.       clr = numeric_expr#
  890.       if accept&(",") then         ' arcbeg
  891.         if accept&(",") then       ' arcend
  892.           if accept&(",") then     ' elipse
  893.             elipse = numeric_expr#
  894.             circle (x, y), radius, clr, , , elipse
  895.           else
  896.             arcend = numeric_expr#
  897.             if accept&(",") then
  898.               elipse = numeric_expr#
  899.               circle (x, y), radius, clr, , arcend, elipse
  900.             else
  901.               circle (x, y), radius, clr, , arcend
  902.             end if
  903.           end if
  904.         else
  905.           arcbeg = numeric_expr#
  906.           if accept&(",") then       ' arcend
  907.             if accept&(",") then     ' elipse
  908.               elipse = numeric_expr#
  909.               circle (x, y), radius, clr, arcbeg, , elipse
  910.             else
  911.               arcend = numeric_expr#
  912.               if accept&(",") then
  913.                 elipse = numeric_expr#
  914.                 circle (x, y), radius, clr, arcbeg, arcend, elipse
  915.               else
  916.                 circle (x, y), radius, clr, arcbeg, arcend
  917.               end if
  918.             end if
  919.           else
  920.             circle (x, y), radius, clr, arcbeg
  921.           end if
  922.         end if
  923.       else
  924.         circle (x, y), radius, clr
  925.       end if
  926.     end if
  927.   else
  928.     circle (x, y), radius
  929.   end if
  930.  
  931. ' color [fore] [,back]
  932. sub colorstmt
  933.   dim back as long, fore as long
  934.   if accept&(",") then
  935.     back = numeric_expr#
  936.     color , back
  937.   else
  938.     fore = numeric_expr#
  939.     if accept&(",") then
  940.       back = numeric_expr#
  941.       color fore, back
  942.     else
  943.       color fore
  944.     end if
  945.   end if
  946.  
  947. sub get_array_bounds(lo as long, hi as long)
  948.     lo = numeric_expr#
  949.     if accept&("to") then
  950.       hi = numeric_expr#
  951.     else
  952.       hi = lo
  953.       lo = 0
  954.     end if
  955.  
  956. ' dim ident(numeric expression [to numeric expression]) {, ident(numeric expression [to numeric expression])}
  957. sub dimstmt
  958.   dim ident as string, ident_type as integer, lo as long, hi as long, lo2 as long, hi2 as long
  959.   dim a_len as long, index as long, i as integer, multi as integer, a_width as long
  960.  
  961.   do
  962.     ident = sym
  963.     ident_type = symtype
  964.     if symtype <> tyident and symtype <> tystrident then
  965.       print at_line$; " Expecting an identifier, but found: "; sym: errors = true: exit sub
  966.     end if
  967.     call getsym   ' skip array name
  968.  
  969.     expect("(")
  970.     call get_array_bounds(lo, hi)
  971.     lo2 = 0: hi2 = 0: multi = false
  972.     if accept&(",") then call get_array_bounds(lo2, hi2): multi = true
  973.     expect(")")
  974.  
  975.     ' see if it already exists
  976.     i = find_vname&(ident)
  977.     if i > 0 then print "Duplicate definition: "; ident: errors = true: exit sub
  978.  
  979.     ' add it
  980.     a_len = hi - lo + 1
  981.     if multi then
  982.         a_width = a_len
  983.         a_len = a_len * (hi2 - lo2 + 1)
  984.     end if
  985.  
  986.     var_names_max = var_names_max + 1
  987.     var_names(var_names_max).vname   = ident
  988.     var_names(var_names_max).symtype = ident_type
  989.     var_names(var_names_max).lo_bnd  = lo
  990.     var_names(var_names_max).hi_bnd  = hi
  991.     var_names(var_names_max).lo_bnd2 = lo2
  992.     var_names(var_names_max).hi_bnd2 = hi2
  993.     var_names(var_names_max).multi   = multi
  994.     var_names(var_names_max).a_len   = a_len
  995.     var_names(var_names_max).a_width = a_width
  996.  
  997.     if ident_type = tystrident then
  998.       index = str_arr_stor_max + 1
  999.       str_arr_stor_max = str_arr_stor_max + a_len
  1000.       redim _preserve string_arr_store(str_arr_stor_max)
  1001.     else
  1002.       index = num_arr_stor_max + 1
  1003.       num_arr_stor_max = num_arr_stor_max + a_len
  1004.       redim _preserve numeric_arr_store(num_arr_stor_max)
  1005.     end if
  1006.  
  1007.     var_names(var_names_max).index = index
  1008.  
  1009.     if sym <> "," then exit do
  1010.     call getsym
  1011.   loop
  1012.  
  1013. ' const id[$] = number|string {, const id[$] = number|string}
  1014. sub conststmt
  1015.  
  1016.   do
  1017.     i = find_vname&(sym)
  1018.     if i <> 0 then print at_line$; "var: "; sym; " already defined": errors = true: exit sub
  1019.     call assignment
  1020.     var_names(var_names_max).is_const = true
  1021.   loop while accept&(",")
  1022.  
  1023.  
  1024. sub drawstmt
  1025.   s = strexpression$
  1026.   draw s
  1027.  
  1028. sub environstmt
  1029.   environ strexpression$
  1030.  
  1031. ' need to account for loop [until|while expr] and next [i]
  1032. sub exitstmt
  1033.   if sym = "while" then
  1034.     call getsym
  1035.     if while_sp <= 0 then errors = true: print at_line$; "'exit while' without while": errors = true: exit sub
  1036.     while_sp = while_sp - 1
  1037.     call find_matching_pair("while", "wend")
  1038.     call getsym
  1039.   elseif sym = "do" then
  1040.     call getsym
  1041.     if do_sp <= 0 then errors = true: print at_line$; "'exit do' without do": errors = true: exit sub
  1042.     do_sp = do_sp - 1
  1043.     call find_matching_pair("do", "loop")
  1044.     call getsym
  1045.     if sym = "until" or sym = "while" then
  1046.       call getsym   ' skip until\while
  1047.       ' somehow skip over the until\while expression
  1048.       while sym <> ":" and sym <> ""
  1049.         call getsym
  1050.       wend
  1051.     end if
  1052.   elseif sym = "for" then
  1053.     call getsym
  1054.     if loopp <= 0 then errors = true: print at_line$; "'exit for' without do": errors = true: exit sub
  1055.     loopp = loopp - 1
  1056.     call find_matching_pair("for", "next")
  1057.     call getsym
  1058.     if symtype = tyident then call getsym
  1059.   else
  1060.     print at_line$; "'exit without do/for/while": errors = true: exit sub
  1061.   end if
  1062.  
  1063.   if endif_count > 0 and if_sp    > 0 then if_sp    = if_sp    - endif_count
  1064.   if loop_count  > 0 and do_sp    > 0 then do_sp    = do_sp    - loop_count
  1065.   if next_count  > 0 and loopp    > 0 then loopp    = loopp    - next_count
  1066.   if wend_count  > 0 and while_sp > 0 then while_sp = while_sp - wend_count
  1067.  
  1068.  
  1069. ' for xvar = -1.5 to 1.5 step .01
  1070. sub forstmt
  1071.   dim xvar as integer, i as integer
  1072.   xvar = getvarindex&(left_side)   ' get position of "i"
  1073.   if loopp >= 0 then
  1074.     for i = 0 to loopp - 1
  1075.       if loopvars(i) = xvar then
  1076.         print at_line$; "for index variable already in use": errors = true
  1077.         exit sub
  1078.       end if
  1079.     next
  1080.   end if
  1081.   expect("=")
  1082.   numeric_store(xvar) = numeric_expr#
  1083.   loopp = loopp + 1
  1084.   loopvars(loopp) = xvar
  1085.   looplines(loopp) = curline
  1086.   expect("to")
  1087.   loopmax(loopp) = numeric_expr#
  1088.   if accept&("step") then loopstep(loopp) = numeric_expr# else loopstep(loopp) = 1
  1089.   loopoff(loopp) = textp
  1090.   if len(sym) > 0 then loopoff(loopp) = textp - len(sym) - 1
  1091.  
  1092. ' finds target, using current sym
  1093. function get_target&
  1094.   if symtype = tynum then
  1095.     get_target = numeric_expr#
  1096.   else
  1097.     dim i as integer, lbl as string
  1098.     lbl = sym
  1099.     if right$(lbl, 1) <> ":" then lbl = lbl + ":"
  1100.     for i = 1 to pgmsize
  1101.       if lcase$(mid$(ltrim$(pgm(i)), 1, len(lbl))) = lbl then
  1102.         get_target& = i
  1103.         exit function
  1104.       end if
  1105.     next
  1106.     print at_line$; "Target of goto not found:"; sym: errors = true
  1107.     get_target& = 0
  1108.   end if
  1109.  
  1110. sub gosubstmt
  1111.   dim target as integer
  1112.  
  1113.   target = get_target&
  1114.   if not errors then
  1115.     validlinenum(target)
  1116.     stackp = stackp + 1
  1117.     if stackp > stacksize then print at_line$; "out of stack space": errors = true
  1118.     gosubstack(stackp) = curline
  1119.     ' 26 May 2021 was just textp
  1120.     gosuboffstack(stackp) = textp - 1
  1121.     'print "textp:"; textp; "=>"; pgm$(curline)
  1122.     'if sym = ":" then gosuboffstack(stackp) = textp
  1123.     call initgetsym(target, 1)
  1124.   end if
  1125.  
  1126. sub gotostmt
  1127.   dim target as integer
  1128.  
  1129.   target = get_target&
  1130.   gotoline(target)
  1131.  
  1132. ' single line if: if expr then if expr then if expr then s else s else s else s
  1133. sub ifstmt
  1134.   dim b as integer, level as integer, cond as integer
  1135.  
  1136.   level = 0
  1137.  
  1138.   begin:
  1139.  
  1140.   level = level + 1
  1141.   cond = numeric_expr#
  1142.   b = accept&("then")
  1143.   '*** multiline if processing ***
  1144.   if sym = "" then  'multiline if
  1145.     if level > 1 then
  1146.       print at_line$; "can't mix multi and single line 'if'": errors = true
  1147.       exit sub
  1148.     end if
  1149.     call multi_ifstmt(cond)
  1150.   '*** singleline if processing ***
  1151.   elseif cond then
  1152.     if symtype = tynum then
  1153.         gotoline(int(the_num))
  1154.     elseif accept&("if") then
  1155.         goto begin
  1156.     end if
  1157.   else
  1158.     call find_matching_sline_if
  1159.     ' if else found, pick up there, otherwise skip rest of stmt
  1160.     if not accept&("else") then skiptoeol
  1161.     if symtype = tynum then gotoline(int(the_num))
  1162.   end if
  1163.  
  1164. sub multi_ifstmt(cond as integer)
  1165.  
  1166.   if_sp = if_sp + 1
  1167.   if_stack(if_sp) = curline
  1168.   'print at_line$; "if after inc: if_sp: "; if_sp, pgm(curline)
  1169.  
  1170.   if cond then
  1171.     rem let docmd process these commands
  1172.   else
  1173.     'need to find the next corresponding 'elseif' or 'else' or 'endif'
  1174.     restart:
  1175.     ' on the "if" or "elseif" line, so skip it
  1176.     s = find_matching_else$ 'either elseif, else or endif
  1177.     'print at_line$; "found: "; sym
  1178.     if s = "" then print at_line$; "missing endif": errors = true: exit sub
  1179.     if tracing then print "["; curline; "] "; sym; " "; mid$(thelin, textp)
  1180.     if sym = "elseif" then
  1181.       'print sym; ": "; mid$(thelin, textp)
  1182.       call getsym 'skip "elseif"
  1183.       cond = numeric_expr#
  1184.       b = accept&("then")
  1185.       'print at_line$; "elseif evaluated to: "; cond
  1186.       if cond then
  1187.         rem let docmd process these commands, until next elseif/else/endif
  1188.       else
  1189.         goto restart
  1190.       end if
  1191.     elseif sym = "else" then
  1192.       rem - let docmd process these commands, until endif
  1193.       call getsym   ' skip the else, so docmd goes to next line
  1194.     elseif sym = "endif" then
  1195.       call endifstmt
  1196.     end if
  1197.   end if
  1198.  
  1199. ' called from docmd()
  1200. sub elseifstmt
  1201.  
  1202.   if if_sp = 0 then print at_line$; "endif without if": errors = true: exit sub
  1203.  
  1204.   'scan until matching endif
  1205.  
  1206.   ' but first, allow more "elseif"'s
  1207.   do
  1208.     s = find_matching_else$
  1209.   loop while s = "elseif"
  1210.  
  1211.   ' allow an "else"
  1212.   if s = "else" then
  1213.     s = find_matching_else$
  1214.   end if
  1215.  
  1216.   ' finally, need an "endif"
  1217.   if s = "endif" then
  1218.     ' pop the if stack
  1219.     if_sp = if_sp - 1
  1220.     call getsym  ' skip "endif"
  1221.     ' done
  1222.   else
  1223.     print at_line$; "Missing endif": errors = true: exit sub
  1224.   end if
  1225.  
  1226. ' called from docmd()
  1227. sub elsestmt
  1228.   'print at_line$; "else begin: if_sp: "; if_sp, pgm(curline)
  1229.  
  1230.   'part of a single-line if?
  1231.   call initgetsym(curline, 1)
  1232.   'if not "else", then single-line if
  1233.   if sym <> "else" then call skiptoeol: exit sub
  1234.  
  1235.   ' looks like multiline if - but have we seen the start of it?
  1236.   if if_sp = 0 then print at_line$; "else without if": errors = true: exit sub
  1237.  
  1238.   'scan until matching endif
  1239.   if find_matching_else$ <> "endif" then print at_line$; "else without endif": errors = true: exit sub
  1240.  
  1241.   call getsym 'skip the "endif"
  1242.   'pop the if stack
  1243.   if_sp = if_sp - 1
  1244.   'print at_line$; "else end: if_sp: "; if_sp, pgm(curline)
  1245.  
  1246. ' called from docmd()
  1247. sub endifstmt
  1248.   if if_sp = 0 then print at_line$; "endif without if": errors = true: exit sub
  1249.   if_sp = if_sp - 1
  1250.   'print at_line$; "endif: if_sp: "; if_sp, pgm(curline)
  1251.   call getsym 'skip "endif"
  1252.  
  1253. ' input [;] ["prompt" ;|,] variablelist
  1254. sub inputsetup
  1255.   if left$(sym, 1) = chr$(34) then
  1256.     print mid$(sym, 2, len(sym) - 1);
  1257.     call getsym
  1258.     if accept&(";") then
  1259.       print "? ";
  1260.     else
  1261.       expect(",")
  1262.     end if
  1263.   end if
  1264.  
  1265. ' input [;] ["prompt" ;|,] variablelist
  1266. sub inputstmt
  1267.   dim ident as string, ident_type as integer, i as long, x as long, st as string, n as double
  1268.  
  1269.   inputsetup
  1270.  
  1271.   ident = sym: ident_type = symtype
  1272.   if ident_type = tystrident then
  1273.     input "", st
  1274.   else
  1275.     input "", n
  1276.   end if
  1277.  
  1278.   i = find_vname&(ident)
  1279.   if i > 0 then
  1280.     if ident_type <> var_names(i).symtype then
  1281.       print at_line$; "Type mismatch: "; ident_type; " vs. table: "; var_names(i).symtype: errors = true: exit sub
  1282.     end if
  1283.     if var_names(i).a_len > 0 then ' array
  1284.       x = get_array_index&(ident)
  1285.  
  1286.       if ident_type = tystrident then
  1287.         'assign string
  1288.         string_arr_store(x) = st
  1289.         if tracing then print st
  1290.       else
  1291.         'assign number
  1292.         numeric_arr_store(x) = n
  1293.         if tracing then print n
  1294.       end if
  1295.  
  1296.       exit sub
  1297.  
  1298.     end if
  1299.   end if
  1300.  
  1301.   if ident_type = tystrident then
  1302.     i = getstrindex&(left_side)
  1303.     string_store(i) = st
  1304.   elseif ident_type = tyident then
  1305.     i = getvarindex&(left_side)
  1306.     numeric_store(i) = n
  1307.   else
  1308.     print at_line$; "Unknown type": errors = true: exit sub
  1309.   end if
  1310.  
  1311. ' line input [;] ["prompt";] variable$
  1312. sub lineinputstmt
  1313.   dim ident as string, ident_type as integer, i as long, x as long, st as string
  1314.  
  1315.   if not accept&("input") then linestmt: exit sub
  1316.   inputsetup
  1317.  
  1318.   ident = sym: ident_type = symtype
  1319.  
  1320.   if ident_type <> tystrident then print at_line$; "String variable expected": errors = true: exit sub
  1321.  
  1322.   line input st
  1323.  
  1324.   i = find_vname&(ident)
  1325.   if i > 0 then
  1326.     if ident_type <> var_names(i).symtype then
  1327.       print at_line$; "Type mismatch: "; ident_type; " vs. table: "; var_names(i).symtype: errors = true: exit sub
  1328.     end if
  1329.     if var_names(i).a_len > 0 then ' array
  1330.       x = get_array_index&(ident)
  1331.  
  1332.       'assign string
  1333.       string_arr_store(x) = st
  1334.       if tracing then print st
  1335.  
  1336.       exit sub
  1337.  
  1338.     end if
  1339.   end if
  1340.  
  1341.   i = getstrindex&(left_side)
  1342.   string_store(i) = st
  1343.  
  1344. ' line [[step](x1!,y1!)]-[step](x2!,y2!) [,[color%] [,[b | bf] [,style%]]]
  1345. ' ??? step is not currently supported
  1346. sub linestmt
  1347.   dim x1 as single, y1 as single, x2 as single, y2 as single, clr as long
  1348.   dim rect_type as string, step1 as integer, step2 as integer
  1349.  
  1350.   step1 = false: step2 = false
  1351.  
  1352.   if accept&("step") then step1 = true
  1353.   expect("(")
  1354.   x1 = numeric_expr#
  1355.   expect(",")
  1356.   y1 = numeric_expr#
  1357.   expect(")")
  1358.  
  1359.   expect("-")
  1360.   if accept&("step") then step2 = true
  1361.  
  1362.   expect("(")
  1363.   x2 = numeric_expr#
  1364.   expect(",")
  1365.   y2 = numeric_expr#
  1366.   expect(")")
  1367.  
  1368.   ' so far we have: line(x, y)-(x2, y2)
  1369.  
  1370.   if is_stmt_end& then line (x1, y1)-(x2, y2): exit sub
  1371.  
  1372.   '[,[color%] [,[b | bf] [,style%]]]
  1373.   ' only acceptable value is a ","
  1374.  
  1375.   '1) ,c
  1376.   '2) ,c,b
  1377.   '3) ,c,b,s
  1378.   '4) ,c,,s
  1379.   '5) ,,b
  1380.   '6) ,,b,s
  1381.   '7) ,,,s
  1382.  
  1383.   if accept&(",") then
  1384.     if accept&(",") then
  1385.       if accept&(",") then
  1386.         'must have s (7)
  1387.         line (x1, y1)-(x2, y2), , , numeric_expr#
  1388.       else
  1389.         'must have b
  1390.         rect_type = ucase$(sym)
  1391.         if rect_type <> "B" and rect_type <> "BF" then
  1392.           print at_line$; "line ... - expecting 'B' or 'BF', found: "; rect_type: errors = true: exit sub
  1393.         end if
  1394.         if accept&(",") then
  1395.           'must have s (6)
  1396.           if rect_type = "B" then
  1397.             line (x1, y1)-(x2, y2), , B, numeric_expr#
  1398.           else
  1399.             line (x1, y1)-(x2, y2), , BF, numeric_expr#
  1400.           end if
  1401.         else
  1402.           '(5)
  1403.           if rect_type = "B" then
  1404.             line (x1, y1)-(x2, y2), , B
  1405.           else
  1406.             line (x1, y1)-(x2, y2), , BF
  1407.           end if
  1408.           call getsym ' skip "B"
  1409.         end if
  1410.       end if
  1411.     else
  1412.       'must have c
  1413.       clr = numeric_expr#
  1414.       if accept&(",") then
  1415.         if accept&(",") then
  1416.           'must have s (4)
  1417.           line (x1, y1)-(x2, y2), clr, , numeric_expr#
  1418.         else
  1419.           'must have b
  1420.           rect_type = ucase$(sym)
  1421.           if rect_type <> "B" and rect_type <> "BF" then
  1422.             print at_line$; "line ... - expecting 'B' or 'BF', found: "; rect_type: errors = true: exit sub
  1423.           end if
  1424.           if accept&(",") then
  1425.             'must have s (3)
  1426.             if rect_type = "B" then
  1427.               line (x1, y1)-(x2, y2), clr , B, numeric_expr#
  1428.             else
  1429.               line (x1, y1)-(x2, y2), clr, BF, numeric_expr#
  1430.             end if
  1431.           else
  1432.             '(2)
  1433.             if rect_type = "B" then
  1434.               line (x1, y1)-(x2, y2), clr, B
  1435.             else
  1436.               line (x1, y1)-(x2, y2), clr, BF
  1437.             end if
  1438.             call getsym ' skip "B"
  1439.           end if
  1440.         end if
  1441.       else
  1442.         '(1)
  1443.         line (x1, y1)-(x2, y2), clr
  1444.       end if
  1445.     end if
  1446.   end if
  1447.  
  1448. sub locatestmt
  1449.   dim row as integer, col as integer
  1450.   if accept&(",") then
  1451.     col = numeric_expr#
  1452.     locate , col
  1453.   else
  1454.     row = numeric_expr#
  1455.     if accept&(",") then
  1456.       col = numeric_expr#
  1457.       locate row, col
  1458.     else
  1459.       locate row
  1460.     end if
  1461.   end if
  1462.  
  1463. ' mid$(s, i, n)
  1464. sub midstmt
  1465.   dim xvar as integer, start as integer, length as integer, nolength as integer
  1466.   expect("(")
  1467.   xvar = getstrindex&(left_side)
  1468.   expect(",")
  1469.   start = numeric_expr#
  1470.   if accept&(",") then length = numeric_expr# else nolength = -1
  1471.   expect(")")
  1472.   expect("=")
  1473.   if nolength then
  1474.     mid$(string_store(xvar), start) = strexpression$
  1475.   else
  1476.     mid$(string_store(xvar), start, length) = strexpression$
  1477.   end if
  1478.  
  1479. sub nextstmt
  1480.   dim cont as integer
  1481.  
  1482.   if symtype = tyident then call getsym
  1483.   if loopp < 0 then print at_line$; "next without for": errors = true: exit sub
  1484.   ' increment the current "i"
  1485.   numeric_store(loopvars(loopp)) = numeric_store(loopvars(loopp)) + loopstep(loopp)
  1486.   if tracing then print "["; curline; "] "; "next: "; numeric_store(loopvars(loopp))
  1487.  
  1488.   ' see if "for" should continue
  1489.   cont = false
  1490.   if loopstep(loopp) < 0 then
  1491.     if numeric_store(loopvars(loopp)) >= loopmax(loopp) then
  1492.       cont = true
  1493.     end if
  1494.   else
  1495.     if numeric_store(loopvars(loopp)) <= loopmax(loopp) then
  1496.       cont = true
  1497.     end if
  1498.   end if
  1499.  
  1500.   if cont then
  1501.     call initgetsym(looplines(loopp), loopoff(loopp))
  1502.   else
  1503.     loopp = loopp - 1
  1504.   end if
  1505.  
  1506.  
  1507. ' PAINT [STEP] (column%, row%), fillColor[, borderColor%]
  1508. sub paintstmt
  1509.   dim x as long, y as long, f as long
  1510.  
  1511.   expect("(")
  1512.   x = numeric_expr#
  1513.   expect(",")
  1514.   y = numeric_expr#
  1515.   expect(")")
  1516.   if accept&(",") then
  1517.     if accept&(",") then
  1518.       paint (x, y), , numeric_expr#
  1519.     else
  1520.       f = numeric_expr#
  1521.       if accept&(",") then
  1522.         paint (x, y), f, numeric_expr#
  1523.       else
  1524.         paint (x, y), f
  1525.       end if
  1526.     end if
  1527.   else
  1528.     paint (x, y)
  1529.   end if
  1530.  
  1531. ' palette [attribute%,color&]
  1532. sub palettestmt
  1533.     dim a as integer, c as long
  1534.  
  1535.     a = numeric_expr#
  1536.     expect(",")
  1537.     c = numeric_expr#
  1538.     palette a, c
  1539.  
  1540. sub printstmt
  1541.   dim val_type as integer, printed as integer
  1542.  
  1543.   printed = false
  1544.   if accept&(",") then print ,
  1545.   do while sym <> "" and sym <> ":" and sym <> "else"
  1546.     printed = true
  1547.     val_type = any_expr&(0)
  1548.  
  1549.     if accept&(",") then
  1550.       if val_type = tystring then
  1551.         print pop_str$,
  1552.       else
  1553.         print pop_num#,
  1554.       end if
  1555.     elseif accept&(";") then
  1556.       if val_type = tystring then
  1557.         print pop_str$;
  1558.       else
  1559.         print pop_num#;
  1560.       end if
  1561.     else
  1562.       if val_type = tystring then
  1563.         print pop_str$
  1564.       else
  1565.         print pop_num#
  1566.       end if
  1567.       exit do
  1568.     end if
  1569.   loop
  1570.   if not printed then print
  1571.  
  1572. ' preset   (column, row)
  1573. ' preset [step] (x!,y!) [,color%]
  1574. sub presetstmt
  1575.   expect("(")
  1576.   x = numeric_expr#
  1577.   expect(",")
  1578.   y = numeric_expr#
  1579.   expect(")")
  1580.   if accept&(",") then preset (x, y), numeric_expr# else preset (x, y)
  1581.  
  1582. ' pset   (column, row)
  1583. ' pset [step] (x!,y!) [,color%]
  1584. ' PSET [STEP] (x!,y!) [,color%]
  1585. sub psetstmt
  1586.   dim x as single, y as single, clr as long
  1587.   expect("(")
  1588.   x = numeric_expr#
  1589.   expect(",")
  1590.   y = numeric_expr#
  1591.   expect(")")
  1592.   if accept&(",") then
  1593.     clr = numeric_expr#
  1594.     pset (x, y), clr
  1595.   else
  1596.     pset (x, y)
  1597.   end if
  1598.  
  1599. sub randomizer
  1600.   if sym = "" then randomize timer else randomize numeric_expr#
  1601.  
  1602. sub returnstmt
  1603.   dim lin as integer, offs as integer
  1604.   if stackp < 0 then print at_line$; "return without gosub": errors = true: exit sub
  1605.   lin = gosubstack(stackp)
  1606.   offs = gosuboffstack(stackp)
  1607.   if tracing then print "returning to: "; lin; ": "; offs
  1608.   'print "["; curline; "] "; "returning to: "; lin; ": "; offs; " while_sp: "; while_sp
  1609.   stackp = stackp - 1
  1610.   if offs <= 1 then print at_line$; "returnstmt - offs <= 1": errors = true
  1611.   call initgetsym(lin, offs)
  1612.  
  1613. ' SCREEN mode% [,[colorswitch%] [,[activepage%] [,visualpage%]]]
  1614. sub screenstmt
  1615.   screen numeric_expr#
  1616.  
  1617. ' shell [string]
  1618. sub shellstmt
  1619.  
  1620.   s = ""
  1621.   while the_ch <> "" and the_ch <> ":"
  1622.     s = s + the_ch
  1623.     call getch
  1624.   wend
  1625.  
  1626.   shell s
  1627.   'print "shell: "; s
  1628.   call skiptoeol
  1629.  
  1630. ' sleep [seconds]
  1631. sub sleepstmt
  1632.   if is_stmt_end& then sleep else sleep numeric_expr#
  1633.  
  1634. ' swap v1, v2
  1635. sub swapstmt
  1636.   dim i1 as integer, i2 as integer
  1637.   dim symtype1 as integer, symtype2 as integer
  1638.   dim sym1 as string, sym2 as string
  1639.  
  1640.   sym1     = sym
  1641.   symtype1 = symtype
  1642.   if symtype = tyident then
  1643.     i1 = getvarindex&(left_side)
  1644.   else
  1645.     i1 = getstrindex&(left_side)
  1646.   end if
  1647.  
  1648.   expect(",")
  1649.  
  1650.   sym2     = sym
  1651.   symtype2 = symtype
  1652.  
  1653.   if symtype = tyident then
  1654.     i2 = getvarindex&(left_side)
  1655.   else
  1656.     i2 = getstrindex&(left_side)
  1657.   end if
  1658.  
  1659.   if symtype1 <> symtype2 then
  1660.     print at_line$; sym1; " and "; sym2; " are not the same data type": errors = true
  1661.     exit sub
  1662.   end if
  1663.  
  1664.   if symtype1 = tyident then
  1665.     swap numeric_store(i1), numeric_store(i2)
  1666.   else
  1667.     swap string_store(i1), string_store(i2)
  1668.   end if
  1669.  
  1670. ' VIEW [[SCREEN] (x1!,y1!)-(x2!,y2!) [,[color%] [,border%]]]
  1671. sub viewstmt
  1672.   dim x1 as long, y1 as long, x2 as long, y2 as long, clr as long, border as long
  1673.  
  1674.   expect("(")
  1675.   x1 = numeric_expr#
  1676.   expect(",")
  1677.   y1 = numeric_expr#
  1678.   expect(")")
  1679.  
  1680.   expect("-")
  1681.  
  1682.   expect("(")
  1683.   x2 = numeric_expr#
  1684.   expect(",")
  1685.   y2 = numeric_expr#
  1686.   expect(")")
  1687.  
  1688.   if accept&(",") then
  1689.     if accept&(",") then
  1690.       border = numeric_expr#
  1691.       view (x1, y1)-(x2, y2), , border
  1692.     else
  1693.       clr = numeric_expr#
  1694.       if accept&(",") then
  1695.         border = numeric_expr#
  1696.         view (x1, y1)-(x2, y2), clr, border
  1697.       else
  1698.         view (x1, y1)-(x2, y2), clr
  1699.       end if
  1700.     end if
  1701.   else
  1702.     view (x1, y1)-(x2, y2)
  1703.   end if
  1704.  
  1705. sub whilestmt(first as integer)
  1706.   if first then
  1707.     while_sp = while_sp + 1
  1708.     while_line(while_sp) = curline
  1709.     while_off(while_sp) = textp
  1710.     if len(sym) > 0 then while_off(while_sp) = textp - len(sym) - 1
  1711.   end if
  1712.   'print "["; curline; "] "; "*while:sym:";sym; " textp:";textp; " =>";mid$(pgm(curline), textp); " while_sp: "; while_sp
  1713.   if not bool_expr& then
  1714.     while_sp = while_sp - 1
  1715.     'print "["; curline; "] "; "*wend bool_expr is 0!"; " while_sp: "; while_sp
  1716.     call find_matching_pair("while", "wend")
  1717.     call getsym
  1718.   end if
  1719.  
  1720. sub wendstmt
  1721.   if while_sp <= 0 then errors = true: print at_line$; "wend without while": errors = true: exit sub
  1722.   call initgetsym(while_line(while_sp), while_off(while_sp))
  1723.   if tracing then print "["; curline; "] "; "wend"
  1724.   whilestmt(false)
  1725.  
  1726. ' do [(while|until) expr][:]
  1727. sub dostmt(first as integer)
  1728.   if first then
  1729.     do_sp = do_sp + 1
  1730.     do_loop(do_sp).lline = curline
  1731.  
  1732.     do_loop(do_sp).loff = textp
  1733.     if len(sym) > 0 then do_loop(do_sp).loff = textp - len(sym) - 1
  1734.     'print "*do:"; "sym:"; sym; " textp:";textp; "=>";mid$(pgm(curline), textp - len(sym))
  1735.   end if
  1736.  
  1737.   if sym = "while" then
  1738.     call getsym
  1739.     if not bool_expr& then
  1740.       do_sp = do_sp - 1
  1741.       call find_matching_pair("do", "loop")
  1742.       call getsym
  1743.     end if
  1744.   elseif sym = "until" then
  1745.     call getsym
  1746.     if bool_expr& then
  1747.       do_sp = do_sp - 1
  1748.       call find_matching_pair("do", "loop")
  1749.       call getsym
  1750.     end if
  1751.   end if
  1752.  
  1753. ' loop [(while|until) expr]
  1754. sub loopstmt
  1755.   if do_sp <= 0 then errors = true: print at_line$; "loop without do": errors = true: exit sub
  1756.  
  1757.   if sym = "while" then
  1758.     call getsym
  1759.     if not bool_expr& then
  1760.       do_sp = do_sp - 1
  1761.       exit sub
  1762.     end if
  1763.   elseif sym = "until" then
  1764.     call getsym
  1765.     if bool_expr& then
  1766.       do_sp = do_sp - 1
  1767.       exit sub
  1768.     end if
  1769.   end if
  1770.  
  1771.   call initgetsym(do_loop(do_sp).lline, do_loop(do_sp).loff)
  1772.   'print "loop line:"; curline; "off:"; do_loop(do_sp).loff; "==>"; pgm(curline)
  1773.   dostmt(false)
  1774.  
  1775. ' width , height
  1776. ' width width
  1777. ' width width, height
  1778. sub widthstmt
  1779.  
  1780.   if accept&(",") then
  1781.     width , numeric_expr#
  1782.   else
  1783.     w = numeric_expr#
  1784.     if accept&(",") then
  1785.       width w , numeric_expr#
  1786.     else
  1787.       width w
  1788.     end if
  1789.   end if
  1790.  
  1791. ' window [ [ screen] (x1!, y1!) - (x2!, y2!)]
  1792. sub windowstmt
  1793.     dim x1 as single, y1 as single, x2 as single, y2 as single
  1794.  
  1795.     if sym = "" then window: exit sub
  1796.  
  1797.     expect("(")
  1798.     x1 = numeric_expr#
  1799.     expect(",")
  1800.     y1 = numeric_expr#
  1801.     expect(")")
  1802.  
  1803.     expect("-")
  1804.  
  1805.     expect("(")
  1806.     x2 = numeric_expr#
  1807.     expect(",")
  1808.     y2 = numeric_expr#
  1809.     expect(")")
  1810.  
  1811.     window (x1, y1) - (x2, y2)
  1812.  
  1813. '------------------------------------------------------------------------
  1814. '  Various helper routines
  1815. '------------------------------------------------------------------------
  1816.  
  1817. sub skip_exit
  1818.     call getsym
  1819.     if sym = "do" or sym = "while" or sym = "for" then
  1820.         call getsym
  1821.     end if
  1822.  
  1823. sub find_matching_pair(s1 as string, s2 as string)
  1824.   dim level as integer
  1825.   dim more as integer
  1826.   dim have_sym as integer
  1827.  
  1828.   level = 1
  1829.   more = true
  1830.   have_sym = false
  1831.  
  1832.   endif_count = 0: wend_count = 0: next_count = 0: loop_count = 0
  1833.  
  1834.   do
  1835.     if sym = "exit" then
  1836.         call skip_exit
  1837.     elseif not have_sym then
  1838.         call getsym
  1839.         if sym = "exit" then call skip_exit
  1840.     end if
  1841.  
  1842.     have_sym = false
  1843.     'print at_line$; "matching, level"; level; "sym=>"; sym
  1844.     'if isalpha&(mid$(sym, 1, 1)) then print "fm: level: sym: "; level; ": '"; sym; "'  "; mid$(thelin, textp, 40)
  1845.  
  1846.     select case sym
  1847.         case s1: level = level + 1
  1848.         case s2: level = level - 1
  1849.     end select
  1850.  
  1851.     if level = 0 then exit do
  1852.  
  1853.     select case sym
  1854.         case "if"     ' need to only do "if" case if multiline if
  1855.           do
  1856.             call getsym
  1857.           loop until sym = "then" or sym = ""
  1858.           call getsym ' skip the "then"
  1859.           ' if nothing past "then", it is a multiline if
  1860.           if sym = "" then endif_count = endif_count - 1
  1861.         case "endif": endif_count = endif_count + 1
  1862.         case "while": wend_count  = wend_count  - 1
  1863.         case "wend":  wend_count  = wend_count  + 1
  1864.         case "for":   next_count  = next_count  - 1
  1865.         case "next":  next_count  = next_count  + 1
  1866.         case "do"
  1867.           loop_count  = loop_count  - 1
  1868.           if sym = "while" then call getsym
  1869.         case "loop"
  1870.           loop_count  = loop_count  + 1
  1871.           if sym = "while" then call getsym
  1872.     end select
  1873.  
  1874.     if sym = "" then
  1875.       if not more then exit sub
  1876.       while sym = "" and curline > 0 and curline < pgmsize
  1877.         call initgetsym(curline + 1, 1)
  1878.       wend
  1879.       if sym = "" then
  1880.         print at_line$; "Cannot find matching: "; s2: errors = true
  1881.         exit sub
  1882.       end if
  1883.       have_sym = true
  1884.     end if
  1885.   loop
  1886.  
  1887. ' find matching elseif/else/endif
  1888. function find_matching_else$
  1889.   dim level as integer
  1890.  
  1891.   find_matching_else$ = ""
  1892.   level = 0
  1893.   do
  1894.       call initgetsym(curline + 1, 1)
  1895.       'print "find_matching_else: "; curline; " sym: "; sym; " level: "; level; "textp: "; textp; " line:"; thelin
  1896.       if curline >= pgmsize then print "searching for endif, found eof": errors = true: exit do
  1897.       if is_multi_line_if& then
  1898.           level = level + 1
  1899.       elseif level = 0 and (sym = "elseif" or sym = "else" or sym = "endif") then
  1900.           find_matching_else = sym: exit do
  1901.       elseif level > 0 and sym = "endif" then
  1902.           level = level - 1
  1903.       elseif errors then
  1904.           exit do
  1905.       endif
  1906.   loop
  1907.  
  1908. sub find_matching_sline_if
  1909.   dim level as integer
  1910.   level = 1
  1911.   do
  1912.     'print "find_matching_sline_if level: "; level; " sym: "; sym
  1913.     if sym = "if" then
  1914.       level = level + 1
  1915.     elseif sym = "else" then
  1916.       level = level - 1
  1917.     end if
  1918.     if level = 0 or sym = "" then exit do
  1919.     call getsym
  1920.   loop
  1921.  
  1922. function is_multi_line_if&
  1923.     is_multi_line_if& = false
  1924.  
  1925.     if sym = "if" then
  1926.         ' is it single or multi line "if" - ignore single line if's
  1927.         do
  1928.             call getsym
  1929.             if sym = "" then print at_line$; "if missing then" : errors = true: exit do
  1930.             if sym = "then" then
  1931.                 call getsym
  1932.                 if sym = "" then
  1933.                     ' multi line "if"
  1934.                     is_multi_line_if& = true
  1935.                 end if
  1936.                 exit do
  1937.             end if
  1938.         loop
  1939.     end if
  1940.  
  1941. function accept&(s as string)
  1942.   accept& = false
  1943.   if sym = s then accept& = true: call getsym
  1944.  
  1945. sub expect(s as string)
  1946.   if not accept&(s) then print at_line$; "expecting "; s; " but found "; sym: errors = true
  1947.  
  1948. function is_stmt_end&
  1949.   is_stmt_end& = sym = "" or sym = ":"
  1950.  
  1951. sub validlinenum(n as integer)
  1952.   if n > 0 and n <= pgmsize then exit sub
  1953.   print at_line$; "line number out of range:"; the_num: errors = true
  1954.  
  1955. function storeline&
  1956. 'print "storeline"
  1957.   storeline& = false
  1958.   call initgetsym(0, 1)
  1959.   if symtype = tynum then
  1960.     validlinenum(int(the_num))
  1961.     pgm(the_num) = mid$(pgm(0), textp, len(pgm(0)) - textp + 1)
  1962.     storeline& = true
  1963.   end if
  1964.  
  1965. sub clearprog
  1966.   for i = 1 to pgmsize
  1967.     pgm(i) = ""
  1968.   next
  1969.  
  1970. sub gotoline(target as integer)
  1971.   validlinenum(target)
  1972.   call initgetsym(target, 1)
  1973.  
  1974. '------------------------------------------------------------------------
  1975. '------[QB64 specific functions]-----------------------------------------
  1976. '------------------------------------------------------------------------
  1977.  
  1978. ' _atan2(y, x)
  1979. function atan2fun#
  1980.  
  1981.   expect("(")
  1982.   y = numeric_expr#
  1983.   expect(",")
  1984.   x = numeric_expr#