*** 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:
