OS/2 Professional/OS2PRO194.ISO/os2/prgramer/pascal2c/basic.p

Text File | 1992-08-05 | 67.2 KB | 2,215 lines

$ sysprog, ucsd, heap_dispose, partial_eval $

{$ debug$}


program basic(input, output);


const

   checking = true;

   varnamelen = 20;
   maxdims = 4;



type

   varnamestring = string[varnamelen];

   string255 = string[255];
   string255ptr = ^string255;

   tokenkinds = (tokvar, toknum, tokstr, toksnerr,

                 tokplus, tokminus, toktimes, tokdiv, tokup, toklp, tokrp,
                 tokcomma, toksemi, tokcolon, tokeq, toklt, tokgt,
                 tokle, tokge, tokne,

                 tokand, tokor, tokxor, tokmod, toknot, toksqr, toksqrt, toksin,
                 tokcos, toktan, tokarctan, toklog, tokexp, tokabs, toksgn,
                 tokstr_, tokval, tokchr_, tokasc, toklen, tokmid_, tokpeek,

                 tokrem, toklet, tokprint, tokinput, tokgoto, tokif, tokend,
                 tokstop, tokfor, toknext, tokwhile, tokwend, tokgosub,
                 tokreturn, tokread, tokdata, tokrestore, tokgotoxy, tokon,
                 tokdim, tokpoke,

                 toklist, tokrun, toknew, tokload, tokmerge, toksave, tokbye,
                 tokdel, tokrenum,

                 tokthen, tokelse, tokto, tokstep);

   realptr = ^real;
   basicstring = string255ptr;
   stringptr = ^basicstring;
   numarray = array[0..maxint] of real;
   arrayptr = ^numarray;
   strarray = array[0..maxint] of basicstring;
   strarrayptr = ^strarray;

   tokenptr = ^tokenrec;
   lineptr = ^linerec;
   varptr = ^varrec;
   loopptr = ^looprec;

   tokenrec =
      record
         next : tokenptr;
         case kind : tokenkinds of
            tokvar : (vp : varptr);
            toknum : (num : real);
            tokstr, tokrem : (sp : string255ptr);
            toksnerr : (snch : char);
      end;

   linerec =
      record
         num, num2 : integer;
         txt : tokenptr;
         next : lineptr;
      end;

   varrec =
      record
         name : varnamestring;
         next : varptr;
         dims : array [1..maxdims] of integer;
         numdims : 0..maxdims;
         case stringvar : boolean of
            false : (arr : arrayptr;  val : realptr;  rv : real);
            true : (sarr : strarrayptr;  sval : stringptr;  sv : basicstring);
      end;

   valrec =
      record
         case stringval : boolean of
            false : (val : real);
            true : (sval : basicstring);
      end;

   loopkind = (forloop, whileloop, gosubloop);
   looprec =
      record
         next : loopptr;
         homeline : lineptr;
         hometok : tokenptr;
         case kind : loopkind of
            forloop :
               ( vp : varptr;
                 max, step : real );
      end;



var

   inbuf : string255ptr;

   linebase : lineptr;
   varbase : varptr;
   loopbase : loopptr;

   curline : integer;
   stmtline, dataline : lineptr;
   stmttok, datatok, buf : tokenptr;

   exitflag : boolean;

   excp_line ['EXCP_LINE'] : integer;



$if not checking$
   $range off$
$end$



procedure misc_getioerrmsg(var s : string; io : integer);
   external;

procedure misc_printerror(er, io : integer);
   external;

function asm_iand(a, b : integer) : integer;
   external;

function asm_ior(a, b : integer) : integer;
   external;

procedure hpm_new(var p : anyptr; size : integer);
   external;

procedure hpm_dispose(var p : anyptr; size : integer);
   external;



procedure restoredata;
   begin
      dataline := nil;
      datatok := nil;
   end;



procedure clearloops;
   var
      l : loopptr;
   begin
      while loopbase <> nil do
         begin
            l := loopbase^.next;
            dispose(loopbase);
            loopbase := l;
         end;
   end;



function arraysize(v : varptr) : integer;
   var
      i, j : integer;
   begin
      with v^ do
         begin
            if stringvar then
               j := 4
            else
               j := 8;
            for i := 1 to numdims do
               j := j * dims[i];
         end;
      arraysize := j;
   end;


procedure clearvar(v : varptr);
   begin
      with v^ do
         begin
            if numdims <> 0 then
               hpm_dispose(arr, arraysize(v))
            else if stringvar and (sv <> nil) then
               dispose(sv);
            numdims := 0;
            if stringvar then
               begin
                  sv := nil;
                  sval := addr(sv);
               end
            else
               begin
                  rv := 0;
                  val := addr(rv);
               end;
         end;
   end;


procedure clearvars;
   var
      v : varptr;
   begin
      v := varbase;
      while v <> nil do
         begin
            clearvar(v);
            v := v^.next;
         end;
   end;



function numtostr(n : real) : string255;
   var
      s : string255;
      i : integer;
   begin
      setstrlen(s, 255);
      if (n <> 0) and (abs(n) < 1e-2) or (abs(n) >= 1e12) then
         begin
            strwrite(s, 1, i, n);
            setstrlen(s, i-1);
            numtostr := s;
         end
      else
         begin
            strwrite(s, 1, i, n:30:10);
            repeat
               i := i - 1;
            until s[i] <> '0';
            if s[i] = '.' then
               i := i - 1;
            setstrlen(s, i);
            numtostr := strltrim(s);
         end;
   end;



