Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume13/pas2c.pch/ptc.diff

Text File | 1988-01-31 | 32.3 KB | 1,317 lines

*** ptc.p    Fri Nov 13 18:45:21 1987
--- nptc.p    Fri Nov 13 18:44:29 1987
***************
*** 42,48 ****
  (**    The code generated by the translator assumes that there    is a      **)
  (**    C-implementation with at least a reasonable <stdio> library      **)
  (**    since all input/output is implemented in terms of C functions      **)
! (**    like fprintf(), getc(), fopen(), rewind() etc.              **)
  (**    If the source-program uses Pascal functions like sin(), sqrt()      **)
  (**    etc, there must also exist such functions in the C-library.      **)
  (**                                      **)
--- 42,48 ----
  (**    The code generated by the translator assumes that there    is a      **)
  (**    C-implementation with at least a reasonable <stdio> library      **)
  (**    since all input/output is implemented in terms of C functions      **)
! (**    like fprintf(), getc(), fopen(), fseek() etc.              **)
  (**    If the source-program uses Pascal functions like sin(), sqrt()      **)
  (**    etc, there must also exist such functions in the C-library.      **)
  (**                                      **)
***************
*** 53,59 ****

  label    9999;                (* end of program        *)

! const    version        = '@(#)ptc.p    1.5  Date 87/05/01';

      keytablen    = 38;        (* nr of keywords        *)
      keywordlen    = 10;        (* length of a keyword        *)
--- 53,59 ----

  label    9999;                (* end of program        *)

! const    version        = '@(#)ptc.p    2.6  Date 87/09/12';

      keytablen    = 38;        (* nr of keywords        *)
      keywordlen    = 10;        (* length of a keyword        *)
***************
*** 67,75 ****
      setbits        = 15;            (* CPU *)

      (* a Pascal file is implemented as a struct which (among other    *)
!     (* things) contain a flag-field, currently 3 bits are used    *)
      filebits    = 'unsigned short';    (* flags for files    *)
!     filefill    = 12;            (* 16 less used 3 bits    *)

      maxsetrange    = 15;            (* nr of words in a set    *)
      scalbase    = 0;    (* ordinal value of first scalar member    *)
--- 67,75 ----
      setbits        = 15;            (* CPU *)

      (* a Pascal file is implemented as a struct which (among other    *)
!     (* things) contain a flag-field, currently 4 bits are used    *)
      filebits    = 'unsigned short';    (* flags for files    *)
!     filefill    = 12;            (* 16 less used 4 bits    *)

      maxsetrange    = 15;            (* nr of words in a set    *)
      scalbase    = 0;    (* ordinal value of first scalar member    *)
***************
*** 106,111 ****
--- 106,112 ----
         temporary files for reset/rewrite, the last character is supplied
         by the reset/rewrite routine *)
      tmpfilename    = '"/tmp/ptc%d%c", getpid(), '; (* OS *)
+     maxfilename    = 'MAXFILENAME';

      (* some frequently used characters *)
      space        = ' ';
***************
*** 146,151 ****
--- 147,154 ----
      voidtyp        = 'void';    (* for procedures         *)
      voidcast    = '(void)';

+     align        = true;        (* align literal params        *)
+
      intlen        = 10;        (* length of written integer    *)
      fixlen        = 20;        (* length of written real    *)

***************
*** 239,244 ****
--- 242,264 ----
            sinteger:    (vint    : integer);
            sreal:    (vflt    : strindx);
            sstring:    (vstr    : strindx);
+
+           sand,        sarray,        sbegin,        scase,
+           sconst,    sdiv,        sdo,        sdownto,
+           selse,    send,        sextern,    sfile,
+           sfor,        sforward,    sfunc,        sgoto,
+           sif,        sinn,        slabel,        smod,
+           snil,        snot,        sof,        sor,
+           sother,    spacked,    sproc,        spgm,
+           srecord,    srepeat,    sset,        sthen,
+           sto,        stype,        suntil,        svar,
+           swhile,    swith,        seof,
+           splus,    sminus,        smul,        squot,
+           sarrow,    slpar,        srpar,        slbrack,
+           srbrack,    seq,        sne,        slt,
+           sle,        sgt,        sge,        scomma,
+           scolon,    ssemic,        sassign,    sdotdot,
+           sdot:        ()
          end;

      (* enumeration of symnode variants *)
***************
*** 648,653 ****
--- 668,674 ----
          cstdout,    cstderr,    cstrncmp,    cstrncpy,
          cstruct,    cstatic,    cswitch,    ctypedef,
          cundef,        cungetc,    cunion,        cunlink,
+         cfseek,        cgetchar,    cputchar,
          cunsigned,    cwrite
      );

***************
*** 661,667 ****
          enew,        esetbase,    esetsize,    eoverflow,
          etree,        etag,        euprconf,    easgnconf,
          ecmpconf,    econfconf,    evrntfile,    evarfile,
!         emanymachs,    ebadmach
      );

      machdefstr = packed array [ 1 .. machdeflen ] of char;
--- 682,688 ----
          enew,        esetbase,    esetsize,    eoverflow,
          etree,        etag,        euprconf,    easgnconf,
          ecmpconf,    econfconf,    evrntfile,    evarfile,
!         emanymachs,    ebadmach,    eprconf
      );

      machdefstr = packed array [ 1 .. machdeflen ] of char;
***************
*** 683,688 ****
--- 704,711 ----
      useins,
      usescpy,
      usecomp,        (* source program uses string-compare    *)
+     usealig,        (* source program uses aligned params    *)
+     usesal,
      usefopn,        (* source program uses reset/rewrite    *)
      usescan,
      usegetl,
***************
*** 738,745 ****

      varno    : integer;        (* counter for unique id's    *)

!     hexdig    : packed array [ 0 .. 15 ] of char;

  (*    Prtmsg produces an error message. It asssumes that procedure    *)
  (*    "message" (predefined) will "writeln" to user tty. OS        *)
  procedure prtmsg(m : errors);
--- 761,771 ----

      varno    : integer;        (* counter for unique id's    *)

!     pushchr    : char;            (* pushback for lexical scanner    *)
!     pushed    : boolean;

+     hexdig    : array [ 0 .. 15 ] of char;
+
  (*    Prtmsg produces an error message. It asssumes that procedure    *)
  (*    "message" (predefined) will "writeln" to user tty. OS        *)
  procedure prtmsg(m : errors);
***************
*** 814,819 ****
--- 840,847 ----
          message(restr, 'Too many machine integer types');
        ebadmach:
          message(inter, 'Bad name for machine integer type');
+       eprconf:
+         message(restr, 'Cannot write conformant arrays');
      end;(* case *)
      if lastline <> 0 then
          begin
***************
*** 1219,1225 ****
      var    c    : char;

      begin
!         if eof then
              c := chr(null)
          else begin
              colno := colno + 1;
--- 1247,1258 ----
      var    c    : char;

      begin
!         if pushed then
!             begin
!             c := pushchr;
!             pushed := false
!             end
!         else if eof then
              c := chr(null)
          else begin
              colno := colno + 1;
***************
*** 1235,1241 ****
                  else
                      write(c);
              if c = tab1 then
!                 colno := ((colno div tabwidth) + 1) * tabwidth
               end;
          if lastchr > 0 then
              begin
--- 1268,1275 ----
                  else
                      write(c);
              if c = tab1 then
!                 colno := (((colno - 1) div tabwidth) + 1) *
!                         tabwidth
               end;
          if lastchr > 0 then
              begin
***************
*** 1249,1255 ****
      function peekchar : char;

      begin
!         if eof then
              peekchar := chr(null)
          else
              peekchar := input^
--- 1283,1291 ----
      function peekchar : char;

      begin
!         if pushed then
!             peekchar := pushchr
!         else if eof then
              peekchar := chr(null)
          else
              peekchar := input^
***************
*** 1458,1466 ****
                      end;
                  st := sinteger;
                  vint := n;
                  if realok then
                      begin
-                     (* accept real numbers *)
                      if peekchar = '.' then
                          begin
                          (* this is a real number *)
--- 1494,1508 ----
                      end;
                  st := sinteger;
                  vint := n;
+                 if realok and (peekchar = '.') then
+                     begin
+                     c := nextchar;
+                     realok := numchar(peekchar);
+                     pushchr := c;
+                     pushed := true
+                     end;
                  if realok then
                      begin
                      if peekchar = '.' then
                          begin
                          (* this is a real number *)
***************
*** 1579,1585 ****
                quote:
                  begin
                  (* assume the symbol is a literal string *)
!                 wl := 0;
                  ready := false;
                  repeat
                      if eoln then
--- 1621,1627 ----
                quote:
                  begin
                  (* assume the symbol is a literal string *)
!                 wl := 1;
                  ready := false;
                  repeat
                      if eoln then
***************
*** 1602,1608 ****
                          end;
                      if not ready then
                          begin
!                         wl := wl + 1;
                          if wl >= maxtoknlen then
                              begin
                              lasttok[lastchr] :=
--- 1644,1650 ----
                          end;
                      if not ready then
                          begin
!                         wb[wl] := c;
                          if wl >= maxtoknlen then
                              begin
                              lasttok[lastchr] :=
***************
*** 1609,1618 ****
                                  chr(null);
                              error(elongstring)
                              end;
!                         wb[wl] := c
                          end
                  until    ready;
!                 if wl = 1 then
                      begin
                      (* only 1 character => not a string *)
                      st := schar;
--- 1651,1660 ----
                                  chr(null);
                              error(elongstring)
                              end;
!                         wl := wl + 1;
                          end
                  until    ready;
!                 if wl = 2 then
                      begin
                      (* only 1 character => not a string *)
                      st := schar;
***************
*** 1620,1631 ****
                      end
                  else begin
                      (* > 1 character => its a string *)
-                     wl := wl + 1;
-                     if wl >= maxtoknlen then
-                         begin
-                         lasttok[lastchr] := chr(null);
-                         error(elongstring)
-                         end;
                      wb[wl] := chr(null);
                      st := sstring;
                      vstr := savestr(wb)
--- 1662,1667 ----
***************
*** 2645,2650 ****
--- 2681,2687 ----
                          sproc, sfunc, sbegin]);
          pbody(tp);
          checksymbol([sdot]);
