*** ptc.p	Tue Mar 27 16:24:55 1990
--- /tmp/ptc.p.orig	Wed Mar 28 00:57:48 1990
***************
*** 43,47 ****
  (**	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.	  **)
--- 43,47 ----
  (**	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.	  **)
***************
*** 50,60 ****
  (***************************************************************************)
  
! program	ptc(input, output, erroutput);
  
  label	9999;				(* end of program		*)
  
! const	version		= '@(#)ptc.p	2.6  Date 87/09/12';
! 	rcsid		= '$Id: ptc.p,v 1.17 90/03/27 16:24:55 tml Exp $';
! 	rcsrevision	= '$Revision: 1.17 $';
  
  	keytablen	= 38;		(* nr of keywords		*)
--- 50,58 ----
  (***************************************************************************)
  
! program	ptc(input, output);
  
  label	9999;				(* end of program		*)
  
! const	version		= '@(#)ptc.p	1.5  Date 87/05/01';
  
  	keytablen	= 38;		(* nr of keywords		*)
***************
*** 66,73 ****
  	(* a Pascal set is implemented as an array of "wordtype" where	*)
  	(* each element contains bits numbered from 0 to "setbits"	*)
! 	wordtype	= 'unsigned int';	(* CPU *)
! 	setbits		= 31;			(* CPU *)
  
! 	maxsetrange	= 32;			(* nr of words in a set	*)
  	scalbase	= 0;	(* ordinal value of first scalar member	*)
  
--- 64,76 ----
  	(* a Pascal set is implemented as an array of "wordtype" where	*)
  	(* each element contains bits numbered from 0 to "setbits"	*)
! 	wordtype	= 'unsigned short';	(* CPU *)
! 	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	*)
  
***************
*** 80,85 ****
  	(* in an array 0 .. maxblkcnt of ^ array 0 .. maxstrblk of char	*)
  	maxstrblk	= 1023;
! 	maxblkcnt	= 1023;
! 	maxstrstor	= 1048575; (* maxstrstor should be ==
  					(maxblkcnt+1) * (maxstrblk+1) - 1 *)
  
--- 83,88 ----
  	(* in an array 0 .. maxblkcnt of ^ array 0 .. maxstrblk of char	*)
  	maxstrblk	= 1023;
! 	maxblkcnt	= 63;
! 	maxstrstor	= 65535; (* maxstrstor should be ==
  					(maxblkcnt+1) * (maxstrblk+1) - 1 *)
  
***************
*** 88,92 ****
  				   and should be <= 256, see hashtokn()	*)
  
! 	hashmax		= 512;	(* size of hashtable - 1		*)
  
  	null		= 0;	(* "impossible" character value, CHAR;
--- 91,95 ----
  				   and should be <= 256, see hashtokn()	*)
  
