Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume21/p2c/part19

Internet Message Format | 1990-04-05 | 50.3 KB

Subject:  v21i064:  Pascal to C translator, Part19/32
Newsgroups: comp.sources.unix
Approved: [e-mail]
X-Checksum-Snefru: da6cea1c d014eb81 886e97ce e7773e24

Submitted-by: Dave Gillespie <[e-mail]>
Posting-number: Volume 21, Issue 64
Archive-name: p2c/part19

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 19 (of 32)."
# Contents:  examples/basic.p.1
# Wrapped by [e-mail] on Mon Mar 26 14:29:42 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'examples/basic.p.1' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'examples/basic.p.1'\"
else
echo shar: Extracting \"'examples/basic.p.1'\" \(48192 characters\)
sed "s/^X//" >'examples/basic.p.1' <<'END_OF_FILE'
X
X$ sysprog, ucsd, heap_dispose, partial_eval $
X
X{$ debug$}
X
X
Xprogram basic(input, output);
X
X
Xconst
X
X   checking = true;
X
X   varnamelen = 20;
X   maxdims = 4;
X
X
X
Xtype
X
X   varnamestring = string[varnamelen];
X
X   string255 = string[255];
X   string255ptr = ^string255;
X
X   tokenkinds = (tokvar, toknum, tokstr, toksnerr,
X
X                 tokplus, tokminus, toktimes, tokdiv, tokup, toklp, tokrp,
X                 tokcomma, toksemi, tokcolon, tokeq, toklt, tokgt,
X                 tokle, tokge, tokne,
X
X                 tokand, tokor, tokxor, tokmod, toknot, toksqr, toksqrt, toksin,
X                 tokcos, toktan, tokarctan, toklog, tokexp, tokabs, toksgn,
X                 tokstr_, tokval, tokchr_, tokasc, toklen, tokmid_, tokpeek,
X
X                 tokrem, toklet, tokprint, tokinput, tokgoto, tokif, tokend,
X                 tokstop, tokfor, toknext, tokwhile, tokwend, tokgosub,
X                 tokreturn, tokread, tokdata, tokrestore, tokgotoxy, tokon,
X                 tokdim, tokpoke,
X
X                 toklist, tokrun, toknew, tokload, tokmerge, toksave, tokbye,
X                 tokdel, tokrenum,
X
X                 tokthen, tokelse, tokto, tokstep);
X
X   realptr = ^real;
X   basicstring = string255ptr;
X   stringptr = ^basicstring;
X   numarray = array[0..maxint] of real;
X   arrayptr = ^numarray;
X   strarray = array[0..maxint] of basicstring;
X   strarrayptr = ^strarray;
X
X   tokenptr = ^tokenrec;
X   lineptr = ^linerec;
X   varptr = ^varrec;
X   loopptr = ^looprec;
X
X   tokenrec =
X      record
X         next : tokenptr;
X         case kind : tokenkinds of
X            tokvar : (vp : varptr);
X            toknum : (num : real);
X            tokstr, tokrem : (sp : string255ptr);
X            toksnerr : (snch : char);
X      end;
X
X   linerec =
X      record
X         num, num2 : integer;
X         txt : tokenptr;
X         next : lineptr;
X      end;
X
X   varrec =
X      record
X         name : varnamestring;
X         next : varptr;
X         dims : array [1..maxdims] of integer;
X         numdims : 0..maxdims;
X         case stringvar : boolean of
X            false : (arr : arrayptr;  val : realptr;  rv : real);
X            true : (sarr : strarrayptr;  sval : stringptr;  sv : basicstring);
X      end;
X
X   valrec =
X      record
X         case stringval : boolean of
X            false : (val : real);
X            true : (sval : basicstring);
X      end;
X
X   loopkind = (forloop, whileloop, gosubloop);
X   looprec =
X      record
X         next : loopptr;
X         homeline : lineptr;
X         hometok : tokenptr;
X         case kind : loopkind of
X            forloop :
X               ( vp : varptr;
X                 max, step : real );
X      end;
X
X
X
Xvar
X
X   inbuf : string255ptr;
X
X   linebase : lineptr;
X   varbase : varptr;
X   loopbase : loopptr;
X
X   curline : integer;
X   stmtline, dataline : lineptr;
X   stmttok, datatok, buf : tokenptr;
X
X   exitflag : boolean;
X
X   excp_line ['EXCP_LINE'] : integer;
X
X
X
X$if not checking$
X   $range off$
X$end$
X
X
X
Xprocedure misc_getioerrmsg(var s : string; io : integer);
X   external;
X
Xprocedure misc_printerror(er, io : integer);
X   external;
X
Xfunction asm_iand(a, b : integer) : integer;
X   external;
X
Xfunction asm_ior(a, b : integer) : integer;
X   external;
X
Xprocedure hpm_new(var p : anyptr; size : integer);
X   external;
X
Xprocedure hpm_dispose(var p : anyptr; size : integer);
X   external;
X
X
X
Xprocedure restoredata;
X   begin
X      dataline := nil;
X      datatok := nil;
X   end;
X
X
X
Xprocedure clearloops;
X   var
X      l : loopptr;
X   begin
X      while loopbase <> nil do
X         begin
X            l := loopbase^.next;
X            dispose(loopbase);
X            loopbase := l;
X         end;
X   end;
X
X
X
Xfunction arraysize(v : varptr) : integer;
X   var
X      i, j : integer;
X   begin
X      with v^ do
X         begin
X            if stringvar then
X               j := 4
X            else
X               j := 8;
X            for i := 1 to numdims do
X               j := j * dims[i];
X         end;
X      arraysize := j;
X   end;
X
X
Xprocedure clearvar(v : varptr);
X   begin
X      with v^ do
X         begin
X            if numdims <> 0 then
X               hpm_dispose(arr, arraysize(v))
X            else if stringvar and (sv <> nil) then
X               dispose(sv);
X            numdims := 0;
X            if stringvar then
X               begin
X                  sv := nil;
X                  sval := addr(sv);
X               end
X            else
X               begin
X                  rv := 0;
X                  val := addr(rv);
X               end;
X         end;
X   end;
X
X
Xprocedure clearvars;
X   var
X      v : varptr;
X   begin
X      v := varbase;
X      while v <> nil do
X         begin
X            clearvar(v);
X            v := v^.next;
X         end;
X   end;
X
X
X
Xfunction numtostr(n : real) : string255;
X   var
X      s : string255;
X      i : integer;
X   begin
X      setstrlen(s, 255);
X      if (n <> 0) and (abs(n) < 1e-2) or (abs(n) >= 1e12) then
X         begin
X            strwrite(s, 1, i, n);
X            setstrlen(s, i-1);
X            numtostr := s;
X         end
X      else
X         begin
X            strwrite(s, 1, i, n:30:10);
X            repeat
X               i := i - 1;
X            until s[i] <> '0';
X            if s[i] = '.' then
X               i := i - 1;
X            setstrlen(s, i);
X            numtostr := strltrim(s);
X         end;
X   end;
X
X
X
Xprocedure parse(inbuf : string255ptr; var buf : tokenptr);
X
X   const
X      toklength = 20;
X
X   type
X      chset = set of char;
X
X   const
X      idchars = chset ['A'..'Z','a'..'z','0'..'9','_','$'];
X
X   var
X      i, j, k : integer;
X      token : string[toklength];
X      t, tptr : tokenptr;
X      v : varptr;
X      ch : char;
X      n, d, d1 : real;
X
X   begin
X      tptr := nil;
X      buf := nil;
X      i := 1;
X      repeat
X         ch := ' ';
X         while (i <= strlen(inbuf^)) and (ch = ' ') do
X            begin
X               ch := inbuf^[i];
X               i := i + 1;
X            end;
X         if ch <> ' ' then
X            begin
X               new(t);
X               if tptr = nil then
X                  buf := t
X               else
X                  tptr^.next := t;
X               tptr := t;
X               t^.next := nil;
X               case ch of
X                  'A'..'Z', 'a'..'z' :
X                     begin
X                        i := i - 1;
X                        j := 0;
X                        setstrlen(token, strmax(token));
X                        while (i <= strlen(inbuf^)) and (inbuf^[i] in idchars) do
X                           begin
X                              if j < toklength then
X                                 begin
X                                    j := j + 1;
X                                    token[j] := inbuf^[i];
X                                 end;
X                              i := i + 1;
X                           end;
X                        setstrlen(token, j);
X                        if (token = 'and')     or (token = 'AND')     then t^.kind := tokand
X                   else if (token = 'or')      or (token = 'OR')      then t^.kind := tokor
X                   else if (token = 'xor')     or (token = 'XOR')     then t^.kind := tokxor
X                   else if (token = 'not')     or (token = 'NOT')     then t^.kind := toknot
X                   else if (token = 'mod')     or (token = 'MOD')     then t^.kind := tokmod
X                   else if (token = 'sqr')     or (token = 'SQR')     then t^.kind := toksqr
X                   else if (token = 'sqrt')    or (token = 'SQRT')    then t^.kind := toksqrt
X                   else if (token = 'sin')     or (token = 'SIN')     then t^.kind := toksin
X                   else if (token = 'cos')     or (token = 'COS')     then t^.kind := tokcos
X                   else if (token = 'tan')     or (token = 'TAN')     then t^.kind := toktan
X                   else if (token = 'arctan')  or (token = 'ARCTAN')  then t^.kind := tokarctan
X                   else if (token = 'log')     or (token = 'LOG')     then t^.kind := toklog
X                   else if (token = 'exp')     or (token = 'EXP')     then t^.kind := tokexp
X                   else if (token = 'abs')     or (token = 'ABS')     then t^.kind := tokabs
X                   else if (token = 'sgn')     or (token = 'SGN')     then t^.kind := toksgn
X                   else if (token = 'str$')    or (token = 'STR$')    then t^.kind := tokstr_
X                   else if (token = 'val')     or (token = 'VAL')     then t^.kind := tokval
X                   else if (token = 'chr$')    or (token = 'CHR$')    then t^.kind := tokchr_
X                   else if (token = 'asc')     or (token = 'ASC')     then t^.kind := tokasc
X                   else if (token = 'len')     or (token = 'LEN')     then t^.kind := toklen
X                   else if (token = 'mid$')    or (token = 'MID$')    then t^.kind := tokmid_
X                   else if (token = 'peek')    or (token = 'PEEK')    then t^.kind := tokpeek
X                   else if (token = 'let')     or (token = 'LET')     then t^.kind := toklet
X                   else if (token = 'print')   or (token = 'PRINT')   then t^.kind := tokprint
X                   else if (token = 'input')   or (token = 'INPUT')   then t^.kind := tokinput
X                   else if (token = 'goto')    or (token = 'GOTO')    then t^.kind := tokgoto
X                   else if (token = 'go to')   or (token = 'GO TO')   then t^.kind := tokgoto
X                   else if (token = 'if')      or (token = 'IF')      then t^.kind := tokif
X                   else if (token = 'end')     or (token = 'END')     then t^.kind := tokend
X                   else if (token = 'stop')    or (token = 'STOP')    then t^.kind := tokstop
X                   else if (token = 'for')     or (token = 'FOR')     then t^.kind := tokfor
X                   else if (token = 'next')    or (token = 'NEXT')    then t^.kind := toknext
X                   else if (token = 'while')   or (token = 'WHILE')   then t^.kind := tokwhile
X                   else if (token = 'wend')    or (token = 'WEND')    then t^.kind := tokwend
X                   else if (token = 'gosub')   or (token = 'GOSUB')   then t^.kind := tokgosub
X                   else if (token = 'return')  or (token = 'RETURN')  then t^.kind := tokreturn
X                   else if (token = 'read')    or (token = 'READ')    then t^.kind := tokread
X                   else if (token = 'data')    or (token = 'DATA')    then t^.kind := tokdata
X                   else if (token = 'restore') or (token = 'RESTORE') then t^.kind := tokrestore
X                   else if (token = 'gotoxy')  or (token = 'GOTOXY')  then t^.kind := tokgotoxy
X                   else if (token = 'on')      or (token = 'ON')      then t^.kind := tokon
X                   else if (token = 'dim')     or (token = 'DIM')     then t^.kind := tokdim
X                   else if (token = 'poke')    or (token = 'POKE')    then t^.kind := tokpoke
X                   else if (token = 'list')    or (token = 'LIST')    then t^.kind := toklist
X                   else if (token = 'run')     or (token = 'RUN')     then t^.kind := tokrun
X                   else if (token = 'new')     or (token = 'NEW')     then t^.kind := toknew
X                   else if (token = 'load')    or (token = 'LOAD')    then t^.kind := tokload
X                   else if (token = 'merge')   or (token = 'MERGE')   then t^.kind := tokmerge
X                   else if (token = 'save')    or (token = 'SAVE')    then t^.kind := toksave
X                   else if (token = 'bye')     or (token = 'BYE')     then t^.kind := tokbye
X                   else if (token = 'quit')    or (token = 'QUIT')    then t^.kind := tokbye
X                   else if (token = 'del')     or (token = 'DEL')     then t^.kind := tokdel
X                   else if (token = 'renum')   or (token = 'RENUM')   then t^.kind := tokrenum
X                   else if (token = 'then')    or (token = 'THEN')    then t^.kind := tokthen
X                   else if (token = 'else')    or (token = 'ELSE')    then t^.kind := tokelse
X                   else if (token = 'to')      or (token = 'TO')      then t^.kind := tokto
X                   else if (token = 'step')    or (token = 'STEP')    then t^.kind := tokstep
X                   else if (token = 'rem')     or (token = 'REM')     then
X                           begin
X                              t^.kind := tokrem;
X                              new(t^.sp);
X                              t^.sp^ := str(inbuf^, i, strlen(inbuf^)-i+1);
X                              i := strlen(inbuf^)+1;
X                           end
X                        else
X                           begin
X                              t^.kind := tokvar;
X                              v := varbase;
X                              while (v <> nil) and (v^.name <> token) do
X                                 v := v^.next;
X                              if v = nil then
X                                 begin
X                                    new(v);
X                                    v^.next := varbase;
X                                    varbase := v;
X                                    v^.name := token;
X                                    v^.numdims := 0;
X                                    if token[strlen(token)] = '$' then
X                                       begin
X                                          v^.stringvar := true;
X                                          v^.sv := nil;
X                                          v^.sval := addr(v^.sv);
X                                       end
X                                    else
X                                       begin
X                                          v^.stringvar := false;
X                                          v^.rv := 0;
X                                          v^.val := addr(v^.rv);
X                                       end;
X                                 end;
X                              t^.vp := v;
X                           end;
X                     end;
X                  '"', '''' :
X                     begin
X                        t^.kind := tokstr;
X                        new(t^.sp);
X                        setstrlen(t^.sp^, 255);
X                        j := 0;
X                        while (i <= strlen(inbuf^)) and (inbuf^[i] <> ch) do
X                           begin
X                              j := j + 1;
X                              t^.sp^[j] := inbuf^[i];
X                              i := i + 1;
X                           end;
X                        setstrlen(t^.sp^, j);
X                        i := i + 1;
X                     end;
X                  '0'..'9', '.' :
X                     begin
X                        t^.kind := toknum;
X                        n := 0;
X                        d := 1;
X                        d1 := 1;
X                        i := i - 1;
X                        while (i <= strlen(inbuf^)) and ((inbuf^[i] in ['0'..'9'])
X                                    or ((inbuf^[i] = '.') and (d1 = 1))) do
X                           begin
X                              if inbuf^[i] = '.' then
X                                 d1 := 10
X                              else
X                                 begin
X                                    n := n * 10 + ord(inbuf^[i]) - 48;
X                                    d := d * d1;
X                                 end;
X                              i := i + 1;
X                           end;
X                        n := n / d;
X                        if (i <= strlen(inbuf^)) and (inbuf^[i] in ['e','E']) then
X                           begin
X                              i := i + 1;
X                              d1 := 10;
X                              if (i <= strlen(inbuf^)) and (inbuf^[i] in ['+','-']) then
X                                 begin
X                                    if inbuf^[i] = '-' then
X                                       d1 := 0.1;
X                                    i := i + 1;
X                                 end;
X                              j := 0;
X                              while (i <= strlen(inbuf^)) and (inbuf^[i] in ['0'..'9']) do
X                                 begin
X                                    j := j * 10 + ord(inbuf^[i]) - 48;
X                                    i := i + 1;
X                                 end;
X                              for k := 1 to j do
X                                 n := n * d1;
X                           end;
X                        t^.num := n;
X                     end;
X                  '+' : t^.kind := tokplus;
X                  '-' : t^.kind := tokminus;
X                  '*' : t^.kind := toktimes;
X                  '/' : t^.kind := tokdiv;
X                  '^' : t^.kind := tokup;
X                  '(', '[' : t^.kind := toklp;
X                  ')', ']' : t^.kind := tokrp;
X                  ',' : t^.kind := tokcomma;
X                  ';' : t^.kind := toksemi;
X                  ':' : t^.kind := tokcolon;
X                  '?' : t^.kind := tokprint;
X                  '=' : t^.kind := tokeq;
X                  '<' :
X                     begin
X                        if (i <= strlen(inbuf^)) and (inbuf^[i] = '=') then
X                           begin
X                              t^.kind := tokle;
X                              i := i + 1;
X                           end
X                        else if (i <= strlen(inbuf^)) and (inbuf^[i] = '>') then
X                           begin
X                              t^.kind := tokne;
X                              i := i + 1;
X                           end
X                        else
X                           t^.kind := toklt;
X                     end;
X                  '>' :
X                     begin
X                        if (i <= strlen(inbuf^)) and (inbuf^[i] = '=') then
X                           begin
X                              t^.kind := tokge;
X                              i := i + 1;
X                           end
X                        else
X                           t^.kind := tokgt;
X                     end;
X                  otherwise
X                     begin
X                        t^.kind := toksnerr;
X                        t^.snch := ch;
X                     end;
X               end;
X            end;
X      until i > strlen(inbuf^);
X   end;
X
X
X
Xprocedure listtokens(var f : text; buf : tokenptr);
X   var
X      ltr, ltr0 : boolean;
X   begin
X      ltr := false;
X      while buf <> nil do
X         begin
X            if buf^.kind in [tokvar, toknum, toknot..tokrenum] then
X               begin
X                  if ltr then write(f, ' ');
X                  ltr := (buf^.kind <> toknot);
X               end
X            else
X               ltr := false;
X            case buf^.kind of
X               tokvar     : write(f, buf^.vp^.name);
X               toknum     : write(f, numtostr(buf^.num));
X               tokstr     : write(f, '"', buf^.sp^, '"');
X               toksnerr   : write(f, '{', buf^.snch, '}');
X               tokplus    : write(f, '+');
X               tokminus   : write(f, '-');
X               toktimes   : write(f, '*');
X               tokdiv     : write(f, '/');
X               tokup      : write(f, '^');
X               toklp      : write(f, '(');
X               tokrp      : write(f, ')');
X               tokcomma   : write(f, ',');
X               toksemi    : write(f, ';');
X               tokcolon   : write(f, ' : ');
X               tokeq      : write(f, ' = ');
X               toklt      : write(f, ' < ');
X               tokgt      : write(f, ' > ');
X               tokle      : write(f, ' <= ');
X               tokge      : write(f, ' >= ');
X               tokne      : write(f, ' <> ');
X               tokand     : write(f, ' AND ');
X               tokor      : write(f, ' OR ');
X               tokxor     : write(f, ' XOR ');
X               tokmod     : write(f, ' MOD ');
X               toknot     : write(f, 'NOT ');
X               toksqr     : write(f, 'SQR');
X               toksqrt    : write(f, 'SQRT');
X               toksin     : write(f, 'SIN');
X               tokcos     : write(f, 'COS');
X               toktan     : write(f, 'TAN');
X               tokarctan  : write(f, 'ARCTAN');
X               toklog     : write(f, 'LOG');
X               tokexp     : write(f, 'EXP');
X               tokabs     : write(f, 'ABS');
X               toksgn     : write(f, 'SGN');
X               tokstr_    : write(f, 'STR$');
X               tokval     : write(f, 'VAL');
X               tokchr_    : write(f, 'CHR$');
X               tokasc     : write(f, 'ASC');
X               toklen     : write(f, 'LEN');
X               tokmid_    : write(f, 'MID$');
X               tokpeek    : write(f, 'PEEK');
X               toklet     : write(f, 'LET');
X               tokprint   : write(f, 'PRINT');
X               tokinput   : write(f, 'INPUT');
X               tokgoto    : write(f, 'GOTO');
X               tokif      : write(f, 'IF');
X               tokend     : write(f, 'END');
X               tokstop    : write(f, 'STOP');
X               tokfor     : write(f, 'FOR');
X               toknext    : write(f, 'NEXT');
X               tokwhile   : write(f, 'WHILE');
X               tokwend    : write(f, 'WEND');
X               tokgosub   : write(f, 'GOSUB');
X               tokreturn  : write(f, 'RETURN');
X               tokread    : write(f, 'READ');
X               tokdata    : write(f, 'DATA');
X               tokrestore : write(f, 'RESTORE');
X               tokgotoxy  : write(f, 'GOTOXY');
X               tokon      : write(f, 'ON');
X               tokdim     : write(f, 'DIM');
X               tokpoke    : write(f, 'POKE');
X               toklist    : write(f, 'LIST');
X               tokrun     : write(f, 'RUN');
X               toknew     : write(f, 'NEW');
X               tokload    : write(f, 'LOAD');
X               tokmerge   : write(f, 'MERGE');
X               toksave    : write(f, 'SAVE');
X               tokdel     : write(f, 'DEL');
X               tokbye     : write(f, 'BYE');
X               tokrenum   : write(f, 'RENUM');
X               tokthen    : write(f, ' THEN ');
X               tokelse    : write(f, ' ELSE ');
X               tokto      : write(f, ' TO ');
X               tokstep    : write(f, ' STEP ');
X               tokrem     : write(f, 'REM', buf^.sp^);
X            end;
X            buf := buf^.next;
X         end;
X   end;
X
X
X
Xprocedure disposetokens(var tok : tokenptr);
X   var
X      tok1 : tokenptr;
X   begin
X      while tok <> nil do
X         begin
X            tok1 := tok^.next;
X            if tok^.kind in [tokstr, tokrem] then
X               dispose(tok^.sp);
X            dispose(tok);
X            tok := tok1;
X         end;
X   end;
X
X
X
Xprocedure parseinput(var buf : tokenptr);
X   var
X      l, l0, l1 : lineptr;
X   begin
X      inbuf^ := strltrim(inbuf^);
X      curline := 0;
X      while (strlen(inbuf^) <> 0) and (inbuf^[1] in ['0'..'9']) do
X         begin
X            curline := curline * 10 + ord(inbuf^[1]) - 48;
X            strdelete(inbuf^, 1, 1);
X         end;
X      parse(inbuf, buf);
X      if curline <> 0 then
X         begin
X            l := linebase;
X            l0 := nil;
X            while (l <> nil) and (l^.num < curline) do
X               begin
X                  l0 := l;
X                  l := l^.next;
X               end;
X            if (l <> nil) and (l^.num = curline) then
X               begin
X                  l1 := l;
X                  l := l^.next;
X                  if l0 = nil then
X                     linebase := l
X                  else
X                     l0^.next := l;
X                  disposetokens(l1^.txt);
X                  dispose(l1);
X               end;
X            if buf <> nil then
X               begin
X                  new(l1);
X                  l1^.next := l;
X                  if l0 = nil then
X                     linebase := l1
X                  else
X                     l0^.next := l1;
X                  l1^.num := curline;
X                  l1^.txt := buf;
X               end;
X            clearloops;
X            restoredata;
X         end;
X   end;
X
X
X
X
X
Xprocedure errormsg(s : string255);
X   begin
X      write(#7, s);
X      escape(42);
X   end;
X
X
Xprocedure snerr;
X   begin
X      errormsg('Syntax error');
X   end;
X
Xprocedure tmerr;
X   begin
X      errormsg('Type mismatch error');
X   end;
X
Xprocedure badsubscr;
X   begin
X      errormsg('Bad subscript');
X   end;
X
X
X
X
X
X
Xprocedure exec;
X
X   var
X      gotoflag, elseflag : boolean;
X      t : tokenptr;
X      ioerrmsg : string255ptr;
X
X
X   function factor : valrec;
X      forward;
X
X   function expr : valrec;
X      forward;
X
X   function realfactor : real;
X      var
X         n : valrec;
X      begin
X         n := factor;
X         if n.stringval then tmerr;
X         realfactor := n.val;
X      end;
X
X   function strfactor : basicstring;
X      var
X         n : valrec;
X      begin
X         n := factor;
X         if not n.stringval then tmerr;
X         strfactor := n.sval;
X      end;
X
X   function stringfactor : string255;
X      var
X         n : valrec;
X      begin
X         n := factor;
X         if not n.stringval then tmerr;
X         stringfactor := n.sval^;
X         dispose(n.sval);
X      end;
X
X   function intfactor : integer;
X      begin
X         intfactor := round(realfactor);
X      end;
X
X   function realexpr : real;
X      var
X         n : valrec;
X      begin
X         n := expr;
X         if n.stringval then tmerr;
X         realexpr := n.val;
X      end;
X
X   function strexpr : basicstring;
X      var
X         n : valrec;
X      begin
X         n := expr;
X         if not n.stringval then tmerr;
X         strexpr := n.sval;
X      end;
X
X   function stringexpr : string255;
X      var
X         n : valrec;
X      begin
X         n := expr;
X         if not n.stringval then tmerr;
X         stringexpr := n.sval^;
X         dispose(n.sval);
X      end;
X
X   function intexpr : integer;
X      begin
X         intexpr := round(realexpr);
X      end;
X
X
X   procedure require(k : tokenkinds);
X      begin
X         if (t = nil) or (t^.kind <> k) then
X            snerr;
X         t := t^.next;
X      end;
X
X
X   procedure skipparen;
X      label 1;
X      begin
X         repeat
X            if t = nil then snerr;
X            if (t^.kind = tokrp) or (t^.kind = tokcomma) then
X               goto 1;
X            if t^.kind = toklp then
X               begin
X                  t := t^.next;
X                  skipparen;
X               end;
X            t := t^.next;
X         until false;
X       1 :
X      end;
X
X
X   function findvar : varptr;
X      var
X         v : varptr;
X         i, j, k : integer;
X         tok : tokenptr;
X      begin
X         if (t = nil) or (t^.kind <> tokvar) then snerr;
X         v := t^.vp;
X         t := t^.next;
X         if (t <> nil) and (t^.kind = toklp) then
X            with v^ do
X               begin
X                  if numdims = 0 then
X                     begin
X                        tok := t;
X                        i := 0;
X                        j := 1;
X                        repeat
X                           if i >= maxdims then badsubscr;
X                           t := t^.next;
X                           skipparen;
X                           j := j * 11;
X                           i := i + 1;
X                           dims[i] := 11;
X                        until t^.kind = tokrp;
X                        numdims := i;
X                        if stringvar then
X                           begin
X                              hpm_new(sarr, j*4);
X                              for k := 0 to j-1 do
X                                 sarr^[k] := nil;
X                           end
X                        else
X                           begin
X                              hpm_new(arr, j*8);
X                              for k := 0 to j-1 do
X                                 arr^[k] := 0;
X                           end;
X                        t := tok;
X                     end;
X                  k := 0;
X                  t := t^.next;
X                  for i := 1 to numdims do
X                     begin
X                        j := intexpr;
X                        if (j < 0) or (j >= dims[i]) then
X                           badsubscr;
X                        k := k * dims[i] + j;
X                        if i < numdims then
X                           require(tokcomma);
X                     end;
X                  require(tokrp);
X                  if stringvar then
X                      sval := addr(sarr^[k])
X                  else
X                      val := addr(arr^[k]);
X               end
X         else
X            begin
X               if v^.numdims <> 0 then
X                  badsubscr;
X            end;
X         findvar := v;
X      end;
X
X
X   function inot(i : integer) : integer;
X      begin
X         inot := -1 - i;
X      end;
X
X   function ixor(a, b : integer) : integer;
X      begin
X         ixor := asm_ior(asm_iand(a, inot(b)), asm_iand(inot(a), b));
X      end;
X
X
X   function factor : valrec;
X      var
X         v : varptr;
X         facttok : tokenptr;
X         n : valrec;
X         i, j : integer;
X         tok, tok1 : tokenptr;
X         s : basicstring;
X         trick :
X            record
X               case boolean of
X                  true : (i : integer);
X                  false : (c : ^char);
X            end;
X      begin
X         if t = nil then snerr;
X         facttok := t;
X         t := t^.next;
X         n.stringval := false;
X         case facttok^.kind of
X            toknum :
X               n.val := facttok^.num;
X            tokstr :
X               begin
X                  n.stringval := true;
X                  new(n.sval);
X                  n.sval^ := facttok^.sp^;
X               end;
X            tokvar :
X               begin
X                  t := facttok;
X                  v := findvar;
X                  n.stringval := v^.stringvar;
X                  if n.stringval then
X                     begin
X                        new(n.sval);
X                        n.sval^ := v^.sval^^;
X                     end
X                  else
X                     n.val := v^.val^;
X               end;
X            toklp :
X               begin
X                  n := expr;
X                  require(tokrp);
X               end;
X            tokminus :
X               n.val := - realfactor;
X            tokplus :
X               n.val := realfactor;
X            toknot :
X               n.val := inot(intfactor);
X            toksqr :
X               n.val := sqr(realfactor);
X            toksqrt :
X               n.val := sqrt(realfactor);
X            toksin :
X               n.val := sin(realfactor);
X            tokcos :
X               n.val := cos(realfactor);
X            toktan :
X               begin
X                  n.val := realfactor;
X                  n.val := sin(n.val) / cos(n.val);
X               end;
X            tokarctan :
X               n.val := arctan(realfactor);
X            toklog:
X               n.val := ln(realfactor);
X            tokexp :
X               n.val := exp(realfactor);
X            tokabs :
X               n.val := abs(realfactor);
X            toksgn :
X               begin
X                  n.val := realfactor;
X                  n.val := ord(n.val > 0) - ord(n.val < 0);
X               end;
X            tokstr_ :
X               begin
X                  n.stringval := true;
X                  new(n.sval);
X                  n.sval^ := numtostr(realfactor);
X               end;
X            tokval :
X               begin
X                  s := strfactor;
X                  tok1 := t;
X                  parse(s, t);
X                  tok := t;
X                  if tok = nil then
X                     n.val := 0
X                  else
X                     n := expr;
X                  disposetokens(tok);
X                  t := tok1;
X                  dispose(s);
X               end;
X            tokchr_ :
X               begin
X                  n.stringval := true;
X                  new(n.sval);
X                  n.sval^ := ' ';
X                  n.sval^[1] := chr(intfactor);
X               end;
X            tokasc :
X               begin
X                  s := strfactor;
X                  if strlen(s^) = 0 then
X                     n.val := 0
X                  else
X                     n.val := ord(s^[1]);
X                  dispose(s);
X               end;
X            tokmid_ :
X               begin
X                  n.stringval := true;
X                  require(toklp);
X                  n.sval := strexpr;
X                  require(tokcomma);
X                  i := intexpr;
X                  if i < 1 then i := 1;
X                  j := 255;
X                  if (t <> nil) and (t^.kind = tokcomma) then
X                     begin
X                        t := t^.next;
X                        j := intexpr;
X                     end;
X                  if j > strlen(n.sval^)-i+1 then
X                     j := strlen(n.sval^)-i+1;
X                  if i > strlen(n.sval^) then
X                     n.sval^ := ''
X                  else
X                     n.sval^ := str(n.sval^, i, j);
X                  require(tokrp);
X               end;
X            toklen :
X               begin
X                  s := strfactor;
X                  n.val := strlen(s^);
X                  dispose(s);
X               end;
X            tokpeek :
X               begin
X                  $range off$
X                  trick.i := intfactor;
X                  n.val := ord(trick.c^);
X                  $if checking$ $range on$ $end$
X               end;
X            otherwise
X               snerr;
X         end;
X         factor := n;
X      end;
X
X   function upexpr : valrec;
X      var
X         n, n2 : valrec;
X      begin
X         n := factor;
X         while (t <> nil) and (t^.kind = tokup) do
X            begin
X               if n.stringval then tmerr;
X               t := t^.next;
X               n2 := upexpr;
X               if n2.stringval then tmerr;
X               if n.val < 0 then
X                  begin
X                     if n2.val <> trunc(n2.val) then n.val := ln(n.val);
X                     n.val := exp(n2.val * ln(-n.val));
X                     if odd(trunc(n2.val)) then
X                        n.val := - n.val;
X                  end
X               else
X                  n.val := exp(n2.val * ln(n.val));
X            end;
X         upexpr := n;
X      end;
X
X   function term : valrec;
X      var
X         n, n2 : valrec;
X         k : tokenkinds;
X      begin
X         n := upexpr;
X         while (t <> nil) and (t^.kind in [toktimes, tokdiv, tokmod]) do
X            begin
X               k := t^.kind;
X               t := t^.next;
X               n2 := upexpr;
X               if n.stringval or n2.stringval then tmerr;
X               if k = tokmod then
X                  n.val := round(n.val) mod round(n2.val)
X               else if k = toktimes then
X                  n.val := n.val * n2.val
X               else
X                  n.val := n.val / n2.val;
X            end;
X         term := n;
X      end;
X
X   function sexpr : valrec;
X      var
X         n, n2 : valrec;
X         k : tokenkinds;
X      begin
X         n := term;
X         while (t <> nil) and (t^.kind in [tokplus, tokminus]) do
X            begin
X               k := t^.kind;
X               t := t^.next;
X               n2 := term;
X               if n.stringval <> n2.stringval then tmerr;
X               if k = tokplus then
X                  if n.stringval then
X                     begin
X                        n.sval^ := n.sval^ + n2.sval^;
X                        dispose(n2.sval);
X                     end
X                  else
X                     n.val := n.val + n2.val
X               else
X                  if n.stringval then
X                     tmerr
X                  else
X                     n.val := n.val - n2.val;
X            end;
X         sexpr := n;
X      end;
X
X   function relexpr : valrec;
X      var
X         n, n2 : valrec;
X         f : boolean;
X         k : tokenkinds;
X      begin
X         n := sexpr;
X         while (t <> nil) and (t^.kind in [tokeq..tokne]) do
X            begin
X               k := t^.kind;
X               t := t^.next;
X               n2 := sexpr;
X               if n.stringval <> n2.stringval then tmerr;
X               if n.stringval then
X                  begin
X                     f := ((n.sval^ = n2.sval^) and (k in [tokeq, tokge, tokle]) or
X                           (n.sval^ < n2.sval^) and (k in [toklt, tokle, tokne]) or
X                           (n.sval^ > n2.sval^) and (k in [tokgt, tokge, tokne]));
X                     dispose(n.sval);
X                     dispose(n2.sval);
X                  end
X               else
X                  f := ((n.val = n2.val) and (k in [tokeq, tokge, tokle]) or
X                        (n.val < n2.val) and (k in [toklt, tokle, tokne]) or
X                        (n.val > n2.val) and (k in [tokgt, tokge, tokne]));
X               n.stringval := false;
X               n.val := ord(f);
X            end;
X         relexpr := n;
X      end;
X
X   function andexpr : valrec;
X      var
X         n, n2 : valrec;
X      begin
X         n := relexpr;
X         while (t <> nil) and (t^.kind = tokand) do
X            begin
X               t := t^.next;
X               n2 := relexpr;
X               if n.stringval or n2.stringval then tmerr;
X               n.val := asm_iand(trunc(n.val), trunc(n2.val));
X            end;
X         andexpr := n;
X      end;
X
X   function expr : valrec;
X      var
X         n, n2 : valrec;
X         k : tokenkinds;
X      begin
X         n := andexpr;
X         while (t <> nil) and (t^.kind in [tokor, tokxor]) do
X            begin
X               k := t^.kind;
X               t := t^.next;
X               n2 := andexpr;
X               if n.stringval or n2.stringval then tmerr;
X               if k = tokor then
X                  n.val := asm_ior(trunc(n.val), trunc(n2.val))
X               else
X                  n.val := ixor(trunc(n.val), trunc(n2.val));
X            end;
X         expr := n;
X      end;
X
X
X   procedure checkextra;
X      begin
X         if t <> nil then
X            errormsg('Extra information on line');
X      end;
X
X
X   function iseos : boolean;
X      begin
X         iseos := (t = nil) or (t^.kind in [tokcolon, tokelse]);
X      end;
X
X
X   procedure skiptoeos;
X      begin
X         while not iseos do
X            t := t^.next;
X      end;
X
X
X   function findline(n : integer) : lineptr;
X      var
X         l : lineptr;
X      begin
X         l := linebase;
X         while (l <> nil) and (l^.num <> n) do
X            l := l^.next;
X         findline := l;
X      end;
X
X
X   function mustfindline(n : integer) : lineptr;
X      var
X         l : lineptr;
X      begin
X         l := findline(n);
X         if l = nil then
X            errormsg('Undefined line');
X         mustfindline := l;
X      end;
X
X
X   procedure cmdend;
X      begin
X         stmtline := nil;
X         t := nil;
X      end;
X
X
X   procedure cmdnew;
X      var
X         p : anyptr;
X      begin
X         cmdend;
X         clearloops;
X         restoredata;
X         while linebase <> nil do
X            begin
X               p := linebase^.next;
X               disposetokens(linebase^.txt);
X               dispose(linebase);
X               linebase := p;
X            end;
X         while varbase <> nil do
X            begin
X               p := varbase^.next;
X               if varbase^.stringvar then
X                  if varbase^.sval^ <> nil then
X                     dispose(varbase^.sval^);
X               dispose(varbase);
X               varbase := p;
X            end;
X      end;
X
X
X   procedure cmdlist;
X      var
X         l : lineptr;
X         n1, n2 : integer;
X      begin
X         repeat
X            n1 := 0;
X            n2 := maxint;
X            if (t <> nil) and (t^.kind = toknum) then
X               begin
X                  n1 := trunc(t^.num);
X                  t := t^.next;
X                  if (t = nil) or (t^.kind <> tokminus) then
X                     n2 := n1;
X               end;
X            if (t <> nil) and (t^.kind = tokminus) then
X               begin
X                  t := t^.next;
X                  if (t <> nil) and (t^.kind = toknum) then
X                     begin
X                        n2 := trunc(t^.num);
X                        t := t^.next;
X                     end
X                  else
X                     n2 := maxint;
X               end;
X            l := linebase;
X            while (l <> nil) and (l^.num <= n2) do
X               begin
X                  if (l^.num >= n1) then
X                     begin
X                        write(l^.num:1, ' ');
X                        listtokens(output, l^.txt);
X                        writeln;
X                     end;
X                  l := l^.next;
X               end;
X            if not iseos then
X               require(tokcomma);
X         until iseos;
X      end;
X
X
X   procedure cmdload(merging : boolean; name : string255);
X      var
X         f : text;
X         buf : tokenptr;
X      begin
X         if not merging then
X            cmdnew;
X         reset(f, name + '.TEXT', 'shared');
X         while not eof(f) do
X            begin
X               readln(f, inbuf^);
X               parseinput(buf);
X               if curline = 0 then
X                  begin
X                     writeln('Bad line in file');
X                     disposetokens(buf);
X                  end;
X            end;
X         close(f);
X      end;
X
X
X   procedure cmdrun;
X      var
X         l : lineptr;
X         i : integer;
X         s : string255;
X      begin
X         l := linebase;
X         if not iseos then
X            begin
X               if t^.kind = toknum then
X                  l := mustfindline(intexpr)
X               else
X                  begin
X                     s := stringexpr;
X                     i := 0;
X                     if not iseos then
X                        begin
X                           require(tokcomma);
X                           i := intexpr;
X                        end;
X                     checkextra;
X                     cmdload(false, s);
X                     if i = 0 then
X                        l := linebase
X                     else
X                        l := mustfindline(i)
X                  end
X            end;
X         stmtline := l;
X         gotoflag := true;
X         clearvars;
X         clearloops;
X         restoredata;
X      end;
X
X
X   procedure cmdsave;
X      var
X         f : text;
X         l : lineptr;
X      begin
X         rewrite(f, stringexpr + '.TEXT');
X         l := linebase;
X         while l <> nil do
X            begin
X               write(f, l^.num:1, ' ');
X               listtokens(f, l^.txt);
X               writeln(f);
X               l := l^.next;
X            end;
X         close(f, 'save');
X      end;
X
X
X   procedure cmdbye;
X      begin
X         exitflag := true;
X      end;
X
X
X   procedure cmddel;
X      var
X         l, l0, l1 : lineptr;
X         n1, n2 : integer;
X      begin
X         repeat
X            if iseos then snerr;
X            n1 := 0;
X            n2 := maxint;
X            if (t <> nil) and (t^.kind = toknum) then
X               begin
X                  n1 := trunc(t^.num);
X                  t := t^.next;
X                  if (t = nil) or (t^.kind <> tokminus) then
X                     n2 := n1;
X               end;
X            if (t <> nil) and (t^.kind = tokminus) then
X               begin
X                  t := t^.next;
X                  if (t <> nil) and (t^.kind = toknum) then
X                     begin
X                        n2 := trunc(t^.num);
X                        t := t^.next;
X                     end
X                  else
X                     n2 := maxint;
X               end;
X            l := linebase;
X            l0 := nil;
X            while (l <> nil) and (l^.num <= n2) do
X               begin
X                  l1 := l^.next;
X                  if (l^.num >= n1) then
X                     begin
X                        if l = stmtline then
X                           begin
X                              cmdend;
X                              clearloops;
X                              restoredata;
X                           end;
X                        if l0 = nil then
X                           linebase := l^.next
X                        else
X                           l0^.next := l^.next;
X                        disposetokens(l^.txt);
X                        dispose(l);
X                     end
X                  else
X                     l0 := l;
X                  l := l1;
X               end;
X            if not iseos then
X               require(tokcomma);
X         until iseos;
X      end;
X
X
X   procedure cmdrenum;
X      var
X         l, l1 : lineptr;
X         tok : tokenptr;
X         lnum, step : integer;
X      begin
X         lnum := 10;
X         step := 10;
X         if not iseos then
X            begin
X               lnum := intexpr;
X               if not iseos then
X                  begin
X                     require(tokcomma);
X                     step := intexpr;
X                  end;
X            end;
X         l := linebase;
X         if l <> nil then
X            begin
X               while l <> nil do
X                  begin
X                     l^.num2 := lnum;
X                     lnum := lnum + step;
X                     l := l^.next;
X                  end;
X               l := linebase;
X               repeat
X                  tok := l^.txt;
X                  repeat
X                     if tok^.kind in [tokgoto, tokgosub, tokthen, tokelse,
X                                      tokrun, toklist, tokrestore, tokdel] then
X                        while (tok^.next <> nil) and (tok^.next^.kind = toknum) do
X                           begin
X                              tok := tok^.next;
X                              lnum := round(tok^.num);
X                              l1 := linebase;
X                              while (l1 <> nil) and (l1^.num <> lnum) do
X                                 l1 := l1^.next;
X                              if l1 = nil then
X                                 writeln('Undefined line ', lnum:1, ' in line ', l^.num2:1)
X                              else
X                                 tok^.num := l1^.num2;
X                              if (tok^.next <> nil) and (tok^.next^.kind = tokcomma) then
X                                 tok := tok^.next;
X                           end;
X                     tok := tok^.next;
X                  until tok = nil;
X                  l := l^.next;
X               until l = nil;
X               l := linebase;
X               while l <> nil do
X                  begin
X                     l^.num := l^.num2;
X                     l := l^.next;
X                  end;
X            end;
X      end;
X
X
X   procedure cmdprint;
X      var
X         semiflag : boolean;
X         n : valrec;
X      begin
X         semiflag := false;
X         while not iseos do
X            begin
X               semiflag := false;
X               if t^.kind in [toksemi, tokcomma] then
X                  begin
X                     semiflag := true;
X                     t := t^.next;
X                  end
X               else
X                  begin
X                     n := expr;
X                     if n.stringval then
X                        begin
X                           write(n.sval^);
X                           dispose(n.sval);
X                        end
X                     else
X                        write(numtostr(n.val), ' ');
X                  end;
X            end;
X         if not semiflag then
X            writeln;
X      end;
X
X
X   procedure cmdinput;
X      var
X         v : varptr;
X         s : string255;
X         tok, tok0, tok1 : tokenptr;
X         strflag : boolean;
X      begin
X         if (t <> nil) and (t^.kind = tokstr) then
X            begin
X               write(t^.sp^);
X               t := t^.next;
X               require(toksemi);
X            end
X         else
X            begin
X               write('? ');
X            end;
X         tok := t;
X         if (t = nil) or (t^.kind <> tokvar) then snerr;
X         strflag := t^.vp^.stringvar;
X         repeat
X            if (t <> nil) and (t^.kind = tokvar) then
X               if t^.vp^.stringvar <> strflag then snerr;
X            t := t^.next;
X         until iseos;
X         t := tok;
X         if strflag then
X            begin
X               repeat
X                  readln(s);
X                  v := findvar;
END_OF_FILE
if test 48192 -ne `wc -c <'examples/basic.p.1'`; then
    echo shar: \"'examples/basic.p.1'\" unpacked with wrong size!
fi
# end of 'examples/basic.p.1'
fi
echo shar: End of archive 19 \(of 32\).
cp /dev/null ark19isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 32 archives.
    echo "Now see PACKNOTES and the README"
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0