+         nextsymbol([seof]);
          tp^.tscope := currscope;
          leavescope;
          pprogram := tp
***************
*** 2662,2668 ****
          tp^.tsubid := nil;
          tp^.tsubpar := nil;
          pbody(tp);
!         checksymbol([ssemic]);
          tp^.tscope := currscope;
          leavescope;
          pmodule := tp
--- 2699,2707 ----
          tp^.tsubid := nil;
          tp^.tsubpar := nil;
          pbody(tp);
!         checksymbol([ssemic, seof]);
!         if currsym.st = ssemic then
!             nextsymbol([seof]);
          tp^.tscope := currscope;
          leavescope;
          pmodule := tp
***************
*** 2799,2805 ****
              enterscope(dp);
              dp := currscope
              end;
!         nextsymbol([sid, scase] + [cs]);
          tq := nil;
          while currsym.st = sid do
              begin
--- 2838,2844 ----
              enterscope(dp);
              dp := currscope
              end;
!         nextsymbol([sid, scase, cs]);
          tq := nil;
          while currsym.st = sid do
              begin
***************
*** 2820,2826 ****
              tq^.tbind := ptypedef;
              enterscope(dp);
              if currsym.st = ssemic then
!                 nextsymbol([sid, scase] + [cs])
              end;
          if currsym.st = scase then
              begin
--- 2859,2865 ----
              tq^.tbind := ptypedef;
              enterscope(dp);
              if currsym.st = ssemic then
!                 nextsymbol([sid, scase, cs])
              end;
          if currsym.st = scase then
              begin
***************
*** 2852,2858 ****
                  tv := nil;
                  repeat
                      nextsymbol([sid, sinteger, schar, splus,
!                              sminus] + [cs]);
                      if currsym.st = cs then
                          goto 999;
                      if tv = nil then
--- 2891,2897 ----
                  tv := nil;
                  repeat
                      nextsymbol([sid, sinteger, schar, splus,
!                              sminus, cs]);
                      if currsym.st = cs then
                          goto 999;
                      if tv = nil then
***************
*** 3650,3655 ****
--- 3689,3696 ----
                  tq^.tnext := mknode(nchoise);
                  tq := tq^.tnext
                   end;
+             tq^.tchocon := nil;
+             tq^.tchostmt := nil;
              tv := nil;
              repeat
                  nextsymbol([sid, sinteger, schar,
***************
*** 3845,3852 ****
      if currsym.st = spgm then
          top := pprogram
      else
!         top := pmodule;
!     nextsymbol([seof]);
  end;    (* parse *)

  (*    Compute value for a node (which must be some kind of constant).    *)
--- 3886,3892 ----
      if currsym.st = spgm then
          top := pprogram
      else
!         top := pmodule
  end;    (* parse *)

  (*    Compute value for a node (which must be some kind of constant).    *)
***************
*** 4317,4328 ****
                          move := true;
                          sp := ip^.tsym;
                          if sp^.lid^.inref > 1 then
-                           begin
                              sp^.lid :=
!                             mkrename( 'M', sp^.lid);
!                             sp^.lid^.inref :=
!                                 sp^.lid^.inref - 1
!                           end;
                          ip := nil
                          end
                      else
--- 4357,4364 ----
                          move := true;
                          sp := ip^.tsym;
                          if sp^.lid^.inref > 1 then
                              sp^.lid :=
!                             mkrename('M', sp^.lid);
                          ip := nil
                          end
                      else
***************
*** 4619,4624 ****
--- 4655,4662 ----

                  (* mark those used in nested subroutines *)
                  global(tp^.tsubsub, tp, false);
+                 global(tp^.tsubvar, tp, false);
+                 global(tp^.tsubtype, tp, false);

                  (* move out variables used in inner scope *)
                  movevars(tp, tp^.tsubpar);
***************
*** 4887,4896 ****
                     a unique name *)
                  sp := tp^.tsubid^.tsym;
                  if sp^.lid^.inref > 1 then
!                     begin
!                     sp^.lid := mkrename('P', sp^.lid);
!                     sp^.lid^.inref := sp^.lid^.inref - 1
!                     end
                  end;
              tp := tp^.tnext
              end
--- 4925,4931 ----
                     a unique name *)
                  sp := tp^.tsubid^.tsym;
                  if sp^.lid^.inref > 1 then
!                     sp^.lid := mkrename('P', sp^.lid)
                  end;
              tp := tp^.tnext
              end
***************
*** 5131,5136 ****
--- 5166,5172 ----

  const    include    = '# include ';
      define    = '# define ';
+     undef    = '# undef ';
      ifdef    = '# ifdef ';
      ifndef    = '# ifndef ';
      elsif    = '# else';
***************
*** 5145,5152 ****
  var    conflag,
      setused,
      dropset,
-     donearr    : boolean;
      doarrow,
      indnt    : integer;

      procedure increment;
--- 5181,5188 ----
  var    conflag,
      setused,
      dropset,
      doarrow,
+     donearr    : boolean;
      indnt    : integer;

      procedure increment;
***************
*** 5203,5216 ****
      (*    Emit code to select a record member.    *)
      procedure eselect(tp : treeptr);

      begin
!         doarrow := doarrow + 1;
          eexpr(tp);
-         doarrow := doarrow - 1;
          if donearr then
              donearr := false
          else
!             write('.')
      end;

      (*    Emit code for call to a predefined function/procedure.    *)
--- 5239,5255 ----
      (*    Emit code to select a record member.    *)
      procedure eselect(tp : treeptr);

+     var    da    : boolean;
+
      begin
!         da := doarrow;
!         doarrow := true;
          eexpr(tp);
          if donearr then
              donearr := false
          else
!             write('.');
!         doarrow := da
      end;

      (*    Emit code for call to a predefined function/procedure.    *)
***************
*** 5435,5441 ****
                          else
                              write('*.*');
                      write('s')
!                      end
              end (* case *)
          end;    (* eformat *)

--- 5474,5482 ----
                          else
                              write('*.*');
                      write('s')
!                      end;
!               'v':
!                 fatal(eprconf)
              end (* case *)
          end;    (* eformat *)

***************
*** 5572,5578 ****
                      write(', ');
                      eexpr(tq)
                      end
!                 end
              end (* case *)
          end;    (* ewrite *)

--- 5613,5621 ----
                      write(', ');
                      eexpr(tq)
                      end
!                 end;
!               'v':
!                 fatal(eprconf)
              end (* case *)
          end;    (* ewrite *)

***************
*** 6212,6218 ****
              write(', ');
              tq := tp^.taparm^.tnext;
              if tq = nil then
!                 write('NULL')
              else begin
                  tq := typeof(tq);
                  if tq = typnods[tchar] then
--- 6255,6261 ----
              write(', ');
              tq := tp^.taparm^.tnext;
              if tq = nil then
!                 write('NULL, 0')
              else begin
                  tq := typeof(tq);
                  if tq = typnods[tchar] then
***************
*** 6221,6234 ****
                      ch := chr(cvalof(tp^.taparm^.tnext));
                      if (ch = bslash) or (ch = cite) then
                          write(bslash);
!                     write(ch, cite)
                      end
                  else if tq = typnods[tstring] then
!                     eexpr(tp^.taparm^.tnext)
!                 else  if tq^.tt in [narray, nconfarr] then
                       begin
                      eexpr(tp^.taparm^.tnext);
!                     write('.A')
                       end
                  else
                      fatal(etree)
--- 6264,6282 ----
                      ch := chr(cvalof(tp^.taparm^.tnext));
                      if (ch = bslash) or (ch = cite) then
                          write(bslash);
!                     write(ch, cite, ', -1')
                      end
                  else if tq = typnods[tstring] then
!                     begin
!                     eexpr(tp^.taparm^.tnext);
!                     write(', -1')
!                     end
!                 else if tq^.tt = narray then
                       begin
                      eexpr(tp^.taparm^.tnext);
!                     write('.A, sizeof(');
!                     eexpr(tp^.taparm^.tnext);
!                     write('.A)')
                       end
                  else
                      fatal(etree)
***************
*** 6487,6507 ****
                          eexpr(tq);
                          write(')')
                          end
                      else
                          eexpr(tq);
                      end
!                 else if (tx = typnods[tstring]) or
!                         (tx = typnods[tset]) then
                      begin
-                     (* cast literal to proper type *)
                      write('*((');
                      etypedef(tf^.tup^.tbind);
                      write(' *)');
!                     if tx = typnods[tset] then
                          begin
!                         dropset := true;
                          eexpr(tq);
!                         dropset := false
                          end
                      else
                          eexpr(tq);
--- 6535,6574 ----
                          eexpr(tq);
                          write(')')
                          end
+                     else if tf^.tup^.tt = nvarpar then
+                         eaddr(tq)
                      else
+                         eexpr(tq)
+                     end
+                 else if tx = typnods[tset] then
+                     begin
+                     write('*((');
+                     etypedef(tf^.tup^.tbind);
+                     write(' *)');
+                     dropset := true;
+                     if align then
+                         begin
+                         usesal := true;
+                         write('SETALIGN(');
                          eexpr(tq);
+                         write(')')
+                         end
+                     else
+                         eexpr(tq);
+                     dropset := false;
+                     write(')')
                      end
!                 else if tx = typnods[tstring] then
                      begin
                      write('*((');
                      etypedef(tf^.tup^.tbind);
                      write(' *)');
!                     if align then
                          begin
!                         usealig := true;
!                         write('STRALIGN(');
                          eexpr(tq);
!                         write(')')
                          end
                      else
                          eexpr(tq);
***************
*** 6521,6528 ****
                      eexpr(tq);
                      (* add upper bound of actual value *)
                      if tq^.tnext = nil then
!                         write(', ',
!                             crange(tx^.taindx):1)
                      end
                  else begin
                      if tf^.tup^.tt = nvarpar then