! 	hashmax		= 64;	(* size of hashtable - 1		*)
  
  	null		= 0;	(* "impossible" character value, CHAR;
***************
*** 97,106 ****
  
  	minchar		= null;
! 	maxchar		= 255;	(* greatest possible character, CHAR; limits
  				   the number of elements in type "char" *)
  
  	(* some frequently used characters *)
  	space		= ' ';
- 	tab		= '	';
  	tab1		= '	';
  	tab2		= '		';
--- 100,113 ----
  
  	minchar		= null;
! 	maxchar		= 127;	(* greatest possible character, CHAR; limits
  				   the number of elements in type "char" *)
  
+ 	(* tmpfilename is used in the generated code to obtain names of
+ 	   temporary files for reset/rewrite, the last character is supplied
+ 	   by the reset/rewrite routine *)
+ 	tmpfilename	= '"/tmp/ptc%d%c", getpid(), '; (* OS *)
+ 
  	(* some frequently used characters *)
  	space		= ' ';
  	tab1		= '	';
  	tab2		= '		';
***************
*** 122,125 ****
--- 129,133 ----
  	tabwidth	= 8;		(* width of a tab-stop. OS	*)
  
+ 	echo		= false; 	(* echo input as read		*)
  	diffcomm	= false; 	(* comment delimiters different	*)
  	lazyfor		= false; 	(* compile for-stmts a la C	*)
***************
*** 127,131 ****
  
  	inttyp		= 'int';	(* for predefined functions	*)
! 	chartyp		= 'unsigned char';
  	setwtyp		= 'setword';
  	setptyp		= 'setptr';
--- 135,139 ----
  
  	inttyp		= 'int';	(* for predefined functions	*)
! 	chartyp		= 'char';
  	setwtyp		= 'setword';
  	setptyp		= 'setptr';
***************
*** 134,138 ****
  	dblcast		= '(double)';	(* for predefined functions	*)
  
! 	realtyp		= floattyp;	(* user real-vars and functions	*)
  
  	voidtyp		= 'void';	(* for procedures 		*)
--- 142,146 ----
  	dblcast		= '(double)';	(* for predefined functions	*)
  
! 	realtyp		= doubletyp;	(* user real-vars and functions	*)
  
  	voidtyp		= 'void';	(* for procedures 		*)
***************
*** 139,144 ****
  	voidcast	= '(void)';
  
- 	align		= true;		(* align literal params		*)
- 
  	intlen		= 10;		(* length of written integer	*)
  	fixlen		= 20;		(* length of written real	*)
--- 147,150 ----
***************
*** 151,159 ****
  	(* string-table "strstor" is implemented as an array that is grown
  	   dynamically by adding blocks when needed *)
! 	strbidx	= integer; (* 0 .. maxstrblk+1; *)
! 		(* integer because many varibles of this type in fact get
! 		  the value maxstrblk+1.  Argh, Pascal subranges are
! 		  stupid. *) 
! 	strblk	= array [ 0 .. maxstrblk ] of char;
  	strptr	= ^ strblk;
  	strbcnt	= 0 .. maxblkcnt;
--- 157,162 ----
  	(* string-table "strstor" is implemented as an array that is grown
  	   dynamically by adding blocks when needed *)
! 	strbidx	= 0 .. maxstrblk;
! 	strblk	= array [ strbidx ] of char;
  	strptr	= ^ strblk;
  	strbcnt	= 0 .. maxblkcnt;
***************
*** 169,173 ****
  	idnode	= record
  			inext	: idptr;	(* chain of idnode's	*)
! 			inref	: integer;	(* # of refs to this id	*)
  			ihash	: hashtyp;	(* its hash value	*)
  			istr	: strindx;	(* index to "strstor"	*)
--- 172,176 ----
  	idnode	= record
  			inext	: idptr;	(* chain of idnode's	*)
! 			inref	: 0 .. 127;	(* # of refs to this id	*)
  			ihash	: hashtyp;	(* its hash value	*)
  			istr	: strindx;	(* index to "strstor"	*)
***************
*** 187,204 ****
  		dboolean,	dchar,		dchr,		dclose,
  		dcos,		ddispose,	deof,		deoln,
- 		derroutput,
  		dexit,		dexp,		dfalse,		dflush,
  		dget,		dhalt,		dinput,		dinteger,
! 		dln,		dmaxint,	         	dnew,
  		dodd,		dord,		doutput,	dpage,
! 		dpack,		dpred,		dput,		dprompt,
! 								dread,
  		dreadln,	dreal,		dreset,		drewrite,
! 		dround,		dseek,
! 				dsin,		dsqr,		dsqrt,
! 		dsucc,		dtell,
! 				dtext,		dtrue,		dtrunc,
  		dtan,		dwrite,		dwriteln,	dunpack,
! 		dzfp,		dztring
  	);
  
--- 190,203 ----
  		dboolean,	dchar,		dchr,		dclose,
  		dcos,		ddispose,	deof,		deoln,
  		dexit,		dexp,		dfalse,		dflush,
  		dget,		dhalt,		dinput,		dinteger,
! 		dln,		dmaxint,	dmessage,	dnew,
  		dodd,		dord,		doutput,	dpage,
! 		dpack,		dpred,		dput,		dread,
  		dreadln,	dreal,		dreset,		drewrite,
! 		dround,		dsin,		dsqr,		dsqrt,
! 		dsucc,		dtext,		dtrue,		dtrunc,
  		dtan,		dwrite,		dwriteln,	dunpack,
! 		dzinit,		dztring
  	);
  
***************
*** 241,261 ****
  		  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;
  
--- 240,243 ----
***************
*** 630,636 ****
  		  numinus:		(* -			*)
  		    (
- 			tisassigndest:	(* used to prevent lazy i/o when
- 					   assigning to file buffer variable *)
- 				boolean;
  			texps:		(* operand expression	*)
  				treeptr
--- 612,615 ----
***************
*** 670,674 ****
  		cstruct,	cstatic,	cswitch,	ctypedef,
  		cundef,		cungetc,	cunion,		cunlink,
- 		cfseek,		cgetchar,	cputchar,
  		cunsigned,	cwrite
  	);
--- 649,652 ----
***************
*** 684,688 ****
  		etree,		etag,		euprconf,	easgnconf,
  		ecmpconf,	econfconf,	evrntfile,	evarfile,
! 		emanymachs,	ebadmach,	eprconf
  	);
  
--- 662,666 ----
  		etree,		etag,		euprconf,	easgnconf,
  		ecmpconf,	econfconf,	evrntfile,	evarfile,
! 		emanymachs,	ebadmach
  	);
  
***************
*** 706,711 ****
  	usescpy,
  	usecomp,		(* source program uses string-compare	*)
! 	usealig,		(* source program uses aligned params	*)
! 	usesal : boolean;
  
  	top	: treeptr;	(* top of parsetree, result from parse	*)
--- 684,692 ----
  	usescpy,
  	usecomp,		(* source program uses string-compare	*)
! 	usefopn,		(* source program uses reset/rewrite	*)
! 	usescan,
! 	usegetl,
! 	usenilp,		(* source program uses nil-pointer 	*)
! 	usebool	: boolean;	(* source program writes boolean-values	*)
  
  	top	: treeptr;	(* top of parsetree, result from parse	*)
***************
*** 758,770 ****
  	varno	: integer;		(* counter for unique id's	*)
  
! 	pushchr	: char;			(* pushback for lexical scanner	*)
! 	pushed	: boolean;
  
! 	hexdig	: array [ 0 .. 15 ] of char;
! { IF-PASCAL
! 	erroutput : text;
! END-IF-PASCAL }
! 
! (*	Prtmsg produces an error message.                           	*)
  procedure prtmsg(m : errors);
  
--- 739,746 ----
  	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);
  
***************
*** 780,844 ****
  	case m of
  	  ebadsymbol:
! 		writeln(erroutput, user, 'Unexpected symbol');
  	  ebadchar:
! 		writeln(erroutput, user, 'Bad character');
  	  elongstring:
! 		writeln(erroutput, restr, 'Too long string');
  	  ebadstring:
! 		writeln(erroutput, user, 'Newline in string or character');
  	  eeofstr:
! 		writeln(erroutput, user, 'End of file in string or character');
  	  eeofcmnt:
! 		writeln(erroutput, user, 'End of file in comment');
  	  elongtokn:
! 		writeln(erroutput, restr, 'Too long identfier');
  	  emanytokn:
! 		writeln(erroutput, restr, 'Too many strings, identifiers or real numbers');
  	  enotdeclid:
! 		writeln(erroutput, user, 'Identifier not declared');
  	  emultdeclid:
! 		writeln(erroutput, user, 'Identifier declared twice');
  	  enotdecllab:
! 		writeln(erroutput, user, 'Label not declared');
  	  emultdecllab:
! 		writeln(erroutput, user, 'Label declared twice');
  	  emuldeflab:
! 		writeln(erroutput, user, 'Label defined twice');
  	  evarpar:
! 		writeln(erroutput, user, 'Actual parameter not a variable');
  	  enulchr:
! 		writeln(erroutput, restr, 'Cannot handle nul-character in strings');
  	  enew:
! 		writeln(erroutput, restr, 'New returned a nil-pointer');
  	  eoverflow:
! 		writeln(erroutput, restr, 'Token buffer overflowed');
  	  esetbase:
! 		writeln(erroutput, restr, 'Cannot handle sets with base >> 0');
  	  esetsize:
! 		writeln(erroutput, restr, 'Cannot handle sets with very large range');
  	  etree:
! 		writeln(erroutput, inter, 'Bad tree structure');
  	  etag:
! 		writeln(erroutput, inter, 'Cannot find tag');
  	  evrntfile:
! 		writeln(erroutput, restr, 'Cannot initialize files in record variants');
  	  evarfile:
! 		writeln(erroutput, restr, 'Cannot handle files in structured variables');
  	  euprconf:
! 		writeln(erroutput, inter, 'No upper bound on conformant arrays');
  	  easgnconf:
! 		writeln(erroutput, inter, 'Cannot assign conformant arrays');
  	  ecmpconf:
! 		writeln(erroutput, inter, 'Cannot compare conformant arrays');
  	  econfconf:
! 		writeln(erroutput, restr, 'Cannot handle nested conformat arrays');
  	  erange:
! 		writeln(erroutput, inter, 'Cannot find C-type for integer-subrange');
  	  emanymachs:
! 		writeln(erroutput, restr, 'Too many machine integer types');
  	  ebadmach:
! 		writeln(erroutput, inter, 'Bad name for machine integer type');
! 	  eprconf:
! 		writeln(erroutput, inter, 'Cannot write conformant arrays');
  	end;(* case *)
  	if lastline <> 0 then
--- 756,818 ----
  	case m of
  	  ebadsymbol:
! 		message(user, 'Unexpected symbol');
  	  ebadchar:
! 		message(user, 'Bad character');
  	  elongstring:
! 		message(restr, 'Too long string');
  	  ebadstring:
! 		message(user, 'Newline in string or character');
  	  eeofstr:
! 		message(user, 'End of file in string or character');
  	  eeofcmnt:
! 		message(user, 'End of file in comment');
  	  elongtokn:
! 		message(restr, 'Too long identfier');
  	  emanytokn:
! 		message(restr, 'Too many strings, identifiers or real numbers');
  	  enotdeclid:
! 		message(user, 'Identifier not declared');
  	  emultdeclid:
! 		message(user, 'Identifier declared twice');
  	  enotdecllab:
! 		message(user, 'Label not declared');
  	  emultdecllab:
! 		message(user, 'Label declared twice');
  	  emuldeflab:
! 		message(user, 'Label defined twice');
  	  evarpar:
! 		message(user, 'Actual parameter not a variable');
  	  enulchr:
! 		message(restr, 'Cannot handle nul-character in strings');
  	  enew:
! 		message(restr, 'New returned a nil-pointer');
  	  eoverflow:
! 		message(restr, 'Token buffer overflowed');
  	  esetbase:
! 		message(restr, 'Cannot handle sets with base >> 0');
  	  esetsize:
! 		message(restr, 'Cannot handle sets with very large range');
  	  etree:
! 		message(inter, 'Bad tree structure');
  	  etag:
! 		message(inter, 'Cannot find tag');
  	  evrntfile:
! 		message(restr, 'Cannot initialize files in record variants');
  	  evarfile:
! 		message(restr, 'Cannot handle files in structured variables');
  	  euprconf:
! 		message(inter, 'No upper bound on conformant arrays');
  	  easgnconf:
! 		message(inter, 'Cannot assign conformant arrays');
  	  ecmpconf:
! 		message(inter, 'Cannot compare conformant arrays');
  	  econfconf:
! 		message(restr, 'Cannot handle nested conformat arrays');
  	  erange:
! 		message(inter, 'Cannot find C-type for integer-subrange');
  	  emanymachs:
! 		message(restr, 'Too many machine integer types');
  	  ebadmach:
! 		message(inter, 'Bad name for machine integer type');
  	end;(* case *)
  	if lastline <> 0 then
***************
*** 846,850 ****
  		(* error detected during parsing,
  		    report line/column and print the offending symbol *)
! 		writeln(erroutput, 'Line ', lastline:1, ', col ', lastcol:1, ':');
  		if m in [enulchr, ebadchar, ebadstring, ebadsymbol,
  			emuldeflab, emultdecllab, enotdecllab, emultdeclid,
--- 820,824 ----
  		(* error detected during parsing,
  		    report line/column and print the offending symbol *)
! 		message('Line ', lastline:1, ', col ', lastcol:1, ':');
  		if m in [enulchr, ebadchar, ebadstring, ebadsymbol,
  			emuldeflab, emultdecllab, enotdecllab, emultdeclid,
***************
*** 857,861 ****
  				i := i + 1
  			    end;
! 			writeln(erroutput, 'Current symbol: ', xtok:i-1)
  		    end
  	    end
--- 831,841 ----
  				i := i + 1
  			    end;
! 			while i < xtoklen do
! 			    begin
! 				xtok[i] := ' ';
! 				i := i + 1
! 			    end;
! 			xtok[xtoklen] := ' ';
! 			message('Current symbol: ', xtok)
  		    end
  	    end
***************
*** 1240,1249 ****
  
  	begin
! 		if pushed then
! 		    begin
! 			c := pushchr;
! 			pushed := false
! 		    end
! 		else if eof then
  			c := chr(null)
  		else begin
--- 1220,1224 ----
  
  	begin
! 		if eof then
  			c := chr(null)
  		else begin
***************
*** 1255,1261 ****
  			    end;
  			read(c);
! 			if c = tab then
! 				colno := (((colno - 1) div tabwidth) + 1) *
! 						tabwidth
  		     end;
  		if lastchr > 0 then
--- 1230,1240 ----
  			    end;
  			read(c);
! 			if echo then
! 				if colno = 0 then
! 					writeln
! 				else
! 					write(c);
! 			if c = tab1 then
! 				colno := ((colno div tabwidth) + 1) * tabwidth
  		     end;
  		if lastchr > 0 then
***************
*** 1271,1277 ****
  
  	begin
! 		if pushed then
! 			peekchar := pushchr
! 		else if eof then
  			peekchar := chr(null)
  		else
--- 1250,1254 ----
  
  	begin
! 		if eof then
  			peekchar := chr(null)
  		else
***************
*** 1287,1291 ****
  		ready	: boolean;
  
! 		wl	: 0..maxtoknlen;
  		wb	: toknbuf;
  
--- 1264,1268 ----
  		ready	: boolean;
  
! 		wl	: toknidx;
  		wb	: toknbuf;
  
***************
*** 1403,1407 ****
  				c := space
  			    end
! 		until	(c <> space) and (c <> tab);
  
  		(* save characters from this token and save line- and column-
--- 1380,1384 ----
  				c := space
  			    end
! 		until	(c <> space) and (c <> tab1);
  
  		(* save characters from this token and save line- and column-
***************
*** 1482,1494 ****
  				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
--- 1459,1465 ----
  				st := sinteger;
  				vint := n;
  				if realok then
  				    begin
+ 					(* accept real numbers *)
  					if peekchar = '.' then
  					    begin
***************
*** 1609,1613 ****
  			    begin
  				(* assume the symbol is a literal string *)
! 				wl := 1;
  				ready := false;
  				repeat
--- 1580,1584 ----
  			    begin
  				(* assume the symbol is a literal string *)
! 				wl := 0;
  				ready := false;
  				repeat
***************
*** 1632,1636 ****
  					if not ready then
  					    begin
! 						wb[wl] := c;
  						if wl >= maxtoknlen then
  						    begin
--- 1603,1607 ----
  					if not ready then
  					    begin
! 						wl := wl + 1;
  						if wl >= maxtoknlen then
  						    begin
***************
*** 1639,1646 ****
  							error(elongstring)
  						    end;
! 						wl := wl + 1;
  					    end
  				until	ready;
! 				if wl = 2 then
  				    begin
  					(* only 1 character => not a string *)
--- 1610,1617 ----
  							error(elongstring)
  						    end;
! 						wb[wl] := c
  					    end
  				until	ready;
! 				if wl = 1 then
  				    begin
  					(* only 1 character => not a string *)
***************
*** 1650,1653 ****
--- 1621,1630 ----
  				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;
***************
*** 2603,2608 ****
  			tq	: treeptr;
  			din,
! 			dut,
! 			der: idptr;
  
  		begin
--- 2580,2584 ----
  			tq	: treeptr;
  			din,
! 			dut	: idptr;
  
  		begin
***************
*** 2610,2626 ****
  			din := deftab[dinput]^.tidl^.tsym^.lid;
  			dut := deftab[doutput]^.tidl^.tsym^.lid;
! 			der := deftab[derroutput]^.tidl^.tsym^.lid;
! 			while (currsym.vid = din) or (currsym.vid = dut)
! 			or (currsym.vid = der) do
  			    begin
! 				(* ignore input/output/erroutput as parameters
! 				   so that they will be bound to stdin/stdout/
! 				   stderr unless declared as variables *)
  				if currsym.vid = din then
  					defnams[dinput]^.lused := true
- 				else if currsym.vid = dut then
- 					defnams[doutput]^.lused := true
  				else
! 					defnams[derroutput]^.lused := true;
  				nextsymbol([scomma, srpar]);
  				if currsym.st = srpar then
--- 2586,2598 ----
  			din := deftab[dinput]^.tidl^.tsym^.lid;
  			dut := deftab[doutput]^.tidl^.tsym^.lid;
! 			while (currsym.vid = din) or (currsym.vid = dut) do
  			    begin
! 				(* ignore input/output as parameters so that
! 				   they will be bound to stdin/stdout unless
! 				   declared as variables *)
  				if currsym.vid = din then
  					defnams[dinput]^.lused := true
  				else
! 					defnams[doutput]^.lused := true;
  				nextsymbol([scomma, srpar]);
  				if currsym.st = srpar then
***************
*** 2639,2644 ****
  				else if currsym.vid = dut then
  					defnams[doutput]^.lused := true
- 				else if currsym.vid = der then
- 					defnams[derroutput]^.lused := true
  				else begin
  					tq^.tnext := newid(currsym.vid);
--- 2611,2614 ----
***************
*** 2677,2681 ****
  		pbody(tp);
  		checksymbol([sdot]);
- 		nextsymbol([seof]);
  		tp^.tscope := currscope;
  		leavescope;
--- 2647,2650 ----
***************
*** 2695,2701 ****
  		tp^.tsubpar := nil;
  		pbody(tp);
! 		checksymbol([ssemic, seof]);
! 		if currsym.st = ssemic then
! 			nextsymbol([seof]);
  		tp^.tscope := currscope;
  		leavescope;
--- 2664,2668 ----
  		tp^.tsubpar := nil;
  		pbody(tp);
! 		checksymbol([ssemic]);
  		tp^.tscope := currscope;
  		leavescope;
***************
*** 2834,2838 ****
  			dp := currscope
  		    end;
! 		nextsymbol([sid, scase, cs]);
  		tq := nil;
  		while currsym.st = sid do
--- 2801,2805 ----
  			dp := currscope
  		    end;
! 		nextsymbol([sid, scase] + [cs]);
  		tq := nil;
  		while currsym.st = sid do
***************
*** 2855,2859 ****
  			enterscope(dp);
  			if currsym.st = ssemic then
! 				nextsymbol([sid, scase, cs])
  		    end;
  		if currsym.st = scase then
--- 2822,2826 ----
  			enterscope(dp);
  			if currsym.st = ssemic then
! 				nextsymbol([sid, scase] + [cs])
  		    end;
  		if currsym.st = scase then
***************
*** 2887,2891 ****
  				repeat
  					nextsymbol([sid, sinteger, schar, splus,
! 							 sminus, cs]);
  					if currsym.st = cs then
  						goto 999;
--- 2854,2858 ----
  				repeat
  					nextsymbol([sid, sinteger, schar, splus,
! 							 sminus] + [cs]);
  					if currsym.st = cs then
  						goto 999;
***************
*** 3392,3406 ****
  	end;
  
- 	procedure flagassigndest(tp : treeptr);
- 
- 	begin
- 		if tp^.tt in [ nindex, nselect, nderef ] then
- 		    case tp^.tt of
- 		      nindex: flagassigndest(tp^.tvariable);
- 		      nselect: flagassigndest(tp^.trecord);
- 		      nderef: tp^.tisassigndest := true;
- 		    end
- 	end;
- 
  	(*	Parse an assignment or a procedure call.		*)
  	function psimple;
--- 3359,3362 ----
***************
*** 3414,3418 ****
  		    begin
  			tq := mknode(nassign);
- 			flagassigndest(tp);
  			tq^.tlhs := tp;
  			tq^.trhs := pexpr(nil);
--- 3370,3373 ----
***************
*** 3478,3482 ****
  			    begin
  				tp := mknode(nderef);
- 				tp^.tisassigndest := false;
  				tp^.texps := varptr
  			    end
--- 3433,3436 ----
***************
*** 3565,3569 ****
--- 3519,3526 ----
  			tp := mklit;
  		  snil:
+ 		    begin
+ 			usenilp := true;
  			tp := mknode(nnil);
+ 		    end;
  		  sid:
  		    begin
***************
*** 3695,3700 ****
  				tq := tq^.tnext
  			     end;
- 			tq^.tchocon := nil;
- 			tq^.tchostmt := nil;
  			tv := nil;
  			repeat
--- 3652,3655 ----
***************
*** 3726,3732 ****
  				    scase, swith, sbegin, sgoto,
  					selse, ssemic, send, suntil]);
! 			tp^.tcasother := pstmt;
! 			if currsym.st = ssemic then
! 			        nextsymbol([send])
  		    end
  		else begin
--- 3681,3685 ----
  				    scase, swith, sbegin, sgoto,
  					selse, ssemic, send, suntil]);
! 			tp^.tcasother := pstmt
  		    end
  		else begin
***************
*** 3894,3898 ****
  		top := pprogram
  	else
! 		top := pmodule
  end;	(* parse *)
  
--- 3847,3852 ----
  		top := pprogram
  	else
! 		top := pmodule;
! 	nextsymbol([seof]);
  end;	(* parse *)
  
***************
*** 4365,4370 ****
  						sp := ip^.tsym;
  						if sp^.lid^.inref > 1 then
  						    sp^.lid :=
! 							mkrename('M', sp^.lid);
  						ip := nil
  					    end
--- 4319,4328 ----
  						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
***************
*** 4663,4668 ****
  				(* 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 *)
--- 4621,4624 ----
***************
*** 4933,4937 ****
  				sp := tp^.tsubid^.tsym;
  				if sp^.lid^.inref > 1 then
! 					sp^.lid := mkrename('P', sp^.lid)
  			    end;
  			tp := tp^.tnext
--- 4889,4896 ----
  				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
***************
*** 5083,5087 ****
  					ty^.trecord := ti;
  					ty^.tfield :=
! 						oldid(defnams[dzfp]^.lid,
  								lforward);
  					tx := mknode(nassign);
--- 5042,5046 ----
  					ty^.trecord := ti;
  					ty^.tfield :=
! 						oldid(defnams[dzinit]^.lid,
  								lforward);
  					tx := mknode(nassign);
***************
*** 5175,5179 ****
  const	include	= '# include ';
  	define	= '# define ';
- 	undef	= '# undef ';
  	ifdef	= '# ifdef ';
  	ifndef	= '# ifndef ';
--- 5134,5137 ----
***************
*** 5185,5193 ****
  	registr	= 'register ';
  	usigned	= 'unsigned ';
! 	indstep	= 2;
  
  var	conflag,
  	setused,
! 	dropset	: boolean;
  	indnt	: integer;
  
--- 5143,5153 ----
  	registr	= 'register ';
  	usigned	= 'unsigned ';
! 	indstep	= 8;
  
  var	conflag,
  	setused,
! 	dropset,
! 	donearr	: boolean;
! 	doarrow,
  	indnt	: integer;
  
***************
*** 5240,5258 ****
  	end;
  
- 	(* Check if a type is represented in C as unsigned short or *)
- 	(* char, and thus should be cast to int in expressions to   *)
- 	(* preserve Pascal semantics				    *)
- 	function needsintcast(tp : treeptr) : boolean;
- 
- 	begin
- 		tp := typeof(tp);
- 		if tp^.tt <> nsubrange then
- 			needsintcast := false
- 		else if clower(tp) < 0 then
- 			needsintcast := false
- 		else
- 			needsintcast := cupper(tp) <= 65535;
- 	end;
- 
  	procedure eexpr(tp : treeptr);				forward;
  	procedure etypedef(tp : treeptr);			forward;
--- 5200,5203 ----
***************
*** 5262,5267 ****
  
  	begin
  		eexpr(tp);
! 		write('.');
  	end;
  
--- 5207,5217 ----
  
  	begin
+ 		doarrow := doarrow + 1;
  		eexpr(tp);
! 		doarrow := doarrow - 1;
! 		if donearr then
! 			donearr := false
! 		else
! 			write('.')
  	end;
  
***************
*** 5488,5495 ****
  							write('*.*');
  					write('s')
! 				     end;
! 			  'v':
! 				fatal(eprconf)
! 			end; (* case *)
  		end;	(* eformat *)
  
--- 5438,5443 ----
  							write('*.*');
  					write('s')
! 				     end
! 			end (* case *)
  		end;	(* eformat *)
  
***************
*** 5530,5533 ****
--- 5478,5482 ----
  					tx := tq^.texpl
  				    end;
+ 				usebool := true;
  				write('Bools[(int)(');
  				eexpr(tx);
***************
*** 5626,5632 ****
  					eexpr(tq)
  				    end
! 			    end;
! 			  'v':
! 				fatal(eprconf)
  			end (* case *)
  		end;	(* ewrite *)
--- 5575,5579 ----
  					eexpr(tq)
  				    end
! 			    end
  			end (* case *)
  		end;	(* ewrite *)
***************
*** 5786,5790 ****
  				eexpr(tp^.taparm)
  			else begin
! 				write('(unsigned char)(');
  				eexpr(tp^.taparm);
  				write(')')
--- 5733,5737 ----
  				eexpr(tp^.taparm)
  			else begin
! 				write('(char)(');
  				eexpr(tp^.taparm);
  				write(')')
***************
*** 5799,5820 ****
  		  deof:
  		    begin
! 			tq := tp^.taparm;
! 			if tq <> nil then
! 			    begin
! 				tv := typeof(tq);
! 				if tv = typnods[ttext] then
! 				    txtfile := true
! 				else if tv^.tt = nfileof then
! 				    txtfile := typeof(tv^.tof) =
! 						    typnods[tchar]
! 				else
! 				    txtfile := true
! 			    end
! 			else
! 			    txtfile := true;
! 			if txtfile then
! 			    write('Eofx(')
! 			else
! 			    write('Eof(');
  			if tp^.taparm = nil then
  			    begin
--- 5746,5750 ----
  		  deof:
  		    begin
! 			write('Eof(');
  			if tp^.taparm = nil then
  			    begin
***************
*** 5847,5854 ****
  			writeln(');');
  		    end;
! 		  dflush,
! 		  dprompt:
  		    begin
! 			write('Flush(');
  			if tp^.taparm = nil then
  			    begin
--- 5777,5783 ----
  			writeln(');');
  		    end;
! 		  dflush:
  		    begin
! 			write('fflush(');			(* LIB *)
  			if tp^.taparm = nil then
  			    begin
***************
*** 5858,5862 ****
  			else
  				eexpr(tp^.taparm);
! 			writeln(');')
  		    end;
  		  dpage:
--- 5787,5791 ----
  			else
  				eexpr(tp^.taparm);
! 			writeln('.fp);')
  		    end;
  		  dpage:
***************
*** 5876,5883 ****
  		  dget:
  		    begin
! 			tv := typeof(tp^.taparm);
! 			if (tv = typnods[ttext])
! 			or ((tv^.tt = nfileof)
! 			and (typeof(tv^.tof) = typnods[tchar])) then
  				if td = dget then
  					write('Getx')
--- 5805,5809 ----
  		  dget:
  		    begin
! 			if typeof(tp^.taparm) = typnods[ttext] then
  				if td = dget then
  					write('Getx')
***************
*** 5917,5921 ****
  			txtfile := false;
  			tq := tp^.taparm;
- 			write('{');
  			if tq <> nil then
  			    begin
--- 5843,5846 ----
***************
*** 5965,5971 ****
  					write(')');
  					if td = dreadln then
! 						write('; ');
  					goto 444
  				    end;
  				write('Fscan(');
  				if tv = nil then
--- 5890,5897 ----
  					write(')');
  					if td = dreadln then
! 						write(',');
  					goto 444
  				    end;
+ 				usescan := true;
  				write('Fscan(');
  				if tv = nil then
***************
*** 5973,5977 ****
  				else
  					eexpr(tv);
! 				write('); ');
  				(* first pass, emit format string *)
  				while tq <> nil do
--- 5899,5903 ----
  				else
  					eexpr(tv);
! 				write('), ');
  				(* first pass, emit format string *)
  				while tq <> nil do
***************
*** 6010,6014 ****
  					  'd':
  					    begin
! 						write('; ');
  						eexpr(tq);
  						write(' = Tmplng')
--- 5936,5940 ----
  					  'd':
  					    begin
! 						write(', ');
  						eexpr(tq);
  						write(' = Tmplng')
***************
*** 6016,6020 ****
  					  'g':
  					    begin
! 						write('; ');
  						eexpr(tq);
  						write(' = Tmpdbl')
--- 5942,5946 ----
  					  'g':
  					    begin
! 						write(', ');
  						eexpr(tq);
  						write(' = Tmpdbl')
***************
*** 6027,6031 ****
  					if tq <> nil then
  					    begin
! 						writeln(';');
  						indent;
  						write(tab1)
--- 5953,5957 ----
  					if tq <> nil then
  					    begin
! 						writeln(',');
  						indent;
  						write(tab1)
***************
*** 6032,6041 ****
  					    end
  				    end;
! 				write(';');
  				if td = dreadln then
! 					write('; ');
  			444:
  				if td = dreadln then
  				    begin
  					write('Getl(&');
  					if tv = nil then
--- 5958,5973 ----
  					    end
  				    end;
! 				write(', Getx(');
! 				if tv = nil then
! 					printid(defnams[dinput]^.lid)
! 				else
! 					eexpr(tv);
! 				write(')');
  				if td = dreadln then
! 					write(',');
  			444:
  				if td = dreadln then
  				    begin
+ 					usegetl := true;
  					write('Getl(&');
  					if tv = nil then
***************
*** 6050,6064 ****
  				while tq <> nil do
  				    begin
! 				        eexpr(tq);
! 					write(' = ');
! 					write('Buf(');
! 					eexpr(tv);
! 					write('), Get(');
  					eexpr(tv);
! 					write(')');
  					tq := tq^.tnext;
  					if tq <> nil then
  					    begin
! 						writeln('; ');
  						indent
  					    end
--- 5982,5994 ----
  				while tq <> nil do
  				    begin
! 					write(voidcast, 'Fread(');
! 					eexpr(tq);
! 					write(', ');
  					eexpr(tv);
! 					write('.fp)');
  					tq := tq^.tnext;
  					if tq <> nil then
  					    begin
! 						writeln(',');
  						indent
  					    end
***************
*** 6066,6073 ****
  				decrement
  			     end;
! 			writeln(';}')
  		    end;
  		  dwrite,
! 		  dwriteln:
  		    begin
  			txtfile := false;
--- 5996,6004 ----
  				decrement
  			     end;
! 			writeln(';')
  		    end;
  		  dwrite,
! 		  dwriteln,
! 		  dmessage:
  		    begin
  			txtfile := false;
***************
*** 6107,6111 ****
  				    begin
  					(* writeln whithout parameters *)
! 					if td = dwriteln then
  					    begin
  						write('Putchr(', nlchr, ', ');
--- 6038,6042 ----
  				    begin
  					(* writeln whithout parameters *)
! 					if td in [dwriteln, dmessage] then
  					    begin
  						write('Putchr(', nlchr, ', ');
***************
*** 6150,6154 ****
  				tx := nil;
  				write(voidcast, 'fprintf(');	(* LIB *)
! 				begin
  					if tv = nil then
  						printid(defnams[doutput]^.lid)
--- 6081,6087 ----
  				tx := nil;
  				write(voidcast, 'fprintf(');	(* LIB *)
! 				if td = dmessage then
! 					write('stderr, ')
! 				else begin
  					if tv = nil then
  						printid(defnams[doutput]^.lid)
***************
*** 6165,6169 ****
  					tq := tq^.tnext
  				    end;
! 				if (td = dwriteln) then
  					write('\n');
  				write(cite);
--- 6098,6102 ----
  					tq := tq^.tnext
  				    end;
! 				if (td = dmessage) or (td = dwriteln) then
  					write('\n');
  				write(cite);
***************
*** 6282,6286 ****
  			tq := tp^.taparm^.tnext;
  			if tq = nil then
! 				write('NULL, 0')
  			else begin
  				tq := typeof(tq);
--- 6215,6219 ----
  			tq := tp^.taparm^.tnext;
  			if tq = nil then
! 				write('NULL')
  			else begin
  				tq := typeof(tq);
***************
*** 6291,6307 ****
  					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
--- 6224,6235 ----
  					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
***************
*** 6310,6331 ****
  			writeln(');')
  		    end;
- 		  dseek:
- 		    begin
- 		        write('Seek(');
- 			eexpr(tp^.taparm);
- 			write(',');
- 			eexpr(tp^.taparm^.tnext);
- 			write(',');
- 			eexpr(tp^.taparm^.tnext^.tnext);
- 			writeln(');');
- 			defnams[dseek]^.lused := true;
- 		    end;
- 		  dtell:
- 		    begin
- 		    	write('Tell(');
- 			eexpr(tp^.taparm);
- 			write(')');
- 			defnams[dtell]^.lused := true;
- 		    end;
  		  darctan:
  		    begin
--- 6238,6241 ----
***************
*** 6580,6617 ****
  						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
--- 6490,6508 ----
  						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
***************
*** 6633,6643 ****
  					(* 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
--- 6524,6529 ----
  					(* add upper bound of actual value *)
  					if tq^.tnext = nil then
! 						write(', ',
! 							crange(tx^.taindx):1)
  				    end
  				else begin
***************
*** 6721,6724 ****
--- 6607,6611 ----
  
  	begin	(* eexpr *)
+ 		donearr := false;
  		if tp^.tt in [nplus, nminus, nmul, nle, nge, neq, nne] then
  		    begin
***************
*** 6827,6833 ****
  		    begin
  			flag := cprio[tp^.tt] > cprio[tp^.texpl^.tt];
! 			if ((tp^.tt in [nlt, nle, ngt, nge]) and
! 					not arithexpr(tp^.texpl))
! 			or (needsintcast(tp^.texpl)) then
  			    begin
  				write('(int)');
--- 6714,6719 ----
  		    begin
  			flag := cprio[tp^.tt] > cprio[tp^.texpl^.tt];
! 			if (tp^.tt in [nlt, nle, ngt, nge]) and
! 					not arithexpr(tp^.texpl) then
  			    begin
  				write('(int)');
***************
*** 6874,6880 ****
  			end;(* case *)
  			flag := cprio[tp^.tt] > cprio[tp^.texpr^.tt];
! 			if ((tp^.tt in [nlt, nle, ngt, nge]) and
! 					not arithexpr(tp^.texpr))
! 			or (needsintcast(tp^.texpr)) then
  			    begin
  				write('(int)');
--- 6760,6765 ----
  			end;(* case *)
  			flag := cprio[tp^.tt] > cprio[tp^.texpr^.tt];
! 			if (tp^.tt in [nlt, nle, ngt, nge]) and
! 					not arithexpr(tp^.texpr) then
  			    begin
  				write('(int)');
***************
*** 7045,7067 ****
  			    begin
  				(* using a file-variable as pointer *)
! 				if tp^.tisassigndest then
! 				    begin
! 					eexpr(tp^.texps);
! 					write('.buf');
! 				    end
! 				else
! 				    begin
! 					if (tq^.tdef = dtext) then
! 					    write('Bufx(')
! 					else
! 					    write('Buf(');
! 					eexpr(tp^.texps);
! 					write(')')
! 				    end
  			    end
  			else begin
- 				write('(*');
  				eexpr(tp^.texps);
! 				write(')')
  			     end
  		    end;
--- 6930,6945 ----
  			    begin
  				(* using a file-variable as pointer *)
! 				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;
***************
*** 7072,7080 ****
  			tq := idup(tp);
  			if tq^.tt = nvarpar then
! 				     begin
  					write('(*');
  					printid(tp^.tsym^.lid);
  					write(')')
  				     end
  			else if (tq^.tt = nconst) and conflag then
  				write(cvalof(tp):1)
--- 6950,6967 ----
  			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)
***************
*** 7223,7248 ****
  	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;
--- 7110,7113 ----
***************
*** 7311,7320 ****
  			case tp^.tt of
  			  nid:
! 				(* Could we test this in a simpler way? *)
! 			        if tp^.tsym^.lsymdecl
! 				    = typnods[tchar]^.tup^.tidl then
! 			  		write(chartyp)
! 				else
! 					printid(tp^.tsym^.lid);
  			  nptr:
  			    begin
--- 7176,7180 ----
  			case tp^.tt of
  			  nid:
! 				printid(tp^.tsym^.lid);
  			  nptr:
  			    begin
***************
*** 7512,7523 ****
  				writeln(tab1, 'FILE', tab1, '*fp;');
  				indent;
! 				writeln(inttyp, tab1, 'bufvalid, eoln, eof, ',
! 				    'writable;');
  				indent;
  				etdef(nil, tp^.tof);
  				writeln(tab1, 'buf;');
  				indent;
- 				writeln(inttyp, tab1, 'auxbuf;');
- 				indent;
  				write('} ')
  			    end;
--- 7372,7389 ----
  				writeln(tab1, 'FILE', tab1, '*fp;');
  				indent;
! 				writeln(tab1, filebits, tab1, 'eoln:1,');
! 				indent;
! 				writeln(tab3, 'eof:1,');
  				indent;
+ 				writeln(tab3, 'out:1,');
+ 				indent;
+ 				writeln(tab3, 'init:1,');
+ 				indent;
+ 				writeln(tab3, ':', filefill:1, ';');
+ 				indent;
+ 				write(tab1);
  				etdef(nil, tp^.tof);
  				writeln(tab1, 'buf;');
  				indent;
  				write('} ')
  			    end;
***************
*** 8005,8012 ****
  			    begin
  				indent;
! 				write('switch ((int)(');
  				increment;
  				eexpr(tp^.tcasxp);
! 				writeln(')) {');
  				decrement;
  				echoise(tp^.tcaslst);
--- 7871,7878 ----
  			    begin
  				indent;
! 				write('switch (');
  				increment;
  				eexpr(tp^.tcasxp);
! 				writeln(') {');
  				decrement;
  				echoise(tp^.tcaslst);
***************
*** 8017,8022 ****
  				    begin
  					indent;
! 					writeln('PTCerror(PTC_E_CASE, ',
! 					    '__LINE__, 0, 0);')
  				    end
  				else
--- 7883,7887 ----
  				    begin
  					indent;
! 					writeln('Caseerror(Line);')
  				    end
  				else
***************
*** 8191,8195 ****
  			writeln('  case 0:');
  			indent;
! 			writeln(tab1, 'break;');
  			tq := tp^.tsublab;
  			while tq <> nil do
--- 8056,8060 ----
  			writeln('  case 0:');
  			indent;
! 			writeln(tab1, 'break');
  			tq := tp^.tsublab;
  			while tq <> nil do
***************
*** 8210,8215 ****
  			writeln('  default:');
  			indent;
! 			writeln(tab1, 
! 			    'PTCerror(PTC_E_CASE, __LINE__, 0, 0);');
  			indent;
  			writeln('}')
--- 8075,8079 ----
  			writeln('  default:');
  			indent;
! 			writeln(tab1, 'Caseerror(Line)');
  			indent;
  			writeln('}')
***************
*** 8338,8342 ****
  			    end;
  			decrement;
- 			edconst(tp^.tsubconst);
  			writeln('}');
  		999:
--- 8202,8205 ----
***************
*** 8370,8373 ****
--- 8233,8248 ----
  		end;
  
+ 		procedure etextdef;
+ 
+ 		var	tq	: treeptr;
+ 
+ 		begin
+ 			write('typedef ');
+ 			tq := mknode(nfileof);
+ 			tq^.tof := typnods[tchar];
+ 			etypedef(tq);
+ 			writeln(tab1, 'text;')
+ 		end;
+ 
  	begin	(* eprogram *)
  		if tp^.tsubid <> nil then
***************
*** 8378,8396 ****
  			printid(tp^.tsubid^.tsym^.lid);
  			writeln;
! 			writeln('**	Translated by ptc ', rcsrevision);
! 			writeln('**	', rcsid);
  			writeln('*', '/');
  		    end;
! 		(* there aren't many programs that don't do I/O... *)
! 		writeln(include, '<stdio.h>');
! 		(* or string operations, so we might as well include these *)
! 		writeln(include, '<string.h>');
! 		writeln(include, '<ptc.h>');
! 		if use(dexp) or use(dln) or use(dsqr) or use(dsin) or
! 		   use(dcos) or use(dtan) or use(darctan) or use(dsqrt) or
! 		   use(dabs) or use(dtrunc) or use(dround) then
! 			writeln(include, '<math.h>');
! 		if use(dinput) or use(doutput) or use(derroutput) then
  		    begin
  			if use(dinput) then
  			    begin
--- 8253,8274 ----
  			printid(tp^.tsubid^.tsym^.lid);
  			writeln;
! 			writeln('*', '/');
! 			writeln(xtern, voidtyp, tab1, 'exit();')
! 		    end;
! 		if usecase or usesets or
! 		   use(dinput) or use(doutput) or
! 		   use(dwrite) or use(dwriteln) or use(dmessage) or
! 		   use(deof) or use(deoln) or use(dflush) or use(dpage) or
! 		   use(dread) or use(dreadln) or use(dclose) or
! 		   use(dreset) or use(drewrite) or use(dget) or use(dput) then
! 		    begin
! 			writeln('/', '*');
! 			writeln('**	Definitions for i/o');
  			writeln('*', '/');
+ 			writeln(include, '<stdio.h>')	(* LIB *)
  		    end;
! 		if use(dinput) or use(doutput) or use(dtext) then
  		    begin
+ 			etextdef;
  			if use(dinput) then
  			    begin
***************
*** 8400,8404 ****
  				printid(defnams[dinput]^.lid);
  				if tp^.tsubid <> nil then
! 					write(' = { stdin, 0, 0, 0, 0}');
  				writeln(';')
  			    end;
--- 8278,8282 ----
  				printid(defnams[dinput]^.lid);
  				if tp^.tsubid <> nil then
! 					write(' = { stdin, 0, 0 }');
  				writeln(';')
  			    end;
***************
*** 8410,8427 ****
  				printid(defnams[doutput]^.lid);
  				if tp^.tsubid <> nil then
! 					write(' = { stdout, 0, 0, 0, 1}');
! 				writeln(';')
! 			    end;
! 			if use(derroutput) then
! 			    begin
! 				if tp^.tsubid = nil then
! 					write(xtern);
! 				write('text', tab1);
! 				printid(defnams[derroutput]^.lid);
! 				if tp^.tsubid <> nil then
! 					write(' = { stderr, 0, 0, 0, 1 }');
  				writeln(';')
  			    end
  		    end;
  		if use(dread) or use(dreadln) then
  		    begin
--- 8288,8308 ----
  				printid(defnams[doutput]^.lid);
  				if tp^.tsubid <> nil then
! 					write(' = { stdout, 0, 0 }');
  				writeln(';')
  			    end
  		    end;
+ 		if use(dinput) or use(dget) or use(dread) or use(dreadln) or
+ 		   use(deof) or use(deoln) or use(dreset) or use(drewrite) then
+ 		    begin
+ 			writeln(define, 'Fread(x, f) ',
+ 				'fread((char *)&x, sizeof(x), 1, f)'); (* LIB *)
+ 			writeln(define, 'Get(f) Fread((f).buf, (f).fp)');
+ 			writeln(define, 'Getx(f) (f).init = 1, ',
+ 				'(f).eoln = (((f).buf = ',
+ 					'fgetc((f).fp)',	(* LIB *)
+ 					') == ', nlchr, ') ? (((f).buf = ',
+ 						spchr, '), 1) : 0');
+ 			writeln(define, 'Getchr(f) (f).buf, Getx(f)')
+ 		    end;
  		if use(dread) or use(dreadln) then
  		    begin
***************
*** 8429,8432 ****
--- 8310,8406 ----
  			writeln(static, 'long', tab1, 'Tmplng;');
  			writeln(static, 'double', tab1, 'Tmpdbl;');
+ 			writeln(define, 'Fscan(f) (f).init ? ',
+ 				'ungetc((f).buf, (f).fp)',	(* LIB *)
+ 					' : 0, Tmpfil = (f).fp');
+ 			writeln(define, 'Scan(p, a) ',
+ 				'Scanck(fscanf(Tmpfil, p, a))'); (* LIB *)
+ 			writeln(voidtyp, tab1, 'Scanck();');
+ 			if use(dreadln) then
+ 				writeln(voidtyp, tab1, 'Getl();');
+ 		    end;
+ 		if use(deoln) then
+ 			writeln(define, 'Eoln(f) ((f).eoln ? true : false)');
+ 		if use(deof) then
+ 			writeln(define, 'Eof(f) ',
+ 				'((((f).init == 0) ? (Get(f)) : 0, ',
+ 					'((f).eof ? 1 : ',
+ 						'feof((f).fp))) ? ', (* LIB *)
+ 							'true : false)');
+ 		if use(doutput) or use(dput) or
+ 				use(dwrite) or use(dwriteln) or
+ 				use(dreset) or use(drewrite) or use(dclose) then
+ 		    begin
+ 			writeln(define, 'Fwrite(x, f) ',
+ 				'fwrite((char *)&x, sizeof(x), 1, f)');(* LIB *)
+ 			writeln(define, 'Put(f) Fwrite((f).buf, (f).fp)');
+ 			writeln(define, 'Putx(f) (f).eoln = ((f).buf == ',
+ 			    nlchr, '), ', voidcast,
+ 				'fputc((f).buf, (f).fp)'); (* LIB *)
+ 			writeln(define, 'Putchr(c, f) (f).buf = (c), Putx(f)');
+ 			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 = ',
+ 				'((f).init ? (',
+ 					'fclose((f).fp), ',	(* LIB *)
+ 						'0) : 0), (f).fp = NULL');
+ 			writeln(define, 'Closex(f) (f).init = ',
+ 				'((f).init ? ',
+ 					'(Finish(f), ',
+ 					'fclose((f).fp), ',	(* LIB *)
+ 						'0) : 0), (f).fp = NULL')
+ 		    end;
+ 		if use(dreset) then
+ 		    begin
+ 			writeln(ifdef, 'READONLY');
+ 			writeln(static, chartyp, tab1, 'Rmode[] = "r";');
+ 			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;
+ 		if use(drewrite) then
+ 		    begin
+ 			writeln(ifdef, 'WRITEONLY');
+ 			writeln(static, chartyp, tab1, 'Wmode[] = "w";');
+ 			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;
+ 		if usefopn then
+ 		    begin
+ 			writeln('FILE	*Fopen();');
+ 			writeln(define, 'MAXFILENAME 256')
+ 		    end;
+ 		if usecase or usejmps then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for case-statements');
+ 			writeln('**	and for non-local gotos');
+ 			writeln('*', '/');
+ 			writeln(define, 'Line __LINE__');
+ 			writeln(voidtyp, tab1, 'Caseerror();')
  		    end;
  		if usejmps then
***************
*** 8447,8450 ****
--- 8421,8431 ----
  			writeln('*', '/')
  		    end;
+ 		if usecomp then
+ 		    begin
+ 			writeln(xtern, inttyp, ' strncmp();');	(* LIB *)
+ 			writeln(define,
+ 				'Cmpstr(x, y) ',
+ 				'strncmp((x), (y), sizeof(x))')	(* LIB *)
+ 		    end;
  		if use(dboolean) or use(dfalse) or use(dtrue) or
  			use(deof) or use(deoln) or usesets then
***************
*** 8466,8470 ****
  			printid(defnams[dboolean]^.lid);
  			writeln(')1');
! 			writeln(static, chartyp, tab1, '*Bools[] = { "false", "true" };')
  		    end;
  		capital(defnams[dinteger]);
--- 8447,8451 ----
  			printid(defnams[dboolean]^.lid);
  			writeln(')1');
! 			writeln(xtern, chartyp, tab1, '*Bools[];')
  		    end;
  		capital(defnams[dinteger]);
***************
*** 8484,8487 ****
--- 8465,8494 ----
  			writeln(';')
  		    end;
+ 		if use(dexp) then
+ 			writeln(xtern, doubletyp, ' exp();');	(* LIB *)
+ 		if use(dln) then
+ 			writeln(xtern, doubletyp, ' log();');	(* LIB *)
+ 		if use(dsqr) then
+ 			writeln(xtern, doubletyp, ' pow();');	(* LIB *)
+ 		if use(dsin) then
+ 			writeln(xtern, doubletyp, ' sin();');	(* LIB *)
+ 		if use(dcos) then
+ 			writeln(xtern, doubletyp, ' cos();');	(* LIB *)
+ 		if use(dtan) then
+ 			writeln(xtern, doubletyp, ' tan();');	(* LIB *)
+ 		if use(darctan) then
+ 			writeln(xtern, doubletyp, ' atan();');	(* LIB *)
+ 		if use(dsqrt) then
+ 			writeln(xtern, doubletyp, ' sqrt();');	(* LIB *)
+ 		if use(dabs) and use(dreal) then
+ 			writeln(xtern, doubletyp, ' fabs();');	(* LIB *)
+ 		if use(dhalt) then
+ 			writeln(xtern, voidtyp, ' abort();');	(* LIB *)
+ 		if use(dnew) or usenilp then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for pointers');
+ 			writeln('*', '/');
+ 		    end;
  		if use(dnew) then
  		    begin
***************
*** 8491,8496 ****
--- 8498,8512 ----
  			writeln(endif)
  		    end;
+ 		if usenilp then
+ 			writeln(define, 'NIL 0');		(* CPU *)
+ 		if use(dnew) then
+ 			writeln(xtern, chartyp, ' *malloc();');	(* LIB *)
+ 		if use(ddispose) then
+ 			writeln(xtern, voidtyp, ' free();');	(* LIB *)
  		if usesets then
  		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for set-operations');
+ 			writeln('*', '/');
  			writeln(define, 'Claimset() ',
  				voidcast, 'Currset(0, (', setptyp, ')0)');
***************
*** 8507,8525 ****
  			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;
  		if (tp^.tsubconst <> nil) or (tp^.tsubtype<> nil) or
--- 8523,8550 ----
  			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
! 			writeln('/', '*');
! 			writeln('**	Definitions for argv-operations');
! 			writeln('*', '/');
! 			writeln(inttyp, tab1, 'argc;');		(* OS *)
! 			writeln(chartyp, tab1, '**argv;');
! 			writeln(' void');
! 			writeln('Argvgt(n, cp, l)');
! 			writeln(inttyp, tab1, 'n;');
! 			writeln(registr, inttyp, tab1, 'l;');
! 			writeln(registr, chartyp, tab1, '*cp;');
! 			writeln('{');
! 			writeln(tab1, registr, chartyp, tab1, '*sp;');
! 			writeln;
! 			writeln(tab1, 'for (sp = argv[n]; l > 0 && *sp; l--)');
! 			writeln(tab2, '*cp++ = *sp++;');
! 			writeln(tab1, 'while (l-- > 0)');
! 			writeln(tab2, '*cp++ = ', spchr, ';');
! 			writeln('}');
  		    end;
  		if (tp^.tsubconst <> nil) or (tp^.tsubtype<> nil) or
***************
*** 8539,8555 ****
  		    begin
  			(* program heading was seen *)
! 			writeln(inttyp, tab1, 'argc;');
! 			writeln(chartyp, tab1, '**argv;');
! 			writeln;
! 			writeln('main(_ac, _av)');	(* OS *)
! 			writeln(inttyp, tab1, '_ac;');
! 			writeln(chartyp, tab1, '*_av[];');
! 			writeln('{');
! 			writeln;
  			increment;
- 			indent;
- 			writeln('argc = _ac;');
- 			indent;
- 			writeln('argv = _av;');
  			elabel(tp);
  			estmt(tp^.tsubstmt);
--- 8564,8585 ----
  		    begin
  			(* program heading was seen *)
! 			writeln('/', '*');
! 			writeln('**	Start of program code');
! 			writeln('*', '/');
! 			if use(dargc) or use(dargv) then
! 			    begin
! 				writeln('main(_ac, _av)');	(* OS *)
! 				writeln(inttyp, tab1, '_ac;');
! 				writeln(chartyp, tab1, '*_av[];');
! 				writeln('{');
! 				writeln;
! 				writeln(tab1, 'argc = _ac;');
! 				writeln(tab1, 'argv = _av;')
! 			    end
! 			else begin
! 				writeln('main()');
! 				writeln('{')
! 			     end;
  			increment;
  			elabel(tp);
  			estmt(tp^.tsubstmt);
