编译器/解释器

开发平台：
C/C++

basic.p.1：源码内容
							
$ 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 + '.TEXT', '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 + '.TEXT');
         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;

						