--- 6588,6600 ----
                      eexpr(tq);
                      (* add upper bound of actual value *)
                      if tq^.tnext = nil then
!                         begin
!                         write(', (');
!                         eexpr(tx^.taindx^.thi);
!                         write(' - ');
!                         eexpr(tx^.taindx^.tlo);
!                         write(' + 1)')
!                         end
                      end
                  else begin
                      if tf^.tup^.tt = nvarpar then
***************
*** 6930,6944 ****
                  eexpr(tp^.texps);
                  write('.buf')
                  end
!             else if doarrow = 0 then
                  begin
!                 write('*');
!                 eexpr(tp^.texps)
!                 end
!             else begin
                  eexpr(tp^.texps);
                  write('->');
                  donearr := true
                   end
              end;
            nid:
--- 7002,7018 ----
                  eexpr(tp^.texps);
                  write('.buf')
                  end
!             else if doarrow then
                  begin
!                 doarrow := false;
                  eexpr(tp^.texps);
                  write('->');
                  donearr := true
+                 end
+             else begin
+                 write('(*');
+                 eexpr(tp^.texps);
+                 write(')')
                   end
              end;
            nid:
***************
*** 6947,6966 ****
                 var-parameter or as a procedure-parameter *)
              tq := idup(tp);
              if tq^.tt = nvarpar then
!                 begin
!                 if (doarrow = 0) or
!                         (tq^.tattr = areference) then
                      begin
!                     write('(*');
                      printid(tp^.tsym^.lid);
!                     write(')')
                      end
                  else begin
                      printid(tp^.tsym^.lid);
!                     write('->');
!                     donearr := true
                       end
-                 end
              else if (tq^.tt = nconst) and conflag then
                  write(cvalof(tp):1)
              else if tq^.tt in [nparproc, nparfunc] then
--- 7021,7038 ----
                 var-parameter or as a procedure-parameter *)
              tq := idup(tp);
              if tq^.tt = nvarpar then
!                 if doarrow then
                      begin
!                     doarrow := false;
                      printid(tp^.tsym^.lid);
!                     write('->');
!                     donearr := true
                      end
                  else begin
+                     write('(*');
                      printid(tp^.tsym^.lid);
!                     write(')')
                       end
              else if (tq^.tt = nconst) and conflag then
                  write(cvalof(tp):1)
              else if tq^.tt in [nparproc, nparfunc] then
***************
*** 7107,7112 ****
--- 7179,7206 ----
              end
      end;    (* econst *)

+     (*    Undefine constants.                    *)
+     procedure edconst(tp : treeptr);
+
+     var    sp    : symptr;
+
+     begin
+         while tp <> nil do
+             begin
+             sp := tp^.tidl^.tsym;
+             if tp^.tbind^.tt <> nstring then
+                 begin
+                 (* all non-strings are emitted as
+                    preprocessor # defines *)
+                 write(undef);
+                 printid(sp^.lid);
+                 writeln
+                 end;
+             tp := tp^.tnext
+             end
+     end;    (* edconst *)
+
+
      (*    Emit a typedef.                        *)
      procedure etypedef;

***************
*** 7867,7876 ****
                ncase:
                  begin
                  indent;
!                 write('switch (');
                  increment;
                  eexpr(tp^.tcasxp);
!                 writeln(') {');
                  decrement;
                  echoise(tp^.tcaslst);
                  indent;
--- 7961,7970 ----
                ncase:
                  begin
                  indent;
!                 write('switch ((int)(');
                  increment;
                  eexpr(tp^.tcasxp);
!                 writeln(')) {');
                  decrement;
                  echoise(tp^.tcaslst);
                  indent;
***************
*** 8052,8058 ****
              indent;
              writeln('  case 0:');
              indent;
!             writeln(tab1, 'break');
              tq := tp^.tsublab;
              while tq <> nil do
                  begin
--- 8146,8152 ----
              indent;
              writeln('  case 0:');
              indent;
!             writeln(tab1, 'break;');
              tq := tp^.tsublab;
              while tq <> nil do
                  begin
***************
*** 8071,8077 ****
              indent;
              writeln('  default:');
              indent;
!             writeln(tab1, 'Caseerror(Line)');
              indent;
              writeln('}')
              end
--- 8165,8171 ----
              indent;
              writeln('  default:');
              indent;
!             writeln(tab1, 'Caseerror(Line);');
              indent;
              writeln('}')
              end
***************
*** 8198,8203 ****
--- 8292,8298 ----
                  writeln(';');
                  end;
              decrement;
+             edconst(tp^.tsubconst);
              writeln('}');
          999:
              writeln;
***************
*** 8337,8345 ****
              writeln(define, 'Putl(f, v) (f).eoln = v')
              end;
          if use(dreset) or use(drewrite) or use(dclose) then
              writeln(define, 'Finish(f) ((f).out && !(f).eoln) ? ',
                  '(Putchr(', nlchr, ', f), 0) : 0, ',
!                     'rewind((f).fp)');    (* LIB *)
          if use(dclose) then
              begin
              writeln(define, 'Close(f) (f).init = ',
--- 8432,8443 ----
              writeln(define, 'Putl(f, v) (f).eoln = v')
              end;
          if use(dreset) or use(drewrite) or use(dclose) then
+             begin
              writeln(define, 'Finish(f) ((f).out && !(f).eoln) ? ',
                  '(Putchr(', nlchr, ', f), 0) : 0, ',
!                     '!fseek((f).fp, 0L, 0)'); (* LIB *)
!             writeln(xtern, 'int', tab1, 'fseek();')    (* LIB *)
!             end;
          if use(dclose) then
              begin
              writeln(define, 'Close(f) (f).init = ',
***************
*** 8359,8371 ****
              writeln(elsif);
              writeln(static, chartyp, tab1, 'Rmode[] = "r+";');
              writeln(endif);
!             writeln(define, 'Reset(f, n) (f).init = ',
!                 '(f).init ? rewind((f).fp) : ',    (* LIB *)
!                 '(((f).fp = Fopen(n, Rmode)), 1), ',
                      '(f).eof = (f).out = 0, Get(f)');
!             writeln(define, 'Resetx(f, n) (f).init = ',
                  '(f).init ? (Finish(f)) : ',
!                 '(((f).fp = Fopen(n, Rmode)), 1), ',
                      '(f).eof = (f).out = 0, Getx(f)');
              usefopn := true
              end;
--- 8457,8469 ----
              writeln(elsif);
              writeln(static, chartyp, tab1, 'Rmode[] = "r+";');
              writeln(endif);
!             writeln(define, 'Reset(f, n, l) (f).init = ',
!                 '(f).init ? !fseek((f).fp, 0L, 0) : ', (* LIB *)
!                 '(((f).fp = Fopen(n, l, Rmode)), 1), ',
                      '(f).eof = (f).out = 0, Get(f)');
!             writeln(define, 'Resetx(f, n, l) (f).init = ',
                  '(f).init ? (Finish(f)) : ',
!                 '(((f).fp = Fopen(n, l, Rmode)), 1), ',
                      '(f).eof = (f).out = 0, Getx(f)');
              usefopn := true
              end;
***************
*** 8376,8388 ****
              writeln(elsif);
              writeln(static, chartyp, tab1, 'Wmode[] = "w+";');
              writeln(endif);
!             writeln(define, 'Rewrite(f, n) (f).init = ',
!                 '(f).init ? rewind((f).fp) : ',    (* LIB *)
!                 '(((f).fp = Fopen(n, Wmode)), 1), ',
                      '(f).out = (f).eof = 1');
!             writeln(define, 'Rewritex(f, n) (f).init = ',
                  '(f).init ? (Finish(f)) : ',
!                 '(((f).fp = Fopen(n, Wmode)), 1), ',
                      '(f).out = (f).eof = (f).eoln = 1');
              usefopn := true
              end;
--- 8474,8486 ----
              writeln(elsif);
              writeln(static, chartyp, tab1, 'Wmode[] = "w+";');
              writeln(endif);
!             writeln(define, 'Rewrite(f, n, l) (f).init = ',
!                 '(f).init ? !fseek((f).fp, 0L, 0) : ', (* LIB *)
!                 '(((f).fp = Fopen(n, l, Wmode)), 1), ',
                      '(f).out = (f).eof = 1');
!             writeln(define, 'Rewritex(f, n, l) (f).init = ',
                  '(f).init ? (Finish(f)) : ',
!                 '(((f).fp = Fopen(n, l, Wmode)), 1), ',
                      '(f).out = (f).eof = (f).eoln = 1');
              usefopn := true
              end;
***************
*** 8389,8395 ****
          if usefopn then
              begin
              writeln('FILE    *Fopen();');
!             writeln(define, 'MAXFILENAME 256')
              end;
          if usecase or usejmps then
              begin
--- 8487,8495 ----
          if usefopn then
              begin
              writeln('FILE    *Fopen();');
!             writeln(ifndef, maxfilename);
!             writeln(define, maxfilename, ' ', (maxtoknlen+1):1);
!             writeln(endif)
              end;
          if usecase or usejmps then
              begin
***************
*** 8443,8449 ****
              write(' (');
              printid(defnams[dboolean]^.lid);
              writeln(')1');
!             writeln(xtern, chartyp, tab1, '*Bools[];')
              end;
          capital(defnams[dinteger]);
          if use(dinteger) then
--- 8543,8549 ----
              write(' (');
              printid(defnams[dboolean]^.lid);
              writeln(')1');
!             writeln(chartyp, tab1, '*Bools[];')
              end;
          capital(defnams[dinteger]);
          if use(dinteger) then
***************
*** 8519,8527 ****
              writeln(setptyp, tab1, 'Insmem(), Mksubr();');
              writeln(setptyp, tab1, 'Currset(), Inter();');
              writeln(static, setptyp, tab1, 'Tmpset;');
!             writeln(xtern, setptyp, tab1, 'Conset[];');
              writeln(voidtyp, tab1, 'Setncpy();')
              end;
          writeln(xtern, chartyp, ' *strncpy();');    (* LIB *)
          if use(dargc) or use(dargv) then
              begin
--- 8619,8640 ----
              writeln(setptyp, tab1, 'Insmem(), Mksubr();');
              writeln(setptyp, tab1, 'Currset(), Inter();');
              writeln(static, setptyp, tab1, 'Tmpset;');
!             writeln(setptyp, tab1, 'Conset[];');
              writeln(voidtyp, tab1, 'Setncpy();')
              end;
+         if align then                    (* CPU *)
+             begin
+             writeln(ifndef, 'SETALIGN');
+             writeln(define, 'SETALIGN(x) Alignset(x)');
+             writeln('struct Set { ', wordtype, tab1, 'S[',
+                     maxsetrange:1, '+1]; } *Alignset();');
+             writeln(endif);
+             writeln(ifndef, 'STRALIGN');
+             writeln(define, 'STRALIGN(x) Alignstr(x)');
+             writeln('struct String { char    A[',
+                     maxtoknlen:1, '+1]; } *Alignstr();');
+             writeln(endif)
+             end;
          writeln(xtern, chartyp, ' *strncpy();');    (* LIB *)
          if use(dargc) or use(dargv) then
              begin
***************
*** 8577,8589 ****
--- 8690,8711 ----
                  writeln('main()');
                  writeln('{')
                   end;
+             if use(dinput) then
+                 begin
+                 writeln(ifdef, 'STDINIT');
+                 writeln(tab1, voidcast, '(Getx(input));');
+                 writeln(endif)
+                 end;
              increment;
              elabel(tp);
              estmt(tp^.tsubstmt);
              indent;
              writeln('exit(0);');
+             indent;
+             writeln('/', '* NOTREACHED *', '/');
              decrement;
              writeln('}');
+             edconst(tp^.tsubconst);
              writeln('/', '*');
              writeln('**    End of program code');
              writeln('*', '/')
***************
*** 8716,8725 ****
      conflag := false;
      setused := false;
      dropset := false;
!     doarrow := 0;
      eprogram(top);
      if usebool then
!         writeln(chartyp, tab1, '*Bools[] = { "false", "true" };');
      if usescan then
          begin
          writeln;
--- 8838,8848 ----
      conflag := false;
      setused := false;
      dropset := false;
!     doarrow := false;
!     donearr := false;
      eprogram(top);
      if usebool then
!         writeln(static, chartyp, tab1, '*Bools[] = { "false", "true" };');
      if usescan then
          begin
          writeln;
***************
*** 8749,8770 ****
          begin
          writeln;
          writeln(static, 'FILE *');
!         writeln('Fopen(n, m)');
          writeln(chartyp, tab1, '*n, *m;');
          writeln('{');
          writeln(tab1, 'FILE', tab2, '*f;');
          writeln(tab1, registr, chartyp, tab1, '*s;');
          writeln(tab1, static, chartyp, tab1, 'ch = ',
                          quote, 'A', quote, ';');
!         writeln(tab1, static, chartyp, tab1, 'tmp[MAXFILENAME];');
!         writeln(tab1, xtern , inttyp, tab1, 'unlink();'); (* OS *)
          writeln;
          writeln(tab1, 'if (n == NULL)');
          writeln(tab2, 'sprintf(tmp, ', tmpfilename, 'ch++);');
          writeln(tab1, 'else {');
          writeln(tab2, 'strncpy(tmp, n, sizeof(tmp));');
          writeln(tab2, 'for (s = &tmp[sizeof(tmp)-1]; *s == ',
!             spchr, ' || *s == ', nulchr, '; )');
          writeln(tab3, '*s-- = ', nulchr, ';');
          writeln(tab2, 'if (tmp[sizeof(tmp)-1]) {');
          writeln(tab3, voidcast, 'fprintf(stderr, "Too long filename ',
--- 8872,8897 ----
          begin
          writeln;
          writeln(static, 'FILE *');
!         writeln('Fopen(n, l, m)');
          writeln(chartyp, tab1, '*n, *m;');
+         writeln(inttyp, tab1, 'l;');
          writeln('{');
          writeln(tab1, 'FILE', tab2, '*f;');
          writeln(tab1, registr, chartyp, tab1, '*s;');
          writeln(tab1, static, chartyp, tab1, 'ch = ',
                          quote, 'A', quote, ';');
!         writeln(tab1, static, chartyp, tab1, 'tmp[', maxfilename, '];');
!         writeln(tab1, xtern , inttyp, tab1, 'unlink(),'); (* OS *)
!         writeln(tab3, 'strlen();'); (* OS *)
          writeln;
          writeln(tab1, 'if (n == NULL)');
          writeln(tab2, 'sprintf(tmp, ', tmpfilename, 'ch++);');
          writeln(tab1, 'else {');
+         writeln(tab2, 'if (l < 0)');
+         writeln(tab3, 'l = strlen(n);');
          writeln(tab2, 'strncpy(tmp, n, sizeof(tmp));');
          writeln(tab2, 'for (s = &tmp[sizeof(tmp)-1]; *s == ',
!             spchr, ' || *s == ', nulchr, ' || s - tmp > l; )');
          writeln(tab3, '*s-- = ', nulchr, ';');
          writeln(tab2, 'if (tmp[sizeof(tmp)-1]) {');
          writeln(tab3, voidcast, 'fprintf(stderr, "Too long filename ',
***************
*** 8782,8788 ****
          writeln(tab2, 'unlink(tmp);');    (* OS *)
          writeln(tab1, 'return (f);');
          writeln('}');
-         writeln(xtern, inttyp, tab1, 'rewind();')
          end;
      if setcnt > 0 then
          econset(setlst, setcnt);
--- 8909,8914 ----
***************
*** 9098,9106 ****
          writeln(tab2, '*S1++ = 0;');
          writeln('}')
          end;
!     if usecase then
          begin
          writeln;
          writeln(static, voidtyp);
          writeln('Caseerror(n)');
          writeln(tab1, inttyp, tab1, 'n;');
--- 9224,9263 ----
          writeln(tab2, '*S1++ = 0;');
          writeln('}')
          end;
!     if usesal then
          begin
          writeln;
+         writeln(static, 'struct Set *');
+         writeln('Alignset(Sp)');
+         writeln(tab1, registr, wordtype, tab1, '*Sp;');
+         writeln('{');
+         writeln(tab1, static, 'struct Set', tab1, 'tmp;');
+         writeln(tab1, registr, wordtype, tab1, '*tp = tmp.S;');
+         writeln(tab1, registr, inttyp, tab2, 'i = *Sp;');
+         writeln;
+         writeln(tab1, 'while (i-- >= 0)');
+         writeln(tab2, '*tp++ = *Sp++;');
+         writeln(tab1, 'return (&tmp);');
+         writeln('}')
+         end;
+     if usealig then
+         begin
+         writeln;
+         writeln(static, 'struct String *');
+         writeln('Alignstr(Cp)');
+         writeln(tab1, registr, chartyp, tab1, '*Cp;');
+         writeln('{');
+         writeln(tab1, static, 'struct String', tab1, 'tmp;');
+         writeln(tab1, registr, chartyp, tab1, '*sp = tmp.A;');
+         writeln;
+         writeln(tab1, 'while (*sp++ = *Cp++)');
+         writeln(tab2, ';');
+         writeln(tab1, 'return (&tmp);');
+         writeln('}')
+         end;
+     if usecase or usejmps then
+         begin
+         writeln;
          writeln(static, voidtyp);
          writeln('Caseerror(n)');
          writeln(tab1, inttyp, tab1, 'n;');
***************
*** 9108,9113 ****
--- 9265,9271 ----
          writeln(tab1, voidcast,
              'fprintf(stderr, "Missing case limb: line %d\n", n);');
          writeln(tab1, 'exit(1);');
+         writeln(tab1, '/', '* NOTREACHED *', '/');
          writeln('}')
          end;
      if usemax then
***************
*** 9153,9158 ****
--- 9311,9318 ----
      t    : pretyps;
      d    : predefs;

+     hx    : packed array [ 1 .. 16 ] of char;
+
      (*    Define names in ctable.                    *)
      procedure defname(cn : cnames; str : keyword);

***************
*** 9328,9339 ****
  begin    (* initialize *)
      lineno := 1;
      colno := 0;

      initstrstore;

      setlst := nil;
      setcnt := 0;
!     hexdig := '0123456789ABCDEF';

      symtab := nil;
      statlvl := 0;
--- 9488,9501 ----
  begin    (* initialize *)
      lineno := 1;
      colno := 0;
+     pushed := false;

      initstrstore;

      setlst := nil;
      setcnt := 0;
!     hx := '0123456789ABCDEF';
!     unpack(hx, hexdig, 0);

      symtab := nil;
      statlvl := 0;
***************
*** 9366,9371 ****
--- 9528,9535 ----

      usecomp := false;
      usemax    := false;
+     usealig    := false;
+     usesal    := false;

      for s := 0 to hashmax do
          idtab[s] := nil;
***************
*** 9541,9546 ****
--- 9705,9713 ----
      defname(cungetc,    'ungetc    ');    (* LIB *)
      defname(cunion,        'union     ');
      defname(cunlink,    'unlink    ');    (* OS *)
+     defname(cfseek,        'fseek     ');    (* LIB *)
+     defname(cgetchar,    'getchar   ');    (* LIB *)
+     defname(cputchar,    'putchar   ');    (* LIB *)
      defname(cunsigned,    'unsigned  ');
      defname(cwrite,        'write     ');    (* OS *)

***************
*** 9613,9619 ****
             describing type, fill in constant identifying type *)
          case t of
            tboolean:
!             typnods[t] := deftab[dboolean]; (* scalar type *)
            tchar:
              typnods[t] := deftab[dchar]^.tbind;
            tinteger:
--- 9780,9786 ----
             describing type, fill in constant identifying type *)
          case t of
            tboolean:
!             typnods[t] := deftab[dboolean]^.tbind;
            tchar:
              typnods[t] := deftab[dchar]^.tbind;
            tinteger: