Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!uunet!husc6!hao!gatech!hubcap!ncrcae!sauron!wescott
From: wescott@sauron.Columbia.NCR.COM (Mike Wescott)
Newsgroups: comp.sources.d
Subject: Re: File access problem using ptc --
Message-ID: <921@sauron.Columbia.NCR.COM>
Date: Fri, 28-Aug-87 11:46:15 EDT
Article-I.D.: sauron.921
Posted: Fri Aug 28 11:46:15 1987
Date-Received: Sun, 30-Aug-87 01:35:34 EDT
References: <490@leah.Albany.Edu>
Reply-To: wescott@sauron.Columbia.NCR.COM (Mike Wescott)
Organization: Advanced Systems Development, NCR Corp., Columbia, SC
Lines: 363
Keywords: reset, pascal, ptc, um

In article <490@leah.Albany.Edu> rds95@leah.Albany.Edu ( Robert Seals) writes:
> .......<stuff deleted>.....
> % cc ptcbug.c
> "ptcbug.c", line 66: operands of : have incompatible types
> "ptcbug.c", line 120: redeclaration of rewind
> 
> Has anybody come up with anything that will make it work? Programs that
> use stdin and out all work fine, and this is a real bummer drag,
> because very few of my programs don't use files.

One fix is to replace the call to rewind with an equivalent fseek. There is
also a bug in the way filenames are handled in the code emited for Fopen().
The bug can result in garbage or spaces in filenames opened.

A third bug is the way colno is calculated - if a tab occurs in just before
a tabstop colno is pushed one tabstop too far.

I also added getchar() and putchar() to the cname list (this maybe just a
SysV anomaly).

I ran into problems porting TeX if changes weren't made in the defmach
routine.  These changes are included and force all arithmetic to be 
signed (on the C side).

The emitted code for switch was changed to include a cast to int -- my
C compiler complains if enums are switched.

There is an initialization problem in the handling of the node created
when a case statement is parsed.  In some cases (pun) the generation
of a nchoise-variant record can have the tchocon and tchostmt elements
left uninitialized.  For many implementations this ends up with nil or
0 in it.  However if malloc or new cannot guareentee zero filled memory
on mallocs then an occasional SIGSEGV may occur in linkup().

As patched, I have had no further while using it on an NCR-Tower32 (68020
and SystemV) in trying to port TeX to the Tower32. I'm still testing with
initex but it looks very promising and I have gotten much further in the 
effort than with any of the Pascal compilers available for the Tower32.

Patch below:

*** ptc.p	Mon Aug 24 10:02:22 1987
--- orig/ptc.p	Thu Jul 30 22:10:58 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(), fseek() 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(), rewind() etc.			  **)
  (**	If the source-program uses Pascal functions like sin(), sqrt()	  **)
  (**	etc, there must also exist such functions in the C-library.	  **)
  (**									  **)
***************
*** 639,648 ****
  		cetext,		cextern,	cfgetc,		cfclose,
  		cfflush,	cfloat,		cfloor,		cfprintf,
  		cfputc,		cfread,		cfscanf,	cfwrite,
! 		cgetc,		cgetchar, 	cgetpid,	cint,		cinclude,
  		clong,		clog,		cmain,		cmalloc,
! 		cprintf,	cpower,		cputc,		cputchar, 	cread,
! 		creturn,	cregister,	cfseek,		cscanf,
  		csetbits,	csetword,	csetptr,	cshort,
  		csigned,	csizeof,	csprintf,	cstdin,
  		cstdout,	cstderr,	cstrncmp,	cstrncpy,
--- 639,648 ----
  		cetext,		cextern,	cfgetc,		cfclose,
  		cfflush,	cfloat,		cfloor,		cfprintf,
  		cfputc,		cfread,		cfscanf,	cfwrite,
! 		cgetc,		cgetpid,	cint,		cinclude,
  		clong,		clog,		cmain,		cmalloc,
! 		cprintf,	cpower,		cputc,		cread,
! 		creturn,	cregister,	crewind,	cscanf,
  		csetbits,	csetword,	csetptr,	cshort,
  		csigned,	csizeof,	csprintf,	cstdin,
  		cstdout,	cstderr,	cstrncmp,	cstrncpy,
***************
*** 1235,1241 ****
  				else
  					write(c);
  			if c = tab1 then
! 				colno := (((colno-1) div tabwidth) + 1) * tabwidth
  		     end;
  		if lastchr > 0 then
  		    begin
--- 1235,1241 ----
  				else
  					write(c);
  			if c = tab1 then
! 				colno := ((colno div tabwidth) + 1) * tabwidth
  		     end;
  		if lastchr > 0 then
  		    begin
***************
*** 3651,3664 ****
  				tq^.tnext := mknode(nchoise);
  				tq := tq^.tnext
  			     end;
- 			tq^.tchocon := nil;
- 			tq^.tchostmt := nil;
  			tv := nil;
  			repeat
  				nextsymbol([sid, sinteger, schar,
  						splus, sminus, send, sother]);
  				if currsym.st in [send, sother] then
! 					goto 9959;
  				if tv = nil then
  				    begin
  					tv := pconstant(false);
--- 3651,3662 ----
  				tq^.tnext := mknode(nchoise);
  				tq := tq^.tnext
  			     end;
  			tv := nil;
  			repeat
  				nextsymbol([sid, sinteger, schar,
  						splus, sminus, send, sother]);
  				if currsym.st in [send, sother] then
! 					goto 999;
  				if tv = nil then
  				    begin
  					tv := pconstant(false);
***************
*** 7870,7879 ****
  			  ncase:
  			    begin
  				indent;
! 				write('switch ((int)(');
  				increment;
  				eexpr(tp^.tcasxp);
! 				writeln(')) {');
  				decrement;
  				echoise(tp^.tcaslst);
  				indent;
--- 7870,7879 ----
  			  ncase:
  			    begin
  				indent;
! 				write('switch (');
  				increment;
  				eexpr(tp^.tcasxp);
! 				writeln(') {');
  				decrement;
  				echoise(tp^.tcaslst);
  				indent;
***************
*** 8342,8348 ****
  		if use(dreset) or use(drewrite) or use(dclose) then
  			writeln(define, 'Finish(f) ((f).out && !(f).eoln) ? ',
  				'(Putchr(', nlchr, ', f), 0) : 0, ',
! 					'fseek((f).fp,0L,0)');	(* LIB *)
  		if use(dclose) then
  		    begin
  			writeln(define, 'Close(f) (f).init = ',
--- 8342,8348 ----
  		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 = ',
***************
*** 8363,8374 ****
  			writeln(static, chartyp, tab1, 'Rmode[] = "r+";');
  			writeln(endif);
  			writeln(define, 'Reset(f, n) (f).init = ',
! 			    '(f).init ? fseek((f).fp,0L,0) : ',	(* LIB *)
! 				'(((f).fp = Fopen(n, Rmode, sizeof(n))), 1), ',
  					'(f).eof = (f).out = 0, Get(f)');
  			writeln(define, 'Resetx(f, n) (f).init = ',
  			    '(f).init ? (Finish(f)) : ',
! 				'(((f).fp = Fopen(n, Rmode, sizeof(n))), 1), ',
  					'(f).eof = (f).out = 0, Getx(f)');
  			usefopn := true
  		    end;
--- 8363,8374 ----
  			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;
***************
*** 8380,8391 ****
  			writeln(static, chartyp, tab1, 'Wmode[] = "w+";');
  			writeln(endif);
  			writeln(define, 'Rewrite(f, n) (f).init = ',
! 			    '(f).init ? fseek((f).fp,0L,0) : ',	(* LIB *)
! 				'(((f).fp = Fopen(n, Wmode, sizeof(n))), 1), ',
  					'(f).out = (f).eof = 1');
  			writeln(define, 'Rewritex(f, n) (f).init = ',
  			    '(f).init ? (Finish(f)) : ',
! 				'(((f).fp = Fopen(n, Wmode, sizeof(n))), 1), ',
  					'(f).out = (f).eof = (f).eoln = 1');
  			usefopn := true
  		    end;
--- 8380,8391 ----
  			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;
***************
*** 8752,8760 ****
  	    begin
  		writeln;
  		writeln(static, 'FILE *');
! 		writeln('Fopen(n, m, l)');
  		writeln(chartyp, tab1, '*n, *m;');
- 		writeln(inttyp, tab1, 'l;');
  		writeln('{');
  		writeln(tab1, 'FILE', tab2, '*f;');
  		writeln(tab1, registr, chartyp, tab1, '*s;');
--- 8752,8759 ----
  	    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;');
***************
*** 8766,8776 ****
  		writeln(tab1, 'if (n == NULL)');
  		writeln(tab2, 'sprintf(tmp, ', tmpfilename, 'ch++);');
  		writeln(tab1, 'else {');
! 		writeln(tab2, 'l = l < MAXFILENAME-1 ? l : MAXFILENAME-2;');
! 		writeln(tab2, 'strncpy(tmp, n, l);');
! 		writeln(tab2, 'tmp[l+1] = ', nulchr, ';');
! 		writeln(tab2, 'for (s = tmp; *s; s++);');
! 		writeln(tab2, 'for (; *s == ', spchr, ' || *s == ', nulchr, '; *s-- = ', nulchr,');');
  		writeln(tab1, '}');
  		writeln(tab1, 's = tmp;');
  		writeln(tab1, 'if ((f = fopen(s, m)) == NULL) {');
--- 8765,8779 ----
  		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) {');
***************
*** 8782,8788 ****
  		writeln(tab2, 'unlink(tmp);');	(* OS *)
  		writeln(tab1, 'return (f);');
  		writeln('}');
! 		writeln(xtern, inttyp, tab1, 'fseek();')
  	    end;
  	if setcnt > 0 then
  		econset(setlst, setcnt);
--- 8785,8791 ----
  		writeln(tab2, 'unlink(tmp);');	(* OS *)
  		writeln(tab1, 'return (f);');
  		writeln('}');
! 		writeln(xtern, inttyp, tab1, 'rewind();')
  	    end;
  	if setcnt > 0 then
  		econset(setlst, setcnt);
***************
*** 9506,9512 ****
  	defname(cfscanf,	'fscanf    ');	(* LIB *)
  	defname(cfwrite,	'fwrite    ');	(* LIB *)
  	defname(cgetc,		'getc      ');	(* OS *)
- 	defname(cgetchar,	'getchar   ');	(* LIB *)
  	defname(cgetpid,	'getpid    ');	(* OS *)
  	defname(cint,		'int       ');
  	defname(cinclude,	'include   ');
--- 9509,9514 ----
***************
*** 9517,9527 ****
  	defname(cprintf,	'printf    ');	(* LIB *)
  	defname(cpower,		'pow       ');	(* OS *)
  	defname(cputc,		'putc      ');	(* LIB *)
- 	defname(cputchar,	'putchar   ');	(* LIB *)
  	defname(cread,		'read      ');	(* OS *)
  	defname(creturn,	'return    ');
  	defname(cregister,	'register  ');
! 	defname(cfseek,		'fseek     ');	(* LIB *)
  	defname(cscanf,		'scanf     ');	(* LIB *)
  	defname(csetbits,	'setbits   ');
  	defname(csetword,	'setword   ');
--- 9519,9528 ----
  	defname(cprintf,	'printf    ');	(* LIB *)
  	defname(cpower,		'pow       ');	(* OS *)
  	defname(cputc,		'putc      ');	(* LIB *)
  	defname(cread,		'read      ');	(* OS *)
  	defname(creturn,	'return    ');
  	defname(cregister,	'register  ');
! 	defname(crewind,	'rewind    ');	(* LIB *)
  	defname(cscanf,		'scanf     ');	(* LIB *)
  	defname(csetbits,	'setbits   ');
  	defname(csetword,	'setword   ');
***************
*** 9686,9702 ****
  	deftab[dmessage]^.tfuntyp := typnods[tnone];
  	deftab[dunpack]^.tfuntyp := typnods[tnone];
  
! 	(* set up definitions for integer subranges  CPU *)
  	nmachdefs := 0;
! {	defmach(0,		255,		'unsigned char   ');}
! 	defmach(-128,		127,		'char            ');
! {	defmach(0,		65535,		'unsigned short  ');}
! 	defmach(-32768,		32767,		'short           ');
! 	defmach(-2147483647,	2147483647,	'long            ');
! {	defmach(0,		4294967295,	'unsigned long   ');}
  end;	(* initialize *)
  
! procedure exit(i : integer); forward;	(* OS *)
  
  (*	Action to take when an error is detected.			*)
  procedure error;
--- 9687,9703 ----
  	deftab[dmessage]^.tfuntyp := typnods[tnone];
  	deftab[dunpack]^.tfuntyp := typnods[tnone];
  
! 	(* set up definitions for integer subranges *)
  	nmachdefs := 0;
! 	defmach(0,		255,		'unsigned char   '); (* CPU *)
! 	defmach(-128,		127,		'char            '); (* CPU *)
! 	defmach(0,		65535,		'unsigned short  '); (* CPU *)
! 	defmach(-32768,		32767,		'short           '); (* CPU *)
! 	defmach(-2147483647,	2147483647,	'long            '); (* CPU *)
! {	defmach(0,		4294967295,	'unsigned long   ');}(* CPU *)
  end;	(* initialize *)
  
! procedure exit(i : integer); external;	(* OS *)
  
  (*	Action to take when an error is detected.			*)
  procedure error;
-- 
	-Mike Wescott
	 wescott@ncrcae.Columbia.NCR.COM