home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 2 / FFMCD02.bin / new / dev / misc / p2c / examples / basic.p < prev    next >
Text File  |  1993-12-21  |  67KB  |  2,247 lines
  1.  
  2. $ sysprog, ucsd, heap_dispose, partial_eval $
  3.  
  4. {$ debug$}
  5.  
  6. { Added some hacks to allow interrupting BASIC programs by pressing
  7.   CTRL-C on the console. This will only work on the AMIGA. It will
  8.   slow down a bit the program execution but I think it is worth the price.
  9.     - Günther -
  10. }
  11.  
  12. {EMBED
  13. #ifdef MCH_AMIGA
  14. # include <dos/dos.h>
  15. # include <clib/exec_protos.h>
  16. # ifdef AZTEC_C
  17. #  include <pragmas/exec_lib.h>
  18.    extern int Enable_Abort;
  19. # endif
  20. #endif
  21. }
  22.  
  23. program basic(input, output);
  24.  
  25.  
  26. const
  27.  
  28.    checking = true;
  29.  
  30.    varnamelen = 20;
  31.    maxdims = 4;
  32.  
  33.  
  34.  
  35. type
  36.  
  37.    varnamestring = string[varnamelen];
  38.  
  39.    string255 = string[255];
  40.    string255ptr = ^string255;
  41.  
  42.    tokenkinds = (tokvar, toknum, tokstr, toksnerr,
  43.  
  44.                  tokplus, tokminus, toktimes, tokdiv, tokup, toklp, tokrp, 
  45.                  tokcomma, toksemi, tokcolon, tokeq, toklt, tokgt,
  46.                  tokle, tokge, tokne,
  47.  
  48.                  tokand, tokor, tokxor, tokmod, toknot, toksqr, toksqrt, toksin,
  49.                  tokcos, toktan, tokarctan, toklog, tokexp, tokabs, toksgn,
  50.                  tokstr_, tokval, tokchr_, tokasc, toklen, tokmid_, tokpeek,
  51.  
  52.                  tokrem, toklet, tokprint, tokinput, tokgoto, tokif, tokend, 
  53.                  tokstop, tokfor, toknext, tokwhile, tokwend, tokgosub,
  54.                  tokreturn, tokread, tokdata, tokrestore, tokgotoxy, tokon,
  55.                  tokdim, tokpoke,
  56.  
  57.                  toklist, tokrun, toknew, tokload, tokmerge, toksave, tokbye,
  58.                  tokdel, tokrenum,
  59.  
  60.                  tokthen, tokelse, tokto, tokstep);
  61.  
  62.    realptr = ^real;
  63.    basicstring = string255ptr;
  64.    stringptr = ^basicstring;
  65.    numarray = array[0..maxint] of real;
  66.    arrayptr = ^numarray;
  67.    strarray = array[0..maxint] of basicstring;
  68.    strarrayptr = ^strarray;
  69.  
  70.    tokenptr = ^tokenrec;
  71.    lineptr = ^linerec;
  72.    varptr = ^varrec;
  73.    loopptr = ^looprec;
  74.  
  75.    tokenrec =
  76.       record
  77.          next : tokenptr;
  78.          case kind : tokenkinds of
  79.             tokvar : (vp : varptr);
  80.             toknum : (num : real);
  81.             tokstr, tokrem : (sp : string255ptr);
  82.             toksnerr : (snch : char);
  83.       end;
  84.  
  85.    linerec =
  86.       record
  87.          num, num2 : integer;
  88.          txt : tokenptr;
  89.          next : lineptr;
  90.       end;
  91.  
  92.    varrec =
  93.       record
  94.          name : varnamestring;
  95.          next : varptr;
  96.          dims : array [1..maxdims] of integer;
  97.          numdims : 0..maxdims;
  98.          case stringvar : boolean of
  99.             false : (arr : arrayptr;  val : realptr;  rv : real);
  100.             true : (sarr : strarrayptr;  sval : stringptr;  sv : basicstring);
  101.       end;
  102.  
  103.    valrec =
  104.       record
  105.          case stringval : boolean of
  106.             false : (val : real);
  107.             true : (sval : basicstring);
  108.       end;
  109.  
  110.    loopkind = (forloop, whileloop, gosubloop);
  111.    looprec =
  112.       record
  113.          next : loopptr;
  114.          homeline : lineptr;
  115.          hometok : tokenptr;
  116.          case kind : loopkind of
  117.             forloop :
  118.                ( vp : varptr;
  119.                  max, step : real );
  120.       end;
  121.  
  122.  
  123.  
  124. var
  125.  
  126.    inbuf : string255ptr;
  127.  
  128.    linebase : lineptr;
  129.    varbase : varptr;
  130.    loopbase : loopptr;
  131.  
  132.    curline : integer;
  133.    stmtline, dataline : lineptr;
  134.    stmttok, datatok, buf : tokenptr;
  135.  
  136.    exitflag : boolean;
  137.  
  138.    excp_line ['EXCP_LINE'] : integer;
  139.  
  140.  
  141.  
  142. $if not checking$
  143.    $range off$
  144. $end$
  145.  
  146.  
  147.  
  148. procedure misc_getioerrmsg(var s : string; io : integer);
  149.    external;
  150.  
  151. procedure misc_printerror(er, io : integer);
  152.    external;
  153.  
  154. function asm_iand(a, b : integer) : integer;
  155.    external;
  156.  
  157. function asm_ior(a, b : integer) : integer;
  158.    external;
  159.  
  160. procedure hpm_new(var p : anyptr; size : integer);
  161.    external;
  162.  
  163. procedure hpm_dispose(var p : anyptr; size : integer);
  164.    external;
  165.  
  166.  
  167.  
  168. procedure restoredata;
  169.    begin
  170.       dataline := nil;
  171.       datatok := nil;
  172.    end;
  173.  
  174.  
  175.  
  176. procedure clearloops;
  177.    var
  178.       l : loopptr;
  179.    begin
  180.       while loopbase <> nil do
  181.          begin
  182.             l := loopbase^.next;
  183.             dispose(loopbase);
  184.             loopbase := l;
  185.          end;
  186.    end;
  187.  
  188.  
  189.  
  190. function arraysize(v : varptr) : integer;
  191.    var
  192.       i, j : integer;
  193.    begin
  194.       with v^ do
  195.          begin
  196.             if stringvar then
  197.                j := 4
  198.             else
  199.                j := 8;
  200.             for i := 1 to numdims do
  201.                j := j * dims[i];
  202.          end;
  203.       arraysize := j;
  204.    end;
  205.  
  206.  
  207. procedure clearvar(v : varptr);
  208.    begin
  209.       with v^ do
  210.          begin
  211.             if numdims <> 0 then
  212.                hpm_dispose(arr, arraysize(v))
  213.             else if stringvar and (sv <> nil) then
  214.                dispose(sv);
  215.             numdims := 0;
  216.             if stringvar then
  217.                begin
  218.                   sv := nil;
  219.                   sval := addr(sv);
  220.                end
  221.             else
  222.                begin
  223.                   rv := 0;
  224.                   val := addr(rv);
  225.                end;
  226.          end;
  227.    end;
  228.  
  229.  
  230. procedure clearvars;
  231.    var
  232.       v : varptr;
  233.    begin
  234.       v := varbase;
  235.       while v <> nil do
  236.          begin
  237.             clearvar(v);
  238.             v := v^.next;
  239.          end;
  240.    end;
  241.  
  242.  
  243.  
  244. function numtostr(n : real) : string255;
  245.    var
  246.       s : string255;
  247.       i : integer;
  248.    begin
  249.       setstrlen(s, 255);
  250.       if (n <> 0) and (abs(n) < 1e-2) or (abs(n) >= 1e12) then
  251.          begin
  252.             strwrite(s, 1, i, n);
  253.             setstrlen(s, i-1);
  254.             numtostr := s;
  255.          end
  256.       else
  257.          begin
  258.             strwrite(s, 1, i, n:30:10);
  259.             repeat
  260.                i := i - 1;
  261.             until s[i] <> '0';
  262.             if s[i] = '.' then
  263.                i := i - 1;
  264.             setstrlen(s, i);
  265.             numtostr := strltrim(s);
  266.          end;
  267.    end;
  268.  
  269.  
  270.  
  271. procedure parse(inbuf : string255ptr; var buf : tokenptr);
  272.  
  273.    const
  274.       toklength = 20;
  275.  
  276.    type
  277.       chset = set of char;
  278.  
  279.    const
  280.       idchars = chset ['A'..'Z','a'..'z','0'..'9','_','$'];
  281.  
  282.    var
  283.       i, j, k : integer;
  284.       token : string[toklength];
  285.       t, tptr : tokenptr;
  286.       v : varptr;
  287.       ch : char;
  288.       n, d, d1 : real;
  289.  
  290.    begin
  291.       tptr := nil;
  292.       buf := nil;
  293.       i := 1;
  294.       repeat
  295.          ch := ' ';
  296.          while (i <= strlen(inbuf^)) and (ch = ' ') do
  297.             begin
  298.                ch := inbuf^[i];
  299.                i := i + 1;
  300.             end;
  301.          if ch <> ' ' then
  302.             begin
  303.                new(t);
  304.                if tptr = nil then
  305.                   buf := t
  306.                else
  307.                   tptr^.next := t;
  308.                tptr := t;
  309.                t^.next := nil;
  310.                case ch of
  311.                   'A'..'Z', 'a'..'z' :
  312.                      begin
  313.                         i := i - 1;
  314.                         j := 0;
  315.                         setstrlen(token, strmax(token));
  316.                         while (i <= strlen(inbuf^)) and (inbuf^[i] in idchars) do
  317.                            begin
  318.                               if j < toklength then
  319.                                  begin
  320.                                     j := j + 1;
  321.                                     token[j] := inbuf^[i];
  322.                                  end;
  323.                               i := i + 1;
  324.                            end;
  325.                         setstrlen(token, j);
  326.                         if (token = 'and')     or (token = 'AND')     then t^.kind := tokand     
  327.                    else if (token = 'or')      or (token = 'OR')      then t^.kind := tokor      
  328.                    else if (token = 'xor')     or (token = 'XOR')     then t^.kind := tokxor     
  329.                    else if (token = 'not')     or (token = 'NOT')     then t^.kind := toknot     
  330.                    else if (token = 'mod')     or (token = 'MOD')     then t^.kind := tokmod     
  331.                    else if (token = 'sqr')     or (token = 'SQR')     then t^.kind := toksqr     
  332.                    else if (token = 'sqrt')    or (token = 'SQRT')    then t^.kind := toksqrt    
  333.                    else if (token = 'sin')     or (token = 'SIN')     then t^.kind := toksin     
  334.                    else if (token = 'cos')     or (token = 'COS')     then t^.kind := tokcos     
  335.                    else if (token = 'tan')     or (token = 'TAN')     then t^.kind := toktan     
  336.                    else if (token = 'arctan')  or (token = 'ARCTAN')  then t^.kind := tokarctan  
  337.                    else if (token = 'log')     or (token = 'LOG')     then t^.kind := toklog     
  338.                    else if (token = 'exp')     or (token = 'EXP')     then t^.kind := tokexp     
  339.                    else if (token = 'abs')     or (token = 'ABS')     then t^.kind := tokabs     
  340.                    else if (token = 'sgn')     or (token = 'SGN')     then t^.kind := toksgn     
  341.                    else if (token = 'str$')    or (token = 'STR$')    then t^.kind := tokstr_    
  342.                    else if (token = 'val')     or (token = 'VAL')     then t^.kind := tokval     
  343.                    else if (token = 'chr$')    or (token = 'CHR$')    then t^.kind := tokchr_    
  344.                    else if (token = 'asc')     or (token = 'ASC')     then t^.kind := tokasc     
  345.                    else if (token = 'len')     or (token = 'LEN')     then t^.kind := toklen     
  346.                    else if (token = 'mid$')    or (token = 'MID$')    then t^.kind := tokmid_    
  347.                    else if (token = 'peek')    or (token = 'PEEK')    then t^.kind := tokpeek    
  348.                    else if (token = 'let')     or (token = 'LET')     then t^.kind := toklet     
  349.                    else if (token = 'print')   or (token = 'PRINT')   then t^.kind := tokprint   
  350.                    else if (token = 'input')   or (token = 'INPUT')   then t^.kind := tokinput   
  351.                    else if (token = 'goto')    or (token = 'GOTO')    then t^.kind := tokgoto    
  352.                    else if (token = 'go to')   or (token = 'GO TO')   then t^.kind := tokgoto    
  353.                    else if (token = 'if')      or (token = 'IF')      then t^.kind := tokif      
  354.                    else if (token = 'end')     or (token = 'END')     then t^.kind := tokend     
  355.                    else if (token = 'stop')    or (token = 'STOP')    then t^.kind := tokstop    
  356.                    else if (token = 'for')     or (token = 'FOR')     then t^.kind := tokfor     
  357.                    else if (token = 'next')    or (token = 'NEXT')    then t^.kind := toknext    
  358.                    else if (token = 'while')   or (token = 'WHILE')   then t^.kind := tokwhile   
  359.                    else if (token = 'wend')    or (token = 'WEND')    then t^.kind := tokwend    
  360.                    else if (token = 'gosub')   or (token = 'GOSUB')   then t^.kind := tokgosub   
  361.                    else if (token = 'return')  or (token = 'RETURN')  then t^.kind := tokreturn  
  362.                    else if (token = 'read')    or (token = 'READ')    then t^.kind := tokread    
  363.                    else if (token = 'data')    or (token = 'DATA')    then t^.kind := tokdata    
  364.                    else if (token = 'restore') or (token = 'RESTORE') then t^.kind := tokrestore 
  365.                    else if (token = 'gotoxy')  or (token = 'GOTOXY')  then t^.kind := tokgotoxy  
  366.                    else if (token = 'on')      or (token = 'ON')      then t^.kind := tokon      
  367.                    else if (token = 'dim')     or (token = 'DIM')     then t^.kind := tokdim     
  368.                    else if (token = 'poke')    or (token = 'POKE')    then t^.kind := tokpoke    
  369.                    else if (token = 'list')    or (token = 'LIST')    then t^.kind := toklist    
  370.                    else if (token = 'run')     or (token = 'RUN')     then t^.kind := tokrun     
  371.                    else if (token = 'new')     or (token = 'NEW')     then t^.kind := toknew     
  372.                    else if (token = 'load')    or (token = 'LOAD')    then t^.kind := tokload    
  373.                    else if (token = 'merge')   or (token = 'MERGE')   then t^.kind := tokmerge   
  374.                    else if (token = 'save')    or (token = 'SAVE')    then t^.kind := toksave    
  375.                    else if (token = 'bye')     or (token = 'BYE')     then t^.kind := tokbye     
  376.                    else if (token = 'quit')    or (token = 'QUIT')    then t^.kind := tokbye     
  377.                    else if (token = 'del')     or (token = 'DEL')     then t^.kind := tokdel     
  378.                    else if (token = 'renum')   or (token = 'RENUM')   then t^.kind := tokrenum   
  379.                    else if (token = 'then')    or (token = 'THEN')    then t^.kind := tokthen    
  380.                    else if (token = 'else')    or (token = 'ELSE')    then t^.kind := tokelse    
  381.                    else if (token = 'to')      or (token = 'TO')      then t^.kind := tokto      
  382.                    else if (token = 'step')    or (token = 'STEP')    then t^.kind := tokstep    
  383.                    else if (token = 'rem')     or (token = 'REM')     then
  384.                            begin
  385.                               t^.kind := tokrem;
  386.                               new(t^.sp);
  387.                               t^.sp^ := str(inbuf^, i, strlen(inbuf^)-i+1);
  388.                               i := strlen(inbuf^)+1;
  389.                            end
  390.                         else
  391.                            begin
  392.                               t^.kind := tokvar;
  393.                               v := varbase;
  394.                               while (v <> nil) and (v^.name <> token) do
  395.                                  v := v^.next;
  396.                               if v = nil then
  397.                                  begin
  398.                                     new(v);
  399.                                     v^.next := varbase;
  400.                                     varbase := v;
  401.                                     v^.name := token;
  402.                                     v^.numdims := 0;
  403.                                     if token[strlen(token)] = '$' then
  404.                                        begin
  405.                                           v^.stringvar := true;
  406.                                           v^.sv := nil;
  407.                                           v^.sval := addr(v^.sv);
  408.                                        end
  409.                                     else
  410.                                        begin
  411.                                           v^.stringvar := false;
  412.                                           v^.rv := 0;
  413.                                           v^.val := addr(v^.rv);
  414.                                        end;
  415.                                  end;
  416.                               t^.vp := v;
  417.                            end;
  418.                      end;
  419.                   '"', '''' :
  420.                      begin
  421.                         t^.kind := tokstr;
  422.                         new(t^.sp);
  423.                         setstrlen(t^.sp^, 255);
  424.                         j := 0;
  425.                         while (i <= strlen(inbuf^)) and (inbuf^[i] <> ch) do
  426.                            begin
  427.                               j := j + 1;
  428.                               t^.sp^[j] := inbuf^[i];
  429.                               i := i + 1;
  430.                            end;
  431.                         setstrlen(t^.sp^, j);
  432.                         i := i + 1;
  433.                      end;
  434.                   '0'..'9', '.' :
  435.                      begin
  436.                         t^.kind := toknum;
  437.                         n := 0;
  438.                         d := 1;
  439.                         d1 := 1;
  440.                         i := i - 1;
  441.                         while (i <= strlen(inbuf^)) and ((inbuf^[i] in ['0'..'9'])
  442.                                     or ((inbuf^[i] = '.') and (d1 = 1))) do
  443.                            begin
  444.                               if inbuf^[i] = '.' then
  445.                                  d1 := 10
  446.                               else
  447.                                  begin
  448.                                     n := n * 10 + ord(inbuf^[i]) - 48;
  449.                                     d := d * d1;
  450.                                  end;
  451.                               i := i + 1;
  452.                            end;
  453.                         n := n / d;
  454.                         if (i <= strlen(inbuf^)) and (inbuf^[i] in ['e','E']) then
  455.                            begin
  456.                               i := i + 1;
  457.                               d1 := 10;
  458.                               if (i <= strlen(inbuf^)) and (inbuf^[i] in ['+','-']) then
  459.                                  begin
  460.                                     if inbuf^[i] = '-' then
  461.                                        d1 := 0.1;
  462.                                     i := i + 1;
  463.                                  end;
  464.                               j := 0;
  465.                               while (i <= strlen(inbuf^)) and (inbuf^[i] in ['0'..'9']) do
  466.                                  begin
  467.                                     j := j * 10 + ord(inbuf^[i]) - 48;
  468.                                     i := i + 1;
  469.                                  end;
  470.                               for k := 1 to j do
  471.                                  n := n * d1;
  472.                            end;
  473.                         t^.num := n;
  474.                      end;
  475.                   '+' : t^.kind := tokplus;
  476.                   '-' : t^.kind := tokminus;
  477.                   '*' : t^.kind := toktimes;
  478.                   '/' : t^.kind := tokdiv;
  479.                   '^' : t^.kind := tokup;
  480.                   '(', '[' : t^.kind := toklp;
  481.                   ')', ']' : t^.kind := tokrp;
  482.                   ',' : t^.kind := tokcomma;
  483.                   ';' : t^.kind := toksemi;
  484.                   ':' : t^.kind := tokcolon;
  485.                   '?' : t^.kind := tokprint;
  486.                   '=' : t^.kind := tokeq;
  487.                   '<' : 
  488.                      begin
  489.                         if (i <= strlen(inbuf^)) and (inbuf^[i] = '=') then
  490.                            begin
  491.                               t^.kind := tokle;
  492.                               i := i + 1;
  493.                            end
  494.                         else if (i <= strlen(inbuf^)) and (inbuf^[i] = '>') then
  495.                            begin
  496.                               t^.kind := tokne;
  497.                               i := i + 1;
  498.                            end
  499.                         else
  500.                            t^.kind := toklt;
  501.                      end;
  502.                   '>' :
  503.                      begin
  504.                         if (i <= strlen(inbuf^)) and (inbuf^[i] = '=') then
  505.                            begin
  506.                               t^.kind := tokge;
  507.                               i := i + 1;
  508.                            end
  509.                         else
  510.                            t^.kind := tokgt;
  511.                      end;
  512.                   otherwise
  513.                      begin
  514.                         t^.kind := toksnerr;
  515.                         t^.snch := ch;
  516.                      end;
  517.                end;
  518.             end;
  519.       until i > strlen(inbuf^);
  520.    end;
  521.  
  522.  
  523.  
  524. procedure listtokens(var f : text; buf : tokenptr);
  525.    var
  526.       ltr, ltr0 : boolean;
  527.    begin
  528.       ltr := false;
  529.       while buf <> nil do
  530.          begin
  531.             if buf^.kind in [tokvar, toknum, toknot..tokrenum] then
  532.                begin
  533.                   if ltr then write(f, ' ');
  534.                   ltr := (buf^.kind <> toknot);
  535.                end
  536.             else
  537.                ltr := false;
  538.             case buf^.kind of
  539.                tokvar     : write(f, buf^.vp^.name);
  540.                toknum     : write(f, numtostr(buf^.num));
  541.                tokstr     : write(f, '"', buf^.sp^, '"');
  542.                toksnerr   : write(f, '{', buf^.snch, '}');
  543.                tokplus    : write(f, '+');
  544.                tokminus   : write(f, '-');
  545.                toktimes   : write(f, '*');
  546.                tokdiv     : write(f, '/');
  547.                tokup      : write(f, '^');
  548.                toklp      : write(f, '(');
  549.                tokrp      : write(f, ')');
  550.                tokcomma   : write(f, ',');
  551.                toksemi    : write(f, ';');
  552.                tokcolon   : write(f, ' : ');
  553.                tokeq      : write(f, ' = ');
  554.                toklt      : write(f, ' < ');
  555.                tokgt      : write(f, ' > ');
  556.                tokle      : write(f, ' <= ');
  557.                tokge      : write(f, ' >= ');
  558.                tokne      : write(f, ' <> ');
  559.                tokand     : write(f, ' AND ');
  560.                tokor      : write(f, ' OR ');
  561.                tokxor     : write(f, ' XOR ');
  562.                tokmod     : write(f, ' MOD ');
  563.                toknot     : write(f, 'NOT ');
  564.                toksqr     : write(f, 'SQR');
  565.                toksqrt    : write(f, 'SQRT');
  566.                toksin     : write(f, 'SIN');
  567.                tokcos     : write(f, 'COS');
  568.                toktan     : write(f, 'TAN');
  569.                tokarctan  : write(f, 'ARCTAN');
  570.                toklog     : write(f, 'LOG');
  571.                tokexp     : write(f, 'EXP');
  572.                tokabs     : write(f, 'ABS');
  573.                toksgn     : write(f, 'SGN');
  574.                tokstr_    : write(f, 'STR$');
  575.                tokval     : write(f, 'VAL');
  576.                tokchr_    : write(f, 'CHR$');
  577.                tokasc     : write(f, 'ASC');
  578.                toklen     : write(f, 'LEN');
  579.                tokmid_    : write(f, 'MID$');
  580.                tokpeek    : write(f, 'PEEK');
  581.                toklet     : write(f, 'LET');
  582.                tokprint   : write(f, 'PRINT');
  583.                tokinput   : write(f, 'INPUT');
  584.                tokgoto    : write(f, 'GOTO');
  585.                tokif      : write(f, 'IF');
  586.                tokend     : write(f, 'END');
  587.                tokstop    : write(f, 'STOP');
  588.                tokfor     : write(f, 'FOR');
  589.                toknext    : write(f, 'NEXT');
  590.                tokwhile   : write(f, 'WHILE');
  591.                tokwend    : write(f, 'WEND');
  592.                tokgosub   : write(f, 'GOSUB');
  593.                tokreturn  : write(f, 'RETURN');
  594.                tokread    : write(f, 'READ');
  595.                tokdata    : write(f, 'DATA');
  596.                tokrestore : write(f, 'RESTORE');
  597.                tokgotoxy  : write(f, 'GOTOXY');
  598.                tokon      : write(f, 'ON');
  599.                tokdim     : write(f, 'DIM');
  600.                tokpoke    : write(f, 'POKE');
  601.                toklist    : write(f, 'LIST');
  602.                tokrun     : write(f, 'RUN');
  603.                toknew     : write(f, 'NEW');
  604.                tokload    : write(f, 'LOAD');
  605.                tokmerge   : write(f, 'MERGE');
  606.                toksave    : write(f, 'SAVE');
  607.                tokdel     : write(f, 'DEL');
  608.                tokbye     : write(f, 'BYE');
  609.                tokrenum   : write(f, 'RENUM');
  610.                tokthen    : write(f, ' THEN ');
  611.                tokelse    : write(f, ' ELSE ');
  612.                tokto      : write(f, ' TO ');
  613.                tokstep    : write(f, ' STEP ');
  614.                tokrem     : write(f, 'REM', buf^.sp^);
  615.             end;
  616.             buf := buf^.next;
  617.          end;
  618.    end;
  619.  
  620.  
  621.  
  622. procedure disposetokens(var tok : tokenptr);
  623.    var
  624.       tok1 : tokenptr;
  625.    begin
  626.       while tok <> nil do
  627.          begin
  628.             tok1 := tok^.next;
  629.             if tok^.kind in [tokstr, tokrem] then
  630.                dispose(tok^.sp);
  631.             dispose(tok);
  632.             tok := tok1;
  633.          end;
  634.    end;
  635.  
  636.  
  637.  
  638. procedure parseinput(var buf : tokenptr);
  639.    var
  640.       l, l0, l1 : lineptr;
  641.    begin
  642.       inbuf^ := strltrim(inbuf^);
  643.       curline := 0;
  644.       while (strlen(inbuf^) <> 0) and (inbuf^[1] in ['0'..'9']) do
  645.          begin
  646.             curline := curline * 10 + ord(inbuf^[1]) - 48;
  647.             strdelete(inbuf^, 1, 1);
  648.          end;
  649.       parse(inbuf, buf);
  650.       if curline <> 0 then
  651.          begin
  652.             l := linebase;
  653.             l0 := nil;
  654.             while (l <> nil) and (l^.num < curline) do
  655.                begin
  656.                   l0 := l;
  657.                   l := l^.next;
  658.                end;
  659.             if (l <> nil) and (l^.num = curline) then
  660.                begin
  661.                   l1 := l;
  662.                   l := l^.next;
  663.                   if l0 = nil then
  664.                      linebase := l
  665.                   else
  666.                      l0^.next := l;
  667.                   disposetokens(l1^.txt);
  668.                   dispose(l1);
  669.                end;
  670.             if buf <> nil then
  671.                begin
  672.                   new(l1);
  673.                   l1^.next := l;
  674.                   if l0 = nil then
  675.                      linebase := l1
  676.                   else
  677.                      l0^.next := l1;
  678.                   l1^.num := curline;
  679.                   l1^.txt := buf;
  680.                end;
  681.             clearloops;
  682.             restoredata;
  683.          end;
  684.    end;
  685.  
  686.  
  687.  
  688.  
  689.  
  690. procedure errormsg(s : string255);
  691.    begin
  692.       write(#7, s);
  693.       escape(42);
  694.    end;
  695.  
  696.  
  697. procedure snerr;
  698.    begin
  699.       errormsg('Syntax error');
  700.    end;
  701.  
  702. procedure tmerr;
  703.    begin
  704.       errormsg('Type mismatch error');
  705.    end;
  706.  
  707. procedure badsubscr;
  708.    begin
  709.       errormsg('Bad subscript');
  710.    end;
  711.  
  712.  
  713.  
  714.  
  715.  
  716.  
  717. procedure exec;
  718.  
  719.    var
  720.       gotoflag, elseflag : boolean;
  721.       t : tokenptr;
  722.       ioerrmsg : string255ptr;
  723.  
  724.  
  725.    function factor : valrec;
  726.       forward;
  727.  
  728.    function expr : valrec;
  729.       forward;
  730.  
  731.    function realfactor : real;
  732.       var
  733.          n : valrec;
  734.       begin
  735.          n := factor;
  736.          if n.stringval then tmerr;
  737.          realfactor := n.val;
  738.       end;
  739.  
  740.    function strfactor : basicstring;
  741.       var
  742.          n : valrec;
  743.       begin
  744.          n := factor;
  745.          if not n.stringval then tmerr;
  746.          strfactor := n.sval;
  747.       end;
  748.  
  749.    function stringfactor : string255;
  750.       var
  751.          n : valrec;
  752.       begin
  753.          n := factor;
  754.          if not n.stringval then tmerr;
  755.          stringfactor := n.sval^;
  756.          dispose(n.sval);
  757.       end;
  758.  
  759.    function intfactor : integer;
  760.       begin
  761.          intfactor := round(realfactor);
  762.       end;
  763.  
  764.    function realexpr : real;
  765.       var
  766.          n : valrec;
  767.       begin
  768.          n := expr;
  769.          if n.stringval then tmerr;
  770.          realexpr := n.val;
  771.       end;
  772.  
  773.    function strexpr : basicstring;
  774.       var
  775.          n : valrec;
  776.       begin
  777.          n := expr;
  778.          if not n.stringval then tmerr;
  779.          strexpr := n.sval;
  780.       end;
  781.  
  782.    function stringexpr : string255;
  783.       var
  784.          n : valrec;
  785.       begin
  786.          n := expr;
  787.          if not n.stringval then tmerr;
  788.          stringexpr := n.sval^;
  789.          dispose(n.sval);
  790.       end;
  791.  
  792.    function intexpr : integer;
  793.       begin
  794.          intexpr := round(realexpr);
  795.       end;
  796.  
  797.  
  798.    procedure require(k : tokenkinds);
  799.       begin
  800.          if (t = nil) or (t^.kind <> k) then
  801.             snerr;
  802.          t := t^.next;
  803.       end;
  804.  
  805.  
  806.    procedure skipparen;
  807.       label 1;
  808.       begin
  809.          repeat
  810.             if t = nil then snerr;
  811.             if (t^.kind = tokrp) or (t^.kind = tokcomma) then
  812.                goto 1;
  813.             if t^.kind = toklp then
  814.                begin
  815.                   t := t^.next;
  816.                   skipparen;
  817.                end;
  818.             t := t^.next;
  819.          until false;
  820.        1 :
  821.       end;
  822.  
  823.  
  824.    function findvar : varptr;
  825.       var
  826.          v : varptr;
  827.          i, j, k : integer;
  828.          tok : tokenptr;
  829.       begin
  830.          if (t = nil) or (t^.kind <> tokvar) then snerr;
  831.          v := t^.vp;
  832.          t := t^.next;
  833.          if (t <> nil) and (t^.kind = toklp) then
  834.             with v^ do
  835.                begin
  836.                   if numdims = 0 then
  837.                      begin
  838.                         tok := t;
  839.                         i := 0;
  840.                         j := 1;
  841.                         repeat
  842.                            if i >= maxdims then badsubscr;
  843.                            t := t^.next;
  844.                            skipparen;
  845.                            j := j * 11;
  846.                            i := i + 1;
  847.                            dims[i] := 11;
  848.                         until t^.kind = tokrp;
  849.                         numdims := i;
  850.                         if stringvar then
  851.                            begin
  852.                               hpm_new(sarr, j*4);
  853.                               for k := 0 to j-1 do
  854.                                  sarr^[k] := nil;
  855.                            end
  856.                         else
  857.                            begin
  858.                               hpm_new(arr, j*8);
  859.                               for k := 0 to j-1 do
  860.                                  arr^[k] := 0;
  861.                            end;
  862.                         t := tok;
  863.                      end;
  864.                   k := 0;
  865.                   t := t^.next;
  866.                   for i := 1 to numdims do
  867.                      begin
  868.                         j := intexpr;
  869.                         if (j < 0) or (j >= dims[i]) then
  870.                            badsubscr;
  871.                         k := k * dims[i] + j;
  872.                         if i < numdims then
  873.                            require(tokcomma);
  874.                      end;
  875.                   require(tokrp);
  876.                   if stringvar then
  877.                       sval := addr(sarr^[k])
  878.                   else
  879.                       val := addr(arr^[k]);
  880.                end
  881.          else
  882.             begin
  883.                if v^.numdims <> 0 then
  884.                   badsubscr;
  885.             end;
  886.          findvar := v;
  887.       end;
  888.  
  889.  
  890.    function inot(i : integer) : integer;
  891.       begin
  892.          inot := -1 - i;
  893.       end;
  894.  
  895.    function ixor(a, b : integer) : integer;
  896.       begin
  897.          ixor := asm_ior(asm_iand(a, inot(b)), asm_iand(inot(a), b));
  898.       end;
  899.  
  900.  
  901.    function factor : valrec;
  902.       var
  903.          v : varptr;
  904.          facttok : tokenptr;
  905.          n : valrec;
  906.          i, j : integer;
  907.          tok, tok1 : tokenptr;
  908.          s : basicstring;
  909.          trick :
  910.             record
  911.                case boolean of
  912.                   true : (i : integer);
  913.                   false : (c : ^char);
  914.             end;
  915.       begin
  916.          if t = nil then snerr;
  917.          facttok := t;
  918.          t := t^.next;
  919.          n.stringval := false;
  920.          case facttok^.kind of
  921.             toknum :
  922.                n.val := facttok^.num;
  923.             tokstr :
  924.                begin
  925.                   n.stringval := true;
  926.                   new(n.sval);
  927.                   n.sval^ := facttok^.sp^;
  928.                end;
  929.             tokvar :
  930.                begin
  931.                   t := facttok;
  932.                   v := findvar;
  933.                   n.stringval := v^.stringvar;
  934.                   if n.stringval then
  935.                      begin
  936.                         new(n.sval);
  937.                         n.sval^ := v^.sval^^;
  938.                      end
  939.                   else
  940.                      n.val := v^.val^;
  941.                end;
  942.             toklp :
  943.                begin
  944.                   n := expr;
  945.                   require(tokrp);
  946.                end;
  947.             tokminus :
  948.                n.val := - realfactor;
  949.             tokplus :
  950.                n.val := realfactor;
  951.             toknot :
  952.                n.val := inot(intfactor);
  953.             toksqr :
  954.                n.val := sqr(realfactor);
  955.             toksqrt :
  956.                n.val := sqrt(realfactor);
  957.             toksin :
  958.                n.val := sin(realfactor);
  959.             tokcos :
  960.                n.val := cos(realfactor);
  961.             toktan :
  962.                begin
  963.                   n.val := realfactor;
  964.                   n.val := sin(n.val) / cos(n.val);
  965.                end;
  966.             tokarctan :
  967.                n.val := arctan(realfactor);
  968.             toklog:
  969.                n.val := ln(realfactor);
  970.             tokexp :
  971.                n.val := exp(realfactor);
  972.             tokabs :
  973.                n.val := abs(realfactor);
  974.             toksgn :
  975.                begin
  976.                   n.val := realfactor;
  977.                   n.val := ord(n.val > 0) - ord(n.val < 0);
  978.                end;
  979.             tokstr_ :
  980.                begin
  981.                   n.stringval := true;
  982.                   new(n.sval);
  983.                   n.sval^ := numtostr(realfactor);
  984.                end;
  985.             tokval :
  986.                begin
  987.                   s := strfactor;
  988.                   tok1 := t;
  989.                   parse(s, t);
  990.                   tok := t;
  991.                   if tok = nil then
  992.                      n.val := 0
  993.                   else
  994.                      n := expr;
  995.                   disposetokens(tok);
  996.                   t := tok1;
  997.                   dispose(s);
  998.                end;
  999.             tokchr_ :
  1000.                begin
  1001.                   n.stringval := true;
  1002.                   new(n.sval);
  1003.                   n.sval^ := ' ';
  1004.                   n.sval^[1] := chr(intfactor);
  1005.                end;
  1006.             tokasc :
  1007.                begin
  1008.                   s := strfactor;
  1009.                   if strlen(s^) = 0 then
  1010.                      n.val := 0
  1011.                   else
  1012.                      n.val := ord(s^[1]);
  1013.                   dispose(s);
  1014.                end;
  1015.             tokmid_ :
  1016.                begin
  1017.                   n.stringval := true;
  1018.                   require(toklp);
  1019.                   n.sval := strexpr;
  1020.                   require(tokcomma);
  1021.                   i := intexpr;
  1022.                   if i < 1 then i := 1;
  1023.                   j := 255;
  1024.                   if (t <> nil) and (t^.kind = tokcomma) then
  1025.                      begin
  1026.                         t := t^.next;
  1027.                         j := intexpr;
  1028.                      end;
  1029.                   if j > strlen(n.sval^)-i+1 then
  1030.                      j := strlen(n.sval^)-i+1;
  1031.                   if i > strlen(n.sval^) then
  1032.                      n.sval^ := ''
  1033.                   else
  1034.                      n.sval^ := str(n.sval^, i, j);
  1035.                   require(tokrp);
  1036.                end;
  1037.             toklen :
  1038.                begin
  1039.                   s := strfactor;
  1040.                   n.val := strlen(s^);
  1041.                   dispose(s);
  1042.                end;
  1043.             tokpeek :
  1044.                begin
  1045.                   $range off$
  1046.                   trick.i := intfactor;
  1047.                   n.val := ord(trick.c^);
  1048.                   $if checking$ $range on$ $end$
  1049.                end;
  1050.             otherwise
  1051.                snerr;
  1052.          end;
  1053.          factor := n;
  1054.       end;
  1055.  
  1056.    function upexpr : valrec;
  1057.       var
  1058.          n, n2 : valrec;
  1059.       begin
  1060.          n := factor;
  1061.          while (t <> nil) and (t^.kind = tokup) do
  1062.             begin
  1063.                if n.stringval then tmerr;
  1064.                t := t^.next;
  1065.                n2 := upexpr;
  1066.                if n2.stringval then tmerr;
  1067.                if n.val < 0 then
  1068.                   begin
  1069.                      if n2.val <> trunc(n2.val) then n.val := ln(n.val);
  1070.                      n.val := exp(n2.val * ln(-n.val));
  1071.                      if odd(trunc(n2.val)) then
  1072.                         n.val := - n.val;
  1073.                   end
  1074.                else
  1075.                   n.val := exp(n2.val * ln(n.val));
  1076.             end;
  1077.          upexpr := n;
  1078.       end;
  1079.  
  1080.    function term : valrec;
  1081.       var
  1082.          n, n2 : valrec;
  1083.          k : tokenkinds;
  1084.       begin
  1085.          n := upexpr;
  1086.          while (t <> nil) and (t^.kind in [toktimes, tokdiv, tokmod]) do
  1087.             begin
  1088.                k := t^.kind;
  1089.                t := t^.next;
  1090.                n2 := upexpr;
  1091.                if n.stringval or n2.stringval then tmerr;
  1092.                if k = tokmod then
  1093.                   n.val := round(n.val) mod round(n2.val)
  1094.                else if k = toktimes then
  1095.                   n.val := n.val * n2.val
  1096.                else
  1097.                   n.val := n.val / n2.val;
  1098.             end;
  1099.          term := n;
  1100.       end;
  1101.  
  1102.    function sexpr : valrec;
  1103.       var
  1104.          n, n2 : valrec;
  1105.          k : tokenkinds;
  1106.       begin
  1107.          n := term;
  1108.          while (t <> nil) and (t^.kind in [tokplus, tokminus]) do
  1109.             begin
  1110.                k := t^.kind;
  1111.                t := t^.next;
  1112.                n2 := term;
  1113.                if n.stringval <> n2.stringval then tmerr;
  1114.                if k = tokplus then
  1115.                   if n.stringval then
  1116.                      begin
  1117.                         n.sval^ := n.sval^ + n2.sval^;
  1118.                         dispose(n2.sval);
  1119.                      end
  1120.                   else
  1121.                      n.val := n.val + n2.val
  1122.                else
  1123.                   if n.stringval then
  1124.                      tmerr
  1125.                   else
  1126.                      n.val := n.val - n2.val;
  1127.             end;
  1128.          sexpr := n;
  1129.       end;
  1130.  
  1131.    function relexpr : valrec;
  1132.       var
  1133.          n, n2 : valrec;
  1134.          f : boolean;
  1135.          k : tokenkinds;
  1136.       begin
  1137.          n := sexpr;
  1138.          while (t <> nil) and (t^.kind in [tokeq..tokne]) do
  1139.             begin
  1140.                k := t^.kind;
  1141.                t := t^.next;
  1142.                n2 := sexpr;
  1143.                if n.stringval <> n2.stringval then tmerr;
  1144.                if n.stringval then
  1145.                   begin
  1146.                      f := ((n.sval^ = n2.sval^) and (k in [tokeq, tokge, tokle]) or
  1147.                            (n.sval^ < n2.sval^) and (k in [toklt, tokle, tokne]) or
  1148.                            (n.sval^ > n2.sval^) and (k in [tokgt, tokge, tokne]));
  1149.                      dispose(n.sval);
  1150.                      dispose(n2.sval);
  1151.                   end
  1152.                else
  1153.                   f := ((n.val = n2.val) and (k in [tokeq, tokge, tokle]) or
  1154.                         (n.val < n2.val) and (k in [toklt, tokle, tokne]) or
  1155.                         (n.val > n2.val) and (k in [tokgt, tokge, tokne]));
  1156.                n.stringval := false;
  1157.                n.val := ord(f);
  1158.             end;
  1159.          relexpr := n;
  1160.       end;
  1161.  
  1162.    function andexpr : valrec;
  1163.       var
  1164.          n, n2 : valrec;
  1165.       begin
  1166.          n := relexpr;
  1167.          while (t <> nil) and (t^.kind = tokand) do
  1168.             begin
  1169.                t := t^.next;
  1170.                n2 := relexpr;
  1171.                if n.stringval or n2.stringval then tmerr;
  1172.                n.val := asm_iand(trunc(n.val), trunc(n2.val));
  1173.             end;
  1174.          andexpr := n;
  1175.       end;
  1176.  
  1177.    function expr : valrec;
  1178.       var
  1179.          n, n2 : valrec;
  1180.          k : tokenkinds;
  1181.       begin
  1182.          n := andexpr;
  1183.          while (t <> nil) and (t^.kind in [tokor, tokxor]) do
  1184.             begin
  1185.                k := t^.kind;
  1186.                t := t^.next;
  1187.                n2 := andexpr;
  1188.                if n.stringval or n2.stringval then tmerr;
  1189.                if k = tokor then
  1190.                   n.val := asm_ior(trunc(n.val), trunc(n2.val))
  1191.                else
  1192.                   n.val := ixor(trunc(n.val), trunc(n2.val));
  1193.             end;
  1194.          expr := n;
  1195.       end;
  1196.  
  1197.  
  1198.    procedure checkextra;
  1199.       begin
  1200.          if t <> nil then
  1201.             errormsg('Extra information on line');
  1202.       end;
  1203.  
  1204.  
  1205.    function iseos : boolean;
  1206.       begin
  1207.          iseos := (t = nil) or (t^.kind in [tokcolon, tokelse]);
  1208.       end;
  1209.  
  1210.  
  1211.    procedure skiptoeos;
  1212.       begin
  1213.          while not iseos do
  1214.             t := t^.next;
  1215.       end;
  1216.  
  1217.  
  1218.    function findline(n : integer) : lineptr;
  1219.       var
  1220.          l : lineptr;
  1221.       begin
  1222.          l := linebase;
  1223.          while (l <> nil) and (l^.num <> n) do
  1224.             l := l^.next;
  1225.          findline := l;
  1226.       end;
  1227.  
  1228.  
  1229.    function mustfindline(n : integer) : lineptr;
  1230.       var
  1231.          l : lineptr;
  1232.       begin
  1233.          l := findline(n);
  1234.          if l = nil then
  1235.             errormsg('Undefined line');
  1236.          mustfindline := l;
  1237.       end;
  1238.  
  1239.  
  1240.    procedure cmdend;
  1241.       begin
  1242.          stmtline := nil;
  1243.          t := nil;
  1244.       end;
  1245.  
  1246.  
  1247.    procedure cmdnew;
  1248.       var
  1249.          p : anyptr;
  1250.       begin
  1251.          cmdend;
  1252.          clearloops;
  1253.          restoredata;
  1254.          while linebase <> nil do
  1255.             begin
  1256.                p := linebase^.next;
  1257.                disposetokens(linebase^.txt);
  1258.                dispose(linebase);
  1259.                linebase := p;
  1260.             end;
  1261.          while varbase <> nil do
  1262.             begin
  1263.                p := varbase^.next;
  1264.                if varbase^.stringvar then
  1265.                   if varbase^.sval^ <> nil then
  1266.                      dispose(varbase^.sval^);
  1267.                dispose(varbase);
  1268.                varbase := p;
  1269.             end;
  1270.       end;
  1271.  
  1272.  
  1273.    procedure cmdlist;
  1274.       var
  1275.          l : lineptr;
  1276.          n1, n2 : integer;
  1277.       begin
  1278.          repeat
  1279.             n1 := 0;
  1280.             n2 := maxint;
  1281.             if (t <> nil) and (t^.kind = toknum) then
  1282.                begin
  1283.                   n1 := trunc(t^.num);
  1284.                   t := t^.next;
  1285.                   if (t = nil) or (t^.kind <> tokminus) then
  1286.                      n2 := n1;
  1287.                end;
  1288.             if (t <> nil) and (t^.kind = tokminus) then
  1289.                begin
  1290.                   t := t^.next;
  1291.                   if (t <> nil) and (t^.kind = toknum) then
  1292.                      begin
  1293.                         n2 := trunc(t^.num);
  1294.                         t := t^.next;
  1295.                      end
  1296.                   else
  1297.                      n2 := maxint;
  1298.                end;
  1299.             l := linebase;
  1300.             while (l <> nil) and (l^.num <= n2) do
  1301.                begin
  1302.                   if (l^.num >= n1) then
  1303.                      begin
  1304.                         write(l^.num:1, ' ');
  1305.                         listtokens(output, l^.txt);
  1306.                         writeln;
  1307.                      end;
  1308.                   l := l^.next;
  1309.                end;
  1310.             if not iseos then
  1311.                require(tokcomma);
  1312.          until iseos;
  1313.       end;
  1314.  
  1315.  
  1316.    procedure cmdload(merging : boolean; name : string255);
  1317.       var
  1318.          f : text;
  1319.          buf : tokenptr;
  1320.       begin
  1321.          if not merging then
  1322.             cmdnew;
  1323.          reset(f, name + '.TEXT', 'shared');
  1324.          while not eof(f) do
  1325.             begin
  1326.                readln(f, inbuf^);
  1327.                parseinput(buf);
  1328.                if curline = 0 then
  1329.                   begin
  1330.                      writeln('Bad line in file');
  1331.                      disposetokens(buf);
  1332.                   end;
  1333.             end;
  1334.          close(f);
  1335.       end;
  1336.  
  1337.  
  1338.    procedure cmdrun;
  1339.       var
  1340.          l : lineptr;
  1341.          i : integer;
  1342.          s : string255;
  1343.       begin
  1344.          l := linebase;
  1345.          if not iseos then
  1346.             begin
  1347.                if t^.kind = toknum then
  1348.                   l := mustfindline(intexpr)
  1349.                else
  1350.                   begin
  1351.                      s := stringexpr;
  1352.                      i := 0;
  1353.                      if not iseos then
  1354.                         begin
  1355.                            require(tokcomma);
  1356.                            i := intexpr;
  1357.                         end;
  1358.                      checkextra;
  1359.                      cmdload(false, s);
  1360.                      if i = 0 then
  1361.                         l := linebase
  1362.                      else
  1363.                         l := mustfindline(i)
  1364.                   end
  1365.             end;
  1366.          stmtline := l;
  1367.          gotoflag := true;
  1368.          clearvars;
  1369.          clearloops;
  1370.          restoredata;
  1371.       end;
  1372.  
  1373.  
  1374.    procedure cmdsave;
  1375.       var
  1376.          f : text;
  1377.          l : lineptr;
  1378.       begin
  1379.          rewrite(f, stringexpr + '.TEXT');
  1380.          l := linebase;
  1381.          while l <> nil do
  1382.             begin
  1383.                write(f, l^.num:1, ' ');
  1384.                listtokens(f, l^.txt);
  1385.                writeln(f);
  1386.                l := l^.next;
  1387.             end;
  1388.          close(f, 'save');
  1389.       end;
  1390.  
  1391.  
  1392.    procedure cmdbye;
  1393.       begin
  1394.          exitflag := true;
  1395.       end;
  1396.  
  1397.  
  1398.    procedure cmddel;
  1399.       var
  1400.          l, l0, l1 : lineptr;
  1401.          n1, n2 : integer;
  1402.       begin
  1403.          repeat
  1404.             if iseos then snerr;
  1405.             n1 := 0;
  1406.             n2 := maxint;
  1407.             if (t <> nil) and (t^.kind = toknum) then
  1408.                begin
  1409.                   n1 := trunc(t^.num);
  1410.                   t := t^.next;
  1411.                   if (t = nil) or (t^.kind <> tokminus) then
  1412.                      n2 := n1;
  1413.                end;
  1414.             if (t <> nil) and (t^.kind = tokminus) then
  1415.                begin
  1416.                   t := t^.next;
  1417.                   if (t <> nil) and (t^.kind = toknum) then
  1418.                      begin
  1419.                         n2 := trunc(t^.num);
  1420.                         t := t^.next;
  1421.                      end
  1422.                   else
  1423.                      n2 := maxint;
  1424.                end;
  1425.             l := linebase;
  1426.             l0 := nil;
  1427.             while (l <> nil) and (l^.num <= n2) do
  1428.                begin
  1429.                   l1 := l^.next;
  1430.                   if (l^.num >= n1) then
  1431.                      begin
  1432.                         if l = stmtline then
  1433.                            begin
  1434.                               cmdend;
  1435.                               clearloops;
  1436.                               restoredata;
  1437.                            end;
  1438.                         if l0 = nil then
  1439.                            linebase := l^.next
  1440.                         else
  1441.                            l0^.next := l^.next;
  1442.                         disposetokens(l^.txt);
  1443.                         dispose(l);
  1444.                      end
  1445.                   else
  1446.                      l0 := l;
  1447.                   l := l1;
  1448.                end;
  1449.             if not iseos then
  1450.                require(tokcomma);
  1451.          until iseos;
  1452.       end;
  1453.  
  1454.  
  1455.    procedure cmdrenum;
  1456.       var
  1457.          l, l1 : lineptr;
  1458.          tok : tokenptr;
  1459.          lnum, step : integer;
  1460.       begin
  1461.          lnum := 10;
  1462.          step := 10;
  1463.          if not iseos then
  1464.             begin
  1465.                lnum := intexpr;
  1466.                if not iseos then
  1467.                   begin
  1468.                      require(tokcomma);
  1469.                      step := intexpr;
  1470.                   end;
  1471.             end;
  1472.          l := linebase;
  1473.          if l <> nil then
  1474.             begin
  1475.                while l <> nil do
  1476.                   begin
  1477.                      l^.num2 := lnum;
  1478.                      lnum := lnum + step;
  1479.                      l := l^.next;
  1480.                   end;
  1481.                l := linebase;
  1482.                repeat
  1483.                   tok := l^.txt;
  1484.                   repeat
  1485.                      if tok^.kind in [tokgoto, tokgosub, tokthen, tokelse, 
  1486.                                       tokrun, toklist, tokrestore, tokdel] then
  1487.                         while (tok^.next <> nil) and (tok^.next^.kind = toknum) do
  1488.                            begin
  1489.                               tok := tok^.next;
  1490.                               lnum := round(tok^.num);
  1491.                               l1 := linebase;
  1492.                               while (l1 <> nil) and (l1^.num <> lnum) do
  1493.                                  l1 := l1^.next;
  1494.                               if l1 = nil then
  1495.                                  writeln('Undefined line ', lnum:1, ' in line ', l^.num2:1)
  1496.                               else
  1497.                                  tok^.num := l1^.num2;
  1498.                               if (tok^.next <> nil) and (tok^.next^.kind = tokcomma) then
  1499.                                  tok := tok^.next;
  1500.                            end;
  1501.                      tok := tok^.next;
  1502.                   until tok = nil;
  1503.                   l := l^.next;
  1504.                until l = nil;
  1505.                l := linebase;
  1506.                while l <> nil do
  1507.                   begin
  1508.                      l^.num := l^.num2;
  1509.                      l := l^.next;
  1510.                   end;
  1511.             end;
  1512.       end;
  1513.  
  1514.  
  1515.    procedure cmdprint;
  1516.       var
  1517.          semiflag : boolean;
  1518.          n : valrec;
  1519.       begin
  1520.          semiflag := false;
  1521.          while not iseos do
  1522.             begin
  1523.                semiflag := false;
  1524.                if t^.kind in [toksemi, tokcomma] then
  1525.                   begin
  1526.                      semiflag := true;
  1527.                      t := t^.next;
  1528.                   end
  1529.                else
  1530.                   begin
  1531.                      n := expr;
  1532.                      if n.stringval then
  1533.                         begin
  1534.                            write(n.sval^);
  1535.                            dispose(n.sval);
  1536.                         end
  1537.                      else
  1538.                         write(numtostr(n.val), ' ');
  1539.                   end;
  1540.             end;
  1541.          if not semiflag then 
  1542.             writeln;
  1543.       end;
  1544.  
  1545.  
  1546.    procedure cmdinput;
  1547.       var
  1548.          v : varptr;
  1549.          s : string255;
  1550.          tok, tok0, tok1 : tokenptr;
  1551.          strflag : boolean;
  1552.       begin
  1553.          if (t <> nil) and (t^.kind = tokstr) then
  1554.             begin
  1555.                write(t^.sp^);
  1556.                t := t^.next;
  1557.                require(toksemi);
  1558.             end
  1559.          else
  1560.             begin
  1561.                write('? ');
  1562.             end;
  1563.          tok := t;
  1564.          if (t = nil) or (t^.kind <> tokvar) then snerr;
  1565.          strflag := t^.vp^.stringvar;
  1566.          repeat
  1567.             if (t <> nil) and (t^.kind = tokvar) then
  1568.                if t^.vp^.stringvar <> strflag then snerr;
  1569.             t := t^.next;
  1570.          until iseos;
  1571.          t := tok;
  1572.          if strflag then
  1573.             begin
  1574.                repeat
  1575.                   readln(s);
  1576.                   v := findvar;
  1577.                   if v^.sval^ <> nil then
  1578.                      dispose(v^.sval^);
  1579.                   new(v^.sval^);
  1580.                   v^.sval^^ := s;
  1581.                   if not iseos then
  1582.                      begin
  1583.                         require(tokcomma);
  1584.                         write('?? ');
  1585.                      end;
  1586.                until iseos;
  1587.             end
  1588.          else
  1589.             begin
  1590.                readln(s);
  1591.                parse(addr(s), tok);
  1592.                tok0 := tok;
  1593.                repeat
  1594.                   v := findvar;
  1595.                   while tok = nil do
  1596.                      begin
  1597.                         write('?? ');
  1598.                         readln(s);
  1599.                         disposetokens(tok0);
  1600.                         parse(addr(s), tok);
  1601.                         tok0 := tok;
  1602.                      end;
  1603.                   tok1 := t;
  1604.                   t := tok;
  1605.                   v^.val^ := realexpr;
  1606.                   if t <> nil then
  1607.                      if t^.kind = tokcomma then
  1608.                         t := t^.next
  1609.                      else
  1610.                         snerr;
  1611.                   tok := t;
  1612.                   t := tok1;
  1613.                   if not iseos then
  1614.                      require(tokcomma);
  1615.                until iseos;
  1616.                disposetokens(tok0);
  1617.             end;
  1618.       end;
  1619.  
  1620.  
  1621.    procedure cmdlet(implied : boolean);
  1622.       var
  1623.          v : varptr;
  1624.      old : basicstring;
  1625.       begin
  1626.          if implied then
  1627.             t := stmttok;
  1628.          v := findvar;
  1629.          require(tokeq);
  1630.          if v^.stringvar then
  1631.             begin
  1632.                old := v^.sval^;
  1633.                v^.sval^ := strexpr;
  1634.                if old <> nil then
  1635.                   dispose(old);
  1636.             end
  1637.          else
  1638.             v^.val^ := realexpr;
  1639.       end;
  1640.  
  1641.  
  1642.    procedure cmdgoto;
  1643.       begin
  1644.          stmtline := mustfindline(intexpr);
  1645.          t := nil;
  1646.          gotoflag := true;
  1647.       end;
  1648.  
  1649.  
  1650.    procedure cmdif;
  1651.       var
  1652.          n : real;
  1653.          i : integer;
  1654.       begin
  1655.          n := realexpr;
  1656.          require(tokthen);
  1657.          if n = 0 then
  1658.             begin
  1659.                i := 0;
  1660.                repeat
  1661.                   if t <> nil then
  1662.                      begin
  1663.                         if t^.kind = tokif then
  1664.                            i := i + 1;
  1665.                         if t^.kind = tokelse then
  1666.                            i := i - 1;
  1667.                         t := t^.next;
  1668.                      end;
  1669.                until (t = nil) or (i < 0);
  1670.             end;
  1671.          if (t <> nil) and (t^.kind = toknum) then
  1672.             cmdgoto
  1673.          else
  1674.             elseflag := true;
  1675.       end;
  1676.  
  1677.  
  1678.    procedure cmdelse;
  1679.       begin
  1680.          t := nil;
  1681.       end;
  1682.  
  1683.  
  1684.    function skiploop(up, dn : tokenkinds) : boolean;
  1685.       label 1;
  1686.       var
  1687.          i : integer;
  1688.          saveline : lineptr;
  1689.       begin
  1690.          saveline := stmtline;
  1691.          i := 0;
  1692.          repeat
  1693.             while t = nil do
  1694.                begin
  1695.                   if (stmtline = nil) or (stmtline^.next = nil) then
  1696.                      begin
  1697.                         skiploop := false;
  1698.                         stmtline := saveline;
  1699.                         goto 1;
  1700.                      end;
  1701.                   stmtline := stmtline^.next;
  1702.                   t := stmtline^.txt;
  1703.                end;
  1704.             if t^.kind = up then
  1705.                i := i + 1;
  1706.             if t^.kind = dn then
  1707.                i := i - 1;
  1708.             t := t^.next;
  1709.          until i < 0;
  1710.          skiploop := true;
  1711.      1 :
  1712.       end;
  1713.  
  1714.  
  1715.    procedure cmdfor;
  1716.       var
  1717.          l : loopptr;
  1718.          lr : looprec;
  1719.          saveline : lineptr;
  1720.          i, j : integer;
  1721.       begin
  1722.          lr.vp := findvar;
  1723.          if lr.vp^.stringvar then snerr;
  1724.          require(tokeq);
  1725.          lr.vp^.val^ := realexpr;
  1726.          require(tokto);
  1727.          lr.max := realexpr;
  1728.          if (t <> nil) and (t^.kind = tokstep) then
  1729.             begin
  1730.                t := t^.next;
  1731.                lr.step := realexpr;
  1732.             end
  1733.          else
  1734.             lr.step := 1;
  1735.          lr.homeline := stmtline;
  1736.          lr.hometok := t;
  1737.          lr.kind := forloop;
  1738.          lr.next := loopbase;
  1739.          with lr do
  1740.             if ((step >= 0) and (vp^.val^ > max)) or ((step <= 0) and (vp^.val^ < max)) then
  1741.                begin
  1742.                   saveline := stmtline;
  1743.                   i := 0;
  1744.                   j := 0;
  1745.                   repeat
  1746.                      while t = nil do
  1747.                         begin
  1748.                            if (stmtline = nil) or (stmtline^.next = nil) then
  1749.                               begin
  1750.                                  stmtline := saveline;
  1751.                                  errormsg('FOR without NEXT');
  1752.                               end;
  1753.                            stmtline := stmtline^.next;
  1754.                            t := stmtline^.txt;
  1755.                         end;
  1756.                      if t^.kind = tokfor then
  1757.                         if (t^.next <> nil) and (t^.next^.kind = tokvar) and (t^.next^.vp = vp) then
  1758.                            j := j + 1
  1759.                         else
  1760.                            i := i + 1;
  1761.                      if (t^.kind = toknext) then
  1762.                         if (t^.next <> nil) and (t^.next^.kind = tokvar) and (t^.next^.vp = vp) then
  1763.                            j := j - 1
  1764.                         else
  1765.                            i := i - 1;
  1766.                      t := t^.next;
  1767.                   until (i < 0) or (j < 0);
  1768.                   skiptoeos;
  1769.                end
  1770.             else
  1771.                begin
  1772.                   new(l);
  1773.                   l^ := lr;
  1774.                   loopbase := l;
  1775.                end;
  1776.       end;
  1777.  
  1778.  
  1779.    procedure cmdnext;
  1780.       var
  1781.          v : varptr;
  1782.          found : boolean;
  1783.          l : loopptr;
  1784.       begin
  1785.          if not iseos then
  1786.             v := findvar
  1787.          else
  1788.             v := nil;
  1789.          repeat
  1790.             if (loopbase = nil) or (loopbase^.kind = gosubloop) then 
  1791.                errormsg('NEXT without FOR');
  1792.             found := (loopbase^.kind = forloop) and
  1793.                      ((v = nil) or (loopbase^.vp = v));
  1794.             if not found then
  1795.                begin
  1796.                   l := loopbase^.next;
  1797.                   dispose(loopbase);
  1798.                   loopbase := l;
  1799.                end;
  1800.          until found;
  1801.          with loopbase^ do
  1802.             begin
  1803.                vp^.val^ := vp^.val^ + step;
  1804.                if ((step >= 0) and (vp^.val^ > max)) or ((step <= 0) and (vp^.val^ < max)) then
  1805.                   begin
  1806.                      l := loopbase^.next;
  1807.                      dispose(loopbase);
  1808.                      loopbase := l;
  1809.                   end
  1810.                else
  1811.                   begin
  1812.                      stmtline := homeline;
  1813.                      t := hometok;
  1814.                   end;
  1815.             end;
  1816.       end;
  1817.  
  1818.  
  1819.    procedure cmdwhile;
  1820.       var
  1821.          l : loopptr;
  1822.       begin
  1823.          new(l);
  1824.          l^.next := loopbase;
  1825.          loopbase := l;
  1826.          l^.kind := whileloop;
  1827.          l^.homeline := stmtline;
  1828.          l^.hometok := t;
  1829.          if not iseos then
  1830.             if realexpr = 0 then
  1831.                begin
  1832.                   if not skiploop(tokwhile, tokwend) then 
  1833.                      errormsg('WHILE without WEND');
  1834.                   l := loopbase^.next;
  1835.                   dispose(loopbase);
  1836.                   loopbase := l;
  1837.                   skiptoeos;
  1838.                end;
  1839.       end;
  1840.  
  1841.  
  1842.    procedure cmdwend;
  1843.       var
  1844.          tok : tokenptr;
  1845.          tokline : lineptr;
  1846.          l : loopptr;
  1847.          found : boolean;
  1848.       begin
  1849.          repeat
  1850.             if (loopbase = nil) or (loopbase^.kind = gosubloop) then
  1851.                errormsg('WEND without WHILE');
  1852.             found := (loopbase^.kind = whileloop);
  1853.             if not found then
  1854.                begin
  1855.                   l := loopbase^.next;
  1856.                   dispose(loopbase);
  1857.                   loopbase := l;
  1858.                end;
  1859.          until found;
  1860.          if not iseos then
  1861.             if realexpr <> 0 then
  1862.                found := false;
  1863.          tok := t;
  1864.          tokline := stmtline;
  1865.          if found then
  1866.             begin
  1867.                stmtline := loopbase^.homeline;
  1868.                t := loopbase^.hometok;
  1869.                if not iseos then
  1870.                   if realexpr = 0 then
  1871.                      found := false;
  1872.             end;
  1873.          if not found then
  1874.             begin
  1875.                t := tok;
  1876.                stmtline := tokline;
  1877.                l := loopbase^.next;
  1878.                dispose(loopbase);
  1879.                loopbase := l;
  1880.             end;
  1881.       end;
  1882.  
  1883.  
  1884.    procedure cmdgosub;
  1885.       var
  1886.          l : loopptr;
  1887.       begin
  1888.          new(l);
  1889.          l^.next := loopbase;
  1890.          loopbase := l;
  1891.          l^.kind := gosubloop;
  1892.          l^.homeline := stmtline;
  1893.          l^.hometok := t;
  1894.          cmdgoto;
  1895.       end;
  1896.  
  1897.  
  1898.    procedure cmdreturn;
  1899.       var
  1900.          l : loopptr;
  1901.          found : boolean;
  1902.       begin
  1903.          repeat
  1904.             if loopbase = nil then
  1905.                errormsg('RETURN without GOSUB');
  1906.             found := (loopbase^.kind = gosubloop);
  1907.             if not found then
  1908.                begin
  1909.                   l := loopbase^.next;
  1910.                   dispose(loopbase);
  1911.                   loopbase := l;
  1912.                end;
  1913.          until found;
  1914.          stmtline := loopbase^.homeline;
  1915.          t := loopbase^.hometok;
  1916.          l := loopbase^.next;
  1917.          dispose(loopbase);
  1918.          loopbase := l;
  1919.          skiptoeos;
  1920.       end;
  1921.  
  1922.  
  1923.    procedure cmdread;
  1924.       var
  1925.          v : varptr;
  1926.          tok : tokenptr;
  1927.          found : boolean;
  1928.       begin
  1929.          repeat
  1930.             v := findvar;
  1931.             tok := t;
  1932.             t := datatok;
  1933.             if dataline = nil then
  1934.                begin
  1935.                   dataline := linebase;
  1936.                   t := dataline^.txt;
  1937.                end;
  1938.             if (t = nil) or (t^.kind <> tokcomma) then
  1939.                repeat
  1940.                   while t = nil do
  1941.                      begin
  1942.                         if (dataline = nil) or (dataline^.next = nil) then
  1943.                            errormsg('Out of Data');
  1944.                         dataline := dataline^.next;
  1945.                         t := dataline^.txt;
  1946.                      end;
  1947.                   found := (t^.kind = tokdata);
  1948.                   t := t^.next;
  1949.                until found and not iseos
  1950.             else
  1951.                t := t^.next;
  1952.             if v^.stringvar then
  1953.                begin
  1954.                   if v^.sval^ <> nil then
  1955.                      dispose(v^.sval^);
  1956.                   v^.sval^ := strexpr;
  1957.                end
  1958.             else
  1959.                v^.val^ := realexpr;
  1960.             datatok := t;
  1961.             t := tok;
  1962.             if not iseos then
  1963.                require(tokcomma);
  1964.          until iseos;
  1965.       end;
  1966.  
  1967.  
  1968.    procedure cmddata;
  1969.       begin
  1970.          skiptoeos;
  1971.       end;
  1972.  
  1973.  
  1974.    procedure cmdrestore;
  1975.       begin
  1976.          if iseos then
  1977.             restoredata
  1978.          else
  1979.             begin
  1980.                dataline := mustfindline(intexpr);
  1981.                datatok := dataline^.txt;
  1982.             end;
  1983.       end;
  1984.  
  1985.  
  1986.    procedure cmdgotoxy;
  1987.       var
  1988.          i : integer;
  1989.       begin
  1990.          i := intexpr;
  1991.          require(tokcomma);
  1992.          gotoxy(i, intexpr);
  1993.       end;
  1994.  
  1995.  
  1996.    procedure cmdon;
  1997.       var
  1998.          i : integer;
  1999.          l : loopptr;
  2000.       begin
  2001.          i := intexpr;
  2002.          if (t <> nil) and (t^.kind = tokgosub) then
  2003.             begin
  2004.                new(l);
  2005.                l^.next := loopbase;
  2006.                loopbase := l;
  2007.                l^.kind := gosubloop;
  2008.                l^.homeline := stmtline;
  2009.                l^.hometok := t;
  2010.                t := t^.next;
  2011.             end
  2012.          else
  2013.             require(tokgoto);
  2014.          if i < 1 then
  2015.             skiptoeos
  2016.          else
  2017.             begin
  2018.                while (i > 1) and not iseos do
  2019.                   begin
  2020.                      require(toknum);
  2021.                      if not iseos then
  2022.                         require(tokcomma);
  2023.                      i := i - 1;
  2024.                   end;
  2025.                if not iseos then
  2026.                   cmdgoto;
  2027.             end;
  2028.       end;
  2029.  
  2030.  
  2031.    procedure cmddim;
  2032.       var
  2033.          i, j, k : integer;
  2034.          v : varptr;
  2035.          done : boolean;
  2036.       begin
  2037.          repeat
  2038.             if (t = nil) or (t^.kind <> tokvar) then snerr;
  2039.             v := t^.vp;
  2040.             t := t^.next;
  2041.             with v^ do
  2042.                begin
  2043.                   if numdims <> 0 then
  2044.                      errormsg('Array already dimensioned');
  2045.                   j := 1;
  2046.                   i := 0;
  2047.                   require(toklp);
  2048.                   repeat
  2049.                      k := intexpr + 1;
  2050.                      if k < 1 then badsubscr;
  2051.                      if i >= maxdims then badsubscr;
  2052.                      i := i + 1;
  2053.                      dims[i] := k;
  2054.                      j := j * k;
  2055.                      done := (t <> nil) and (t^.kind = tokrp);
  2056.                      if not done then
  2057.                         require(tokcomma);
  2058.                   until done;
  2059.                   t := t^.next;
  2060.                   numdims := i;
  2061.                   if stringvar then
  2062.                      begin
  2063.                         hpm_new(sarr, j*4);
  2064.                         for i := 0 to j-1 do
  2065.                            sarr^[i] := nil;
  2066.                      end
  2067.                   else
  2068.                      begin
  2069.                         hpm_new(arr, j*8);
  2070.                         for i := 0 to j-1 do
  2071.                            arr^[i] := 0;
  2072.                      end;
  2073.                end;
  2074.             if not iseos then
  2075.                require(tokcomma);
  2076.          until iseos;
  2077.       end;
  2078.  
  2079.  
  2080.    procedure cmdpoke;
  2081.       var
  2082.          trick :
  2083.             record
  2084.                case boolean of
  2085.                   true : (i : integer);
  2086.                   false : (c : ^char);
  2087.             end;
  2088.       begin
  2089.          $range off$
  2090.          trick.i := intexpr;
  2091.          require(tokcomma);
  2092.          trick.c^ := chr(intexpr);
  2093.          $if checking$ $range on$ $end$
  2094.       end;
  2095.  
  2096.  
  2097.    begin {exec}
  2098.       try
  2099.          repeat
  2100.             repeat
  2101.                gotoflag := false;
  2102.                elseflag := false;
  2103.                while (stmttok <> nil) and (stmttok^.kind = tokcolon) do
  2104.                   stmttok := stmttok^.next;
  2105.                t := stmttok;
  2106.                if t <> nil then
  2107.                   begin
  2108.                      t := t^.next;
  2109. {EMBED
  2110. #ifdef MCH_AMIGA
  2111.  if(SetSignal(0L, 0L) & SIGBREAKF_CTRL_C)
  2112.   \[
  2113.       P_escapecode = -20;
  2114.       goto _Ltry1;
  2115.   \]
  2116. #endif
  2117. }
  2118.                      case stmttok^.kind of
  2119.                         tokrem     : ;
  2120.                         toklist    : cmdlist;
  2121.                         tokrun     : cmdrun;
  2122.                         toknew     : cmdnew;
  2123.                         tokload    : cmdload(false, stringexpr);
  2124.                         tokmerge   : cmdload(true, stringexpr);
  2125.                         toksave    : cmdsave;
  2126.                         tokbye     : cmdbye;
  2127.                         tokdel     : cmddel;
  2128.                         tokrenum   : cmdrenum;
  2129.                         toklet     : cmdlet(false);
  2130.                         tokvar     : cmdlet(true);
  2131.                         tokprint   : cmdprint;
  2132.                         tokinput   : cmdinput;
  2133.                         tokgoto    : cmdgoto;
  2134.                         tokif      : cmdif;
  2135.                         tokelse    : cmdelse;
  2136.                         tokend     : cmdend;
  2137.                         tokstop    : escape(-20);
  2138.                         tokfor     : cmdfor;
  2139.                         toknext    : cmdnext;
  2140.                         tokwhile   : cmdwhile;
  2141.                         tokwend    : cmdwend;
  2142.                         tokgosub   : cmdgosub;
  2143.                         tokreturn  : cmdreturn;
  2144.                         tokread    : cmdread;
  2145.                         tokdata    : cmddata;
  2146.                         tokrestore : cmdrestore;
  2147.                         tokgotoxy  : cmdgotoxy;
  2148.                         tokon      : cmdon;
  2149.                         tokdim     : cmddim;
  2150.                         tokpoke    : cmdpoke;
  2151.                      otherwise
  2152.                         errormsg('Illegal command');
  2153.                      end;
  2154.                   end;
  2155.                if not elseflag and not iseos then
  2156.                   checkextra;
  2157.                stmttok := t;
  2158.             until t = nil;
  2159.             if stmtline <> nil then
  2160.                begin
  2161.                   if not gotoflag then
  2162.                      stmtline := stmtline^.next;
  2163.                   if stmtline <> nil then
  2164.                      stmttok := stmtline^.txt;
  2165.                end;
  2166.          until stmtline = nil;
  2167.       recover
  2168.          begin
  2169.             if escapecode = -20 then
  2170.                begin
  2171.                   write('Break');
  2172.                end
  2173.             else if escapecode = 42 then
  2174.                begin end
  2175.             else
  2176.                case escapecode of
  2177.                   -4 : write(#7'Integer overflow');
  2178.                   -5 : write(#7'Divide by zero');
  2179.                   -6 : write(#7'Real math overflow');
  2180.                   -7 : write(#7'Real math underflow');
  2181.                   -8, -19..-15 : write(#7'Value range error');
  2182.                   -10 :
  2183.                      begin
  2184.                         new(ioerrmsg);
  2185.                         misc_getioerrmsg(ioerrmsg^, ioresult);
  2186.                         write(#7, ioerrmsg^);
  2187.                         dispose(ioerrmsg);
  2188.                      end;
  2189.                   otherwise
  2190.                      begin
  2191.                         if excp_line <> -1 then
  2192.                            writeln(excp_line);
  2193.                         escape(escapecode);
  2194.                      end;
  2195.                end;
  2196.             if stmtline <> nil then
  2197.                write(' in ', stmtline^.num:1);
  2198.             writeln;
  2199.          end;
  2200.    end; {exec}
  2201.  
  2202.  
  2203.  
  2204.  
  2205.  
  2206. begin {main}
  2207.    new(inbuf);
  2208.    linebase := nil;
  2209.    varbase := nil;
  2210.    loopbase := nil;
  2211. {EMBED
  2212. #ifdef MCH_AMIGA
  2213. # ifdef AZTEC_C
  2214.   Enable_Abort = 0;
  2215. # endif
  2216. #endif
  2217. }
  2218.    writeln('Chipmunk BASIC 1.0');
  2219.    writeln;
  2220.    exitflag := false;
  2221.    repeat
  2222.       try
  2223.          repeat
  2224.             write('>');
  2225.             readln(inbuf^);
  2226.             parseinput(buf);
  2227.             if curline = 0 then
  2228.                begin
  2229.                   stmtline := nil;
  2230.                   stmttok := buf;
  2231.                   if stmttok <> nil then
  2232.                      exec;
  2233.                   disposetokens(buf);
  2234.                end;
  2235.          until exitflag or eof(input);
  2236.       recover
  2237.          if escapecode <> -20 then
  2238.             misc_printerror(escapecode, ioresult)
  2239.          else
  2240.             writeln;
  2241.    until exitflag or eof(input);
  2242. end.
  2243.  
  2244.  
  2245.  
  2246.  
  2247.