***************
*** 8556,8564 ****
  			indent;
  			writeln('exit(0);');
- 			indent;
- 			writeln('/', '* NOTREACHED *', '/');
  			decrement;
  			writeln('}');
! 			edconst(tp^.tsubconst);
  		    end
  	end;	(* eprogram *)
--- 8586,8594 ----
  			indent;
  			writeln('exit(0);');
  			decrement;
  			writeln('}');
! 			writeln('/', '*');
! 			writeln('**	End of program code');
! 			writeln('*', '/')
  		    end
  	end;	(* eprogram *)
***************
*** 8690,8694 ****
--- 8720,8791 ----
  	setused := false;
  	dropset := false;
+ 	doarrow := 0;
  	eprogram(top);
+ 	if usebool then
+ 		writeln(chartyp, tab1, '*Bools[] = { "false", "true" };');
+ 	if usescan then
+ 	    begin
+ 		writeln;
+ 		writeln(static, voidtyp);
+ 		writeln('Scanck(n)');
+ 		writeln(inttyp, tab1, 'n;');
+ 		writeln('{');
+ 		writeln(tab1, 'if (n != 1) {');
+ 		writeln(tab2, voidcast, 'fprintf(stderr, "Bad input\n");');
+ 		writeln(tab2, 'exit(1);');
+ 		writeln(tab1, '}');
+ 		writeln('}')
+ 	    end;
+ 	if usegetl then
+ 	    begin
+ 		writeln;
+ 		writeln(static, voidtyp);
+ 		writeln('Getl(f)');
+ 		writeln(' text', tab1, '*f;');
+ 		writeln('{');
+ 		writeln(tab1, 'while (f->eoln == 0)');
+ 		writeln(tab2, 'Getx(*f);');
+ 		writeln(tab1, 'Getx(*f);');
+ 		writeln('}')
+ 	    end;
+ 	if usefopn then
+ 	    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 ',
+ 			quote, '%s', quote, '\n", n);');
+ 		writeln(tab3, 'exit(1);');
+ 		writeln(tab2, '}');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 's = tmp;');
+ 		writeln(tab1, 'if ((f = fopen(s, m)) == NULL) {');
+ 		writeln(tab2, voidcast,
+ 				'fprintf(stderr, "Cannot open: %s\n", s);');
+ 		writeln(tab2, 'exit(1);');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'if (n == NULL)');
+ 		writeln(tab2, 'unlink(tmp);');	(* OS *)
+ 		writeln(tab1, 'return (f);');
+ 		writeln('}');
+ 		writeln(xtern, inttyp, tab1, 'rewind();')
+ 	    end;
  	if setcnt > 0 then
  		econset(setlst, setcnt);
***************
*** 9005,9037 ****
  		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;
--- 9102,9115 ----
  		writeln('}')
  	    end;
! 	if usecase then
  	    begin
  		writeln;
! 		writeln(static, voidtyp);
! 		writeln('Caseerror(n)');
! 		writeln(tab1, inttyp, tab1, 'n;');
! 		writeln('{');
! 		writeln(tab1, voidcast,
! 			'fprintf(stderr, "Missing case limb: line %d\n", n);');
! 		writeln(tab1, 'exit(1);');
  		writeln('}')
  	    end;
***************
*** 9048,9051 ****
--- 9126,9151 ----
  		writeln('}')
  	    end;
+ 	if use(dtrunc) then
+ 	    begin
+ 		writeln(static, inttyp);
+ 		writeln('Trunc(f)');
+ 		printid(defnams[dreal]^.lid);
+ 		writeln(tab1, 'f;');
+ 		writeln('{');
+ 		writeln(tab1, 'return f;');
+ 		writeln('}')
+ 	    end;
+ 	if use(dround) then
+ 	    begin
+ 		writeln(static, inttyp);
+ 		writeln('Round(f)');
+ 		printid(defnams[dreal]^.lid);
+ 		writeln(tab1, 'f;');
+ 		writeln('{');
+ 		writeln(tab1, xtern, doubletyp, ' floor();');	(* LIB *)
+ 		writeln(tab1,
+ 			'return floor(', dblcast, '(0.5+f));');	(* LIB *)
+ 		writeln('}')
+ 	    end
  end;	(* emit *)
  
***************
*** 9057,9062 ****
  	d	: predefs;
  
- 	hx	: packed array [ 1 .. 16 ] of char;
- 
  	(*	Define names in ctable.					*)
  	procedure defname(cn : cnames; str : keyword);
--- 9157,9160 ----
***************
*** 9174,9178 ****
  	end;
  
! 	procedure fixfp(i : strindx);
  
  	var	t	: toknbuf;
--- 9272,9276 ----
  	end;
  
! 	procedure fixinit(i : strindx);
  
  	var	t	: toknbuf;
***************
*** 9180,9184 ****
  	begin
  		gettokn(i, t);
! 		t[1] := 'f';
  		puttokn(i, t);
  	end;
--- 9278,9282 ----
  	begin
  		gettokn(i, t);
! 		t[1] := 'i';
  		puttokn(i, t);
  	end;
***************
*** 9232,9241 ****
  
  begin	(* initialize *)
- { IF-PASCAL
- 	rewrite(erroutput, '/dev/tty'); 
- END-IF-PASCAL }
  	lineno := 1;
  	colno := 0;
- 	pushed := false;
  
  	initstrstore;
--- 9330,9335 ----
***************
*** 9243,9248 ****
  	setlst := nil;
  	setcnt := 0;
! 	hx := '0123456789ABCDEF';
! 	unpack(hx, hexdig, 0);
  
  	symtab := nil;
--- 9337,9341 ----
  	setlst := nil;
  	setcnt := 0;
! 	hexdig := '0123456789ABCDEF';
  
  	symtab := nil;
***************
*** 9252,9255 ****
--- 9345,9350 ----
  	varno:= 0;
  
+ 	usenilp := false;
+ 
  	usesets := false;
  	useunion := false;
***************
*** 9264,9267 ****
--- 9359,9365 ----
  	useins := false;
  	usescpy := false;
+ 	usefopn := false;
+ 	usescan := false;
+ 	usegetl := false;
  
  	usecase := false;
***************
*** 9268,9275 ****
  	usejmps := false;
  
  	usecomp := false;
  	usemax	:= false;
- 	usealig	:= false;
- 	usesal	:= false;
  
  	for s := 0 to hashmax do
--- 9366,9373 ----
  	usejmps := false;
  
+ 	usebool := false;
+ 
  	usecomp := false;
  	usemax	:= false;
  
  	for s := 0 to hashmax do
***************
*** 9447,9453 ****
  	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 *)
--- 9545,9548 ----
***************
*** 9465,9469 ****
  	defid(nproc,	ddispose,	'dispose   ');
  	defid(nid,	dfalse,		'false     ');
- 	defid(nvar,	derroutput,	'erroutput ');
  	defid(nfunc,	deof,		'eof       ');
  	defid(nfunc,	deoln,		'eoln      ');
--- 9560,9563 ----
***************
*** 9470,9474 ****
  	defid(nproc,	dexit,		'exit      ');	(* OS *)
  	defid(nfunc,	dexp,		'exp       ');
! 	defid(nproc,	dflush,		'flush     ');  (* OS *)
  	defid(nproc,	dget,		'get       ');
  	defid(nproc,	dhalt,		'halt      ');	(* OS *)
--- 9564,9568 ----
  	defid(nproc,	dexit,		'exit      ');	(* OS *)
  	defid(nfunc,	dexp,		'exp       ');
! 	defid(nproc,	dflush,		'flush     ');	(* OS *)
  	defid(nproc,	dget,		'get       ');
  	defid(nproc,	dhalt,		'halt      ');	(* OS *)
***************
*** 9477,9480 ****
--- 9571,9575 ----
  	defid(nfunc,	dln,		'ln        ');
  	defid(nconst,	dmaxint,	'maxint    ');
+ 	defid(nproc,	dmessage,	'message   ');	(* OS *)
  	defid(nproc,	dnew,		'new       ');
  	defid(nfunc,	dodd,		'odd       ');
***************
*** 9484,9488 ****
  	defid(nproc,	dpage,		'page      ');
  	defid(nfunc,	dpred,		'pred      ');
- 	defid(nproc,	dprompt,	'prompt    '); (* OS *)
  	defid(nproc,	dput,		'put       ');
  	defid(nproc,	dread,		'read      ');
--- 9579,9582 ----
***************
*** 9492,9496 ****
  	defid(nproc,	drewrite,	'rewrite   ');
  	defid(nfunc,	dround,		'round     ');
- 	defid(nproc,	dseek,		'seek      ');
  	defid(nfunc,	dsin,		'sin       ');
  	defid(nfunc,	dsqr,		'sqr       ');
--- 9586,9589 ----
***************
*** 9497,9501 ****
  	defid(nfunc,	dsqrt,		'sqrt      ');
  	defid(nfunc,	dsucc,		'succ      ');
- 	defid(nfunc,	dtell,		'tell      ');
  	defid(ntype,	dtext,		'text      ');
  	defid(nid,	dtrue,		'true      ');
--- 9590,9593 ----
***************
*** 9506,9510 ****
  	defid(nproc,	dwriteln,	'writeln   ');
  
! 	defid(nfield,	dzfp,		'$p        ');	(* for internal use *)
  	defid(ntype,	dztring,	'$ztring   ');
  
--- 9598,9602 ----
  	defid(nproc,	dwriteln,	'writeln   ');
  
! 	defid(nfield,	dzinit,		'$nit      ');	(* for internal use *)
  	defid(ntype,	dztring,	'$ztring   ');
  
***************
*** 9518,9522 ****
  	deftab[dinput]^.tbind := deftab[dtext]^.tbind;
  	deftab[doutput]^.tbind := deftab[dtext]^.tbind;
- 	deftab[derroutput]^.tbind := deftab[dtext]^.tbind;
  
  	for t := tnone to terror do
--- 9610,9613 ----
***************
*** 9526,9530 ****
  		case t of
  		  tboolean:
! 			typnods[t] := deftab[dboolean]^.tbind;
  		  tchar:
  			typnods[t] := deftab[dchar]^.tbind;
--- 9617,9621 ----
  		case t of
  		  tboolean:
! 			typnods[t] := deftab[dboolean]; (* scalar type *)
  		  tchar:
  			typnods[t] := deftab[dchar]^.tbind;
***************
*** 9550,9556 ****
  	    end;
  
! 	(* fix name and type of field "fp" *)
! 	fixfp(defnams[dzfp]^.lid^.istr);
! 	deftab[dzfp]^.tbind := deftab[dinteger]^.tbind;
  
  	for d := dabs to dztring do
--- 9641,9647 ----
  	    end;
  
! 	(* fix name and type of field "init" *)
! 	fixinit(defnams[dzinit]^.lid^.istr);
! 	deftab[dzinit]^.tbind := deftab[dinteger]^.tbind;
  
  	for d := dabs to dztring do
***************
*** 9565,9569 ****
  	deftab[dord]^.tfuntyp := typnods[tinteger];
  	deftab[dround]^.tfuntyp := typnods[tinteger];
- 	deftab[dtell]^.tfuntyp := typnods[tinteger];
  	deftab[dtrunc]^.tfuntyp := typnods[tinteger];
  
--- 9656,9659 ----
***************
*** 9584,9588 ****
  	deftab[ddispose]^.tfuntyp := typnods[tnone];
  	deftab[dexit]^.tfuntyp := typnods[tnone];
- 	deftab[dflush]^.tfuntyp := typnods[tnone];
  	deftab[dget]^.tfuntyp := typnods[tnone];
  	deftab[dhalt]^.tfuntyp := typnods[tnone];
--- 9674,9677 ----
***************
*** 9590,9594 ****
  	deftab[dpack]^.tfuntyp := typnods[tnone];
  	deftab[dput]^.tfuntyp := typnods[tnone];
- 	deftab[dprompt]^.tfuntyp := typnods[tnone];
  	deftab[dread]^.tfuntyp := typnods[tnone];
  	deftab[dreadln]^.tfuntyp := typnods[tnone];
--- 9679,9682 ----
***************
*** 9595,9601 ****
  	deftab[dreset]^.tfuntyp := typnods[tnone];
  	deftab[drewrite]^.tfuntyp := typnods[tnone];
- 	deftab[dseek]^.tfuntyp := typnods[tnone];
  	deftab[dwrite]^.tfuntyp := typnods[tnone];
  	deftab[dwriteln]^.tfuntyp := typnods[tnone];
  	deftab[dunpack]^.tfuntyp := typnods[tnone];
  
--- 9683,9689 ----
  	deftab[dreset]^.tfuntyp := typnods[tnone];
  	deftab[drewrite]^.tfuntyp := typnods[tnone];
  	deftab[dwrite]^.tfuntyp := typnods[tnone];
  	deftab[dwriteln]^.tfuntyp := typnods[tnone];
+ 	deftab[dmessage]^.tfuntyp := typnods[tnone];
  	deftab[dunpack]^.tfuntyp := typnods[tnone];
  
***************
*** 9610,9613 ****
--- 9698,9703 ----
  end;	(* initialize *)
  
+ procedure exit(i : integer); external;	(* OS *)
+ 
  (*	Action to take when an error is detected.			*)
  procedure error;
***************
*** 9615,9624 ****
  begin
  	prtmsg(m);
! { IF-PASCAL
! 	goto 9999;
! END-IF-PASCAL }
! { IF-C }
! 	exit(1);
! { END-IF-C }
  end;
  
--- 9705,9710 ----
  begin
  	prtmsg(m);
! 	exit(1);	(* OS *)
! 	goto 9999
  end;
  
***************
*** 9628,9637 ****
  begin
  	prtmsg(m);
! { IF-PASCAL
! 	goto 9999;
! END-IF-PASCAL }
! { IF-C }
! 	exit(1);
! { END-IF-C }
  end;
  
--- 9714,9719 ----
  begin
  	prtmsg(m);
! 	halt		(* OS *)
! 	(* goto 9999	*)
  end;
  
***************
*** 9639,9647 ****
--- 9721,9736 ----
  begin	(* program *)
  	initialize;
+ 	if echo then
+ 		writeln('# ifdef PASCAL');
  	parse;
+ 	if echo then
+ 		writeln('# else');
  	lineno := 0; lastline := 0;
  	transform;
  	emit;
+ 	if echo then
+ 		writeln('# endif');
  9999:
  	(* the very *)
  end.
+