procedure parse(inbuf : string255ptr; var buf : tokenptr);

   const
      toklength = 20;

   type
      chset = set of char;

   const
      idchars = chset ['A'..'Z','a'..'z','0'..'9','_','$'];

   var
      i, j, k : integer;
      token : string[toklength];
      t, tptr : tokenptr;
      v : varptr;
      ch : char;
      n, d, d1 : real;

   begin
      tptr := nil;
      buf := nil;
      i := 1;
      repeat
         ch := ' ';
         while (i <= strlen(inbuf^)) and (ch = ' ') do
            begin
               ch := inbuf^[i];
               i := i + 1;
            end;
         if ch <> ' ' then
            begin
               new(t);
               if tptr = nil then
                  buf := t
               else
                  tptr^.next := t;
               tptr := t;
               t^.next := nil;
               case ch of
                  'A'..'Z', 'a'..'z' :
                     begin
                        i := i - 1;
                        j := 0;
                        setstrlen(token, strmax(token));
                        while (i <= strlen(inbuf^)) and (inbuf^[i] in idchars) do
                           begin
                              if j < toklength then
                                 begin
                                    j := j + 1;
                                    token[j] := inbuf^[i];
                                 end;
                              i := i + 1;
                           end;
                        setstrlen(token, j);
                        if (token = 'and')     or (token = 'AND')     then t^.kind := tokand
                   else if (token = 'or')      or (token = 'OR')      then t^.kind := tokor
                   else if (token = 'xor')     or (token = 'XOR')     then t^.kind := tokxor
                   else if (token = 'not')     or (token = 'NOT')     then t^.kind := toknot
                   else if (token = 'mod')     or (token = 'MOD')     then t^.kind := tokmod
                   else if (token = 'sqr')     or (token = 'SQR')     then t^.kind := toksqr
                   else if (token = 'sqrt')    or (token = 'SQRT')    then t^.kind := toksqrt
                   else if (token = 'sin')     or (token = 'SIN')     then t^.kind := toksin
                   else if (token = 'cos')     or (token = 'COS')     then t^.kind := tokcos
                   else if (token = 'tan')     or (token = 'TAN')     then t^.kind := toktan
                   else if (token = 'arctan')  or (token = 'ARCTAN')  then t^.kind := tokarctan
                   else if (token = 'log')     or (token = 'LOG')     then t^.kind := toklog
                   else if (token = 'exp')     or (token = 'EXP')     then t^.kind := tokexp
                   else if (token = 'abs')     or (token = 'ABS')     then t^.kind := tokabs
                   else if (token = 'sgn')     or (token = 'SGN')     then t^.kind := toksgn
                   else if (token = 'str$')    or (token = 'STR$')    then t^.kind := tokstr_
                   else if (token = 'val')     or (token = 'VAL')     then t^.kind := tokval
                   else if (token = 'chr$')    or (token = 'CHR$')    then t^.kind := tokchr_
                   else if (token = 'asc')     or (token = 'ASC')     then t^.kind := tokasc
                   else if (token = 'len')     or (token = 'LEN')     then t^.kind := toklen
                   else if (token = 'mid$')    or (token = 'MID$')    then t^.kind := tokmid_
                   else if (token = 'peek')    or (token = 'PEEK')    then t^.kind := tokpeek
                   else if (token = 'let')     or (token = 'LET')     then t^.kind := toklet
                   else if (token = 'print')   or (token = 'PRINT')   then t^.kind := tokprint
                   else if (token = 'input')   or (token = 'INPUT')   then t^.kind := tokinput
                   else if (token = 'goto')    or (token = 'GOTO')    then t^.kind := tokgoto
                   else if (token = 'go to')   or (token = 'GO TO')   then t^.kind := tokgoto
                   else if (token = 'if')      or (token = 'IF')      then t^.kind := tokif
                   else if (token = 'end')     or (token = 'END')     then t^.kind := tokend
                   else if (token = 'stop')    or (token = 'STOP')    then t^.kind := tokstop
                   else if (token = 'for')     or (token = 'FOR')     then t^.kind := tokfor
                   else if (token = 'next')    or (token = 'NEXT')    then t^.kind := toknext
                   else if (token = 'while')   or (token = 'WHILE')   then t^.kind := tokwhile
                   else if (token = 'wend')    or (token = 'WEND')    then t^.kind := tokwend
                   else if (token = 'gosub')   or (token = 'GOSUB')   then t^.kind := tokgosub
                   else if (token = 'return')  or (token = 'RETURN')  then t^.kind := tokreturn
                   else if (token = 'read')    or (token = 'READ')    then t^.kind := tokread
                   else if (token = 'data')    or (token = 'DATA')    then t^.kind := tokdata
                   else if (token = 'restore') or (token = 'RESTORE') then t^.kind := tokrestore
                   else if (token = 'gotoxy')  or (token = 'GOTOXY')  then t^.kind := tokgotoxy
                   else if (token = 'on')      or (token = 'ON')      then t^.kind := tokon
                   else if (token = 'dim')     or (token = 'DIM')     then t^.kind := tokdim
                   else if (token = 'poke')    or (token = 'POKE')    then t^.kind := tokpoke
                   else if (token = 'list')    or (token = 'LIST')    then t^.kind := toklist
                   else if (token = 'run')     or (token = 'RUN')     then t^.kind := tokrun
                   else if (token = 'new')     or (token = 'NEW')     then t^.kind := toknew
                   else if (token = 'load')    or (token = 'LOAD')    then t^.kind := tokload
                   else if (token = 'merge')   or (token = 'MERGE')   then t^.kind := tokmerge
                   else if (token = 'save')    or (token = 'SAVE')    then t^.kind := toksave
                   else if (token = 'bye')     or (token = 'BYE')     then t^.kind := tokbye
                   else if (token = 'quit')    or (token = 'QUIT')    then t^.kind := tokbye
                   else if (token = 'del')     or (token = 'DEL')     then t^.kind := tokdel
                   else if (token = 'renum')   or (token = 'RENUM')   then t^.kind := tokrenum
                   else if (token = 'then')    or (token = 'THEN')    then t^.kind := tokthen
                   else if (token = 'else')    or (token = 'ELSE')    then t^.kind := tokelse
                   else if (token = 'to')      or (token = 'TO')      then t^.kind := tokto
                   else if (token = 'step')    or (token = 'STEP')    then t^.kind := tokstep
                   else if (token = 'rem')     or (token = 'REM')     then
                           begin
                              t^.kind := tokrem;
                              new(t^.sp);
                              t^.sp^ := str(inbuf^, i, strlen(inbuf^)-i+1);
                              i := strlen(inbuf^)+1;
                           end
                        else
                           begin
                              t^.kind := tokvar;
                              v := varbase;
                              while (v <> nil) and (v^.name <> token) do
                                 v := v^.next;
                              if v = nil then
                                 begin
                                    new(v);
                                    v^.next := varbase;
                                    varbase := v;
                                    v^.name := token;
                                    v^.numdims := 0;
                                    if token[strlen(token)] = '$' then
                                       begin
                                          v^.stringvar := true;
                                          v^.sv := nil;
                                          v^.sval := addr(v^.sv);
                                       end
                                    else
                                       begin
                                          v^.stringvar := false;
                                          v^.rv := 0;
                                          v^.val := addr(v^.rv);
                                       end;
                                 end;
                              t^.vp := v;
                           end;
                     end;
                  '"', '''' :
                     begin
                        t^.kind := tokstr;
                        new(t^.sp);
                        setstrlen(t^.sp^, 255);
                        j := 0;
                        while (i <= strlen(inbuf^)) and (inbuf^[i] <> ch) do
                           begin
                              j := j + 1;
                              t^.sp^[j] := inbuf^[i];
                              i := i + 1;
                           end;
                        setstrlen(t^.sp^, j);
                        i := i + 1;
                     end;
                  '0'..'9', '.' :
                     begin
                        t^.kind := toknum;
                        n := 0;
                        d := 1;
                        d1 := 1;
                        i := i - 1;
                        while (i <= strlen(inbuf^)) and ((inbuf^[i] in ['0'..'9'])
                                    or ((inbuf^[i] = '.') and (d1 = 1))) do
                           begin
                              if inbuf^[i] = '.' then
                                 d1 := 10
                              else
                                 begin
                                    n := n * 10 + ord(inbuf^[i]) - 48;
                                    d := d * d1;
                                 end;
                              i := i + 1;
                           end;
                        n := n / d;
                        if (i <= strlen(inbuf^)) and (inbuf^[i] in ['e','E']) then
                           begin
                              i := i + 1;
                              d1 := 10;
                              if (i <= strlen(inbuf^)) and (inbuf^[i] in ['+','-']) then
                                 begin
                                    if inbuf^[i] = '-' then
                                       d1 := 0.1;
                                    i := i + 1;
                                 end;
                              j := 0;
                              while (i <= strlen(inbuf^)) and (inbuf^[i] in ['0'..'9']) do
                                 begin
                                    j := j * 10 + ord(inbuf^[i]) - 48;
                                    i := i + 1;
                                 end;
                              for k := 1 to j do
                                 n := n * d1;
                           end;
                        t^.num := n;
                     end;
                  '+' : t^.kind := tokplus;
                  '-' : t^.kind := tokminus;
                  '*' : t^.kind := toktimes;
                  '/' : t^.kind := tokdiv;
                  '^' : t^.kind := tokup;
                  '(', '[' : t^.kind := toklp;
                  ')', ']' : t^.kind := tokrp;
                  ',' : t^.kind := tokcomma;
                  ';' : t^.kind := toksemi;
                  ':' : t^.kind := tokcolon;
                  '?' : t^.kind := tokprint;
                  '=' : t^.kind := tokeq;
                  '<' :
                     begin
                        if (i <= strlen(inbuf^)) and (inbuf^[i] = '=') then
                           begin
                              t^.kind := tokle;
                              i := i + 1;
                           end
                        else if (i <= strlen(inbuf^)) and (inbuf^[i] = '>') then
                           begin
                              t^.kind := tokne;
                              i := i + 1;
                           end
                        else
                           t^.kind := toklt;
                     end;
                  '>' :
                     begin
                        if (i <= strlen(inbuf^)) and (inbuf^[i] = '=') then
                           begin
                              t^.kind := tokge;
                              i := i + 1;
                           end
                        else
                           t^.kind := tokgt;
                     end;
                  otherwise
                     begin
                        t^.kind := toksnerr;
                        t^.snch := ch;
                     end;
               end;
            end;
      until i > strlen(inbuf^);
   end;



procedure listtokens(var f : text; buf : tokenptr);
   var
      ltr, ltr0 : boolean;
   begin
      ltr := false;
      while buf <> nil do
         begin
            if buf^.kind in [tokvar, toknum, toknot..tokrenum] then
               begin
                  if ltr then write(f, ' ');
                  ltr := (buf^.kind <> toknot);
               end
            else
               ltr := false;
            case buf^.kind of
               tokvar     : write(f, buf^.vp^.name);
               toknum     : write(f, numtostr(buf^.num));
               tokstr     : write(f, '"', buf^.sp^, '"');
               toksnerr   : write(f, '{', buf^.snch, '}');
               tokplus    : write(f, '+');
               tokminus   : write(f, '-');
               toktimes   : write(f, '*');
               tokdiv     : write(f, '/');
               tokup      : write(f, '^');
               toklp      : write(f, '(');
               tokrp      : write(f, ')');
               tokcomma   : write(f, ',');
               toksemi    : write(f, ';');
               tokcolon   : write(f, ' : ');
               tokeq      : write(f, ' = ');
               toklt      : write(f, ' < ');
               tokgt      : write(f, ' > ');
               tokle      : write(f, ' <= ');
               tokge      : write(f, ' >= ');
               tokne      : write(f, ' <> ');
               tokand     : write(f, ' AND ');
               tokor      : write(f, ' OR ');
               tokxor     : write(f, ' XOR ');
               tokmod     : write(f, ' MOD ');
               toknot     : write(f, 'NOT ');
               toksqr     : write(f, 'SQR');
               toksqrt    : write(f, 'SQRT');
               toksin     : write(f, 'SIN');
               tokcos     : write(f, 'COS');
               toktan     : write(f, 'TAN');
               tokarctan  : write(f, 'ARCTAN');
               toklog     : write(f, 'LOG');
               tokexp     : write(f, 'EXP');
               tokabs     : write(f, 'ABS');
               toksgn     : write(f, 'SGN');
               tokstr_    : write(f, 'STR$');
               tokval     : write(f, 'VAL');
               tokchr_    : write(f, 'CHR$');
               tokasc     : write(f, 'ASC');
               toklen     : write(f, 'LEN');
               tokmid_    : write(f, 'MID$');
               tokpeek    : write(f, 'PEEK');
               toklet     : write(f, 'LET');
               tokprint   : write(f, 'PRINT');
               tokinput   : write(f, 'INPUT');
               tokgoto    : write(f, 'GOTO');
               tokif      : write(f, 'IF');
               tokend     : write(f, 'END');
               tokstop    : write(f, 'STOP');
               tokfor     : write(f, 'FOR');
               toknext    : write(f, 'NEXT');
               tokwhile   : write(f, 'WHILE');
               tokwend    : write(f, 'WEND');
               tokgosub   : write(f, 'GOSUB');
               tokreturn  : write(f, 'RETURN');
               tokread    : write(f, 'READ');
               tokdata    : write(f, 'DATA');
               tokrestore : write(f, 'RESTORE');
               tokgotoxy  : write(f, 'GOTOXY');
               tokon      : write(f, 'ON');
               tokdim     : write(f, 'DIM');
               tokpoke    : write(f, 'POKE');
               toklist    : write(f, 'LIST');
               tokrun     : write(f, 'RUN');
               toknew     : write(f, 'NEW');
               tokload    : write(f, 'LOAD');
               tokmerge   : write(f, 'MERGE');
               toksave    : write(f, 'SAVE');
               tokdel     : write(f, 'DEL');
               tokbye     : write(f, 'BYE');
               tokrenum   : write(f, 'RENUM');
               tokthen    : write(f, ' THEN ');
               tokelse    : write(f, ' ELSE ');
               tokto      : write(f, ' TO ');
               tokstep    : write(f, ' STEP ');
               tokrem     : write(f, 'REM', buf^.sp^);
            end;
            buf := buf^.next;
         end;
   end;



procedure disposetokens(var tok : tokenptr);
   var
      tok1 : tokenptr;
   begin
      while tok <> nil do
         begin
            tok1 := tok^.next;
            if tok^.kind in [tokstr, tokrem] then
               dispose(tok^.sp);
            dispose(tok);
            tok := tok1;
         end;
   end;



procedure parseinput(var buf : tokenptr);
   var
      l, l0, l1 : lineptr;
   begin
      inbuf^ := strltrim(inbuf^);
      curline := 0;
      while (strlen(inbuf^) <> 0) and (inbuf^[1] in ['0'..'9']) do
         begin
            curline := curline * 10 + ord(inbuf^[1]) - 48;
            strdelete(inbuf^, 1, 1);
         end;
      parse(inbuf, buf);
      if curline <> 0 then
         begin
            l := linebase;
            l0 := nil;
            while (l <> nil) and (l^.num < curline) do
               begin
                  l0 := l;
                  l := l^.next;
               end;
            if (l <> nil) and (l^.num = curline) then
               begin
                  l1 := l;
                  l := l^.next;
                  if l0 = nil then
                     linebase := l
                  else
                     l0^.next := l;
                  disposetokens(l1^.txt);
                  dispose(l1);
               end;
            if buf <> nil then
               begin
                  new(l1);
                  l1^.next := l;
                  if l0 = nil then
                     linebase := l1
                  else
                     l0^.next := l1;
                  l1^.num := curline;
                  l1^.txt := buf;
               end;
            clearloops;
            restoredata;
         end;
   end;





procedure errormsg(s : string255);
   begin
      write(#7, s);
      escape(42);
   end;


procedure snerr;
   begin
      errormsg('Syntax error');
   end;

procedure tmerr;
   begin
      errormsg('Type mismatch error');
   end;

procedure badsubscr;
   begin
      errormsg('Bad subscript');
   end;






procedure exec;

   var
      gotoflag, elseflag : boolean;
      t : tokenptr;
      ioerrmsg : string255ptr;


   function factor : valrec;
      forward;

   function expr : valrec;
      forward;

   function realfactor : real;
      var
         n : valrec;
      begin
         n := factor;
         if n.stringval then tmerr;
         realfactor := n.val;
      end;

   function strfactor : basicstring;
      var
         n : valrec;
      begin
         n := factor;
         if not n.stringval then tmerr;
         strfactor := n.sval;
      end;

   function stringfactor : string255;
      var
         n : valrec;
      begin
         n := factor;
         if not n.stringval then tmerr;
         stringfactor := n.sval^;
         dispose(n.sval);
      end;

   function intfactor : integer;
      begin
         intfactor := round(realfactor);
      end;

   function realexpr : real;
      var
         n : valrec;
      begin
         n := expr;
         if n.stringval then tmerr;
         realexpr := n.val;
      end;

   function strexpr : basicstring;
      var
         n : valrec;
      begin
         n := expr;
         if not n.stringval then tmerr;
         strexpr := n.sval;
      end;

   function stringexpr : string255;
      var
         n : valrec;
      begin
         n := expr;
         if not n.stringval then tmerr;
         stringexpr := n.sval^;
         dispose(n.sval);
      end;

   function intexpr : integer;
      begin
         intexpr := round(realexpr);
      end;


   procedure require(k : tokenkinds);
      begin
         if (t = nil) or (t^.kind <> k) then
            snerr;
         t := t^.next;
      end;


   procedure skipparen;
      label 1;
      begin
         repeat
            if t = nil then snerr;
            if (t^.kind = tokrp) or (t^.kind = tokcomma) then
               goto 1;
            if t^.kind = toklp then
               begin
                  t := t^.next;
                  skipparen;
               end;
            t := t^.next;
         until false;
       1 :
      end;


   function findvar : varptr;
      var
         v : varptr;
         i, j, k : integer;
         tok : tokenptr;
      begin
         if (t = nil) or (t^.kind <> tokvar) then snerr;
         v := t^.vp;
         t := t^.next;
         if (t <> nil) and (t^.kind = toklp) then
            with v^ do
               begin
                  if numdims = 0 then
                     begin
                        tok := t;
                        i := 0;
                        j := 1;
                        repeat
                           if i >= maxdims then badsubscr;
                           t := t^.next;
                           skipparen;
                           j := j * 11;
                           i := i + 1;
                           dims[i] := 11;
                        until t^.kind = tokrp;
                        numdims := i;
                        if stringvar then
                           begin
                              hpm_new(sarr, j*4);
                              for k := 0 to j-1 do
                                 sarr^[k] := nil;
                           end
                        else
                           begin
                              hpm_new(arr, j*8);
                              for k := 0 to j-1 do
                                 arr^[k] := 0;
                           end;
                        t := tok;
                     end;
                  k := 0;
                  t := t^.next;
                  for i := 1 to numdims do
                     begin
                        j := intexpr;
                        if (j < 0) or (j >= dims[i]) then
                           badsubscr;
                        k := k * dims[i] + j;
                        if i < numdims then
                           require(tokcomma);
                     end;
                  require(tokrp);
                  if stringvar then
                      sval := addr(sarr^[k])
                  else
                      val := addr(arr^[k]);
               end
         else
            begin
               if v^.numdims <> 0 then
                  badsubscr;
            end;
         findvar := v;
      end;


   function inot(i : integer) : integer;
      begin
         inot := -1 - i;
      end;

   function ixor(a, b : integer) : integer;
      begin
         ixor := asm_ior(asm_iand(a, inot(b)), asm_iand(inot(a), b));
      end;


   function factor : valrec;
      var
         v : varptr;
         facttok : tokenptr;
         n : valrec;
         i, j : integer;
         tok, tok1 : tokenptr;
         s : basicstring;
         trick :
            record
               case boolean of
                  true : (i : integer);
                  false : (c : ^char);
            end;
      begin
         if t = nil then snerr;
         facttok := t;
         t := t^.next;
         n.stringval := false;
         case facttok^.kind of
            toknum :
               n.val := facttok^.num;
            tokstr :
               begin
                  n.stringval := true;
                  new(n.sval);
                  n.sval^ := facttok^.sp^;
               end;
            tokvar :
               begin
                  t := facttok;
                  v := findvar;
                  n.stringval := v^.stringvar;
                  if n.stringval then
                     begin
                        new(n.sval);
                        n.sval^ := v^.sval^^;
                     end
                  else
                     n.val := v^.val^;
               end;
            toklp :
               begin
                  n := expr;
                  require(tokrp);
               end;
            tokminus :
               n.val := - realfactor;
            tokplus :
               n.val := realfactor;
            toknot :
               n.val := inot(intfactor);
            toksqr :
               n.val := sqr(realfactor);
            toksqrt :
               n.val := sqrt(realfactor);
            toksin :
               n.val := sin(realfactor);
            tokcos :
               n.val := cos(realfactor);
            toktan :
               begin
                  n.val := realfactor;
                  n.val := sin(n.val) / cos(n.val);
               end;
            tokarctan :
               n.val := arctan(realfactor);
            toklog:
               n.val := ln(realfactor);
            tokexp :
               n.val := exp(realfactor);
            tokabs :
               n.val := abs(realfactor);
            toksgn :
               begin
                  n.val := realfactor;
                  n.val := ord(n.val > 0) - ord(n.val < 0);
               end;
            tokstr_ :
               begin
                  n.stringval := true;
                  new(n.sval);
                  n.sval^ := numtostr(realfactor);
               end;
            tokval :
               begin
                  s := strfactor;
                  tok1 := t;
                  parse(s, t);
                  tok := t;
                  if tok = nil then
                     n.val := 0
                  else
                     n := expr;
                  disposetokens(tok);
                  t := tok1;
                  dispose(s);
               end;
            tokchr_ :
               begin
                  n.stringval := true;
                  new(n.sval);
                  n.sval^ := ' ';
                  n.sval^[1] := chr(intfactor);
               end;
            tokasc :
               begin
                  s := strfactor;
                  if strlen(s^) = 0 then
                     n.val := 0
                  else
                     n.val := ord(s^[1]);
                  dispose(s);
               end;
            tokmid_ :
               begin
                  n.stringval := true;
                  require(toklp);
                  n.sval := strexpr;
                  require(tokcomma);
                  i := intexpr;
                  if i < 1 then i := 1;
                  j := 255;
                  if (t <> nil) and (t^.kind = tokcomma) then
                     begin
                        t := t^.next;
                        j := intexpr;
                     end;
                  if j > strlen(n.sval^)-i+1 then
                     j := strlen(n.sval^)-i+1;
                  if i > strlen(n.sval^) then
                     n.sval^ := ''
                  else
                     n.sval^ := str(n.sval^, i, j);
                  require(tokrp);
               end;
            toklen :
               begin
                  s := strfactor;
                  n.val := strlen(s^);
                  dispose(s);
               end;
            tokpeek :
               begin
                  $range off$
                  trick.i := intfactor;
                  n.val := ord(trick.c^);
                  $if checking$ $range on$ $end$
               end;
            otherwise
               snerr;
         end;
         factor := n;
      end;

   function upexpr : valrec;
      var
         n, n2 : valrec;
      begin
         n := factor;
         while (t <> nil) and (t^.kind = tokup) do
            begin
               if n.stringval then tmerr;
               t := t^.next;
               n2 := upexpr;
               if n2.stringval then tmerr;
               if n.val < 0 then
                  begin
                     if n2.val <> trunc(n2.val) then n.val := ln(n.val);
                     n.val := exp(n2.val * ln(-n.val));
                     if odd(trunc(n2.val)) then
                        n.val := - n.val;
                  end
               else
                  n.val := exp(n2.val * ln(n.val));
            end;
         upexpr := n;
      end;

   function term : valrec;
      var
         n, n2 : valrec;
         k : tokenkinds;
      begin
         n := upexpr;
         while (t <> nil) and (t^.kind in [toktimes, tokdiv, tokmod]) do
            begin
               k := t^.kind;
               t := t^.next;
               n2 := upexpr;
               if n.stringval or n2.stringval then tmerr;
               if k = tokmod then
                  n.val := round(n.val) mod round(n2.val)
               else if k = toktimes then
                  n.val := n.val * n2.val
               else
                  n.val := n.val / n2.val;
            end;
         term := n;
      end;

   function sexpr : valrec;
      var
         n, n2 : valrec;
         k : tokenkinds;
      begin
         n := term;
         while (t <> nil) and (t^.kind in [tokplus, tokminus]) do
            begin
               k := t^.kind;
               t := t^.next;
               n2 := term;
               if n.stringval <> n2.stringval then tmerr;
               if k = tokplus then
                  if n.stringval then
                     begin
                        n.sval^ := n.sval^ + n2.sval^;
                        dispose(n2.sval);
                     end
                  else
                     n.val := n.val + n2.val
               else
                  if n.stringval then
                     tmerr
                  else
                     n.val := n.val - n2.val;
            end;
         sexpr := n;
      end;

   function relexpr : valrec;
      var
         n, n2 : valrec;
         f : boolean;
         k : tokenkinds;
      begin
         n := sexpr;
         while (t <> nil) and (t^.kind in [tokeq..tokne]) do
            begin
               k := t^.kind;
               t := t^.next;
               n2 := sexpr;
               if n.stringval <> n2.stringval then tmerr;
               if n.stringval then
                  begin
                     f := ((n.sval^ = n2.sval^) and (k in [tokeq, tokge, tokle]) or
                           (n.sval^ < n2.sval^) and (k in [toklt, tokle, tokne]) or
                           (n.sval^ > n2.sval^) and (k in [tokgt, tokge, tokne]));
                     dispose(n.sval);
                     dispose(n2.sval);
                  end
               else
                  f := ((n.val = n2.val) and (k in [tokeq, tokge, tokle]) or
                        (n.val < n2.val) and (k in [toklt, tokle, tokne]) or
                        (n.val > n2.val) and (k in [tokgt, tokge, tokne]));
               n.stringval := false;
               n.val := ord(f);
            end;
         relexpr := n;
      end;

   function andexpr : valrec;
      var
         n, n2 : valrec;
      begin
         n := relexpr;
         while (t <> nil) and (t^.kind = tokand) do
            begin
               t := t^.next;
               n2 := relexpr;
               if n.stringval or n2.stringval then tmerr;
               n.val := asm_iand(trunc(n.val), trunc(n2.val));
            end;
         andexpr := n;
      end;

   function expr : valrec;
      var
         n, n2 : valrec;
         k : tokenkinds;
      begin
         n := andexpr;
         while (t <> nil) and (t^.kind in [tokor, tokxor]) do
            begin
               k := t^.kind;
               t := t^.next;
               n2 := andexpr;
               if n.stringval or n2.stringval then tmerr;
               if k = tokor then
                  n.val := asm_ior(trunc(n.val), trunc(n2.val))
               else
                  n.val := ixor(trunc(n.val), trunc(n2.val));
            end;
         expr := n;
      end;


   procedure checkextra;
      begin
         if t <> nil then
            errormsg('Extra information on line');
      end;


   function iseos : boolean;
      begin
         iseos := (t = nil) or (t^.kind in [tokcolon, tokelse]);
      end;


   procedure skiptoeos;
      begin
         while not iseos do
            t := t^.next;
      end;


   function findline(n : integer) : lineptr;
      var
         l : lineptr;
      begin
         l := linebase;
         while (l <> nil) and (l^.num <> n) do
            l := l^.next;
         findline := l;
      end;


   function mustfindline(n : integer) : lineptr;
      var
         l : lineptr;
      begin
         l := findline(n);
         if l = nil then
            errormsg('Undefined line');
         mustfindline := l;
      end;


   procedure cmdend;
      begin
         stmtline := nil;
         t := nil;
      end;


   procedure cmdnew;
      var
         p : anyptr;
      begin
         cmdend;
         clearloops;
         restoredata;
         while linebase <> nil do
            begin
               p := linebase^.next;
               disposetokens(linebase^.txt);
               dispose(linebase);
               linebase := p;
            end;
         while varbase <> nil do
            begin
               p := varbase^.next;
               if varbase^.stringvar then
                  if varbase^.sval^ <> nil then
                     dispose(varbase^.sval^);
               dispose(varbase);
               varbase := p;
            end;
      end;


   procedure cmdlist;
      var
         l : lineptr;
         n1, n2 : integer;
      begin
         repeat
            n1 := 0;
            n2 := maxint;
            if (t <> nil) and (t^.kind = toknum) then
               begin
                  n1 := trunc(t^.num);
                  t := t^.next;
                  if (t = nil) or (t^.kind <> tokminus) then
                     n2 := n1;
               end;
            if (t <> nil) and (t^.kind = tokminus) then
               begin
                  t := t^.next;
                  if (t <> nil) and (t^.kind = toknum) then
                     begin
                        n2 := trunc(t^.num);
                        t := t^.next;
                     end
                  else
                     n2 := maxint;
               end;
            l := linebase;
            while (l <> nil) and (l^.num <= n2) do
               begin
                  if (l^.num >= n1) then
                     begin
                        write(l^.num:1, ' ');
                        listtokens(output, l^.txt);
                        writeln;
                     end;
                  l := l^.next;
               end;
            if not iseos then
               require(tokcomma);
         until iseos;
      end;


   procedure cmdload(merging : boolean; name : string255);
      var
         f : text;
         buf : tokenptr;
      begin
         if not merging then
            cmdnew;
         reset(f, name + '.TXT', 'shared');
         while not eof(f) do
            begin
               readln(f, inbuf^);
               parseinput(buf);
               if curline = 0 then
                  begin
                     writeln('Bad line in file');
                     disposetokens(buf);
                  end;
            end;
         close(f);
      end;


   procedure cmdrun;
      var
         l : lineptr;
         i : integer;
         s : string255;
      begin
         l := linebase;
         if not iseos then
            begin
               if t^.kind = toknum then
                  l := mustfindline(intexpr)
               else
                  begin
                     s := stringexpr;
                     i := 0;
                     if not iseos then
                        begin
                           require(tokcomma);
                           i := intexpr;
                        end;
                     checkextra;
                     cmdload(false, s);
                     if i = 0 then
                        l := linebase
                     else
                        l := mustfindline(i)
                  end
            end;
         stmtline := l;
         gotoflag := true;
         clearvars;
         clearloops;
         restoredata;
      end;


   procedure cmdsave;
      var
         f : text;
         l : lineptr;
      begin
         rewrite(f, stringexpr + '.TXT');
         l := linebase;
         while l <> nil do
            begin
               write(f, l^.num:1, ' ');
               listtokens(f, l^.txt);
               writeln(f);
               l := l^.next;
            end;
         close(f, 'save');
      end;


   procedure cmdbye;
      begin
         exitflag := true;
      end;


   procedure cmddel;
      var
         l, l0, l1 : lineptr;
         n1, n2 : integer;
      begin
         repeat
            if iseos then snerr;
            n1 := 0;
            n2 := maxint;
            if (t <> nil) and (t^.kind = toknum) then
               begin
                  n1 := trunc(t^.num);
                  t := t^.next;
                  if (t = nil) or (t^.kind <> tokminus) then
                     n2 := n1;
               end;
            if (t <> nil) and (t^.kind = tokminus) then
               begin
                  t := t^.next;
                  if (t <> nil) and (t^.kind = toknum) then
                     begin
                        n2 := trunc(t^.num);
                        t := t^.next;
                     end
                  else
                     n2 := maxint;
               end;
            l := linebase;
            l0 := nil;
            while (l <> nil) and (l^.num <= n2) do
               begin
                  l1 := l^.next;
                  if (l^.num >= n1) then
                     begin
                        if l = stmtline then
                           begin
                              cmdend;
                              clearloops;
                              restoredata;
                           end;
                        if l0 = nil then
                           linebase := l^.next
                        else
                           l0^.next := l^.next;
                        disposetokens(l^.txt);
                        dispose(l);
                     end
                  else
                     l0 := l;
                  l := l1;
               end;
            if not iseos then
               require(tokcomma);
         until iseos;
      end;


   procedure cmdrenum;
      var
         l, l1 : lineptr;
         tok : tokenptr;
         lnum, step : integer;
      begin
         lnum := 10;
         step := 10;
         if not iseos then
            begin
               lnum := intexpr;
               if not iseos then
                  begin
                     require(tokcomma);
                     step := intexpr;
                  end;
            end;
         l := linebase;
         if l <> nil then
            begin
               while l <> nil do
                  begin
                     l^.num2 := lnum;
                     lnum := lnum + step;
                     l := l^.next;
                  end;
               l := linebase;
               repeat
                  tok := l^.txt;
                  repeat
                     if tok^.kind in [tokgoto, tokgosub, tokthen, tokelse,
                                      tokrun, toklist, tokrestore, tokdel] then
                        while (tok^.next <> nil) and (tok^.next^.kind = toknum) do
                           begin
                              tok := tok^.next;
                              lnum := round(tok^.num);
                              l1 := linebase;
                              while (l1 <> nil) and (l1^.num <> lnum) do
                                 l1 := l1^.next;
                              if l1 = nil then
                                 writeln('Undefined line ', lnum:1, ' in line ', l^.num2:1)
                              else
                                 tok^.num := l1^.num2;
                              if (tok^.next <> nil) and (tok^.next^.kind = tokcomma) then
                                 tok := tok^.next;
                           end;
                     tok := tok^.next;
                  until tok = nil;
                  l := l^.next;
               until l = nil;
               l := linebase;
               while l <> nil do
                  begin
                     l^.num := l^.num2;
                     l := l^.next;
                  end;
            end;
      end;


   procedure cmdprint;
      var
         semiflag : boolean;
         n : valrec;
      begin
         semiflag := false;
         while not iseos do
            begin
               semiflag := false;
               if t^.kind in [toksemi, tokcomma] then
                  begin
                     semiflag := true;
                     t := t^.next;
                  end
               else
                  begin
                     n := expr;
                     if n.stringval then
                        begin
                           write(n.sval^);
                           dispose(n.sval);
                        end
                     else
                        write(numtostr(n.val), ' ');
                  end;
            end;
         if not semiflag then
            writeln;
      end;


   procedure cmdinput;
      var
         v : varptr;
         s : string255;
         tok, tok0, tok1 : tokenptr;
         strflag : boolean;
      begin
         if (t <> nil) and (t^.kind = tokstr) then
            begin
               write(t^.sp^);
               t := t^.next;
               require(toksemi);
            end
         else
            begin
               write('? ');
            end;
         tok := t;
         if (t = nil) or (t^.kind <> tokvar) then snerr;
         strflag := t^.vp^.stringvar;
         repeat
            if (t <> nil) and (t^.kind = tokvar) then
               if t^.vp^.stringvar <> strflag then snerr;
            t := t^.next;
         until iseos;
         t := tok;
         if strflag then
            begin
               repeat
                  readln(s);
                  v := findvar;
                  if v^.sval^ <> nil then
                     dispose(v^.sval^);
                  new(v^.sval^);
                  v^.sval^^ := s;
                  if not iseos then
                     begin
                        require(tokcomma);
                        write('?? ');
                     end;
               until iseos;
            end
         else
            begin
               readln(s);
               parse(addr(s), tok);
               tok0 := tok;
               repeat
                  v := findvar;
                  while tok = nil do
                     begin
                        write('?? ');
                        readln(s);
                        disposetokens(tok0);
                        parse(addr(s), tok);
                        tok0 := tok;
                     end;
                  tok1 := t;
                  t := tok;
                  v^.val^ := realexpr;
                  if t <> nil then
                     if t^.kind = tokcomma then
                        t := t^.next
                     else
                        snerr;
                  tok := t;
                  t := tok1;
                  if not iseos then
                     require(tokcomma);
               until iseos;
               disposetokens(tok0);
            end;
      end;


   procedure cmdlet(implied : boolean);
      var
         v : varptr;
     old : basicstring;
      begin
         if implied then
            t := stmttok;
         v := findvar;
         require(tokeq);
         if v^.stringvar then
            begin
               old := v^.sval^;
               v^.sval^ := strexpr;
               if old <> nil then
                  dispose(old);
            end
         else
            v^.val^ := realexpr;
      end;


   procedure cmdgoto;
      begin
         stmtline := mustfindline(intexpr);
         t := nil;
         gotoflag := true;
      end;


   procedure cmdif;
      var
         n : real;
         i : integer;
      begin
         n := realexpr;
         require(tokthen);
         if n = 0 then
            begin
               i := 0;
               repeat
                  if t <> nil then
                     begin
                        if t^.kind = tokif then
                           i := i + 1;
                        if t^.kind = tokelse then
                           i := i - 1;
                        t := t^.next;
                     end;
               until (t = nil) or (i < 0);
            end;
         if (t <> nil) and (t^.kind = toknum) then
            cmdgoto
         else
            elseflag := true;
      end;


   procedure cmdelse;
      begin
         t := nil;
      end;


   function skiploop(up, dn : tokenkinds) : boolean;
      label 1;
      var
         i : integer;
         saveline : lineptr;
      begin
         saveline := stmtline;
         i := 0;
         repeat
            while t = nil do
               begin
                  if (stmtline = nil) or (stmtline^.next = nil) then
                     begin
                        skiploop := false;
                        stmtline := saveline;
                        goto 1;
                     end;
                  stmtline := stmtline^.next;
                  t := stmtline^.txt;
               end;
            if t^.kind = up then
               i := i + 1;
            if t^.kind = dn then
               i := i - 1;
            t := t^.next;
         until i < 0;
         skiploop := true;
     1 :
      end;


   procedure cmdfor;
      var
         l : loopptr;
         lr : looprec;
         saveline : lineptr;
         i, j : integer;
      begin
         lr.vp := findvar;
         if lr.vp^.stringvar then snerr;
         require(tokeq);
         lr.vp^.val^ := realexpr;
         require(tokto);
         lr.max := realexpr;
         if (t <> nil) and (t^.kind = tokstep) then
            begin
               t := t^.next;
               lr.step := realexpr;
            end
         else
            lr.step := 1;
         lr.homeline := stmtline;
         lr.hometok := t;
         lr.kind := forloop;
         lr.next := loopbase;
         with lr do
            if ((step >= 0) and (vp^.val^ > max)) or ((step <= 0) and (vp^.val^ < max)) then
               begin
                  saveline := stmtline;
                  i := 0;
                  j := 0;
                  repeat
                     while t = nil do
                        begin
                           if (stmtline = nil) or (stmtline^.next = nil) then
                              begin
                                 stmtline := saveline;
                                 errormsg('FOR without NEXT');
                              end;
                           stmtline := stmtline^.next;
                           t := stmtline^.txt;
                        end;
                     if t^.kind = tokfor then
                        if (t^.next <> nil) and (t^.next^.kind = tokvar) and (t^.next^.vp = vp) then
                           j := j + 1
                        else
                           i := i + 1;
                     if (t^.kind = toknext) then
                        if (t^.next <> nil) and (t^.next^.kind = tokvar) and (t^.next^.vp = vp) then
                           j := j - 1
                        else
                           i := i - 1;
                     t := t^.next;
                  until (i < 0) or (j < 0);
                  skiptoeos;
               end
            else
               begin
                  new(l);
                  l^ := lr;
                  loopbase := l;
               end;
      end;


   procedure cmdnext;
      var
         v : varptr;
         found : boolean;
         l : loopptr;
      begin
         if not iseos then
            v := findvar
         else
            v := nil;
         repeat
            if (loopbase = nil) or (loopbase^.kind = gosubloop) then
               errormsg('NEXT without FOR');
            found := (loopbase^.kind = forloop) and
                     ((v = nil) or (loopbase^.vp = v));
            if not found then
               begin
                  l := loopbase^.next;
                  dispose(loopbase);
                  loopbase := l;
               end;
         until found;
         with loopbase^ do
            begin
               vp^.val^ := vp^.val^ + step;
               if ((step >= 0) and (vp^.val^ > max)) or ((step <= 0) and (vp^.val^ < max)) then
                  begin
                     l := loopbase^.next;
                     dispose(loopbase);
                     loopbase := l;
                  end
               else
                  begin
                     stmtline := homeline;
                     t := hometok;
                  end;
            end;
      end;


   procedure cmdwhile;
      var
         l : loopptr;
      begin
         new(l);
         l^.next := loopbase;
         loopbase := l;
         l^.kind := whileloop;
         l^.homeline := stmtline;
         l^.hometok := t;
         if not iseos then
            if realexpr = 0 then
               begin
                  if not skiploop(tokwhile, tokwend) then
                     errormsg('WHILE without WEND');
                  l := loopbase^.next;
                  dispose(loopbase);
                  loopbase := l;
                  skiptoeos;
               end;
      end;


   procedure cmdwend;
      var
         tok : tokenptr;
         tokline : lineptr;
         l : loopptr;
         found : boolean;
      begin
         repeat
            if (loopbase = nil) or (loopbase^.kind = gosubloop) then
               errormsg('WEND without WHILE');
            found := (loopbase^.kind = whileloop);
            if not found then
               begin
                  l := loopbase^.next;
                  dispose(loopbase);
                  loopbase := l;
               end;
         until found;
         if not iseos then
            if realexpr <> 0 then
               found := false;
         tok := t;
         tokline := stmtline;
         if found then
            begin
               stmtline := loopbase^.homeline;
               t := loopbase^.hometok;
               if not iseos then
                  if realexpr = 0 then
                     found := false;
            end;
         if not found then
            begin
               t := tok;
               stmtline := tokline;
               l := loopbase^.next;
               dispose(loopbase);
               loopbase := l;
            end;
      end;


   procedure cmdgosub;
      var
         l : loopptr;
      begin
         new(l);
         l^.next := loopbase;
         loopbase := l;
         l^.kind := gosubloop;
         l^.homeline := stmtline;
         l^.hometok := t;
         cmdgoto;
      end;


   procedure cmdreturn;
      var
         l : loopptr;
         found : boolean;
      begin
         repeat
            if loopbase = nil then
               errormsg('RETURN without GOSUB');
            found := (loopbase^.kind = gosubloop);
            if not found then
               begin
                  l := loopbase^.next;
                  dispose(loopbase);
                  loopbase := l;
               end;
         until found;
         stmtline := loopbase^.homeline;
         t := loopbase^.hometok;
         l := loopbase^.next;
         dispose(loopbase);
         loopbase := l;
         skiptoeos;
      end;


   procedure cmdread;
      var
         v : varptr;
         tok : tokenptr;
         found : boolean;
      begin
         repeat
            v := findvar;
            tok := t;
            t := datatok;
            if dataline = nil then
               begin
                  dataline := linebase;
                  t := dataline^.txt;
               end;
            if (t = nil) or (t^.kind <> tokcomma) then
               repeat
                  while t = nil do
                     begin
                        if (dataline = nil) or (dataline^.next = nil) then
                           errormsg('Out of Data');
                        dataline := dataline^.next;
                        t := dataline^.txt;
                     end;
                  found := (t^.kind = tokdata);
                  t := t^.next;
               until found and not iseos
            else
               t := t^.next;
            if v^.stringvar then
               begin
                  if v^.sval^ <> nil then
                     dispose(v^.sval^);
                  v^.sval^ := strexpr;
               end
            else
               v^.val^ := realexpr;
            datatok := t;
            t := tok;
            if not iseos then
               require(tokcomma);
         until iseos;
      end;


   procedure cmddata;
      begin
         skiptoeos;
      end;


   procedure cmdrestore;
      begin
         if iseos then
            restoredata
         else
            begin
               dataline := mustfindline(intexpr);
               datatok := dataline^.txt;
            end;
      end;


   procedure cmdgotoxy;
      var
         i : integer;
      begin
         i := intexpr;
         require(tokcomma);
         gotoxy(i, intexpr);
      end;


   procedure cmdon;
      var
         i : integer;
         l : loopptr;
      begin
         i := intexpr;
         if (t <> nil) and (t^.kind = tokgosub) then
            begin
               new(l);
               l^.next := loopbase;
               loopbase := l;
               l^.kind := gosubloop;
               l^.homeline := stmtline;
               l^.hometok := t;
               t := t^.next;
            end
         else
            require(tokgoto);
         if i < 1 then
            skiptoeos
         else
            begin
               while (i > 1) and not iseos do
                  begin
                     require(toknum);
                     if not iseos then
                        require(tokcomma);
                     i := i - 1;
                  end;
               if not iseos then
                  cmdgoto;
            end;
      end;


   procedure cmddim;
      var
         i, j, k : integer;
         v : varptr;
         done : boolean;
      begin
         repeat
            if (t = nil) or (t^.kind <> tokvar) then snerr;
            v := t^.vp;
            t := t^.next;
            with v^ do
               begin
                  if numdims <> 0 then
                     errormsg('Array already dimensioned');
                  j := 1;
                  i := 0;
                  require(toklp);
                  repeat
                     k := intexpr + 1;
                     if k < 1 then badsubscr;
                     if i >= maxdims then badsubscr;
                     i := i + 1;
                     dims[i] := k;
                     j := j * k;
                     done := (t <> nil) and (t^.kind = tokrp);
                     if not done then
                        require(tokcomma);
                  until done;
                  t := t^.next;
                  numdims := i;
                  if stringvar then
                     begin
                        hpm_new(sarr, j*4);
                        for i := 0 to j-1 do
                           sarr^[i] := nil;
                     end
                  else
                     begin
                        hpm_new(arr, j*8);
                        for i := 0 to j-1 do
                           arr^[i] := 0;
                     end;
               end;
            if not iseos then
               require(tokcomma);
         until iseos;
      end;


   procedure cmdpoke;
      var
         trick :
            record
               case boolean of
                  true : (i : integer);
                  false : (c : ^char);
            end;
      begin
         $range off$
         trick.i := intexpr;
         require(tokcomma);
         trick.c^ := chr(intexpr);
         $if checking$ $range on$ $end$
      end;


   begin {exec}
      try
         repeat
            repeat
               gotoflag := false;
               elseflag := false;
               while (stmttok <> nil) and (stmttok^.kind = tokcolon) do
                  stmttok := stmttok^.next;
               t := stmttok;
               if t <> nil then
                  begin
                     t := t^.next;
                     case stmttok^.kind of
                        tokrem     : ;
                        toklist    : cmdlist;
                        tokrun     : cmdrun;
                        toknew     : cmdnew;
                        tokload    : cmdload(false, stringexpr);
                        tokmerge   : cmdload(true, stringexpr);
                        toksave    : cmdsave;
                        tokbye     : cmdbye;
                        tokdel     : cmddel;
                        tokrenum   : cmdrenum;
                        toklet     : cmdlet(false);
                        tokvar     : cmdlet(true);
                        tokprint   : cmdprint;
                        tokinput   : cmdinput;
                        tokgoto    : cmdgoto;
                        tokif      : cmdif;
                        tokelse    : cmdelse;
                        tokend     : cmdend;
                        tokstop    : escape(-20);
                        tokfor     : cmdfor;
                        toknext    : cmdnext;
                        tokwhile   : cmdwhile;
                        tokwend    : cmdwend;
                        tokgosub   : cmdgosub;
                        tokreturn  : cmdreturn;
                        tokread    : cmdread;
                        tokdata    : cmddata;
                        tokrestore : cmdrestore;
                        tokgotoxy  : cmdgotoxy;
                        tokon      : cmdon;
                        tokdim     : cmddim;
                        tokpoke    : cmdpoke;
                     otherwise
                        errormsg('Illegal command');
                     end;
                  end;
               if not elseflag and not iseos then
                  checkextra;
               stmttok := t;
            until t = nil;
            if stmtline <> nil then
               begin
                  if not gotoflag then
                     stmtline := stmtline^.next;
                  if stmtline <> nil then
                     stmttok := stmtline^.txt;
               end;
         until stmtline = nil;
      recover
         begin
            if escapecode = -20 then
               begin
                  write('Break');
               end
            else if escapecode = 42 then
               begin end
            else
               case escapecode of
                  -4 : write(#7'Integer overflow');
                  -5 : write(#7'Divide by zero');
                  -6 : write(#7'Real math overflow');
                  -7 : write(#7'Real math underflow');
                  -8, -19..-15 : write(#7'Value range error');
                  -10 :
                     begin
                        new(ioerrmsg);
                        misc_getioerrmsg(ioerrmsg^, ioresult);
                        write(#7, ioerrmsg^);
                        dispose(ioerrmsg);
                     end;
                  otherwise
                     begin
                        if excp_line <> -1 then
                           writeln(excp_line);
                        escape(escapecode);
                     end;
               end;
            if stmtline <> nil then
               write(' in ', stmtline^.num:1);
            writeln;
         end;
   end; {exec}





begin {main}
   new(inbuf);
   linebase := nil;
   varbase := nil;
   loopbase := nil;
   writeln('Chipmunk BASIC 1.0');
   writeln;
   exitflag := false;
   repeat
      try
         repeat
            write('>');
            readln(inbuf^);
            parseinput(buf);
            if curline = 0 then
               begin
                  stmtline := nil;
                  stmttok := buf;
                  if stmttok <> nil then
                     exec;
                  disposetokens(buf);
               end;
         until exitflag or eof(input);
      recover
         if escapecode <> -20 then
            misc_printerror(escapecode, ioresult)
         else
            writeln;
   until exitflag or eof(input);
end.