Remove f2c as its libraries were tossed last April, and f2c has been replaced

with EGCS's f77.

Noticed still alive by:	bde

54 files changed, 0 insertions, 31525 deletions

diff --git a/usr.bin/f2c/Makefile b/usr.bin/f2c/Makefile
deleted file mode 100644
index b711916..0000000
--- a/usr.bin/f2c/Makefile
+++ /dev/null
@@ -1,35 +0,0 @@
-#	Makefile for f2c, a Fortran 77 to C converter
-
-PROG=	f2c
-
-CFLAGS +=  -DANSI_Libraries -I${.CURDIR} -I.
-SHELL = /bin/sh
-
-SRCSd =	main.c init.c gram.c lex.c proc.c equiv.c data.c format.c \
-	expr.c exec.c intr.c io.c misc.c error.c mem.c names.c \
-	output.c p1output.c pread.c put.c putpcc.c vax.c formatdata.c \
-	parse_args.c niceprintf.c cds.c sysdep.c version.c
-SRCS =	$(SRCSd) tokdefs.h # malloc.c
-
-GRAMFILES = ${.CURDIR}/gram.head ${.CURDIR}/gram.dcl ${.CURDIR}/gram.expr\
-	${.CURDIR}/gram.exec ${.CURDIR}/gram.io
-
-gram.c:	${GRAMFILES} ${.CURDIR}/defs.h tokdefs.h
-	(sed < tokdefs.h "s/#define/%token/" ; \
-	cat ${GRAMFILES}) > gram.in
-	$(YACC) $(YFLAGS) gram.in
-	echo "# expect 4 shift/reduce conflicts"
-	sed 's/^# line.*/\/* & *\//' y.tab.c >gram.c
-	rm -f gram.in y.tab.c
-
-tokdefs.h: ${.CURDIR}/tokens
-	grep -n . <${.CURDIR}/tokens | sed "s/\([^:]*\):\(.*\)/#define \2 \1/" >tokdefs.h
-
-CLEANFILES+=\
-	gram.c tokdefs.h y.tab.h
-
-beforeinstall:
-	${INSTALL} -C -o ${BINOWN} -g ${BINGRP} -m 444 ${.CURDIR}/f2c.h \
-		${DESTDIR}/usr/include
-
-.include <bsd.prog.mk>
diff --git a/usr.bin/f2c/Notice b/usr.bin/f2c/Notice
deleted file mode 100644
index 261b719..0000000
--- a/usr.bin/f2c/Notice
+++ /dev/null
@@ -1,23 +0,0 @@
-/****************************************************************
-Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
diff --git a/usr.bin/f2c/README b/usr.bin/f2c/README
deleted file mode 100644
index 6b0d2b2..0000000
--- a/usr.bin/f2c/README
+++ /dev/null
@@ -1,174 +0,0 @@
-Type "make" to check the validity of the f2c source and compile f2c.
-
-On a PC, you may need to compile xsum.c with -DMSDOS (i.e., with
-MSDOS #defined).
-
-If your compiler does not understand ANSI/ISO C syntax (i.e., if
-you have a K&R C compiler), compile with -DKR_headers .
-
-On non-Unix systems where files have separate binary and text modes,
-you may need to "make xsumr.out" rather than "make xsum.out".
-
-If (in accordance with what follows) you need to any of the source
-files (excluding the makefile), first issue a "make xsum.out" (or, if
-appropriate, "make xsumr.out") to check the validity of the f2c source,
-then make your changes, then type "make f2c".
-
-The file usignal.h is for the benefit of strictly ANSI include files
-on a UNIX system -- the ANSI signal.h does not define SIGHUP or SIGQUIT.
-You may need to modify usignal.h if you are not running f2c on a UNIX
-system.
-
-Should you get the message "xsum0.out xsum1.out differ", see what lines
-are different (`diff xsum0.out xsum1.out`) and ask netlib
-(e.g., netlib@netlib.bell-labs.com) to send you the files in question,
-plus the current xsum0.out (which may have changed) "from f2c/src".
-For example, if exec.c and expr.c have incorrect check sums, you would
-send netlib the message
-	send exec.c expr.c xsum0.out from f2c/src
-You can also ftp these files from netlib.bell-labs.com; for more
-details, ask netlib@netlib.bell-labs.com to "send readme from f2c".
-
-On some systems, the malloc and free in malloc.c let f2c run faster
-than do the standard malloc and free.  Other systems may not tolerate
-redefinition of malloc and free (though changes of 8 Nov. 1994 may
-render this less of a problem than hitherto).  If your system permits
-use of a user-supplied malloc, you may wish to change the MALLOC =
-line in the makefile to "MALLOC = malloc.o", or to type
-	make MALLOC=malloc.o
-instead of
-	make
-Still other systems have a -lmalloc that provides performance
-competitive with that from malloc.c; you may wish to compare the two
-on your system.  If your system does not permit user-supplied malloc
-routines, then f2c may fault with "MALLOC=malloc.o", or may display
-other untoward behavior.
-
-On some BSD systems, you may need to create a file named "string.h"
-whose single line is
-#include <strings.h>
-you may need to add " -Dstrchr=index" to the "CFLAGS =" assignment
-in the makefile, and you may need to add " memset.o" to the "OBJECTS ="
-assignment in the makefile -- see the comments in memset.c .
-
-For non-UNIX systems, you may need to change some things in sysdep.c,
-such as the choice of intermediate file names.
-
-On some systems, you may need to modify parts of sysdep.h (which is
-included by defs.h).  In particular, for Sun 4.1 systems and perhaps
-some others, you need to comment out the typedef of size_t.  For some
-systems (e.g., IRIX 4.0.1 and AIX) it is better to add
-#define ANSI_Libraries
-to the beginning of sysdep.h (or to supply -DANSI_Libraries in the
-makefile).
-
-Alas, some systems #define __STDC__ but do not provide a true standard
-(ANSI or ISO) C environment, e.g. do not provide stdlib.h .  If yours
-is such a system, then (a) you should complain loudly to your vendor
-about __STDC__ being erroneously defined, and (b) you should insert
-#undef __STDC__
-at the beginning of sysdep.h .  You may need to make other adjustments.
-
-For some non-ANSI versions of stdio, you must change the values given
-to binread and binwrite in sysdep.c from "rb" and "wb" to "r" and "w".
-You may need to make this change if you run f2c and get an error
-message of the form
-	Compiler error ... cannot open intermediate file ...
-
-On many systems, it is best to combine libF77 and libI77 into a single
-library, say libf2c, as suggested in "readme from f2c".  If you do not
-do this, then you should adjust the definition of link_msg in sysdep.c
-appropriately (e.g., replacing "-lf2c" by "-lF77 -lI77").  On Unix
-systems, the easiest way to create libf2c.a is to make libF77/libF77.a
-and libI77/libI77.a (after reading and heeding libF77/README and
-libI77/README), and then to say
-
-	cp libF77/libF77.a libf2c.a
-	ar ruv libf2c.a libI77/*.o
-	ranlib libf2c.a
-
-The last step, ranlib, may not be necessary on your system.  On
-other systems, just compile all the .c files in libF77 and libI77,
-and put the resulting objects (except one or both of the Version
-objects) into a library, called perhaps f2c.lib .
-
-In general, under Linux it is necessary to compile libI77 with
--DNON_UNIX_STDIO .  Under at least one variant of Linux, you can make
-and install a shared-library version of libf2c by compiling libI77
-with -DNON_UNIX_STDIO, creating libf2c.a as above, and then executing
-
-	mkdir t
-	ln lib?77/*.o t
-	cd t; cc -shared -o ../libf2c.so -Wl,-soname,libf2c.so.1 *.o
-	cd ..
-	rm -r t
-	rm /usr/lib/libf2c*
-	mv libf2c.a libf2c.so /usr/lib
-	cd /usr/lib
-	ln libf2c.so libf2c.so.1
-	ln libf2c.so libf2c.so.1.0.0
-
-On some other systems, /usr/local/lib is the appropriate installation
-directory.
-
-
-Some older C compilers object to
-	typedef void (*foo)();
-or to
-	typedef void zap;
-	zap (*foo)();
-If yours is such a compiler, change the definition of VOID in
-f2c.h from void to int.
-
-For convenience with systems that use control-Z to denote end-of-file,
-f2c treats control-Z characters (ASCII 26, '\x1a') that appear at the
-beginning of a line as an end-of-file indicator.  You can disable this
-test by compiling lex.c with NO_EOF_CHAR_CHECK #defined, or can
-change control-Z to some other character by #defining EOF_CHAR to
-be the desired value.
-
-
-If your machine has IEEE, VAX, or IBM-mainframe arithmetic, but your
-printf is inaccurate (e.g., with Symantec C++ version 6.0,
-printf("%.17g",12.) prints 12.000000000000001), you can make f2c print
-correctly rounded numbers by compiling with -DUSE_DTOA and adding
-dtoa.o g_fmt.o to the makefile's OBJECTS = line, so it becomes
-
-	OBJECTS = $(OBJECTSd) malloc.o dtoa.o g_fmt.o
-
-Also add the rule
-
-	dtoa.o: dtoa.c
-		$(CC) -c $(CFLAGS) -DMALLOC=ckalloc -DIEEE... dtoa.c
-
-(without the initial tab) to the makefile, where IEEE... is one of
-IEEE_MC68k, IEEE_8087, VAX, or IBM, depending on your machine's
-arithmetic.  See the comments near the start of dtoa.c.
-
-The relevant source files, dtoa.c and g_fmt.c, are available
-separately from netlib's fp directory.  For example, you could
-send the E-mail message
-
-	send dtoa.c g_fmt.c from fp
-
-to netlib@netlib.bell-labs.com (or use anonymous ftp from
-netlib.bell-labs.com and look in directory /netlib/fp).
-
-The makefile has a rule for creating tokdefs.h.  If you cannot use the
-makefile, an alternative is to extract tokdefs.h from the beginning of
-gram.c: it's the first 100 lines.
-
-File mem.c has #ifdef CRAY lines that are appropriate for machines
-with the conventional CRAY architecture, but not for "Cray" machines
-based on DEC Alpha chips, such as the T3E; on such machines, you may
-need to make a suitable adjustment, e.g., add #undef CRAY to sysdep.h.
-
-
-Please send bug reports to dmg@bell-labs.com .  The old index file
-(now called "readme" due to unfortunate changes in netlib conventions:
-"send readme from f2c") will report recent changes in the recent-change
-log at its end; all changes will be shown in the "changes" file
-("send changes from f2c").  To keep current source, you will need to
-request xsum0.out and version.c, in addition to the changed source
-files.  Changes first appear on netlib@netlib.bell-labs.com, and in due
-time propagate to the other netlib sites that are kept current.
diff --git a/usr.bin/f2c/cds.c b/usr.bin/f2c/cds.c
deleted file mode 100644
index e5bacaa..0000000
--- a/usr.bin/f2c/cds.c
+++ /dev/null
@@ -1,195 +0,0 @@
-/****************************************************************
-Copyright 1990, 1993, 1994 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-/* Put strings representing decimal floating-point numbers
- * into canonical form: always have a decimal point or
- * exponent field; if using an exponent field, have the
- * number before it start with a digit and decimal point
- * (if the number has more than one digit); only have an
- * exponent field if it saves space.
- *
- * Arrange that the return value, rv, satisfies rv[0] == '-' || rv[-1] == '-' .
- */
-
-#include "defs.h"
-
- char *
-#ifdef KR_headers
-cds(s, z0)
-	char *s;
-	char *z0;
-#else
-cds(char *s, char *z0)
-#endif
-{
-	int ea, esign, et, i, k, nd = 0, sign = 0, tz;
-	char c, *z;
-	char ebuf[24];
-	long ex = 0;
-	static char etype[Table_size], *db;
-	static int dblen = 64;
-
-	if (!db) {
-		etype['E'] = 1;
-		etype['e'] = 1;
-		etype['D'] = 1;
-		etype['d'] = 1;
-		etype['+'] = 2;
-		etype['-'] = 3;
-		db = Alloc(dblen);
-		}
-
-	while((c = *s++) == '0');
-	if (c == '-')
-		{ sign = 1; c = *s++; }
-	else if (c == '+')
-		c = *s++;
-	k = strlen(s) + 2;
-	if (k >= dblen) {
-		do dblen <<= 1;
-			while(k >= dblen);
-		free(db);
-		db = Alloc(dblen);
-		}
-	if (etype[(unsigned char)c] >= 2)
-		while(c == '0') c = *s++;
-	tz = 0;
-	while(c >= '0' && c <= '9') {
-		if (c == '0')
-			tz++;
-		else {
-			if (nd)
-				for(; tz; --tz)
-					db[nd++] = '0';
-			else
-				tz = 0;
-			db[nd++] = c;
-			}
-		c = *s++;
-		}
-	ea = -tz;
-	if (c == '.') {
-		while((c = *s++) >= '0' && c <= '9') {
-			if (c == '0')
-				tz++;
-			else {
-				if (tz) {
-					ea += tz;
-					if (nd)
-						for(; tz; --tz)
-							db[nd++] = '0';
-					else
-						tz = 0;
-					}
-				db[nd++] = c;
-				ea++;
-				}
-			}
-		}
-	if (et = etype[(unsigned char)c]) {
-		esign = et == 3;
-		c = *s++;
-		if (et == 1) {
-			if(etype[(unsigned char)c] > 1) {
-				if (c == '-')
-					esign = 1;
-				c = *s++;
-				}
-			}
-		while(c >= '0' && c <= '9') {
-			ex = 10*ex + (c - '0');
-			c = *s++;
-			}
-		if (esign)
-			ex = -ex;
-		}
-	switch(c) {
-		case 0:
-			break;
-#ifndef VAX
-		case 'i':
-		case 'I':
-			Fatal("Overflow evaluating constant expression.");
-		case 'n':
-		case 'N':
-			Fatal("Constant expression yields NaN.");
-#endif
-		default:
-			Fatal("unexpected character in cds.");
-		}
-	ex -= ea;
-	if (!nd) {
-		if (!z0)
-			z0 = mem(4,0);
-		strcpy(z0, "-0.");
-		sign = 0;
-		}
-	else if (ex > 2 || ex + nd < -2) {
-		sprintf(ebuf, "%ld", ex + nd - 1);
-		k = strlen(ebuf) + nd + 3;
-		if (nd > 1)
-			k++;
-		if (!z0)
-			z0 = mem(k,0);
-		z = z0;
-		*z++ = '-';
-		*z++ = *db;
-		if (nd > 1) {
-			*z++ = '.';
-			for(k = 1; k < nd; k++)
-				*z++ = db[k];
-			}
-		*z++ = 'e';
-		strcpy(z, ebuf);
-		}
-	else {
-		k = (int)(ex + nd);
-		i = nd + 3;
-		if (k < 0)
-			i -= k;
-		else if (ex > 0)
-			i += ex;
-		if (!z0)
-			z0 = mem(i,0);
-		z = z0;
-		*z++ = '-';
-		if (ex >= 0) {
-			for(k = 0; k < nd; k++)
-				*z++ = db[k];
-			while(--ex >= 0)
-				*z++ = '0';
-			*z++ = '.';
-			}
-		else {
-			for(i = 0; i < k;)
-				*z++ = db[i++];
-			*z++ = '.';
-			while(++k <= 0)
-				*z++ = '0';
-			while(i < nd)
-				*z++ = db[i++];
-			}
-		*z = 0;
-		}
-	return sign ? z0 : z0+1;
-	}
diff --git a/usr.bin/f2c/data.c b/usr.bin/f2c/data.c
deleted file mode 100644
index 7454039..0000000
--- a/usr.bin/f2c/data.c
+++ /dev/null
@@ -1,493 +0,0 @@
-/****************************************************************
-Copyright 1990, 1993 - 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-
-/* ROUTINES CALLED DURING DATA AND PARAMETER STATEMENT PROCESSING */
-
-static char datafmt[] = "%s\t%09ld\t%d";
-static char *cur_varname;
-
-/* another initializer, called from parser */
- void
-#ifdef KR_headers
-dataval(repp, valp)
-	register expptr repp;
-	register expptr valp;
-#else
-dataval(register expptr repp, register expptr valp)
-#endif
-{
-	int i, nrep;
-	ftnint elen;
-	register Addrp p;
-
-	if (parstate < INDATA) {
-		frexpr(repp);
-		goto ret;
-		}
-	if(repp == NULL)
-		nrep = 1;
-	else if (ISICON(repp) && repp->constblock.Const.ci >= 0)
-		nrep = repp->constblock.Const.ci;
-	else
-	{
-		err("invalid repetition count in DATA statement");
-		frexpr(repp);
-		goto ret;
-	}
-	frexpr(repp);
-
-	if( ! ISCONST(valp) ) {
-		if (valp->tag == TADDR
-		 && valp->addrblock.uname_tag == UNAM_CONST) {
-			/* kludge */
-			frexpr(valp->addrblock.memoffset);
-			valp->tag = TCONST;
-			}
-		else {
-			err("non-constant initializer");
-			goto ret;
-			}
-		}
-
-	if(toomanyinit) goto ret;
-	for(i = 0 ; i < nrep ; ++i)
-	{
-		p = nextdata(&elen);
-		if(p == NULL)
-		{
-			if (lineno != err_lineno)
-				err("too many initializers");
-			toomanyinit = YES;
-			goto ret;
-		}
-		setdata((Addrp)p, (Constp)valp, elen);
-		frexpr((expptr)p);
-	}
-
-ret:
-	frexpr(valp);
-}
-
-
- Addrp
-#ifdef KR_headers
-nextdata(elenp)
-	ftnint *elenp;
-#else
-nextdata(ftnint *elenp)
-#endif
-{
-	register struct Impldoblock *ip;
-	struct Primblock *pp;
-	register Namep np;
-	register struct Rplblock *rp;
-	tagptr p;
-	expptr neltp;
-	register expptr q;
-	int skip;
-	ftnint off, vlen;
-
-	while(curdtp)
-	{
-		p = (tagptr)curdtp->datap;
-		if(p->tag == TIMPLDO)
-		{
-			ip = &(p->impldoblock);
-			if(ip->implb==NULL || ip->impub==NULL || ip->varnp==NULL)
-				fatali("bad impldoblock 0%o", (int) ip);
-			if(ip->isactive)
-				ip->varvp->Const.ci += ip->impdiff;
-			else
-			{
-				q = fixtype(cpexpr(ip->implb));
-				if( ! ISICON(q) )
-					goto doerr;
-				ip->varvp = (Constp) q;
-
-				if(ip->impstep)
-				{
-					q = fixtype(cpexpr(ip->impstep));
-					if( ! ISICON(q) )
-						goto doerr;
-					ip->impdiff = q->constblock.Const.ci;
-					frexpr(q);
-				}
-				else
-					ip->impdiff = 1;
-
-				q = fixtype(cpexpr(ip->impub));
-				if(! ISICON(q))
-					goto doerr;
-				ip->implim = q->constblock.Const.ci;
-				frexpr(q);
-
-				ip->isactive = YES;
-				rp = ALLOC(Rplblock);
-				rp->rplnextp = rpllist;
-				rpllist = rp;
-				rp->rplnp = ip->varnp;
-				rp->rplvp = (expptr) (ip->varvp);
-				rp->rpltag = TCONST;
-			}
-
-			if( (ip->impdiff>0 && (ip->varvp->Const.ci <= ip->implim))
-			    || (ip->impdiff<0 && (ip->varvp->Const.ci >= ip->implim)) )
-			{ /* start new loop */
-				curdtp = ip->datalist;
-				goto next;
-			}
-
-			/* clean up loop */
-
-			if(rpllist)
-			{
-				rp = rpllist;
-				rpllist = rpllist->rplnextp;
-				free( (charptr) rp);
-			}
-			else
-				Fatal("rpllist empty");
-
-			frexpr((expptr)ip->varvp);
-			ip->isactive = NO;
-			curdtp = curdtp->nextp;
-			goto next;
-		}
-
-		pp = (struct Primblock *) p;
-		np = pp->namep;
-		cur_varname = np->fvarname;
-		skip = YES;
-
-		if(p->primblock.argsp==NULL && np->vdim!=NULL)
-		{   /* array initialization */
-			q = (expptr) mkaddr(np);
-			off = typesize[np->vtype] * curdtelt;
-			if(np->vtype == TYCHAR)
-				off *= np->vleng->constblock.Const.ci;
-			q->addrblock.memoffset =
-			    mkexpr(OPPLUS, q->addrblock.memoffset, mkintcon(off) );
-			if( (neltp = np->vdim->nelt) && ISCONST(neltp))
-			{
-				if(++curdtelt < neltp->constblock.Const.ci)
-					skip = NO;
-			}
-			else
-				err("attempt to initialize adjustable array");
-		}
-		else
-			q = mklhs((struct Primblock *)cpexpr((expptr)pp), 0);
-		if(skip)
-		{
-			curdtp = curdtp->nextp;
-			curdtelt = 0;
-		}
-		if(q->headblock.vtype == TYCHAR)
-			if(ISICON(q->headblock.vleng))
-				*elenp = q->headblock.vleng->constblock.Const.ci;
-			else	{
-				err("initialization of string of nonconstant length");
-				continue;
-			}
-		else	*elenp = typesize[q->headblock.vtype];
-
-		if (np->vstg == STGBSS) {
-			vlen = np->vtype==TYCHAR
-				? np->vleng->constblock.Const.ci
-				: typesize[np->vtype];
-			if(vlen > 0)
-				np->vstg = STGINIT;
-			}
-		return( (Addrp) q );
-
-doerr:
-		err("nonconstant implied DO parameter");
-		frexpr(q);
-		curdtp = curdtp->nextp;
-
-next:
-		curdtelt = 0;
-	}
-
-	return(NULL);
-}
-
-
-
-LOCAL FILEP dfile;
-
- void
-#ifdef KR_headers
-setdata(varp, valp, elen)
-	register Addrp varp;
-	register Constp valp;
-	ftnint elen;
-#else
-setdata(register Addrp varp, register Constp valp, ftnint elen)
-#endif
-{
-	struct Constblock con;
-	register int type;
-	int i, k, valtype;
-	ftnint offset;
-	char *varname;
-	static Addrp badvar;
-	register unsigned char *s;
-	static int last_lineno;
-	static char *last_varname;
-
-	if (varp->vstg == STGCOMMON) {
-		if (!(dfile = blkdfile))
-			dfile = blkdfile = opf(blkdfname, textwrite);
-		}
-	else {
-		if (procclass == CLBLOCK) {
-			if (varp != badvar) {
-				badvar = varp;
-				warn1("%s is not in a COMMON block",
-					varp->uname_tag == UNAM_NAME
-					? varp->user.name->fvarname
-					: "???");
-				}
-			return;
-			}
-		if (!(dfile = initfile))
-			dfile = initfile = opf(initfname, textwrite);
-		}
-	varname = dataname(varp->vstg, varp->memno);
-	offset = varp->memoffset->constblock.Const.ci;
-	type = varp->vtype;
-	valtype = valp->vtype;
-	if(type!=TYCHAR && valtype==TYCHAR)
-	{
-		if(! ftn66flag
-		&& (last_varname != cur_varname || last_lineno != lineno)) {
-			/* prevent multiple warnings */
-			last_lineno = lineno;
-			warn1(
-	"non-character datum %.42s initialized with character string",
-				last_varname = cur_varname);
-			}
-		varp->vleng = ICON(typesize[type]);
-		varp->vtype = type = TYCHAR;
-	}
-	else if( (type==TYCHAR && valtype!=TYCHAR) ||
-	    (cktype(OPASSIGN,type,valtype) == TYERROR) )
-	{
-		err("incompatible types in initialization");
-		return;
-	}
-	if(type == TYADDR)
-		con.Const.ci = valp->Const.ci;
-	else if(type != TYCHAR)
-	{
-		if(valtype == TYUNKNOWN)
-			con.Const.ci = valp->Const.ci;
-		else	consconv(type, &con, valp);
-	}
-
-	k = 1;
-
-	switch(type)
-	{
-	case TYLOGICAL:
-	case TYINT1:
-	case TYLOGICAL1:
-	case TYLOGICAL2:
-	case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-		dataline(varname, offset, type);
-		prconi(dfile, con.Const.ci);
-		break;
-
-	case TYADDR:
-		dataline(varname, offset, type);
-		prcona(dfile, con.Const.ci);
-		break;
-
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-		k = 2;
-	case TYREAL:
-	case TYDREAL:
-		dataline(varname, offset, type);
-		prconr(dfile, &con, k);
-		break;
-
-	case TYCHAR:
-		k = valp -> vleng -> constblock.Const.ci;
-		if (elen < k)
-			k = elen;
-		s = (unsigned char *)valp->Const.ccp;
-		for(i = 0 ; i < k ; ++i) {
-			dataline(varname, offset++, TYCHAR);
-			fprintf(dfile, "\t%d\n", *s++);
-			}
-		k = elen - valp->vleng->constblock.Const.ci;
-		if(k > 0) {
-			dataline(varname, offset, TYBLANK);
-			fprintf(dfile, "\t%d\n", k);
-			}
-		break;
-
-	default:
-		badtype("setdata", type);
-	}
-
-}
-
-
-
-/*
-   output form of name is padded with blanks and preceded
-   with a storage class digit
-*/
- char*
-#ifdef KR_headers
-dataname(stg, memno)
-	int stg;
-	long memno;
-#else
-dataname(int stg, long memno)
-#endif
-{
-	static char varname[64];
-	register char *s, *t;
-	char buf[16];
-
-	if (stg == STGCOMMON) {
-		varname[0] = '2';
-		sprintf(s = buf, "Q.%ld", memno);
-		}
-	else {
-		varname[0] = stg==STGEQUIV ? '1' : '0';
-		s = memname(stg, memno);
-		}
-	t = varname + 1;
-	while(*t++ = *s++);
-	*t = 0;
-	return(varname);
-}
-
-
-
-
- void
-#ifdef KR_headers
-frdata(p0)
-	chainp p0;
-#else
-frdata(chainp p0)
-#endif
-{
-	register struct Chain *p;
-	register tagptr q;
-
-	for(p = p0 ; p ; p = p->nextp)
-	{
-		q = (tagptr)p->datap;
-		if(q->tag == TIMPLDO)
-		{
-			if(q->impldoblock.isbusy)
-				return;	/* circular chain completed */
-			q->impldoblock.isbusy = YES;
-			frdata(q->impldoblock.datalist);
-			free( (charptr) q);
-		}
-		else
-			frexpr(q);
-	}
-
-	frchain( &p0);
-}
-
-
- void
-#ifdef KR_headers
-dataline(varname, offset, type)
-	char *varname;
-	ftnint offset;
-	int type;
-#else
-dataline(char *varname, ftnint offset, int type)
-#endif
-{
-	fprintf(dfile, datafmt, varname, offset, type);
-}
-
- void
-#ifdef KR_headers
-make_param(p, e)
-	register struct Paramblock *p;
-	expptr e;
-#else
-make_param(register struct Paramblock *p, expptr e)
-#endif
-{
-	register expptr q;
-	Constp qc;
-
-	if (p->vstg == STGARG)
-		errstr("Dummy argument %.50s appears in a parameter statement.",
-			p->fvarname);
-	p->vclass = CLPARAM;
-	impldcl((Namep)p);
-	if (e->headblock.vtype != TYCHAR)
-		e = putx(fixtype(e));
-	p->paramval = q = mkconv(p->vtype, e);
-	if (p->vtype == TYCHAR) {
-		if (q->tag == TEXPR)
-			p->paramval = q = fixexpr((Exprp)q);
-		if (q->tag == TADDR && q->addrblock.uname_tag == UNAM_CONST) {
-			qc = mkconst(TYCHAR);
-			qc->Const = q->addrblock.user.Const;
-			qc->vleng = q->addrblock.vleng;
-			q->addrblock.vleng = 0;
-			frexpr(q);
-			p->paramval = q = (expptr)qc;
-			}
-		if (!ISCONST(q) || q->constblock.vtype != TYCHAR) {
-			errstr("invalid value for character parameter %s",
-				p->fvarname);
-			return;
-			}
-		if (!(e = p->vleng))
-			p->vleng = ICON(q->constblock.vleng->constblock.Const.ci
-					+ q->constblock.Const.ccp1.blanks);
-		else if (q->constblock.vleng->constblock.Const.ci
-				> e->constblock.Const.ci) {
-			q->constblock.vleng->constblock.Const.ci
-				= e->constblock.Const.ci;
-			q->constblock.Const.ccp1.blanks = 0;
-			}
-		else
-			q->constblock.Const.ccp1.blanks
-				= e->constblock.Const.ci
-				- q->constblock.vleng->constblock.Const.ci;
-		}
-	}
diff --git a/usr.bin/f2c/defines.h b/usr.bin/f2c/defines.h
deleted file mode 100644
index 1ed4537..0000000
--- a/usr.bin/f2c/defines.h
+++ /dev/null
@@ -1,300 +0,0 @@
-#define PDP11 4
-
-#define BIGGEST_CHAR	0x7f		/* Assumes 32-bit arithmetic */
-#define BIGGEST_SHORT	0x7fff		/* Assumes 32-bit arithmetic */
-#define BIGGEST_LONG	0x7fffffff	/* Assumes 32-bit arithmetic */
-
-#define M(x) (1<<x)	/* Mask (x) returns 2^x */
-
-#define ALLOC(x)	(struct x *) ckalloc((int)sizeof(struct x))
-#define ALLEXPR		(expptr) ckalloc((int)sizeof(union Expression) )
-typedef int *ptr;
-typedef char *charptr;
-typedef FILE *FILEP;
-typedef int flag;
-typedef char field;	/* actually need only 4 bits */
-typedef long int ftnint;
-#define LOCAL static
-
-#define NO 0
-#define YES 1
-
-#define CNULL (char *) 0	/* Character string null */
-#define PNULL (ptr) 0
-#define CHNULL (chainp) 0	/* Chain null */
-#define ENULL (expptr) 0
-
-
-/* BAD_MEMNO - used to distinguish between long string constants and other
-   constants in the table */
-
-#define BAD_MEMNO -32768
-
-
-/* block tag values -- syntactic stuff */
-
-#define TNAME 1
-#define TCONST 2
-#define TEXPR 3
-#define TADDR 4
-#define TPRIM 5		/* Primitive datum - should not appear in an
-			   expptr variable, it should have already been
-			   identified */
-#define TLIST 6
-#define TIMPLDO 7
-#define TERROR 8
-
-
-/* parser states - order is important, since there are several tests for
-   state < INDATA   */
-
-#define OUTSIDE 0
-#define INSIDE 1
-#define INDCL 2
-#define INDATA 3
-#define INEXEC 4
-
-/* procedure classes */
-
-#define PROCMAIN 1
-#define PROCBLOCK 2
-#define PROCSUBR 3
-#define PROCFUNCT 4
-
-
-/* storage classes -- vstg values.  BSS and INIT are used in the later
-   merge pass over identifiers; and they are entered differently into the
-   symbol table */
-
-#define STGUNKNOWN 0
-#define STGARG 1	/* adjustable dimensions */
-#define STGAUTO 2	/* for stack references */
-#define STGBSS 3	/* uninitialized storage (normal variables) */
-#define STGINIT 4	/* initialized storage */
-#define STGCONST 5
-#define STGEXT 6	/* external storage */
-#define STGINTR 7	/* intrinsic (late decision) reference.  See
-			   chapter 5 of the Fortran 77 standard */
-#define STGSTFUNCT 8
-#define STGCOMMON 9
-#define STGEQUIV 10
-#define STGREG 11	/* register - the outermost DO loop index will be
-			   in a register (because the compiler is one
-			   pass, it can't know where the innermost loop is
-			   */
-#define STGLENG 12
-#define STGNULL 13
-#define STGMEMNO 14	/* interemediate-file pointer to constant table */
-
-/* name classes -- vclass values, also   procclass   values */
-
-#define CLUNKNOWN 0
-#define CLPARAM 1	/* Parameter - macro definition */
-#define CLVAR 2		/* variable */
-#define CLENTRY 3
-#define CLMAIN 4
-#define CLBLOCK 5
-#define CLPROC 6
-#define CLNAMELIST 7	/* in data with this tag, the   vdcldone   flag should
-			   be ignored (according to vardcl()) */
-
-
-/* vprocclass values -- there is some overlap with the vclass values given
-   above */
-
-#define PUNKNOWN 0
-#define PEXTERNAL 1
-#define PINTRINSIC 2
-#define PSTFUNCT 3
-#define PTHISPROC 4	/* here to allow recursion - further distinction
-			   is given in the CL tag (those just above).
-			   This applies to the presence of the name of a
-			   function used within itself.  The function name
-			   means either call the function again, or assign
-			   some value to the storage allocated to the
-			   function's return value. */
-
-/* control stack codes - these are part of a state machine which handles
-   the nesting of blocks (i.e. what to do about the ELSE statement) */
-
-#define CTLDO 1
-#define CTLIF 2
-#define CTLELSE 3
-#define CTLIFX 4
-
-
-/* operators for both Fortran input and C output.  They are common because
-   so many are shared between the trees */
-
-#define OPPLUS 1
-#define OPMINUS 2
-#define OPSTAR 3
-#define OPSLASH 4
-#define OPPOWER 5
-#define OPNEG 6
-#define OPOR 7
-#define OPAND 8
-#define OPEQV 9
-#define OPNEQV 10
-#define OPNOT 11
-#define OPCONCAT 12
-#define OPLT 13
-#define OPEQ 14
-#define OPGT 15
-#define OPLE 16
-#define OPNE 17
-#define OPGE 18
-#define OPCALL 19
-#define OPCCALL 20
-#define OPASSIGN 21
-#define OPPLUSEQ 22
-#define OPSTAREQ 23
-#define OPCONV 24
-#define OPLSHIFT 25
-#define OPMOD 26
-#define OPCOMMA 27
-#define OPQUEST 28
-#define OPCOLON 29
-#define OPABS 30
-#define OPMIN 31
-#define OPMAX 32
-#define OPADDR 33
-#define OPCOMMA_ARG 34
-#define OPBITOR 35
-#define OPBITAND 36
-#define OPBITXOR 37
-#define OPBITNOT 38
-#define OPRSHIFT 39
-#define OPWHATSIN 40		/* dereferencing operator */
-#define OPMINUSEQ 41		/* assignment operators */
-#define OPSLASHEQ 42
-#define OPMODEQ 43
-#define OPLSHIFTEQ 44
-#define OPRSHIFTEQ 45
-#define OPBITANDEQ 46
-#define OPBITXOREQ 47
-#define OPBITOREQ 48
-#define OPPREINC 49		/* Preincrement (++x) operator */
-#define OPPREDEC 50		/* Predecrement (--x) operator */
-#define OPDOT 51		/* structure field reference */
-#define OPARROW 52		/* structure pointer field reference */
-#define OPNEG1 53		/* simple negation under forcedouble */
-#define OPDMIN 54		/* min(a,b) macro under forcedouble */
-#define OPDMAX 55		/* max(a,b) macro under forcedouble */
-#define OPASSIGNI 56		/* assignment for inquire stmt */
-#define OPIDENTITY 57		/* for turning TADDR into TEXPR */
-#define OPCHARCAST 58		/* for casting to char * (in I/O stmts) */
-#define OPDABS 59		/* abs macro under forcedouble */
-#define OPMIN2 60		/* min(a,b) macro */
-#define OPMAX2 61		/* max(a,b) macro */
-#define OPBITTEST 62		/* btest */
-#define OPBITCLR 63		/* ibclr */
-#define OPBITSET 64		/* ibset */
-#define OPQBITCLR 65		/* ibclr, integer*8 */
-#define OPQBITSET 66		/* ibset, integer*8 */
-#define OPBITBITS 67		/* ibits */
-#define OPBITSH 68		/* ishft */
-#define OPBITSHC 69		/* ishftc */
-
-/* label type codes -- used with the ASSIGN statement */
-
-#define LABUNKNOWN 0
-#define LABEXEC 1
-#define LABFORMAT 2
-#define LABOTHER 3
-
-
-/* INTRINSIC function codes*/
-
-#define INTREND 0
-#define INTRCONV 1
-#define INTRMIN 2
-#define INTRMAX 3
-#define INTRGEN 4	/* General intrinsic, e.g. cos v. dcos, zcos, ccos */
-#define INTRSPEC 5
-#define INTRBOOL 6
-#define INTRCNST 7	/* constants, e.g. bigint(1.0) v. bigint (1d0) */
-#define INTRBGEN 8	/* bit manipulation */
-
-
-/* I/O statement codes - these all form Integer Constants, and are always
-   reevaluated */
-
-#define IOSTDIN ICON(5)
-#define IOSTDOUT ICON(6)
-#define IOSTDERR ICON(0)
-
-#define IOSBAD (-1)
-#define IOSPOSITIONAL 0
-#define IOSUNIT 1
-#define IOSFMT 2
-
-#define IOINQUIRE 1
-#define IOOPEN 2
-#define IOCLOSE 3
-#define IOREWIND 4
-#define IOBACKSPACE 5
-#define IOENDFILE 6
-#define IOREAD 7
-#define IOWRITE 8
-
-
-/* User name tags -- these identify the form of the original identifier
-   stored in a   struct Addrblock   structure (in the   user   field). */
-
-#define UNAM_UNKNOWN 0		/* Not specified */
-#define UNAM_NAME 1		/* Local symbol, store in the hash table */
-#define UNAM_IDENT 2		/* Character string not stored elsewhere */
-#define UNAM_EXTERN 3		/* External reference; check symbol table
-				   using   memno   as index */
-#define UNAM_CONST 4		/* Constant value */
-#define UNAM_CHARP 5		/* pointer to string */
-#define UNAM_REF 6		/* subscript reference with -s */
-
-
-#define IDENT_LEN 31		/* Maximum length user.ident */
-#define MAXNAMELEN 50		/* Maximum Fortran name length */
-
-/* type masks - TYLOGICAL defined in   ftypes   */
-
-#define MSKLOGICAL	M(TYLOGICAL)|M(TYLOGICAL1)|M(TYLOGICAL2)
-#define MSKADDR	M(TYADDR)
-#define MSKCHAR	M(TYCHAR)
-#ifdef TYQUAD
-#define MSKINT	M(TYINT1)|M(TYSHORT)|M(TYLONG)|M(TYQUAD)
-#else
-#define MSKINT	M(TYINT1)|M(TYSHORT)|M(TYLONG)
-#endif
-#define MSKREAL	M(TYREAL)|M(TYDREAL)	/* DREAL means Double Real */
-#define MSKCOMPLEX	M(TYCOMPLEX)|M(TYDCOMPLEX)
-#define MSKSTATIC (M(STGINIT)|M(STGBSS)|M(STGCOMMON)|M(STGEQUIV)|M(STGCONST))
-
-/* miscellaneous macros */
-
-/* ONEOF (x, y) -- x is the number of one of the OR'ed masks in y (i.e., x is
-   the log of one of the OR'ed masks in y) */
-
-#define ONEOF(x,y) (M(x) & (y))
-#define ISCOMPLEX(z) ONEOF(z, MSKCOMPLEX)
-#define ISREAL(z) ONEOF(z, MSKREAL)
-#define ISNUMERIC(z) ONEOF(z, MSKINT|MSKREAL|MSKCOMPLEX)
-#define ISICON(z) (z->tag==TCONST && ISINT(z->constblock.vtype))
-#define ISLOGICAL(z) ONEOF(z, MSKLOGICAL)
-
-/* ISCHAR assumes that   z   has some kind of structure, i.e. is not null */
-
-#define ISCHAR(z) (z->headblock.vtype==TYCHAR)
-#define ISINT(z)   ONEOF(z, MSKINT)	/*   z   is a tag, i.e. a mask number */
-#define ISCONST(z) (z->tag==TCONST)
-#define ISERROR(z) (z->tag==TERROR)
-#define ISPLUSOP(z) (z->tag==TEXPR && z->exprblock.opcode==OPPLUS)
-#define ISSTAROP(z) (z->tag==TEXPR && z->exprblock.opcode==OPSTAR)
-#define ISONE(z) (ISICON(z) && z->constblock.Const.ci==1)
-#define INT(z) ONEOF(z, MSKINT|MSKCHAR)	/* has INT storage in real life */
-#define ICON(z) mkintcon( (ftnint)(z) )
-
-/* NO66 -- F77 feature is being used
-   NOEXT -- F77 extension is being used */
-
-#define NO66(s)	if(no66flag) err66(s)
-#define NOEXT(s)	if(noextflag) errext(s)
diff --git a/usr.bin/f2c/defs.h b/usr.bin/f2c/defs.h
deleted file mode 100644
index 2d80862..0000000
--- a/usr.bin/f2c/defs.h
+++ /dev/null
@@ -1,1055 +0,0 @@
-/****************************************************************
-Copyright 1990 - 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "sysdep.h"
-
-#include "ftypes.h"
-#include "defines.h"
-#include "machdefs.h"
-
-#define MAXDIM 20
-#define MAXINCLUDES 10
-#define MAXLITERALS 200		/* Max number of constants in the literal
-				   pool */
-#define MAXCTL 20
-#define MAXHASH 401
-#define MAXSTNO 801
-#define MAXEXT 200
-#define MAXEQUIV 150
-#define MAXLABLIST 258		/* Max number of labels in an alternate
-				   return CALL or computed GOTO */
-#define MAXCONTIN 99		/* Max continuation lines */
-
-/* These are the primary pointer types used in the compiler */
-
-typedef union Expression *expptr, *tagptr;
-typedef struct Chain *chainp;
-typedef struct Addrblock *Addrp;
-typedef struct Constblock *Constp;
-typedef struct Exprblock *Exprp;
-typedef struct Nameblock *Namep;
-
-extern FILEP infile;
-extern FILEP diagfile;
-extern FILEP textfile;
-extern FILEP asmfile;
-extern FILEP c_file;		/* output file for all functions; extern
-				   declarations will have to be prepended */
-extern FILEP pass1_file;	/* Temp file to hold the function bodies
-				   read on pass 1 */
-extern FILEP expr_file;		/* Debugging file */
-extern FILEP initfile;		/* Intermediate data file pointer */
-extern FILEP blkdfile;		/* BLOCK DATA file */
-
-extern int current_ftn_file;
-extern int maxcontin;
-
-extern char *blkdfname, *initfname, *sortfname;
-extern long headoffset;		/* Since the header block requires data we
-				   don't know about until AFTER each
-				   function has been processed, we keep a
-				   pointer to the current (dummy) header
-				   block (at the top of the assembly file)
-				   here */
-
-extern char main_alias[];	/* name given to PROGRAM psuedo-op */
-extern char *token;
-extern int maxtoklen, toklen;
-extern long err_lineno, lineno;
-extern char *infname;
-extern int needkwd;
-extern struct Labelblock *thislabel;
-
-/* Used to allow runtime expansion of internal tables.  In particular,
-   these values can exceed their associated constants */
-
-extern int maxctl;
-extern int maxequiv;
-extern int maxstno;
-extern int maxhash;
-extern int maxext;
-
-extern flag nowarnflag;
-extern flag ftn66flag;		/* Generate warnings when weird f77
-				   features are used (undeclared dummy
-				   procedure, non-char initialized with
-				   string, 1-dim subscript in EQUIV) */
-extern flag no66flag;		/* Generate an error when a generic
-				   function (f77 feature) is used */
-extern flag noextflag;		/* Generate an error when an extension to
-				   Fortran 77 is used (hex/oct/bin
-				   constants, automatic, static, double
-				   complex types) */
-extern flag zflag;		/* enable double complex intrinsics */
-extern flag shiftcase;
-extern flag undeftype;
-extern flag shortsubs;		/* Use short subscripts on arrays? */
-extern flag onetripflag;	/* if true, always execute DO loop body */
-extern flag checksubs;
-extern flag debugflag;
-extern int nerr;
-extern int nwarn;
-
-extern int parstate;
-extern flag headerdone;		/* True iff the current procedure's header
-				   data has been written */
-extern int blklevel;
-extern flag saveall;
-extern flag substars;		/* True iff some formal parameter is an
-				   asterisk */
-extern int impltype[ ];
-extern ftnint implleng[ ];
-extern int implstg[ ];
-
-extern int tycomplex, tyint, tyioint, tyreal;
-extern int tylog, tylogical;	/* TY____ of the implementation of   logical.
-				   This will be LONG unless '-2' is given
-				   on the command line */
-extern int type_choice[];
-extern char *typename[];
-
-extern int typesize[];	/* size (in bytes) of an object of each
-				   type.  Indexed by TY___ macros */
-extern int typealign[];
-extern int proctype;	/* Type of return value in this procedure */
-extern char * procname;	/* External name of the procedure, or last ENTRY name */
-extern int rtvlabel[ ];	/* Return value labels, indexed by TY___ macros */
-extern Addrp retslot;
-extern Addrp xretslot[];
-extern int cxslot;	/* Complex return argument slot (frame pointer offset)*/
-extern int chslot;	/* Character return argument slot (fp offset) */
-extern int chlgslot;	/* Argument slot for length of character buffer */
-extern int procclass;	/* Class of the current procedure:  either CLPROC,
-			   CLMAIN, CLBLOCK or CLUNKNOWN */
-extern ftnint procleng;	/* Length of function return value (e.g. char
-			   string length).  If this is -1, then the length is
-			   not known at compile time */
-extern int nentry;	/* Number of entry points (other than the original
-			   function call) into this procedure */
-extern flag multitype;	/* YES iff there is more than one return value
-			   possible */
-extern int blklevel;
-extern long lastiolabno;
-extern long lastlabno;
-extern int lastvarno;
-extern int lastargslot;	/* integer offset pointing to the next free
-			   location for an argument to the current routine */
-extern int argloc;
-extern int autonum[];		/* for numbering
-				   automatic variables, e.g. temporaries */
-extern int retlabel;
-extern int ret0label;
-extern int dorange;		/* Number of the label which terminates
-				   the innermost DO loop */
-extern int regnum[ ];		/* Numbers of DO indicies named in
-				   regnamep   (below) */
-extern Namep regnamep[ ];	/* List of DO indicies in registers */
-extern int maxregvar;		/* number of elts in   regnamep   */
-extern int highregvar;		/* keeps track of the highest register
-				   number used by DO index allocator */
-extern int nregvar;		/* count of DO indicies in registers */
-
-extern chainp templist[];
-extern int maxdim;
-extern chainp earlylabs;
-extern chainp holdtemps;
-extern struct Entrypoint *entries;
-extern struct Rplblock *rpllist;
-extern struct Chain *curdtp;
-extern ftnint curdtelt;
-extern chainp allargs;		/* union of args in entries */
-extern int nallargs;		/* total number of args */
-extern int nallchargs;		/* total number of character args */
-extern flag toomanyinit;	/* True iff too many initializers in a
-				   DATA statement */
-
-extern flag inioctl;
-extern int iostmt;
-extern Addrp ioblkp;
-extern int nioctl;
-extern int nequiv;
-extern int eqvstart;	/* offset to eqv number to guarantee uniqueness
-			   and prevent <something> from going negative */
-extern int nintnames;
-
-/* Chain of tagged blocks */
-
-struct Chain
-	{
-	chainp nextp;
-	char * datap;		/* Tagged block */
-	};
-
-extern chainp chains;
-
-/* Recall that   field   is intended to hold four-bit characters */
-
-/* This structure exists only to defeat the type checking */
-
-struct Headblock
-	{
-	field tag;
-	field vtype;
-	field vclass;
-	field vstg;
-	expptr vleng;		/* Expression for length of char string -
-				   this may be a constant, or an argument
-				   generated by mkarg() */
-	} ;
-
-/* Control construct info (for do loops, else, etc) */
-
-struct Ctlframe
-	{
-	unsigned ctltype:8;
-	unsigned dostepsign:8;	/* 0 - variable, 1 - pos, 2 - neg */
-	unsigned dowhile:1;
-	int ctlabels[4];	/* Control labels, defined below */
-	int dolabel;		/* label marking end of this DO loop */
-	Namep donamep;		/* DO index variable */
-	expptr doinit;		/* for use with -onetrip */
-	expptr domax;		/* constant or temp variable holding MAX
-				   loop value; or expr of while(expr) */
-	expptr dostep;		/* expression */
-	Namep loopname;
-	};
-#define endlabel ctlabels[0]
-#define elselabel ctlabels[1]
-#define dobodylabel ctlabels[1]
-#define doposlabel ctlabels[2]
-#define doneglabel ctlabels[3]
-extern struct Ctlframe *ctls;		/* Keeps info on DO and BLOCK IF
-					   structures - this is the stack
-					   bottom */
-extern struct Ctlframe *ctlstack;	/* Pointer to current nesting
-					   level */
-extern struct Ctlframe *lastctl;	/* Point to end of
-					   dynamically-allocated array */
-
-typedef struct {
-	int type;
-	chainp cp;
-	} Atype;
-
-typedef struct {
-	int defined, dnargs, nargs, changes;
-	Atype atypes[1];
-	} Argtypes;
-
-/* External Symbols */
-
-struct Extsym
-	{
-	char *fextname;		/* Fortran version of external name */
-	char *cextname;		/* C version of external name */
-	field extstg;		/* STG -- should be COMMON, UNKNOWN or EXT
-				   */
-	unsigned extype:4;	/* for transmitting type to output routines */
-	unsigned used_here:1;	/* Boolean - true on the second pass
-				   through a function if the block has
-				   been referenced */
-	unsigned exused:1;	/* Has been used (for help with error msgs
-				   about externals typed differently in
-				   different modules) */
-	unsigned exproto:1;	/* type specified in a .P file */
-	unsigned extinit:1;	/* Procedure has been defined,
-				   or COMMON has DATA */
-	unsigned extseen:1;	/* True if previously referenced */
-	chainp extp;		/* List of identifiers in the common
-				   block for this function, stored as
-				   Namep (hash table pointers) */
-	chainp allextp;		/* List of lists of identifiers; we keep one
-				   list for each layout of this common block */
-	int curno;		/* current number for this common block,
-				   used for constructing appending _nnn
-				   to the common block name */
-	int maxno;		/* highest curno value for this common block */
-	ftnint extleng;
-	ftnint maxleng;
-	Argtypes *arginfo;
-	};
-typedef struct Extsym Extsym;
-
-extern Extsym *extsymtab;	/* External symbol table */
-extern Extsym *nextext;
-extern Extsym *lastext;
-extern int complex_seen, dcomplex_seen;
-
-/* Statement labels */
-
-struct Labelblock
-	{
-	int labelno;		/* Internal label */
-	unsigned blklevel:8;	/* level of nesting, for branch-in-loop
-				   checking */
-	unsigned labused:1;
-	unsigned fmtlabused:1;
-	unsigned labinacc:1;	/* inaccessible? (i.e. has its scope
-				   vanished) */
-	unsigned labdefined:1;	/* YES or NO */
-	unsigned labtype:2;	/* LAB{FORMAT,EXEC,etc} */
-	ftnint stateno;		/* Original label */
-	char *fmtstring;	/* format string */
-	};
-
-extern struct Labelblock *labeltab;	/* Label table - keeps track of
-					   all labels, including undefined */
-extern struct Labelblock *labtabend;
-extern struct Labelblock *highlabtab;
-
-/* Entry point list */
-
-struct Entrypoint
-	{
-	struct Entrypoint *entnextp;
-	Extsym *entryname;	/* Name of this ENTRY */
-	chainp arglist;
-	int typelabel;			/* Label for function exit; this
-					   will return the proper type of
-					   object */
-	Namep enamep;			/* External name */
-	};
-
-/* Primitive block, or Primary block.  This is a general template returned
-   by the parser, which will be interpreted in context.  It is a template
-   for an identifier (variable name, function name), parenthesized
-   arguments (array subscripts, function parameters) and substring
-   specifications. */
-
-struct Primblock
-	{
-	field tag;
-	field vtype;
-	unsigned parenused:1;		/* distinguish (a) from a */
-	Namep namep;			/* Pointer to structure Nameblock */
-	struct Listblock *argsp;
-	expptr fcharp;			/* first-char-index-pointer (in
-					   substring) */
-	expptr lcharp;			/* last-char-index-pointer (in
-					   substring) */
-	};
-
-
-struct Hashentry
-	{
-	int hashval;
-	Namep varp;
-	};
-extern struct Hashentry *hashtab;	/* Hash table */
-extern struct Hashentry *lasthash;
-
-struct Intrpacked	/* bits for intrinsic function description */
-	{
-	unsigned f1:4;
-	unsigned f2:4;
-	unsigned f3:7;
-	unsigned f4:1;
-	};
-
-struct Nameblock
-	{
-	field tag;
-	field vtype;
-	field vclass;
-	field vstg;
-	expptr vleng;		/* length of character string, if applicable */
-	char *fvarname;		/* name in the Fortran source */
-	char *cvarname;		/* name in the resulting C */
-	chainp vlastdim;	/* datap points to new_vars entry for the */
-				/* system variable, if any, storing the final */
-				/* dimension; we zero the datap if this */
-				/* variable is needed */
-	unsigned vprocclass:3;	/* P____ macros - selects the   varxptr
-				   field below */
-	unsigned vdovar:1;	/* "is it a DO variable?" for register
-				   and multi-level loop	checking */
-	unsigned vdcldone:1;	/* "do I think I'm done?" - set when the
-				   context is sufficient to determine its
-				   status */
-	unsigned vadjdim:1;	/* "adjustable dimension?" - needed for
-				   information about copies */
-	unsigned vsave:1;
-	unsigned vimpldovar:1;	/* used to prevent erroneous error messages
-				   for variables used only in DATA stmt
-				   implicit DOs */
-	unsigned vis_assigned:1;/* True if this variable has had some
-				   label ASSIGNED to it; hence
-				   varxptr.assigned_values is valid */
-	unsigned vimplstg:1;	/* True if storage type is assigned implicitly;
-				   this allows a COMMON variable to participate
-				   in a DIMENSION before the COMMON declaration.
-				   */
-	unsigned vcommequiv:1;	/* True if EQUIVALENCEd onto STGCOMMON */
-	unsigned vfmt_asg:1;	/* True if char *var_fmt needed */
-	unsigned vpassed:1;	/* True if passed as a character-variable arg */
-	unsigned vknownarg:1;	/* True if seen in a previous entry point */
-	unsigned visused:1;	/* True if variable is referenced -- so we */
-				/* can omit variables that only appear in DATA */
-	unsigned vnamelist:1;	/* Appears in a NAMELIST */
-	unsigned vimpltype:1;	/* True if implicitly typed and not
-				   invoked as a function or subroutine
-				   (so we can consistently type procedures
-				   declared external and passed as args
-				   but never invoked).
-				   */
-	unsigned vtypewarned:1;	/* so we complain just once about
-				   changed types of external procedures */
-	unsigned vinftype:1;	/* so we can restore implicit type to a
-				   procedure if it is invoked as a function
-				   after being given a different type by -it */
-	unsigned vinfproc:1;	/* True if -it infers this to be a procedure */
-	unsigned vcalled:1;	/* has been invoked */
-	unsigned vdimfinish:1;	/* need to invoke dim_finish() */
-	unsigned vrefused:1;	/* Need to #define name_ref (for -s) */
-	unsigned vsubscrused:1;	/* Need to #define name_subscr (for -2) */
-	unsigned veqvadjust:1;	/* voffset has been adjusted for equivalence */
-
-/* The   vardesc   union below is used to store the number of an intrinsic
-   function (when vstg == STGINTR and vprocclass == PINTRINSIC), or to
-   store the index of this external symbol in   extsymtab   (when vstg ==
-   STGEXT and vprocclass == PEXTERNAL) */
-
-	union	{
-		int varno;		/* Return variable for a function.
-					   This is used when a function is
-					   assigned a return value.  Also
-					   used to point to the COMMON
-					   block, when this is a field of
-					   that block.  Also points to
-					   EQUIV block when STGEQUIV */
-		struct Intrpacked intrdesc;	/* bits for intrinsic function*/
-		} vardesc;
-	struct Dimblock *vdim;	/* points to the dimensions if they exist */
-	ftnint voffset;		/* offset in a storage block (the variable
-				   name will be "v.%d", voffset in a
-				   common blck on the vax).  Also holds
-				   pointers for automatic variables.  When
-				   STGEQUIV, this is -(offset from array
-				   base) */
-	union	{
-		chainp namelist;	/* points to names in the NAMELIST,
-					   if this is a NAMELIST name */
-		chainp vstfdesc;	/* points to (formals, expr) pair */
-		chainp assigned_values;	/* list of integers, each being a
-					   statement label assigned to
-					   this variable in the current function */
-		} varxptr;
-	int argno;		/* for multiple entries */
-	Argtypes *arginfo;
-	};
-
-
-/* PARAMETER statements */
-
-struct Paramblock
-	{
-	field tag;
-	field vtype;
-	field vclass;
-	field vstg;
-	expptr vleng;
-	char *fvarname;
-	char *cvarname;
-	expptr paramval;
-	} ;
-
-
-/* Expression block */
-
-struct Exprblock
-	{
-	field tag;
-	field vtype;
-	field vclass;
-	field vstg;
-	expptr vleng;		/* in the case of a character expression, this
-				   value is inherited from the children */
-	unsigned opcode;
-	expptr leftp;
-	expptr rightp;
-	int typefixed;
-	};
-
-
-union Constant
-	{
-	struct {
-		char *ccp0;
-		ftnint blanks;
-		} ccp1;
-	ftnint ci;		/* Constant longeger */
-	double cd[2];
-	char *cds[2];
-	};
-#define ccp ccp1.ccp0
-
-struct Constblock
-	{
-	field tag;
-	field vtype;
-	field vclass;
-	field vstg;		/* vstg = 1 when using Const.cds */
-	expptr vleng;
-	union Constant Const;
-	};
-
-
-struct Listblock
-	{
-	field tag;
-	field vtype;
-	chainp listp;
-	};
-
-
-
-/* Address block - this is the FINAL form of identifiers before being
-   sent to pass 2.  We'll want to add the original identifier here so that it can
-   be preserved in the translation.
-
-   An example identifier is q.7.  The "q" refers to the storage class
-   (field vstg), the 7 to the variable number (int memno). */
-
-struct Addrblock
-	{
-	field tag;
-	field vtype;
-	field vclass;
-	field vstg;
-	expptr vleng;
-	/* put union...user here so the beginning of an Addrblock
-	 * is the same as a Constblock.
-	 */
-	union {
-	    Namep name;		/* contains a pointer into the hash table */
-	    char ident[IDENT_LEN + 1];	/* C string form of identifier */
-	    char *Charp;
-	    union Constant Const;	/* Constant value */
-	    struct {
-		double dfill[2];
-		field vstg1;
-		} kludge;	/* so we can distinguish string vs binary
-				 * floating-point constants */
-	} user;
-	long memno;		/* when vstg == STGCONST, this is the
-				   numeric part of the assembler label
-				   where the constant value is stored */
-	expptr memoffset;	/* used in subscript computations, usually */
-	unsigned istemp:1;	/* used in stack management of temporary
-				   variables */
-	unsigned isarray:1;	/* used to show that memoffset is
-				   meaningful, even if zero */
-	unsigned ntempelt:10;	/* for representing temporary arrays, as
-				   in concatenation */
-	unsigned dbl_builtin:1;	/* builtin to be declared double */
-	unsigned charleng:1;	/* so saveargtypes can get i/o calls right */
-	unsigned cmplx_sub:1;	/* used in complex arithmetic under -s */
-	unsigned skip_offset:1;	/* used in complex arithmetic under -s */
-	unsigned parenused:1;	/* distinguish (a) from a */
-	ftnint varleng;		/* holds a copy of a constant length which
-				   is stored in the   vleng   field (e.g.
-				   a double is 8 bytes) */
-	int uname_tag;		/* Tag describing which of the unions()
-				   below to use */
-	char *Field;		/* field name when dereferencing a struct */
-}; /* struct Addrblock */
-
-
-/* Errorbock - placeholder for errors, to allow the compilation to
-   continue */
-
-struct Errorblock
-	{
-	field tag;
-	field vtype;
-	};
-
-
-/* Implicit DO block, especially related to DATA statements.  This block
-   keeps track of the compiler's location in the implicit DO while it's
-   running.  In particular, the   isactive and isbusy   flags tell where
-   it is */
-
-struct Impldoblock
-	{
-	field tag;
-	unsigned isactive:1;
-	unsigned isbusy:1;
-	Namep varnp;
-	Constp varvp;
-	chainp impdospec;
-	expptr implb;
-	expptr impub;
-	expptr impstep;
-	ftnint impdiff;
-	ftnint implim;
-	struct Chain *datalist;
-	};
-
-
-/* Each of these components has a first field called   tag.   This union
-   exists just for allocation simplicity */
-
-union Expression
-	{
-	field tag;
-	struct Addrblock addrblock;
-	struct Constblock constblock;
-	struct Errorblock errorblock;
-	struct Exprblock exprblock;
-	struct Headblock headblock;
-	struct Impldoblock impldoblock;
-	struct Listblock listblock;
-	struct Nameblock nameblock;
-	struct Paramblock paramblock;
-	struct Primblock primblock;
-	} ;
-
-
-
-struct Dimblock
-	{
-	int ndim;
-	expptr nelt;		/* This is NULL if the array is unbounded */
-	expptr baseoffset;	/* a constant or local variable holding
-				   the offset in this procedure */
-	expptr basexpr;		/* expression for comuting the offset, if
-				   it's not constant.  If this is
-				   non-null, the register named in
-				   baseoffset will get initialized to this
-				   value in the procedure's prolog */
-	struct
-		{
-		expptr dimsize;	/* constant or register holding the size
-				   of this dimension */
-		expptr dimexpr;	/* as above in basexpr, this is an
-				   expression for computing a variable
-				   dimension */
-		} dims[1];	/* Dimblocks are allocated with enough
-				   space for this to become dims[ndim] */
-	};
-
-
-/* Statement function identifier stack - this holds the name and value of
-   the parameters in a statement function invocation.  For example,
-
-	f(x,y,z)=x+y+z
-		.
-		.
-	y = f(1,2,3)
-
-   generates a stack of depth 3, with <x 1>, <y 2>, <z 3> AT THE INVOCATION, NOT
-   at the definition */
-
-struct Rplblock	/* name replacement block */
-	{
-	struct Rplblock *rplnextp;
-	Namep rplnp;		/* Name of the formal parameter */
-	expptr rplvp;		/* Value of the actual parameter */
-	expptr rplxp;		/* Initialization of temporary variable,
-				   if required; else null */
-	int rpltag;		/* Tag on the value of the actual param */
-	};
-
-
-
-/* Equivalence block */
-
-struct Equivblock
-	{
-	struct Eqvchain *equivs;	/* List (Eqvchain) of primblocks
-					   holding variable identifiers */
-	flag eqvinit;
-	long eqvtop;
-	long eqvbottom;
-	int eqvtype;
-	} ;
-#define eqvleng eqvtop
-
-extern struct Equivblock *eqvclass;
-
-
-struct Eqvchain
-	{
-	struct Eqvchain *eqvnextp;
-	union
-		{
-		struct Primblock *eqvlhs;
-		Namep eqvname;
-		} eqvitem;
-	long eqvoffset;
-	} ;
-
-
-
-/* For allocation purposes only, and to keep lint quiet.  In particular,
-   don't count on the tag being able to tell you which structure is used */
-
-
-/* There is a tradition in Fortran that the compiler not generate the same
-   bit pattern more than is necessary.  This structure is used to do just
-   that; if two integer constants have the same bit pattern, just generate
-   it once.  This could be expanded to optimize without regard to type, by
-   removing the type check in   putconst()   */
-
-struct Literal
-	{
-	short littype;
-	short lituse;		/* usage count */
-	long litnum;			/* numeric part of the assembler
-					   label for this constant value */
-	union	{
-		ftnint litival;
-		double litdval[2];
-		ftnint litival2[2];	/* length, nblanks for strings */
-		} litval;
-	char *cds[2];
-	};
-
-extern struct Literal *litpool;
-extern int maxliterals, nliterals;
-extern char Letters[];
-#define letter(x) Letters[x]
-
-struct Dims { expptr lb, ub; };
-
-extern int forcedouble;		/* force real functions to double */
-extern int doin_setbound;	/* special handling for array bounds */
-extern int Ansi;
-extern char hextoi_tab[];
-#define hextoi(x) hextoi_tab[(x) & 0xff]
-extern char *casttypes[], *ftn_types[], *protorettypes[], *usedcasts[];
-extern int Castargs, infertypes;
-extern FILE *protofile;
-extern char binread[], binwrite[], textread[], textwrite[];
-extern char *ei_first, *ei_last, *ei_next;
-extern char *wh_first, *wh_last, *wh_next;
-extern char *halign, *outbuf, *outbtail;
-extern flag keepsubs;
-#ifdef TYQUAD
-extern flag use_tyquad;
-#endif
-extern int n_keywords;
-extern char *c_keywords[];
-
-#ifdef KR_headers
-#define Argdcl(x) ()
-#define Void /* void */
-#else
-#define Argdcl(x) x
-#define Void void
-#endif
-
-char*	Alloc Argdcl((int));
-char*	Argtype Argdcl((int, char*));
-void	Fatal Argdcl((char*));
-struct	Impldoblock* mkiodo Argdcl((chainp, chainp));
-tagptr	Inline Argdcl((int, int, chainp));
-struct	Labelblock* execlab Argdcl((long));
-struct	Labelblock* mklabel Argdcl((long));
-struct	Listblock* mklist Argdcl((chainp));
-void	Un_link_all Argdcl((int));
-void	add_extern_to_list Argdcl((Addrp, chainp*));
-int	addressable Argdcl((tagptr));
-tagptr	addrof Argdcl((tagptr));
-char*	addunder Argdcl((char*));
-Addrp	autovar Argdcl((int, int, tagptr, char*));
-void	backup Argdcl((char*, char*));
-void	bad_atypes Argdcl((Argtypes*, char*, int, int, int, char*, char*));
-int	badchleng Argdcl((tagptr));
-void	badop Argdcl((char*, int));
-void	badstg Argdcl((char*, int));
-void	badtag Argdcl((char*, int));
-void	badthing Argdcl((char*, char*, int));
-void	badtype Argdcl((char*, int));
-Addrp	builtin Argdcl((int, char*, int));
-char*	c_name Argdcl((char*, int));
-tagptr	call0 Argdcl((int, char*));
-tagptr	call1 Argdcl((int, char*, tagptr));
-tagptr	call2 Argdcl((int, char*, tagptr, tagptr));
-tagptr	call3 Argdcl((int, char*, tagptr, tagptr, tagptr));
-tagptr	call4 Argdcl((int, char*, tagptr, tagptr, tagptr, tagptr));
-tagptr	callk Argdcl((int, char*, chainp));
-void	cast_args Argdcl((int, chainp));
-char*	cds Argdcl((char*, char*));
-void	changedtype Argdcl((Namep));
-ptr	ckalloc Argdcl((int));
-int	cktype Argdcl((int, int, int));
-void	clf Argdcl((FILEP*, char*, int));
-int	cmpstr Argdcl((char*, char*, long, long));
-char*	c_type_decl Argdcl((int, int));
-Extsym*	comblock Argdcl((char*));
-char*	comm_union_name Argdcl((int));
-void	consconv Argdcl((int, Constp, Constp));
-void	consnegop Argdcl((Constp));
-int	conssgn Argdcl((tagptr));
-char*	convic Argdcl((long));
-void	copy_data Argdcl((chainp));
-char*	copyn Argdcl((int, char*));
-char*	copys Argdcl((char*));
-tagptr	cpblock Argdcl((int, char*));
-tagptr	cpexpr Argdcl((tagptr));
-void	cpn Argdcl((int, char*, char*));
-char*	cpstring Argdcl((char*));
-void	dataline Argdcl((char*, long, int));
-char*	dataname Argdcl((int, long));
-void	dataval Argdcl((tagptr, tagptr));
-void	dclerr Argdcl((char*, Namep));
-void	def_commons Argdcl((FILEP));
-void	def_start Argdcl((FILEP, char*, char*, char*));
-void	deregister Argdcl((Namep));
-void	do_uninit_equivs Argdcl((FILEP, ptr));
-void	doequiv(Void);
-int	dofork(Void);
-void	doinclude Argdcl((char*));
-void	doio Argdcl((chainp));
-void	done Argdcl((int));
-void	donmlist(Void);
-int	dsort Argdcl((char*, char*));
-char*	dtos Argdcl((double));
-void	elif_out Argdcl((FILEP, tagptr));
-void	end_else_out Argdcl((FILEP));
-void	enddcl(Void);
-void	enddo Argdcl((int));
-void	endio(Void);
-void	endioctl(Void);
-void	endproc(Void);
-void	entrypt Argdcl((int, int, long, Extsym*, chainp));
-int	eqn Argdcl((int, char*, char*));
-char*	equiv_name Argdcl((int, char*));
-void	err Argdcl((char*));
-void	err66 Argdcl((char*));
-void	errext Argdcl((char*));
-void	erri Argdcl((char*, int));
-void	errl Argdcl((char*, long));
-tagptr	errnode(Void);
-void	errstr Argdcl((char*, char*));
-void	exarif Argdcl((tagptr, struct Labelblock*, struct Labelblock*, struct Labelblock*));
-void	exasgoto Argdcl((Namep));
-void	exassign Argdcl((Namep, struct Labelblock*));
-void	excall Argdcl((Namep, struct Listblock*, int, struct Labelblock**));
-void	exdo Argdcl((int, Namep, chainp));
-void	execerr Argdcl((char*, char*));
-void	exelif Argdcl((tagptr));
-void	exelse(Void);
-void	exenddo Argdcl((Namep));
-void	exendif(Void);
-void	exequals Argdcl((struct Primblock*, tagptr));
-void	exgoto Argdcl((struct Labelblock*));
-void	exif Argdcl((tagptr));
-void	exreturn Argdcl((tagptr));
-void	exstop Argdcl((int, tagptr));
-void	extern_out Argdcl((FILEP, Extsym*));
-void	fatali Argdcl((char*, int));
-void	fatalstr Argdcl((char*, char*));
-void	ffilecopy Argdcl((FILEP, FILEP));
-void	fileinit(Void);
-int	fixargs Argdcl((int, struct Listblock*));
-tagptr	fixexpr Argdcl((Exprp));
-tagptr	fixtype Argdcl((tagptr));
-char*	flconst Argdcl((char*, char*));
-void	flline(Void);
-void	fmt_init(Void);
-void	fmtname Argdcl((Namep, Addrp));
-int	fmtstmt Argdcl((struct Labelblock*));
-tagptr	fold Argdcl((tagptr));
-void	frchain Argdcl((chainp*));
-void	frdata Argdcl((chainp));
-void	freetemps(Void);
-void	freqchain Argdcl((struct Equivblock*));
-void	frexchain Argdcl((chainp*));
-void	frexpr Argdcl((tagptr));
-void	frrpl(Void);
-void	frtemp Argdcl((Addrp));
-char*	gmem Argdcl((int, int));
-void	hashclear(Void);
-chainp	hookup Argdcl((chainp, chainp));
-expptr	imagpart Argdcl((Addrp));
-void	impldcl Argdcl((Namep));
-int	in_vector Argdcl((char*, char**, int));
-void	incomm Argdcl((Extsym*, Namep));
-void	inferdcl Argdcl((Namep, int));
-int	inilex Argdcl((char*));
-void	initkey(Void);
-int	inregister Argdcl((Namep));
-long	int commlen Argdcl((chainp));
-long	int convci Argdcl((int, char*));
-long	int iarrlen Argdcl((Namep));
-long	int lencat Argdcl((expptr));
-long	int lmax Argdcl((long, long));
-long	int lmin Argdcl((long, long));
-long	int wr_char_len Argdcl((FILEP, struct Dimblock*, int, int));
-Addrp	intraddr Argdcl((Namep));
-tagptr	intrcall Argdcl((Namep, struct Listblock*, int));
-int	intrfunct Argdcl((char*));
-void	ioclause Argdcl((int, expptr));
-int	iocname(Void);
-int	is_negatable Argdcl((Constp));
-int	isaddr Argdcl((tagptr));
-int	isnegative_const Argdcl((Constp));
-int	isstatic Argdcl((tagptr));
-chainp	length_comp Argdcl((struct Entrypoint*, int));
-int	lengtype Argdcl((int, long));
-char*	lexline Argdcl((ptr));
-void	list_arg_types Argdcl((FILEP, struct Entrypoint*, chainp, int, char*));
-void	list_decls Argdcl((FILEP));
-void	list_init_data Argdcl((FILE **, char *, FILE *));
-void	listargs Argdcl((FILEP, struct Entrypoint*, int, chainp));
-char*	lit_name Argdcl((struct Literal*));
-int	log_2 Argdcl((long));
-char*	lower_string Argdcl((char*, char*));
-int	main Argdcl((int, char**));
-expptr	make_int_expr Argdcl((expptr));
-void	make_param Argdcl((struct Paramblock*, tagptr));
-void	many Argdcl((char*, char, int));
-void	margin_printf Argdcl((FILEP, char*, ...));
-int	maxtype Argdcl((int, int));
-char*	mem Argdcl((int, int));
-void	mem_init(Void);
-char*	memname Argdcl((int, long));
-Addrp	memversion Argdcl((Namep));
-tagptr	mkaddcon Argdcl((long));
-Addrp	mkaddr Argdcl((Namep));
-Addrp	mkarg Argdcl((int, int));
-tagptr	mkbitcon Argdcl((int, int, char*));
-chainp	mkchain Argdcl((char*, chainp));
-Constp	mkconst Argdcl((int));
-tagptr	mkconv Argdcl((int, tagptr));
-tagptr	mkcxcon Argdcl((tagptr, tagptr));
-tagptr	mkexpr Argdcl((int, tagptr, tagptr));
-Extsym*	mkext Argdcl((char*, char*));
-Extsym*	mkext1 Argdcl((char*, char*));
-Addrp	mkfield Argdcl((Addrp, char*, int));
-tagptr	mkfunct Argdcl((tagptr));
-tagptr	mkintcon Argdcl((long));
-tagptr	mklhs Argdcl((struct Primblock*, int));
-tagptr	mklogcon Argdcl((int));
-Namep	mkname Argdcl((char*));
-Addrp	mkplace Argdcl((Namep));
-tagptr	mkprim Argdcl((Namep, struct Listblock*, chainp));
-tagptr	mkrealcon Argdcl((int, char*));
-Addrp	mkscalar Argdcl((Namep));
-void	mkstfunct Argdcl((struct Primblock*, tagptr));
-tagptr	mkstrcon Argdcl((int, char*));
-Addrp	mktmp Argdcl((int, tagptr));
-Addrp	mktmp0 Argdcl((int, tagptr));
-Addrp	mktmpn Argdcl((int, int, tagptr));
-void	namelist Argdcl((Namep));
-int	ncat Argdcl((expptr));
-void	negate_const Argdcl((Constp));
-void	new_endif(Void);
-Extsym*	newentry Argdcl((Namep, int));
-long	newlabel(Void);
-void	newproc(Void);
-Addrp	nextdata Argdcl((long*));
-void	nice_printf Argdcl((FILEP, char*, ...));
-void	not_both Argdcl((char*));
-void	np_init(Void);
-int	oneof_stg Argdcl((Namep, int, int));
-int	op_assign Argdcl((int));
-tagptr	opconv Argdcl((tagptr, int));
-FILEP	opf Argdcl((char*, char*));
-void	out_addr Argdcl((FILEP, Addrp));
-void	out_asgoto Argdcl((FILEP, tagptr));
-void	out_call Argdcl((FILEP, int, int, tagptr, tagptr, tagptr));
-void	out_const Argdcl((FILEP, Constp));
-void	out_else Argdcl((FILEP));
-void	out_for Argdcl((FILEP, tagptr, tagptr, tagptr));
-void	out_init(Void);
-void	outbuf_adjust(Void);
-void	p1_label Argdcl((long));
-void	prcona Argdcl((FILEP, long));
-void	prconi Argdcl((FILEP, long));
-void	prconr Argdcl((FILEP, Constp, int));
-void	procinit(Void);
-void	procode Argdcl((FILEP));
-void	prolog Argdcl((FILEP, chainp));
-void	protowrite Argdcl((FILEP, int, char*, struct Entrypoint*, chainp));
-expptr	prune_left_conv Argdcl((expptr));
-int	put_one_arg Argdcl((int, char*, char**, char*, char*));
-expptr	putassign Argdcl((expptr, expptr));
-Addrp	putchop Argdcl((tagptr));
-void	putcmgo Argdcl((tagptr, int, struct Labelblock**));
-Addrp	putconst Argdcl((Constp));
-tagptr	putcxop Argdcl((tagptr));
-void	puteq Argdcl((expptr, expptr));
-void	putexpr Argdcl((expptr));
-void	puthead Argdcl((char*, int));
-void	putif Argdcl((tagptr, int));
-void	putout Argdcl((tagptr));
-expptr	putsteq Argdcl((Addrp, Addrp));
-void	putwhile Argdcl((tagptr));
-tagptr	putx Argdcl((tagptr));
-void	r8fix(Void);
-int	rdlong Argdcl((FILEP, long*));
-int	rdname Argdcl((FILEP, ptr, char*));
-void	read_Pfiles Argdcl((char**));
-Addrp	realpart Argdcl((Addrp));
-chainp	revchain Argdcl((chainp));
-int	same_expr Argdcl((tagptr, tagptr));
-int	same_ident Argdcl((tagptr, tagptr));
-void	save_argtypes Argdcl((chainp, Argtypes**, Argtypes**, int, char*, int, int, int, int));
-void	saveargtypes Argdcl((Exprp));
-void	set_externs(Void);
-void	set_tmp_names(Void);
-void	setbound Argdcl((Namep, int, struct Dims*));
-void	setdata Argdcl((Addrp, Constp, long));
-void	setext Argdcl((Namep));
-void	setfmt Argdcl((struct Labelblock*));
-void	setimpl Argdcl((int, long, int, int));
-void	setintr Argdcl((Namep));
-void	settype Argdcl((Namep, int, long));
-void	sigcatch Argdcl((int));
-void	sserr Argdcl((Namep));
-void	start_formatting(Void);
-void	startioctl(Void);
-void	startproc Argdcl((Extsym*, int));
-void	startrw(Void);
-char*	string_num Argdcl((char*, long));
-int	struct_eq Argdcl((chainp, chainp));
-tagptr	subcheck Argdcl((Namep, tagptr));
-tagptr	suboffset Argdcl((struct Primblock*));
-int	type_fixup Argdcl((Argtypes*, Atype*, int));
-void	unamstring Argdcl((Addrp, char*));
-void	unclassifiable(Void);
-void	vardcl Argdcl((Namep));
-void	warn Argdcl((char*));
-void	warn1 Argdcl((char*, char*));
-void	warni Argdcl((char*, int));
-void	wr_abbrevs Argdcl((FILEP, int, chainp));
-char*	wr_ardecls Argdcl((FILE*, struct Dimblock*, long));
-void	wr_array_init Argdcl((FILEP, int, chainp));
-void	wr_common_decls Argdcl((FILEP));
-void	wr_equiv_init Argdcl((FILEP, int, chainp*, int));
-void	wr_globals Argdcl((FILEP));
-void	wr_nv_ident_help Argdcl((FILEP, Addrp));
-void	wr_struct Argdcl((FILEP, chainp));
-void	wronginf Argdcl((Namep));
-void	yyerror Argdcl((char*));
-int	yylex(Void);
-int	yyparse(Void);
-
-#ifdef USE_DTOA
-#define atof(x) strtod(x,0)
-void	g_fmt Argdcl((char*, double));
-#endif
diff --git a/usr.bin/f2c/equiv.c b/usr.bin/f2c/equiv.c
deleted file mode 100644
index 0b7c94c..0000000
--- a/usr.bin/f2c/equiv.c
+++ /dev/null
@@ -1,413 +0,0 @@
-/****************************************************************
-Copyright 1990, 1993-6 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-
-static void eqvcommon Argdcl((struct Equivblock*, int, long int));
-static void eqveqv Argdcl((int, int, long int));
-static int nsubs Argdcl((struct Listblock*));
-
-/* ROUTINES RELATED TO EQUIVALENCE CLASS PROCESSING */
-
-/* called at end of declarations section to process chains
-   created by EQUIVALENCE statements
- */
- void
-doequiv(Void)
-{
-	register int i;
-	int inequiv;			/* True if one namep occurs in
-					   several EQUIV declarations */
-	int comno;		/* Index into Extsym table of the last
-				   COMMON block seen (implicitly assuming
-				   that only one will be given) */
-	int ovarno;
-	ftnint comoffset;	/* Index into the COMMON block */
-	ftnint offset;		/* Offset from array base */
-	ftnint leng;
-	register struct Equivblock *equivdecl;
-	register struct Eqvchain *q;
-	struct Primblock *primp;
-	register Namep np;
-	int k, k1, ns, pref, t;
-	chainp cp;
-	extern int type_pref[];
-	char *s;
-
-	for(i = 0 ; i < nequiv ; ++i)
-	{
-
-/* Handle each equivalence declaration */
-
-		equivdecl = &eqvclass[i];
-		equivdecl->eqvbottom = equivdecl->eqvtop = 0;
-		comno = -1;
-
-
-
-		for(q = equivdecl->equivs ; q ; q = q->eqvnextp)
-		{
-			offset = 0;
-			if (!(primp = q->eqvitem.eqvlhs))
-				continue;
-			vardcl(np = primp->namep);
-			if(primp->argsp || primp->fcharp)
-			{
-				expptr offp;
-
-/* Pad ones onto the end of an array declaration when needed */
-
-				if(np->vdim!=NULL && np->vdim->ndim>1 &&
-				    nsubs(primp->argsp)==1 )
-				{
-					if(! ftn66flag)
-						warni
-			("1-dim subscript in EQUIVALENCE, %d-dim declared",
-						    np -> vdim -> ndim);
-					cp = NULL;
-					ns = np->vdim->ndim;
-					while(--ns > 0)
-						cp = mkchain((char *)ICON(1), cp);
-					primp->argsp->listp->nextp = cp;
-				}
-
-				offp = suboffset(primp);
-				if(ISICON(offp))
-					offset = offp->constblock.Const.ci;
-				else	{
-					dclerr
-			("nonconstant subscript in equivalence ",
-					    np);
-					np = NULL;
-				}
-				frexpr(offp);
-			}
-
-/* Free up the primblock, since we now have a hash table (Namep) entry */
-
-			frexpr((expptr)primp);
-
-			if(np && (leng = iarrlen(np))<0)
-			{
-				dclerr("adjustable in equivalence", np);
-				np = NULL;
-			}
-
-			if(np) switch(np->vstg)
-			{
-			case STGUNKNOWN:
-			case STGBSS:
-			case STGEQUIV:
-				break;
-
-			case STGCOMMON:
-
-/* The code assumes that all COMMON references in a given EQUIVALENCE will
-   be to the same COMMON block, and will all be consistent */
-
-				comno = np->vardesc.varno;
-				comoffset = np->voffset + offset;
-				break;
-
-			default:
-				dclerr("bad storage class in equivalence", np);
-				np = NULL;
-				break;
-			}
-
-			if(np)
-			{
-				q->eqvoffset = offset;
-
-/* eqvbottom   gets the largest difference between the array base address
-   and the address specified in the EQUIV declaration */
-
-				equivdecl->eqvbottom =
-				    lmin(equivdecl->eqvbottom, -offset);
-
-/* eqvtop   gets the largest difference between the end of the array and
-   the address given in the EQUIVALENCE */
-
-				equivdecl->eqvtop =
-				    lmax(equivdecl->eqvtop, leng-offset);
-			}
-			q->eqvitem.eqvname = np;
-		}
-
-/* Now all equivalenced variables are in the hash table with the proper
-   offset, and   eqvtop and eqvbottom   are set. */
-
-		if(comno >= 0)
-
-/* Get rid of all STGEQUIVS, they will be mapped onto STGCOMMON variables
-   */
-
-			eqvcommon(equivdecl, comno, comoffset);
-		else for(q = equivdecl->equivs ; q ; q = q->eqvnextp)
-		{
-			if(np = q->eqvitem.eqvname)
-			{
-				inequiv = NO;
-				if(np->vstg==STGEQUIV)
-					if( (ovarno = np->vardesc.varno) == i)
-					{
-
-/* Can't EQUIV different elements of the same array */
-
-						if(np->voffset + q->eqvoffset != 0)
-							dclerr
-			("inconsistent equivalence", np);
-					}
-					else	{
-						offset = np->voffset;
-						inequiv = YES;
-					}
-
-				np->vstg = STGEQUIV;
-				np->vardesc.varno = i;
-				np->voffset = - q->eqvoffset;
-
-				if(inequiv)
-
-/* Combine 2 equivalence declarations */
-
-					eqveqv(i, ovarno, q->eqvoffset + offset);
-			}
-		}
-	}
-
-/* Now each equivalence declaration is distinct (all connections have been
-   merged in eqveqv()), and some may be empty. */
-
-	for(i = 0 ; i < nequiv ; ++i)
-	{
-		equivdecl = & eqvclass[i];
-		if(equivdecl->eqvbottom!=0 || equivdecl->eqvtop!=0) {
-
-/* a live chain */
-
-			k = TYCHAR;
-			pref = 1;
-			for(q = equivdecl->equivs ; q; q = q->eqvnextp)
-			    if ((np = q->eqvitem.eqvname)
-			    		&& !np->veqvadjust) {
-				np->veqvadjust = 1;
-				np->voffset -= equivdecl->eqvbottom;
-				t = typealign[k1 = np->vtype];
-				if (pref < type_pref[k1]) {
-					k = k1;
-					pref = type_pref[k1];
-					}
-				if(np->voffset % t != 0) {
-					dclerr("bad alignment forced by equivalence", np);
-					--nerr; /* don't give bad return code for this */
-					}
-				}
-			equivdecl->eqvtype = k;
-		}
-		freqchain(equivdecl);
-	}
-}
-
-
-
-
-
-/* put equivalence chain p at common block comno + comoffset */
-
- LOCAL void
-#ifdef KR_headers
-eqvcommon(p, comno, comoffset)
-	struct Equivblock *p;
-	int comno;
-	ftnint comoffset;
-#else
-eqvcommon(struct Equivblock *p, int comno, ftnint comoffset)
-#endif
-{
-	int ovarno;
-	ftnint k, offq;
-	register Namep np;
-	register struct Eqvchain *q;
-
-	if(comoffset + p->eqvbottom < 0)
-	{
-		errstr("attempt to extend common %s backward",
-		    extsymtab[comno].fextname);
-		freqchain(p);
-		return;
-	}
-
-	if( (k = comoffset + p->eqvtop) > extsymtab[comno].extleng)
-		extsymtab[comno].extleng = k;
-
-
-	for(q = p->equivs ; q ; q = q->eqvnextp)
-		if(np = q->eqvitem.eqvname)
-		{
-			switch(np->vstg)
-			{
-			case STGUNKNOWN:
-			case STGBSS:
-				np->vstg = STGCOMMON;
-				np->vcommequiv = 1;
-				np->vardesc.varno = comno;
-
-/* np -> voffset   will point to the base of the array */
-
-				np->voffset = comoffset - q->eqvoffset;
-				break;
-
-			case STGEQUIV:
-				ovarno = np->vardesc.varno;
-
-/* offq   will point to the current element, even if it's in an array */
-
-				offq = comoffset - q->eqvoffset - np->voffset;
-				np->vstg = STGCOMMON;
-				np->vcommequiv = 1;
-				np->vardesc.varno = comno;
-
-/* np -> voffset   will point to the base of the array */
-
-				np->voffset += offq;
-				if(ovarno != (p - eqvclass))
-					eqvcommon(&eqvclass[ovarno], comno, offq);
-				break;
-
-			case STGCOMMON:
-				if(comno != np->vardesc.varno ||
-				    comoffset != np->voffset+q->eqvoffset)
-					dclerr("inconsistent common usage", np);
-				break;
-
-
-			default:
-				badstg("eqvcommon", np->vstg);
-			}
-		}
-
-	freqchain(p);
-	p->eqvbottom = p->eqvtop = 0;
-}
-
-
-/* Move all items on ovarno chain to the front of   nvarno   chain.
- * adjust offsets of ovarno elements and top and bottom of nvarno chain
- */
-
- LOCAL void
-#ifdef KR_headers
-eqveqv(nvarno, ovarno, delta)
-	int nvarno;
-	int ovarno;
-	ftnint delta;
-#else
-eqveqv(int nvarno, int ovarno, ftnint delta)
-#endif
-{
-	register struct Equivblock *neweqv, *oldeqv;
-	register Namep np;
-	struct Eqvchain *q, *q1;
-
-	neweqv = eqvclass + nvarno;
-	oldeqv = eqvclass + ovarno;
-	neweqv->eqvbottom = lmin(neweqv->eqvbottom, oldeqv->eqvbottom - delta);
-	neweqv->eqvtop = lmax(neweqv->eqvtop, oldeqv->eqvtop - delta);
-	oldeqv->eqvbottom = oldeqv->eqvtop = 0;
-
-	for(q = oldeqv->equivs ; q ; q = q1)
-	{
-		q1 = q->eqvnextp;
-		if( (np = q->eqvitem.eqvname) && np->vardesc.varno==ovarno)
-		{
-			q->eqvnextp = neweqv->equivs;
-			neweqv->equivs = q;
-			q->eqvoffset += delta;
-			np->vardesc.varno = nvarno;
-			np->voffset -= delta;
-		}
-		else	free( (charptr) q);
-	}
-	oldeqv->equivs = NULL;
-}
-
-
-
- void
-#ifdef KR_headers
-freqchain(p)
-	register struct Equivblock *p;
-#else
-freqchain(register struct Equivblock *p)
-#endif
-{
-	register struct Eqvchain *q, *oq;
-
-	for(q = p->equivs ; q ; q = oq)
-	{
-		oq = q->eqvnextp;
-		free( (charptr) q);
-	}
-	p->equivs = NULL;
-}
-
-
-
-
-
-/* nsubs -- number of subscripts in this arglist (just the length of the
-   list) */
-
- LOCAL int
-#ifdef KR_headers
-nsubs(p)
-	register struct Listblock *p;
-#else
-nsubs(register struct Listblock *p)
-#endif
-{
-	register int n;
-	register chainp q;
-
-	n = 0;
-	if(p)
-		for(q = p->listp ; q ; q = q->nextp)
-			++n;
-
-	return(n);
-}
-
- struct Primblock *
-#ifdef KR_headers
-primchk(e) expptr e;
-#else
-primchk(expptr e)
-#endif
-{
-	if (e->headblock.tag != TPRIM) {
-		err("Invalid name in EQUIVALENCE.");
-		return 0;
-		}
-	return &e->primblock;
-	}
diff --git a/usr.bin/f2c/error.c b/usr.bin/f2c/error.c
deleted file mode 100644
index 0899d82..0000000
--- a/usr.bin/f2c/error.c
+++ /dev/null
@@ -1,347 +0,0 @@
-/****************************************************************
-Copyright 1990, 1993, 1994 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-
- void
-#ifdef KR_headers
-warni(s, t)
-	char *s;
-	int t;
-#else
-warni(char *s, int t)
-#endif
-{
-	char buf[100];
-	sprintf(buf,s,t);
-	warn(buf);
-	}
-
- void
-#ifdef KR_headers
-warn1(s, t)
-	char *s;
-	char *t;
-#else
-warn1(char *s, char *t)
-#endif
-{
-	char buff[100];
-	sprintf(buff, s, t);
-	warn(buff);
-}
-
- void
-#ifdef KR_headers
-warn(s)
-	char *s;
-#else
-warn(char *s)
-#endif
-{
-	if(nowarnflag)
-		return;
-	if (infname && *infname)
-		fprintf(diagfile, "Warning on line %ld of %s: %s\n",
-			lineno, infname, s);
-	else
-		fprintf(diagfile, "Warning on line %ld: %s\n", lineno, s);
-	fflush(diagfile);
-	++nwarn;
-}
-
- void
-#ifdef KR_headers
-errstr(s, t)
-	char *s;
-	char *t;
-#else
-errstr(char *s, char *t)
-#endif
-{
-	char buff[100];
-	sprintf(buff, s, t);
-	err(buff);
-}
-
-
- void
-#ifdef KR_headers
-erri(s, t)
-	char *s;
-	int t;
-#else
-erri(char *s, int t)
-#endif
-{
-	char buff[100];
-	sprintf(buff, s, t);
-	err(buff);
-}
-
- void
-#ifdef KR_headers
-errl(s, t)
-	char *s;
-	long t;
-#else
-errl(char *s, long t)
-#endif
-{
-	char buff[100];
-	sprintf(buff, s, t);
-	err(buff);
-}
-
- char *err_proc = 0;
-
- void
-#ifdef KR_headers
-err(s)
-	char *s;
-#else
-err(char *s)
-#endif
-{
-	if (err_proc)
-		fprintf(diagfile,
-			"Error processing %s before line %ld",
-			err_proc, lineno);
-	else
-		fprintf(diagfile, "Error on line %ld", lineno);
-	if (infname && *infname)
-		fprintf(diagfile, " of %s", infname);
-	fprintf(diagfile, ": %s\n", s);
-	fflush(diagfile);
-	++nerr;
-}
-
- void
-#ifdef KR_headers
-yyerror(s)
-	char *s;
-#else
-yyerror(char *s)
-#endif
-{
-	err(s);
-}
-
-
- void
-#ifdef KR_headers
-dclerr(s, v)
-	char *s;
-	Namep v;
-#else
-dclerr(char *s, Namep v)
-#endif
-{
-	char buff[100];
-
-	if(v)
-	{
-		sprintf(buff, "Declaration error for %s: %s", v->fvarname, s);
-		err(buff);
-	}
-	else
-		errstr("Declaration error %s", s);
-}
-
-
- void
-#ifdef KR_headers
-execerr(s, n)
-	char *s;
-	char *n;
-#else
-execerr(char *s, char *n)
-#endif
-{
-	char buf1[100], buf2[100];
-
-	sprintf(buf1, "Execution error %s", s);
-	sprintf(buf2, buf1, n);
-	err(buf2);
-}
-
-
- void
-#ifdef KR_headers
-Fatal(t)
-	char *t;
-#else
-Fatal(char *t)
-#endif
-{
-	fprintf(diagfile, "Compiler error line %ld", lineno);
-	if (infname)
-		fprintf(diagfile, " of %s", infname);
-	fprintf(diagfile, ": %s\n", t);
-	done(3);
-}
-
-
-
- void
-#ifdef KR_headers
-fatalstr(t, s)
-	char *t;
-	char *s;
-#else
-fatalstr(char *t, char *s)
-#endif
-{
-	char buff[100];
-	sprintf(buff, t, s);
-	Fatal(buff);
-}
-
-
- void
-#ifdef KR_headers
-fatali(t, d)
-	char *t;
-	int d;
-#else
-fatali(char *t, int d)
-#endif
-{
-	char buff[100];
-	sprintf(buff, t, d);
-	Fatal(buff);
-}
-
-
- void
-#ifdef KR_headers
-badthing(thing, r, t)
-	char *thing;
-	char *r;
-	int t;
-#else
-badthing(char *thing, char *r, int t)
-#endif
-{
-	char buff[50];
-	sprintf(buff, "Impossible %s %d in routine %s", thing, t, r);
-	Fatal(buff);
-}
-
-
- void
-#ifdef KR_headers
-badop(r, t)
-	char *r;
-	int t;
-#else
-badop(char *r, int t)
-#endif
-{
-	badthing("opcode", r, t);
-}
-
-
- void
-#ifdef KR_headers
-badtag(r, t)
-	char *r;
-	int t;
-#else
-badtag(char *r, int t)
-#endif
-{
-	badthing("tag", r, t);
-}
-
-
-
-
- void
-#ifdef KR_headers
-badstg(r, t)
-	char *r;
-	int t;
-#else
-badstg(char *r, int t)
-#endif
-{
-	badthing("storage class", r, t);
-}
-
-
-
- void
-#ifdef KR_headers
-badtype(r, t)
-	char *r;
-	int t;
-#else
-badtype(char *r, int t)
-#endif
-{
-	badthing("type", r, t);
-}
-
- void
-#ifdef KR_headers
-many(s, c, n)
-	char *s;
-	char c;
-	int n;
-#else
-many(char *s, char c, int n)
-#endif
-{
-	char buff[250];
-
-	sprintf(buff,
-	    "Too many %s.\nTable limit now %d.\nTry rerunning with the -N%c%d option.\n",
-	    s, n, c, 2*n);
-	Fatal(buff);
-}
-
- void
-#ifdef KR_headers
-err66(s)
-	char *s;
-#else
-err66(char *s)
-#endif
-{
-	errstr("Fortran 77 feature used: %s", s);
-	--nerr;
-}
-
-
- void
-#ifdef KR_headers
-errext(s)
-	char *s;
-#else
-errext(char *s)
-#endif
-{
-	errstr("f2c extension used: %s", s);
-	--nerr;
-}
diff --git a/usr.bin/f2c/exec.c b/usr.bin/f2c/exec.c
deleted file mode 100644
index 5e3d7b2..0000000
--- a/usr.bin/f2c/exec.c
+++ /dev/null
@@ -1,934 +0,0 @@
-/****************************************************************
-Copyright 1990, 1993 - 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "p1defs.h"
-#include "names.h"
-
-static void exar2 Argdcl((int, tagptr, struct Labelblock*, struct Labelblock*));
-static void popctl Argdcl((void));
-static void pushctl Argdcl((int));
-
-/*   Logical IF codes
-*/
-
- void
-#ifdef KR_headers
-exif(p)
-	expptr p;
-#else
-exif(expptr p)
-#endif
-{
-    pushctl(CTLIF);
-    putif(p, 0);	/* 0 => if, not elseif */
-}
-
-
- void
-#ifdef KR_headers
-exelif(p)
-	expptr p;
-#else
-exelif(expptr p)
-#endif
-{
-    if (ctlstack->ctltype == CTLIF || ctlstack->ctltype == CTLIFX)
-	putif(p, 1);	/* 1 ==> elseif */
-    else
-	execerr("elseif out of place", CNULL);
-}
-
-
-
-
- void
-exelse(Void)
-{
-	register struct Ctlframe *c;
-
-	for(c = ctlstack; c->ctltype == CTLIFX; --c);
-	if(c->ctltype == CTLIF) {
-		p1_else ();
-		c->ctltype = CTLELSE;
-		}
-	else
-		execerr("else out of place", CNULL);
-	}
-
- void
-#ifdef KR_headers
-exendif()
-#else
-exendif()
-#endif
-{
-	while(ctlstack->ctltype == CTLIFX) {
-		popctl();
-		p1else_end();
-		}
-	if(ctlstack->ctltype == CTLIF) {
-		popctl();
-		p1_endif ();
-		}
-	else if(ctlstack->ctltype == CTLELSE) {
-		popctl();
-		p1else_end ();
-		}
-	else
-		execerr("endif out of place", CNULL);
-	}
-
-
- void
-#ifdef KR_headers
-new_endif()
-#else
-new_endif()
-#endif
-{
-	if (ctlstack->ctltype == CTLIF || ctlstack->ctltype == CTLIFX)
-		pushctl(CTLIFX);
-	else
-		err("new_endif bug");
-	}
-
-/* pushctl -- Start a new control construct, initialize the labels (to
-   zero) */
-
- LOCAL void
-#ifdef KR_headers
-pushctl(code)
-	int code;
-#else
-pushctl(int code)
-#endif
-{
-	register int i;
-
-	if(++ctlstack >= lastctl)
-		many("loops or if-then-elses", 'c', maxctl);
-	ctlstack->ctltype = code;
-	for(i = 0 ; i < 4 ; ++i)
-		ctlstack->ctlabels[i] = 0;
-	ctlstack->dowhile = 0;
-	ctlstack->domax = ctlstack->dostep = 0;	/* in case of errors */
-	++blklevel;
-}
-
-
- LOCAL void
-popctl(Void)
-{
-	if( ctlstack-- < ctls )
-		Fatal("control stack empty");
-	--blklevel;
-}
-
-
-
-/* poplab -- update the flags in   labeltab   */
-
- LOCAL void
-poplab(Void)
-{
-	register struct Labelblock  *lp;
-
-	for(lp = labeltab ; lp < highlabtab ; ++lp)
-		if(lp->labdefined)
-		{
-			/* mark all labels in inner blocks unreachable */
-			if(lp->blklevel > blklevel)
-				lp->labinacc = YES;
-		}
-		else if(lp->blklevel > blklevel)
-		{
-			/* move all labels referred to in inner blocks out a level */
-			lp->blklevel = blklevel;
-		}
-}
-
-
-/*  BRANCHING CODE
-*/
- void
-#ifdef KR_headers
-exgoto(lab)
-	struct Labelblock *lab;
-#else
-exgoto(struct Labelblock *lab)
-#endif
-{
-	lab->labused = 1;
-	p1_goto (lab -> stateno);
-}
-
-
-
-
-
-
- void
-#ifdef KR_headers
-exequals(lp, rp)
-	register struct Primblock *lp;
-	register expptr rp;
-#else
-exequals(register struct Primblock *lp, register expptr rp)
-#endif
-{
-	if(lp->tag != TPRIM)
-	{
-		err("assignment to a non-variable");
-		frexpr((expptr)lp);
-		frexpr(rp);
-	}
-	else if(lp->namep->vclass!=CLVAR && lp->argsp)
-	{
-		if(parstate >= INEXEC)
-			errstr("statement function %.62s amid executables.",
-				lp->namep->fvarname);
-		mkstfunct(lp, rp);
-	}
-	else if (lp->vtype == TYSUBR)
-		err("illegal use of subroutine name");
-	else
-	{
-		expptr new_lp, new_rp;
-
-		if(parstate < INDATA)
-			enddcl();
-		new_lp = mklhs (lp, keepsubs);
-		new_rp = fixtype (rp);
-		puteq(new_lp, new_rp);
-	}
-}
-
-
-
-/* Make Statement Function */
-
-long laststfcn = -1, thisstno;
-int doing_stmtfcn;
-
- void
-#ifdef KR_headers
-mkstfunct(lp, rp)
-	struct Primblock *lp;
-	expptr rp;
-#else
-mkstfunct(struct Primblock *lp, expptr rp)
-#endif
-{
-	register struct Primblock *p;
-	register Namep np;
-	chainp args;
-
-	laststfcn = thisstno;
-	np = lp->namep;
-	if(np->vclass == CLUNKNOWN)
-		np->vclass = CLPROC;
-	else
-	{
-		dclerr("redeclaration of statement function", np);
-		return;
-	}
-	np->vprocclass = PSTFUNCT;
-	np->vstg = STGSTFUNCT;
-
-/* Set the type of the function */
-
-	impldcl(np);
-	if (np->vtype == TYCHAR && !np->vleng)
-		err("character statement function with length (*)");
-	args = (lp->argsp ? lp->argsp->listp : CHNULL);
-	np->varxptr.vstfdesc = mkchain((char *)args, (chainp)rp);
-
-	for(doing_stmtfcn = 1 ; args ; args = args->nextp)
-
-/* It is an error for the formal parameters to have arguments or
-   subscripts */
-
-		if( ((tagptr)(args->datap))->tag!=TPRIM ||
-		    (p = (struct Primblock *)(args->datap) )->argsp ||
-		    p->fcharp || p->lcharp ) {
-			err("non-variable argument in statement function definition");
-			args->datap = 0;
-			}
-		else
-		{
-
-/* Replace the name on the left-hand side */
-
-			args->datap = (char *)p->namep;
-			vardcl(p -> namep);
-			free((char *)p);
-		}
-	doing_stmtfcn = 0;
-}
-
- static void
-#ifdef KR_headers
-mixed_type(np)
-	Namep np;
-#else
-mixed_type(Namep np)
-#endif
-{
-	char buf[128];
-	sprintf(buf, "%s function %.90s invoked as subroutine",
-		ftn_types[np->vtype], np->fvarname);
-	warn(buf);
-	}
-
- void
-#ifdef KR_headers
-excall(name, args, nstars, labels)
-	Namep name;
-	struct Listblock *args;
-	int nstars;
-	struct Labelblock **labels;
-#else
-excall(Namep name, struct Listblock *args, int nstars, struct Labelblock **labels)
-#endif
-{
-	register expptr p;
-
-	if (name->vtype != TYSUBR) {
-		if (name->vinfproc && !name->vcalled) {
-			name->vtype = TYSUBR;
-			frexpr(name->vleng);
-			name->vleng = 0;
-			}
-		else if (!name->vimpltype && name->vtype != TYUNKNOWN)
-			mixed_type(name);
-		else
-			settype(name, TYSUBR, (ftnint)0);
-		}
-	p = mkfunct( mkprim(name, args, CHNULL) );
-	if (p->tag == TERROR)
-		return;
-
-/* Subroutines and their identifiers acquire the type INT */
-
-	p->exprblock.vtype = p->exprblock.leftp->headblock.vtype = TYINT;
-
-/* Handle the alternate return mechanism */
-
-	if(nstars > 0)
-		putcmgo(putx(fixtype(p)), nstars, labels);
-	else
-		putexpr(p);
-}
-
-
- void
-#ifdef KR_headers
-exstop(stop, p)
-	int stop;
-	register expptr p;
-#else
-exstop(int stop, register expptr p)
-#endif
-{
-	char *str;
-	int n;
-
-	if(p)
-	{
-		if( ! ISCONST(p) )
-		{
-			execerr("pause/stop argument must be constant", CNULL);
-			frexpr(p);
-			p = mkstrcon(0, CNULL);
-		}
-		else if( ISINT(p->constblock.vtype) )
-		{
-			str = convic(p->constblock.Const.ci);
-			n = strlen(str);
-			if(n > 0)
-			{
-				p->constblock.Const.ccp = copyn(n, str);
-				p->constblock.Const.ccp1.blanks = 0;
-				p->constblock.vtype = TYCHAR;
-				p->constblock.vleng = (expptr) ICON(n);
-			}
-			else
-				p = (expptr) mkstrcon(0, CNULL);
-		}
-		else if(p->constblock.vtype != TYCHAR)
-		{
-			execerr("pause/stop argument must be integer or string", CNULL);
-			p = (expptr) mkstrcon(0, CNULL);
-		}
-	}
-	else	p = (expptr) mkstrcon(0, CNULL);
-
-    {
-	expptr subr_call;
-
-	subr_call = call1(TYSUBR, (stop ? "s_stop" : "s_paus"), p);
-	putexpr( subr_call );
-    }
-}
-
-/* DO LOOP CODE */
-
-#define DOINIT	par[0]
-#define DOLIMIT	par[1]
-#define DOINCR	par[2]
-
-
-/* Macros for   ctlstack -> dostepsign   */
-
-#define VARSTEP	0
-#define POSSTEP	1
-#define NEGSTEP	2
-
-
-/* exdo -- generate DO loop code.  In the case of a variable increment,
-   positive increment tests are placed above the body, negative increment
-   tests are placed below (see   enddo()   ) */
-
- void
-#ifdef KR_headers
-exdo(range, loopname, spec)
-	int range;
-	Namep loopname;
-	chainp spec;
-#else
-exdo(int range, Namep loopname, chainp spec)
-#endif
-			/* range = end label */
-			/* input spec must have at least 2 exprs */
-{
-	register expptr p;
-	register Namep np;
-	chainp cp;		/* loops over the fields in   spec */
-	register int i;
-	int dotype;		/* type of the index variable */
-	int incsign;		/* sign of the increment, if it's constant
-				   */
-	Addrp dovarp;		/* loop index variable */
-	expptr doinit;		/* constant or register for init param */
-	expptr par[3];		/* local specification parameters */
-
-	expptr init, test, inc;	/* Expressions in the resulting FOR loop */
-
-
-	test = ENULL;
-
-	pushctl(CTLDO);
-	dorange = ctlstack->dolabel = range;
-	ctlstack->loopname = loopname;
-
-/* Declare the loop index */
-
-	np = (Namep)spec->datap;
-	ctlstack->donamep = NULL;
-	if (!np) { /* do while */
-		ctlstack->dowhile = 1;
-#if 0
-		if (loopname) {
-			if (loopname->vtype == TYUNKNOWN) {
-				loopname->vdcldone = 1;
-				loopname->vclass = CLLABEL;
-				loopname->vprocclass = PLABEL;
-				loopname->vtype = TYLABEL;
-				}
-			if (loopname->vtype == TYLABEL)
-				if (loopname->vdovar)
-					dclerr("already in use as a loop name",
-						loopname);
-				else
-					loopname->vdovar = 1;
-			else
-				dclerr("already declared; cannot be a loop name",
-					loopname);
-			}
-#endif
-		putwhile((expptr)spec->nextp);
-		NOEXT("do while");
-		spec->nextp = 0;
-		frchain(&spec);
-		return;
-		}
-	if(np->vdovar)
-	{
-		errstr("nested loops with variable %s", np->fvarname);
-		ctlstack->donamep = NULL;
-		return;
-	}
-
-/* Create a memory-resident version of the index variable */
-
-	dovarp = mkplace(np);
-	if( ! ONEOF(dovarp->vtype, MSKINT|MSKREAL) )
-	{
-		err("bad type on do variable");
-		return;
-	}
-	ctlstack->donamep = np;
-
-	np->vdovar = YES;
-
-/* Now   dovarp   points to the index to be used within the loop,   dostgp
-   points to the one which may need to be stored */
-
-	dotype = dovarp->vtype;
-
-/* Count the input specifications and type-check each one independently;
-   this just eliminates non-numeric values from the specification */
-
-	for(i=0 , cp = spec->nextp ; cp!=NULL && i<3 ; cp = cp->nextp)
-	{
-		p = par[i++] = fixtype((tagptr)cp->datap);
-		if( ! ONEOF(p->headblock.vtype, MSKINT|MSKREAL) )
-		{
-			err("bad type on DO parameter");
-			return;
-		}
-	}
-
-	frchain(&spec);
-	switch(i)
-	{
-	case 0:
-	case 1:
-		err("too few DO parameters");
-		return;
-
-	default:
-		err("too many DO parameters");
-		return;
-
-	case 2:
-		DOINCR = (expptr) ICON(1);
-
-	case 3:
-		break;
-	}
-
-
-/* Now all of the local specification fields are set, but their types are
-   not yet consistent */
-
-/* Declare the loop initialization value, casting it properly and declaring a
-   register if need be */
-
-	ctlstack->doinit = 0;
-	if (ISCONST (DOINIT) || !onetripflag)
-/* putx added 6-29-89 (mwm), not sure if fixtype is required, but I doubt it
-   since mkconv is called just before */
-		doinit = putx (mkconv (dotype, DOINIT));
-	else  {
-	    if (onetripflag)
-	   	ctlstack->doinit = doinit = (expptr) mktmp0(dotype, ENULL);
-	    else
-		doinit = (expptr) mktmp(dotype, ENULL);
-	    puteq (cpexpr (doinit), DOINIT);
-	} /* else */
-
-/* Declare the loop ending value, casting it to the type of the index
-   variable */
-
-	if( ISCONST(DOLIMIT) )
-		ctlstack->domax = mkconv(dotype, DOLIMIT);
-	else {
-		ctlstack->domax = (expptr) mktmp0(dotype, ENULL);
-		puteq (cpexpr (ctlstack -> domax), DOLIMIT);
-	} /* else */
-
-/* Declare the loop increment value, casting it to the type of the index
-   variable */
-
-	if( ISCONST(DOINCR) )
-	{
-		ctlstack->dostep = mkconv(dotype, DOINCR);
-		if( (incsign = conssgn(ctlstack->dostep)) == 0)
-			err("zero DO increment");
-		ctlstack->dostepsign = (incsign > 0 ? POSSTEP : NEGSTEP);
-	}
-	else
-	{
-		ctlstack->dostep = (expptr) mktmp0(dotype, ENULL);
-		ctlstack->dostepsign = VARSTEP;
-		puteq (cpexpr (ctlstack -> dostep), DOINCR);
-	}
-
-/* All data is now properly typed and in the   ctlstack,   except for the
-   initial value.  Assignments of temps have been generated already */
-
-	switch (ctlstack -> dostepsign) {
-	    case VARSTEP:
-		test = mkexpr (OPQUEST, mkexpr (OPLT,
-			cpexpr (ctlstack -> dostep), ICON(0)),
-			mkexpr (OPCOLON,
-			    mkexpr (OPGE, cpexpr((expptr)dovarp),
-				    cpexpr (ctlstack -> domax)),
-			    mkexpr (OPLE, cpexpr((expptr)dovarp),
-				    cpexpr (ctlstack -> domax))));
-		break;
-	    case POSSTEP:
-	        test = mkexpr (OPLE, cpexpr((expptr)dovarp),
-			cpexpr (ctlstack -> domax));
-	        break;
-	    case NEGSTEP:
-	        test = mkexpr (OPGE, cpexpr((expptr)dovarp),
-			cpexpr (ctlstack -> domax));
-	        break;
-	    default:
-	        erri ("exdo:  bad dostepsign '%d'", ctlstack -> dostepsign);
-	        break;
-	} /* switch (ctlstack -> dostepsign) */
-
-	if (onetripflag)
-	    test = mkexpr (OPOR, test,
-		    mkexpr (OPEQ, cpexpr((expptr)dovarp), cpexpr (doinit)));
-	init = mkexpr (OPASSIGN, cpexpr((expptr)dovarp),
-			ctlstack->doinit ? cpexpr(doinit) : doinit);
-	inc = mkexpr (OPPLUSEQ, (expptr)dovarp, cpexpr (ctlstack -> dostep));
-
-	if (!onetripflag && ISCONST (ctlstack -> domax) && ISCONST (doinit)
-		&& ctlstack -> dostepsign != VARSTEP) {
-	    expptr tester;
-
-	    tester = mkexpr (OPMINUS, cpexpr (doinit),
-		    cpexpr (ctlstack -> domax));
-	    if (incsign == conssgn (tester))
-		warn ("DO range never executed");
-	    frexpr (tester);
-	} /* if !onetripflag && */
-
-	p1_for (init, test, inc);
-}
-
- void
-#ifdef KR_headers
-exenddo(np)
-	Namep np;
-#else
-exenddo(Namep np)
-#endif
-{
-	Namep np1;
-	int here;
-	struct Ctlframe *cf;
-
-	if( ctlstack < ctls )
-		goto misplaced;
-	here = ctlstack->dolabel;
-	if (ctlstack->ctltype != CTLDO
-	|| here >= 0 && (!thislabel || thislabel->labelno != here)) {
- misplaced:
-		err("misplaced ENDDO");
-		return;
-		}
-	if (np != ctlstack->loopname) {
-		if (np1 = ctlstack->loopname)
-			errstr("expected \"enddo %s\"", np1->fvarname);
-		else
-			err("expected unnamed ENDDO");
-		for(cf = ctls; cf < ctlstack; cf++)
-			if (cf->ctltype == CTLDO && cf->loopname == np) {
-				here = cf->dolabel;
-				break;
-				}
-		}
-	enddo(here);
-	}
-
- void
-#ifdef KR_headers
-enddo(here)
-	int here;
-#else
-enddo(int here)
-#endif
-{
-	register struct Ctlframe *q;
-	Namep np;			/* name of the current DO index */
-	Addrp ap;
-	register int i;
-	register expptr e;
-
-/* Many DO's can end at the same statement, so keep looping over all
-   nested indicies */
-
-	while(here == dorange)
-	{
-		if(np = ctlstack->donamep)
-			{
-			p1for_end ();
-
-/* Now we're done with all of the tests, and the loop has terminated.
-   Store the index value back in long-term memory */
-
-			if(ap = memversion(np))
-				puteq((expptr)ap, (expptr)mkplace(np));
-			for(i = 0 ; i < 4 ; ++i)
-				ctlstack->ctlabels[i] = 0;
-			deregister(ctlstack->donamep);
-			ctlstack->donamep->vdovar = NO;
-			/* ctlstack->dostep and ctlstack->domax can be zero */
-			/* with sufficiently bizarre (erroneous) syntax */
-			if (e = ctlstack->dostep)
-				if (e->tag == TADDR && e->addrblock.istemp)
-					frtemp((Addrp)e);
-				else
-					frexpr(e);
-			if (e = ctlstack->domax)
-				if (e->tag == TADDR && e->addrblock.istemp)
-					frtemp((Addrp)e);
-				else
-					frexpr(e);
-			if (e = ctlstack->doinit)
-				frtemp((Addrp)e);
-			}
-		else if (ctlstack->dowhile)
-			p1for_end ();
-
-/* Set   dorange   to the closing label of the next most enclosing DO loop
-   */
-
-		popctl();
-		poplab();
-		dorange = 0;
-		for(q = ctlstack ; q>=ctls ; --q)
-			if(q->ctltype == CTLDO)
-			{
-				dorange = q->dolabel;
-				break;
-			}
-	}
-}
-
- void
-#ifdef KR_headers
-exassign(vname, labelval)
-	register Namep vname;
-	struct Labelblock *labelval;
-#else
-exassign(register Namep vname, struct Labelblock *labelval)
-#endif
-{
-	Addrp p;
-	register Addrp q;
-	char *fs;
-	register chainp cp, cpprev;
-	register ftnint k, stno;
-
-	p = mkplace(vname);
-	if( ! ONEOF(p->vtype, MSKINT|MSKADDR) ) {
-		err("noninteger assign variable");
-		return;
-		}
-
-	/* If the label hasn't been defined, then we do things twice:
-	 * once for an executable stmt label, once for a format
-	 */
-
-	/* code for executable label... */
-
-/* Now store the assigned value in a list associated with this variable.
-   This will be used later to generate a switch() statement in the C output */
-
-	fs = labelval->fmtstring;
-	if (!labelval->labdefined || !fs) {
-
-		if (vname -> vis_assigned == 0) {
-			vname -> varxptr.assigned_values = CHNULL;
-			vname -> vis_assigned = 1;
-			}
-
-		/* don't duplicate labels... */
-
-		stno = labelval->stateno;
-		cpprev = 0;
-		for(k = 0, cp = vname->varxptr.assigned_values;
-				cp; cpprev = cp, cp = cp->nextp, k++)
-			if ((ftnint)cp->datap == stno)
-				break;
-		if (!cp) {
-			cp = mkchain((char *)stno, CHNULL);
-			if (cpprev)
-				cpprev->nextp = cp;
-			else
-				vname->varxptr.assigned_values = cp;
-			labelval->labused = 1;
-			}
-		putout(mkexpr(OPASSIGN, (expptr)p, mkintcon(k)));
-		}
-
-	/* Code for FORMAT label... */
-
-	if (!labelval->labdefined || fs) {
-
-		labelval->fmtlabused = 1;
-		p = ALLOC(Addrblock);
-		p->tag = TADDR;
-		p->vtype = TYCHAR;
-		p->vstg = STGAUTO;
-		p->memoffset = ICON(0);
-		fmtname(vname, p);
-		q = ALLOC(Addrblock);
-		q->tag = TADDR;
-		q->vtype = TYCHAR;
-		q->vstg = STGAUTO;
-		q->ntempelt = 1;
-		q->memoffset = ICON(0);
-		q->uname_tag = UNAM_IDENT;
-		sprintf(q->user.ident, "fmt_%ld", labelval->stateno);
-		putout(mkexpr(OPASSIGN, (expptr)p, (expptr)q));
-		}
-
-} /* exassign */
-
-
- void
-#ifdef KR_headers
-exarif(expr, neglab, zerlab, poslab)
-	expptr expr;
-	struct Labelblock *neglab;
-	struct Labelblock *zerlab;
-	struct Labelblock *poslab;
-#else
-exarif(expptr expr, struct Labelblock *neglab, struct Labelblock *zerlab, struct Labelblock *poslab)
-#endif
-{
-    register int lm, lz, lp;
-
-    lm = neglab->stateno;
-    lz = zerlab->stateno;
-    lp = poslab->stateno;
-    expr = fixtype(expr);
-
-    if( ! ONEOF(expr->headblock.vtype, MSKINT|MSKREAL) )
-    {
-        err("invalid type of arithmetic if expression");
-        frexpr(expr);
-    }
-    else
-    {
-        if (lm == lz && lz == lp)
-            exgoto (neglab);
-        else if(lm == lz)
-            exar2(OPLE, expr, neglab, poslab);
-        else if(lm == lp)
-            exar2(OPNE, expr, neglab, zerlab);
-        else if(lz == lp)
-            exar2(OPGE, expr, zerlab, neglab);
-        else {
-            expptr t;
-
-	    if (!addressable (expr)) {
-		t = (expptr) mktmp(expr -> headblock.vtype, ENULL);
-		expr = mkexpr (OPASSIGN, cpexpr (t), expr);
-	    } else
-		t = (expptr) cpexpr (expr);
-
-	    p1_if(putx(fixtype(mkexpr (OPLT, expr, ICON (0)))));
-	    exgoto(neglab);
-	    p1_elif (mkexpr (OPEQ, t, ICON (0)));
-	    exgoto(zerlab);
-	    p1_else ();
-	    exgoto(poslab);
-	    p1else_end ();
-        } /* else */
-    }
-}
-
-
-
-/* exar2 -- Do arithmetic IF for only 2 distinct labels;   if !(e.op.0)
-   goto l2 else goto l1.  If this seems backwards, that's because it is,
-   in order to make the 1 pass algorithm work. */
-
- LOCAL void
-#ifdef KR_headers
-exar2(op, e, l1, l2)
-	int op;
-	expptr e;
-	struct Labelblock *l1;
-	struct Labelblock *l2;
-#else
-exar2(int op, expptr e, struct Labelblock *l1, struct Labelblock *l2)
-#endif
-{
-	expptr comp;
-
-	comp = mkexpr (op, e, ICON (0));
-	p1_if(putx(fixtype(comp)));
-	exgoto(l1);
-	p1_else ();
-	exgoto(l2);
-	p1else_end ();
-}
-
-
-/* exreturn -- return the value in   p  from a SUBROUTINE call -- used to
-   implement the alternate return mechanism */
-
- void
-#ifdef KR_headers
-exreturn(p)
-	register expptr p;
-#else
-exreturn(register expptr p)
-#endif
-{
-	if(procclass != CLPROC)
-		warn("RETURN statement in main or block data");
-	if(p && (proctype!=TYSUBR || procclass!=CLPROC) )
-	{
-		err("alternate return in nonsubroutine");
-		p = 0;
-	}
-
-	if (p || proctype == TYSUBR) {
-		if (p == ENULL) p = ICON (0);
-		p = mkconv (TYLONG, fixtype (p));
-		p1_subr_ret (p);
-	} /* if p || proctype == TYSUBR */
-	else
-	    p1_subr_ret((expptr)retslot);
-}
-
-
- void
-#ifdef KR_headers
-exasgoto(labvar)
-	Namep labvar;
-#else
-exasgoto(Namep labvar)
-#endif
-{
-	register Addrp p;
-
-	p = mkplace(labvar);
-	if( ! ISINT(p->vtype) )
-		err("assigned goto variable must be integer");
-	else {
-		p1_asgoto (p);
-	} /* else */
-}
diff --git a/usr.bin/f2c/expr.c b/usr.bin/f2c/expr.c
deleted file mode 100644
index 59ea9b6..0000000
--- a/usr.bin/f2c/expr.c
+++ /dev/null
@@ -1,3436 +0,0 @@
-/****************************************************************
-Copyright 1990 - 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "output.h"
-#include "names.h"
-
-typedef struct { double dreal, dimag; } dcomplex;
-
-static void consbinop Argdcl((int, int, Constp, Constp, Constp));
-static void conspower Argdcl((Constp, Constp, long int));
-static void zdiv Argdcl((dcomplex*, dcomplex*, dcomplex*));
-static tagptr mkpower Argdcl((tagptr));
-static tagptr stfcall Argdcl((Namep, struct Listblock*));
-
-extern char dflttype[26];
-extern int htype;
-
-/* little routines to create constant blocks */
-
- Constp
-#ifdef KR_headers
-mkconst(t)
-	register int t;
-#else
-mkconst(register int t)
-#endif
-{
-	register Constp p;
-
-	p = ALLOC(Constblock);
-	p->tag = TCONST;
-	p->vtype = t;
-	return(p);
-}
-
-
-/* mklogcon -- Make Logical Constant */
-
- expptr
-#ifdef KR_headers
-mklogcon(l)
-	register int l;
-#else
-mklogcon(register int l)
-#endif
-{
-	register Constp  p;
-
-	p = mkconst(tylog);
-	p->Const.ci = l;
-	return( (expptr) p );
-}
-
-
-
-/* mkintcon -- Make Integer Constant */
-
- expptr
-#ifdef KR_headers
-mkintcon(l)
-	ftnint l;
-#else
-mkintcon(ftnint l)
-#endif
-{
-	register Constp p;
-
-	p = mkconst(tyint);
-	p->Const.ci = l;
-	return( (expptr) p );
-}
-
-
-
-
-/* mkaddcon -- Make Address Constant, given integer value */
-
- expptr
-#ifdef KR_headers
-mkaddcon(l)
-	register long l;
-#else
-mkaddcon(register long l)
-#endif
-{
-	register Constp p;
-
-	p = mkconst(TYADDR);
-	p->Const.ci = l;
-	return( (expptr) p );
-}
-
-
-
-/* mkrealcon -- Make Real Constant.  The type t is assumed
-   to be TYREAL or TYDREAL */
-
- expptr
-#ifdef KR_headers
-mkrealcon(t, d)
-	register int t;
-	char *d;
-#else
-mkrealcon(register int t, char *d)
-#endif
-{
-	register Constp p;
-
-	p = mkconst(t);
-	p->Const.cds[0] = cds(d,CNULL);
-	p->vstg = 1;
-	return( (expptr) p );
-}
-
-
-/* mkbitcon -- Make bit constant.  Reads the input string, which is
-   assumed to correctly specify a number in base 2^shift (where   shift
-   is the input parameter).   shift   may not exceed 4, i.e. only binary,
-   quad, octal and hex bases may be input.  Constants may not exceed 32
-   bits, or whatever the size of (struct Constblock).ci may be. */
-
- expptr
-#ifdef KR_headers
-mkbitcon(shift, leng, s)
-	int shift;
-	int leng;
-	char *s;
-#else
-mkbitcon(int shift, int leng, char *s)
-#endif
-{
-	register Constp p;
-	register long x, y, z;
-	int len;
-	char buff[100], *fmt, *s0 = s;
-	static char *kind[3] = { "Binary", "Hex", "Octal" };
-
-	p = mkconst(TYLONG);
-	x = y = 0;
-	while(--leng >= 0)
-		if(*s != ' ') {
-			z = x;
-			x = (x << shift) | hextoi(*s++);
-			y |= (((unsigned long)x) >> shift) - z;
-			}
-	/* Don't change the type to short for short constants, as
-	 * that is dangerous -- there is no syntax for long constants
-	 * with small values.
-	 */
-	p->Const.ci = x;
-	if (y) {
-		if (--shift == 3)
-			shift = 1;
-		if ((len = (int)leng) > 60)
-			sprintf(buff, "%s constant '%.60s' truncated.",
-				kind[shift], s0);
-		else
-			sprintf(buff, "%s constant '%.*s' truncated.",
-				kind[shift], len, s0);
-		err(buff);
-		}
-	return( (expptr) p );
-}
-
-
-
-
-
-/* mkstrcon -- Make string constant.  Allocates storage and initializes
-   the memory for a copy of the input Fortran-string. */
-
- expptr
-#ifdef KR_headers
-mkstrcon(l, v)
-	int l;
-	register char *v;
-#else
-mkstrcon(int l, register char *v)
-#endif
-{
-	register Constp p;
-	register char *s;
-
-	p = mkconst(TYCHAR);
-	p->vleng = ICON(l);
-	p->Const.ccp = s = (char *) ckalloc(l+1);
-	p->Const.ccp1.blanks = 0;
-	while(--l >= 0)
-		*s++ = *v++;
-	*s = '\0';
-	return( (expptr) p );
-}
-
-
-
-/* mkcxcon -- Make complex contsant.  A complex number is a pair of
-   values, each of which may be integer, real or double. */
-
- expptr
-#ifdef KR_headers
-mkcxcon(realp, imagp)
-	register expptr realp;
-	register expptr imagp;
-#else
-mkcxcon(register expptr realp, register expptr imagp)
-#endif
-{
-	int rtype, itype;
-	register Constp p;
-
-	rtype = realp->headblock.vtype;
-	itype = imagp->headblock.vtype;
-
-	if( ISCONST(realp) && ISNUMERIC(rtype) && ISCONST(imagp) && ISNUMERIC(itype) )
-	{
-		p = mkconst( (rtype==TYDREAL||itype==TYDREAL)
-				? TYDCOMPLEX : tycomplex);
-		if (realp->constblock.vstg || imagp->constblock.vstg) {
-			p->vstg = 1;
-			p->Const.cds[0] = ISINT(rtype)
-				? string_num("", realp->constblock.Const.ci)
-				: realp->constblock.vstg
-					? realp->constblock.Const.cds[0]
-					: dtos(realp->constblock.Const.cd[0]);
-			p->Const.cds[1] = ISINT(itype)
-				? string_num("", imagp->constblock.Const.ci)
-				: imagp->constblock.vstg
-					? imagp->constblock.Const.cds[0]
-					: dtos(imagp->constblock.Const.cd[0]);
-			}
-		else {
-			p->Const.cd[0] = ISINT(rtype)
-				? realp->constblock.Const.ci
-				: realp->constblock.Const.cd[0];
-			p->Const.cd[1] = ISINT(itype)
-				? imagp->constblock.Const.ci
-				: imagp->constblock.Const.cd[0];
-			}
-	}
-	else
-	{
-		err("invalid complex constant");
-		p = (Constp)errnode();
-	}
-
-	frexpr(realp);
-	frexpr(imagp);
-	return( (expptr) p );
-}
-
-
-/* errnode -- Allocate a new error block */
-
- expptr
-errnode(Void)
-{
-	struct Errorblock *p;
-	p = ALLOC(Errorblock);
-	p->tag = TERROR;
-	p->vtype = TYERROR;
-	return( (expptr) p );
-}
-
-
-
-
-
-/* mkconv -- Make type conversion.  Cast expression   p   into type   t.
-   Note that casting to a character copies only the first sizeof(char)
-   bytes. */
-
- expptr
-#ifdef KR_headers
-mkconv(t, p)
-	register int t;
-	register expptr p;
-#else
-mkconv(register int t, register expptr p)
-#endif
-{
-	register expptr q;
-	register int pt, charwarn = 1;
-
-	if (t >= 100) {
-		t -= 100;
-		charwarn = 0;
-		}
-	if(t==TYUNKNOWN || t==TYERROR)
-		badtype("mkconv", t);
-	pt = p->headblock.vtype;
-
-/* Casting to the same type is a no-op */
-
-	if(t == pt)
-		return(p);
-
-/* If we're casting a constant which is not in the literal table ... */
-
-	else if( ISCONST(p) && pt!=TYADDR && pt != TYCHAR
-		|| p->tag == TADDR && p->addrblock.uname_tag == UNAM_CONST)
-	{
-		if (ISINT(t) && ISINT(pt) || ISREAL(t) && ISREAL(pt)) {
-			/* avoid trouble with -i2 */
-			p->headblock.vtype = t;
-			return p;
-			}
-		q = (expptr) mkconst(t);
-		consconv(t, &q->constblock, &p->constblock );
-		if (p->tag == TADDR)
-			q->constblock.vstg = p->addrblock.user.kludge.vstg1;
-		frexpr(p);
-	}
-	else {
-		if (pt == TYCHAR && t != TYADDR && charwarn
-				&& (!halign || p->tag != TADDR
-				|| p->addrblock.uname_tag != UNAM_CONST))
-			warn(
-		 "ichar([first char. of] char. string) assumed for conversion to numeric");
-		q = opconv(p, t);
-		}
-
-	if(t == TYCHAR)
-		q->constblock.vleng = ICON(1);
-	return(q);
-}
-
-
-
-/* opconv -- Convert expression   p   to type   t   using the main
-   expression evaluator; returns an OPCONV expression, I think  14-jun-88 mwm */
-
- expptr
-#ifdef KR_headers
-opconv(p, t)
-	expptr p;
-	int t;
-#else
-opconv(expptr p, int t)
-#endif
-{
-	register expptr q;
-
-	if (t == TYSUBR)
-		err("illegal use of subroutine name");
-	q = mkexpr(OPCONV, p, ENULL);
-	q->headblock.vtype = t;
-	return(q);
-}
-
-
-
-/* addrof -- Create an ADDR expression operation */
-
- expptr
-#ifdef KR_headers
-addrof(p)
-	expptr p;
-#else
-addrof(expptr p)
-#endif
-{
-	return( mkexpr(OPADDR, p, ENULL) );
-}
-
-
-
-/* cpexpr - Returns a new copy of input expression   p   */
-
- tagptr
-#ifdef KR_headers
-cpexpr(p)
-	register tagptr p;
-#else
-cpexpr(register tagptr p)
-#endif
-{
-	register tagptr e;
-	int tag;
-	register chainp ep, pp;
-
-/* This table depends on the ordering of the T macros, e.g. TNAME */
-
-	static int blksize[ ] =
-	{
-		0,
-		sizeof(struct Nameblock),
-		sizeof(struct Constblock),
-		sizeof(struct Exprblock),
-		sizeof(struct Addrblock),
-		sizeof(struct Primblock),
-		sizeof(struct Listblock),
-		sizeof(struct Impldoblock),
-		sizeof(struct Errorblock)
-	};
-
-	if(p == NULL)
-		return(NULL);
-
-/* TNAMEs are special, and don't get copied.  Each name in the current
-   symbol table has a unique TNAME structure. */
-
-	if( (tag = p->tag) == TNAME)
-		return(p);
-
-	e = cpblock(blksize[p->tag], (char *)p);
-
-	switch(tag)
-	{
-	case TCONST:
-		if(e->constblock.vtype == TYCHAR)
-		{
-			e->constblock.Const.ccp =
-			    copyn((int)e->constblock.vleng->constblock.Const.ci+1,
-				e->constblock.Const.ccp);
-			e->constblock.vleng =
-			    (expptr) cpexpr(e->constblock.vleng);
-		}
-	case TERROR:
-		break;
-
-	case TEXPR:
-		e->exprblock.leftp =  (expptr) cpexpr(p->exprblock.leftp);
-		e->exprblock.rightp = (expptr) cpexpr(p->exprblock.rightp);
-		break;
-
-	case TLIST:
-		if(pp = p->listblock.listp)
-		{
-			ep = e->listblock.listp =
-			    mkchain((char *)cpexpr((tagptr)pp->datap), CHNULL);
-			for(pp = pp->nextp ; pp ; pp = pp->nextp)
-				ep = ep->nextp =
-				    mkchain((char *)cpexpr((tagptr)pp->datap),
-						CHNULL);
-		}
-		break;
-
-	case TADDR:
-		e->addrblock.vleng = (expptr)  cpexpr(e->addrblock.vleng);
-		e->addrblock.memoffset = (expptr)cpexpr(e->addrblock.memoffset);
-		e->addrblock.istemp = NO;
-		break;
-
-	case TPRIM:
-		e->primblock.argsp = (struct Listblock *)
-		    cpexpr((expptr)e->primblock.argsp);
-		e->primblock.fcharp = (expptr) cpexpr(e->primblock.fcharp);
-		e->primblock.lcharp = (expptr) cpexpr(e->primblock.lcharp);
-		break;
-
-	default:
-		badtag("cpexpr", tag);
-	}
-
-	return(e);
-}
-
-/* frexpr -- Free expression -- frees up memory used by expression   p   */
-
- void
-#ifdef KR_headers
-frexpr(p)
-	register tagptr p;
-#else
-frexpr(register tagptr p)
-#endif
-{
-	register chainp q;
-
-	if(p == NULL)
-		return;
-
-	switch(p->tag)
-	{
-	case TCONST:
-		if( ISCHAR(p) )
-		{
-			free( (charptr) (p->constblock.Const.ccp) );
-			frexpr(p->constblock.vleng);
-		}
-		break;
-
-	case TADDR:
-		if (p->addrblock.vtype > TYERROR)	/* i/o block */
-			break;
-		frexpr(p->addrblock.vleng);
-		frexpr(p->addrblock.memoffset);
-		break;
-
-	case TERROR:
-		break;
-
-/* TNAME blocks don't get free'd - probably because they're pointed to in
-   the hash table. 14-Jun-88 -- mwm */
-
-	case TNAME:
-		return;
-
-	case TPRIM:
-		frexpr((expptr)p->primblock.argsp);
-		frexpr(p->primblock.fcharp);
-		frexpr(p->primblock.lcharp);
-		break;
-
-	case TEXPR:
-		frexpr(p->exprblock.leftp);
-		if(p->exprblock.rightp)
-			frexpr(p->exprblock.rightp);
-		break;
-
-	case TLIST:
-		for(q = p->listblock.listp ; q ; q = q->nextp)
-			frexpr((tagptr)q->datap);
-		frchain( &(p->listblock.listp) );
-		break;
-
-	default:
-		badtag("frexpr", p->tag);
-	}
-
-	free( (charptr) p );
-}
-
- void
-#ifdef KR_headers
-wronginf(np)
-	Namep np;
-#else
-wronginf(Namep np)
-#endif
-{
-	int c, k;
-	warn1("fixing wrong type inferred for %.65s", np->fvarname);
-	np->vinftype = 0;
-	c = letter(np->fvarname[0]);
-	if ((np->vtype = impltype[c]) == TYCHAR
-	&& (k = implleng[c]))
-		np->vleng = ICON(k);
-	}
-
-/* fix up types in expression; replace subtrees and convert
-   names to address blocks */
-
- expptr
-#ifdef KR_headers
-fixtype(p)
-	register tagptr p;
-#else
-fixtype(register tagptr p)
-#endif
-{
-
-	if(p == 0)
-		return(0);
-
-	switch(p->tag)
-	{
-	case TCONST:
-		if(ONEOF(p->constblock.vtype,MSKINT|MSKLOGICAL|MSKADDR|
-		    MSKREAL) )
-			return( (expptr) p);
-
-		return( (expptr) putconst((Constp)p) );
-
-	case TADDR:
-		p->addrblock.memoffset = fixtype(p->addrblock.memoffset);
-		return( (expptr) p);
-
-	case TERROR:
-		return( (expptr) p);
-
-	default:
-		badtag("fixtype", p->tag);
-
-/* This case means that   fixexpr   can't call   fixtype   with any expr,
-   only a subexpr of its parameter. */
-
-	case TEXPR:
-		if (((Exprp)p)->typefixed)
-			return (expptr)p;
-		return( fixexpr((Exprp)p) );
-
-	case TLIST:
-		return( (expptr) p );
-
-	case TPRIM:
-		if(p->primblock.argsp && p->primblock.namep->vclass!=CLVAR)
-		{
-			if(p->primblock.namep->vtype == TYSUBR)
-			{
-				err("function invocation of subroutine");
-				return( errnode() );
-			}
-			else {
-				if (p->primblock.namep->vinftype)
-					wronginf(p->primblock.namep);
-				return( mkfunct(p) );
-				}
-		}
-
-/* The lack of args makes   p   a function name, substring reference
-   or variable name. */
-
-		else	return mklhs((struct Primblock *) p, keepsubs);
-	}
-}
-
-
- int
-#ifdef KR_headers
-badchleng(p)
-	register expptr p;
-#else
-badchleng(register expptr p)
-#endif
-{
-	if (!p->headblock.vleng) {
-		if (p->headblock.tag == TADDR
-		&& p->addrblock.uname_tag == UNAM_NAME)
-			errstr("bad use of character*(*) variable %.60s",
-				p->addrblock.user.name->fvarname);
-		else
-			err("Bad use of character*(*)");
-		return 1;
-		}
-	return 0;
-	}
-
-
- static expptr
-#ifdef KR_headers
-cplenexpr(p)
-	expptr p;
-#else
-cplenexpr(expptr p)
-#endif
-{
-	expptr rv;
-
-	if (badchleng(p))
-		return ICON(1);
-	rv = cpexpr(p->headblock.vleng);
-	if (ISCONST(p) && p->constblock.vtype == TYCHAR)
-		rv->constblock.Const.ci += p->constblock.Const.ccp1.blanks;
-	return rv;
-	}
-
-
-/* special case tree transformations and cleanups of expression trees.
-   Parameter   p   should have a TEXPR tag at its root, else an error is
-   returned */
-
- expptr
-#ifdef KR_headers
-fixexpr(p)
-	register Exprp p;
-#else
-fixexpr(register Exprp p)
-#endif
-{
-	expptr lp;
-	register expptr rp;
-	register expptr q;
-	char *hsave;
-	int opcode, ltype, rtype, ptype, mtype;
-
-	if( ISERROR(p) || p->typefixed )
-		return( (expptr) p );
-	else if(p->tag != TEXPR)
-		badtag("fixexpr", p->tag);
-	opcode = p->opcode;
-
-/* First set the types of the left and right subexpressions */
-
-	lp = p->leftp;
-	if (!ISCONST(lp) || lp->constblock.vtype != TYCHAR)
-		lp = p->leftp = fixtype(lp);
-	ltype = lp->headblock.vtype;
-
-	if(opcode==OPASSIGN && lp->tag!=TADDR)
-	{
-		err("left side of assignment must be variable");
- eret:
-		frexpr((expptr)p);
-		return( errnode() );
-	}
-
-	if(rp = p->rightp)
-	{
-		if (!ISCONST(rp) || rp->constblock.vtype != TYCHAR)
-			rp = p->rightp = fixtype(rp);
-		rtype = rp->headblock.vtype;
-	}
-	else
-		rtype = 0;
-
-	if(ltype==TYERROR || rtype==TYERROR)
-		goto eret;
-
-/* Now work on the whole expression */
-
-	/* force folding if possible */
-
-	if( ISCONST(lp) && (rp==NULL || ISCONST(rp)) )
-	{
-		q = opcode == OPCONV && lp->constblock.vtype == p->vtype
-			? lp : mkexpr(opcode, lp, rp);
-
-/* mkexpr is expected to reduce constant expressions */
-
-		if( ISCONST(q) ) {
-			p->leftp = p->rightp = 0;
-			frexpr((expptr)p);
-			return(q);
-			}
-		free( (charptr) q );	/* constants did not fold */
-	}
-
-	if( (ptype = cktype(opcode, ltype, rtype)) == TYERROR)
-		goto eret;
-
-	if (ltype == TYCHAR && ISCONST(lp)) {
-		if (opcode == OPCONV) {
-			hsave = halign;
-			halign = 0;
-			lp = (expptr)putconst((Constp)lp);
-			halign = hsave;
-			}
-		else
-			lp = (expptr)putconst((Constp)lp);
-		p->leftp = lp;
-		}
-	if (rtype == TYCHAR && ISCONST(rp))
-		p->rightp = rp = (expptr)putconst((Constp)rp);
-
-	switch(opcode)
-	{
-	case OPCONCAT:
-		if(p->vleng == NULL)
-			p->vleng = mkexpr(OPPLUS, cplenexpr(lp),
-					cplenexpr(rp) );
-		break;
-
-	case OPASSIGN:
-		if (rtype == TYREAL || ISLOGICAL(ptype)
-		 || rtype == TYDREAL && ltype == TYREAL && !ISCONST(rp))
-			break;
-	case OPPLUSEQ:
-	case OPSTAREQ:
-		if(ltype == rtype)
-			break;
-		if( ! ISCONST(rp) && ISREAL(ltype) && ISREAL(rtype) )
-			break;
-		if( ISCOMPLEX(ltype) || ISCOMPLEX(rtype) )
-			break;
-		if( ONEOF(ltype, MSKADDR|MSKINT) && ONEOF(rtype, MSKADDR|MSKINT)
-		    && typesize[ltype]>=typesize[rtype] )
-			    break;
-
-/* Cast the right hand side to match the type of the expression */
-
-		p->rightp = fixtype( mkconv(ptype, rp) );
-		break;
-
-	case OPSLASH:
-		if( ISCOMPLEX(rtype) )
-		{
-			p = (Exprp) call2(ptype,
-
-/* Handle double precision complex variables */
-
-			    ptype == TYCOMPLEX ? "c_div" : "z_div",
-			    mkconv(ptype, lp), mkconv(ptype, rp) );
-			break;
-		}
-	case OPPLUS:
-	case OPMINUS:
-	case OPSTAR:
-	case OPMOD:
-		if(ptype==TYDREAL && ( (ltype==TYREAL && ! ISCONST(lp) ) ||
-		    (rtype==TYREAL && ! ISCONST(rp) ) ))
-			break;
-		if( ISCOMPLEX(ptype) )
-			break;
-
-/* Cast both sides of the expression to match the type of the whole
-   expression.  */
-
-		if(ltype != ptype && (ltype < TYINT1 || ptype > TYDREAL))
-			p->leftp = fixtype(mkconv(ptype,lp));
-		if(rtype != ptype && (rtype < TYINT1 || ptype > TYDREAL))
-			p->rightp = fixtype(mkconv(ptype,rp));
-		break;
-
-	case OPPOWER:
-		rp = mkpower((expptr)p);
-		if (rp->tag == TEXPR)
-			rp->exprblock.typefixed = 1;
-		return rp;
-
-	case OPLT:
-	case OPLE:
-	case OPGT:
-	case OPGE:
-	case OPEQ:
-	case OPNE:
-		if(ltype == rtype)
-			break;
-		if (htype) {
-			if (ltype == TYCHAR) {
-				p->leftp = fixtype(mkconv(rtype,lp));
-				break;
-				}
-			if (rtype == TYCHAR) {
-				p->rightp = fixtype(mkconv(ltype,rp));
-				break;
-				}
-			}
-		mtype = cktype(OPMINUS, ltype, rtype);
-		if(mtype==TYDREAL && (ltype==TYREAL || rtype==TYREAL))
-			break;
-		if( ISCOMPLEX(mtype) )
-			break;
-		if(ltype != mtype)
-			p->leftp = fixtype(mkconv(mtype,lp));
-		if(rtype != mtype)
-			p->rightp = fixtype(mkconv(mtype,rp));
-		break;
-
-	case OPCONV:
-		ptype = cktype(OPCONV, p->vtype, ltype);
-		if(lp->tag==TEXPR && lp->exprblock.opcode==OPCOMMA
-		 && !ISCOMPLEX(ptype))
-		{
-			lp->exprblock.rightp =
-			    fixtype( mkconv(ptype, lp->exprblock.rightp) );
-			free( (charptr) p );
-			p = (Exprp) lp;
-		}
-		break;
-
-	case OPADDR:
-		if(lp->tag==TEXPR && lp->exprblock.opcode==OPADDR)
-			Fatal("addr of addr");
-		break;
-
-	case OPCOMMA:
-	case OPQUEST:
-	case OPCOLON:
-		break;
-
-	case OPMIN:
-	case OPMAX:
-	case OPMIN2:
-	case OPMAX2:
-	case OPDMIN:
-	case OPDMAX:
-	case OPABS:
-	case OPDABS:
-		ptype = p->vtype;
-		break;
-
-	default:
-		break;
-	}
-
-	p->vtype = ptype;
-	p->typefixed = 1;
-	return((expptr) p);
-}
-
-
-/* fix an argument list, taking due care for special first level cases */
-
- int
-#ifdef KR_headers
-fixargs(doput, p0)
-	int doput;
-	struct Listblock *p0;
-#else
-fixargs(int doput, struct Listblock *p0)
-#endif
-	/* doput is true if constants need to be passed by reference */
-{
-	register chainp p;
-	register tagptr q, t;
-	register int qtag;
-	int nargs;
-
-	nargs = 0;
-	if(p0)
-		for(p = p0->listp ; p ; p = p->nextp)
-		{
-			++nargs;
-			q = (tagptr)p->datap;
-			qtag = q->tag;
-			if(qtag == TCONST)
-			{
-
-/* Call putconst() to store values in a constant table.  Since even
-   constants must be passed by reference, this can optimize on the storage
-   required */
-
-				p->datap = doput ? (char *)putconst((Constp)q)
-						 : (char *)q;
-				continue;
-			}
-
-/* Take a function name and turn it into an Addr.  This only happens when
-   nothing else has figured out the function beforehand */
-
-			if (qtag == TPRIM && q->primblock.argsp == 0) {
-			    if (q->primblock.namep->vclass==CLPROC
-			     && q->primblock.namep->vprocclass != PTHISPROC) {
-				p->datap = (char *)mkaddr(q->primblock.namep);
-				continue;
-				}
-
-			    if (q->primblock.namep->vdim != NULL) {
-				p->datap = (char *)mkscalar(q->primblock.namep);
-				if ((q->primblock.fcharp||q->primblock.lcharp)
-				 && (q->primblock.namep->vtype != TYCHAR
-				  || q->primblock.namep->vdim))
-					sserr(q->primblock.namep);
-				continue;
-				}
-
-			    if (q->primblock.namep->vdovar
-			     && (t = (tagptr) memversion(q->primblock.namep))) {
-				p->datap = (char *)fixtype(t);
-				continue;
-				}
-			    }
-			p->datap = (char *)fixtype(q);
-		}
-	return(nargs);
-}
-
-
-
-/* mkscalar -- only called by   fixargs   above, and by some routines in
-   io.c */
-
- Addrp
-#ifdef KR_headers
-mkscalar(np)
-	register Namep np;
-#else
-mkscalar(register Namep np)
-#endif
-{
-	register Addrp ap;
-
-	vardcl(np);
-	ap = mkaddr(np);
-
-	/* The prolog causes array arguments to point to the
-	 * (0,...,0) element, unless subscript checking is on.
-	 */
-	if( !checksubs && np->vstg==STGARG)
-	{
-		register struct Dimblock *dp;
-		dp = np->vdim;
-		frexpr(ap->memoffset);
-		ap->memoffset = mkexpr(OPSTAR,
-		    (np->vtype==TYCHAR ?
-		    cpexpr(np->vleng) :
-		    (tagptr)ICON(typesize[np->vtype]) ),
-		    cpexpr(dp->baseoffset) );
-	}
-	return(ap);
-}
-
-
- static void
-#ifdef KR_headers
-adjust_arginfo(np)
-	register Namep np;
-#else
-adjust_arginfo(register Namep np)
-#endif
-			/* adjust arginfo to omit the length arg for the
-			   arg that we now know to be a character-valued
-			   function */
-{
-	struct Entrypoint *ep;
-	register chainp args;
-	Argtypes *at;
-
-	for(ep = entries; ep; ep = ep->entnextp)
-		for(args = ep->arglist; args; args = args->nextp)
-			if (np == (Namep)args->datap
-			&& (at = ep->entryname->arginfo))
-				--at->nargs;
-	}
-
-
- expptr
-#ifdef KR_headers
-mkfunct(p0)
-	expptr p0;
-#else
-mkfunct(expptr p0)
-#endif
-{
-	register struct Primblock *p = (struct Primblock *)p0;
-	struct Entrypoint *ep;
-	Addrp ap;
-	Extsym *extp;
-	register Namep np;
-	register expptr q;
-	extern chainp new_procs;
-	int k, nargs;
-	int class;
-
-	if(p->tag != TPRIM)
-		return( errnode() );
-
-	np = p->namep;
-	class = np->vclass;
-
-
-	if(class == CLUNKNOWN)
-	{
-		np->vclass = class = CLPROC;
-		if(np->vstg == STGUNKNOWN)
-		{
-			if(np->vtype!=TYSUBR && (k = intrfunct(np->fvarname))
-				&& (zflag || !(*(struct Intrpacked *)&k).f4
-					|| dcomplex_seen))
-			{
-				np->vstg = STGINTR;
-				np->vardesc.varno = k;
-				np->vprocclass = PINTRINSIC;
-			}
-			else
-			{
-				extp = mkext(np->fvarname,
-					addunder(np->cvarname));
-				extp->extstg = STGEXT;
-				np->vstg = STGEXT;
-				np->vardesc.varno = extp - extsymtab;
-				np->vprocclass = PEXTERNAL;
-			}
-		}
-		else if(np->vstg==STGARG)
-		{
-		    if(np->vtype == TYCHAR) {
-			adjust_arginfo(np);
-			if (np->vpassed) {
-				char wbuf[160], *who;
-				who = np->fvarname;
-				sprintf(wbuf, "%s%s%s\n\t%s%s%s",
-					"Character-valued dummy procedure ",
-					who, " not declared EXTERNAL.",
-			"Code may be wrong for previous function calls having ",
-					who, " as a parameter.");
-				warn(wbuf);
-				}
-			}
-		    np->vprocclass = PEXTERNAL;
-		}
-	}
-
-	if(class != CLPROC) {
-		if (np->vstg == STGCOMMON)
-			fatalstr(
-			 "Cannot invoke common variable %.50s as a function.",
-				np->fvarname);
-		errstr("%.80s cannot be called.", np->fvarname);
-		goto error;
-		}
-
-/* F77 doesn't allow subscripting of function calls */
-
-	if(p->fcharp || p->lcharp)
-	{
-		err("no substring of function call");
-		goto error;
-	}
-	impldcl(np);
-	np->vimpltype = 0;	/* invoking as function ==> inferred type */
-	np->vcalled = 1;
-	nargs = fixargs( np->vprocclass!=PINTRINSIC,  p->argsp);
-
-	switch(np->vprocclass)
-	{
-	case PEXTERNAL:
-		if(np->vtype == TYUNKNOWN)
-		{
-			dclerr("attempt to use untyped function", np);
-			np->vtype = dflttype[letter(np->fvarname[0])];
-		}
-		ap = mkaddr(np);
-		if (!extsymtab[np->vardesc.varno].extseen) {
-			new_procs = mkchain((char *)np, new_procs);
-			extsymtab[np->vardesc.varno].extseen = 1;
-			}
-call:
-		q = mkexpr(OPCALL, (expptr)ap, (expptr)p->argsp);
-		q->exprblock.vtype = np->vtype;
-		if(np->vleng)
-			q->exprblock.vleng = (expptr) cpexpr(np->vleng);
-		break;
-
-	case PINTRINSIC:
-		q = intrcall(np, p->argsp, nargs);
-		break;
-
-	case PSTFUNCT:
-		q = stfcall(np, p->argsp);
-		break;
-
-	case PTHISPROC:
-		warn("recursive call");
-
-/* entries   is the list of multiple entry points */
-
-		for(ep = entries ; ep ; ep = ep->entnextp)
-			if(ep->enamep == np)
-				break;
-		if(ep == NULL)
-			Fatal("mkfunct: impossible recursion");
-
-		ap = builtin(np->vtype, ep->entryname->cextname, -2);
-		/* the negative last arg prevents adding */
-		/* this name to the list of used builtins */
-		goto call;
-
-	default:
-		fatali("mkfunct: impossible vprocclass %d",
-		    (int) (np->vprocclass) );
-	}
-	free( (charptr) p );
-	return(q);
-
-error:
-	frexpr((expptr)p);
-	return( errnode() );
-}
-
-
-
- static expptr
-#ifdef KR_headers
-stfcall(np, actlist)
-	Namep np;
-	struct Listblock *actlist;
-#else
-stfcall(Namep np, struct Listblock *actlist)
-#endif
-{
-	register chainp actuals;
-	int nargs;
-	chainp oactp, formals;
-	int type;
-	expptr Ln, Lq, q, q1, rhs, ap;
-	Namep tnp;
-	register struct Rplblock *rp;
-	struct Rplblock *tlist;
-
-	if (np->arginfo) {
-		errstr("statement function %.66s calls itself.",
-			np->fvarname);
-		return ICON(0);
-		}
-	np->arginfo = (Argtypes *)np;	/* arbitrary nonzero value */
-	if(actlist)
-	{
-		actuals = actlist->listp;
-		free( (charptr) actlist);
-	}
-	else
-		actuals = NULL;
-	oactp = actuals;
-
-	nargs = 0;
-	tlist = NULL;
-	if( (type = np->vtype) == TYUNKNOWN)
-	{
-		dclerr("attempt to use untyped statement function", np);
-		type = np->vtype = dflttype[letter(np->fvarname[0])];
-	}
-	formals = (chainp) np->varxptr.vstfdesc->datap;
-	rhs = (expptr) (np->varxptr.vstfdesc->nextp);
-
-	/* copy actual arguments into temporaries */
-	while(actuals!=NULL && formals!=NULL)
-	{
-		if (!(tnp = (Namep) formals->datap)) {
-			/* buggy statement function declaration */
-			q = ICON(1);
-			goto done;
-			}
-		rp = ALLOC(Rplblock);
-		rp->rplnp = tnp;
-		ap = fixtype((tagptr)actuals->datap);
-		if(tnp->vtype==ap->headblock.vtype && tnp->vtype!=TYCHAR
-		    && (ap->tag==TCONST || ap->tag==TADDR) )
-		{
-
-/* If actuals are constants or variable names, no temporaries are required */
-			rp->rplvp = (expptr) ap;
-			rp->rplxp = NULL;
-			rp->rpltag = ap->tag;
-		}
-		else	{
-			rp->rplvp = (expptr) mktmp(tnp->vtype, tnp->vleng);
-			rp -> rplxp = NULL;
-			putexpr ( mkexpr(OPASSIGN, cpexpr(rp->rplvp), ap));
-			if((rp->rpltag = rp->rplvp->tag) == TERROR)
-				err("disagreement of argument types in statement function call");
-		}
-		rp->rplnextp = tlist;
-		tlist = rp;
-		actuals = actuals->nextp;
-		formals = formals->nextp;
-		++nargs;
-	}
-
-	if(actuals!=NULL || formals!=NULL)
-		err("statement function definition and argument list differ");
-
-	/*
-   now push down names involved in formal argument list, then
-   evaluate rhs of statement function definition in this environment
-*/
-
-	if(tlist)	/* put tlist in front of the rpllist */
-	{
-		for(rp = tlist; rp->rplnextp; rp = rp->rplnextp)
-			;
-		rp->rplnextp = rpllist;
-		rpllist = tlist;
-	}
-
-/* So when the expression finally gets evaled, that evaluator must read
-   from the globl   rpllist   14-jun-88 mwm */
-
-	q = (expptr) mkconv(type, fixtype(cpexpr(rhs)) );
-
-	/* get length right of character-valued statement functions... */
-	if (type == TYCHAR
-	 && (Ln = np->vleng)
-	 && q->tag != TERROR
-	 && (Lq = q->exprblock.vleng)
-	 && (Lq->tag != TCONST
-		|| Ln->constblock.Const.ci != Lq->constblock.Const.ci)) {
-		q1 = (expptr) mktmp(type, Ln);
-		putexpr ( mkexpr(OPASSIGN, cpexpr(q1), q));
-		q = q1;
-		}
-
-	/* now generate the tree ( t1=a1, (t2=a2,... , f))))) */
-	while(--nargs >= 0)
-	{
-		if(rpllist->rplxp)
-			q = mkexpr(OPCOMMA, rpllist->rplxp, q);
-		rp = rpllist->rplnextp;
-		frexpr(rpllist->rplvp);
-		free((char *)rpllist);
-		rpllist = rp;
-	}
- done:
-	frchain( &oactp );
-	np->arginfo = 0;
-	return(q);
-}
-
-
-static int replaced;
-
-/* mkplace -- Figure out the proper storage class for the input name and
-   return an addrp with the appropriate stuff */
-
- Addrp
-#ifdef KR_headers
-mkplace(np)
-	register Namep np;
-#else
-mkplace(register Namep np)
-#endif
-{
-	register Addrp s;
-	register struct Rplblock *rp;
-	int regn;
-
-	/* is name on the replace list? */
-
-	for(rp = rpllist ; rp ; rp = rp->rplnextp)
-	{
-		if(np == rp->rplnp)
-		{
-			replaced = 1;
-			if(rp->rpltag == TNAME)
-			{
-				np = (Namep) (rp->rplvp);
-				break;
-			}
-			else	return( (Addrp) cpexpr(rp->rplvp) );
-		}
-	}
-
-	/* is variable a DO index in a register ? */
-
-	if(np->vdovar && ( (regn = inregister(np)) >= 0) )
-		if(np->vtype == TYERROR)
-			return((Addrp) errnode() );
-		else
-		{
-			s = ALLOC(Addrblock);
-			s->tag = TADDR;
-			s->vstg = STGREG;
-			s->vtype = TYIREG;
-			s->memno = regn;
-			s->memoffset = ICON(0);
-			s -> uname_tag = UNAM_NAME;
-			s -> user.name = np;
-			return(s);
-		}
-
-	if (np->vclass == CLPROC && np->vprocclass != PTHISPROC)
-		errstr("external %.60s used as a variable", np->fvarname);
-	vardcl(np);
-	return(mkaddr(np));
-}
-
- static expptr
-#ifdef KR_headers
-subskept(p, a)
-	struct Primblock *p;
-	Addrp a;
-#else
-subskept(struct Primblock *p, Addrp a)
-#endif
-{
-	expptr ep;
-	struct Listblock *Lb;
-	chainp cp;
-
-	if (a->uname_tag != UNAM_NAME)
-		erri("subskept: uname_tag %d", a->uname_tag);
-	a->user.name->vrefused = 1;
-	a->user.name->visused = 1;
-	a->uname_tag = UNAM_REF;
-	Lb = (struct Listblock *)cpexpr((tagptr)p->argsp);
-	for(cp = Lb->listp; cp; cp = cp->nextp)
-		cp->datap = (char *)putx(fixtype((tagptr)cp->datap));
-	if (a->vtype == TYCHAR) {
-		ep = p->fcharp	? mkexpr(OPMINUS, cpexpr(p->fcharp), ICON(1))
-				: ICON(0);
-		Lb->listp = mkchain((char *)ep, Lb->listp);
-		}
-	return (expptr)Lb;
-	}
-
- static int doing_vleng;
-
-/* mklhs -- Compute the actual address of the given expression; account
-   for array subscripts, stack offset, and substring offsets.  The f -> C
-   translator will need this only to worry about the subscript stuff */
-
- expptr
-#ifdef KR_headers
-mklhs(p, subkeep)
-	register struct Primblock *p;
-	int subkeep;
-#else
-mklhs(register struct Primblock *p, int subkeep)
-#endif
-{
-	register Addrp s;
-	Namep np;
-
-	if(p->tag != TPRIM)
-		return( (expptr) p );
-	np = p->namep;
-
-	replaced = 0;
-	s = mkplace(np);
-	if(s->tag!=TADDR || s->vstg==STGREG)
-	{
-		free( (charptr) p );
-		return( (expptr) s );
-	}
-	s->parenused = p->parenused;
-
-	/* compute the address modified by subscripts */
-
-	if (!replaced)
-		s->memoffset = (subkeep && np->vdim
-				&& (np->vdim->ndim > 1 || np->vtype == TYCHAR
-				&& (!ISCONST(np->vleng)
-				  || np->vleng->constblock.Const.ci != 1)))
-				? subskept(p,s)
-				: mkexpr(OPPLUS, s->memoffset, suboffset(p) );
-	frexpr((expptr)p->argsp);
-	p->argsp = NULL;
-
-	/* now do substring part */
-
-	if(p->fcharp || p->lcharp)
-	{
-		if(np->vtype != TYCHAR)
-			sserr(np);
-		else	{
-			if(p->lcharp == NULL)
-				p->lcharp = (expptr)(
-					/* s->vleng == 0 only with errors */
-					s->vleng ? cpexpr(s->vleng) : ICON(1));
-			if(p->fcharp) {
-				doing_vleng = 1;
-				s->vleng = fixtype(mkexpr(OPMINUS,
-						p->lcharp,
-					mkexpr(OPMINUS, p->fcharp, ICON(1) )));
-				doing_vleng = 0;
-				}
-			else	{
-				frexpr(s->vleng);
-				s->vleng = p->lcharp;
-			}
-		}
-	}
-
-	s->vleng = fixtype( s->vleng );
-	s->memoffset = fixtype( s->memoffset );
-	free( (charptr) p );
-	return( (expptr) s );
-}
-
-
-
-
-
-/* deregister -- remove a register allocation from the list; assumes that
-   names are deregistered in stack order (LIFO order - Last In First Out) */
-
- void
-#ifdef KR_headers
-deregister(np)
-	Namep np;
-#else
-deregister(Namep np)
-#endif
-{
-	if(nregvar>0 && regnamep[nregvar-1]==np)
-	{
-		--nregvar;
-	}
-}
-
-
-
-
-/* memversion -- moves a DO index REGISTER into a memory location; other
-   objects are passed through untouched */
-
- Addrp
-#ifdef KR_headers
-memversion(np)
-	register Namep np;
-#else
-memversion(register Namep np)
-#endif
-{
-	register Addrp s;
-
-	if(np->vdovar==NO || (inregister(np)<0) )
-		return(NULL);
-	np->vdovar = NO;
-	s = mkplace(np);
-	np->vdovar = YES;
-	return(s);
-}
-
-
-
-/* inregister -- looks for the input name in the global list   regnamep */
-
- int
-#ifdef KR_headers
-inregister(np)
-	register Namep np;
-#else
-inregister(register Namep np)
-#endif
-{
-	register int i;
-
-	for(i = 0 ; i < nregvar ; ++i)
-		if(regnamep[i] == np)
-			return( regnum[i] );
-	return(-1);
-}
-
-
-
-/* suboffset -- Compute the offset from the start of the array, given the
-   subscripts as arguments */
-
- expptr
-#ifdef KR_headers
-suboffset(p)
-	register struct Primblock *p;
-#else
-suboffset(register struct Primblock *p)
-#endif
-{
-	int n;
-	expptr si, size;
-	chainp cp;
-	expptr e, e1, offp, prod;
-	struct Dimblock *dimp;
-	expptr sub[MAXDIM+1];
-	register Namep np;
-
-	np = p->namep;
-	offp = ICON(0);
-	n = 0;
-	if(p->argsp)
-		for(cp = p->argsp->listp ; cp ; cp = cp->nextp)
-		{
-			si = fixtype(cpexpr((tagptr)cp->datap));
-			if (!ISINT(si->headblock.vtype)) {
-				NOEXT("non-integer subscript");
-				si = mkconv(TYLONG, si);
-				}
-			sub[n++] = si;
-			if(n > maxdim)
-			{
-				erri("more than %d subscripts", maxdim);
-				break;
-			}
-		}
-
-	dimp = np->vdim;
-	if(n>0 && dimp==NULL)
-		errstr("subscripts on scalar variable %.68s", np->fvarname);
-	else if(dimp && dimp->ndim!=n)
-		errstr("wrong number of subscripts on %.68s", np->fvarname);
-	else if(n > 0)
-	{
-		prod = sub[--n];
-		while( --n >= 0)
-			prod = mkexpr(OPPLUS, sub[n],
-			    mkexpr(OPSTAR, prod, cpexpr(dimp->dims[n].dimsize)) );
-		if(checksubs || np->vstg!=STGARG)
-			prod = mkexpr(OPMINUS, prod, cpexpr(dimp->baseoffset));
-
-/* Add in the run-time bounds check */
-
-		if(checksubs)
-			prod = subcheck(np, prod);
-		size = np->vtype == TYCHAR ?
-		    (expptr) cpexpr(np->vleng) : ICON(typesize[np->vtype]);
-		prod = mkexpr(OPSTAR, prod, size);
-		offp = mkexpr(OPPLUS, offp, prod);
-	}
-
-/* Check for substring indicator */
-
-	if(p->fcharp && np->vtype==TYCHAR) {
-		e = p->fcharp;
-		e1 = mkexpr(OPMINUS, cpexpr(e), ICON(1));
-		if (!ISCONST(e) && (e->tag != TPRIM || e->primblock.argsp)) {
-			e = (expptr)mktmp(TYLONG, ENULL);
-			putout(putassign(cpexpr(e), e1));
-			p->fcharp = mkexpr(OPPLUS, cpexpr(e), ICON(1));
-			e1 = e;
-			}
-		offp = mkexpr(OPPLUS, offp, e1);
-		}
-	return(offp);
-}
-
-
-
-
- expptr
-#ifdef KR_headers
-subcheck(np, p)
-	Namep np;
-	register expptr p;
-#else
-subcheck(Namep np, register expptr p)
-#endif
-{
-	struct Dimblock *dimp;
-	expptr t, checkvar, checkcond, badcall;
-
-	dimp = np->vdim;
-	if(dimp->nelt == NULL)
-		return(p);	/* don't check arrays with * bounds */
-	np->vlastdim = 0;
-	if( ISICON(p) )
-	{
-
-/* check for negative (constant) offset */
-
-		if(p->constblock.Const.ci < 0)
-			goto badsub;
-		if( ISICON(dimp->nelt) )
-
-/* see if constant offset exceeds the array declaration */
-
-			if(p->constblock.Const.ci < dimp->nelt->constblock.Const.ci)
-				return(p);
-			else
-				goto badsub;
-	}
-
-/* We know that the subscript offset   p   or   dimp -> nelt   is not a constant.
-   Now find a register to use for run-time bounds checking */
-
-	if(p->tag==TADDR && p->addrblock.vstg==STGREG)
-	{
-		checkvar = (expptr) cpexpr(p);
-		t = p;
-	}
-	else	{
-		checkvar = (expptr) mktmp(p->headblock.vtype, ENULL);
-		t = mkexpr(OPASSIGN, cpexpr(checkvar), p);
-	}
-	checkcond = mkexpr(OPLT, t, cpexpr(dimp->nelt) );
-	if( ! ISICON(p) )
-		checkcond = mkexpr(OPAND, checkcond,
-		    mkexpr(OPLE, ICON(0), cpexpr(checkvar)) );
-
-/* Construct the actual test */
-
-	badcall = call4(p->headblock.vtype, "s_rnge",
-	    mkstrcon(strlen(np->fvarname), np->fvarname),
-	    mkconv(TYLONG,  cpexpr(checkvar)),
-	    mkstrcon(strlen(procname), procname),
-	    ICON(lineno) );
-	badcall->exprblock.opcode = OPCCALL;
-	p = mkexpr(OPQUEST, checkcond,
-	    mkexpr(OPCOLON, checkvar, badcall));
-
-	return(p);
-
-badsub:
-	frexpr(p);
-	errstr("subscript on variable %s out of range", np->fvarname);
-	return ( ICON(0) );
-}
-
-
-
-
- Addrp
-#ifdef KR_headers
-mkaddr(p)
-	register Namep p;
-#else
-mkaddr(register Namep p)
-#endif
-{
-	Extsym *extp;
-	register Addrp t;
-	int k;
-
-	switch( p->vstg)
-	{
-	case STGAUTO:
-		if(p->vclass == CLPROC && p->vprocclass == PTHISPROC)
-			return (Addrp) cpexpr((expptr)xretslot[p->vtype]);
-		goto other;
-
-	case STGUNKNOWN:
-		if(p->vclass != CLPROC)
-			break;	/* Error */
-		extp = mkext(p->fvarname, addunder(p->cvarname));
-		extp->extstg = STGEXT;
-		p->vstg = STGEXT;
-		p->vardesc.varno = extp - extsymtab;
-		p->vprocclass = PEXTERNAL;
-		if ((extp->exproto || infertypes)
-		&& (p->vtype == TYUNKNOWN || p->vimpltype)
-		&& (k = extp->extype))
-			inferdcl(p, k);
-
-
-	case STGCOMMON:
-	case STGEXT:
-	case STGBSS:
-	case STGINIT:
-	case STGEQUIV:
-	case STGARG:
-	case STGLENG:
- other:
-		t = ALLOC(Addrblock);
-		t->tag = TADDR;
-
-		t->vclass = p->vclass;
-		t->vtype = p->vtype;
-		t->vstg = p->vstg;
-		t->memno = p->vardesc.varno;
-		t->memoffset = ICON(p->voffset);
-		if (p->vdim)
-		    t->isarray = 1;
-		if(p->vleng)
-		{
-			t->vleng = (expptr) cpexpr(p->vleng);
-			if( ISICON(t->vleng) )
-				t->varleng = t->vleng->constblock.Const.ci;
-		}
-
-/* Keep the original name around for the C code generation */
-
-		t -> uname_tag = UNAM_NAME;
-		t -> user.name = p;
-		return(t);
-
-	case STGINTR:
-
-		return ( intraddr (p));
-
-	case STGSTFUNCT:
-
-		errstr("invalid use of statement function %.64s.", p->fvarname);
-		return putconst((Constp)ICON(0));
-	}
-	badstg("mkaddr", p->vstg);
-	/* NOT REACHED */ return 0;
-}
-
-
-
-
-/* mkarg -- create storage for a new parameter.  This is called when a
-   function returns a string (for the return value, which is the first
-   parameter), or when a variable-length string is passed to a function. */
-
- Addrp
-#ifdef KR_headers
-mkarg(type, argno)
-	int type;
-	int argno;
-#else
-mkarg(int type, int argno)
-#endif
-{
-	register Addrp p;
-
-	p = ALLOC(Addrblock);
-	p->tag = TADDR;
-	p->vtype = type;
-	p->vclass = CLVAR;
-
-/* TYLENG is the type of the field holding the length of a character string */
-
-	p->vstg = (type==TYLENG ? STGLENG : STGARG);
-	p->memno = argno;
-	return(p);
-}
-
-
-
-
-/* mkprim -- Create a PRIM (primary/primitive) block consisting of a
-   Nameblock (or Paramblock), arguments (actual params or array
-   subscripts) and substring bounds.  Requires that   v   have lots of
-   extra (uninitialized) storage, since it could be a paramblock or
-   nameblock */
-
- expptr
-#ifdef KR_headers
-mkprim(v0, args, substr)
-	Namep v0;
-	struct Listblock *args;
-	chainp substr;
-#else
-mkprim(Namep v0, struct Listblock *args, chainp substr)
-#endif
-{
-	typedef union {
-		struct Paramblock paramblock;
-		struct Nameblock nameblock;
-		struct Headblock headblock;
-		} *Primu;
-	register Primu v = (Primu)v0;
-	register struct Primblock *p;
-
-	if(v->headblock.vclass == CLPARAM)
-	{
-
-/* v   is to be a Paramblock */
-
-		if(args || substr)
-		{
-			errstr("no qualifiers on parameter name %s",
-			    v->paramblock.fvarname);
-			frexpr((expptr)args);
-			if(substr)
-			{
-				frexpr((tagptr)substr->datap);
-				frexpr((tagptr)substr->nextp->datap);
-				frchain(&substr);
-			}
-			frexpr((expptr)v);
-			return( errnode() );
-		}
-		return( (expptr) cpexpr(v->paramblock.paramval) );
-	}
-
-	p = ALLOC(Primblock);
-	p->tag = TPRIM;
-	p->vtype = v->nameblock.vtype;
-
-/* v   is to be a Nameblock */
-
-	p->namep = (Namep) v;
-	p->argsp = args;
-	if(substr)
-	{
-		p->fcharp = (expptr) substr->datap;
-		p->lcharp = (expptr) substr->nextp->datap;
-		frchain(&substr);
-	}
-	return( (expptr) p);
-}
-
-
-
-/* vardcl -- attempt to fill out the Name template for variable   v.
-   This function is called on identifiers known to be variables or
-   recursive references to the same function */
-
- void
-#ifdef KR_headers
-vardcl(v)
-	register Namep v;
-#else
-vardcl(register Namep v)
-#endif
-{
-	struct Dimblock *t;
-	expptr neltp;
-	extern int doing_stmtfcn;
-
-	if(v->vclass == CLUNKNOWN) {
-		v->vclass = CLVAR;
-		if (v->vinftype) {
-			v->vtype = TYUNKNOWN;
-			if (v->vdcldone) {
-				v->vdcldone = 0;
-				impldcl(v);
-				}
-			}
-		}
-	if(v->vdcldone)
-		return;
-	if(v->vclass == CLNAMELIST)
-		return;
-
-	if(v->vtype == TYUNKNOWN)
-		impldcl(v);
-	else if(v->vclass!=CLVAR && v->vprocclass!=PTHISPROC)
-	{
-		dclerr("used as variable", v);
-		return;
-	}
-	if(v->vstg==STGUNKNOWN) {
-		if (doing_stmtfcn) {
-			/* neither declare this variable if its only use */
-			/* is in defining a stmt function, nor complain  */
-			/* that it is never used */
-			v->vimpldovar = 1;
-			return;
-			}
-		v->vstg = implstg[ letter(v->fvarname[0]) ];
-		v->vimplstg = 1;
-		}
-
-/* Compute the actual storage location, i.e. offsets from base addresses,
-   possibly the stack pointer */
-
-	switch(v->vstg)
-	{
-	case STGBSS:
-		v->vardesc.varno = ++lastvarno;
-		break;
-	case STGAUTO:
-		if(v->vclass==CLPROC && v->vprocclass==PTHISPROC)
-			break;
-		if(t = v->vdim)
-			if( (neltp = t->nelt) && ISCONST(neltp) ) ;
-			else
-				dclerr("adjustable automatic array", v);
-		break;
-
-	default:
-		break;
-	}
-	v->vdcldone = YES;
-}
-
-
-
-/* Set the implicit type declaration of parameter   p   based on its first
-   letter */
-
- void
-#ifdef KR_headers
-impldcl(p)
-	register Namep p;
-#else
-impldcl(register Namep p)
-#endif
-{
-	register int k;
-	int type;
-	ftnint leng;
-
-	if(p->vdcldone || (p->vclass==CLPROC && p->vprocclass==PINTRINSIC) )
-		return;
-	if(p->vtype == TYUNKNOWN)
-	{
-		k = letter(p->fvarname[0]);
-		type = impltype[ k ];
-		leng = implleng[ k ];
-		if(type == TYUNKNOWN)
-		{
-			if(p->vclass == CLPROC)
-				return;
-			dclerr("attempt to use undefined variable", p);
-			type = dflttype[k];
-			leng = 0;
-		}
-		settype(p, type, leng);
-		p->vimpltype = 1;
-	}
-}
-
- void
-#ifdef KR_headers
-inferdcl(np, type)
-	Namep np;
-	int type;
-#else
-inferdcl(Namep np, int type)
-#endif
-{
-	int k = impltype[letter(np->fvarname[0])];
-	if (k != type) {
-		np->vinftype = 1;
-		np->vtype = type;
-		frexpr(np->vleng);
-		np->vleng = 0;
-		}
-	np->vimpltype = 0;
-	np->vinfproc = 1;
-	}
-
- LOCAL int
-#ifdef KR_headers
-zeroconst(e)
-	expptr e;
-#else
-zeroconst(expptr e)
-#endif
-{
-	register Constp c = (Constp) e;
-	if (c->tag == TCONST)
-		switch(c->vtype) {
-		case TYINT1:
-		case TYSHORT:
-		case TYLONG:
-#ifdef TYQUAD
-		case TYQUAD:
-#endif
-			return c->Const.ci == 0;
-
-		case TYREAL:
-		case TYDREAL:
-			if (c->vstg == 1)
-				return !strcmp(c->Const.cds[0],"0.");
-			return c->Const.cd[0] == 0.;
-
-		case TYCOMPLEX:
-		case TYDCOMPLEX:
-			if (c->vstg == 1)
-				return !strcmp(c->Const.cds[0],"0.")
-				    && !strcmp(c->Const.cds[1],"0.");
-			return c->Const.cd[0] == 0. && c->Const.cd[1] == 0.;
-		}
-	return 0;
-	}
-
-
-#define ICONEQ(z, c)  (ISICON(z) && z->constblock.Const.ci==c)
-#define COMMUTE	{ e = lp;  lp = rp;  rp = e; }
-
-/* mkexpr -- Make expression, and simplify constant subcomponents (tree
-   order is not preserved).  Assumes that   lp   is nonempty, and uses
-   fold()   to simplify adjacent constants */
-
- expptr
-#ifdef KR_headers
-mkexpr(opcode, lp, rp)
-	int opcode;
-	register expptr lp;
-	register expptr rp;
-#else
-mkexpr(int opcode, register expptr lp, register expptr rp)
-#endif
-{
-	register expptr e, e1;
-	int etype;
-	int ltype, rtype;
-	int ltag, rtag;
-	long L;
-	static long divlineno;
-
-	ltype = lp->headblock.vtype;
-	ltag = lp->tag;
-	if(rp && opcode!=OPCALL && opcode!=OPCCALL)
-	{
-		rtype = rp->headblock.vtype;
-		rtag = rp->tag;
-	}
-	else rtype = 0;
-
-	etype = cktype(opcode, ltype, rtype);
-	if(etype == TYERROR)
-		goto error;
-
-	switch(opcode)
-	{
-		/* check for multiplication by 0 and 1 and addition to 0 */
-
-	case OPSTAR:
-		if( ISCONST(lp) )
-			COMMUTE
-
-		if( ISICON(rp) )
-			{
-				if(rp->constblock.Const.ci == 0)
-					goto retright;
-				goto mulop;
-			}
-		break;
-
-	case OPSLASH:
-	case OPMOD:
-		if( zeroconst(rp) && lineno != divlineno ) {
-			warn("attempted division by zero");
-			divlineno = lineno;
-			}
-		if(opcode == OPMOD)
-			break;
-
-/* Handle multiplying or dividing by 1, -1 */
-
-mulop:
-		if( ISICON(rp) )
-		{
-			if(rp->constblock.Const.ci == 1)
-				goto retleft;
-
-			if(rp->constblock.Const.ci == -1)
-			{
-				frexpr(rp);
-				return( mkexpr(OPNEG, lp, ENULL) );
-			}
-		}
-
-/* Group all constants together.  In particular,
-
-	(x * CONST1) * CONST2 ==> x * (CONST1 * CONST2)
-	(x * CONST1) / CONST2 ==> x * (CONST1 / CONST2)
-*/
-
-		if (!ISINT(etype) || lp->tag != TEXPR || !lp->exprblock.rightp
-				|| !ISICON(lp->exprblock.rightp))
-			break;
-
-		if (lp->exprblock.opcode == OPLSHIFT) {
-			L = 1 << lp->exprblock.rightp->constblock.Const.ci;
-			if (opcode == OPSTAR || ISICON(rp) &&
-					!(L % rp->constblock.Const.ci)) {
-				lp->exprblock.opcode = OPSTAR;
-				lp->exprblock.rightp->constblock.Const.ci = L;
-				}
-			}
-
-		if (lp->exprblock.opcode == OPSTAR) {
-			if(opcode == OPSTAR)
-				e = mkexpr(OPSTAR, lp->exprblock.rightp, rp);
-			else if(ISICON(rp) &&
-			    (lp->exprblock.rightp->constblock.Const.ci %
-			    rp->constblock.Const.ci) == 0)
-				e = mkexpr(OPSLASH, lp->exprblock.rightp, rp);
-			else	break;
-
-			e1 = lp->exprblock.leftp;
-			free( (charptr) lp );
-			return( mkexpr(OPSTAR, e1, e) );
-			}
-		break;
-
-
-	case OPPLUS:
-		if( ISCONST(lp) )
-			COMMUTE
-			    goto addop;
-
-	case OPMINUS:
-		if( ICONEQ(lp, 0) )
-		{
-			frexpr(lp);
-			return( mkexpr(OPNEG, rp, ENULL) );
-		}
-
-		if( ISCONST(rp) && is_negatable((Constp)rp))
-		{
-			opcode = OPPLUS;
-			consnegop((Constp)rp);
-		}
-
-/* Group constants in an addition expression (also subtraction, since the
-   subtracted value was negated above).  In particular,
-
-	(x + CONST1) + CONST2 ==> x + (CONST1 + CONST2)
-*/
-
-addop:
-		if( ISICON(rp) )
-		{
-			if(rp->constblock.Const.ci == 0)
-				goto retleft;
-			if( ISPLUSOP(lp) && ISICON(lp->exprblock.rightp) )
-			{
-				e = mkexpr(OPPLUS, lp->exprblock.rightp, rp);
-				e1 = lp->exprblock.leftp;
-				free( (charptr) lp );
-				return( mkexpr(OPPLUS, e1, e) );
-			}
-		}
-		if (opcode == OPMINUS && (ISINT(etype) || doing_vleng)) {
-			/* check for (i [+const]) - (i [+const]) */
-			if (lp->tag == TPRIM)
-				e = lp;
-			else if (lp->tag == TEXPR && lp->exprblock.opcode == OPPLUS
-					&& lp->exprblock.rightp->tag == TCONST) {
-				e = lp->exprblock.leftp;
-				if (e->tag != TPRIM)
-					break;
-				}
-			else
-				break;
-			if (e->primblock.argsp)
-				break;
-			if (rp->tag == TPRIM)
-				e1 = rp;
-			else if (rp->tag == TEXPR && rp->exprblock.opcode == OPPLUS
-					&& rp->exprblock.rightp->tag == TCONST) {
-				e1 = rp->exprblock.leftp;
-				if (e1->tag != TPRIM)
-					break;
-				}
-			else
-				break;
-			if (e->primblock.namep != e1->primblock.namep
-					|| e1->primblock.argsp)
-				break;
-			L = e == lp ? 0 : lp->exprblock.rightp->constblock.Const.ci;
-			if (e1 != rp)
-				L -= rp->exprblock.rightp->constblock.Const.ci;
-			frexpr(lp);
-			frexpr(rp);
-			return ICON(L);
-			}
-
-		break;
-
-
-	case OPPOWER:
-		break;
-
-/* Eliminate outermost double negations */
-
-	case OPNEG:
-	case OPNEG1:
-		if(ltag==TEXPR && lp->exprblock.opcode==OPNEG)
-		{
-			e = lp->exprblock.leftp;
-			free( (charptr) lp );
-			return(e);
-		}
-		break;
-
-/* Eliminate outermost double NOTs */
-
-	case OPNOT:
-		if(ltag==TEXPR && lp->exprblock.opcode==OPNOT)
-		{
-			e = lp->exprblock.leftp;
-			free( (charptr) lp );
-			return(e);
-		}
-		break;
-
-	case OPCALL:
-	case OPCCALL:
-		etype = ltype;
-		if(rp!=NULL && rp->listblock.listp==NULL)
-		{
-			free( (charptr) rp );
-			rp = NULL;
-		}
-		break;
-
-	case OPAND:
-	case OPOR:
-		if( ISCONST(lp) )
-			COMMUTE
-
-			    if( ISCONST(rp) )
-			{
-				if(rp->constblock.Const.ci == 0)
-					if(opcode == OPOR)
-						goto retleft;
-					else
-						goto retright;
-				else if(opcode == OPOR)
-					goto retright;
-				else
-					goto retleft;
-			}
-	case OPEQV:
-	case OPNEQV:
-
-	case OPBITAND:
-	case OPBITOR:
-	case OPBITXOR:
-	case OPBITNOT:
-	case OPLSHIFT:
-	case OPRSHIFT:
-	case OPBITTEST:
-	case OPBITCLR:
-	case OPBITSET:
-#ifdef TYQUAD
-	case OPQBITCLR:
-	case OPQBITSET:
-#endif
-
-	case OPLT:
-	case OPGT:
-	case OPLE:
-	case OPGE:
-	case OPEQ:
-	case OPNE:
-
-	case OPCONCAT:
-		break;
-	case OPMIN:
-	case OPMAX:
-	case OPMIN2:
-	case OPMAX2:
-	case OPDMIN:
-	case OPDMAX:
-
-	case OPASSIGN:
-	case OPASSIGNI:
-	case OPPLUSEQ:
-	case OPSTAREQ:
-	case OPMINUSEQ:
-	case OPSLASHEQ:
-	case OPMODEQ:
-	case OPLSHIFTEQ:
-	case OPRSHIFTEQ:
-	case OPBITANDEQ:
-	case OPBITXOREQ:
-	case OPBITOREQ:
-
-	case OPCONV:
-	case OPADDR:
-	case OPWHATSIN:
-
-	case OPCOMMA:
-	case OPCOMMA_ARG:
-	case OPQUEST:
-	case OPCOLON:
-	case OPDOT:
-	case OPARROW:
-	case OPIDENTITY:
-	case OPCHARCAST:
-	case OPABS:
-	case OPDABS:
-		break;
-
-	default:
-		badop("mkexpr", opcode);
-	}
-
-	e = (expptr) ALLOC(Exprblock);
-	e->exprblock.tag = TEXPR;
-	e->exprblock.opcode = opcode;
-	e->exprblock.vtype = etype;
-	e->exprblock.leftp = lp;
-	e->exprblock.rightp = rp;
-	if(ltag==TCONST && (rp==0 || rtag==TCONST) )
-		e = fold(e);
-	return(e);
-
-retleft:
-	frexpr(rp);
-	if (lp->tag == TPRIM)
-		lp->primblock.parenused = 1;
-	return(lp);
-
-retright:
-	frexpr(lp);
-	if (rp->tag == TPRIM)
-		rp->primblock.parenused = 1;
-	return(rp);
-
-error:
-	frexpr(lp);
-	if(rp && opcode!=OPCALL && opcode!=OPCCALL)
-		frexpr(rp);
-	return( errnode() );
-}
-
-#define ERR(s)   { errs = s; goto error; }
-
-/* cktype -- Check and return the type of the expression */
-
-#ifdef KR_headers
-cktype(op, lt, rt)
-	register int op;
-	register int lt;
-	register int rt;
-#else
-cktype(register int op, register int lt, register int rt)
-#endif
-{
-	char *errs;
-
-	if(lt==TYERROR || rt==TYERROR)
-		goto error1;
-
-	if(lt==TYUNKNOWN)
-		return(TYUNKNOWN);
-	if(rt==TYUNKNOWN)
-
-/* If not unary operation, return UNKNOWN */
-
-		if(!is_unary_op (op) && op != OPCALL && op != OPCCALL)
-			return(TYUNKNOWN);
-
-	switch(op)
-	{
-	case OPPLUS:
-	case OPMINUS:
-	case OPSTAR:
-	case OPSLASH:
-	case OPPOWER:
-	case OPMOD:
-		if( ISNUMERIC(lt) && ISNUMERIC(rt) )
-			return( maxtype(lt, rt) );
-		ERR("nonarithmetic operand of arithmetic operator")
-
-	case OPNEG:
-	case OPNEG1:
-		if( ISNUMERIC(lt) )
-			return(lt);
-		ERR("nonarithmetic operand of negation")
-
-	case OPNOT:
-		if(ISLOGICAL(lt))
-			return(lt);
-		ERR("NOT of nonlogical")
-
-	case OPAND:
-	case OPOR:
-	case OPEQV:
-	case OPNEQV:
-		if(ISLOGICAL(lt) && ISLOGICAL(rt))
-			return( maxtype(lt, rt) );
-		ERR("nonlogical operand of logical operator")
-
-	case OPLT:
-	case OPGT:
-	case OPLE:
-	case OPGE:
-	case OPEQ:
-	case OPNE:
-		if(lt==TYCHAR || rt==TYCHAR || ISLOGICAL(lt) || ISLOGICAL(rt))
-		{
-			if(lt != rt){
-				if (htype
-					&& (lt == TYCHAR && ISNUMERIC(rt)
-					 || rt == TYCHAR && ISNUMERIC(lt)))
-						return TYLOGICAL;
-				ERR("illegal comparison")
-				}
-		}
-
-		else if( ISCOMPLEX(lt) || ISCOMPLEX(rt) )
-		{
-			if(op!=OPEQ && op!=OPNE)
-				ERR("order comparison of complex data")
-		}
-
-		else if( ! ISNUMERIC(lt) || ! ISNUMERIC(rt) )
-			ERR("comparison of nonarithmetic data")
-	case OPBITTEST:
-		return(TYLOGICAL);
-
-	case OPCONCAT:
-		if(lt==TYCHAR && rt==TYCHAR)
-			return(TYCHAR);
-		ERR("concatenation of nonchar data")
-
-	case OPCALL:
-	case OPCCALL:
-	case OPIDENTITY:
-		return(lt);
-
-	case OPADDR:
-	case OPCHARCAST:
-		return(TYADDR);
-
-	case OPCONV:
-		if(rt == 0)
-			return(0);
-		if(lt==TYCHAR && ISINT(rt) )
-			return(TYCHAR);
-		if (ISLOGICAL(lt) && ISLOGICAL(rt))
-			return lt;
-	case OPASSIGN:
-	case OPASSIGNI:
-	case OPMINUSEQ:
-	case OPPLUSEQ:
-	case OPSTAREQ:
-	case OPSLASHEQ:
-	case OPMODEQ:
-	case OPLSHIFTEQ:
-	case OPRSHIFTEQ:
-	case OPBITANDEQ:
-	case OPBITXOREQ:
-	case OPBITOREQ:
-		if( ISINT(lt) && rt==TYCHAR)
-			return(lt);
-		if (ISLOGICAL(lt) && ISLOGICAL(rt) && op == OPASSIGN)
-			return lt;
-		if(lt==TYCHAR || rt==TYCHAR || ISLOGICAL(lt) || ISLOGICAL(rt))
-			if((op!=OPASSIGN && op != OPPLUSEQ && op != OPMINUSEQ)
-			    || (lt!=rt))
-			{
-				ERR("impossible conversion")
-			}
-		return(lt);
-
-	case OPMIN:
-	case OPMAX:
-	case OPDMIN:
-	case OPDMAX:
-	case OPMIN2:
-	case OPMAX2:
-	case OPBITOR:
-	case OPBITAND:
-	case OPBITXOR:
-	case OPBITNOT:
-	case OPLSHIFT:
-	case OPRSHIFT:
-	case OPWHATSIN:
-	case OPABS:
-	case OPDABS:
-		return(lt);
-
-	case OPBITCLR:
-	case OPBITSET:
-		if (lt < TYLONG)
-			lt = TYLONG;
-		return(lt);
-#ifdef TYQUAD
-	case OPQBITCLR:
-	case OPQBITSET:
-		return TYQUAD;
-#endif
-
-	case OPCOMMA:
-	case OPCOMMA_ARG:
-	case OPQUEST:
-	case OPCOLON:		/* Only checks the rightmost type because
-				   of C language definition (rightmost
-				   comma-expr is the value of the expr) */
-		return(rt);
-
-	case OPDOT:
-	case OPARROW:
-	    return (lt);
-	default:
-		badop("cktype", op);
-	}
-error:
-	err(errs);
-error1:
-	return(TYERROR);
-}
-
- static void
-intovfl(Void)
-{ err("overflow simplifying integer constants."); }
-
-/* fold -- simplifies constant expressions; it assumes that e -> leftp and
-   e -> rightp are TCONST or NULL */
-
- expptr
-#ifdef KR_headers
-fold(e)
-	register expptr e;
-#else
-fold(register expptr e)
-#endif
-{
-	Constp p;
-	register expptr lp, rp;
-	int etype, mtype, ltype, rtype, opcode;
-	int i, bl, ll, lr;
-	char *q, *s;
-	struct Constblock lcon, rcon;
-	ftnint L;
-	double d;
-
-	opcode = e->exprblock.opcode;
-	etype = e->exprblock.vtype;
-
-	lp = e->exprblock.leftp;
-	ltype = lp->headblock.vtype;
-	rp = e->exprblock.rightp;
-
-	if(rp == 0)
-		switch(opcode)
-		{
-		case OPNOT:
-			lp->constblock.Const.ci = ! lp->constblock.Const.ci;
- retlp:
-			e->exprblock.leftp = 0;
-			frexpr(e);
-			return(lp);
-
-		case OPBITNOT:
-			lp->constblock.Const.ci = ~ lp->constblock.Const.ci;
-			goto retlp;
-
-		case OPNEG:
-		case OPNEG1:
-			consnegop((Constp)lp);
-			goto retlp;
-
-		case OPCONV:
-		case OPADDR:
-			return(e);
-
-		case OPABS:
-		case OPDABS:
-			switch(ltype) {
-			    case TYINT1:
-			    case TYSHORT:
-			    case TYLONG:
-#ifdef TYQUAD
-			    case TYQUAD:
-#endif
-				if ((L = lp->constblock.Const.ci) < 0) {
-					lp->constblock.Const.ci = -L;
-					if (L != -lp->constblock.Const.ci)
-						intovfl();
-					}
-				goto retlp;
-			    case TYREAL:
-			    case TYDREAL:
-				if (lp->constblock.vstg) {
-				    s = lp->constblock.Const.cds[0];
-				    if (*s == '-')
-					lp->constblock.Const.cds[0] = s + 1;
-				    goto retlp;
-				}
-				if ((d = lp->constblock.Const.cd[0]) < 0.)
-					lp->constblock.Const.cd[0] = -d;
-			    case TYCOMPLEX:
-			    case TYDCOMPLEX:
-				return e;	/* lazy way out */
-			    }
-		default:
-			badop("fold", opcode);
-		}
-
-	rtype = rp->headblock.vtype;
-
-	p = ALLOC(Constblock);
-	p->tag = TCONST;
-	p->vtype = etype;
-	p->vleng = e->exprblock.vleng;
-
-	switch(opcode)
-	{
-	case OPCOMMA:
-	case OPCOMMA_ARG:
-	case OPQUEST:
-	case OPCOLON:
-		goto ereturn;
-
-	case OPAND:
-		p->Const.ci = lp->constblock.Const.ci &&
-		    rp->constblock.Const.ci;
-		break;
-
-	case OPOR:
-		p->Const.ci = lp->constblock.Const.ci ||
-		    rp->constblock.Const.ci;
-		break;
-
-	case OPEQV:
-		p->Const.ci = lp->constblock.Const.ci ==
-		    rp->constblock.Const.ci;
-		break;
-
-	case OPNEQV:
-		p->Const.ci = lp->constblock.Const.ci !=
-		    rp->constblock.Const.ci;
-		break;
-
-	case OPBITAND:
-		p->Const.ci = lp->constblock.Const.ci &
-		    rp->constblock.Const.ci;
-		break;
-
-	case OPBITOR:
-		p->Const.ci = lp->constblock.Const.ci |
-		    rp->constblock.Const.ci;
-		break;
-
-	case OPBITXOR:
-		p->Const.ci = lp->constblock.Const.ci ^
-		    rp->constblock.Const.ci;
-		break;
-
-	case OPLSHIFT:
-		p->Const.ci = lp->constblock.Const.ci <<
-		    rp->constblock.Const.ci;
-		if ((((unsigned long)p->Const.ci) >> rp->constblock.Const.ci)
-				!= lp->constblock.Const.ci)
-			intovfl();
-		break;
-
-	case OPRSHIFT:
-		p->Const.ci = (unsigned long)lp->constblock.Const.ci >>
-		    rp->constblock.Const.ci;
-		break;
-
-	case OPBITTEST:
-		p->Const.ci = (lp->constblock.Const.ci &
-				1L << rp->constblock.Const.ci) != 0;
-		break;
-
-	case OPBITCLR:
-		p->Const.ci = lp->constblock.Const.ci &
-				~(1L << rp->constblock.Const.ci);
-		break;
-
-	case OPBITSET:
-		p->Const.ci = lp->constblock.Const.ci |
-				1L << rp->constblock.Const.ci;
-		break;
-
-	case OPCONCAT:
-		ll = lp->constblock.vleng->constblock.Const.ci;
-		lr = rp->constblock.vleng->constblock.Const.ci;
-		bl = lp->constblock.Const.ccp1.blanks;
-		p->Const.ccp = q = (char *) ckalloc(ll+lr+bl);
-		p->Const.ccp1.blanks = rp->constblock.Const.ccp1.blanks;
-		p->vleng = ICON(ll+lr+bl);
-		s = lp->constblock.Const.ccp;
-		for(i = 0 ; i < ll ; ++i)
-			*q++ = *s++;
-		for(i = 0 ; i < bl ; i++)
-			*q++ = ' ';
-		s = rp->constblock.Const.ccp;
-		for(i = 0; i < lr; ++i)
-			*q++ = *s++;
-		break;
-
-
-	case OPPOWER:
-		if( !ISINT(rtype)
-		 || rp->constblock.Const.ci < 0 && zeroconst(lp))
-			goto ereturn;
-		conspower(p, (Constp)lp, rp->constblock.Const.ci);
-		break;
-
-	case OPSLASH:
-		if (zeroconst(rp))
-			goto ereturn;
-		/* no break */
-
-	default:
-		if(ltype == TYCHAR)
-		{
-			lcon.Const.ci = cmpstr(lp->constblock.Const.ccp,
-			    rp->constblock.Const.ccp,
-			    lp->constblock.vleng->constblock.Const.ci,
-			    rp->constblock.vleng->constblock.Const.ci);
-			rcon.Const.ci = 0;
-			mtype = tyint;
-		}
-		else	{
-			mtype = maxtype(ltype, rtype);
-			consconv(mtype, &lcon, &lp->constblock);
-			consconv(mtype, &rcon, &rp->constblock);
-		}
-		consbinop(opcode, mtype, p, &lcon, &rcon);
-		break;
-	}
-
-	frexpr(e);
-	return( (expptr) p );
- ereturn:
-	free((char *)p);
-	return e;
-}
-
-
-
-/* assign constant l = r , doing coercion */
-
- void
-#ifdef KR_headers
-consconv(lt, lc, rc)
-	int lt;
-	register Constp lc;
-	register Constp rc;
-#else
-consconv(int lt, register Constp lc, register Constp rc)
-#endif
-{
-	int rt = rc->vtype;
-	register union Constant *lv = &lc->Const, *rv = &rc->Const;
-
-	lc->vtype = lt;
-	if (ONEOF(lt, MSKREAL|MSKCOMPLEX) && ONEOF(rt, MSKREAL|MSKCOMPLEX)) {
-		memcpy((char *)lv, (char *)rv, sizeof(union Constant));
-		lc->vstg = rc->vstg;
-		if (ISCOMPLEX(lt) && ISREAL(rt)) {
-			if (rc->vstg)
-				lv->cds[1] = cds("0",CNULL);
-			else
-				lv->cd[1] = 0.;
-			}
-		return;
-		}
-	lc->vstg = 0;
-
-	switch(lt)
-	{
-
-/* Casting to character means just copying the first sizeof (character)
-   bytes into a new 1 character string.  This is weird. */
-
-	case TYCHAR:
-		*(lv->ccp = (char *) ckalloc(1)) = rv->ci;
-		lv->ccp1.blanks = 0;
-		break;
-
-	case TYINT1:
-	case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-		if(rt == TYCHAR)
-			lv->ci = rv->ccp[0];
-		else if( ISINT(rt) )
-			lv->ci = rv->ci;
-		else	lv->ci = rc->vstg ? atof(rv->cds[0]) : rv->cd[0];
-
-		break;
-
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-		lv->cd[1] = 0.;
-		lv->cd[0] = rv->ci;
-		break;
-
-	case TYREAL:
-	case TYDREAL:
-		lv->cd[0] = rv->ci;
-		break;
-
-	case TYLOGICAL:
-	case TYLOGICAL1:
-	case TYLOGICAL2:
-		lv->ci = rv->ci;
-		break;
-	}
-}
-
-
-
-/* Negate constant value -- changes the input node's value */
-
- void
-#ifdef KR_headers
-consnegop(p)
-	register Constp p;
-#else
-consnegop(register Constp p)
-#endif
-{
-	register char *s;
-	ftnint L;
-
-	if (p->vstg) {
-		if (ISCOMPLEX(p->vtype)) {
-			s = p->Const.cds[1];
-			p->Const.cds[1] = *s == '-' ? s+1
-					: *s == '0' ? s : s-1;
-			}
-		s = p->Const.cds[0];
-		p->Const.cds[0] = *s == '-' ? s+1
-				: *s == '0' ? s : s-1;
-		return;
-		}
-	switch(p->vtype)
-	{
-	case TYINT1:
-	case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-		p->Const.ci = -(L = p->Const.ci);
-		if (L != -p->Const.ci)
-			intovfl();
-		break;
-
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-		p->Const.cd[1] = - p->Const.cd[1];
-		/* fall through and do the real parts */
-	case TYREAL:
-	case TYDREAL:
-		p->Const.cd[0] = - p->Const.cd[0];
-		break;
-	default:
-		badtype("consnegop", p->vtype);
-	}
-}
-
-
-
-/* conspower -- Expand out an exponentiation */
-
- LOCAL void
-#ifdef KR_headers
-conspower(p, ap, n)
-	Constp p;
-	Constp ap;
-	ftnint n;
-#else
-conspower(Constp p, Constp ap, ftnint n)
-#endif
-{
-	register union Constant *powp = &p->Const;
-	register int type;
-	struct Constblock x, x0;
-
-	if (n == 1) {
-		memcpy((char *)powp, (char *)&ap->Const, sizeof(ap->Const));
-		return;
-		}
-
-	switch(type = ap->vtype)	/* pow = 1 */
-	{
-	case TYINT1:
-	case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-		powp->ci = 1;
-		break;
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-		powp->cd[1] = 0;
-	case TYREAL:
-	case TYDREAL:
-		powp->cd[0] = 1;
-		break;
-	default:
-		badtype("conspower", type);
-	}
-
-	if(n == 0)
-		return;
-	switch(type)	/* x0 = ap */
-	{
-	case TYINT1:
-	case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-		x0.Const.ci = ap->Const.ci;
-		break;
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-		x0.Const.cd[1] =
-			ap->vstg ? atof(ap->Const.cds[1]) : ap->Const.cd[1];
-	case TYREAL:
-	case TYDREAL:
-		x0.Const.cd[0] =
-			ap->vstg ? atof(ap->Const.cds[0]) : ap->Const.cd[0];
-		break;
-	}
-	x0.vtype = type;
-	x0.vstg = 0;
-	if(n < 0)
-	{
-		n = -n;
-		if( ISINT(type) )
-		{
-			switch(ap->Const.ci) {
-				case 0:
-					err("0 ** negative number");
-					return;
-				case 1:
-				case -1:
-					goto mult;
-				}
-			err("integer ** negative number");
-			return;
-		}
-		else if (!x0.Const.cd[0]
-				&& (!ISCOMPLEX(type) || !x0.Const.cd[1])) {
-			err("0.0 ** negative number");
-			return;
-			}
-		consbinop(OPSLASH, type, &x, p, &x0);
-	}
-	else
- mult:		consbinop(OPSTAR, type, &x, p, &x0);
-
-	for( ; ; )
-	{
-		if(n & 01)
-			consbinop(OPSTAR, type, p, p, &x);
-		if(n >>= 1)
-			consbinop(OPSTAR, type, &x, &x, &x);
-		else
-			break;
-	}
-}
-
-
-
-/* do constant operation cp = a op b -- assumes that   ap and bp   have data
-   matching the input   type */
-
- LOCAL void
-#ifdef KR_headers
-consbinop(opcode, type, cpp, app, bpp)
-	int opcode;
-	int type;
-	Constp cpp;
-	Constp app;
-	Constp bpp;
-#else
-consbinop(int opcode, int type, Constp cpp, Constp app, Constp bpp)
-#endif
-{
-	register union Constant *ap = &app->Const,
-				*bp = &bpp->Const,
-				*cp = &cpp->Const;
-	int k;
-	double ad[2], bd[2], temp;
-	ftnint a, b;
-
-	cpp->vstg = 0;
-
-	if (ONEOF(type, MSKREAL|MSKCOMPLEX)) {
-		ad[0] = app->vstg ? atof(ap->cds[0]) : ap->cd[0];
-		bd[0] = bpp->vstg ? atof(bp->cds[0]) : bp->cd[0];
-		if (ISCOMPLEX(type)) {
-			ad[1] = app->vstg ? atof(ap->cds[1]) : ap->cd[1];
-			bd[1] = bpp->vstg ? atof(bp->cds[1]) : bp->cd[1];
-			}
-		}
-	switch(opcode)
-	{
-	case OPPLUS:
-		switch(type)
-		{
-		case TYINT1:
-		case TYSHORT:
-		case TYLONG:
-#ifdef TYQUAD
-		case TYQUAD:
-#endif
-			cp->ci = ap->ci + bp->ci;
-			if (ap->ci != cp->ci - bp->ci)
-				intovfl();
-			break;
-		case TYCOMPLEX:
-		case TYDCOMPLEX:
-			cp->cd[1] = ad[1] + bd[1];
-		case TYREAL:
-		case TYDREAL:
-			cp->cd[0] = ad[0] + bd[0];
-			break;
-		}
-		break;
-
-	case OPMINUS:
-		switch(type)
-		{
-		case TYINT1:
-		case TYSHORT:
-		case TYLONG:
-#ifdef TYQUAD
-		case TYQUAD:
-#endif
-			cp->ci = ap->ci - bp->ci;
-			if (ap->ci != bp->ci + cp->ci)
-				intovfl();
-			break;
-		case TYCOMPLEX:
-		case TYDCOMPLEX:
-			cp->cd[1] = ad[1] - bd[1];
-		case TYREAL:
-		case TYDREAL:
-			cp->cd[0] = ad[0] - bd[0];
-			break;
-		}
-		break;
-
-	case OPSTAR:
-		switch(type)
-		{
-		case TYINT1:
-		case TYSHORT:
-		case TYLONG:
-#ifdef TYQUAD
-		case TYQUAD:
-#endif
-			cp->ci = (a = ap->ci) * (b = bp->ci);
-			if (a && cp->ci / a != b)
-				intovfl();
-			break;
-		case TYREAL:
-		case TYDREAL:
-			cp->cd[0] = ad[0] * bd[0];
-			break;
-		case TYCOMPLEX:
-		case TYDCOMPLEX:
-			temp = ad[0] * bd[0]  -  ad[1] * bd[1] ;
-			cp->cd[1] = ad[0] * bd[1]  +  ad[1] * bd[0] ;
-			cp->cd[0] = temp;
-			break;
-		}
-		break;
-	case OPSLASH:
-		switch(type)
-		{
-		case TYINT1:
-		case TYSHORT:
-		case TYLONG:
-#ifdef TYQUAD
-		case TYQUAD:
-#endif
-			cp->ci = ap->ci / bp->ci;
-			break;
-		case TYREAL:
-		case TYDREAL:
-			cp->cd[0] = ad[0] / bd[0];
-			break;
-		case TYCOMPLEX:
-		case TYDCOMPLEX:
-			zdiv((dcomplex*)cp, (dcomplex*)ad, (dcomplex*)bd);
-			break;
-		}
-		break;
-
-	case OPMOD:
-		if( ISINT(type) )
-		{
-			cp->ci = ap->ci % bp->ci;
-			break;
-		}
-		else
-			Fatal("inline mod of noninteger");
-
-	case OPMIN2:
-	case OPDMIN:
-		switch(type)
-		{
-		case TYINT1:
-		case TYSHORT:
-		case TYLONG:
-#ifdef TYQUAD
-		case TYQUAD:
-#endif
-			cp->ci = ap->ci <= bp->ci ? ap->ci : bp->ci;
-			break;
-		case TYREAL:
-		case TYDREAL:
-			cp->cd[0] = ad[0] <= bd[0] ? ad[0] : bd[0];
-			break;
-		default:
-			Fatal("inline min of exected type");
-		}
-		break;
-
-	case OPMAX2:
-	case OPDMAX:
-		switch(type)
-		{
-		case TYINT1:
-		case TYSHORT:
-		case TYLONG:
-#ifdef TYQUAD
-		case TYQUAD:
-#endif
-			cp->ci = ap->ci >= bp->ci ? ap->ci : bp->ci;
-			break;
-		case TYREAL:
-		case TYDREAL:
-			cp->cd[0] = ad[0] >= bd[0] ? ad[0] : bd[0];
-			break;
-		default:
-			Fatal("inline max of exected type");
-		}
-		break;
-
-	default:	  /* relational ops */
-		switch(type)
-		{
-		case TYINT1:
-		case TYSHORT:
-		case TYLONG:
-#ifdef TYQUAD
-		case TYQUAD:
-#endif
-			if(ap->ci < bp->ci)
-				k = -1;
-			else if(ap->ci == bp->ci)
-				k = 0;
-			else	k = 1;
-			break;
-		case TYREAL:
-		case TYDREAL:
-			if(ad[0] < bd[0])
-				k = -1;
-			else if(ad[0] == bd[0])
-				k = 0;
-			else	k = 1;
-			break;
-		case TYCOMPLEX:
-		case TYDCOMPLEX:
-			if(ad[0] == bd[0] &&
-			    ad[1] == bd[1] )
-				k = 0;
-			else	k = 1;
-			break;
-		case TYLOGICAL:
-			k = ap->ci - bp->ci;
-		}
-
-		switch(opcode)
-		{
-		case OPEQ:
-			cp->ci = (k == 0);
-			break;
-		case OPNE:
-			cp->ci = (k != 0);
-			break;
-		case OPGT:
-			cp->ci = (k == 1);
-			break;
-		case OPLT:
-			cp->ci = (k == -1);
-			break;
-		case OPGE:
-			cp->ci = (k >= 0);
-			break;
-		case OPLE:
-			cp->ci = (k <= 0);
-			break;
-		}
-		break;
-	}
-}
-
-
-
-/* conssgn - returns the sign of a Fortran constant */
-
-#ifdef KR_headers
-conssgn(p)
-	register expptr p;
-#else
-conssgn(register expptr p)
-#endif
-{
-	register char *s;
-
-	if( ! ISCONST(p) )
-		Fatal( "sgn(nonconstant)" );
-
-	switch(p->headblock.vtype)
-	{
-	case TYINT1:
-	case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-		if(p->constblock.Const.ci > 0) return(1);
-		if(p->constblock.Const.ci < 0) return(-1);
-		return(0);
-
-	case TYREAL:
-	case TYDREAL:
-		if (p->constblock.vstg) {
-			s = p->constblock.Const.cds[0];
-			if (*s == '-')
-				return -1;
-			if (*s == '0')
-				return 0;
-			return 1;
-			}
-		if(p->constblock.Const.cd[0] > 0) return(1);
-		if(p->constblock.Const.cd[0] < 0) return(-1);
-		return(0);
-
-
-/* The sign of a complex number is 0 iff the number is 0 + 0i, else it's 1 */
-
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-		if (p->constblock.vstg)
-			return *p->constblock.Const.cds[0] != '0'
-			    && *p->constblock.Const.cds[1] != '0';
-		return(p->constblock.Const.cd[0]!=0 || p->constblock.Const.cd[1]!=0);
-
-	default:
-		badtype( "conssgn", p->constblock.vtype);
-	}
-	/* NOT REACHED */ return 0;
-}
-
-char *powint[ ] = {
-	"pow_ii",
-#ifdef TYQUAD
-		  "pow_qq",
-#endif
-		  "pow_ri", "pow_di", "pow_ci", "pow_zi" };
-
- LOCAL expptr
-#ifdef KR_headers
-mkpower(p)
-	register expptr p;
-#else
-mkpower(register expptr p)
-#endif
-{
-	register expptr q, lp, rp;
-	int ltype, rtype, mtype, tyi;
-
-	lp = p->exprblock.leftp;
-	rp = p->exprblock.rightp;
-	ltype = lp->headblock.vtype;
-	rtype = rp->headblock.vtype;
-
-	if (lp->tag == TADDR)
-		lp->addrblock.parenused = 0;
-
-	if (rp->tag == TADDR)
-		rp->addrblock.parenused = 0;
-
-	if(ISICON(rp))
-	{
-		if(rp->constblock.Const.ci == 0)
-		{
-			frexpr(p);
-			if( ISINT(ltype) )
-				return( ICON(1) );
-			else if (ISREAL (ltype))
-				return mkconv (ltype, ICON (1));
-			else
-				return( (expptr) putconst((Constp)
-					mkconv(ltype, ICON(1))) );
-		}
-		if(rp->constblock.Const.ci < 0)
-		{
-			if( ISINT(ltype) )
-			{
-				frexpr(p);
-				err("integer**negative");
-				return( errnode() );
-			}
-			rp->constblock.Const.ci = - rp->constblock.Const.ci;
-			p->exprblock.leftp = lp
-				= fixexpr((Exprp)mkexpr(OPSLASH, ICON(1), lp));
-		}
-		if(rp->constblock.Const.ci == 1)
-		{
-			frexpr(rp);
-			free( (charptr) p );
-			return(lp);
-		}
-
-		if( ONEOF(ltype, MSKINT|MSKREAL) ) {
-			p->exprblock.vtype = ltype;
-			return(p);
-		}
-	}
-	if( ISINT(rtype) )
-	{
-		if(ltype==TYSHORT && rtype==TYSHORT && (!ISCONST(lp) || tyint==TYSHORT) )
-			q = call2(TYSHORT, "pow_hh", lp, rp);
-		else	{
-			if(ONEOF(ltype,M(TYINT1)|M(TYSHORT)))
-			{
-				ltype = TYLONG;
-				lp = mkconv(TYLONG,lp);
-			}
-#ifdef TYQUAD
-			if (ltype == TYQUAD)
-				rp = mkconv(TYQUAD,rp);
-			else
-#endif
-			rp = mkconv(TYLONG,rp);
-			if (ISCONST(rp)) {
-				tyi = tyint;
-				tyint = TYLONG;
-				rp = (expptr)putconst((Constp)rp);
-				tyint = tyi;
-				}
-			q = call2(ltype, powint[ltype-TYLONG], lp, rp);
-		}
-	}
-	else if( ISREAL( (mtype = maxtype(ltype,rtype)) )) {
-		extern int callk_kludge;
-		callk_kludge = TYDREAL;
-		q = call2(mtype, "pow_dd", mkconv(TYDREAL,lp), mkconv(TYDREAL,rp));
-		callk_kludge = 0;
-		}
-	else	{
-		q  = call2(TYDCOMPLEX, "pow_zz",
-		    mkconv(TYDCOMPLEX,lp), mkconv(TYDCOMPLEX,rp));
-		if(mtype == TYCOMPLEX)
-			q = mkconv(TYCOMPLEX, q);
-	}
-	free( (charptr) p );
-	return(q);
-}
-
-
-/* Complex Division.  Same code as in Runtime Library
-*/
-
-
- LOCAL void
-#ifdef KR_headers
-zdiv(c, a, b)
-	register dcomplex *c;
-	register dcomplex *a;
-	register dcomplex *b;
-#else
-zdiv(register dcomplex *c, register dcomplex *a, register dcomplex *b)
-#endif
-{
-	double ratio, den;
-	double abr, abi;
-
-	if( (abr = b->dreal) < 0.)
-		abr = - abr;
-	if( (abi = b->dimag) < 0.)
-		abi = - abi;
-	if( abr <= abi )
-	{
-		if(abi == 0)
-			Fatal("complex division by zero");
-		ratio = b->dreal / b->dimag ;
-		den = b->dimag * (1 + ratio*ratio);
-		c->dreal = (a->dreal*ratio + a->dimag) / den;
-		c->dimag = (a->dimag*ratio - a->dreal) / den;
-	}
-
-	else
-	{
-		ratio = b->dimag / b->dreal ;
-		den = b->dreal * (1 + ratio*ratio);
-		c->dreal = (a->dreal + a->dimag*ratio) / den;
-		c->dimag = (a->dimag - a->dreal*ratio) / den;
-	}
-}
-
-
- void
-#ifdef KR_headers
-sserr(np) Namep np;
-#else
-sserr(Namep np)
-#endif
-{
-	errstr(np->vtype == TYCHAR
-		? "substring of character array %.70s"
-		: "substring of noncharacter %.73s", np->fvarname);
-	}
diff --git a/usr.bin/f2c/f2c.1 b/usr.bin/f2c/f2c.1
deleted file mode 100644
index d068b60..0000000
--- a/usr.bin/f2c/f2c.1
+++ /dev/null
@@ -1,305 +0,0 @@
-.\" mdoc translation of the f2c.1 manpage (deprecated -man format) supplied
-.\" with f2c.  The original manpage did not have a copyright statement, but
-.\" the file /usr/src/bin/f2c/Notice states:
-.\"
-.\"/****************************************************************
-.\"Copyright 1990 - 1997 by AT&T Bell Laboratories and Bellcore.
-.\"
-.\"Permission to use, copy, modify, and distribute this software
-.\"and its documentation for any purpose and without fee is hereby
-.\"granted, provided that the above copyright notice appear in all
-.\"copies and that both that the copyright notice and this
-.\"permission notice and warranty disclaimer appear in supporting
-.\"documentation, and that the names of AT&T Bell Laboratories or
-.\"Bellcore or any of their entities not be used in advertising or
-.\"publicity pertaining to distribution of the software without
-.\"specific, written prior permission.
-.\"
-.\"AT&T and Bellcore disclaim all warranties with regard to this
-.\"software, including all implied warranties of merchantability
-.\"and fitness.  In no event shall AT&T or Bellcore be liable for
-.\"any special, indirect or consequential damages or any damages
-.\"whatsoever resulting from loss of use, data or profits, whether
-.\"in an action of contract, negligence or other tortious action,
-.\"arising out of or in connection with the use or performance of
-.\"this software.
-.\"****************************************************************/
-.\"
-.\"     $Id$
-.\"
-.Dd April 19, 1996
-.Os "AT&T Bell Lab and Bellcore"
-.Dt F2C 1
-.Sh NAME
-.Nm f2c
-.Nd Convert Fortran 77 to C or C++
-.Sh SYNOPSIS
-.Nm f2c
-.Op Fl AaCcEfgpRrsUuvw
-.Op Fl C++
-.Op Fl cd
-.Op Fl d Ar dir
-.Op Fl ec
-.Op Fl e1c
-.Op Fl ext
-.Op Fl h Ns Op Cm d
-.Op Fl \&I2
-.Op Fl \&i2
-.Op Fl i90
-.Op Fl kr Ns Op Cm d
-.Op Fl o Ar name
-.Op Fl onetrip
-.Op Fl P Ns Op Cm s
-.Op Fl r8
-.Op Fl 72
-.Op Fl T Ar dir
-.Op Fl w8
-.Op Fl W Ns Ar n
-.Op Fl z
-.Op Fl !bs
-.Op Fl !c
-.Op Fl !I
-.Op Fl !i8
-.Op Fl !it
-.Op Fl !P
-.Ar file ...
-.Sh DESCRIPTION
-.Nm F2c
-converts Fortran 77 source code in
-.Ar files
-with names ending in
-.So \&.f Sc
-or
-.So \&.F Sc
-to C (or C++) source files in the current directory, with
-.So \&.c Sc
-substituted for the final
-.So \&.f Sc
-or
-.So \&.F Sc .
-If no Fortran files are named,
-.Nm f2c
-reads Fortran from standard input and writes C on standard output.
-.Ar File
-names that end with
-.So \&.p Sc
-or
-.So \&.P Sc
-are taken to be prototype files, as produced by option
-.Fl P ,
-and are read first.
-.Sh OPTIONS
-.Bl -tag -width flag
-.It Fl A
-Produce ANSI C.  Default is old-style C.
-.It Fl a
-Make local variables automatic rather than static unless they appear in a
-DATA , EQUIVALENCE , NAMELIST , or SAVE statement.
-.It Fl C
-Compile code to check that subscripts are within declared array bounds.
-.It Fl C++
-Output C++ code.
-.It Fl c
-Include original Fortran source as comments.
-.It Fl cd
-Do not recognize cdabs, cdcos, cdexp, cdlog, cdsin, and
-cdsqrt as synonyms for the double complex intrinsics
-zabs, zcos, zexp, zlog, zsin, and zsqrt, respectively.
-.It Fl d Ar dir
-Write `.c' files in directory 
-.Ar dir 
-instead of the current directory
-.It Fl E
-Declare uninitialized COMMON to be Extern (overridably defined in
-.Pa f2c.h
-as
-.Em extern
-).
-.It Fl ec
-Place uninitialized COMMON blocks in separate files:
-COMMON ABC appears in file abc_com.c .
-Option
-.Fl e1c
-bundles the separate files
-into the output file, with comments that give an unbundling
-.Xr sed 1
-script.
-.It Fl e1c
-See
-.Fl ec .
-.It Fl ext
-Complain about Fortran 77 extensions.
-.It Fl f
-Assume free-format input: accept text after column 72 and do not
-pad fixed-format lines shorter than 72 characters with blanks.
-.It Fl 72
-Treat text appearing after column 72 as an error.
-.It Fl g
-Include original Fortran line numbers in
-.Sy #line
-lines.
-.It Fl h Ns Op Cm d
-Emulate Fortran 66's treatment of Hollerith: try to align character strings on
-word (or, if the option is
-.Fl hd ,
-on double-word) boundaries.
-.It Fl \&I2
-Render INTEGER and LOGICAL as short, INTEGER*4 as long int.  Assume the
-default
-.Em libF77
-and
-.Em libI77
-allow only INTEGER*4 (and no LOGICAL) variables in INQUIREs.  Option
-.Fl \&I4
-confirms the default rendering of INTEGER as long int.
-.It Fl \&i2
-Similar to
-.Fl \&I2 ,
-but assume a modified
-.Em libF77
-and
-.Em libI77
-(compiled with
-.Fl Df2c_i2 ),
-so INTEGER and LOGICAL variables may be assigned by INQUIRE and array lengths
-are stored in short ints
-.It Fl i90 
-Do not recognize the Fortran 90 bit-manipulation intrinsics btest,
-iand, ibclr, ibits, ibset, ieor, ior, ishft, and ishftc.
-.It Fl kr Ns Op Cm d
-Use temporary values to enforce Fortran expression evaluation
-where K&R (first edition) parenthesization rules allow rearrangement.
-If the option is
-.Fl krd ,
-use double precision temporaries even for single-precision operands.
-.It Fl o Ar name
-The C source code is written into file
-.Ar name .
-.It Fl onetrip
-Compile DO loops that are performed at least once if reached.  (Fortran 77 DO
-loops are not performed at all if the upper limit is smaller than the lower
-limit.)
-.It Fl P Ns Op Cm s
-Write a
-.Ar file Ns \&.P
-of ANSI (or C++) prototypes for definitions in each input
-.Ar file Ns \&.f
-or
-.Ar file Ns \&.F .
-When reading Fortran from standard input, write prototypes at the beginning of
-standard output.  Option
-.Fl Ps
-implies
-.Fl P
-and gives exit status 4 if rerunning
-.Nm f2c
-may change prototypes or declarations.
-.It Fl p
-Supply preprocessor definitions to make common-block members look like local
-variables.
-.It Fl v
-Echo the file name, program name, and procedure name(s) during compilation.
-.It Fl R
-Do not promote REAL functions and operations to DOUBLE PRECISION.  Option
-.Fl !R
-confirms the default, which imitates Fortran 77.
-.It Fl r
-Cast values of REAL functions (including intrinsics) to REAL.
-.It Fl r8
-Promote REAL to DOUBLE PRECISION, COMPLEX to DOUBLE COMPLEX.
-.It Fl s
-Preserve multidimensional subscripts.
-.It Fl T Ar dir
-Put temporary files in directory
-.Ar dir .
-.It Fl U
-Honor the case of variable and external names.  Fortran keywords must be in
-.Em lower
-case.
-.It Fl u
-Make the default type of a variable
-.So undefined Sc
-rather than using the default Fortran rules.
-.It Fl w
-Suppress all warning messages.  If the option is
-.Fl w66 ,
-only Fortran 66 compatibility warnings are suppressed.
-.It Fl w8
-Suppress warnings when COMMON or EQUIVALENCE forces odd-word alignment of
-doubles.
-.It Fl W Ns Ar n
-Assume
-.Ar n
-characters/word (default 4) when initializing numeric variables with character
-data.
-.It Fl z
-Do not implicitly recognize DOUBLE COMPLEX.
-.It Fl !bs
-Do not recognize
-.Em backslash
-escapes
-(\e", \e', \e0, \e\e, \eb, \ef, \en, \er, \et, \ev) in character strings.
-.It Fl !c
-Inhibit C output, but produce
-.Fl P
-output.
-.It Fl !I
-Reject
-.Sy include
-statements.
-.It Fl !i8
-Disallow INTEGER*8.
-.It Fl !it
-Don't infer types of untyped EXTERNAL procedures from use as parameters to
-previously defined or prototyped procedures.
-.It Fl !P
-Do not attempt to infer ANSI or C++ prototypes from usage.
-.El
-.Pp
-Object code should be loaded by with
-.Xr ld 1
-or
-.Xr cc 1
-and the following libraries need to specified:
-.Fl lf2c lm .
-.Sh FILES
-.Ar file Ns \&.[fF]
-input file
-
-.Ar file Ns \&.c
-output file
-
-.Pa /usr/include/f2c.h
-header file
-
-.Pa /usr/lib/libf2c.a
-intrinsic function library and Fortran 77 I/O library
-
-.Sh "SEE ALSO"
-.Rs
-.%A S. I. Feldman
-.%A P. J. Weinberger
-.%T A Portable Fortran 77 Compiler
-.%B UNIX Time Sharing System Programmer's Manual
-.%V Volume 2
-.%D 1990
-.%O AT&T Bell Laboratories
-.%N Tenth Edition
-.Re
-.Sh DIAGNOSTICS
-The diagnostics produced by
-.Nm f2c
-are intended to be
-self-explanatory.
-.Sh BUGS
-Floating-point constant expressions are simplified in
-the floating-point arithmetic of the machine running
-.Nm f2c
-so they are typically accurate to at most 16 or 17 decimal places.
-.Pp
-Untypable EXTERNAL functions are declared int.
-.Pp
-There are several undocumented valid options for
-.Nm f2c .
-These options are discussed at the top of 
-.Pa /usr/src/usr.bin/f2c/main.c .
diff --git a/usr.bin/f2c/f2c.h b/usr.bin/f2c/f2c.h
deleted file mode 100644
index 61f72af..0000000
--- a/usr.bin/f2c/f2c.h
+++ /dev/null
@@ -1,223 +0,0 @@
-/* f2c.h  --  Standard Fortran to C header file */
-
-/**  barf  [ba:rf]  2.  "He suggested using FORTRAN, and everybody barfed."
-
-	- From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
-
-#ifndef F2C_INCLUDE
-#define F2C_INCLUDE
-
-typedef int integer;
-typedef unsigned int uinteger;
-typedef char *address;
-typedef short int shortint;
-typedef float real;
-typedef double doublereal;
-typedef struct { real r, i; } complex;
-typedef struct { doublereal r, i; } doublecomplex;
-typedef int logical;
-typedef short int shortlogical;
-typedef char logical1;
-typedef char integer1;
-#if 0	/* Adjust for integer*8. */
-typedef long long longint;		/* system-dependent */
-typedef unsigned long long ulongint;	/* system-dependent */
-#define qbit_clear(a,b)	((a) & ~((ulongint)1 << (b)))
-#define qbit_set(a,b)	((a) |  ((ulongint)1 << (b)))
-#endif
-
-#define TRUE_ (1)
-#define FALSE_ (0)
-
-/* Extern is for use with -E */
-#ifndef Extern
-#define Extern extern
-#endif
-
-/* I/O stuff */
-
-#ifdef f2c_i2
-/* for -i2 */
-typedef short flag;
-typedef short ftnlen;
-typedef short ftnint;
-#else
-typedef int flag;
-typedef int ftnlen;
-typedef int ftnint;
-#endif
-
-/*external read, write*/
-typedef struct
-{	flag cierr;
-	ftnint ciunit;
-	flag ciend;
-	char *cifmt;
-	ftnint cirec;
-} cilist;
-
-/*internal read, write*/
-typedef struct
-{	flag icierr;
-	char *iciunit;
-	flag iciend;
-	char *icifmt;
-	ftnint icirlen;
-	ftnint icirnum;
-} icilist;
-
-/*open*/
-typedef struct
-{	flag oerr;
-	ftnint ounit;
-	char *ofnm;
-	ftnlen ofnmlen;
-	char *osta;
-	char *oacc;
-	char *ofm;
-	ftnint orl;
-	char *oblnk;
-} olist;
-
-/*close*/
-typedef struct
-{	flag cerr;
-	ftnint cunit;
-	char *csta;
-} cllist;
-
-/*rewind, backspace, endfile*/
-typedef struct
-{	flag aerr;
-	ftnint aunit;
-} alist;
-
-/* inquire */
-typedef struct
-{	flag inerr;
-	ftnint inunit;
-	char *infile;
-	ftnlen infilen;
-	ftnint	*inex;	/*parameters in standard's order*/
-	ftnint	*inopen;
-	ftnint	*innum;
-	ftnint	*innamed;
-	char	*inname;
-	ftnlen	innamlen;
-	char	*inacc;
-	ftnlen	inacclen;
-	char	*inseq;
-	ftnlen	inseqlen;
-	char 	*indir;
-	ftnlen	indirlen;
-	char	*infmt;
-	ftnlen	infmtlen;
-	char	*inform;
-	ftnint	informlen;
-	char	*inunf;
-	ftnlen	inunflen;
-	ftnint	*inrecl;
-	ftnint	*innrec;
-	char	*inblank;
-	ftnlen	inblanklen;
-} inlist;
-
-#define VOID void
-
-union Multitype {	/* for multiple entry points */
-	integer1 g;
-	shortint h;
-	integer i;
-	/* longint j; */
-	real r;
-	doublereal d;
-	complex c;
-	doublecomplex z;
-	};
-
-typedef union Multitype Multitype;
-
-/*typedef long int Long;*/	/* No longer used; formerly in Namelist */
-
-struct Vardesc {	/* for Namelist */
-	char *name;
-	char *addr;
-	ftnlen *dims;
-	int  type;
-	};
-typedef struct Vardesc Vardesc;
-
-struct Namelist {
-	char *name;
-	Vardesc **vars;
-	int nvars;
-	};
-typedef struct Namelist Namelist;
-
-#define abs(x) ((x) >= 0 ? (x) : -(x))
-#define dabs(x) (doublereal)abs(x)
-#define min(a,b) ((a) <= (b) ? (a) : (b))
-#define max(a,b) ((a) >= (b) ? (a) : (b))
-#define dmin(a,b) (doublereal)min(a,b)
-#define dmax(a,b) (doublereal)max(a,b)
-#define bit_test(a,b)	((a) >> (b) & 1)
-#define bit_clear(a,b)	((a) & ~((uinteger)1 << (b)))
-#define bit_set(a,b)	((a) |  ((uinteger)1 << (b)))
-
-/* procedure parameter types for -A and -C++ */
-
-#define F2C_proc_par_types 1
-#ifdef __cplusplus
-typedef int /* Unknown procedure type */ (*U_fp)(...);
-typedef shortint (*J_fp)(...);
-typedef integer (*I_fp)(...);
-typedef real (*R_fp)(...);
-typedef doublereal (*D_fp)(...), (*E_fp)(...);
-typedef /* Complex */ VOID (*C_fp)(...);
-typedef /* Double Complex */ VOID (*Z_fp)(...);
-typedef logical (*L_fp)(...);
-typedef shortlogical (*K_fp)(...);
-typedef /* Character */ VOID (*H_fp)(...);
-typedef /* Subroutine */ int (*S_fp)(...);
-#else
-typedef int /* Unknown procedure type */ (*U_fp)();
-typedef shortint (*J_fp)();
-typedef integer (*I_fp)();
-typedef real (*R_fp)();
-typedef doublereal (*D_fp)(), (*E_fp)();
-typedef /* Complex */ VOID (*C_fp)();
-typedef /* Double Complex */ VOID (*Z_fp)();
-typedef logical (*L_fp)();
-typedef shortlogical (*K_fp)();
-typedef /* Character */ VOID (*H_fp)();
-typedef /* Subroutine */ int (*S_fp)();
-#endif
-/* E_fp is for real functions when -R is not specified */
-typedef VOID C_f;	/* complex function */
-typedef VOID H_f;	/* character function */
-typedef VOID Z_f;	/* double complex function */
-typedef doublereal E_f;	/* real function with -R not specified */
-
-/* undef any lower-case symbols that your C compiler predefines, e.g.: */
-
-#ifndef Skip_f2c_Undefs
-#undef cray
-#undef gcos
-#undef mc68010
-#undef mc68020
-#undef mips
-#undef pdp11
-#undef sgi
-#undef sparc
-#undef sun
-#undef sun2
-#undef sun3
-#undef sun4
-#undef u370
-#undef u3b
-#undef u3b2
-#undef u3b5
-#undef unix
-#undef vax
-#endif
-#endif
diff --git a/usr.bin/f2c/format.c b/usr.bin/f2c/format.c
deleted file mode 100644
index 1e92d3b..0000000
--- a/usr.bin/f2c/format.c
+++ /dev/null
@@ -1,2523 +0,0 @@
-/****************************************************************
-Copyright 1990 - 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-/* Format.c -- this file takes an intermediate file (generated by pass 1
-   of the translator) and some state information about the contents of that
-   file, and generates C program text. */
-
-#include "defs.h"
-#include "p1defs.h"
-#include "format.h"
-#include "output.h"
-#include "names.h"
-#include "iob.h"
-
-int c_output_line_length = DEF_C_LINE_LENGTH;
-
-int last_was_label;	/* Boolean used to generate semicolons
-				   when a label terminates a block */
-static char this_proc_name[52];	/* Name of the current procedure.  This is
-				   probably too simplistic to handle
-				   multiple entry points */
-
-static tagptr do_format Argdcl((FILEP, FILEP));
-static void do_p1_1while Argdcl((FILEP));
-static void do_p1_2while Argdcl((FILEP, FILEP));
-static tagptr do_p1_addr Argdcl((FILEP, FILEP));
-static void do_p1_asgoto Argdcl((FILEP, FILEP));
-static tagptr do_p1_charp Argdcl((FILEP));
-static void do_p1_comment Argdcl((FILEP, FILEP));
-static void do_p1_comp_goto Argdcl((FILEP, FILEP));
-static tagptr do_p1_const Argdcl((FILEP));
-static void do_p1_elif Argdcl((FILEP, FILEP));
-static void do_p1_else Argdcl((FILEP));
-static void do_p1_elseifstart Argdcl((FILEP));
-static void do_p1_end_for Argdcl((FILEP));
-static void do_p1_endelse Argdcl((FILEP));
-static void do_p1_endif Argdcl((FILEP));
-static tagptr do_p1_expr Argdcl((FILEP, FILEP));
-static tagptr do_p1_extern Argdcl((FILEP));
-static void do_p1_for Argdcl((FILEP, FILEP));
-static void do_p1_fortran Argdcl((FILEP, FILEP));
-static void do_p1_goto Argdcl((FILEP, FILEP));
-static tagptr do_p1_head Argdcl((FILEP, FILEP));
-static tagptr do_p1_ident Argdcl((FILEP));
-static void do_p1_if Argdcl((FILEP, FILEP));
-static void do_p1_label Argdcl((FILEP, FILEP));
-static tagptr do_p1_list Argdcl((FILEP, FILEP));
-static tagptr do_p1_literal Argdcl((FILEP));
-static tagptr do_p1_name_pointer Argdcl((FILEP));
-static void do_p1_set_line Argdcl((FILEP));
-static void do_p1_subr_ret Argdcl((FILEP, FILEP));
-static int get_p1_token Argdcl((FILEP));
-static int p1get_const Argdcl((FILEP, int, Constp*));
-static int p1getd Argdcl((FILEP, long int*));
-static int p1getf Argdcl((FILEP, char**));
-static int p1getn Argdcl((FILEP, int, char**));
-static int p1gets Argdcl((FILEP, char*, int));
-static void proto Argdcl((FILEP, Argtypes*, char*));
-
-extern chainp assigned_fmts;
-char filename[P1_FILENAME_MAX];
-extern int gflag, sharp_line;
-int gflag1;
-extern char *parens;
-
- void
-start_formatting(Void)
-{
-    FILE *infile;
-    static int wrote_one = 0;
-    extern int usedefsforcommon;
-    extern char *p1_file, *p1_bakfile;
-
-    this_proc_name[0] = '\0';
-    last_was_label = 0;
-    ei_next = ei_first;
-    wh_next = wh_first;
-
-    (void) fclose (pass1_file);
-    if ((infile = fopen (p1_file, binread)) == NULL)
-	Fatal("start_formatting:  couldn't open the intermediate file\n");
-
-    if (wrote_one)
-	nice_printf (c_file, "\n");
-
-    while (!feof (infile)) {
-	expptr this_expr;
-
-	this_expr = do_format (infile, c_file);
-	if (this_expr) {
-	    out_and_free_statement (c_file, this_expr);
-	} /* if this_expr */
-    } /* while !feof infile */
-
-    (void) fclose (infile);
-
-    if (last_was_label)
-	nice_printf (c_file, ";\n");
-
-    prev_tab (c_file);
-    gflag1 = sharp_line = 0;
-    if (this_proc_name[0])
-	nice_printf (c_file, "} /* %s */\n", this_proc_name);
-
-
-/* Write the #undefs for common variable reference */
-
-    if (usedefsforcommon) {
-	Extsym *ext;
-	int did_one = 0;
-
-	for (ext = extsymtab; ext < nextext; ext++)
-	    if (ext -> extstg == STGCOMMON && ext -> used_here) {
-		ext -> used_here = 0;
-		if (!did_one)
-		    nice_printf (c_file, "\n");
-		wr_abbrevs(c_file, 0, ext->extp);
-		did_one = 1;
-		ext -> extp = CHNULL;
-	    } /* if */
-
-	if (did_one)
-	    nice_printf (c_file, "\n");
-    } /* if usedefsforcommon */
-
-    other_undefs(c_file);
-
-    wrote_one = 1;
-
-/* For debugging only */
-
-    if (debugflag && (pass1_file = fopen (p1_bakfile, binwrite)))
-	if (infile = fopen (p1_file, binread)) {
-	    ffilecopy (infile, pass1_file);
-	    fclose (infile);
-	    fclose (pass1_file);
-	} /* if infile */
-
-/* End of "debugging only" */
-
-    scrub(p1_file);	/* optionally unlink */
-
-    if ((pass1_file = fopen (p1_file, binwrite)) == NULL)
-	err ("start_formatting:  couldn't reopen the pass1 file");
-
-} /* start_formatting */
-
-
- static void
-#ifdef KR_headers
-put_semi(outfile)
-	FILE *outfile;
-#else
-put_semi(FILE *outfile)
-#endif
-{
-	nice_printf (outfile, ";\n");
-	last_was_label = 0;
-	}
-
-#define SEM_CHECK(x) if (last_was_label) put_semi(x)
-
-/* do_format -- takes an input stream (a file in pass1 format) and writes
-   the appropriate C code to   outfile   when possible.  When reading an
-   expression, the expression tree is returned instead. */
-
- static expptr
-#ifdef KR_headers
-do_format(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_format(FILE *infile, FILE *outfile)
-#endif
-{
-    int token_type, was_c_token;
-    expptr retval = ENULL;
-
-    token_type = get_p1_token (infile);
-    was_c_token = 1;
-    switch (token_type) {
-	case P1_COMMENT:
-	    do_p1_comment (infile, outfile);
-	    was_c_token = 0;
-	    break;
-	case P1_SET_LINE:
-	    do_p1_set_line (infile);
-	    was_c_token = 0;
-	    break;
-	case P1_FILENAME:
-	    p1gets(infile, filename, P1_FILENAME_MAX);
-	    was_c_token = 0;
-	    break;
-	case P1_NAME_POINTER:
-	    retval = do_p1_name_pointer (infile);
-	    break;
-	case P1_CONST:
-	    retval = do_p1_const (infile);
-	    break;
-	case P1_EXPR:
-	    retval = do_p1_expr (infile, outfile);
-	    break;
-	case P1_IDENT:
-	    retval = do_p1_ident(infile);
-	    break;
-	case P1_CHARP:
-		retval = do_p1_charp(infile);
-		break;
-	case P1_EXTERN:
-	    retval = do_p1_extern (infile);
-	    break;
-	case P1_HEAD:
-	    gflag1 = sharp_line = 0;
-	    retval = do_p1_head (infile, outfile);
-	    gflag1 = sharp_line = gflag;
-	    break;
-	case P1_LIST:
-	    retval = do_p1_list (infile, outfile);
-	    break;
-	case P1_LITERAL:
-	    retval = do_p1_literal (infile);
-	    break;
-	case P1_LABEL:
-	    do_p1_label (infile, outfile);
-	    /* last_was_label = 1; -- now set in do_p1_label */
-	    was_c_token = 0;
-	    break;
-	case P1_ASGOTO:
-	    do_p1_asgoto (infile, outfile);
-	    break;
-	case P1_GOTO:
-	    do_p1_goto (infile, outfile);
-	    break;
-	case P1_IF:
-	    do_p1_if (infile, outfile);
-	    break;
-	case P1_ELSE:
-	    SEM_CHECK(outfile);
-	    do_p1_else (outfile);
-	    break;
-	case P1_ELIF:
-	    SEM_CHECK(outfile);
-	    do_p1_elif (infile, outfile);
-	    break;
-	case P1_ENDIF:
-	    SEM_CHECK(outfile);
-	    do_p1_endif (outfile);
-	    break;
-	case P1_ENDELSE:
-	    SEM_CHECK(outfile);
-	    do_p1_endelse (outfile);
-	    break;
-	case P1_ADDR:
-	    retval = do_p1_addr (infile, outfile);
-	    break;
-	case P1_SUBR_RET:
-	    do_p1_subr_ret (infile, outfile);
-	    break;
-	case P1_COMP_GOTO:
-	    do_p1_comp_goto (infile, outfile);
-	    break;
-	case P1_FOR:
-	    do_p1_for (infile, outfile);
-	    break;
-	case P1_ENDFOR:
-	    SEM_CHECK(outfile);
-	    do_p1_end_for (outfile);
-	    break;
-	case P1_WHILE1START:
-		do_p1_1while(outfile);
-		break;
-	case P1_WHILE2START:
-		do_p1_2while(infile, outfile);
-		break;
-	case P1_PROCODE:
-		procode(outfile);
-		break;
-	case P1_ELSEIFSTART:
-		SEM_CHECK(outfile);
-		do_p1_elseifstart(outfile);
-		break;
-	case P1_FORTRAN:
-		do_p1_fortran(infile, outfile);
-		/* no break; */
-	case P1_EOF:
-	    was_c_token = 0;
-	    break;
-	case P1_UNKNOWN:
-	    Fatal("do_format:  Unknown token type in intermediate file");
-	    break;
-	default:
-	    Fatal("do_format:  Bad token type in intermediate file");
-	    break;
-   } /* switch */
-
-    if (was_c_token)
-	last_was_label = 0;
-    return retval;
-} /* do_format */
-
-
- static void
-#ifdef KR_headers
-do_p1_comment(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_comment(FILE *infile, FILE *outfile)
-#endif
-{
-    extern int in_comment;
-
-    char storage[COMMENT_BUFFER_SIZE + 1];
-    int length;
-
-    if (!p1gets(infile, storage, COMMENT_BUFFER_SIZE + 1))
-	return;
-
-    length = strlen (storage);
-
-    gflag1 = sharp_line = 0;
-    in_comment = 1;
-    margin_printf(outfile, length ? "/* %s */\n" : "\n", storage);
-    in_comment = 0;
-    gflag1 = sharp_line = gflag;
-} /* do_p1_comment */
-
- static void
-#ifdef KR_headers
-do_p1_set_line(infile)
-	FILE *infile;
-#else
-do_p1_set_line(FILE *infile)
-#endif
-{
-    int status;
-    long new_line_number = -1;
-
-    status = p1getd (infile, &new_line_number);
-
-    if (status == EOF)
-	err ("do_p1_set_line:  Missing line number at end of file\n");
-    else if (status == 0 || new_line_number == -1)
-	errl("do_p1_set_line:  Illegal line number in intermediate file: %ld\n",
-		new_line_number);
-    else {
-	lineno = new_line_number;
-	}
-} /* do_p1_set_line */
-
-
- static expptr
-#ifdef KR_headers
-do_p1_name_pointer(infile)
-	FILE *infile;
-#else
-do_p1_name_pointer(FILE *infile)
-#endif
-{
-    Namep namep = (Namep) NULL;
-    int status;
-
-    status = p1getd (infile, (long *) &namep);
-
-    if (status == EOF)
-	err ("do_p1_name_pointer:  Missing pointer at end of file\n");
-    else if (status == 0 || namep == (Namep) NULL)
-	erri ("do_p1_name_pointer:  Illegal name pointer in p1 file: '%x'\n",
-		(int) namep);
-
-    return (expptr) namep;
-} /* do_p1_name_pointer */
-
-
-
- static expptr
-#ifdef KR_headers
-do_p1_const(infile)
-	FILE *infile;
-#else
-do_p1_const(FILE *infile)
-#endif
-{
-    struct Constblock *c = (struct Constblock *) NULL;
-    long type = -1;
-    int status;
-
-    status = p1getd (infile, &type);
-
-    if (status == EOF)
-	err ("do_p1_const:  Missing constant type at end of file\n");
-    else if (status == 0)
-	errl("do_p1_const:  Illegal constant type in p1 file: %ld\n", type);
-    else {
-	status = p1get_const (infile, (int)type, &c);
-
-	if (status == EOF) {
-	    err ("do_p1_const:  Missing constant value at end of file\n");
-	    c = (struct Constblock *) NULL;
-	} else if (status == 0) {
-	    err ("do_p1_const:  Illegal constant value in p1 file\n");
-	    c = (struct Constblock *) NULL;
-	} /* else */
-    } /* else */
-    return (expptr) c;
-} /* do_p1_const */
-
- void
-#ifdef KR_headers
-addrlit(addrp)
-	Addrp addrp;
-#else
-addrlit(Addrp addrp)
-#endif
-{
-	long memno = addrp->memno;
-	struct Literal *litp, *lastlit;
-
-	lastlit = litpool + nliterals;
-	for (litp = litpool; litp < lastlit; litp++)
-	    if (litp->litnum == memno) {
-		addrp->vtype = litp->littype;
-		*((union Constant *) &(addrp->user)) =
-			*((union Constant *) &(litp->litval));
-		addrp->vstg = STGMEMNO;
-		return;
-		}
-	err("addrlit failure!");
-	}
-
- static expptr
-#ifdef KR_headers
-do_p1_literal(infile)
-	FILE *infile;
-#else
-do_p1_literal(FILE *infile)
-#endif
-{
-    int status;
-    long memno;
-    Addrp addrp;
-
-    status = p1getd (infile, &memno);
-
-    if (status == EOF)
-	err ("do_p1_literal:  Missing memno at end of file");
-    else if (status == 0)
-	err ("do_p1_literal:  Missing memno in p1 file");
-    else {
-	addrp = ALLOC (Addrblock);
-	addrp -> tag = TADDR;
-	addrp -> vtype = TYUNKNOWN;
-	addrp -> Field = NULL;
-	addrp -> memno = memno;
-	addrlit(addrp);
-	addrp -> uname_tag = UNAM_CONST;
-    } /* else */
-
-    return (expptr) addrp;
-} /* do_p1_literal */
-
-
- static void
-#ifdef KR_headers
-do_p1_label(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_label(FILE *infile, FILE *outfile)
-#endif
-{
-    int status;
-    ftnint stateno;
-    struct Labelblock *L;
-    char *fmt;
-
-    status = p1getd (infile, &stateno);
-
-    if (status == EOF)
-	err ("do_p1_label:  Missing label at end of file");
-    else if (status == 0)
-	err ("do_p1_label:  Missing label in p1 file ");
-    else if (stateno < 0) {	/* entry */
-	margin_printf(outfile, "\n%s:\n", user_label(stateno));
-	last_was_label = 1;
-	}
-    else {
-	L = labeltab + stateno;
-	if (L->labused) {
-		fmt = "%s:\n";
-		last_was_label = 1;
-		}
-	else
-		fmt = "/* %s: */\n";
-	margin_printf(outfile, fmt, user_label(L->stateno));
-    } /* else */
-} /* do_p1_label */
-
-
-
- static void
-#ifdef KR_headers
-do_p1_asgoto(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_asgoto(FILE *infile, FILE *outfile)
-#endif
-{
-    expptr expr;
-
-    expr = do_format (infile, outfile);
-    out_asgoto (outfile, expr);
-
-} /* do_p1_asgoto */
-
-
- static void
-#ifdef KR_headers
-do_p1_goto(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_goto(FILE *infile, FILE *outfile)
-#endif
-{
-    int status;
-    long stateno;
-
-    status = p1getd (infile, &stateno);
-
-    if (status == EOF)
-	err ("do_p1_goto:  Missing goto label at end of file");
-    else if (status == 0)
-	err ("do_p1_goto:  Missing goto label in p1 file");
-    else {
-	nice_printf (outfile, "goto %s;\n", user_label (stateno));
-    } /* else */
-} /* do_p1_goto */
-
-
- static void
-#ifdef KR_headers
-do_p1_if(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_if(FILE *infile, FILE *outfile)
-#endif
-{
-    expptr cond;
-
-    do {
-        cond = do_format (infile, outfile);
-    } while (cond == ENULL);
-
-    out_if (outfile, cond);
-} /* do_p1_if */
-
-
- static void
-#ifdef KR_headers
-do_p1_else(outfile)
-	FILE *outfile;
-#else
-do_p1_else(FILE *outfile)
-#endif
-{
-    out_else (outfile);
-} /* do_p1_else */
-
-
- static void
-#ifdef KR_headers
-do_p1_elif(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_elif(FILE *infile, FILE *outfile)
-#endif
-{
-    expptr cond;
-
-    do {
-        cond = do_format (infile, outfile);
-    } while (cond == ENULL);
-
-    elif_out (outfile, cond);
-} /* do_p1_elif */
-
- static void
-#ifdef KR_headers
-do_p1_endif(outfile)
-	FILE *outfile;
-#else
-do_p1_endif(FILE *outfile)
-#endif
-{
-    endif_out (outfile);
-} /* do_p1_endif */
-
-
- static void
-#ifdef KR_headers
-do_p1_endelse(outfile)
-	FILE *outfile;
-#else
-do_p1_endelse(FILE *outfile)
-#endif
-{
-    end_else_out (outfile);
-} /* do_p1_endelse */
-
-
- static expptr
-#ifdef KR_headers
-do_p1_addr(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_addr(FILE *infile, FILE *outfile)
-#endif
-{
-    Addrp addrp = (Addrp) NULL;
-    int status;
-
-    status = p1getn (infile, (int)sizeof(struct Addrblock), (char **) &addrp);
-
-    if (status == EOF)
-	err ("do_p1_addr:  Missing Addrp at end of file");
-    else if (status == 0)
-	err ("do_p1_addr:  Missing Addrp in p1 file");
-    else if (addrp == (Addrp) NULL)
-	err ("do_p1_addr:  Null addrp in p1 file");
-    else if (addrp -> tag != TADDR)
-	erri ("do_p1_addr: bad tag in p1 file '%d'", addrp -> tag);
-    else {
-	addrp -> vleng = do_format (infile, outfile);
-	addrp -> memoffset = do_format (infile, outfile);
-    }
-
-    return (expptr) addrp;
-} /* do_p1_addr */
-
-
-
- static void
-#ifdef KR_headers
-do_p1_subr_ret(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_subr_ret(FILE *infile, FILE *outfile)
-#endif
-{
-    expptr retval;
-
-    nice_printf (outfile, "return ");
-    retval = do_format (infile, outfile);
-    if (!multitype)
-	if (retval)
-		expr_out (outfile, retval);
-
-    nice_printf (outfile, ";\n");
-} /* do_p1_subr_ret */
-
-
-
- static void
-#ifdef KR_headers
-do_p1_comp_goto(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_comp_goto(FILE *infile, FILE *outfile)
-#endif
-{
-    expptr index;
-    expptr labels;
-
-    index = do_format (infile, outfile);
-
-    if (index == ENULL) {
-	err ("do_p1_comp_goto:  no expression for computed goto");
-	return;
-    } /* if index == ENULL */
-
-    labels = do_format (infile, outfile);
-
-    if (labels && labels -> tag != TLIST)
-	erri ("do_p1_comp_goto:  expected list, got tag '%d'", labels -> tag);
-    else
-	compgoto_out (outfile, index, labels);
-} /* do_p1_comp_goto */
-
-
- static void
-#ifdef KR_headers
-do_p1_for(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_for(FILE *infile, FILE *outfile)
-#endif
-{
-    expptr init, test, inc;
-
-    init = do_format (infile, outfile);
-    test = do_format (infile, outfile);
-    inc = do_format (infile, outfile);
-
-    out_for (outfile, init, test, inc);
-} /* do_p1_for */
-
- static void
-#ifdef KR_headers
-do_p1_end_for(outfile)
-	FILE *outfile;
-#else
-do_p1_end_for(FILE *outfile)
-#endif
-{
-    out_end_for (outfile);
-} /* do_p1_end_for */
-
-
- static void
-#ifdef KR_headers
-do_p1_fortran(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_fortran(FILE *infile, FILE *outfile)
-#endif
-{
-	char buf[P1_STMTBUFSIZE];
-	if (!p1gets(infile, buf, P1_STMTBUFSIZE))
-		return;
-	/* bypass nice_printf nonsense */
-	fprintf(outfile, "/*< %s >*/\n", buf+1);	/* + 1 to skip by '$' */
-	}
-
-
- static expptr
-#ifdef KR_headers
-do_p1_expr(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_expr(FILE *infile, FILE *outfile)
-#endif
-{
-    int status;
-    long opcode, type;
-    struct Exprblock *result = (struct Exprblock *) NULL;
-
-    status = p1getd (infile, &opcode);
-
-    if (status == EOF)
-	err ("do_p1_expr:  Missing expr opcode at end of file");
-    else if (status == 0)
-	err ("do_p1_expr:  Missing expr opcode in p1 file");
-    else {
-
-	status = p1getd (infile, &type);
-
-	if (status == EOF)
-	    err ("do_p1_expr:  Missing expr type at end of file");
-	else if (status == 0)
-	    err ("do_p1_expr:  Missing expr type in p1 file");
-	else if (opcode == 0)
-	    return ENULL;
-	else {
-	    result = ALLOC (Exprblock);
-
-	    result -> tag = TEXPR;
-	    result -> vtype = type;
-	    result -> opcode = opcode;
-	    result -> vleng = do_format (infile, outfile);
-
-	    if (is_unary_op (opcode))
-		result -> leftp = do_format (infile, outfile);
-	    else if (is_binary_op (opcode)) {
-		result -> leftp = do_format (infile, outfile);
-		result -> rightp = do_format (infile, outfile);
-	    } else
-		errl("do_p1_expr:  Illegal opcode %ld", opcode);
-	} /* else */
-    } /* else */
-
-    return (expptr) result;
-} /* do_p1_expr */
-
-
- static expptr
-#ifdef KR_headers
-do_p1_ident(infile)
-	FILE *infile;
-#else
-do_p1_ident(FILE *infile)
-#endif
-{
-	Addrp addrp;
-	int status;
-	long vtype, vstg;
-
-	addrp = ALLOC (Addrblock);
-	addrp -> tag = TADDR;
-
-	status = p1getd (infile, &vtype);
-	if (status == EOF)
-	    err ("do_p1_ident:  Missing identifier type at end of file\n");
-	else if (status == 0 || vtype < 0 || vtype >= NTYPES)
-	    errl("do_p1_ident:  Bad type in intermediate file: %ld\n", vtype);
-	else
-	    addrp -> vtype = vtype;
-
-	status = p1getd (infile, &vstg);
-	if (status == EOF)
-	    err ("do_p1_ident:  Missing identifier storage at end of file\n");
-	else if (status == 0 || vstg < 0 || vstg > STGNULL)
-	    errl("do_p1_ident:  Bad storage in intermediate file: %ld\n", vtype);
-	else
-	    addrp -> vstg = vstg;
-
-	status = p1gets(infile, addrp->user.ident, IDENT_LEN);
-
-	if (status == EOF)
-	    err ("do_p1_ident:  Missing ident string at end of file");
-	else if (status == 0)
-	    err ("do_p1_ident:  Missing ident string in intermediate file");
-	addrp->uname_tag = UNAM_IDENT;
-	return (expptr) addrp;
-} /* do_p1_ident */
-
- static expptr
-#ifdef KR_headers
-do_p1_charp(infile)
-	FILE *infile;
-#else
-do_p1_charp(FILE *infile)
-#endif
-{
-	Addrp addrp;
-	int status;
-	long vtype, vstg;
-	char buf[64];
-
-	addrp = ALLOC (Addrblock);
-	addrp -> tag = TADDR;
-
-	status = p1getd (infile, &vtype);
-	if (status == EOF)
-	    err ("do_p1_ident:  Missing identifier type at end of file\n");
-	else if (status == 0 || vtype < 0 || vtype >= NTYPES)
-	    errl("do_p1_ident:  Bad type in intermediate file: %ld\n", vtype);
-	else
-	    addrp -> vtype = vtype;
-
-	status = p1getd (infile, &vstg);
-	if (status == EOF)
-	    err ("do_p1_ident:  Missing identifier storage at end of file\n");
-	else if (status == 0 || vstg < 0 || vstg > STGNULL)
-	    errl("do_p1_ident:  Bad storage in intermediate file: %ld\n", vtype);
-	else
-	    addrp -> vstg = vstg;
-
-	status = p1gets(infile, buf, (int)sizeof(buf));
-
-	if (status == EOF)
-	    err ("do_p1_ident:  Missing charp ident string at end of file");
-	else if (status == 0)
-	    err ("do_p1_ident:  Missing charp ident string in intermediate file");
-	addrp->uname_tag = UNAM_CHARP;
-	addrp->user.Charp = strcpy(mem(strlen(buf)+1,0), buf);
-	return (expptr) addrp;
-}
-
-
- static expptr
-#ifdef KR_headers
-do_p1_extern(infile)
-	FILE *infile;
-#else
-do_p1_extern(FILE *infile)
-#endif
-{
-    Addrp addrp;
-
-    addrp = ALLOC (Addrblock);
-    if (addrp) {
-	int status;
-
-	addrp->tag = TADDR;
-	addrp->vstg = STGEXT;
-	addrp->uname_tag = UNAM_EXTERN;
-	status = p1getd (infile, &(addrp -> memno));
-	if (status == EOF)
-	    err ("do_p1_extern:  Missing memno at end of file");
-	else if (status == 0)
-	    err ("do_p1_extern:  Missing memno in intermediate file");
-	if (addrp->vtype = extsymtab[addrp->memno].extype)
-		addrp->vclass = CLPROC;
-    } /* if addrp */
-
-    return (expptr) addrp;
-} /* do_p1_extern */
-
-
-
- static expptr
-#ifdef KR_headers
-do_p1_head(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_head(FILE *infile, FILE *outfile)
-#endif
-{
-    int status;
-    int add_n_;
-    long class;
-    char storage[256];
-
-    status = p1getd (infile, &class);
-    if (status == EOF)
-	err ("do_p1_head:  missing header class at end of file");
-    else if (status == 0)
-	err ("do_p1_head:  missing header class in p1 file");
-    else {
-	status = p1gets (infile, storage, (int)sizeof(storage));
-	if (status == EOF || status == 0)
-	    storage[0] = '\0';
-    } /* else */
-
-    if (class == CLPROC || class == CLMAIN) {
-	chainp lengths;
-
-	add_n_ = nentry > 1;
-	lengths = length_comp(entries, add_n_);
-
-	if (!add_n_ && protofile && class != CLMAIN)
-		protowrite(protofile, proctype, storage, entries, lengths);
-
-	if (class == CLMAIN)
-	    nice_printf (outfile, "/* Main program */ ");
-	else
-	    nice_printf(outfile, "%s ", multitype ? "VOID"
-			: c_type_decl(proctype, 1));
-
-	nice_printf(outfile, add_n_ ? "%s0_" : "%s", storage);
-	if (!Ansi) {
-		listargs(outfile, entries, add_n_, lengths);
-		nice_printf (outfile, "\n");
-		}
-	list_arg_types (outfile, entries, lengths, add_n_, "\n");
-	nice_printf (outfile, "{\n");
-	frchain(&lengths);
-	next_tab (outfile);
-	strcpy(this_proc_name, storage);
-	list_decls (outfile);
-
-    } else if (class == CLBLOCK)
-        next_tab (outfile);
-    else
-	errl("do_p1_head: got class %ld", class);
-
-    return NULL;
-} /* do_p1_head */
-
-
- static expptr
-#ifdef KR_headers
-do_p1_list(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_list(FILE *infile, FILE *outfile)
-#endif
-{
-    long tag, type, count;
-    int status;
-    expptr result;
-
-    status = p1getd (infile, &tag);
-    if (status == EOF)
-	err ("do_p1_list:  missing list tag at end of file");
-    else if (status == 0)
-	err ("do_p1_list:  missing list tag in p1 file");
-    else {
-	status = p1getd (infile, &type);
-	if (status == EOF)
-	    err ("do_p1_list:  missing list type at end of file");
-	else if (status == 0)
-	    err ("do_p1_list:  missing list type in p1 file");
-	else {
-	    status = p1getd (infile, &count);
-	    if (status == EOF)
-		err ("do_p1_list:  missing count at end of file");
-	    else if (status == 0)
-		err ("do_p1_list:  missing count in p1 file");
-	} /* else */
-    } /* else */
-
-    result = (expptr) ALLOC (Listblock);
-    if (result) {
-	chainp pointer;
-
-	result -> tag = tag;
-	result -> listblock.vtype = type;
-
-/* Assume there will be enough data */
-
-	if (count--) {
-	    pointer = result->listblock.listp =
-		mkchain((char *)do_format(infile, outfile), CHNULL);
-	    while (count--) {
-		pointer -> nextp =
-			mkchain((char *)do_format(infile, outfile), CHNULL);
-		pointer = pointer -> nextp;
-	    } /* while (count--) */
-	} /* if (count) */
-    } /* if (result) */
-
-    return result;
-} /* do_p1_list */
-
-
- chainp
-#ifdef KR_headers
-length_comp(e, add_n)
-	struct Entrypoint *e;
-	int add_n;
-#else
-length_comp(struct Entrypoint *e, int add_n)
-#endif
-		/* get lengths of characters args */
-{
-	chainp lengths;
-	chainp args, args1;
-	Namep arg, np;
-	int nchargs;
-	Argtypes *at;
-	Atype *a;
-	extern int init_ac[TYSUBR+1];
-
-	if (!e)
-		return 0;	/* possible only with errors */
-	args = args1 = add_n ? allargs : e->arglist;
-	nchargs = 0;
-	for (lengths = NULL; args; args = args -> nextp)
-		if (arg = (Namep)args->datap) {
-			if (arg->vclass == CLUNKNOWN)
-				arg->vclass = CLVAR;
-			if (arg->vtype == TYCHAR && arg->vclass != CLPROC) {
-				lengths = mkchain((char *)arg, lengths);
-				nchargs++;
-				}
-			}
-	if (!add_n && (np = e->enamep)) {
-		/* one last check -- by now we know all we ever will
-		 * about external args...
-		 */
-		save_argtypes(e->arglist, &e->entryname->arginfo,
-			&np->arginfo, 0, np->fvarname, STGEXT, nchargs,
-			np->vtype, 1);
-		at = e->entryname->arginfo;
-		a = at->atypes + init_ac[np->vtype];
-		for(; args1; a++, args1 = args1->nextp) {
-			frchain(&a->cp);
-			if (arg = (Namep)args1->datap)
-			    switch(arg->vclass) {
-				case CLPROC:
-					if (arg->vimpltype
-					&& a->type >= 300)
-						a->type = TYUNKNOWN + 200;
-					break;
-				case CLUNKNOWN:
-					a->type %= 100;
-				}
-			}
-		}
-	return revchain(lengths);
-	}
-
- void
-#ifdef KR_headers
-listargs(outfile, entryp, add_n_, lengths)
-	FILE *outfile;
-	struct Entrypoint *entryp;
-	int add_n_;
-	chainp lengths;
-#else
-listargs(FILE *outfile, struct Entrypoint *entryp, int add_n_, chainp lengths)
-#endif
-{
-	chainp args;
-	char *s;
-	Namep arg;
-	int did_one = 0;
-
-	nice_printf (outfile, "(");
-
-	if (add_n_) {
-		nice_printf(outfile, "n__");
-		did_one = 1;
-		args = allargs;
-		}
-	else {
-		if (!entryp)
-			return;	/* possible only with errors */
-		args = entryp->arglist;
-		}
-
-	if (multitype)
-		{
-		nice_printf(outfile, ", ret_val");
-		did_one = 1;
-		args = allargs;
-		}
-	else if (ONEOF(proctype, MSKCOMPLEX|MSKCHAR))
-		{
-		s = xretslot[proctype]->user.ident;
-		nice_printf(outfile, did_one ? ", %s" : "%s",
-			*s == '(' /*)*/ ? "r_v" : s);
-		did_one = 1;
-		if (proctype == TYCHAR)
-			nice_printf (outfile, ", ret_val_len");
-		}
-	for (; args; args = args -> nextp)
-		if (arg = (Namep)args->datap) {
-			nice_printf (outfile, "%s", did_one ? ", " : "");
-			out_name (outfile, arg);
-			did_one = 1;
-			}
-
-	for (args = lengths; args; args = args -> nextp)
-		nice_printf(outfile, ", %s",
-			new_arg_length((Namep)args->datap));
-	nice_printf (outfile, ")");
-} /* listargs */
-
-
- void
-#ifdef KR_headers
-list_arg_types(outfile, entryp, lengths, add_n_, finalnl)
-	FILE *outfile;
-	struct Entrypoint *entryp;
-	chainp lengths;
-	int add_n_;
-	char *finalnl;
-#else
-list_arg_types(FILE *outfile, struct Entrypoint *entryp, chainp lengths, int add_n_, char *finalnl)
-#endif
-{
-    chainp args;
-    int last_type = -1, last_class = -1;
-    int did_one = 0, done_one, is_ext;
-    char *s, *sep = "", *sep1;
-
-    if (outfile == (FILE *) NULL) {
-	err ("list_arg_types:  null output file");
-	return;
-    } else if (entryp == (struct Entrypoint *) NULL) {
-	err ("list_arg_types:  null procedure entry pointer");
-	return;
-    } /* else */
-
-    if (Ansi) {
-	done_one = 0;
-	sep1 = ", ";
-	nice_printf(outfile, "(" /*)*/);
-	}
-    else {
-	done_one = 1;
-	sep1 = ";\n";
-	}
-    args = entryp->arglist;
-    if (add_n_) {
-	nice_printf(outfile, "int n__");
-	did_one = done_one;
-	sep = sep1;
-	args = allargs;
-	}
-    if (multitype) {
-	nice_printf(outfile, "%sMultitype *ret_val", sep);
-	did_one = done_one;
-	sep = sep1;
-	}
-    else if (ONEOF (proctype, MSKCOMPLEX|MSKCHAR)) {
-	s = xretslot[proctype]->user.ident;
-	nice_printf(outfile, "%s%s *%s", sep, c_type_decl(proctype, 0),
-			*s == '(' /*)*/ ? "r_v" : s);
-	did_one = done_one;
-	sep = sep1;
-	if (proctype == TYCHAR)
-	    nice_printf (outfile, "%sftnlen ret_val_len", sep);
-    } /* if ONEOF proctype */
-    for (; args; args = args -> nextp) {
-	Namep arg = (Namep) args->datap;
-
-/* Scalars are passed by reference, and arrays will have their lower bound
-   adjusted, so nearly everything is printed with a star in front.  The
-   exception is character lengths, which are passed by value. */
-
-	if (arg) {
-	    int type = arg -> vtype, class = arg -> vclass;
-
-	    if (class == CLPROC)
-		if (arg->vimpltype)
-			type = Castargs ? TYUNKNOWN : TYSUBR;
-		else if (type == TYREAL && forcedouble && !Castargs)
-			type = TYDREAL;
-
-	    if (type == last_type && class == last_class && did_one)
-		nice_printf (outfile, ", ");
-	    else
-		if ((is_ext = class == CLPROC) && Castargs)
-			nice_printf(outfile, "%s%s ", sep,
-				usedcasts[type] = casttypes[type]);
-		else
-			nice_printf(outfile, "%s%s ", sep,
-				c_type_decl(type, is_ext));
-	    if (class == CLPROC)
-		if (Castargs)
-			out_name(outfile, arg);
-		else {
-			nice_printf(outfile, "(*");
-			out_name(outfile, arg);
-			nice_printf(outfile, ") %s", parens);
-			}
-	    else {
-		nice_printf (outfile, "*");
-		out_name (outfile, arg);
-		}
-
-	    last_type = type;
-	    last_class = class;
-	    did_one = done_one;
-	    sep = sep1;
-	} /* if (arg) */
-    } /* for args = entryp -> arglist */
-
-    for (args = lengths; args; args = args -> nextp)
-	nice_printf(outfile, "%sftnlen %s", sep,
-			new_arg_length((Namep)args->datap));
-    if (did_one)
-	nice_printf (outfile, ";\n");
-    else if (Ansi)
-	nice_printf(outfile,
-		/*((*/ sep != sep1 && Ansi == 1 ? "void)%s" : ")%s",
-		finalnl);
-} /* list_arg_types */
-
- static void
-#ifdef KR_headers
-write_formats(outfile)
-	FILE *outfile;
-#else
-write_formats(FILE *outfile)
-#endif
-{
-	register struct Labelblock *lp;
-	int first = 1;
-	char *fs;
-
-	for(lp = labeltab ; lp < highlabtab ; ++lp)
-		if (lp->fmtlabused) {
-			if (first) {
-				first = 0;
-				nice_printf(outfile, "/* Format strings */\n");
-				}
-			nice_printf(outfile, "static char fmt_%ld[] = \"",
-				lp->stateno);
-			if (!(fs = lp->fmtstring))
-				fs = "";
-			nice_printf(outfile, "%s\";\n", fs);
-			}
-	if (!first)
-		nice_printf(outfile, "\n");
-	}
-
- static void
-#ifdef KR_headers
-write_ioblocks(outfile)
-	FILE *outfile;
-#else
-write_ioblocks(FILE *outfile)
-#endif
-{
-	register iob_data *L;
-	register char *f, **s, *sep;
-
-	nice_printf(outfile, "/* Fortran I/O blocks */\n");
-	L = iob_list = (iob_data *)revchain((chainp)iob_list);
-	do {
-		nice_printf(outfile, "static %s %s = { ",
-			L->type, L->name);
-		sep = 0;
-		for(s = L->fields; f = *s; s++) {
-			if (sep)
-				nice_printf(outfile, sep);
-			sep = ", ";
-			if (*f == '"') {	/* kludge */
-				nice_printf(outfile, "\"");
-				nice_printf(outfile, "%s\"", f+1);
-				}
-			else
-				nice_printf(outfile, "%s", f);
-			}
-		nice_printf(outfile, " };\n");
-		}
-		while(L = L->next);
-	nice_printf(outfile, "\n\n");
-	}
-
- static void
-#ifdef KR_headers
-write_assigned_fmts(outfile)
-	FILE *outfile;
-#else
-write_assigned_fmts(FILE *outfile)
-#endif
-{
-	register chainp cp;
-	Namep np;
-	char *comma, *type;
-	int did_one = 0;
-
-	cp = assigned_fmts = revchain(assigned_fmts);
-	nice_printf(outfile, "/* Assigned format variables */\n");
-	do {
-		np = (Namep)cp->datap;
-		if (did_one == np->vstg) {
-			comma = ", ";
-			type = "";
-			}
-		else {
-			comma = did_one ? ";\n" : "";
-			type = np->vstg == STGAUTO ? "char " : "static char ";
-			did_one = np->vstg;
-			}
-		nice_printf(outfile, "%s%s*%s_fmt", comma, type, np->fvarname);
-		}
-		while(cp = cp->nextp);
-	nice_printf(outfile, ";\n\n");
-	}
-
- static char *
-#ifdef KR_headers
-to_upper(s)
-	register char *s;
-#else
-to_upper(register char *s)
-#endif
-{
-	static char buf[64];
-	register char *t = buf;
-	register int c;
-	while(*t++ = (c = *s++) >= 'a' && c <= 'z' ? c + 'A' - 'a' : c);
-	return buf;
-	}
-
-
-/* This routine creates static structures representing a namelist.
-   Declarations of the namelist and related structures are:
-
-	struct Vardesc {
-		char *name;
-		char *addr;
-		ftnlen *dims;	/* laid out as struct dimensions below *//*
-		int  type;
-		};
-	typedef struct Vardesc Vardesc;
-
-	struct Namelist {
-		char *name;
-		Vardesc **vars;
-		int nvars;
-		};
-
-	struct dimensions
-		{
-		ftnlen numberofdimensions;
-		ftnlen numberofelements
-		ftnlen baseoffset;
-		ftnlen span[numberofdimensions-1];
-		};
-
-   If dims is not null, then the corner element of the array is at
-   addr.  However,  the element with subscripts (i1,...,in) is at
-   addr + sizeoftype * (i1+span[0]*(i2+span[1]*...) - dimp->baseoffset)
-*/
-
- static void
-#ifdef KR_headers
-write_namelists(nmch, outfile)
-	chainp nmch;
-	FILE *outfile;
-#else
-write_namelists(chainp nmch, FILE *outfile)
-#endif
-{
-	Namep var;
-	struct Hashentry *entry;
-	struct Dimblock *dimp;
-	int i, nd, type;
-	char *comma, *name;
-	register chainp q;
-	register Namep v;
-	extern int typeconv[];
-
-	nice_printf(outfile, "/* Namelist stuff */\n\n");
-	for (entry = hashtab; entry < lasthash; ++entry) {
-		if (!(v = entry->varp) || !v->vnamelist)
-			continue;
-		type = v->vtype;
-		name = v->cvarname;
-		if (dimp = v->vdim) {
-			nd = dimp->ndim;
-			nice_printf(outfile,
-				"static ftnlen %s_dims[] = { %d, %ld, %ld",
-				name, nd,
-				dimp->nelt->constblock.Const.ci,
-				dimp->baseoffset->constblock.Const.ci);
-			for(i = 0, --nd; i < nd; i++)
-				nice_printf(outfile, ", %ld",
-				  dimp->dims[i].dimsize->constblock.Const.ci);
-			nice_printf(outfile, " };\n");
-			}
-		nice_printf(outfile, "static Vardesc %s_dv = { \"%s\", %s",
-			name, to_upper(v->fvarname),
-			type == TYCHAR ? ""
-				: (dimp || oneof_stg(v,v->vstg,
-					M(STGEQUIV)|M(STGCOMMON)))
-				? "(char *)" : "(char *)&");
-		out_name(outfile, v);
-		nice_printf(outfile, dimp ? ", %s_dims" : ", (ftnlen *)0", name);
-		nice_printf(outfile, ", %ld };\n",
-			type != TYCHAR  ? (long)typeconv[type]
-					: -v->vleng->constblock.Const.ci);
-		}
-
-	do {
-		var = (Namep)nmch->datap;
-		name = var->cvarname;
-		nice_printf(outfile, "\nstatic Vardesc *%s_vl[] = ", name);
-		comma = "{";
-		i = 0;
-		for(q = var->varxptr.namelist ; q ; q = q->nextp) {
-			v = (Namep)q->datap;
-			if (!v->vnamelist)
-				continue;
-			i++;
-			nice_printf(outfile, "%s &%s_dv", comma, v->cvarname);
-			comma = ",";
-			}
-		nice_printf(outfile, " };\n");
-		nice_printf(outfile,
-			"static Namelist %s = { \"%s\", %s_vl, %d };\n",
-			name, to_upper(var->fvarname), name, i);
-		}
-		while(nmch = nmch->nextp);
-	nice_printf(outfile, "\n");
-	}
-
-/* fixextype tries to infer from usage in previous procedures
-   the type of an external procedure declared
-   external and passed as an argument but never typed or invoked.
- */
-
- static int
-#ifdef KR_headers
-fixexttype(var)
-	Namep var;
-#else
-fixexttype(Namep var)
-#endif
-{
-	Extsym *e;
-	int type, type1;
-
-	type = var->vtype;
-	e = &extsymtab[var->vardesc.varno];
-	if ((type1 = e->extype) && type == TYUNKNOWN)
-		return var->vtype = type1;
-	if (var->visused) {
-		if (e->exused && type != type1)
-			changedtype(var);
-		e->exused = 1;
-		e->extype = type;
-		}
-	return type;
-	}
-
- static void
-#ifdef KR_headers
-ref_defs(outfile, refdefs)
-	FILE *outfile;
-	chainp refdefs;
-#else
-ref_defs(FILE *outfile, chainp refdefs)
-#endif
-{
-	chainp cp;
-	int eb, i, j, n;
-	struct Dimblock *dimp;
-	expptr b, vl;
-	Namep var;
-	char *amp, *comma;
-
-	margin_printf(outfile, "\n");
-	for(cp = refdefs = revchain(refdefs); cp; cp = cp->nextp) {
-		var = (Namep)cp->datap;
-		cp->datap = 0;
-		amp = "_subscr";
-		if (!(eb = var->vsubscrused)) {
-			var->vrefused = 0;
-			if (!ISCOMPLEX(var->vtype))
-				amp = "_ref";
-			}
-		def_start(outfile, var->cvarname, amp, CNULL);
-		dimp = var->vdim;
-		vl = 0;
-		comma = "(";
-		amp = "";
-		if (var->vtype == TYCHAR) {
-			amp = "&";
-			vl = var->vleng;
-			if (ISCONST(vl) && vl->constblock.Const.ci == 1)
-				vl = 0;
-			nice_printf(outfile, "%sa_0", comma);
-			comma = ",";
-			}
-		n = dimp->ndim;
-		for(i = 1; i <= n; i++, comma = ",")
-			nice_printf(outfile, "%sa_%d", comma, i);
-		nice_printf(outfile, ") %s", amp);
-		if (var->vsubscrused)
-			var->vsubscrused = 0;
-		else if (!ISCOMPLEX(var->vtype)) {
-			out_name(outfile, var);
-			nice_printf(outfile, "[%s", vl ? "(" : "");
-			}
-		for(j = 2; j < n; j++)
-			nice_printf(outfile, "(");
-		while(--i > 1) {
-			nice_printf(outfile, "(a_%d)%s*", i, i == n ? "" : ")");
-			expr_out(outfile, cpexpr(dimp->dims[i-2].dimsize));
-			nice_printf(outfile, " + ");
-			}
-		nice_printf(outfile, "a_1");
-		if (var->vtype == TYCHAR) {
-			if (vl) {
-				nice_printf(outfile, ")*");
-				expr_out(outfile, cpexpr(vl));
-				}
-			nice_printf(outfile, " + a_0");
-			}
-		if ((var->vstg != STGARG /* || checksubs */ )
-		 && (b = dimp->baseoffset)) {
-			b = cpexpr(b);
-			if (var->vtype == TYCHAR)
-				b = mkexpr(OPSTAR, cpexpr(var->vleng), b);
-			nice_printf(outfile, " - ");
-			expr_out(outfile, b);
-			}
-		if (ISCOMPLEX(var->vtype)) {
-			margin_printf(outfile, "\n");
-			def_start(outfile, var->cvarname, "_ref", CNULL);
-			comma = "(";
-			for(i = 1; i <= n; i++, comma = ",")
-				nice_printf(outfile, "%sa_%d", comma, i);
-			nice_printf(outfile, ") %s[%s_subscr",
-				var->cvarname, var->cvarname);
-			comma = "(";
-			for(i = 1; i <= n; i++, comma = ",")
-				nice_printf(outfile, "%sa_%d", comma, i);
-			nice_printf(outfile, ")");
-			}
-		margin_printf(outfile, "]\n" + eb);
-		}
-	nice_printf(outfile, "\n");
-	frchain(&refdefs);
-	}
-
- void
-#ifdef KR_headers
-list_decls(outfile)
-	FILE *outfile;
-#else
-list_decls(FILE *outfile)
-#endif
-{
-    extern chainp used_builtins;
-    extern struct Hashentry *hashtab;
-    struct Hashentry *entry;
-    int write_header = 1;
-    int last_class = -1, last_stg = -1;
-    Namep var;
-    int Alias, Define, did_one, last_type, type;
-    extern int def_equivs, useauto;
-    extern chainp new_vars;	/* Compiler-generated locals */
-    chainp namelists = 0, refdefs = 0;
-    char *ctype;
-    int useauto1 = useauto && !saveall;
-    long x;
-    extern int hsize;
-
-/* First write out the statically initialized data */
-
-    if (initfile)
-	list_init_data(&initfile, initfname, outfile);
-
-/* Next come formats */
-    write_formats(outfile);
-
-/* Now write out the system-generated identifiers */
-
-    if (new_vars || nequiv) {
-	chainp args, next_var, this_var;
-	chainp nv[TYVOID], nv1[TYVOID];
-	int i, j;
-	Addrp Var;
-	Namep arg;
-
-	/* zap unused dimension variables */
-
-	for(args = allargs; args; args = args->nextp) {
-		arg = (Namep)args->datap;
-		if (this_var = arg->vlastdim) {
-			frexpr((tagptr)this_var->datap);
-			this_var->datap = 0;
-			}
-		}
-
-	/* sort new_vars by type, skipping entries just zapped */
-
-	for(i = TYADDR; i < TYVOID; i++)
-		nv[i] = 0;
-	for(this_var = new_vars; this_var; this_var = next_var) {
-		next_var = this_var->nextp;
-		if (Var = (Addrp)this_var->datap) {
-			if (!(this_var->nextp = nv[j = Var->vtype]))
-				nv1[j] = this_var;
-			nv[j] = this_var;
-			}
-		else {
-			this_var->nextp = 0;
-			frchain(&this_var);
-			}
-		}
-	new_vars = 0;
-	for(i = TYVOID; --i >= TYADDR;)
-		if (this_var = nv[i]) {
-			nv1[i]->nextp = new_vars;
-			new_vars = this_var;
-			}
-
-	/* write the declarations */
-
-	did_one = 0;
-	last_type = -1;
-
-	for (this_var = new_vars; this_var; this_var = this_var -> nextp) {
-	    Var = (Addrp) this_var->datap;
-
-	    if (Var == (Addrp) NULL)
-		err ("list_decls:  null variable");
-	    else if (Var -> tag != TADDR)
-		erri ("list_decls:  bad tag on new variable '%d'",
-			Var -> tag);
-
-	    type = nv_type (Var);
-	    if (Var->vstg == STGINIT
-	    ||  Var->uname_tag == UNAM_IDENT
-			&& *Var->user.ident == ' '
-			&& multitype)
-		continue;
-	    if (!did_one)
-		nice_printf (outfile, "/* System generated locals */\n");
-
-	    if (last_type == type && did_one)
-		nice_printf (outfile, ", ");
-	    else {
-		if (did_one)
-		    nice_printf (outfile, ";\n");
-		nice_printf (outfile, "%s ",
-			c_type_decl (type, Var -> vclass == CLPROC));
-	    } /* else */
-
-/* Character type is really a string type.  Put out a '*' for parameters
-   with unknown length and functions returning character */
-
-	    if (Var -> vtype == TYCHAR && (!ISICON ((Var -> vleng))
-		    || Var -> vclass == CLPROC))
-		nice_printf (outfile, "*");
-
-	    write_nv_ident(outfile, (Addrp)this_var->datap);
-	    if (Var -> vtype == TYCHAR && Var->vclass != CLPROC &&
-		    ISICON((Var -> vleng))
-			&& (i = Var->vleng->constblock.Const.ci) > 0)
-		nice_printf (outfile, "[%d]", i);
-
-	    did_one = 1;
-	    last_type = nv_type (Var);
-	} /* for this_var */
-
-/* Handle the uninitialized equivalences */
-
-	do_uninit_equivs (outfile, &did_one);
-
-	if (did_one)
-	    nice_printf (outfile, ";\n\n");
-    } /* if new_vars */
-
-/* Write out builtin declarations */
-
-    if (used_builtins) {
-	chainp cp;
-	Extsym *es;
-
-	last_type = -1;
-	did_one = 0;
-
-	nice_printf (outfile, "/* Builtin functions */");
-
-	for (cp = used_builtins; cp; cp = cp -> nextp) {
-	    Addrp e = (Addrp)cp->datap;
-
-	    switch(type = e->vtype) {
-		case TYDREAL:
-		case TYREAL:
-			/* if (forcedouble || e->dbl_builtin) */
-			/* libF77 currently assumes everything double */
-			type = TYDREAL;
-			ctype = "double";
-			break;
-		case TYCOMPLEX:
-		case TYDCOMPLEX:
-			type = TYVOID;
-			/* no break */
-		default:
-			ctype = c_type_decl(type, 0);
-		}
-
-	    if (did_one && last_type == type)
-		nice_printf(outfile, ", ");
-	    else
-		nice_printf(outfile, "%s\n%s ", did_one ? ";" : "", ctype);
-
-	    extern_out(outfile, es = &extsymtab[e -> memno]);
-	    proto(outfile, es->arginfo, es->fextname);
-	    last_type = type;
-	    did_one = 1;
-	} /* for cp = used_builtins */
-
-	nice_printf (outfile, ";\n\n");
-    } /* if used_builtins */
-
-    last_type = -1;
-    for (entry = hashtab; entry < lasthash; ++entry) {
-	var = entry -> varp;
-
-	if (var) {
-	    int procclass = var -> vprocclass;
-	    char *comment = NULL;
-	    int stg = var -> vstg;
-	    int class = var -> vclass;
-	    type = var -> vtype;
-
-	    if (var->vrefused)
-		refdefs = mkchain((char *)var, refdefs);
-	    if (var->vsubscrused)
-		if (ISCOMPLEX(var->vtype))
-			var->vsubscrused = 0;
-		else
-			refdefs = mkchain((char *)var, refdefs);
-	    if (ONEOF(stg, M(STGARG)|M(STGLENG)|M(STGINIT)))
-		continue;
-
-	    if (useauto1 && stg == STGBSS && !var->vsave)
-		stg = STGAUTO;
-
-	    switch (class) {
-	        case CLVAR:
-		    break;
-		case CLPROC:
-		    switch(procclass) {
-			case PTHISPROC:
-				extsymtab[var->vardesc.varno].extype = type;
-				continue;
-			case PSTFUNCT:
-			case PINTRINSIC:
-				continue;
-			case PUNKNOWN:
-				err ("list_decls:  unknown procedure class");
-				continue;
-			case PEXTERNAL:
-				if (stg == STGUNKNOWN) {
-					warn1(
-					"%.64s declared EXTERNAL but never used.",
-						var->fvarname);
-					/* to retain names declared EXTERNAL */
-					/* but not referenced, change	*/
-					/* "continue" to "stg = STGEXT" */
-					continue;
-					}
-				else
-					type = fixexttype(var);
-			}
-		    break;
-		case CLUNKNOWN:
-			/* declared but never used */
-			continue;
-		case CLPARAM:
-			continue;
-		case CLNAMELIST:
-			if (var->visused)
-				namelists = mkchain((char *)var, namelists);
-			continue;
-		default:
-		    erri("list_decls:  can't handle class '%d' yet",
-			    class);
-		    Fatal(var->fvarname);
-		    continue;
-	    } /* switch */
-
-	    /* Might be equivalenced to a common.  If not, don't process */
-	    if (stg == STGCOMMON && !var->vcommequiv)
-		continue;
-
-/* Only write the header if system-generated locals, builtins, or
-   uninitialized equivs were already output */
-
-	    if (write_header == 1 && (new_vars || nequiv || used_builtins)
-		    && oneof_stg ( var, stg,
-		    M(STGBSS)|M(STGEXT)|M(STGAUTO)|M(STGCOMMON)|M(STGEQUIV))) {
-		nice_printf (outfile, "/* Local variables */\n");
-		write_header = 2;
-		}
-
-
-	    Alias = oneof_stg(var, stg, M(STGEQUIV)|M(STGCOMMON));
-	    if (Define = (Alias && def_equivs)) {
-		if (!write_header)
-			nice_printf(outfile, ";\n");
-		def_start(outfile, var->cvarname, CNULL, "(");
-		goto Alias1;
-		}
-	    else if (type == last_type && class == last_class &&
-		    stg == last_stg && !write_header)
-		nice_printf (outfile, ", ");
-	    else {
-		if (!write_header && ONEOF(stg, M(STGBSS)|
-		    M(STGEXT)|M(STGAUTO)|M(STGEQUIV)|M(STGCOMMON)))
-		    nice_printf (outfile, ";\n");
-
-		switch (stg) {
-		    case STGARG:
-		    case STGLENG:
-			/* Part of the argument list, don't write them out
-			   again */
-			continue;	    /* Go back to top of the loop */
-		    case STGBSS:
-		    case STGEQUIV:
-		    case STGCOMMON:
-			nice_printf (outfile, "static ");
-			break;
-		    case STGEXT:
-			nice_printf (outfile, "extern ");
-			break;
-		    case STGAUTO:
-			break;
-		    case STGINIT:
-		    case STGUNKNOWN:
-			/* Don't want to touch the initialized data, that will
-			   be handled elsewhere.  Unknown data have
-			   already been complained about, so skip them */
-			continue;
-		    default:
-			erri("list_decls:  can't handle storage class %d",
-				stg);
-			continue;
-		} /* switch */
-
-		if (type == TYCHAR && halign && class != CLPROC
-		&& ISICON(var->vleng)) {
-			nice_printf(outfile, "struct { %s fill; char val",
-				halign);
-			x = wr_char_len(outfile, var->vdim,
-				var->vleng->constblock.Const.ci, 1);
-			if (x %= hsize)
-				nice_printf(outfile, "; char fill2[%ld]",
-					hsize - x);
-			nice_printf(outfile, "; } %s_st;\n", var->cvarname);
-			def_start(outfile, var->cvarname, CNULL, var->cvarname);
-			margin_printf(outfile, "_st.val\n");
-			last_type = -1;
-			write_header = 2;
-			continue;
-			}
-		nice_printf(outfile, "%s ",
-			c_type_decl(type, class == CLPROC));
-	    } /* else */
-
-/* Character type is really a string type.  Put out a '*' for variable
-   length strings, and also for equivalences */
-
-	    if (type == TYCHAR && class != CLPROC
-		    && (!var->vleng || !ISICON (var -> vleng))
-	    || oneof_stg(var, stg, M(STGEQUIV)|M(STGCOMMON)))
-		nice_printf (outfile, "*%s", var->cvarname);
-	    else {
-		nice_printf (outfile, "%s", var->cvarname);
-		if (class == CLPROC) {
-			Argtypes *at;
-			if (!(at = var->arginfo)
-			 && var->vprocclass == PEXTERNAL)
-				at = extsymtab[var->vardesc.varno].arginfo;
-			proto(outfile, at, var->fvarname);
-			}
-		else if (type == TYCHAR && ISICON ((var -> vleng)))
-			wr_char_len(outfile, var->vdim,
-				(int)var->vleng->constblock.Const.ci, 0);
-		else if (var -> vdim &&
-		    !oneof_stg (var, stg, M(STGEQUIV)|M(STGCOMMON)))
-			comment = wr_ardecls(outfile, var->vdim, 1L);
-		}
-
-	    if (comment)
-		nice_printf (outfile, "%s", comment);
- Alias1:
-	    if (Alias) {
-		char *amp, *lp, *name, *rp;
-		ftnint voff = var -> voffset;
-		int et0, expr_type, k;
-		Extsym *E;
-		struct Equivblock *eb;
-		char buf[16];
-
-/* We DON'T want to use oneof_stg here, because we need to distinguish
-   between them */
-
-		if (stg == STGEQUIV) {
-			name = equiv_name(k = var->vardesc.varno, CNULL);
-			eb = eqvclass + k;
-			if (eb->eqvinit) {
-				amp = "&";
-				et0 = TYERROR;
-				}
-			else {
-				amp = "";
-				et0 = eb->eqvtype;
-				}
-			expr_type = et0;
-		    }
-		else {
-			E = &extsymtab[var->vardesc.varno];
-			sprintf(name = buf, "%s%d", E->cextname, E->curno);
-			expr_type = type;
-			et0 = -1;
-			amp = "&";
-		} /* else */
-
-		if (!Define)
-			nice_printf (outfile, " = ");
-		if (voff) {
-			k = typesize[type];
-			switch((int)(voff % k)) {
-				case 0:
-					voff /= k;
-					expr_type = type;
-					break;
-				case SZSHORT:
-				case SZSHORT+SZLONG:
-					expr_type = TYSHORT;
-					voff /= SZSHORT;
-					break;
-				case SZLONG:
-					expr_type = TYLONG;
-					voff /= SZLONG;
-					break;
-				default:
-					expr_type = TYCHAR;
-				}
-			}
-
-		if (expr_type == type) {
-			lp = rp = "";
-			if (et0 == -1 && !voff)
-				goto cast;
-			}
-		else {
-			lp = "(";
-			rp = ")";
- cast:
-			nice_printf(outfile, "(%s *)", c_type_decl(type, 0));
-			}
-
-/* Now worry about computing the offset */
-
-		if (voff) {
-		    if (expr_type == et0)
-			nice_printf (outfile, "%s%s + %ld%s",
-				lp, name, voff, rp);
-		    else
-			nice_printf(outfile, "%s(%s *)%s%s + %ld%s", lp,
-				c_type_decl (expr_type, 0), amp,
-				name, voff, rp);
-		} else
-		    nice_printf(outfile, "%s%s", amp, name);
-/* Always put these at the end of the line */
-		last_type = last_class = last_stg = -1;
-		write_header = 0;
-		if (Define) {
-			margin_printf(outfile, ")\n");
-			write_header = 2;
-			}
-		continue;
-		}
-	    write_header = 0;
-	    last_type = type;
-	    last_class = class;
-	    last_stg = stg;
-	} /* if (var) */
-    } /* for (entry = hashtab */
-
-    if (!write_header)
-	nice_printf (outfile, ";\n\n");
-    else if (write_header == 2)
-	nice_printf(outfile, "\n");
-
-/* Next, namelists, which may reference equivs */
-
-    if (namelists) {
-	write_namelists(namelists = revchain(namelists), outfile);
-	frchain(&namelists);
-	}
-
-/* Finally, ioblocks (which may reference equivs and namelists) */
-    if (iob_list)
-	write_ioblocks(outfile);
-    if (assigned_fmts)
-	write_assigned_fmts(outfile);
-
-    if (refdefs)
-	ref_defs(outfile, refdefs);
-
-} /* list_decls */
-
- void
-#ifdef KR_headers
-do_uninit_equivs(outfile, did_one)
-	FILE *outfile;
-	int *did_one;
-#else
-do_uninit_equivs(FILE *outfile, int *did_one)
-#endif
-{
-    extern int nequiv;
-    struct Equivblock *eqv, *lasteqv = eqvclass + nequiv;
-    int k, last_type = -1, t;
-
-    for (eqv = eqvclass; eqv < lasteqv; eqv++)
-	if (!eqv -> eqvinit && eqv -> eqvtop != eqv -> eqvbottom) {
-	    if (!*did_one)
-		nice_printf (outfile, "/* System generated locals */\n");
-	    t = eqv->eqvtype;
-	    if (last_type == t)
-		nice_printf (outfile, ", ");
-	    else {
-		if (*did_one)
-		    nice_printf (outfile, ";\n");
-		nice_printf (outfile, "static %s ", c_type_decl(t, 0));
-		k = typesize[t];
-	    } /* else */
-	    nice_printf(outfile, "%s", equiv_name((int)(eqv - eqvclass), CNULL));
-	    nice_printf(outfile, "[%ld]",
-		(eqv->eqvtop - eqv->eqvbottom + k - 1) / k);
-	    last_type = t;
-	    *did_one = 1;
-	} /* if !eqv -> eqvinit */
-} /* do_uninit_equivs */
-
-
-/* wr_ardecls -- Writes the brackets and size for an array
-   declaration.  Because of the inner workings of the compiler,
-   multi-dimensional arrays get mapped directly into a one-dimensional
-   array, so we have to compute the size of the array here.  When the
-   dimension is greater than 1, a string comment about the original size
-   is returned */
-
- char *
-#ifdef KR_headers
-wr_ardecls(outfile, dimp, size)
-	FILE *outfile;
-	struct Dimblock *dimp;
-	long size;
-#else
-wr_ardecls(FILE *outfile, struct Dimblock *dimp, long size)
-#endif
-{
-    int i, k;
-    ftnint j;
-    static char buf[1000];
-
-    if (dimp == (struct Dimblock *) NULL)
-	return NULL;
-
-    sprintf(buf, "\t/* was ");	/* would like to say  k = sprintf(...), but */
-    k = strlen(buf);		/* BSD doesn't return char transmitted count */
-
-    for (i = 0; i < dimp -> ndim; i++) {
-	expptr this_size = dimp -> dims[i].dimsize;
-
-	if (ISCONST(this_size)) {
-		if (ISINT(this_size->constblock.vtype))
-			j = this_size -> constblock.Const.ci;
-		else if (ISREAL(this_size->constblock.vtype))
-			j = (ftnint)this_size -> constblock.Const.cd[0];
-		else
-			goto non_const;
-		size *= j;
-	   	sprintf(buf+k, "[%ld]", j);
-	    	k += strlen(buf+k);
-		/* BSD prevents getting strlen from sprintf */
-		}
-	else {
- non_const:
-	    err ("wr_ardecls:  nonconstant array size");
-		}
-    } /* for i = 0 */
-
-    nice_printf (outfile, "[%ld]", size);
-    strcat(buf+k, " */");
-
-    return (i > 1) ? buf : NULL;
-} /* wr_ardecls */
-
-
-
-/* ----------------------------------------------------------------------
-
-	The following routines read from the p1 intermediate file.  If
-   that format changes, only these routines need be changed
-
-   ---------------------------------------------------------------------- */
-
- static int
-#ifdef KR_headers
-get_p1_token(infile)
-	FILE *infile;
-#else
-get_p1_token(FILE *infile)
-#endif
-{
-    int token = P1_UNKNOWN;
-
-/* NOT PORTABLE!! */
-
-    if (fscanf (infile, "%d", &token) == EOF)
-	return P1_EOF;
-
-/* Skip over the ": " */
-
-    if (getc (infile) != '\n')
-	getc (infile);
-
-    return token;
-} /* get_p1_token */
-
-
-
-/* Returns a (null terminated) string from the input file */
-
- static int
-#ifdef KR_headers
-p1gets(fp, str, size)
-	FILE *fp;
-	char *str;
-	int size;
-#else
-p1gets(FILE *fp, char *str, int size)
-#endif
-{
-    char c;
-
-    if (str == NULL)
-	return 0;
-
-    if ((c = getc (fp)) != ' ')
-	ungetc (c, fp);
-
-    if (fgets (str, size, fp)) {
-	int length;
-
-	str[size - 1] = '\0';
-	length = strlen (str);
-
-/* Get rid of the newline */
-
-	if (str[length - 1] == '\n')
-	    str[length - 1] = '\0';
-	return 1;
-
-    } else if (feof (fp))
-	return EOF;
-    else
-	return 0;
-} /* p1gets */
-
-
- static int
-#ifdef KR_headers
-p1get_const(infile, type, resultp)
-	FILE *infile;
-	int type;
-	struct Constblock **resultp;
-#else
-p1get_const(FILE *infile, int type, struct Constblock **resultp)
-#endif
-{
-    int status;
-    struct Constblock *result;
-
-	if (type != TYCHAR) {
-		*resultp = result = ALLOC(Constblock);
-		result -> tag = TCONST;
-		result -> vtype = type;
-		}
-
-    switch (type) {
-	case TYINT1:
-        case TYSHORT:
-	case TYLONG:
-	case TYLOGICAL:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-	case TYLOGICAL1:
-	case TYLOGICAL2:
-	    status = p1getd (infile, &(result -> Const.ci));
-	    break;
-	case TYREAL:
-	case TYDREAL:
-	    status = p1getf(infile, &result->Const.cds[0]);
-	    result->vstg = 1;
-	    break;
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-	    status = p1getf(infile, &result->Const.cds[0]);
-	    if (status && status != EOF)
-		status = p1getf(infile, &result->Const.cds[1]);
-	    result->vstg = 1;
-	    break;
-	case TYCHAR:
-	    status = fscanf(infile, "%lx", resultp);
-	    break;
-	default:
-	    erri ("p1get_const:  bad constant type '%d'", type);
-	    status = 0;
-	    break;
-    } /* switch */
-
-    return status;
-} /* p1get_const */
-
- static int
-#ifdef KR_headers
-p1getd(infile, result)
-	FILE *infile;
-	long *result;
-#else
-p1getd(FILE *infile, long *result)
-#endif
-{
-    return fscanf (infile, "%ld", result);
-} /* p1getd */
-
- static int
-#ifdef KR_headers
-p1getf(infile, result)
-	FILE *infile;
-	char **result;
-#else
-p1getf(FILE *infile, char **result)
-#endif
-{
-
-	char buf[1324];
-	register int k;
-
-	k = fscanf (infile, "%s", buf);
-	if (k < 1)
-		k = EOF;
-	else
-		strcpy(*result = mem(strlen(buf)+1,0), buf);
-	return k;
-}
-
- static int
-#ifdef KR_headers
-p1getn(infile, count, result)
-	FILE *infile;
-	int count;
-	char **result;
-#else
-p1getn(FILE *infile, int count, char **result)
-#endif
-{
-
-    char *bufptr;
-
-    bufptr = (char *) ckalloc (count);
-
-    if (result)
-	*result = bufptr;
-
-    for (; !feof (infile) && count > 0; count--)
-	*bufptr++ = getc (infile);
-
-    return feof (infile) ? EOF : 1;
-} /* p1getn */
-
- static void
-#ifdef KR_headers
-proto(outfile, at, fname)
-	FILE *outfile;
-	Argtypes *at;
-	char *fname;
-#else
-proto(FILE *outfile,  Argtypes *at,  char *fname)
-#endif
-{
-	int i, j, k, n;
-	char *comma;
-	Atype *atypes;
-	Namep np;
-	chainp cp;
-
-	if (at) {
-		/* Correct types that we learn on the fly, e.g.
-			subroutine gotcha(foo)
-			external foo
-			call zap(...,foo,...)
-			call foo(...)
-		*/
-		atypes = at->atypes;
-		n = at->defined ? at->dnargs : at->nargs;
-		for(i = 0; i++ < n; atypes++) {
-			if (!(cp = atypes->cp))
-				continue;
-			j = atypes->type;
-			do {
-				np = (Namep)cp->datap;
-				k = np->vtype;
-				if (np->vclass == CLPROC) {
-					if (!np->vimpltype && k)
-						k += 200;
-					else {
-						if (j >= 300)
-							j = TYUNKNOWN + 200;
-						continue;
-						}
-					}
-				if (j == k)
-					continue;
-				if (j >= 300
-				||  j == 200 && k >= 200)
-					j = k;
-				else {
-					if (at->nargs >= 0)
-					   bad_atypes(at,fname,i,j,k,""," and");
-					goto break2;
-					}
-				}
-				while(cp = cp->nextp);
-			atypes->type = j;
-			frchain(&atypes->cp);
-			}
-		}
- break2:
-	if (parens) {
-		nice_printf(outfile, parens);
-		return;
-		}
-
-	if (!at || (n = at-> defined ? at->dnargs : at->nargs) < 0) {
-		nice_printf(outfile, Ansi == 1 ? "()" : "(...)");
-		return;
-		}
-
-	if (n == 0) {
-		nice_printf(outfile, Ansi == 1 ? "(void)" : "()");
-		return;
-		}
-
-	atypes = at->atypes;
-	nice_printf(outfile, "(");
-	comma = "";
-	for(; --n >= 0; atypes++) {
-		k = atypes->type;
-		if (k == TYADDR)
-			nice_printf(outfile, "%schar **", comma);
-		else if (k >= 200) {
-			k -= 200;
-			if (k >= 100)
-				k -= 100;
-			nice_printf(outfile, "%s%s", comma,
-				usedcasts[k] = casttypes[k]);
-			}
-		else if (k >= 100)
-			nice_printf(outfile,
-					k == TYCHAR + 100 ? "%s%s *" : "%s%s",
-					comma, c_type_decl(k-100, 0));
-		else
-			nice_printf(outfile, "%s%s *", comma,
-					c_type_decl(k, 0));
-		comma = ", ";
-		}
-	nice_printf(outfile, ")");
-	}
-
- void
-#ifdef KR_headers
-protowrite(protofile, type, name, e, lengths)
-	FILE *protofile;
-	int type;
-	char *name;
-	struct Entrypoint *e;
-	chainp lengths;
-#else
-protowrite(FILE *protofile, int type, char *name, struct Entrypoint *e, chainp lengths)
-#endif
-{
-	extern char used_rets[];
-	int asave;
-
-	if (!(asave = Ansi))
-		Castargs = Ansi = 1;
-	nice_printf(protofile, "extern %s %s", protorettypes[type], name);
-	list_arg_types(protofile, e, lengths, 0, ";\n");
-	used_rets[type] = 1;
-	if (!(Ansi = asave))
-		Castargs = 0;
-	}
-
- static void
-#ifdef KR_headers
-do_p1_1while(outfile)
-	FILE *outfile;
-#else
-do_p1_1while(FILE *outfile)
-#endif
-{
-	if (*wh_next) {
-		nice_printf(outfile,
-			"for(;;) { /* while(complicated condition) */\n" /*}*/ );
-		next_tab(outfile);
-		}
-	else
-		nice_printf(outfile, "while(" /*)*/ );
-	}
-
- static void
-#ifdef KR_headers
-do_p1_2while(infile, outfile)
-	FILE *infile;
-	FILE *outfile;
-#else
-do_p1_2while(FILE *infile, FILE *outfile)
-#endif
-{
-	expptr test;
-
-	test = do_format(infile, outfile);
-	if (*wh_next)
-		nice_printf(outfile, "if (!(");
-	expr_out(outfile, test);
-	if (*wh_next++)
-		nice_printf(outfile, "))\n\tbreak;\n");
-	else {
-		nice_printf(outfile, /*(*/ ") {\n");
-		next_tab(outfile);
-		}
-	}
-
- static void
-#ifdef KR_headers
-do_p1_elseifstart(outfile)
-	FILE *outfile;
-#else
-do_p1_elseifstart(FILE *outfile)
-#endif
-{ /* with sufficiently illegal input, ei_next == ei_last == 0 is possible */
-	if (ei_next < ei_last && *ei_next++) {
-		prev_tab(outfile);
-		nice_printf(outfile, /*{*/
-			"} else /* if(complicated condition) */ {\n" /*}*/ );
-		next_tab(outfile);
-		}
-	}
diff --git a/usr.bin/f2c/format.h b/usr.bin/f2c/format.h
deleted file mode 100644
index 3de97f6..0000000
--- a/usr.bin/f2c/format.h
+++ /dev/null
@@ -1,12 +0,0 @@
-#define DEF_C_LINE_LENGTH 77
-/* actual max will be 79 */
-
-extern int c_output_line_length;	/* max # chars per line in C source
-					   code */
-
-chainp	data_value Argdcl((FILEP, long int, int));
-int	do_init_data Argdcl((FILEP, FILEP));
-void	list_init_data Argdcl((FILEP*, char*, FILEP));
-char*	wr_ardecls Argdcl((FILEP, struct Dimblock*, long int));
-void	wr_one_init Argdcl((FILEP, char*, chainp*, int));
-void	wr_output_values Argdcl((FILEP, Namep, chainp));
diff --git a/usr.bin/f2c/formatdata.c b/usr.bin/f2c/formatdata.c
deleted file mode 100644
index 56507be..0000000
--- a/usr.bin/f2c/formatdata.c
+++ /dev/null
@@ -1,1242 +0,0 @@
-/****************************************************************
-Copyright 1990, 1991, 1993-6 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "output.h"
-#include "names.h"
-#include "format.h"
-
-#define MAX_INIT_LINE 100
-#define NAME_MAX 64
-
-static int memno2info Argdcl((int, Namep*));
-
- extern char *initbname;
-
- void
-#ifdef KR_headers
-list_init_data(Infile, Inname, outfile)
-	FILE **Infile;
-	char *Inname;
-	FILE *outfile;
-#else
-list_init_data(FILE **Infile, char *Inname, FILE *outfile)
-#endif
-{
-    FILE *sortfp;
-    int status;
-
-    fclose(*Infile);
-    *Infile = 0;
-
-    if (status = dsort(Inname, sortfname))
-	fatali ("sort failed, status %d", status);
-
-    scrub(Inname); /* optionally unlink Inname */
-
-    if ((sortfp = fopen(sortfname, textread)) == NULL)
-	Fatal("Couldn't open sorted initialization data");
-
-    do_init_data(outfile, sortfp);
-    fclose(sortfp);
-    scrub(sortfname);
-
-/* Insert a blank line after any initialized data */
-
-	nice_printf (outfile, "\n");
-
-    if (debugflag && infname)
-	 /* don't back block data file up -- it won't be overwritten */
-	backup(initfname, initbname);
-} /* list_init_data */
-
-
-
-/* do_init_data -- returns YES when at least one declaration has been
-   written */
-
- int
-#ifdef KR_headers
-do_init_data(outfile, infile)
-	FILE *outfile;
-	FILE *infile;
-#else
-do_init_data(FILE *outfile, FILE *infile)
-#endif
-{
-    char varname[NAME_MAX], ovarname[NAME_MAX];
-    ftnint offset;
-    ftnint type;
-    int vargroup;	/* 0 --> init, 1 --> equiv, 2 --> common */
-    int did_one = 0;		/* True when one has been output */
-    chainp values = CHNULL;	/* Actual data values */
-    int keepit = 0;
-    Namep np;
-
-    ovarname[0] = '\0';
-
-    while (rdname (infile, &vargroup, varname) && rdlong (infile, &offset)
-	    && rdlong (infile, &type)) {
-	if (strcmp (varname, ovarname)) {
-
-	/* If this is a new variable name, the old initialization has been
-	   completed */
-
-		wr_one_init(outfile, ovarname, &values, keepit);
-
-		strcpy (ovarname, varname);
-		values = CHNULL;
-		if (vargroup == 0) {
-			if (memno2info(atoi(varname+2), &np)) {
-				if (((Addrp)np)->uname_tag != UNAM_NAME) {
-					err("do_init_data: expected NAME");
-					goto Keep;
-					}
-				np = ((Addrp)np)->user.name;
-				}
-			if (!(keepit = np->visused) && !np->vimpldovar)
-				warn1("local variable %s never used",
-					np->fvarname);
-			}
-		else {
- Keep:
-			keepit = 1;
-			}
-		if (keepit && !did_one) {
-			nice_printf (outfile, "/* Initialized data */\n\n");
-			did_one = YES;
-			}
-	} /* if strcmp */
-
-	values = mkchain((char *)data_value(infile, offset, (int)type), values);
-    } /* while */
-
-/* Write out the last declaration */
-
-    wr_one_init (outfile, ovarname, &values, keepit);
-
-    return did_one;
-} /* do_init_data */
-
-
- ftnint
-#ifdef KR_headers
-wr_char_len(outfile, dimp, n, extra1)
-	FILE *outfile;
-	struct Dimblock *dimp;
-	int n;
-	int extra1;
-#else
-wr_char_len(FILE *outfile, struct Dimblock *dimp, int n, int extra1)
-#endif
-{
-	int i, nd;
-	expptr e;
-	ftnint j, rv;
-
-	if (!dimp) {
-		nice_printf (outfile, extra1 ? "[%d+1]" : "[%d]", n);
-		return n + extra1;
-		}
-	nice_printf(outfile, "[%d", n);
-	nd = dimp->ndim;
-	rv = n;
-	for(i = 0; i < nd; i++) {
-		e = dimp->dims[i].dimsize;
-		if (ISCONST(e)) {
-			if (ISINT(e->constblock.vtype))
-				j = e->constblock.Const.ci;
-			else if (ISREAL(e->constblock.vtype))
-				j = (ftnint)e->constblock.Const.cd[0];
-			else
-				goto non_const;
-			nice_printf(outfile, "*%ld", j);
-			rv *= j;
-			}
-		else {
- non_const:
-			err ("wr_char_len:  nonconstant array size");
-			}
-		}
-	/* extra1 allows for stupid C compilers that complain about
-	 * too many initializers in
-	 *	char x[2] = "ab";
-	 */
-	nice_printf(outfile, extra1 ? "+1]" : "]");
-	return extra1 ? rv+1 : rv;
-	}
-
- static int ch_ar_dim = -1; /* length of each element of char string array */
- static int eqvmemno;	/* kludge */
-
- static void
-#ifdef KR_headers
-write_char_init(outfile, Values, namep)
-	FILE *outfile;
-	chainp *Values;
-	Namep namep;
-#else
-write_char_init(FILE *outfile, chainp *Values, Namep namep)
-#endif
-{
-	struct Equivblock *eqv;
-	long size;
-	struct Dimblock *dimp;
-	int i, nd, type;
-	ftnint j;
-	expptr ds;
-
-	if (!namep)
-		return;
-	if(nequiv >= maxequiv)
-		many("equivalences", 'q', maxequiv);
-	eqv = &eqvclass[nequiv];
-	eqv->eqvbottom = 0;
-	type = namep->vtype;
-	size = type == TYCHAR
-		? namep->vleng->constblock.Const.ci
-		: typesize[type];
-	if (dimp = namep->vdim)
-		for(i = 0, nd = dimp->ndim; i < nd; i++) {
-			ds = dimp->dims[i].dimsize;
-			if (ISCONST(ds)) {
-				if (ISINT(ds->constblock.vtype))
-					j = ds->constblock.Const.ci;
-				else if (ISREAL(ds->constblock.vtype))
-					j = (ftnint)ds->constblock.Const.cd[0];
-				else
-					goto non_const;
-				size *= j;
-				}
-			else {
- non_const:
-				err("write_char_values: nonconstant array size");
-				}
-			}
-	*Values = revchain(*Values);
-	eqv->eqvtop = size;
-	eqvmemno = ++lastvarno;
-	eqv->eqvtype = type;
-	wr_equiv_init(outfile, nequiv, Values, 0);
-	def_start(outfile, namep->cvarname, CNULL, "");
-	if (type == TYCHAR)
-		margin_printf(outfile, "((char *)&equiv_%d)\n\n", eqvmemno);
-	else
-		margin_printf(outfile, dimp
-			? "((%s *)&equiv_%d)\n\n" : "(*(%s *)&equiv_%d)\n\n",
-			c_type_decl(type,0), eqvmemno);
-	}
-
-/* wr_one_init -- outputs the initialization of the variable pointed to
-   by   info.   When   is_addr   is true,   info   is an Addrp; otherwise,
-   treat it as a Namep */
-
- void
-#ifdef KR_headers
-wr_one_init(outfile, varname, Values, keepit)
-	FILE *outfile;
-	char *varname;
-	chainp *Values;
-	int keepit;
-#else
-wr_one_init(FILE *outfile, char *varname, chainp *Values, int keepit)
-#endif
-{
-    static int memno;
-    static union {
-	Namep name;
-	Addrp addr;
-    } info;
-    Namep namep;
-    int is_addr, size, type;
-    ftnint last, loc;
-    int is_scalar = 0;
-    char *array_comment = NULL, *name;
-    chainp cp, values;
-    extern char datachar[];
-    static int e1[3] = {1, 0, 1};
-    ftnint x;
-    extern int hsize;
-
-    if (!keepit)
-	goto done;
-    if (varname == NULL || varname[1] != '.')
-	goto badvar;
-
-/* Get back to a meaningful representation; find the given   memno in one
-   of the appropriate tables (user-generated variables in the hash table,
-   system-generated variables in a separate list */
-
-    memno = atoi(varname + 2);
-    switch(varname[0]) {
-	case 'q':
-		/* Must subtract eqvstart when the source file
-		 * contains more than one procedure.
-		 */
-		wr_equiv_init(outfile, eqvmemno = memno - eqvstart, Values, 0);
-		goto done;
-	case 'Q':
-		/* COMMON initialization (BLOCK DATA) */
-		wr_equiv_init(outfile, memno, Values, 1);
-		goto done;
-	case 'v':
-		break;
-	default:
- badvar:
-		errstr("wr_one_init:  unknown variable name '%s'", varname);
-		goto done;
-	}
-
-    is_addr = memno2info (memno, &info.name);
-    if (info.name == (Namep) NULL) {
-	err ("wr_one_init -- unknown variable");
-	return;
-	}
-    if (is_addr) {
-	if (info.addr -> uname_tag != UNAM_NAME) {
-	    erri ("wr_one_init -- couldn't get name pointer; tag is %d",
-		    info.addr -> uname_tag);
-	    namep = (Namep) NULL;
-	    nice_printf (outfile, " /* bad init data */");
-	} else
-	    namep = info.addr -> user.name;
-    } else
-	namep = info.name;
-
-	/* check for character initialization */
-
-    *Values = values = revchain(*Values);
-    type = info.name->vtype;
-    if (type == TYCHAR) {
-	for(last = 0; values; values = values->nextp) {
-		cp = (chainp)values->datap;
-		loc = (ftnint)cp->datap;
-		if (loc > last) {
-			write_char_init(outfile, Values, namep);
-			goto done;
-			}
-		last = (int)cp->nextp->datap == TYBLANK
-			? loc + (int)cp->nextp->nextp->datap
-			: loc + 1;
-		}
-	if (halign && info.name->tag == TNAME) {
-		nice_printf(outfile, "static struct { %s fill; char val",
-			halign);
-		x = wr_char_len(outfile, namep->vdim, ch_ar_dim =
-			info.name -> vleng -> constblock.Const.ci, 1);
-		if (x %= hsize)
-			nice_printf(outfile, "; char fill2[%ld]", hsize - x);
-		name = info.name->cvarname;
-		nice_printf(outfile, "; } %s_st = { 0,", name);
-		wr_output_values(outfile, namep, *Values);
-		nice_printf(outfile, " };\n");
-		ch_ar_dim = -1;
-		def_start(outfile, name, CNULL, name);
-		margin_printf(outfile, "_st.val\n");
-		goto done;
-		}
-	}
-    else {
-	size = typesize[type];
-	loc = 0;
-	for(; values; values = values->nextp) {
-		if ((int)((chainp)values->datap)->nextp->datap == TYCHAR) {
-			write_char_init(outfile, Values, namep);
-			goto done;
-			}
-		last = ((long) ((chainp) values->datap)->datap) / size;
-		if (last - loc > 4) {
-			write_char_init(outfile, Values, namep);
-			goto done;
-			}
-		loc = last;
-		}
-	}
-    values = *Values;
-
-    nice_printf (outfile, "static %s ", c_type_decl (type, 0));
-
-    if (is_addr)
-	write_nv_ident (outfile, info.addr);
-    else
-	out_name (outfile, info.name);
-
-    if (namep)
-	is_scalar = namep -> vdim == (struct Dimblock *) NULL;
-
-    if (namep && !is_scalar)
-	array_comment = type == TYCHAR
-		? 0 : wr_ardecls(outfile, namep->vdim, 1L);
-
-    if (type == TYCHAR)
-	if (ISICON (info.name -> vleng))
-
-/* We'll make single strings one character longer, so that we can use the
-   standard C initialization.  All this does is pad an extra zero onto the
-   end of the string */
-		wr_char_len(outfile, namep->vdim, ch_ar_dim =
-			info.name -> vleng -> constblock.Const.ci, e1[Ansi]);
-	else
-		err ("variable length character initialization");
-
-    if (array_comment)
-	nice_printf (outfile, "%s", array_comment);
-
-    nice_printf (outfile, " = ");
-    wr_output_values (outfile, namep, values);
-    ch_ar_dim = -1;
-    nice_printf (outfile, ";\n");
- done:
-    frchain(Values);
-} /* wr_one_init */
-
-
-
-
- chainp
-#ifdef KR_headers
-data_value(infile, offset, type)
-	FILE *infile;
-	ftnint offset;
-	int type;
-#else
-data_value(FILE *infile, ftnint offset, int type)
-#endif
-{
-    char line[MAX_INIT_LINE + 1], *pointer;
-    chainp vals, prev_val;
-    char *newval;
-
-    if (fgets (line, MAX_INIT_LINE, infile) == NULL) {
-	err ("data_value:  error reading from intermediate file");
-	return CHNULL;
-    } /* if fgets */
-
-/* Get rid of the trailing newline */
-
-    if (line[0])
-	line[strlen (line) - 1] = '\0';
-
-#define iswhite(x) (isspace (x) || (x) == ',')
-
-    pointer = line;
-    prev_val = vals = CHNULL;
-
-    while (*pointer) {
-	register char *end_ptr, old_val;
-
-/* Move   pointer   to the start of the next word */
-
-	while (*pointer && iswhite (*pointer))
-	    pointer++;
-	if (*pointer == '\0')
-	    break;
-
-/* Move   end_ptr   to the end of the current word */
-
-	for (end_ptr = pointer + 1; *end_ptr && !iswhite (*end_ptr);
-		end_ptr++)
-	    ;
-
-	old_val = *end_ptr;
-	*end_ptr = '\0';
-
-/* Add this value to the end of the list */
-
-	if (ONEOF(type, MSKREAL|MSKCOMPLEX))
-		newval = cpstring(pointer);
-	else
-		newval = (char *)atol(pointer);
-	if (vals) {
-	    prev_val->nextp = mkchain(newval, CHNULL);
-	    prev_val = prev_val -> nextp;
-	} else
-	    prev_val = vals = mkchain(newval, CHNULL);
-	*end_ptr = old_val;
-	pointer = end_ptr;
-    } /* while *pointer */
-
-    return mkchain((char *)offset, mkchain((char *)LONG_CAST type, vals));
-} /* data_value */
-
- static void
-overlapping(Void)
-{
-	extern char *filename0;
-	static int warned = 0;
-
-	if (warned)
-		return;
-	warned = 1;
-
-	fprintf(stderr, "Error");
-	if (filename0)
-		fprintf(stderr, " in file %s", filename0);
-	fprintf(stderr, ": overlapping initializations\n");
-	nerr++;
-	}
-
- static void make_one_const Argdcl((int, union Constant*, chainp));
- static long charlen;
-
- void
-#ifdef KR_headers
-wr_output_values(outfile, namep, values)
-	FILE *outfile;
-	Namep namep;
-	chainp values;
-#else
-wr_output_values(FILE *outfile, Namep namep, chainp values)
-#endif
-{
-	int type = TYUNKNOWN;
-	struct Constblock Const;
-	static expptr Vlen;
-
-	if (namep)
-		type = namep -> vtype;
-
-/* Handle array initializations away from scalars */
-
-	if (namep && namep -> vdim)
-		wr_array_init (outfile, namep -> vtype, values);
-
-	else if (values->nextp && type != TYCHAR)
-		overlapping();
-
-	else {
-		make_one_const(type, &Const.Const, values);
-		Const.vtype = type;
-		Const.vstg = ONEOF(type, MSKREAL|MSKCOMPLEX) != 0;
-		if (type== TYCHAR) {
-			if (!Vlen)
-				Vlen = ICON(0);
-			Const.vleng = Vlen;
-			Vlen->constblock.Const.ci = charlen;
-			out_const (outfile, &Const);
-			free (Const.Const.ccp);
-			}
-		else
-			out_const (outfile, &Const);
-		}
-	}
-
-
- void
-#ifdef KR_headers
-wr_array_init(outfile, type, values)
-	FILE *outfile;
-	int type;
-	chainp values;
-#else
-wr_array_init(FILE *outfile, int type, chainp values)
-#endif
-{
-    int size = typesize[type];
-    long index, main_index = 0;
-    int k;
-
-    if (type == TYCHAR) {
-	nice_printf(outfile, "\"");
-	k = 0;
-	if (Ansi != 1)
-		ch_ar_dim = -1;
-	}
-    else
-	nice_printf (outfile, "{ ");
-    while (values) {
-	struct Constblock Const;
-
-	index = ((long) ((chainp) values->datap)->datap) / size;
-	while (index > main_index) {
-
-/* Fill with zeros.  The structure shorthand works because the compiler
-   will expand the "0" in braces to fill the size of the entire structure
-   */
-
-	    switch (type) {
-	        case TYREAL:
-		case TYDREAL:
-		    nice_printf (outfile, "0.0,");
-		    break;
-		case TYCOMPLEX:
-		case TYDCOMPLEX:
-		    nice_printf (outfile, "{0},");
-		    break;
-		case TYCHAR:
-			nice_printf(outfile, " ");
-			break;
-		default:
-		    nice_printf (outfile, "0,");
-		    break;
-	    } /* switch */
-	    main_index++;
-	} /* while index > main_index */
-
-	if (index < main_index)
-		overlapping();
-	else switch (type) {
-	    case TYCHAR:
-		{ int this_char;
-
-		if (k == ch_ar_dim) {
-			nice_printf(outfile, "\" \"");
-			k = 0;
-			}
-		this_char = (int) ((chainp) values->datap)->
-				nextp->nextp->datap;
-		if ((int)((chainp)values->datap)->nextp->datap == TYBLANK) {
-			main_index += this_char;
-			k += this_char;
-			while(--this_char >= 0)
-				nice_printf(outfile, " ");
-			values = values -> nextp;
-			continue;
-			}
-		nice_printf(outfile, str_fmt[this_char], this_char);
-		k++;
-		} /* case TYCHAR */
-	        break;
-
-	    case TYINT1:
-	    case TYSHORT:
-	    case TYLONG:
-#ifdef TYQUAD
-	    case TYQUAD:
-#endif
-	    case TYREAL:
-	    case TYDREAL:
-	    case TYLOGICAL:
-	    case TYLOGICAL1:
-	    case TYLOGICAL2:
-	    case TYCOMPLEX:
-	    case TYDCOMPLEX:
-		make_one_const(type, &Const.Const, values);
-		Const.vtype = type;
-		Const.vstg = ONEOF(type, MSKREAL|MSKCOMPLEX) != 0;
-		out_const(outfile, &Const);
-	        break;
-	    default:
-	        erri("wr_array_init: bad type '%d'", type);
-	        break;
-	} /* switch */
-	values = values->nextp;
-
-	main_index++;
-	if (values && type != TYCHAR)
-	    nice_printf (outfile, ",");
-    } /* while values */
-
-    if (type == TYCHAR) {
-	nice_printf(outfile, "\"");
-	}
-    else
-	nice_printf (outfile, " }");
-} /* wr_array_init */
-
-
- static void
-#ifdef KR_headers
-make_one_const(type, storage, values)
-	int type;
-	union Constant *storage;
-	chainp values;
-#else
-make_one_const(int type, union Constant *storage, chainp values)
-#endif
-{
-    union Constant *Const;
-    register char **L;
-
-    if (type == TYCHAR) {
-	char *str, *str_ptr;
-	chainp v, prev;
-	int b = 0, k, main_index = 0;
-
-/* Find the max length of init string, by finding the highest offset
-   value stored in the list of initial values */
-
-	for(k = 1, prev = CHNULL, v = values; v; prev = v, v = v->nextp)
-	    ;
-	if (prev != CHNULL)
-	    k = ((int) (((chainp) prev->datap)->datap)) + 2;
-		/* + 2 above for null char at end */
-	str = Alloc (k);
-	for (str_ptr = str; values; str_ptr++) {
-	    int index = (int) (((chainp) values->datap)->datap);
-
-	    if (index < main_index)
-		overlapping();
-	    while (index > main_index++)
-		*str_ptr++ = ' ';
-
-		k = (int) (((chainp) values->datap)->nextp->nextp->datap);
-		if ((int)((chainp)values->datap)->nextp->datap == TYBLANK) {
-			b = k;
-			break;
-			}
-		*str_ptr = k;
-		values = values -> nextp;
-	} /* for str_ptr */
-	*str_ptr = '\0';
-	Const = storage;
-	Const -> ccp = str;
-	Const -> ccp1.blanks = b;
-	charlen = str_ptr - str;
-    } else {
-	int i = 0;
-	chainp vals;
-
-	vals = ((chainp)values->datap)->nextp->nextp;
-	if (vals) {
-		L = (char **)storage;
-		do L[i++] = vals->datap;
-			while(vals = vals->nextp);
-		}
-
-    } /* else */
-
-} /* make_one_const */
-
-
- int
-#ifdef KR_headers
-rdname(infile, vargroupp, name)
-	FILE *infile;
-	int *vargroupp;
-	char *name;
-#else
-rdname(FILE *infile, int *vargroupp, char *name)
-#endif
-{
-    register int i, c;
-
-    c = getc (infile);
-
-    if (feof (infile))
-	return NO;
-
-    *vargroupp = c - '0';
-    for (i = 1;; i++) {
-	if (i >= NAME_MAX)
-		Fatal("rdname: oversize name");
-	c = getc (infile);
-	if (feof (infile))
-	    return NO;
-	if (c == '\t')
-		break;
-	*name++ = c;
-    }
-    *name = 0;
-    return YES;
-} /* rdname */
-
- int
-#ifdef KR_headers
-rdlong(infile, n)
-	FILE *infile;
-	ftnint *n;
-#else
-rdlong(FILE *infile, ftnint *n)
-#endif
-{
-    register int c;
-
-    for (c = getc (infile); !feof (infile) && isspace (c); c = getc (infile))
-	;
-
-    if (feof (infile))
-	return NO;
-
-    for (*n = 0; isdigit (c); c = getc (infile))
-	*n = 10 * (*n) + c - '0';
-    return YES;
-} /* rdlong */
-
-
- static int
-#ifdef KR_headers
-memno2info(memno, info)
-	int memno;
-	Namep *info;
-#else
-memno2info(int memno, Namep *info)
-#endif
-{
-    chainp this_var;
-    extern chainp new_vars;
-    extern struct Hashentry *hashtab, *lasthash;
-    struct Hashentry *entry;
-
-    for (this_var = new_vars; this_var; this_var = this_var -> nextp) {
-	Addrp var = (Addrp) this_var->datap;
-
-	if (var == (Addrp) NULL)
-	    Fatal("memno2info:  null variable");
-	else if (var -> tag != TADDR)
-	    Fatal("memno2info:  bad tag");
-	if (memno == var -> memno) {
-	    *info = (Namep) var;
-	    return 1;
-	} /* if memno == var -> memno */
-    } /* for this_var = new_vars */
-
-    for (entry = hashtab; entry < lasthash; ++entry) {
-	Namep var = entry -> varp;
-
-	if (var && var -> vardesc.varno == memno && var -> vstg == STGINIT) {
-	    *info = (Namep) var;
-	    return 0;
-	} /* if entry -> vardesc.varno == memno */
-    } /* for entry = hashtab */
-
-    Fatal("memno2info:  couldn't find memno");
-    return 0;
-} /* memno2info */
-
- static chainp
-#ifdef KR_headers
-do_string(outfile, v, nloc)
-	FILE *outfile;
-	register chainp v;
-	ftnint *nloc;
-#else
-do_string(FILE *outfile, register chainp v, ftnint *nloc)
-#endif
-{
-	register chainp cp, v0;
-	ftnint dloc, k, loc;
-	unsigned long uk;
-	char buf[8], *comma;
-
-	nice_printf(outfile, "{");
-	cp = (chainp)v->datap;
-	loc = (ftnint)cp->datap;
-	comma = "";
-	for(v0 = v;;) {
-		switch((int)cp->nextp->datap) {
-			case TYBLANK:
-				k = (ftnint)cp->nextp->nextp->datap;
-				loc += k;
-				while(--k >= 0) {
-					nice_printf(outfile, "%s' '", comma);
-					comma = ", ";
-					}
-				break;
-			case TYCHAR:
-				uk = (ftnint)cp->nextp->nextp->datap;
-				sprintf(buf, chr_fmt[uk], uk);
-				nice_printf(outfile, "%s'%s'", comma, buf);
-				comma = ", ";
-				loc++;
-				break;
-			default:
-				goto done;
-			}
-		v0 = v;
-		if (!(v = v->nextp) || !(cp = (chainp)v->datap))
-			break;
-		dloc = (ftnint)cp->datap;
-		if (loc != dloc)
-			break;
-		}
- done:
-	nice_printf(outfile, "}");
-	*nloc = loc;
-	return v0;
-	}
-
- static chainp
-#ifdef KR_headers
-Ado_string(outfile, v, nloc)
-	FILE *outfile;
-	register chainp v;
-	ftnint *nloc;
-#else
-Ado_string(FILE *outfile, register chainp v, ftnint *nloc)
-#endif
-{
-	register chainp cp, v0;
-	ftnint dloc, k, loc;
-
-	nice_printf(outfile, "\"");
-	cp = (chainp)v->datap;
-	loc = (ftnint)cp->datap;
-	for(v0 = v;;) {
-		switch((int)cp->nextp->datap) {
-			case TYBLANK:
-				k = (ftnint)cp->nextp->nextp->datap;
-				loc += k;
-				while(--k >= 0)
-					nice_printf(outfile, " ");
-				break;
-			case TYCHAR:
-				k = (ftnint)cp->nextp->nextp->datap;
-				nice_printf(outfile, str_fmt[k], k);
-				loc++;
-				break;
-			default:
-				goto done;
-			}
-		v0 = v;
-		if (!(v = v->nextp) || !(cp = (chainp)v->datap))
-			break;
-		dloc = (ftnint)cp->datap;
-		if (loc != dloc)
-			break;
-		}
- done:
-	nice_printf(outfile, "\"");
-	*nloc = loc;
-	return v0;
-	}
-
- static char *
-#ifdef KR_headers
-Len(L, type)
-	long L;
-	int type;
-#else
-Len(long L, int type)
-#endif
-{
-	static char buf[24];
-	if (L == 1 && type != TYCHAR)
-		return "";
-	sprintf(buf, "[%ld]", L);
-	return buf;
-	}
-
- static void
-#ifdef KR_headers
-fill_dcl(outfile, t, k, L) FILE *outfile; int t; int k; ftnint L;
-#else
-fill_dcl(FILE *outfile, int t, int k, ftnint L)
-#endif
-{
-	nice_printf(outfile, "%s fill_%d[%ld];\n", typename[t], k, L);
-	}
-
- static int
-#ifdef KR_headers
-fill_type(L, loc, xtype) ftnint L; ftnint loc; int xtype;
-#else
-fill_type(ftnint L, ftnint loc, int xtype)
-#endif
-{
-	int ft, ft1, szshort;
-
-	if (xtype == TYCHAR)
-		return xtype;
-	szshort = typesize[TYSHORT];
-	ft = L % szshort ? TYCHAR : type_choice[L/szshort % 4];
-	ft1 = loc % szshort ? TYCHAR : type_choice[loc/szshort % 4];
-	if (typesize[ft] > typesize[ft1])
-		ft = ft1;
-	return ft;
-	}
-
- static ftnint
-#ifdef KR_headers
-get_fill(dloc, loc, t0, t1, L0, L1, xtype) ftnint dloc; ftnint loc; int *t0; int *t1; ftnint *L0; ftnint *L1; int xtype;
-#else
-get_fill(ftnint dloc, ftnint loc, int *t0, int *t1, ftnint *L0, ftnint *L1, int xtype)
-#endif
-{
-	ftnint L, L2, loc0;
-
-	if (L = loc % typesize[xtype]) {
-		loc0 = loc;
-		loc += L = typesize[xtype] - L;
-		if (L % typesize[TYSHORT])
-			*t0 = TYCHAR;
-		else
-			L /= typesize[*t0 = fill_type(L, loc0, xtype)];
-		}
-	if (dloc < loc + typesize[xtype])
-		return 0;
-	*L0 = L;
-	L2 = (dloc - loc) / typesize[xtype];
-	loc += L2*typesize[xtype];
-	if (dloc -= loc)
-		dloc /= typesize[*t1 = fill_type(dloc, loc, xtype)];
-	*L1 = dloc;
-	return L2;
-	}
-
- void
-#ifdef KR_headers
-wr_equiv_init(outfile, memno, Values, iscomm)
-	FILE *outfile;
-	int memno;
-	chainp *Values;
-	int iscomm;
-#else
-wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm)
-#endif
-{
-	struct Equivblock *eqv;
-	int btype, curtype, dtype, filltype, j, k, n, t0, t1;
-	int wasblank, xfilled, xtype;
-	static char Blank[] = "";
-	register char *comma = Blank;
-	register chainp cp, v;
-	chainp sentinel, values, v1, vlast;
-	ftnint L, L0, L1, L2, dL, dloc, loc, loc0;
-	union Constant Const;
-	char imag_buf[50], real_buf[50];
-	int szshort = typesize[TYSHORT];
-	static char typepref[] = {0, 0, TYINT1, TYSHORT, TYLONG,
-#ifdef TYQUAD
-				  TYQUAD,
-#endif
-				  TYREAL, TYDREAL, TYREAL, TYDREAL,
-				  TYLOGICAL1, TYLOGICAL2,
-				  TYLOGICAL, TYCHAR};
-	static char basetype[] = {0, 0, TYCHAR, TYSHORT, TYLONG,
-#ifdef TYQUAD
-				  TYDREAL,
-#endif
-				  TYLONG, TYDREAL, TYLONG, TYDREAL,
-				  TYCHAR, TYSHORT,
-				  TYLONG, TYCHAR, 0 /* for TYBLANK */ };
-	extern int htype;
-	char *z;
-
-	/* add sentinel */
-	if (iscomm) {
-		L = extsymtab[memno].maxleng;
-		xtype = extsymtab[memno].extype;
-		}
-	else {
-		eqv = &eqvclass[memno];
-		L = eqv->eqvtop - eqv->eqvbottom;
-		xtype = eqv->eqvtype;
-		}
-
-	if (halign && typealign[typepref[xtype]] < typealign[htype])
-		xtype = htype;
-	xtype = typepref[xtype];
-	*Values = values = revchain(vlast = *Values);
-
-	xfilled = 2;
-	if (xtype != TYCHAR) {
-
-		/* unless the data include a value of the appropriate
-		 * type, we add an extra element in an attempt
-		 * to force correct alignment */
-
-		btype = basetype[xtype];
-		loc = 0;
-		for(v = *Values;;v = v->nextp) {
-			if (!v) {
-				dtype = typepref[xtype];
-				z = ISREAL(dtype) ? cpstring("0.") : (char *)0;
-				k = typesize[dtype];
-				if (j = L % k)
-					L += k - j;
-				v = mkchain((char *)L,
-					mkchain((char *)LONG_CAST dtype,
-						mkchain(z, CHNULL)));
-				vlast = vlast->nextp =
-					mkchain((char *)v, CHNULL);
-				L += k;
-				break;
-				}
-			cp = (chainp)v->datap;
-			if (basetype[(int)cp->nextp->datap] == btype)
-				break;
-			dloc = (ftnint)cp->datap;
-			if (get_fill(dloc, loc, &t0, &t1, &L0, &L1, xtype)) {
-				xfilled = 0;
-				break;
-				}
-			L1 = dloc - loc;
-			if (L1 > 0
-			 && !(L1 % szshort)
-			 && !(loc % szshort)
-			 && btype <= type_choice[L1/szshort % 4]
-			 && btype <= type_choice[loc/szshort % 4])
-				break;
-			dtype = (int)cp->nextp->datap;
-			loc = dloc + (dtype == TYBLANK
-					? (ftnint)cp->nextp->nextp->datap
-					: typesize[dtype]);
-			}
-		}
-	sentinel = mkchain((char *)L, mkchain((char *)TYERROR,CHNULL));
-	vlast->nextp = mkchain((char *)sentinel, CHNULL);
-
-	/* use doublereal fillers only if there are doublereal values */
-
-	k = TYLONG;
-	for(v = values; v; v = v->nextp)
-		if (ONEOF((int)((chainp)v->datap)->nextp->datap,
-				M(TYDREAL)|M(TYDCOMPLEX))) {
-			k = TYDREAL;
-			break;
-			}
-	type_choice[0] = k;
-
-	nice_printf(outfile, "%sstruct {\n", iscomm ? "" : "static ");
-	next_tab(outfile);
-	loc = loc0 = k = 0;
-	curtype = -1;
-	for(v = values; v; v = v->nextp) {
-		cp = (chainp)v->datap;
-		dloc = (ftnint)cp->datap;
-		L = dloc - loc;
-		if (L < 0) {
-			overlapping();
-			if ((int)cp->nextp->datap != TYERROR) {
-				v1 = cp;
-				frchain(&v1);
-				v->datap = 0;
-				}
-			continue;
-			}
-		dtype = (int)cp->nextp->datap;
-		if (dtype == TYBLANK) {
-			dtype = TYCHAR;
-			wasblank = 1;
-			}
-		else
-			wasblank = 0;
-		if (curtype != dtype || L > 0) {
-			if (curtype != -1) {
-				L1 = (loc - loc0)/dL;
-				nice_printf(outfile, "%s e_%d%s;\n",
-					typename[curtype], ++k,
-					Len(L1,curtype));
-				}
-			curtype = dtype;
-			loc0 = dloc;
-			}
-		if (L > 0) {
-			filltype = fill_type(L, loc, xtype);
-			L1 = L / typesize[filltype];
-			if (!xfilled && (L2 = get_fill(dloc, loc, &t0, &t1,
-							&L0, &L1, xtype))) {
-				xfilled = 1;
-				if (L0)
-					fill_dcl(outfile, t0, ++k, L0);
-				fill_dcl(outfile, xtype, ++k, L2);
-				if (L1)
-					fill_dcl(outfile, t1, ++k, L1);
-				}
-			else
-				fill_dcl(outfile, filltype, ++k, L1);
-			loc = dloc;
-			}
-		if (wasblank) {
-			loc += (ftnint)cp->nextp->nextp->datap;
-			dL = 1;
-			}
-		else {
-			dL = typesize[dtype];
-			loc += dL;
-			}
-		}
-	nice_printf(outfile, "} %s = { ", iscomm
-		? extsymtab[memno].cextname
-		: equiv_name(eqvmemno, CNULL));
-	loc = 0;
-	xfilled &= 2;
-	for(v = values; ; v = v->nextp) {
-		cp = (chainp)v->datap;
-		if (!cp)
-			continue;
-		dtype = (int)cp->nextp->datap;
-		if (dtype == TYERROR)
-			break;
-		dloc = (ftnint)cp->datap;
-		if (dloc > loc) {
-			n = 1;
-			if (!xfilled && (L2 = get_fill(dloc, loc, &t0, &t1,
-							&L0, &L1, xtype))) {
-				xfilled = 1;
-				if (L0)
-					n = 2;
-				if (L1)
-					n++;
-				}
-			while(n--) {
-				nice_printf(outfile, "%s{0}", comma);
-				comma = ", ";
-				}
-			loc = dloc;
-			}
-		if (comma != Blank)
-			nice_printf(outfile, ", ");
-		comma = ", ";
-		if (dtype == TYCHAR || dtype == TYBLANK) {
-			v =  Ansi == 1  ? Ado_string(outfile, v, &loc)
-					:  do_string(outfile, v, &loc);
-			continue;
-			}
-		make_one_const(dtype, &Const, v);
-		switch(dtype) {
-			case TYLOGICAL:
-			case TYLOGICAL2:
-			case TYLOGICAL1:
-				if (Const.ci < 0 || Const.ci > 1)
-					errl(
-			  "wr_equiv_init: unexpected logical value %ld",
-						Const.ci);
-				nice_printf(outfile,
-					Const.ci ? "TRUE_" : "FALSE_");
-				break;
-			case TYINT1:
-			case TYSHORT:
-			case TYLONG:
-#ifdef TYQUAD
-			case TYQUAD:
-#endif
-				nice_printf(outfile, "%ld", Const.ci);
-				break;
-			case TYREAL:
-				nice_printf(outfile, "%s",
-					flconst(real_buf, Const.cds[0]));
-				break;
-			case TYDREAL:
-				nice_printf(outfile, "%s", Const.cds[0]);
-				break;
-			case TYCOMPLEX:
-				nice_printf(outfile, "%s, %s",
-					flconst(real_buf, Const.cds[0]),
-					flconst(imag_buf, Const.cds[1]));
-				break;
-			case TYDCOMPLEX:
-				nice_printf(outfile, "%s, %s",
-					Const.cds[0], Const.cds[1]);
-				break;
-			default:
-				erri("unexpected type %d in wr_equiv_init",
-					dtype);
-			}
-		loc += typesize[dtype];
-		}
-	nice_printf(outfile, " };\n\n");
-	prev_tab(outfile);
-	frchain(&sentinel);
-	}
diff --git a/usr.bin/f2c/ftypes.h b/usr.bin/f2c/ftypes.h
deleted file mode 100644
index 80d2deb..0000000
--- a/usr.bin/f2c/ftypes.h
+++ /dev/null
@@ -1,51 +0,0 @@
-
-/* variable types (stored in the   vtype  field of   expptr)
- * numeric assumptions:
- *	int < reals < complexes
- *	TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX
- */
-
-#ifdef NO_TYQUAD
-#undef TYQUAD
-#define TYQUAD_inc 0
-#else
-#define TYQUAD 5
-#define TYQUAD_inc 1
-#endif
-
-#define TYUNKNOWN 0
-#define TYADDR 1
-#define TYINT1 2
-#define TYSHORT 3
-#define TYLONG 4
-/* #define TYQUAD 5 */
-#define TYREAL (5+TYQUAD_inc)
-#define TYDREAL (6+TYQUAD_inc)
-#define TYCOMPLEX (7+TYQUAD_inc)
-#define TYDCOMPLEX (8+TYQUAD_inc)
-#define TYLOGICAL1 (9+TYQUAD_inc)
-#define TYLOGICAL2 (10+TYQUAD_inc)
-#define TYLOGICAL (11+TYQUAD_inc)
-#define TYCHAR (12+TYQUAD_inc)
-#define TYSUBR (13+TYQUAD_inc)
-#define TYERROR (14+TYQUAD_inc)
-#define TYCILIST (15+TYQUAD_inc)
-#define TYICILIST (16+TYQUAD_inc)
-#define TYOLIST (17+TYQUAD_inc)
-#define TYCLLIST (18+TYQUAD_inc)
-#define TYALIST (19+TYQUAD_inc)
-#define TYINLIST (20+TYQUAD_inc)
-#define TYVOID (21+TYQUAD_inc)
-#define TYLABEL (22+TYQUAD_inc)
-#define TYFTNLEN (23+TYQUAD_inc)
-/* TYVOID is not in any tables. */
-
-/* NTYPES, NTYPES0 -- Total number of types, used to allocate tables indexed by
-   type.  Such tables can include the size (in bytes) of objects of a given
-   type, or labels for returning objects of different types from procedures
-   (see array   rtvlabels)   */
-
-#define NTYPES TYVOID
-#define NTYPES0 TYCILIST
-#define TYBLANK TYSUBR		/* Huh? */
-
diff --git a/usr.bin/f2c/gram.dcl b/usr.bin/f2c/gram.dcl
deleted file mode 100644
index e5c5df0..0000000
--- a/usr.bin/f2c/gram.dcl
+++ /dev/null
@@ -1,416 +0,0 @@
-spec:	  dcl
-	| common
-	| external
-	| intrinsic
-	| equivalence
-	| data
-	| implicit
-	| namelist
-	| SSAVE
-		{ NO66("SAVE statement");
-		  saveall = YES; }
-	| SSAVE savelist
-		{ NO66("SAVE statement"); }
-	| SFORMAT
-		{ fmtstmt(thislabel); setfmt(thislabel); }
-	| SPARAM in_dcl SLPAR paramlist SRPAR
-		{ NO66("PARAMETER statement"); }
-	;
-
-dcl:	  type opt_comma name in_dcl new_dcl dims lengspec
-		{ settype($3, $1, $7);
-		  if(ndim>0) setbound($3,ndim,dims);
-		}
-	| dcl SCOMMA name dims lengspec
-		{ settype($3, $1, $5);
-		  if(ndim>0) setbound($3,ndim,dims);
-		}
-	| dcl SSLASHD datainit vallist SSLASHD
-		{ if (new_dcl == 2) {
-			err("attempt to give DATA in type-declaration");
-			new_dcl = 1;
-			}
-		}
-	;
-
-new_dcl:	{ new_dcl = 2; } ;
-
-type:	  typespec lengspec
-		{ varleng = $2; }
-	;
-
-typespec:  typename
-		{ varleng = ($1<0 || ONEOF($1,M(TYLOGICAL)|M(TYLONG))
-				? 0 : typesize[$1]);
-		  vartype = $1; }
-	;
-
-typename:    SINTEGER	{ $$ = TYLONG; }
-	| SREAL		{ $$ = tyreal; }
-	| SCOMPLEX	{ ++complex_seen; $$ = tycomplex; }
-	| SDOUBLE	{ $$ = TYDREAL; }
-	| SDCOMPLEX	{ ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }
-	| SLOGICAL	{ $$ = TYLOGICAL; }
-	| SCHARACTER	{ NO66("CHARACTER statement"); $$ = TYCHAR; }
-	| SUNDEFINED	{ $$ = TYUNKNOWN; }
-	| SDIMENSION	{ $$ = TYUNKNOWN; }
-	| SAUTOMATIC	{ NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
-	| SSTATIC	{ NOEXT("STATIC statement"); $$ = - STGBSS; }
-	| SBYTE		{ $$ = TYINT1; }
-	;
-
-lengspec:
-		{ $$ = varleng; }
-	| SSTAR intonlyon expr intonlyoff
-		{
-		expptr p;
-		p = $3;
-		NO66("length specification *n");
-		if( ! ISICON(p) || p->constblock.Const.ci <= 0 )
-			{
-			$$ = 0;
-			dclerr("length must be a positive integer constant",
-				NPNULL);
-			}
-		else {
-			if (vartype == TYCHAR)
-				$$ = p->constblock.Const.ci;
-			else switch((int)p->constblock.Const.ci) {
-				case 1:	$$ = 1; break;
-				case 2: $$ = typesize[TYSHORT];	break;
-				case 4: $$ = typesize[TYLONG];	break;
-				case 8: $$ = typesize[TYDREAL];	break;
-				case 16: $$ = typesize[TYDCOMPLEX]; break;
-				default:
-					dclerr("invalid length",NPNULL);
-					$$ = varleng;
-				}
-			}
-		}
-	| SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
-		{ NO66("length specification *(*)"); $$ = -1; }
-	;
-
-common:	  SCOMMON in_dcl var
-		{ incomm( $$ = comblock("") , $3 ); }
-	| SCOMMON in_dcl comblock var
-		{ $$ = $3;  incomm($3, $4); }
-	| common opt_comma comblock opt_comma var
-		{ $$ = $3;  incomm($3, $5); }
-	| common SCOMMA var
-		{ incomm($1, $3); }
-	;
-
-comblock:  SCONCAT
-		{ $$ = comblock(""); }
-	| SSLASH SNAME SSLASH
-		{ $$ = comblock(token); }
-	;
-
-external: SEXTERNAL in_dcl name
-		{ setext($3); }
-	| external SCOMMA name
-		{ setext($3); }
-	;
-
-intrinsic:  SINTRINSIC in_dcl name
-		{ NO66("INTRINSIC statement"); setintr($3); }
-	| intrinsic SCOMMA name
-		{ setintr($3); }
-	;
-
-equivalence:  SEQUIV in_dcl equivset
-	| equivalence SCOMMA equivset
-	;
-
-equivset:  SLPAR equivlist SRPAR
-		{
-		struct Equivblock *p;
-		if(nequiv >= maxequiv)
-			many("equivalences", 'q', maxequiv);
-		p  =  & eqvclass[nequiv++];
-		p->eqvinit = NO;
-		p->eqvbottom = 0;
-		p->eqvtop = 0;
-		p->equivs = $2;
-		}
-	;
-
-equivlist:  lhs
-		{ $$=ALLOC(Eqvchain);
-		  $$->eqvitem.eqvlhs = primchk($1);
-		}
-	| equivlist SCOMMA lhs
-		{ $$=ALLOC(Eqvchain);
-		  $$->eqvitem.eqvlhs = primchk($3);
-		  $$->eqvnextp = $1;
-		}
-	;
-
-data:	  SDATA in_data datalist
-	| data opt_comma datalist
-	;
-
-in_data:
-		{ if(parstate == OUTSIDE)
-			{
-			newproc();
-			startproc(ESNULL, CLMAIN);
-			}
-		  if(parstate < INDATA)
-			{
-			enddcl();
-			parstate = INDATA;
-			datagripe = 1;
-			}
-		}
-	;
-
-datalist:  datainit datavarlist SSLASH datapop vallist SSLASH
-		{ ftnint junk;
-		  if(nextdata(&junk) != NULL)
-			err("too few initializers");
-		  frdata($2);
-		  frrpl();
-		}
-	;
-
-datainit: /* nothing */ { frchain(&datastack); curdtp = 0; } ;
-
-datapop: /* nothing */ { pop_datastack(); } ;
-
-vallist:  { toomanyinit = NO; }  val
-	| vallist SCOMMA val
-	;
-
-val:	  value
-		{ dataval(ENULL, $1); }
-	| simple SSTAR value
-		{ dataval($1, $3); }
-	;
-
-value:	  simple
-	| addop simple
-		{ if( $1==OPMINUS && ISCONST($2) )
-			consnegop((Constp)$2);
-		  $$ = $2;
-		}
-	| complex_const
-	;
-
-savelist: saveitem
-	| savelist SCOMMA saveitem
-	;
-
-saveitem: name
-		{ int k;
-		  $1->vsave = YES;
-		  k = $1->vstg;
-		if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
-			dclerr("can only save static variables", $1);
-		}
-	| comblock
-	;
-
-paramlist:  paramitem
-	| paramlist SCOMMA paramitem
-	;
-
-paramitem:  name SEQUALS expr
-		{ if($1->vclass == CLUNKNOWN)
-			make_param((struct Paramblock *)$1, $3);
-		  else dclerr("cannot make into parameter", $1);
-		}
-	;
-
-var:	  name dims
-		{ if(ndim>0) setbound($1, ndim, dims); }
-	;
-
-datavar:	  lhs
-		{ Namep np;
-		  struct Primblock *pp = (struct Primblock *)$1;
-		  int tt = $1->tag;
-		  if (tt != TPRIM) {
-			if (tt == TCONST)
-				err("parameter in data statement");
-			else
-				erri("tag %d in data statement",tt);
-			$$ = 0;
-			err_lineno = lineno;
-			break;
-			}
-		  np = pp -> namep;
-		  vardcl(np);
-		  if ((pp->fcharp || pp->lcharp)
-		   && (np->vtype != TYCHAR || np->vdim && !pp->argsp))
-			sserr(np);
-		  if(np->vstg == STGCOMMON)
-			extsymtab[np->vardesc.varno].extinit = YES;
-		  else if(np->vstg==STGEQUIV)
-			eqvclass[np->vardesc.varno].eqvinit = YES;
-		  else if(np->vstg!=STGINIT && np->vstg!=STGBSS) {
-			errstr(np->vstg == STGARG
-				? "Dummy argument \"%.60s\" in data statement."
-				: "Cannot give data to \"%.75s\"",
-				np->fvarname);
-			$$ = 0;
-			err_lineno = lineno;
-			break;
-			}
-		  $$ = mkchain((char *)$1, CHNULL);
-		}
-	| SLPAR datavarlist SCOMMA dospec SRPAR
-		{ chainp p; struct Impldoblock *q;
-		pop_datastack();
-		q = ALLOC(Impldoblock);
-		q->tag = TIMPLDO;
-		(q->varnp = (Namep) ($4->datap))->vimpldovar = 1;
-		p = $4->nextp;
-		if(p)  { q->implb = (expptr)(p->datap); p = p->nextp; }
-		if(p)  { q->impub = (expptr)(p->datap); p = p->nextp; }
-		if(p)  { q->impstep = (expptr)(p->datap); }
-		frchain( & ($4) );
-		$$ = mkchain((char *)q, CHNULL);
-		q->datalist = hookup($2, $$);
-		}
-	;
-
-datavarlist: datavar
-		{ if (!datastack)
-			curdtp = 0;
-		  datastack = mkchain((char *)curdtp, datastack);
-		  curdtp = $1; curdtelt = 0;
-		  }
-	| datavarlist SCOMMA datavar
-		{ $$ = hookup($1, $3); }
-	;
-
-dims:
-		{ ndim = 0; }
-	| SLPAR dimlist SRPAR
-	;
-
-dimlist:   { ndim = 0; }   dim
-	| dimlist SCOMMA dim
-	;
-
-dim:	  ubound
-		{
-		  if(ndim == maxdim)
-			err("too many dimensions");
-		  else if(ndim < maxdim)
-			{ dims[ndim].lb = 0;
-			  dims[ndim].ub = $1;
-			}
-		  ++ndim;
-		}
-	| expr SCOLON ubound
-		{
-		  if(ndim == maxdim)
-			err("too many dimensions");
-		  else if(ndim < maxdim)
-			{ dims[ndim].lb = $1;
-			  dims[ndim].ub = $3;
-			}
-		  ++ndim;
-		}
-	;
-
-ubound:	  SSTAR
-		{ $$ = 0; }
-	| expr
-	;
-
-labellist: label
-		{ nstars = 1; labarray[0] = $1; }
-	| labellist SCOMMA label
-		{ if(nstars < maxlablist)  labarray[nstars++] = $3; }
-	;
-
-label:	  SICON
-		{ $$ = execlab( convci(toklen, token) ); }
-	;
-
-implicit:  SIMPLICIT in_dcl implist
-		{ NO66("IMPLICIT statement"); }
-	| implicit SCOMMA implist
-	;
-
-implist:  imptype SLPAR letgroups SRPAR
-	| imptype
-		{ if (vartype != TYUNKNOWN)
-			dclerr("-- expected letter range",NPNULL);
-		  setimpl(vartype, varleng, 'a', 'z'); }
-	;
-
-imptype:   { needkwd = 1; } type
-		/* { vartype = $2; } */
-	;
-
-letgroups: letgroup
-	| letgroups SCOMMA letgroup
-	;
-
-letgroup:  letter
-		{ setimpl(vartype, varleng, $1, $1); }
-	| letter SMINUS letter
-		{ setimpl(vartype, varleng, $1, $3); }
-	;
-
-letter:  SNAME
-		{ if(toklen!=1 || token[0]<'a' || token[0]>'z')
-			{
-			dclerr("implicit item must be single letter", NPNULL);
-			$$ = 0;
-			}
-		  else $$ = token[0];
-		}
-	;
-
-namelist:	SNAMELIST
-	| namelist namelistentry
-	;
-
-namelistentry:  SSLASH name SSLASH namelistlist
-		{
-		if($2->vclass == CLUNKNOWN)
-			{
-			$2->vclass = CLNAMELIST;
-			$2->vtype = TYINT;
-			$2->vstg = STGBSS;
-			$2->varxptr.namelist = $4;
-			$2->vardesc.varno = ++lastvarno;
-			}
-		else dclerr("cannot be a namelist name", $2);
-		}
-	;
-
-namelistlist:  name
-		{ $$ = mkchain((char *)$1, CHNULL); }
-	| namelistlist SCOMMA name
-		{ $$ = hookup($1, mkchain((char *)$3, CHNULL)); }
-	;
-
-in_dcl:
-		{ switch(parstate)
-			{
-			case OUTSIDE:	newproc();
-					startproc(ESNULL, CLMAIN);
-			case INSIDE:	parstate = INDCL;
-			case INDCL:	break;
-
-			case INDATA:
-				if (datagripe) {
-					errstr(
-				"Statement order error: declaration after DATA",
-						CNULL);
-					datagripe = 0;
-					}
-				break;
-
-			default:
-				dclerr("declaration among executables", NPNULL);
-			}
-		}
-	;
diff --git a/usr.bin/f2c/gram.exec b/usr.bin/f2c/gram.exec
deleted file mode 100644
index 39d7e42..0000000
--- a/usr.bin/f2c/gram.exec
+++ /dev/null
@@ -1,143 +0,0 @@
-exec:	  iffable
-	| SDO end_spec label opt_comma dospecw
-		{
-		if($3->labdefined)
-			execerr("no backward DO loops", CNULL);
-		$3->blklevel = blklevel+1;
-		exdo($3->labelno, NPNULL, $5);
-		}
-	| SDO end_spec opt_comma dospecw
-		{
-		exdo((int)(ctls - ctlstack - 2), NPNULL, $4);
-		NOEXT("DO without label");
-		}
-	| SENDDO
-		{ exenddo(NPNULL); }
-	| logif iffable
-		{ exendif();  thiswasbranch = NO; }
-	| logif STHEN
-	| SELSEIF end_spec SLPAR expr SRPAR STHEN
-		{ exelif($4); lastwasbranch = NO; }
-	| SELSE end_spec
-		{ exelse(); lastwasbranch = NO; }
-	| SENDIF end_spec
-		{ exendif(); lastwasbranch = NO; }
-	;
-
-logif:	  SLOGIF end_spec SLPAR expr SRPAR
-		{ exif($4); }
-	;
-
-dospec:	  name SEQUALS exprlist
-		{ $$ = mkchain((char *)$1, $3); }
-	;
-
-dospecw:  dospec
-	| SWHILE SLPAR expr SRPAR
-		{ $$ = mkchain(CNULL, (chainp)$3); }
-	;
-
-iffable:  let lhs SEQUALS expr
-		{ exequals((struct Primblock *)$2, $4); }
-	| SASSIGN end_spec assignlabel STO name
-		{ exassign($5, $3); }
-	| SCONTINUE end_spec
-	| goto
-	| io
-		{ inioctl = NO; }
-	| SARITHIF end_spec SLPAR expr SRPAR label SCOMMA label SCOMMA label
-		{ exarif($4, $6, $8, $10);  thiswasbranch = YES; }
-	| call
-		{ excall($1, LBNULL, 0, labarray); }
-	| call SLPAR SRPAR
-		{ excall($1, LBNULL, 0, labarray); }
-	| call SLPAR callarglist SRPAR
-		{ if(nstars < maxlablist)
-			excall($1, mklist(revchain($3)), nstars, labarray);
-		  else
-			many("alternate returns", 'l', maxlablist);
-		}
-	| SRETURN end_spec opt_expr
-		{ exreturn($3);  thiswasbranch = YES; }
-	| stop end_spec opt_expr
-		{ exstop($1, $3);  thiswasbranch = $1; }
-	;
-
-assignlabel:   SICON
-		{ $$ = mklabel( convci(toklen, token) ); }
-	;
-
-let:	  SLET
-		{ if(parstate == OUTSIDE)
-			{
-			newproc();
-			startproc(ESNULL, CLMAIN);
-			}
-		}
-	;
-
-goto:	  SGOTO end_spec label
-		{ exgoto($3);  thiswasbranch = YES; }
-	| SASGOTO end_spec name
-		{ exasgoto($3);  thiswasbranch = YES; }
-	| SASGOTO end_spec name opt_comma SLPAR labellist SRPAR
-		{ exasgoto($3);  thiswasbranch = YES; }
-	| SCOMPGOTO end_spec SLPAR labellist SRPAR opt_comma expr
-		{ if(nstars < maxlablist)
-			putcmgo(putx(fixtype($7)), nstars, labarray);
-		  else
-			many("labels in computed GOTO list", 'l', maxlablist);
-		}
-	;
-
-opt_comma:
-	| SCOMMA
-	;
-
-call:	  SCALL end_spec name
-		{ nstars = 0; $$ = $3; }
-	;
-
-callarglist:  callarg
-		{ $$ = $1 ? mkchain((char *)$1,CHNULL) : CHNULL; }
-	| callarglist SCOMMA callarg
-		{ $$ = $3 ? mkchain((char *)$3, $1) : $1; }
-	;
-
-callarg:  expr
-	| SSTAR label
-		{ if(nstars < maxlablist) labarray[nstars++] = $2; $$ = 0; }
-	;
-
-stop:	  SPAUSE
-		{ $$ = 0; }
-	| SSTOP
-		{ $$ = 2; }
-	;
-
-exprlist:  expr
-		{ $$ = mkchain((char *)$1, CHNULL); }
-	| exprlist SCOMMA expr
-		{ $$ = hookup($1, mkchain((char *)$3,CHNULL) ); }
-	;
-
-end_spec:
-		{ if(parstate == OUTSIDE)
-			{
-			newproc();
-			startproc(ESNULL, CLMAIN);
-			}
-
-/* This next statement depends on the ordering of the state table encoding */
-
-		  if(parstate < INDATA) enddcl();
-		}
-	;
-
-intonlyon:
-		{ intonly = YES; }
-	;
-
-intonlyoff:
-		{ intonly = NO; }
-	;
diff --git a/usr.bin/f2c/gram.expr b/usr.bin/f2c/gram.expr
deleted file mode 100644
index 1ef18e5..0000000
--- a/usr.bin/f2c/gram.expr
+++ /dev/null
@@ -1,142 +0,0 @@
-funarglist:
-		{ $$ = 0; }
-	| funargs
-		{ $$ = revchain($1); }
-	;
-
-funargs:  expr
-		{ $$ = mkchain((char *)$1, CHNULL); }
-	| funargs SCOMMA expr
-		{ $$ = mkchain((char *)$3, $1); }
-	;
-
-
-expr:	  uexpr
-	| SLPAR expr SRPAR	{ $$ = $2; if ($$->tag == TPRIM)
-					$$->primblock.parenused = 1; }
-	| complex_const
-	;
-
-uexpr:	  lhs
-	| simple_const
-	| expr addop expr   %prec SPLUS
-		{ $$ = mkexpr($2, $1, $3); }
-	| expr SSTAR expr
-		{ $$ = mkexpr(OPSTAR, $1, $3); }
-	| expr SSLASH expr
-		{ $$ = mkexpr(OPSLASH, $1, $3); }
-	| expr SPOWER expr
-		{ $$ = mkexpr(OPPOWER, $1, $3); }
-	| addop expr  %prec SSTAR
-		{ if($1 == OPMINUS)
-			$$ = mkexpr(OPNEG, $2, ENULL);
-		  else 	$$ = $2;
-		}
-	| expr relop expr  %prec SEQ
-		{ $$ = mkexpr($2, $1, $3); }
-	| expr SEQV expr
-		{ NO66(".EQV. operator");
-		  $$ = mkexpr(OPEQV, $1,$3); }
-	| expr SNEQV expr
-		{ NO66(".NEQV. operator");
-		  $$ = mkexpr(OPNEQV, $1, $3); }
-	| expr SOR expr
-		{ $$ = mkexpr(OPOR, $1, $3); }
-	| expr SAND expr
-		{ $$ = mkexpr(OPAND, $1, $3); }
-	| SNOT expr
-		{ $$ = mkexpr(OPNOT, $2, ENULL); }
-	| expr SCONCAT expr
-		{ NO66("concatenation operator //");
-		  $$ = mkexpr(OPCONCAT, $1, $3); }
-	;
-
-addop:	  SPLUS		{ $$ = OPPLUS; }
-	| SMINUS	{ $$ = OPMINUS; }
-	;
-
-relop:	  SEQ	{ $$ = OPEQ; }
-	| SGT	{ $$ = OPGT; }
-	| SLT	{ $$ = OPLT; }
-	| SGE	{ $$ = OPGE; }
-	| SLE	{ $$ = OPLE; }
-	| SNE	{ $$ = OPNE; }
-	;
-
-lhs:	 name
-		{ $$ = mkprim($1, LBNULL, CHNULL); }
-	| name substring
-		{ NO66("substring operator :");
-		  $$ = mkprim($1, LBNULL, $2); }
-	| name SLPAR funarglist SRPAR
-		{ $$ = mkprim($1, mklist($3), CHNULL); }
-	| name SLPAR funarglist SRPAR substring
-		{ NO66("substring operator :");
-		  $$ = mkprim($1, mklist($3), $5); }
-	;
-
-substring:  SLPAR opt_expr SCOLON opt_expr SRPAR
-		{ $$ = mkchain((char *)$2, mkchain((char *)$4,CHNULL)); }
-	;
-
-opt_expr:
-		{ $$ = 0; }
-	| expr
-	;
-
-simple:	  name
-		{ if($1->vclass == CLPARAM)
-			$$ = (expptr) cpexpr(
-				( (struct Paramblock *) ($1) ) -> paramval);
-		}
-	| simple_const
-	;
-
-simple_const:   STRUE	{ $$ = mklogcon(1); }
-	| SFALSE	{ $$ = mklogcon(0); }
-	| SHOLLERITH  { $$ = mkstrcon(toklen, token); }
-	| SICON	= { $$ = mkintcon( convci(toklen, token) ); }
-	| SRCON	= { $$ = mkrealcon(tyreal, token); }
-	| SDCON	= { $$ = mkrealcon(TYDREAL, token); }
-	| bit_const
-	;
-
-complex_const:  SLPAR uexpr SCOMMA uexpr SRPAR
-		{ $$ = mkcxcon($2,$4); }
-	;
-
-bit_const:  SHEXCON
-		{ NOEXT("hex constant");
-		  $$ = mkbitcon(4, toklen, token); }
-	| SOCTCON
-		{ NOEXT("octal constant");
-		  $$ = mkbitcon(3, toklen, token); }
-	| SBITCON
-		{ NOEXT("binary constant");
-		  $$ = mkbitcon(1, toklen, token); }
-	;
-
-fexpr:	  unpar_fexpr
-	| SLPAR fexpr SRPAR
-		{ $$ = $2; }
-	;
-
-unpar_fexpr:	  lhs
-	| simple_const
-	| fexpr addop fexpr   %prec SPLUS
-		{ $$ = mkexpr($2, $1, $3); }
-	| fexpr SSTAR fexpr
-		{ $$ = mkexpr(OPSTAR, $1, $3); }
-	| fexpr SSLASH fexpr
-		{ $$ = mkexpr(OPSLASH, $1, $3); }
-	| fexpr SPOWER fexpr
-		{ $$ = mkexpr(OPPOWER, $1, $3); }
-	| addop fexpr  %prec SSTAR
-		{ if($1 == OPMINUS)
-			$$ = mkexpr(OPNEG, $2, ENULL);
-		  else	$$ = $2;
-		}
-	| fexpr SCONCAT fexpr
-		{ NO66("concatenation operator //");
-		  $$ = mkexpr(OPCONCAT, $1, $3); }
-	;
diff --git a/usr.bin/f2c/gram.head b/usr.bin/f2c/gram.head
deleted file mode 100644
index 183dfeb..0000000
--- a/usr.bin/f2c/gram.head
+++ /dev/null
@@ -1,291 +0,0 @@
-/****************************************************************
-Copyright 1990, 1993 by AT&T Bell Laboratories, Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T Bell Laboratories or
-Bellcore or any of their entities not be used in advertising or
-publicity pertaining to distribution of the software without
-specific, written prior permission.
-
-AT&T and Bellcore disclaim all warranties with regard to this
-software, including all implied warranties of merchantability
-and fitness.  In no event shall AT&T or Bellcore be liable for
-any special, indirect or consequential damages or any damages
-whatsoever resulting from loss of use, data or profits, whether
-in an action of contract, negligence or other tortious action,
-arising out of or in connection with the use or performance of
-this software.
-****************************************************************/
-
-%{
-#include "defs.h"
-#include "p1defs.h"
-
-static int nstars;			/* Number of labels in an
-					   alternate return CALL */
-static int datagripe;
-static int ndim;
-static int vartype;
-int new_dcl;
-static ftnint varleng;
-static struct Dims dims[MAXDIM+1];
-extern struct Labelblock **labarray;	/* Labels in an alternate
-						   return CALL */
-extern int maxlablist;
-
-/* The next two variables are used to verify that each statement might be reached
-   during runtime.   lastwasbranch   is tested only in the defintion of the
-   stat:   nonterminal. */
-
-int lastwasbranch = NO;
-static int thiswasbranch = NO;
-extern ftnint yystno;
-extern flag intonly;
-static chainp datastack;
-extern long laststfcn, thisstno;
-extern int can_include;	/* for netlib */
-extern struct Primblock *primchk Argdcl((expptr));
-
-#define ESNULL (Extsym *)0
-#define NPNULL (Namep)0
-#define LBNULL (struct Listblock *)0
-
- static void
-pop_datastack(Void) {
-	chainp d0 = datastack;
-	if (d0->datap)
-		curdtp = (chainp)d0->datap;
-	datastack = d0->nextp;
-	d0->nextp = 0;
-	frchain(&d0);
-	}
-
-%}
-
-/* Specify precedences and associativities. */
-
-%union	{
-	int ival;
-	ftnint lval;
-	char *charpval;
-	chainp chval;
-	tagptr tagval;
-	expptr expval;
-	struct Labelblock *labval;
-	struct Nameblock *namval;
-	struct Eqvchain *eqvval;
-	Extsym *extval;
-	}
-
-%left SCOMMA
-%nonassoc SCOLON
-%right SEQUALS
-%left SEQV SNEQV
-%left SOR
-%left SAND
-%left SNOT
-%nonassoc SLT SGT SLE SGE SEQ SNE
-%left SCONCAT
-%left SPLUS SMINUS
-%left SSTAR SSLASH
-%right SPOWER
-
-%start program
-%type <labval> thislabel label assignlabel
-%type <tagval> other inelt
-%type <ival> type typespec typename dcl letter addop relop stop nameeq
-%type <lval> lengspec
-%type <charpval> filename
-%type <chval> datavar datavarlist namelistlist funarglist funargs
-%type <chval> dospec dospecw
-%type <chval> callarglist arglist args exprlist inlist outlist out2 substring
-%type <namval> name arg call var
-%type <expval> lhs expr uexpr opt_expr fexpr unpar_fexpr
-%type <expval> ubound simple value callarg complex_const simple_const bit_const
-%type <extval> common comblock entryname progname
-%type <eqvval> equivlist
-
-%%
-
-program:
-	| program stat SEOS
-	;
-
-stat:	  thislabel  entry
-		{
-/* stat:   is the nonterminal for Fortran statements */
-
-		  lastwasbranch = NO; }
-	| thislabel  spec
-	| thislabel  exec
-		{ /* forbid further statement function definitions... */
-		  if (parstate == INDATA && laststfcn != thisstno)
-			parstate = INEXEC;
-		  thisstno++;
-		  if($1 && ($1->labelno==dorange))
-			enddo($1->labelno);
-		  if(lastwasbranch && thislabel==NULL)
-			warn("statement cannot be reached");
-		  lastwasbranch = thiswasbranch;
-		  thiswasbranch = NO;
-		  if($1)
-			{
-			if($1->labtype == LABFORMAT)
-				err("label already that of a format");
-			else
-				$1->labtype = LABEXEC;
-			}
-		  freetemps();
-		}
-	| thislabel SINCLUDE filename
-		{ if (can_include)
-			doinclude( $3 );
-		  else {
-			fprintf(diagfile, "Cannot open file %s\n", $3);
-			done(1);
-			}
-		}
-	| thislabel  SEND  end_spec
-		{ if ($1)
-			lastwasbranch = NO;
-		  endproc(); /* lastwasbranch = NO; -- set in endproc() */
-		}
-	| thislabel SUNKNOWN
-		{ unclassifiable();
-
-/* flline flushes the current line, ignoring the rest of the text there */
-
-		  flline(); }
-	| error
-		{ flline();  needkwd = NO;  inioctl = NO;
-		  yyerrok; yyclearin; }
-	;
-
-thislabel:  SLABEL
-		{
-		if(yystno != 0)
-			{
-			$$ = thislabel =  mklabel(yystno);
-			if( ! headerdone ) {
-				if (procclass == CLUNKNOWN)
-					procclass = CLMAIN;
-				puthead(CNULL, procclass);
-				}
-			if(thislabel->labdefined)
-				execerr("label %s already defined",
-					convic(thislabel->stateno) );
-			else	{
-				if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
-				    && thislabel->labtype!=LABFORMAT)
-					warn1("there is a branch to label %s from outside block",
-					      convic( (ftnint) (thislabel->stateno) ) );
-				thislabel->blklevel = blklevel;
-				thislabel->labdefined = YES;
-				if(thislabel->labtype != LABFORMAT)
-					p1_label((long)(thislabel - labeltab));
-				}
-			}
-		else    $$ = thislabel = NULL;
-		}
-	;
-
-entry:	  SPROGRAM new_proc progname
-		   {startproc($3, CLMAIN); }
-	| SPROGRAM new_proc progname progarglist
-		   {	warn("ignoring arguments to main program");
-			/* hashclear(); */
-			startproc($3, CLMAIN); }
-	| SBLOCK new_proc progname
-		{ if($3) NO66("named BLOCKDATA");
-		  startproc($3, CLBLOCK); }
-	| SSUBROUTINE new_proc entryname arglist
-		{ entrypt(CLPROC, TYSUBR, (ftnint) 0,  $3, $4); }
-	| SFUNCTION new_proc entryname arglist
-		{ entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); }
-	| type SFUNCTION new_proc entryname arglist
-		{ entrypt(CLPROC, $1, varleng, $4, $5); }
-	| SENTRY entryname arglist
-		 { if(parstate==OUTSIDE || procclass==CLMAIN
-			|| procclass==CLBLOCK)
-				execerr("misplaced entry statement", CNULL);
-		  entrypt(CLENTRY, 0, (ftnint) 0, $2, $3);
-		}
-	;
-
-new_proc:
-		{ newproc(); }
-	;
-
-entryname:  name
-		{ $$ = newentry($1, 1); }
-	;
-
-name:	  SNAME
-		{ $$ = mkname(token); }
-	;
-
-progname:		{ $$ = NULL; }
-	| entryname
-	;
-
-progarglist:
-	  SLPAR SRPAR
-	| SLPAR progargs SRPAR
-	;
-
-progargs: progarg
-	| progargs SCOMMA progarg
-	;
-
-progarg:  SNAME
-	| SNAME SEQUALS SNAME
-	;
-
-arglist:
-		{ $$ = 0; }
-	| SLPAR SRPAR
-		{ NO66(" () argument list");
-		  $$ = 0; }
-	| SLPAR args SRPAR
-		{$$ = $2; }
-	;
-
-args:	  arg
-		{ $$ = ($1 ? mkchain((char *)$1,CHNULL) : CHNULL ); }
-	| args SCOMMA arg
-		{ if($3) $1 = $$ = mkchain((char *)$3, $1); }
-	;
-
-arg:	  name
-		{ if($1->vstg!=STGUNKNOWN && $1->vstg!=STGARG)
-			dclerr("name declared as argument after use", $1);
-		  $1->vstg = STGARG;
-		}
-	| SSTAR
-		{ NO66("altenate return argument");
-
-/* substars   means that '*'ed formal parameters should be replaced.
-   This is used to specify alternate return labels; in theory, only
-   parameter slots which have '*' should accept the statement labels.
-   This compiler chooses to ignore the '*'s in the formal declaration, and
-   always return the proper value anyway.
-
-   This variable is only referred to in   proc.c   */
-
-		  $$ = 0;  substars = YES; }
-	;
-
-
-
-filename:   SHOLLERITH
-		{
-		char *s;
-		s = copyn(toklen+1, token);
-		s[toklen] = '\0';
-		$$ = s;
-		}
-	;
diff --git a/usr.bin/f2c/gram.io b/usr.bin/f2c/gram.io
deleted file mode 100644
index f1a6649..0000000
--- a/usr.bin/f2c/gram.io
+++ /dev/null
@@ -1,173 +0,0 @@
-  /*  Input/Output Statements */
-
-io:	  io1
-		{ endio(); }
-	;
-
-io1:	  iofmove ioctl
-	| iofmove unpar_fexpr
-		{ ioclause(IOSUNIT, $2); endioctl(); }
-	| iofmove SSTAR
-		{ ioclause(IOSUNIT, ENULL); endioctl(); }
-	| iofmove SPOWER
-		{ ioclause(IOSUNIT, IOSTDERR); endioctl(); }
-	| iofctl ioctl
-	| read ioctl
-		{ doio(CHNULL); }
-	| read infmt
-		{ doio(CHNULL); }
-	| read ioctl inlist
-		{ doio(revchain($3)); }
-	| read infmt SCOMMA inlist
-		{ doio(revchain($4)); }
-	| read ioctl SCOMMA inlist
-		{ doio(revchain($4)); }
-	| write ioctl
-		{ doio(CHNULL); }
-	| write ioctl outlist
-		{ doio(revchain($3)); }
-	| print
-		{ doio(CHNULL); }
-	| print SCOMMA outlist
-		{ doio(revchain($3)); }
-	;
-
-iofmove:   fmkwd end_spec in_ioctl
-	;
-
-fmkwd:	  SBACKSPACE
-		{ iostmt = IOBACKSPACE; }
-	| SREWIND
-		{ iostmt = IOREWIND; }
-	| SENDFILE
-		{ iostmt = IOENDFILE; }
-	;
-
-iofctl:  ctlkwd end_spec in_ioctl
-	;
-
-ctlkwd:	  SINQUIRE
-		{ iostmt = IOINQUIRE; }
-	| SOPEN
-		{ iostmt = IOOPEN; }
-	| SCLOSE
-		{ iostmt = IOCLOSE; }
-	;
-
-infmt:	  unpar_fexpr
-		{
-		ioclause(IOSUNIT, ENULL);
-		ioclause(IOSFMT, $1);
-		endioctl();
-		}
-	| SSTAR
-		{
-		ioclause(IOSUNIT, ENULL);
-		ioclause(IOSFMT, ENULL);
-		endioctl();
-		}
-	;
-
-ioctl:	  SLPAR fexpr SRPAR
-		{
-		  ioclause(IOSUNIT, $2);
-		  endioctl();
-		}
-	| SLPAR ctllist SRPAR
-		{ endioctl(); }
-	;
-
-ctllist:  ioclause
-	| ctllist SCOMMA ioclause
-	;
-
-ioclause:  fexpr
-		{ ioclause(IOSPOSITIONAL, $1); }
-	| SSTAR
-		{ ioclause(IOSPOSITIONAL, ENULL); }
-	| SPOWER
-		{ ioclause(IOSPOSITIONAL, IOSTDERR); }
-	| nameeq expr
-		{ ioclause($1, $2); }
-	| nameeq SSTAR
-		{ ioclause($1, ENULL); }
-	| nameeq SPOWER
-		{ ioclause($1, IOSTDERR); }
-	;
-
-nameeq:  SNAMEEQ
-		{ $$ = iocname(); }
-	;
-
-read:	  SREAD end_spec in_ioctl
-		{ iostmt = IOREAD; }
-	;
-
-write:	  SWRITE end_spec in_ioctl
-		{ iostmt = IOWRITE; }
-	;
-
-print:	  SPRINT end_spec fexpr in_ioctl
-		{
-		iostmt = IOWRITE;
-		ioclause(IOSUNIT, ENULL);
-		ioclause(IOSFMT, $3);
-		endioctl();
-		}
-	| SPRINT end_spec SSTAR in_ioctl
-		{
-		iostmt = IOWRITE;
-		ioclause(IOSUNIT, ENULL);
-		ioclause(IOSFMT, ENULL);
-		endioctl();
-		}
-	;
-
-inlist:	  inelt
-		{ $$ = mkchain((char *)$1, CHNULL); }
-	| inlist SCOMMA inelt
-		{ $$ = mkchain((char *)$3, $1); }
-	;
-
-inelt:	  lhs
-		{ $$ = (tagptr) $1; }
-	| SLPAR inlist SCOMMA dospec SRPAR
-		{ $$ = (tagptr) mkiodo($4,revchain($2)); }
-	;
-
-outlist:  uexpr
-		{ $$ = mkchain((char *)$1, CHNULL); }
-	| other
-		{ $$ = mkchain((char *)$1, CHNULL); }
-	| out2
-	;
-
-out2:	  uexpr SCOMMA uexpr
-		{ $$ = mkchain((char *)$3, mkchain((char *)$1, CHNULL) ); }
-	| uexpr SCOMMA other
-		{ $$ = mkchain((char *)$3, mkchain((char *)$1, CHNULL) ); }
-	| other SCOMMA uexpr
-		{ $$ = mkchain((char *)$3, mkchain((char *)$1, CHNULL) ); }
-	| other SCOMMA other
-		{ $$ = mkchain((char *)$3, mkchain((char *)$1, CHNULL) ); }
-	| out2  SCOMMA uexpr
-		{ $$ = mkchain((char *)$3, $1); }
-	| out2  SCOMMA other
-		{ $$ = mkchain((char *)$3, $1); }
-	;
-
-other:	  complex_const
-		{ $$ = (tagptr) $1; }
-	| SLPAR expr SRPAR
-		{ $$ = (tagptr) $2; }
-	| SLPAR uexpr SCOMMA dospec SRPAR
-		{ $$ = (tagptr) mkiodo($4, mkchain((char *)$2, CHNULL) ); }
-	| SLPAR other SCOMMA dospec SRPAR
-		{ $$ = (tagptr) mkiodo($4, mkchain((char *)$2, CHNULL) ); }
-	| SLPAR out2  SCOMMA dospec SRPAR
-		{ $$ = (tagptr) mkiodo($4, revchain($2)); }
-	;
-
-in_ioctl:
-		{ startioctl(); }
-	;
diff --git a/usr.bin/f2c/init.c b/usr.bin/f2c/init.c
deleted file mode 100644
index bc0dff4..0000000
--- a/usr.bin/f2c/init.c
+++ /dev/null
@@ -1,517 +0,0 @@
-/****************************************************************
-Copyright 1990, 1992 - 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "output.h"
-#include "iob.h"
-
-/* State required for the C output */
-char *fl_fmt_string;		/* Float format string */
-char *db_fmt_string;	    	/* Double format string */
-char *cm_fmt_string;		/* Complex format string */
-char *dcm_fmt_string;		/* Double complex format string */
-
-chainp new_vars = CHNULL;	/* List of newly created locals in this
-				   function.  These may have identifiers
-				   which have underscores and more than VL
-				   characters */
-chainp used_builtins = CHNULL;	/* List of builtins used by this function.
-				   These are all Addrps with UNAM_EXTERN
-				   */
-chainp assigned_fmts = CHNULL;	/* assigned formats */
-chainp allargs;			/* union of args in all entry points */
-chainp earlylabs;		/* labels seen before enddcl() */
-char main_alias[52];		/* PROGRAM name, if any is given */
-int tab_size = 4;
-
-
-FILEP infile;
-FILEP diagfile;
-
-FILEP c_file;
-FILEP pass1_file;
-FILEP initfile;
-FILEP blkdfile;
-
-
-char *token;
-int maxtoklen, toklen;
-long err_lineno;
-long lineno;			/* Current line in the input file, NOT the
-				   Fortran statement label number */
-char *infname;
-int needkwd;
-struct Labelblock *thislabel	= NULL;
-int nerr;
-int nwarn;
-
-flag saveall;
-flag substars;
-int parstate	= OUTSIDE;
-flag headerdone	= NO;
-int blklevel;
-int doin_setbound;
-int impltype[26];
-ftnint implleng[26];
-int implstg[26];
-
-int tyint	= TYLONG ;
-int tylogical	= TYLONG;
-int tylog	= TYLOGICAL;
-int typesize[NTYPES] = {
-	1, SZADDR, 1, SZSHORT, SZLONG,
-#ifdef TYQUAD
-		2*SZLONG,
-#endif
-		SZLONG, 2*SZLONG,
-		2*SZLONG, 4*SZLONG, 1, SZSHORT, SZLONG, 1, 1, 0,
-		4*SZLONG + SZADDR,	/* sizeof(cilist) */
-		4*SZLONG + 2*SZADDR,	/* sizeof(icilist) */
-		4*SZLONG + 5*SZADDR,	/* sizeof(olist) */
-		2*SZLONG + SZADDR,	/* sizeof(cllist) */
-		2*SZLONG,		/* sizeof(alist) */
-		11*SZLONG + 15*SZADDR	/* sizeof(inlist) */
-		};
-
-int typealign[NTYPES] = {
-	1, ALIADDR, 1, ALISHORT, ALILONG,
-#ifdef TYQUAD
-	ALIDOUBLE,
-#endif
-	ALILONG, ALIDOUBLE,
-	ALILONG, ALIDOUBLE, 1, ALISHORT, ALILONG, 1, 1, 1,
-	ALILONG, ALILONG, ALILONG, ALILONG, ALILONG, ALILONG};
-
-int type_choice[4] = { TYDREAL, TYSHORT, TYLONG,  TYSHORT };
-
-char *typename[] = {
-	"<<unknown>>",
-	"address",
-	"integer1",
-	"shortint",
-	"integer",
-#ifdef TYQUAD
-	"longint",
-#endif
-	"real",
-	"doublereal",
-	"complex",
-	"doublecomplex",
-	"logical1",
-	"shortlogical",
-	"logical",
-	"char"	/* character */
-	};
-
-int type_pref[NTYPES] = { 0, 0, 3, 5, 7,
-#ifdef TYQUAD
-			 10,
-#endif
-				8, 11, 9, 12, 1, 4, 6, 2 };
-
-char *protorettypes[] = {
-	"?", "??", "integer1", "shortint", "integer",
-#ifdef TYQUAD
-	"longint",
-#endif
-	"real", "doublereal",
-	"C_f", "Z_f", "logical1", "shortlogical", "logical", "H_f", "int"
-	};
-
-char *casttypes[TYSUBR+1] = {
-	"U_fp", "??bug??", "I1_fp",
-	"J_fp", "I_fp",
-#ifdef TYQUAD
-	"Q_fp",
-#endif
-	"R_fp", "D_fp", "C_fp", "Z_fp",
-	"L1_fp", "L2_fp", "L_fp", "H_fp", "S_fp"
-	};
-char *usedcasts[TYSUBR+1];
-
-char *dfltarg[] = {
-	0, 0, "(integer1 *)0",
-	"(shortint *)0", "(integer *)0",
-#ifdef TYQUAD
-	"(longint *)0",
-#endif
-	"(real *)0",
-	"(doublereal *)0", "(complex *)0", "(doublecomplex *)0",
-	"(logical1 *)0","(shortlogical *)0", "(logical *)0", "(char *)0"
-	};
-
-static char *dflt0proc[] = {
-	0, 0, "(integer1 (*)())0",
-	"(shortint (*)())0", "(integer (*)())0",
-#ifdef TYQUAD
-	"(longint (*)())0",
-#endif
-	"(real (*)())0",
-	"(doublereal (*)())0", "(complex (*)())0", "(doublecomplex (*)())0",
-	"(logical1 (*)())0", "(shortlogical (*)())0",
-	"(logical (*)())0", "(char (*)())0", "(int (*)())0"
-	};
-
-char *dflt1proc[] = { "(U_fp)0", "(??bug??)0", "(I1_fp)0",
-	"(J_fp)0", "(I_fp)0",
-#ifdef TYQUAD
-	"(Q_fp)0",
-#endif
-	"(R_fp)0", "(D_fp)0", "(C_fp)0", "(Z_fp)0",
-	"(L1_fp)0","(L2_fp)0",
-	"(L_fp)0", "(H_fp)0", "(S_fp)0"
-	};
-
-char **dfltproc = dflt0proc;
-
-static char Bug[] = "bug";
-
-char *ftn_types[] = { "external", "??", "integer*1",
-	"integer*2", "integer",
-#ifdef TYQUAD
-	"integer*8",
-#endif
-	"real",
-	"double precision", "complex", "double complex",
-	"logical*1", "logical*2",
-	"logical", "character", "subroutine",
-	Bug,Bug,Bug,Bug,Bug,Bug,Bug,Bug,Bug, "ftnlen"
-	};
-
-int init_ac[TYSUBR+1] = { 0,0,0,0,0,0,0,
-#ifdef TYQUAD
-			  0,
-#endif
-			  1, 1, 0, 0, 0, 2};
-
-int proctype	= TYUNKNOWN;
-char *procname;
-int rtvlabel[NTYPES0];
-Addrp retslot;			/* Holds automatic variable which was
-				   allocated the function return value
-				   */
-Addrp xretslot[NTYPES0];	/* for multiple entry points */
-int cxslot	= -1;
-int chslot	= -1;
-int chlgslot	= -1;
-int procclass	= CLUNKNOWN;
-int nentry;
-int nallargs;
-int nallchargs;
-flag multitype;
-ftnint procleng;
-long lastiolabno;
-long lastlabno;
-int lastvarno;
-int lastargslot;
-int autonum[TYVOID];
-char *av_pfix[TYVOID] = {"??TYUNKNOWN??", "a","i1","s","i",
-#ifdef TYQUAD
-			 "i8",
-#endif
-			"r","d","q","z","L1","L2","L","ch",
-			 "??TYSUBR??", "??TYERROR??","ci", "ici",
-			 "o", "cl", "al", "ioin" };
-
-extern int maxctl;
-struct Ctlframe *ctls;
-struct Ctlframe *ctlstack;
-struct Ctlframe *lastctl;
-
-Namep regnamep[MAXREGVAR];
-int highregvar;
-int nregvar;
-
-extern int maxext;
-Extsym *extsymtab;
-Extsym *nextext;
-Extsym *lastext;
-
-extern int maxequiv;
-struct Equivblock *eqvclass;
-
-extern int maxhash;
-struct Hashentry *hashtab;
-struct Hashentry *lasthash;
-
-extern int maxstno;		/* Maximum number of statement labels */
-struct Labelblock *labeltab;
-struct Labelblock *labtabend;
-struct Labelblock *highlabtab;
-
-int maxdim	= MAXDIM;
-struct Rplblock *rpllist	= NULL;
-struct Chain *curdtp	= NULL;
-flag toomanyinit;
-ftnint curdtelt;
-chainp templist[TYVOID];
-chainp holdtemps;
-int dorange	= 0;
-struct Entrypoint *entries	= NULL;
-
-chainp chains	= NULL;
-
-flag inioctl;
-int iostmt;
-int nioctl;
-int nequiv	= 0;
-int eqvstart	= 0;
-int nintnames	= 0;
-extern int maxlablist;
-struct Labelblock **labarray;
-
-struct Literal *litpool;
-int nliterals;
-
-char dflttype[26];
-char hextoi_tab[Table_size], Letters[Table_size];
-char *ei_first, *ei_next, *ei_last;
-char *wh_first, *wh_next, *wh_last;
-
-#define ALLOCN(n,x)	(struct x *) ckalloc((n)*sizeof(struct x))
-
- void
-fileinit(Void)
-{
-	register char *s;
-	register int i, j;
-
-	lastiolabno = 100000;
-	lastlabno = 0;
-	lastvarno = 0;
-	nliterals = 0;
-	nerr = 0;
-
-	infile = stdin;
-
-	maxtoklen = 502;
-	token = (char *)ckalloc(maxtoklen+2);
-	memset(dflttype, tyreal, 26);
-	memset(dflttype + 'i' - 'a', tyint, 6);
-	memset(hextoi_tab, 16, sizeof(hextoi_tab));
-	for(i = 0, s = "0123456789abcdef"; *s; i++, s++)
-		hextoi(*s) = i;
-	for(i = 10, s = "ABCDEF"; *s; i++, s++)
-		hextoi(*s) = i;
-	for(j = 0, s = "abcdefghijklmnopqrstuvwxyz"; i = *s++; j++)
-		Letters[i] = Letters[i+'A'-'a'] = j;
-
-	ctls = ALLOCN(maxctl+1, Ctlframe);
-	extsymtab = ALLOCN(maxext, Extsym);
-	eqvclass = ALLOCN(maxequiv, Equivblock);
-	hashtab = ALLOCN(maxhash, Hashentry);
-	labeltab = ALLOCN(maxstno, Labelblock);
-	litpool = ALLOCN(maxliterals, Literal);
-	labarray = (struct Labelblock **)ckalloc(maxlablist*
-					sizeof(struct Labelblock *));
-	fmt_init();
-	mem_init();
-	np_init();
-
-	ctlstack = ctls++;
-	lastctl = ctls + maxctl;
-	nextext = extsymtab;
-	lastext = extsymtab + maxext;
-	lasthash = hashtab + maxhash;
-	labtabend = labeltab + maxstno;
-	highlabtab = labeltab;
-	main_alias[0] = '\0';
-	if (forcedouble)
-		dfltproc[TYREAL] = dfltproc[TYDREAL];
-
-/* Initialize the routines for providing C output */
-
-	out_init ();
-}
-
- void
-hashclear(Void)	/* clear hash table */
-{
-	register struct Hashentry *hp;
-	register Namep p;
-	register struct Dimblock *q;
-	register int i;
-
-	for(hp = hashtab ; hp < lasthash ; ++hp)
-		if(p = hp->varp)
-		{
-			frexpr(p->vleng);
-			if(q = p->vdim)
-			{
-				for(i = 0 ; i < q->ndim ; ++i)
-				{
-					frexpr(q->dims[i].dimsize);
-					frexpr(q->dims[i].dimexpr);
-				}
-				frexpr(q->nelt);
-				frexpr(q->baseoffset);
-				frexpr(q->basexpr);
-				free( (charptr) q);
-			}
-			if(p->vclass == CLNAMELIST)
-				frchain( &(p->varxptr.namelist) );
-			free( (charptr) p);
-			hp->varp = NULL;
-		}
-	}
-
- void
-procinit(Void)
-{
-	register struct Labelblock *lp;
-	struct Chain *cp;
-	int i;
-	struct memblock;
-	extern struct memblock *curmemblock, *firstmemblock;
-	extern char *mem_first, *mem_next, *mem_last, *mem0_last;
-
-	curmemblock = firstmemblock;
-	mem_next = mem_first;
-	mem_last = mem0_last;
-	ei_next = ei_first = ei_last = 0;
-	wh_next = wh_first = wh_last = 0;
-	iob_list = 0;
-	for(i = 0; i < 9; i++)
-		io_structs[i] = 0;
-
-	parstate = OUTSIDE;
-	headerdone = NO;
-	blklevel = 1;
-	saveall = NO;
-	substars = NO;
-	nwarn = 0;
-	thislabel = NULL;
-	needkwd = 0;
-
-	proctype = TYUNKNOWN;
-	procname = "MAIN_";
-	procclass = CLUNKNOWN;
-	nentry = 0;
-	nallargs = nallchargs = 0;
-	multitype = NO;
-	retslot = NULL;
-	for(i = 0; i < NTYPES0; i++) {
-		frexpr((expptr)xretslot[i]);
-		xretslot[i] = 0;
-		}
-	cxslot = -1;
-	chslot = -1;
-	chlgslot = -1;
-	procleng = 0;
-	blklevel = 1;
-	lastargslot = 0;
-
-	for(lp = labeltab ; lp < labtabend ; ++lp)
-		lp->stateno = 0;
-
-	hashclear();
-
-/* Clear the list of newly generated identifiers from the previous
-   function */
-
-	frexchain(&new_vars);
-	frexchain(&used_builtins);
-	frchain(&assigned_fmts);
-	frchain(&allargs);
-	frchain(&earlylabs);
-
-	nintnames = 0;
-	highlabtab = labeltab;
-
-	ctlstack = ctls - 1;
-	for(i = TYADDR; i < TYVOID; i++) {
-		for(cp = templist[i]; cp ; cp = cp->nextp)
-			free( (charptr) (cp->datap) );
-		frchain(templist + i);
-		autonum[i] = 0;
-		}
-	holdtemps = NULL;
-	dorange = 0;
-	nregvar = 0;
-	highregvar = 0;
-	entries = NULL;
-	rpllist = NULL;
-	inioctl = NO;
-	eqvstart += nequiv;
-	nequiv = 0;
-	dcomplex_seen = 0;
-
-	for(i = 0 ; i<NTYPES0 ; ++i)
-		rtvlabel[i] = 0;
-
-	if(undeftype)
-		setimpl(TYUNKNOWN, (ftnint) 0, 'a', 'z');
-	else
-	{
-		setimpl(tyreal, (ftnint) 0, 'a', 'z');
-		setimpl(tyint,  (ftnint) 0, 'i', 'n');
-	}
-	setimpl(-STGBSS, (ftnint) 0, 'a', 'z');	/* set class */
-}
-
-
-
- void
-#ifdef KR_headers
-setimpl(type, length, c1, c2)
-	int type;
-	ftnint length;
-	int c1;
-	int c2;
-#else
-setimpl(int type, ftnint length, int c1, int c2)
-#endif
-{
-	int i;
-	char buff[100];
-
-	if(c1==0 || c2==0)
-		return;
-
-	if(c1 > c2) {
-		sprintf(buff, "characters out of order in implicit:%c-%c", c1, c2);
-		err(buff);
-		}
-	else {
-		c1 = letter(c1);
-		c2 = letter(c2);
-		if(type < 0)
-			for(i = c1 ; i<=c2 ; ++i)
-				implstg[i] = - type;
-		else {
-			type = lengtype(type, length);
-			if(type == TYCHAR) {
-				if (length < 0) {
-					err("length (*) in implicit");
-					length = 1;
-					}
-				}
-			else if (type != TYLONG)
-				length = 0;
-			for(i = c1 ; i<=c2 ; ++i) {
-				impltype[i] = type;
-				implleng[i] = length;
-				}
-			}
-		}
-	}
diff --git a/usr.bin/f2c/intr.c b/usr.bin/f2c/intr.c
deleted file mode 100644
index 3fc177a..0000000
--- a/usr.bin/f2c/intr.c
+++ /dev/null
@@ -1,978 +0,0 @@
-/****************************************************************
-Copyright 1990, 1992, 1994-6, 1998 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "names.h"
-
-union
-	{
-	int ijunk;
-	struct Intrpacked bits;
-	} packed;
-
-struct Intrbits
-	{
-	char intrgroup /* :3 */;
-	char intrstuff /* result type or number of generics */;
-	char intrno /* :7 */;
-	char dblcmplx;
-	char dblintrno;	/* for -r8 */
-	char extflag;	/* for -cd, -i90 */
-	};
-
-/* List of all intrinsic functions.  */
-
-LOCAL struct Intrblock
-	{
-	char intrfname[8];
-	struct Intrbits intrval;
-	} intrtab[ ] =
-{
-"int", 		{ INTRCONV, TYLONG },
-"real", 	{ INTRCONV, TYREAL, 1 },
-		/* 1 ==> real(TYDCOMPLEX) yields TYDREAL */
-"dble", 	{ INTRCONV, TYDREAL },
-"dreal",	{ INTRCONV, TYDREAL, 0, 0, 0, 1 },
-"cmplx", 	{ INTRCONV, TYCOMPLEX },
-"dcmplx", 	{ INTRCONV, TYDCOMPLEX, 0, 1 },
-"ifix", 	{ INTRCONV, TYLONG },
-"idint", 	{ INTRCONV, TYLONG },
-"float", 	{ INTRCONV, TYREAL },
-"dfloat",	{ INTRCONV, TYDREAL },
-"sngl", 	{ INTRCONV, TYREAL },
-"ichar", 	{ INTRCONV, TYLONG },
-"iachar", 	{ INTRCONV, TYLONG },
-"char", 	{ INTRCONV, TYCHAR },
-"achar", 	{ INTRCONV, TYCHAR },
-
-/* any MAX or MIN can be used with any types; the compiler will cast them
-   correctly.  So rules against bad syntax in these expressions are not
-   enforced */
-
-"max", 		{ INTRMAX, TYUNKNOWN },
-"max0", 	{ INTRMAX, TYLONG },
-"amax0", 	{ INTRMAX, TYREAL },
-"max1", 	{ INTRMAX, TYLONG },
-"amax1", 	{ INTRMAX, TYREAL },
-"dmax1", 	{ INTRMAX, TYDREAL },
-
-"and",		{ INTRBOOL, TYUNKNOWN, OPBITAND },
-"or",		{ INTRBOOL, TYUNKNOWN, OPBITOR },
-"xor",		{ INTRBOOL, TYUNKNOWN, OPBITXOR },
-"not",		{ INTRBOOL, TYUNKNOWN, OPBITNOT },
-"lshift",	{ INTRBOOL, TYUNKNOWN, OPLSHIFT },
-"rshift",	{ INTRBOOL, TYUNKNOWN, OPRSHIFT },
-
-"min", 		{ INTRMIN, TYUNKNOWN },
-"min0", 	{ INTRMIN, TYLONG },
-"amin0", 	{ INTRMIN, TYREAL },
-"min1", 	{ INTRMIN, TYLONG },
-"amin1", 	{ INTRMIN, TYREAL },
-"dmin1", 	{ INTRMIN, TYDREAL },
-
-"aint", 	{ INTRGEN, 2, 0 },
-"dint", 	{ INTRSPEC, TYDREAL, 1 },
-
-"anint", 	{ INTRGEN, 2, 2 },
-"dnint", 	{ INTRSPEC, TYDREAL, 3 },
-
-"nint", 	{ INTRGEN, 4, 4 },
-"idnint", 	{ INTRGEN, 2, 6 },
-
-"abs", 		{ INTRGEN, 6, 8 },
-"iabs", 	{ INTRGEN, 2, 9 },
-"dabs", 	{ INTRSPEC, TYDREAL, 11 },
-"cabs", 	{ INTRSPEC, TYREAL, 12, 0, 13 },
-"zabs", 	{ INTRSPEC, TYDREAL, 13, 1 },
-
-"mod", 		{ INTRGEN, 4, 14 },
-"amod", 	{ INTRSPEC, TYREAL, 16, 0, 17 },
-"dmod", 	{ INTRSPEC, TYDREAL, 17 },
-
-"sign", 	{ INTRGEN, 4, 18 },
-"isign", 	{ INTRGEN, 2, 19 },
-"dsign", 	{ INTRSPEC, TYDREAL, 21 },
-
-"dim", 		{ INTRGEN, 4, 22 },
-"idim", 	{ INTRGEN, 2, 23 },
-"ddim", 	{ INTRSPEC, TYDREAL, 25 },
-
-"dprod", 	{ INTRSPEC, TYDREAL, 26 },
-
-"len", 		{ INTRSPEC, TYLONG, 27 },
-"index", 	{ INTRSPEC, TYLONG, 29 },
-
-"imag", 	{ INTRGEN, 2, 31 },
-"aimag", 	{ INTRSPEC, TYREAL, 31, 0, 32 },
-"dimag", 	{ INTRSPEC, TYDREAL, 32 },
-
-"conjg", 	{ INTRGEN, 2, 33 },
-"dconjg", 	{ INTRSPEC, TYDCOMPLEX, 34, 1 },
-
-"sqrt", 	{ INTRGEN, 4, 35 },
-"dsqrt", 	{ INTRSPEC, TYDREAL, 36 },
-"csqrt", 	{ INTRSPEC, TYCOMPLEX, 37, 0, 38 },
-"zsqrt", 	{ INTRSPEC, TYDCOMPLEX, 38, 1 },
-
-"exp", 		{ INTRGEN, 4, 39 },
-"dexp", 	{ INTRSPEC, TYDREAL, 40 },
-"cexp", 	{ INTRSPEC, TYCOMPLEX, 41, 0, 42 },
-"zexp", 	{ INTRSPEC, TYDCOMPLEX, 42, 1 },
-
-"log", 		{ INTRGEN, 4, 43 },
-"alog", 	{ INTRSPEC, TYREAL, 43, 0, 44 },
-"dlog", 	{ INTRSPEC, TYDREAL, 44 },
-"clog", 	{ INTRSPEC, TYCOMPLEX, 45, 0, 46 },
-"zlog", 	{ INTRSPEC, TYDCOMPLEX, 46, 1 },
-
-"log10", 	{ INTRGEN, 2, 47 },
-"alog10", 	{ INTRSPEC, TYREAL, 47, 0, 48 },
-"dlog10", 	{ INTRSPEC, TYDREAL, 48 },
-
-"sin", 		{ INTRGEN, 4, 49 },
-"dsin", 	{ INTRSPEC, TYDREAL, 50 },
-"csin", 	{ INTRSPEC, TYCOMPLEX, 51, 0, 52 },
-"zsin", 	{ INTRSPEC, TYDCOMPLEX, 52, 1 },
-
-"cos", 		{ INTRGEN, 4, 53 },
-"dcos", 	{ INTRSPEC, TYDREAL, 54 },
-"ccos", 	{ INTRSPEC, TYCOMPLEX, 55, 0, 56 },
-"zcos", 	{ INTRSPEC, TYDCOMPLEX, 56, 1 },
-
-"tan", 		{ INTRGEN, 2, 57 },
-"dtan", 	{ INTRSPEC, TYDREAL, 58 },
-
-"asin", 	{ INTRGEN, 2, 59 },
-"dasin", 	{ INTRSPEC, TYDREAL, 60 },
-
-"acos", 	{ INTRGEN, 2, 61 },
-"dacos", 	{ INTRSPEC, TYDREAL, 62 },
-
-"atan", 	{ INTRGEN, 2, 63 },
-"datan", 	{ INTRSPEC, TYDREAL, 64 },
-
-"atan2", 	{ INTRGEN, 2, 65 },
-"datan2", 	{ INTRSPEC, TYDREAL, 66 },
-
-"sinh", 	{ INTRGEN, 2, 67 },
-"dsinh", 	{ INTRSPEC, TYDREAL, 68 },
-
-"cosh", 	{ INTRGEN, 2, 69 },
-"dcosh", 	{ INTRSPEC, TYDREAL, 70 },
-
-"tanh", 	{ INTRGEN, 2, 71 },
-"dtanh", 	{ INTRSPEC, TYDREAL, 72 },
-
-"lge",		{ INTRSPEC, TYLOGICAL, 73},
-"lgt",		{ INTRSPEC, TYLOGICAL, 75},
-"lle",		{ INTRSPEC, TYLOGICAL, 77},
-"llt",		{ INTRSPEC, TYLOGICAL, 79},
-
-#if 0
-"epbase",	{ INTRCNST, 4, 0 },
-"epprec",	{ INTRCNST, 4, 4 },
-"epemin",	{ INTRCNST, 2, 8 },
-"epemax",	{ INTRCNST, 2, 10 },
-"eptiny",	{ INTRCNST, 2, 12 },
-"ephuge",	{ INTRCNST, 4, 14 },
-"epmrsp",	{ INTRCNST, 2, 18 },
-#endif
-
-"fpexpn",	{ INTRGEN, 4, 81 },
-"fpabsp",	{ INTRGEN, 2, 85 },
-"fprrsp",	{ INTRGEN, 2, 87 },
-"fpfrac",	{ INTRGEN, 2, 89 },
-"fpmake",	{ INTRGEN, 2, 91 },
-"fpscal",	{ INTRGEN, 2, 93 },
-
-"cdabs", 	{ INTRSPEC, TYDREAL,	13, 1, 0, 1 },
-"cdsqrt", 	{ INTRSPEC, TYDCOMPLEX, 38, 1, 0, 1 },
-"cdexp", 	{ INTRSPEC, TYDCOMPLEX, 42, 1, 0, 1 },
-"cdlog", 	{ INTRSPEC, TYDCOMPLEX, 46, 1, 0, 1 },
-"cdsin", 	{ INTRSPEC, TYDCOMPLEX, 52, 1, 0, 1 },
-"cdcos", 	{ INTRSPEC, TYDCOMPLEX, 56, 1, 0, 1 },
-
-"iand",		{ INTRBOOL, TYUNKNOWN, OPBITAND, 0, 0, 2 },
-"ior",		{ INTRBOOL, TYUNKNOWN, OPBITOR,  0, 0, 2 },
-"ieor",		{ INTRBOOL, TYUNKNOWN, OPBITXOR, 0, 0, 2 },
-
-"btest",	{ INTRBGEN, TYLOGICAL, OPBITTEST,0, 0, 2 },
-"ibclr",	{ INTRBGEN, TYUNKNOWN, OPBITCLR, 0, 0, 2 },
-"ibset",	{ INTRBGEN, TYUNKNOWN, OPBITSET, 0, 0, 2 },
-"ibits",	{ INTRBGEN, TYUNKNOWN, OPBITBITS,0, 0, 2 },
-"ishft",	{ INTRBGEN, TYUNKNOWN, OPBITSH,  0, 0, 2 },
-"ishftc",	{ INTRBGEN, TYUNKNOWN, OPBITSHC, 0, 0, 2 },
-
-"" };
-
-
-LOCAL struct Specblock
-	{
-	char atype;		/* Argument type; every arg must have
-				   this type */
-	char rtype;		/* Result type */
-	char nargs;		/* Number of arguments */
-	char spxname[8];	/* Name of the function in Fortran */
-	char othername;		/* index into callbyvalue table */
-	} spectab[ ] =
-{
-	{ TYREAL,TYREAL,1,"r_int" },
-	{ TYDREAL,TYDREAL,1,"d_int" },
-
-	{ TYREAL,TYREAL,1,"r_nint" },
-	{ TYDREAL,TYDREAL,1,"d_nint" },
-
-	{ TYREAL,TYSHORT,1,"h_nint" },
-	{ TYREAL,TYLONG,1,"i_nint" },
-
-	{ TYDREAL,TYSHORT,1,"h_dnnt" },
-	{ TYDREAL,TYLONG,1,"i_dnnt" },
-
-	{ TYREAL,TYREAL,1,"r_abs" },
-	{ TYSHORT,TYSHORT,1,"h_abs" },
-	{ TYLONG,TYLONG,1,"i_abs" },
-	{ TYDREAL,TYDREAL,1,"d_abs" },
-	{ TYCOMPLEX,TYREAL,1,"c_abs" },
-	{ TYDCOMPLEX,TYDREAL,1,"z_abs" },
-
-	{ TYSHORT,TYSHORT,2,"h_mod" },
-	{ TYLONG,TYLONG,2,"i_mod" },
-	{ TYREAL,TYREAL,2,"r_mod" },
-	{ TYDREAL,TYDREAL,2,"d_mod" },
-
-	{ TYREAL,TYREAL,2,"r_sign" },
-	{ TYSHORT,TYSHORT,2,"h_sign" },
-	{ TYLONG,TYLONG,2,"i_sign" },
-	{ TYDREAL,TYDREAL,2,"d_sign" },
-
-	{ TYREAL,TYREAL,2,"r_dim" },
-	{ TYSHORT,TYSHORT,2,"h_dim" },
-	{ TYLONG,TYLONG,2,"i_dim" },
-	{ TYDREAL,TYDREAL,2,"d_dim" },
-
-	{ TYREAL,TYDREAL,2,"d_prod" },
-
-	{ TYCHAR,TYSHORT,1,"h_len" },
-	{ TYCHAR,TYLONG,1,"i_len" },
-
-	{ TYCHAR,TYSHORT,2,"h_indx" },
-	{ TYCHAR,TYLONG,2,"i_indx" },
-
-	{ TYCOMPLEX,TYREAL,1,"r_imag" },
-	{ TYDCOMPLEX,TYDREAL,1,"d_imag" },
-	{ TYCOMPLEX,TYCOMPLEX,1,"r_cnjg" },
-	{ TYDCOMPLEX,TYDCOMPLEX,1,"d_cnjg" },
-
-	{ TYREAL,TYREAL,1,"r_sqrt", 1 },
-	{ TYDREAL,TYDREAL,1,"d_sqrt", 1 },
-	{ TYCOMPLEX,TYCOMPLEX,1,"c_sqrt" },
-	{ TYDCOMPLEX,TYDCOMPLEX,1,"z_sqrt" },
-
-	{ TYREAL,TYREAL,1,"r_exp", 2 },
-	{ TYDREAL,TYDREAL,1,"d_exp", 2 },
-	{ TYCOMPLEX,TYCOMPLEX,1,"c_exp" },
-	{ TYDCOMPLEX,TYDCOMPLEX,1,"z_exp" },
-
-	{ TYREAL,TYREAL,1,"r_log", 3 },
-	{ TYDREAL,TYDREAL,1,"d_log", 3 },
-	{ TYCOMPLEX,TYCOMPLEX,1,"c_log" },
-	{ TYDCOMPLEX,TYDCOMPLEX,1,"z_log" },
-
-	{ TYREAL,TYREAL,1,"r_lg10" },
-	{ TYDREAL,TYDREAL,1,"d_lg10" },
-
-	{ TYREAL,TYREAL,1,"r_sin", 4 },
-	{ TYDREAL,TYDREAL,1,"d_sin", 4 },
-	{ TYCOMPLEX,TYCOMPLEX,1,"c_sin" },
-	{ TYDCOMPLEX,TYDCOMPLEX,1,"z_sin" },
-
-	{ TYREAL,TYREAL,1,"r_cos", 5 },
-	{ TYDREAL,TYDREAL,1,"d_cos", 5 },
-	{ TYCOMPLEX,TYCOMPLEX,1,"c_cos" },
-	{ TYDCOMPLEX,TYDCOMPLEX,1,"z_cos" },
-
-	{ TYREAL,TYREAL,1,"r_tan", 6 },
-	{ TYDREAL,TYDREAL,1,"d_tan", 6 },
-
-	{ TYREAL,TYREAL,1,"r_asin", 7 },
-	{ TYDREAL,TYDREAL,1,"d_asin", 7 },
-
-	{ TYREAL,TYREAL,1,"r_acos", 8 },
-	{ TYDREAL,TYDREAL,1,"d_acos", 8 },
-
-	{ TYREAL,TYREAL,1,"r_atan", 9 },
-	{ TYDREAL,TYDREAL,1,"d_atan", 9 },
-
-	{ TYREAL,TYREAL,2,"r_atn2", 10 },
-	{ TYDREAL,TYDREAL,2,"d_atn2", 10 },
-
-	{ TYREAL,TYREAL,1,"r_sinh", 11 },
-	{ TYDREAL,TYDREAL,1,"d_sinh", 11 },
-
-	{ TYREAL,TYREAL,1,"r_cosh", 12 },
-	{ TYDREAL,TYDREAL,1,"d_cosh", 12 },
-
-	{ TYREAL,TYREAL,1,"r_tanh", 13 },
-	{ TYDREAL,TYDREAL,1,"d_tanh", 13 },
-
-	{ TYCHAR,TYLOGICAL,2,"hl_ge" },
-	{ TYCHAR,TYLOGICAL,2,"l_ge" },
-
-	{ TYCHAR,TYLOGICAL,2,"hl_gt" },
-	{ TYCHAR,TYLOGICAL,2,"l_gt" },
-
-	{ TYCHAR,TYLOGICAL,2,"hl_le" },
-	{ TYCHAR,TYLOGICAL,2,"l_le" },
-
-	{ TYCHAR,TYLOGICAL,2,"hl_lt" },
-	{ TYCHAR,TYLOGICAL,2,"l_lt" },
-
-	{ TYREAL,TYSHORT,1,"hr_expn" },
-	{ TYREAL,TYLONG,1,"ir_expn" },
-	{ TYDREAL,TYSHORT,1,"hd_expn" },
-	{ TYDREAL,TYLONG,1,"id_expn" },
-
-	{ TYREAL,TYREAL,1,"r_absp" },
-	{ TYDREAL,TYDREAL,1,"d_absp" },
-
-	{ TYREAL,TYDREAL,1,"r_rrsp" },
-	{ TYDREAL,TYDREAL,1,"d_rrsp" },
-
-	{ TYREAL,TYREAL,1,"r_frac" },
-	{ TYDREAL,TYDREAL,1,"d_frac" },
-
-	{ TYREAL,TYREAL,2,"r_make" },
-	{ TYDREAL,TYDREAL,2,"d_make" },
-
-	{ TYREAL,TYREAL,2,"r_scal" },
-	{ TYDREAL,TYDREAL,2,"d_scal" },
-
-	{ 0 }
-} ;
-
-#if 0
-LOCAL struct Incstblock
-	{
-	char atype;
-	char rtype;
-	char constno;
-	} consttab[ ] =
-{
-	{ TYSHORT, TYLONG, 0 },
-	{ TYLONG, TYLONG, 1 },
-	{ TYREAL, TYLONG, 2 },
-	{ TYDREAL, TYLONG, 3 },
-
-	{ TYSHORT, TYLONG, 4 },
-	{ TYLONG, TYLONG, 5 },
-	{ TYREAL, TYLONG, 6 },
-	{ TYDREAL, TYLONG, 7 },
-
-	{ TYREAL, TYLONG, 8 },
-	{ TYDREAL, TYLONG, 9 },
-
-	{ TYREAL, TYLONG, 10 },
-	{ TYDREAL, TYLONG, 11 },
-
-	{ TYREAL, TYREAL, 0 },
-	{ TYDREAL, TYDREAL, 1 },
-
-	{ TYSHORT, TYLONG, 12 },
-	{ TYLONG, TYLONG, 13 },
-	{ TYREAL, TYREAL, 2 },
-	{ TYDREAL, TYDREAL, 3 },
-
-	{ TYREAL, TYREAL, 4 },
-	{ TYDREAL, TYDREAL, 5 }
-};
-#endif
-
-char *callbyvalue[ ] =
-	{0,
-	"sqrt",
-	"exp",
-	"log",
-	"sin",
-	"cos",
-	"tan",
-	"asin",
-	"acos",
-	"atan",
-	"atan2",
-	"sinh",
-	"cosh",
-	"tanh"
-	};
-
- void
-r8fix(Void)	/* adjust tables for -r8 */
-{
-	register struct Intrblock *I;
-	register struct Specblock *S;
-
-	for(I = intrtab; I->intrfname[0]; I++)
-		if (I->intrval.intrgroup != INTRGEN)
-		    switch(I->intrval.intrstuff) {
-			case TYREAL:
-				I->intrval.intrstuff = TYDREAL;
-				I->intrval.intrno = I->intrval.dblintrno;
-				break;
-			case TYCOMPLEX:
-				I->intrval.intrstuff = TYDCOMPLEX;
-				I->intrval.intrno = I->intrval.dblintrno;
-				I->intrval.dblcmplx = 1;
-			}
-
-	for(S = spectab; S->atype; S++)
-	    switch(S->atype) {
-		case TYCOMPLEX:
-			S->atype = TYDCOMPLEX;
-			if (S->rtype == TYREAL)
-				S->rtype = TYDREAL;
-			else if (S->rtype == TYCOMPLEX)
-				S->rtype = TYDCOMPLEX;
-			switch(S->spxname[0]) {
-				case 'r':
-					S->spxname[0] = 'd';
-					break;
-				case 'c':
-					S->spxname[0] = 'z';
-					break;
-				default:
-					Fatal("r8fix bug");
-				}
-			break;
-		case TYREAL:
-			S->atype = TYDREAL;
-			switch(S->rtype) {
-			    case TYREAL:
-				S->rtype = TYDREAL;
-				if (S->spxname[0] != 'r')
-					Fatal("r8fix bug");
-				S->spxname[0] = 'd';
-			    case TYDREAL:	/* d_prod */
-				break;
-
-			    case TYSHORT:
-				if (!strcmp(S->spxname, "hr_expn"))
-					S->spxname[1] = 'd';
-				else if (!strcmp(S->spxname, "h_nint"))
-					strcpy(S->spxname, "h_dnnt");
-				else Fatal("r8fix bug");
-				break;
-
-			    case TYLONG:
-				if (!strcmp(S->spxname, "ir_expn"))
-					S->spxname[1] = 'd';
-				else if (!strcmp(S->spxname, "i_nint"))
-					strcpy(S->spxname, "i_dnnt");
-				else Fatal("r8fix bug");
-				break;
-
-			    default:
-				Fatal("r8fix bug");
-			    }
-		}
-	}
-
-
- expptr
-#ifdef KR_headers
-intrcall(np, argsp, nargs)
-	Namep np;
-	struct Listblock *argsp;
-	int nargs;
-#else
-intrcall(Namep np, struct Listblock *argsp, int nargs)
-#endif
-{
-	int i, rettype;
-	Addrp ap;
-	register struct Specblock *sp;
-	register struct Chain *cp;
-	expptr q, ep;
-	int mtype;
-	int op;
-	int f1field, f2field, f3field;
-	char *s;
-	static char	bit_bits[] =	"?bit_bits",
-			bit_shift[] =	"?bit_shift",
-			bit_cshift[] = 	"?bit_cshift";
-	static char *bitop[3] = { bit_bits, bit_shift, bit_cshift };
-	static int t_pref[2] = { 'l', 'q' };
-
-	packed.ijunk = np->vardesc.varno;
-	f1field = packed.bits.f1;
-	f2field = packed.bits.f2;
-	f3field = packed.bits.f3;
-	if(nargs == 0)
-		goto badnargs;
-
-	mtype = 0;
-	for(cp = argsp->listp ; cp ; cp = cp->nextp)
-	{
-		ep = (expptr)cp->datap;
-		if( ISCONST(ep) && ep->headblock.vtype==TYSHORT )
-			cp->datap = (char *) mkconv(tyint, ep);
-		mtype = maxtype(mtype, ep->headblock.vtype);
-	}
-
-	switch(f1field)
-	{
-	case INTRBGEN:
-		op = f3field;
-		if( ! ONEOF(mtype, MSKINT) )
-			goto badtype;
-		if (op < OPBITBITS) {
-			if(nargs != 2)
-				goto badnargs;
-			if (op != OPBITTEST) {
-#ifdef TYQUAD
-				if (mtype == TYQUAD)
-					op += 2;
-#endif
-				goto intrbool2;
-				}
-			q = mkexpr(op, (expptr)argsp->listp->datap,
-			    		(expptr)argsp->listp->nextp->datap);
-			q->exprblock.vtype = TYLOGICAL;
-			goto intrbool2a;
-			}
-		if (nargs != 2 && (nargs != 3 || op == OPBITSH))
-			goto badnargs;
-		cp = argsp->listp;
-		ep = (expptr)cp->datap;
-		if (ep->headblock.vtype < TYLONG)
-			cp->datap = (char *)mkconv(TYLONG, ep);
-		while(cp->nextp) {
-			cp = cp->nextp;
-			ep = (expptr)cp->datap;
-			if (ep->headblock.vtype != TYLONG)
-				cp->datap = (char *)mkconv(TYLONG, ep);
-			}
-		if (op == OPBITSH) {
-			ep = (expptr)argsp->listp->nextp->datap;
-			if (ISCONST(ep)) {
-				if ((i = ep->constblock.Const.ci) < 0) {
-					q = (expptr)argsp->listp->datap;
-					if (ISCONST(q)) {
-						ep->constblock.Const.ci = -i;
-						op = OPRSHIFT;
-						goto intrbool2;
-						}
-					}
-				else {
-					op = OPLSHIFT;
-					goto intrbool2;
-					}
-				}
-			}
-		else if (nargs == 2) {
-			if (op == OPBITBITS)
-				goto badnargs;
-			cp->nextp = mkchain((char*)ICON(-1), 0);
-			}
-		ep = (expptr)argsp->listp->datap;
-		i = ep->headblock.vtype;
-		s = bitop[op - OPBITBITS];
-		*s = t_pref[i - TYLONG];
-		ap = builtin(i, s, 1);
-		return fixexpr((Exprp)
-				mkexpr(OPCCALL, (expptr)ap, (expptr)argsp) );
-
-	case INTRBOOL:
-		op = f3field;
-		if( ! ONEOF(mtype, MSKINT|MSKLOGICAL) )
-			goto badtype;
-		if(op == OPBITNOT)
-		{
-			if(nargs != 1)
-				goto badnargs;
-			q = mkexpr(OPBITNOT, (expptr)argsp->listp->datap, ENULL);
-		}
-		else
-		{
-			if(nargs != 2)
-				goto badnargs;
- intrbool2:
-			q = mkexpr(op, (expptr)argsp->listp->datap,
-			    		(expptr)argsp->listp->nextp->datap);
-		}
- intrbool2a:
-		frchain( &(argsp->listp) );
-		free( (charptr) argsp);
-		return(q);
-
-	case INTRCONV:
-		rettype = f2field;
-		switch(rettype) {
-		  case TYLONG:
-			rettype = tyint;
-			break;
-		  case TYLOGICAL:
-			rettype = tylog;
-		  }
-		if( ISCOMPLEX(rettype) && nargs==2)
-		{
-			expptr qr, qi;
-			qr = (expptr) argsp->listp->datap;
-			qi = (expptr) argsp->listp->nextp->datap;
-			if (qr->headblock.vtype == TYDREAL
-			 || qi->headblock.vtype == TYDREAL)
-				rettype = TYDCOMPLEX;
-			if(ISCONST(qr) && ISCONST(qi))
-				q = mkcxcon(qr,qi);
-			else	q = mkexpr(OPCONV,mkconv(rettype-2,qr),
-			    mkconv(rettype-2,qi));
-		}
-		else if(nargs == 1) {
-			if (f3field && ((Exprp)argsp->listp->datap)->vtype
-					== TYDCOMPLEX)
-				rettype = TYDREAL;
-			q = mkconv(rettype+100, (expptr)argsp->listp->datap);
-			if (q->tag == TADDR)
-				q->addrblock.parenused = 1;
-			}
-		else goto badnargs;
-
-		q->headblock.vtype = rettype;
-		frchain(&(argsp->listp));
-		free( (charptr) argsp);
-		return(q);
-
-
-#if 0
-	case INTRCNST:
-
-/* Machine-dependent f77 stuff that f2c omits:
-
-intcon contains
-	radix for short int
-	radix for long int
-	radix for single precision
-	radix for double precision
-	precision for short int
-	precision for long int
-	precision for single precision
-	precision for double precision
-	emin for single precision
-	emin for double precision
-	emax for single precision
-	emax for double prcision
-	largest short int
-	largest long int
-
-realcon contains
-	tiny for single precision
-	tiny for double precision
-	huge for single precision
-	huge for double precision
-	mrsp (epsilon) for single precision
-	mrsp (epsilon) for double precision
-*/
-	{	register struct Incstblock *cstp;
-		extern ftnint intcon[14];
-		extern double realcon[6];
-
-		cstp = consttab + f3field;
-		for(i=0 ; i<f2field ; ++i)
-			if(cstp->atype == mtype)
-				goto foundconst;
-			else
-				++cstp;
-		goto badtype;
-
-foundconst:
-		switch(cstp->rtype)
-		{
-		case TYLONG:
-			return(mkintcon(intcon[cstp->constno]));
-
-		case TYREAL:
-		case TYDREAL:
-			return(mkrealcon(cstp->rtype,
-			    realcon[cstp->constno]) );
-
-		default:
-			Fatal("impossible intrinsic constant");
-		}
-	}
-#endif
-
-	case INTRGEN:
-		sp = spectab + f3field;
-		if(no66flag)
-			if(sp->atype == mtype)
-				goto specfunct;
-			else err66("generic function");
-
-		for(i=0; i<f2field ; ++i)
-			if(sp->atype == mtype)
-				goto specfunct;
-			else
-				++sp;
-		warn1 ("bad argument type to intrinsic %s", np->fvarname);
-
-/* Made this a warning rather than an error so things like "log (5) ==>
-   log (5.0)" can be accommodated.  When none of these cases matches, the
-   argument is cast up to the first type in the spectab list; this first
-   type is assumed to be the "smallest" type, e.g. REAL before DREAL
-   before COMPLEX, before DCOMPLEX */
-
-		sp = spectab + f3field;
-		mtype = sp -> atype;
-		goto specfunct;
-
-	case INTRSPEC:
-		sp = spectab + f3field;
-specfunct:
-		if(tyint==TYLONG && ONEOF(sp->rtype,M(TYSHORT)|M(TYLOGICAL))
-		    && (sp+1)->atype==sp->atype)
-			++sp;
-
-		if(nargs != sp->nargs)
-			goto badnargs;
-		if(mtype != sp->atype)
-			goto badtype;
-
-/* NOTE!!  I moved fixargs (YES) into the ELSE branch so that constants in
-   the inline expression wouldn't get put into the constant table */
-
-		fixargs (NO, argsp);
-		cast_args (mtype, argsp -> listp);
-
-		if(q = Inline((int)(sp-spectab), mtype, argsp->listp))
-		{
-			frchain( &(argsp->listp) );
-			free( (charptr) argsp);
-		} else {
-
-		    if(sp->othername) {
-			/* C library routines that return double... */
-			/* sp->rtype might be TYREAL */
-			ap = builtin(sp->rtype,
-				callbyvalue[sp->othername], 1);
-			q = fixexpr((Exprp)
-				mkexpr(OPCCALL, (expptr)ap, (expptr)argsp) );
-		    } else {
-			fixargs(YES, argsp);
-			ap = builtin(sp->rtype, sp->spxname, 0);
-			q = fixexpr((Exprp)
-				mkexpr(OPCALL, (expptr)ap, (expptr)argsp) );
-		    } /* else */
-		} /* else */
-		return(q);
-
-	case INTRMIN:
-	case INTRMAX:
-		if(nargs < 2)
-			goto badnargs;
-		if( ! ONEOF(mtype, MSKINT|MSKREAL) )
-			goto badtype;
-		argsp->vtype = mtype;
-		q = mkexpr( (f1field==INTRMIN ? OPMIN : OPMAX), (expptr)argsp, ENULL);
-
-		q->headblock.vtype = mtype;
-		rettype = f2field;
-		if(rettype == TYLONG)
-			rettype = tyint;
-		else if(rettype == TYUNKNOWN)
-			rettype = mtype;
-		return( mkconv(rettype, q) );
-
-	default:
-		fatali("intrcall: bad intrgroup %d", f1field);
-	}
-badnargs:
-	errstr("bad number of arguments to intrinsic %s", np->fvarname);
-	goto bad;
-
-badtype:
-	errstr("bad argument type to intrinsic %s", np->fvarname);
-
-bad:
-	return( errnode() );
-}
-
-
-
- int
-#ifdef KR_headers
-intrfunct(s)
-	char *s;
-#else
-intrfunct(char *s)
-#endif
-{
-	register struct Intrblock *p;
-	int i;
-	extern int intr_omit;
-
-	for(p = intrtab; p->intrval.intrgroup!=INTREND ; ++p)
-	{
-		if( !strcmp(s, p->intrfname) )
-		{
-			if (i = p->intrval.extflag) {
-				if (i & intr_omit)
-					return 0;
-				if (noextflag)
-					errext(s);
-				}
-			packed.bits.f1 = p->intrval.intrgroup;
-			packed.bits.f2 = p->intrval.intrstuff;
-			packed.bits.f3 = p->intrval.intrno;
-			packed.bits.f4 = p->intrval.dblcmplx;
-			return(packed.ijunk);
-		}
-	}
-
-	return(0);
-}
-
-
-
-
-
- Addrp
-#ifdef KR_headers
-intraddr(np)
-	Namep np;
-#else
-intraddr(Namep np)
-#endif
-{
-	Addrp q;
-	register struct Specblock *sp;
-	int f3field;
-
-	if(np->vclass!=CLPROC || np->vprocclass!=PINTRINSIC)
-		fatalstr("intraddr: %s is not intrinsic", np->fvarname);
-	packed.ijunk = np->vardesc.varno;
-	f3field = packed.bits.f3;
-
-	switch(packed.bits.f1)
-	{
-	case INTRGEN:
-		/* imag, log, and log10 arent specific functions */
-		if(f3field==31 || f3field==43 || f3field==47)
-			goto bad;
-
-	case INTRSPEC:
-		sp = spectab + f3field;
-		if (tyint == TYLONG
-		&& (sp->rtype == TYSHORT || sp->rtype == TYLOGICAL))
-			++sp;
-		q = builtin(sp->rtype, sp->spxname,
-			sp->othername ? 1 : 0);
-		return(q);
-
-	case INTRCONV:
-	case INTRMIN:
-	case INTRMAX:
-	case INTRBOOL:
-	case INTRCNST:
-	case INTRBGEN:
-bad:
-		errstr("cannot pass %s as actual", np->fvarname);
-		return((Addrp)errnode());
-	}
-	fatali("intraddr: impossible f1=%d\n", (int) packed.bits.f1);
-	/* NOT REACHED */ return 0;
-}
-
-
-
- void
-#ifdef KR_headers
-cast_args(maxtype, args)
-	int maxtype;
-	chainp args;
-#else
-cast_args(int maxtype, chainp args)
-#endif
-{
-    for (; args; args = args -> nextp) {
-	expptr e = (expptr) args->datap;
-	if (e -> headblock.vtype != maxtype)
-	    if (e -> tag == TCONST)
-		args->datap = (char *) mkconv(maxtype, e);
-	    else {
-		Addrp temp = mktmp(maxtype, ENULL);
-
-		puteq(cpexpr((expptr)temp), e);
-		args->datap = (char *)temp;
-	    } /* else */
-    } /* for */
-} /* cast_args */
-
-
-
- expptr
-#ifdef KR_headers
-Inline(fno, type, args)
-	int fno;
-	int type;
-	struct Chain *args;
-#else
-Inline(int fno, int type, struct Chain *args)
-#endif
-{
-	register expptr q, t, t1;
-
-	switch(fno)
-	{
-	case 8:	/* real abs */
-	case 9:	/* short int abs */
-	case 10:	/* long int abs */
-	case 11:	/* double precision abs */
-		if( addressable(q = (expptr) args->datap) )
-		{
-			t = q;
-			q = NULL;
-		}
-		else
-			t = (expptr) mktmp(type,ENULL);
-		t1 = mkexpr(type == TYREAL && forcedouble ? OPDABS : OPABS,
-			cpexpr(t), ENULL);
-		if(q)
-			t1 = mkexpr(OPCOMMA, mkexpr(OPASSIGN, cpexpr(t),q), t1);
-		frexpr(t);
-		return(t1);
-
-	case 26:	/* dprod */
-		q = mkexpr(OPSTAR, mkconv(TYDREAL,(expptr)args->datap),
-			(expptr)args->nextp->datap);
-		return(q);
-
-	case 27:	/* len of character string */
-		q = (expptr) cpexpr(((tagptr)args->datap)->headblock.vleng);
-		frexpr((expptr)args->datap);
-		return mkconv(tyioint, q);
-
-	case 14:	/* half-integer mod */
-	case 15:	/* mod */
-		return mkexpr(OPMOD, (expptr) args->datap,
-		    		(expptr) args->nextp->datap);
-	}
-	return(NULL);
-}
diff --git a/usr.bin/f2c/io.c b/usr.bin/f2c/io.c
deleted file mode 100644
index 12ecedd..0000000
--- a/usr.bin/f2c/io.c
+++ /dev/null
@@ -1,1508 +0,0 @@
-/****************************************************************
-Copyright 1990, 1991, 1993, 1994, 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-/* Routines to generate code for I/O statements.
-   Some corrections and improvements due to David Wasley, U. C. Berkeley
-*/
-
-/* TEMPORARY */
-#define TYIOINT TYLONG
-#define SZIOINT SZLONG
-
-#include "defs.h"
-#include "names.h"
-#include "iob.h"
-
-extern int byterev, inqmask;
-
-static void dofclose Argdcl((void));
-static void dofinquire Argdcl((void));
-static void dofmove Argdcl((char*));
-static void dofopen Argdcl((void));
-static void doiolist Argdcl((chainp));
-static void ioset Argdcl((int, int, expptr));
-static void ioseta Argdcl((int, Addrp));
-static void iosetc Argdcl((int, expptr));
-static void iosetip Argdcl((int, int));
-static void iosetlc Argdcl((int, int, int));
-static void putio Argdcl((expptr, expptr));
-static void putiocall Argdcl((expptr));
-
-iob_data *iob_list;
-Addrp io_structs[9];
-
-LOCAL char ioroutine[12];
-
-LOCAL long ioendlab;
-LOCAL long ioerrlab;
-LOCAL int endbit;
-LOCAL int errbit;
-LOCAL long jumplab;
-LOCAL long skiplab;
-LOCAL int ioformatted;
-LOCAL int statstruct = NO;
-LOCAL struct Labelblock *skiplabel;
-Addrp ioblkp;
-
-#define UNFORMATTED 0
-#define FORMATTED 1
-#define LISTDIRECTED 2
-#define NAMEDIRECTED 3
-
-#define V(z)	ioc[z].iocval
-
-#define IOALL 07777
-
-LOCAL struct Ioclist
-{
-	char *iocname;
-	int iotype;
-	expptr iocval;
-}
-ioc[ ] =
-{
-	{ "", 0 },
-	{ "unit", IOALL },
-	{ "fmt", M(IOREAD) | M(IOWRITE) },
-	{ "err", IOALL },
-	{ "end", M(IOREAD) },
-	{ "iostat", IOALL },
-	{ "rec", M(IOREAD) | M(IOWRITE) },
-	{ "recl", M(IOOPEN) | M(IOINQUIRE) },
-	{ "file", M(IOOPEN) | M(IOINQUIRE) },
-	{ "status", M(IOOPEN) | M(IOCLOSE) },
-	{ "access", M(IOOPEN) | M(IOINQUIRE) },
-	{ "form", M(IOOPEN) | M(IOINQUIRE) },
-	{ "blank", M(IOOPEN) | M(IOINQUIRE) },
-	{ "exist", M(IOINQUIRE) },
-	{ "opened", M(IOINQUIRE) },
-	{ "number", M(IOINQUIRE) },
-	{ "named", M(IOINQUIRE) },
-	{ "name", M(IOINQUIRE) },
-	{ "sequential", M(IOINQUIRE) },
-	{ "direct", M(IOINQUIRE) },
-	{ "formatted", M(IOINQUIRE) },
-	{ "unformatted", M(IOINQUIRE) },
-	{ "nextrec", M(IOINQUIRE) },
-	{ "nml", M(IOREAD) | M(IOWRITE) }
-};
-
-#define NIOS (sizeof(ioc)/sizeof(struct Ioclist) - 1)
-
-/* #define IOSUNIT 1 */
-/* #define IOSFMT 2 */
-#define IOSERR 3
-#define IOSEND 4
-#define IOSIOSTAT 5
-#define IOSREC 6
-#define IOSRECL 7
-#define IOSFILE 8
-#define IOSSTATUS 9
-#define IOSACCESS 10
-#define IOSFORM 11
-#define IOSBLANK 12
-#define IOSEXISTS 13
-#define IOSOPENED 14
-#define IOSNUMBER 15
-#define IOSNAMED 16
-#define IOSNAME 17
-#define IOSSEQUENTIAL 18
-#define IOSDIRECT 19
-#define IOSFORMATTED 20
-#define IOSUNFORMATTED 21
-#define IOSNEXTREC 22
-#define IOSNML 23
-
-#define IOSTP V(IOSIOSTAT)
-
-
-/* offsets in generated structures */
-
-#define SZFLAG SZIOINT
-
-/* offsets for external READ and WRITE statements */
-
-#define XERR 0
-#define XUNIT	SZFLAG
-#define XEND	SZFLAG + SZIOINT
-#define XFMT	2*SZFLAG + SZIOINT
-#define XREC	2*SZFLAG + SZIOINT + SZADDR
-
-/* offsets for internal READ and WRITE statements */
-
-#define XIUNIT	SZFLAG
-#define XIEND	SZFLAG + SZADDR
-#define XIFMT	2*SZFLAG + SZADDR
-#define XIRLEN	2*SZFLAG + 2*SZADDR
-#define XIRNUM	2*SZFLAG + 2*SZADDR + SZIOINT
-#define XIREC	2*SZFLAG + 2*SZADDR + 2*SZIOINT
-
-/* offsets for OPEN statements */
-
-#define XFNAME	SZFLAG + SZIOINT
-#define XFNAMELEN	SZFLAG + SZIOINT + SZADDR
-#define XSTATUS	SZFLAG + 2*SZIOINT + SZADDR
-#define XACCESS	SZFLAG + 2*SZIOINT + 2*SZADDR
-#define XFORMATTED	SZFLAG + 2*SZIOINT + 3*SZADDR
-#define XRECLEN	SZFLAG + 2*SZIOINT + 4*SZADDR
-#define XBLANK	SZFLAG + 3*SZIOINT + 4*SZADDR
-
-/* offset for CLOSE statement */
-
-#define XCLSTATUS	SZFLAG + SZIOINT
-
-/* offsets for INQUIRE statement */
-
-#define XFILE	SZFLAG + SZIOINT
-#define XFILELEN	SZFLAG + SZIOINT + SZADDR
-#define XEXISTS	SZFLAG + 2*SZIOINT + SZADDR
-#define XOPEN	SZFLAG + 2*SZIOINT + 2*SZADDR
-#define XNUMBER	SZFLAG + 2*SZIOINT + 3*SZADDR
-#define XNAMED	SZFLAG + 2*SZIOINT + 4*SZADDR
-#define XNAME	SZFLAG + 2*SZIOINT + 5*SZADDR
-#define XNAMELEN	SZFLAG + 2*SZIOINT + 6*SZADDR
-#define XQACCESS	SZFLAG + 3*SZIOINT + 6*SZADDR
-#define XQACCLEN	SZFLAG + 3*SZIOINT + 7*SZADDR
-#define XSEQ	SZFLAG + 4*SZIOINT + 7*SZADDR
-#define XSEQLEN	SZFLAG + 4*SZIOINT + 8*SZADDR
-#define XDIRECT	SZFLAG + 5*SZIOINT + 8*SZADDR
-#define XDIRLEN	SZFLAG + 5*SZIOINT + 9*SZADDR
-#define XFORM	SZFLAG + 6*SZIOINT + 9*SZADDR
-#define XFORMLEN	SZFLAG + 6*SZIOINT + 10*SZADDR
-#define XFMTED	SZFLAG + 7*SZIOINT + 10*SZADDR
-#define XFMTEDLEN	SZFLAG + 7*SZIOINT + 11*SZADDR
-#define XUNFMT	SZFLAG + 8*SZIOINT + 11*SZADDR
-#define XUNFMTLEN	SZFLAG + 8*SZIOINT + 12*SZADDR
-#define XQRECL	SZFLAG + 9*SZIOINT + 12*SZADDR
-#define XNEXTREC	SZFLAG + 9*SZIOINT + 13*SZADDR
-#define XQBLANK	SZFLAG + 9*SZIOINT + 14*SZADDR
-#define XQBLANKLEN	SZFLAG + 9*SZIOINT + 15*SZADDR
-
-LOCAL char *cilist_names[] = {
-	"cilist",
-	"cierr",
-	"ciunit",
-	"ciend",
-	"cifmt",
-	"cirec"
-	};
-LOCAL char *icilist_names[] = {
-	"icilist",
-	"icierr",
-	"iciunit",
-	"iciend",
-	"icifmt",
-	"icirlen",
-	"icirnum"
-	};
-LOCAL char *olist_names[] = {
-	"olist",
-	"oerr",
-	"ounit",
-	"ofnm",
-	"ofnmlen",
-	"osta",
-	"oacc",
-	"ofm",
-	"orl",
-	"oblnk"
-	};
-LOCAL char *cllist_names[] = {
-	"cllist",
-	"cerr",
-	"cunit",
-	"csta"
-	};
-LOCAL char *alist_names[] = {
-	"alist",
-	"aerr",
-	"aunit"
-	};
-LOCAL char *inlist_names[] = {
-	"inlist",
-	"inerr",
-	"inunit",
-	"infile",
-	"infilen",
-	"inex",
-	"inopen",
-	"innum",
-	"innamed",
-	"inname",
-	"innamlen",
-	"inacc",
-	"inacclen",
-	"inseq",
-	"inseqlen",
-	"indir",
-	"indirlen",
-	"infmt",
-	"infmtlen",
-	"inform",
-	"informlen",
-	"inunf",
-	"inunflen",
-	"inrecl",
-	"innrec",
-	"inblank",
-	"inblanklen"
-	};
-
-LOCAL char **io_fields;
-
-#define zork(n,t) n, sizeof(n)/sizeof(char *) - 1, t
-
-LOCAL io_setup io_stuff[] = {
-	zork(cilist_names, TYCILIST),	/* external read/write */
-	zork(inlist_names, TYINLIST),	/* inquire */
-	zork(olist_names,  TYOLIST),	/* open */
-	zork(cllist_names, TYCLLIST),	/* close */
-	zork(alist_names,  TYALIST),	/* rewind */
-	zork(alist_names,  TYALIST),	/* backspace */
-	zork(alist_names,  TYALIST),	/* endfile */
-	zork(icilist_names,TYICILIST),	/* internal read */
-	zork(icilist_names,TYICILIST)	/* internal write */
-	};
-
-#undef zork
-
- int
-#ifdef KR_headers
-fmtstmt(lp)
-	register struct Labelblock *lp;
-#else
-fmtstmt(register struct Labelblock *lp)
-#endif
-{
-	if(lp == NULL)
-	{
-		execerr("unlabeled format statement" , CNULL);
-		return(-1);
-	}
-	if(lp->labtype == LABUNKNOWN)
-	{
-		lp->labtype = LABFORMAT;
-		lp->labelno = (int)newlabel();
-	}
-	else if(lp->labtype != LABFORMAT)
-	{
-		execerr("bad format number", CNULL);
-		return(-1);
-	}
-	return(lp->labelno);
-}
-
-
- void
-#ifdef KR_headers
-setfmt(lp)
-	struct Labelblock *lp;
-#else
-setfmt(struct Labelblock *lp)
-#endif
-{
-	int n, parity;
-	char *s0;
-	register char *s, *se, *t;
-	register k;
-
-	s0 = s = lexline(&n);
-	se = t = s + n;
-
-	/* warn of trivial errors, e.g. "  11 CONTINUE" (one too few spaces) */
-	/* following FORMAT... */
-
-	if (n <= 0)
-		warn("No (...) after FORMAT");
-	else if (*s != '(')
-		warni("%c rather than ( after FORMAT", *s);
-	else if (se[-1] != ')') {
-		*se = 0;
-		while(--t > s && *t != ')') ;
-		if (t <= s)
-			warn("No ) at end of FORMAT statement");
-		else if (se - t > 30)
-			warn1("Extraneous text at end of FORMAT: ...%s", se-12);
-		else
-			warn1("Extraneous text at end of FORMAT: %s", t+1);
-		t = se;
-		}
-
-	/* fix MYQUOTES (\002's) and \\'s */
-
-	parity = 1;
-	while(s < se)
-		switch(*s++) {
-			case 2:
-				if ((parity ^= 1) && *s == 2) {
-					t -= 2;
-					++s;
-					}
-				else
-					t += 3;
-				break;
-			case '"':
-			case '\\':
-				t++; break;
-			}
-	s = s0;
-	parity = 1;
-	if (lp) {
-		lp->fmtstring = t = mem((int)(t - s + 1), 0);
-		while(s < se)
-			switch(k = *s++) {
-				case 2:
-					if ((parity ^= 1) && *s == 2)
-						s++;
-					else {
-						t[0] = '\\';
-						t[1] = '0';
-						t[2] = '0';
-						t[3] = '2';
-						t += 4;
-						}
-					break;
-				case '"':
-				case '\\':
-					*t++ = '\\';
-					/* no break */
-				default:
-					*t++ = k;
-				}
-		*t = 0;
-		}
-	flline();
-}
-
-
- void
-#ifdef KR_headers
-startioctl()
-#else
-startioctl()
-#endif
-{
-	register int i;
-
-	inioctl = YES;
-	nioctl = 0;
-	ioformatted = UNFORMATTED;
-	for(i = 1 ; i<=NIOS ; ++i)
-		V(i) = NULL;
-}
-
- static long
-newiolabel(Void) {
-	long rv;
-	rv = ++lastiolabno;
-	skiplabel = mklabel(rv);
-	skiplabel->labdefined = 1;
-	return rv;
-	}
-
- void
-endioctl(Void)
-{
-	int i;
-	expptr p;
-	struct io_setup *ios;
-
-	inioctl = NO;
-
-	/* set up for error recovery */
-
-	ioerrlab = ioendlab = skiplab = jumplab = 0;
-
-	if(p = V(IOSEND))
-		if(ISICON(p))
-			execlab(ioendlab = p->constblock.Const.ci);
-		else
-			err("bad end= clause");
-
-	if(p = V(IOSERR))
-		if(ISICON(p))
-			execlab(ioerrlab = p->constblock.Const.ci);
-		else
-			err("bad err= clause");
-
-	if(IOSTP)
-		if(IOSTP->tag!=TADDR || ! ISINT(IOSTP->addrblock.vtype) )
-		{
-			err("iostat must be an integer variable");
-			frexpr(IOSTP);
-			IOSTP = NULL;
-		}
-
-	if(iostmt == IOREAD)
-	{
-		if(IOSTP)
-		{
-			if(ioerrlab && ioendlab && ioerrlab==ioendlab)
-				jumplab = ioerrlab;
-			else
-				skiplab = jumplab = newiolabel();
-		}
-		else	{
-			if(ioerrlab && ioendlab && ioerrlab!=ioendlab)
-			{
-				IOSTP = (expptr) mktmp(TYINT, ENULL);
-				skiplab = jumplab = newiolabel();
-			}
-			else
-				jumplab = (ioerrlab ? ioerrlab : ioendlab);
-		}
-	}
-	else if(iostmt == IOWRITE)
-	{
-		if(IOSTP && !ioerrlab)
-			skiplab = jumplab = newiolabel();
-		else
-			jumplab = ioerrlab;
-	}
-	else
-		jumplab = ioerrlab;
-
-	endbit = IOSTP!=NULL || ioendlab!=0;	/* for use in startrw() */
-	errbit = IOSTP!=NULL || ioerrlab!=0;
-	if (jumplab && !IOSTP)
-		IOSTP = (expptr) mktmp(TYINT, ENULL);
-
-	if(iostmt!=IOREAD && iostmt!=IOWRITE)
-	{
-		ios = io_stuff + iostmt;
-		io_fields = ios->fields;
-		ioblkp = io_structs[iostmt];
-		if(ioblkp == NULL)
-			io_structs[iostmt] = ioblkp =
-				autovar(1, ios->type, ENULL, "");
-		ioset(TYIOINT, XERR, ICON(errbit));
-	}
-
-	switch(iostmt)
-	{
-	case IOOPEN:
-		dofopen();
-		break;
-
-	case IOCLOSE:
-		dofclose();
-		break;
-
-	case IOINQUIRE:
-		dofinquire();
-		break;
-
-	case IOBACKSPACE:
-		dofmove("f_back");
-		break;
-
-	case IOREWIND:
-		dofmove("f_rew");
-		break;
-
-	case IOENDFILE:
-		dofmove("f_end");
-		break;
-
-	case IOREAD:
-	case IOWRITE:
-		startrw();
-		break;
-
-	default:
-		fatali("impossible iostmt %d", iostmt);
-	}
-	for(i = 1 ; i<=NIOS ; ++i)
-		if(i!=IOSIOSTAT && V(i)!=NULL)
-			frexpr(V(i));
-}
-
-
- int
-iocname(Void)
-{
-	register int i;
-	int found, mask;
-
-	found = 0;
-	mask = M(iostmt);
-	for(i = 1 ; i <= NIOS ; ++i)
-		if(!strcmp(ioc[i].iocname, token))
-			if(ioc[i].iotype & mask)
-				return(i);
-			else {
-				found = i;
-				break;
-				}
-	if(found) {
-		if (iostmt == IOOPEN && !strcmp(ioc[i].iocname, "name")) {
-			NOEXT("open with \"name=\" treated as \"file=\"");
-			for(i = 1; strcmp(ioc[i].iocname, "file"); i++);
-			return i;
-			}
-		errstr("invalid control %s for statement", ioc[found].iocname);
-		}
-	else
-		errstr("unknown iocontrol %s", token);
-	return(IOSBAD);
-}
-
-
- void
-#ifdef KR_headers
-ioclause(n, p)
-	register int n;
-	register expptr p;
-#else
-ioclause(register int n, register expptr p)
-#endif
-{
-	struct Ioclist *iocp;
-
-	++nioctl;
-	if(n == IOSBAD)
-		return;
-	if(n == IOSPOSITIONAL)
-		{
-		n = nioctl;
-		if (n == IOSFMT) {
-			if (iostmt == IOOPEN) {
-				n = IOSFILE;
-				NOEXT("file= specifier omitted from open");
-				}
-			else if (iostmt < IOREAD)
-				goto illegal;
-			}
-		else if(n > IOSFMT)
-			{
- illegal:
-			err("illegal positional iocontrol");
-			return;
-			}
-		}
-	else if (n == IOSNML)
-		n = IOSFMT;
-
-	if(p == NULL)
-	{
-		if(n == IOSUNIT)
-			p = (expptr) (iostmt==IOREAD ? IOSTDIN : IOSTDOUT);
-		else if(n != IOSFMT)
-		{
-			err("illegal * iocontrol");
-			return;
-		}
-	}
-	if(n == IOSFMT)
-		ioformatted = (p==NULL ? LISTDIRECTED : FORMATTED);
-
-	iocp = & ioc[n];
-	if(iocp->iocval == NULL)
-	{
-		if(n!=IOSFMT && ( n!=IOSUNIT || (p && p->headblock.vtype!=TYCHAR) ) )
-			p = fixtype(p);
-		else if (p && p->tag == TPRIM
-			   && p->primblock.namep->vclass == CLUNKNOWN) {
-			/* kludge made necessary by attempt to infer types
-			 * for untyped external parameters: given an error
-			 * in calling sequences, an integer argument might
-			 * tentatively be assumed TYCHAR; this would otherwise
-			 * be corrected too late in startrw after startrw
-			 * had decided this to be an internal file.
-			 */
-			vardcl(p->primblock.namep);
-			p->primblock.vtype = p->primblock.namep->vtype;
-			}
-		iocp->iocval = p;
-	}
-	else
-		errstr("iocontrol %s repeated", iocp->iocname);
-}
-
-/* io list item */
-
- void
-#ifdef KR_headers
-doio(list)
-	chainp list;
-#else
-doio(chainp list)
-#endif
-{
-	if(ioformatted == NAMEDIRECTED)
-	{
-		if(list)
-			err("no I/O list allowed in NAMELIST read/write");
-	}
-	else
-	{
-		doiolist(list);
-		ioroutine[0] = 'e';
-		if (skiplab)
-			jumplab = 0;
-		putiocall( call0(TYINT, ioroutine) );
-	}
-}
-
-
-
-
-
- LOCAL void
-#ifdef KR_headers
-doiolist(p0)
-	chainp p0;
-#else
-doiolist(chainp p0)
-#endif
-{
-	chainp p;
-	register tagptr q;
-	register expptr qe;
-	register Namep qn;
-	Addrp tp;
-	int range;
-	extern char *ohalign;
-
-	for (p = p0 ; p ; p = p->nextp)
-	{
-		q = (tagptr)p->datap;
-		if(q->tag == TIMPLDO)
-		{
-			exdo(range = (int)newlabel(), (Namep)0,
-				q->impldoblock.impdospec);
-			doiolist(q->impldoblock.datalist);
-			enddo(range);
-			free( (charptr) q);
-		}
-		else	{
-			if(q->tag==TPRIM && q->primblock.argsp==NULL
-			    && q->primblock.namep->vdim!=NULL)
-			{
-				vardcl(qn = q->primblock.namep);
-				if(qn->vdim->nelt) {
-					putio( fixtype(cpexpr(qn->vdim->nelt)),
-					    (expptr)mkscalar(qn) );
-					qn->vlastdim = 0;
-					}
-				else
-					err("attempt to i/o array of unknown size");
-			}
-			else if(q->tag==TPRIM && q->primblock.argsp==NULL &&
-			    (qe = (expptr) memversion(q->primblock.namep)) )
-				putio(ICON(1),qe);
-			else if (ISCONST(q) && q->constblock.vtype == TYCHAR) {
-				halign = 0;
-				putio(ICON(1), qe = fixtype(cpexpr(q)));
-				halign = ohalign;
-				}
-			else if(((qe = fixtype(cpexpr(q)))->tag==TADDR &&
-			    (qe->addrblock.uname_tag != UNAM_CONST ||
-			    !ISCOMPLEX(qe -> addrblock.vtype))) ||
-			    (qe -> tag == TCONST && !ISCOMPLEX(qe ->
-			    headblock.vtype))) {
-				if (qe -> tag == TCONST)
-					qe = (expptr) putconst((Constp)qe);
-				putio(ICON(1), qe);
-			}
-			else if(qe->headblock.vtype != TYERROR)
-			{
-				if(iostmt == IOWRITE)
-				{
-					expptr qvl;
-					qvl = NULL;
-					if( ISCHAR(qe) )
-					{
-						qvl = (expptr)
-						    cpexpr(qe->headblock.vleng);
-						tp = mktmp(qe->headblock.vtype,
-						    ICON(lencat(qe)));
-					}
-					else
-						tp = mktmp(qe->headblock.vtype,
-						    qe->headblock.vleng);
-					puteq( cpexpr((expptr)tp), qe);
-					if(qvl)	/* put right length on block */
-					{
-						frexpr(tp->vleng);
-						tp->vleng = qvl;
-					}
-					putio(ICON(1), (expptr)tp);
-				}
-				else
-					err("non-left side in READ list");
-			}
-			frexpr(q);
-		}
-	}
-	frchain( &p0 );
-}
-
- int iocalladdr = TYADDR;	/* for fixing TYADDR in saveargtypes */
- int typeconv[TYERROR+1] = {
-#ifdef TYQUAD
-		0, 1, 11, 2, 3, 14, 4, 5, 6, 7, 12, 13, 8, 9, 10, 15
-#else
-		0, 1, 11, 2, 3,     4, 5, 6, 7, 12, 13, 8, 9, 10, 14
-#endif
-		};
-
- LOCAL void
-#ifdef KR_headers
-putio(nelt, addr)
-	expptr nelt;
-	register expptr addr;
-#else
-putio(expptr nelt, register expptr addr)
-#endif
-{
-	int type;
-	register expptr q;
-	register Addrp c = 0;
-
-	type = addr->headblock.vtype;
-	if(ioformatted!=LISTDIRECTED && ISCOMPLEX(type) )
-	{
-		nelt = mkexpr(OPSTAR, ICON(2), nelt);
-		type -= (TYCOMPLEX-TYREAL);
-	}
-
-	/* pass a length with every item.  for noncharacter data, fake one */
-	if(type != TYCHAR)
-	{
-
-		if( ISCONST(addr) )
-			addr = (expptr) putconst((Constp)addr);
-		c = ALLOC(Addrblock);
-		c->tag = TADDR;
-		c->vtype = TYLENG;
-		c->vstg = STGAUTO;
-		c->ntempelt = 1;
-		c->isarray = 1;
-		c->memoffset = ICON(0);
-		c->uname_tag = UNAM_IDENT;
-		c->charleng = 1;
-		sprintf(c->user.ident, "(ftnlen)sizeof(%s)", typename[type]);
-		addr = mkexpr(OPCHARCAST, addr, ENULL);
-		}
-
-	nelt = fixtype( mkconv(tyioint,nelt) );
-	if(ioformatted == LISTDIRECTED) {
-		expptr mc = mkconv(tyioint, ICON(typeconv[type]));
-		q = c	? call4(TYINT, "do_lio", mc, nelt, addr, (expptr)c)
-			: call3(TYINT, "do_lio", mc, nelt, addr);
-		}
-	else {
-		char *s = ioformatted==FORMATTED ? "do_fio"
-			: !byterev ? "do_uio"
-			: ONEOF(type, M(TYCHAR)|M(TYINT1)|M(TYLOGICAL1))
-			? "do_ucio" : "do_unio";
-		q = c	? call3(TYINT, s, nelt, addr, (expptr)c)
-			: call2(TYINT, s, nelt, addr);
-		}
-	iocalladdr = TYCHAR;
-	putiocall(q);
-	iocalladdr = TYADDR;
-}
-
-
-
- void
-endio(Void)
-{
-	if(skiplab)
-	{
-		if (ioformatted != NAMEDIRECTED)
-			p1_label((long)(skiplabel - labeltab));
-		if(ioendlab) {
-			exif( mkexpr(OPLT, cpexpr(IOSTP), ICON(0)));
-			exgoto(execlab(ioendlab));
-			exendif();
-			}
-		if(ioerrlab) {
-			exif( mkexpr(iostmt==IOREAD||iostmt==IOWRITE
-					? OPGT : OPNE,
-				cpexpr(IOSTP), ICON(0)));
-			exgoto(execlab(ioerrlab));
-			exendif();
-			}
-	}
-
-	if(IOSTP)
-		frexpr(IOSTP);
-}
-
-
-
- LOCAL void
-#ifdef KR_headers
-putiocall(q)
-	register expptr q;
-#else
-putiocall(register expptr q)
-#endif
-{
-	int tyintsave;
-
-	tyintsave = tyint;
-	tyint = tyioint;	/* for -I2 and -i2 */
-
-	if(IOSTP)
-	{
-		q->headblock.vtype = TYINT;
-		q = fixexpr((Exprp)mkexpr(OPASSIGN, cpexpr(IOSTP), q));
-	}
-	putexpr(q);
-	if(jumplab) {
-		exif(mkexpr(OPNE, cpexpr(IOSTP), ICON(0)));
-		exgoto(execlab(jumplab));
-		exendif();
-		}
-	tyint = tyintsave;
-}
-
- void
-#ifdef KR_headers
-fmtname(np, q)
-	Namep np;
-	register Addrp q;
-#else
-fmtname(Namep np, register Addrp q)
-#endif
-{
-	register int k;
-	register char *s, *t;
-	extern chainp assigned_fmts;
-
-	if (!np->vfmt_asg) {
-		np->vfmt_asg = 1;
-		assigned_fmts = mkchain((char *)np, assigned_fmts);
-		}
-	k = strlen(s = np->fvarname);
-	if (k < IDENT_LEN - 4) {
-		q->uname_tag = UNAM_IDENT;
-		t = q->user.ident;
-		}
-	else {
-		q->uname_tag = UNAM_CHARP;
-		q->user.Charp = t = mem(k + 5,0);
-		}
-	sprintf(t, "%s_fmt", s);
-	}
-
- LOCAL Addrp
-#ifdef KR_headers
-asg_addr(p)
-	union Expression *p;
-#else
-asg_addr(union Expression *p)
-#endif
-{
-	register Addrp q;
-
-	if (p->tag != TPRIM)
-		badtag("asg_addr", p->tag);
-	q = ALLOC(Addrblock);
-	q->tag = TADDR;
-	q->vtype = TYCHAR;
-	q->vstg = STGAUTO;
-	q->ntempelt = 1;
-	q->isarray = 0;
-	q->memoffset = ICON(0);
-	fmtname(p->primblock.namep, q);
-	return q;
-	}
-
- void
-startrw(Void)
-{
-	register expptr p;
-	register Namep np;
-	register Addrp unitp, fmtp, recp;
-	register expptr nump;
-	int iostmt1;
-	flag intfile, sequential, ok, varfmt;
-	struct io_setup *ios;
-
-	/* First look at all the parameters and determine what is to be done */
-
-	ok = YES;
-	statstruct = YES;
-
-	intfile = NO;
-	if(p = V(IOSUNIT))
-	{
-		if( ISINT(p->headblock.vtype) ) {
- int_unit:
-			unitp = (Addrp) cpexpr(p);
-			}
-		else if(p->headblock.vtype == TYCHAR)
-		{
-			if (nioctl == 1 && iostmt == IOREAD) {
-				/* kludge to recognize READ(format expr) */
-				V(IOSFMT) = p;
-				V(IOSUNIT) = p = (expptr) IOSTDIN;
-				ioformatted = FORMATTED;
-				goto int_unit;
-				}
-			intfile = YES;
-			if(p->tag==TPRIM && p->primblock.argsp==NULL &&
-			    (np = p->primblock.namep)->vdim!=NULL)
-			{
-				vardcl(np);
-				if(nump = np->vdim->nelt)
-				{
-					nump = fixtype(cpexpr(nump));
-					if( ! ISCONST(nump) ) {
-						statstruct = NO;
-						np->vlastdim = 0;
-						}
-				}
-				else
-				{
-					err("attempt to use internal unit array of unknown size");
-					ok = NO;
-					nump = ICON(1);
-				}
-				unitp = mkscalar(np);
-			}
-			else	{
-				nump = ICON(1);
-				unitp = (Addrp /*pjw */) fixtype(cpexpr(p));
-			}
-			if(! isstatic((expptr)unitp) )
-				statstruct = NO;
-		}
-		else {
-			err("unit specifier not of type integer or character");
-			ok = NO;
-			}
-	}
-	else
-	{
-		err("bad unit specifier");
-		ok = NO;
-	}
-
-	sequential = YES;
-	if(p = V(IOSREC))
-		if( ISINT(p->headblock.vtype) )
-		{
-			recp = (Addrp) cpexpr(p);
-			sequential = NO;
-		}
-		else	{
-			err("bad REC= clause");
-			ok = NO;
-		}
-	else
-		recp = NULL;
-
-
-	varfmt = YES;
-	fmtp = NULL;
-	if(p = V(IOSFMT))
-	{
-		if(p->tag==TPRIM && p->primblock.argsp==NULL)
-		{
-			np = p->primblock.namep;
-			if(np->vclass == CLNAMELIST)
-			{
-				ioformatted = NAMEDIRECTED;
-				fmtp = (Addrp) fixtype(p);
-				V(IOSFMT) = (expptr)fmtp;
-				if (skiplab)
-					jumplab = 0;
-				goto endfmt;
-			}
-			vardcl(np);
-			if(np->vdim)
-			{
-				if( ! ONEOF(np->vstg, MSKSTATIC) )
-					statstruct = NO;
-				fmtp = mkscalar(np);
-				goto endfmt;
-			}
-			if( ISINT(np->vtype) )	/* ASSIGNed label */
-			{
-				statstruct = NO;
-				varfmt = YES;
-				fmtp = asg_addr(p);
-				goto endfmt;
-			}
-		}
-		p = V(IOSFMT) = fixtype(p);
-		if(p->headblock.vtype == TYCHAR
-			/* Since we allow write(6,n)		*/
-			/* we may as well allow write(6,n(2))	*/
-		|| p->tag == TADDR && ISINT(p->addrblock.vtype))
-		{
-			if( ! isstatic(p) )
-				statstruct = NO;
-			fmtp = (Addrp) cpexpr(p);
-		}
-		else if( ISICON(p) )
-		{
-			struct Labelblock *lp;
-			lp = mklabel(p->constblock.Const.ci);
-			if (fmtstmt(lp) > 0)
-			{
-				fmtp = (Addrp)mkaddcon(lp->stateno);
-				/* lp->stateno for names fmt_nnn */
-				lp->fmtlabused = 1;
-				varfmt = NO;
-			}
-			else
-				ioformatted = UNFORMATTED;
-		}
-		else	{
-			err("bad format descriptor");
-			ioformatted = UNFORMATTED;
-			ok = NO;
-		}
-	}
-	else
-		fmtp = NULL;
-
-endfmt:
-	if(intfile) {
-		if (ioformatted==UNFORMATTED) {
-			err("unformatted internal I/O not allowed");
-			ok = NO;
-			}
-		if (recp) {
-			err("direct internal I/O not allowed");
-			ok = NO;
-			}
-		}
-	if(!sequential && ioformatted==LISTDIRECTED)
-	{
-		err("direct list-directed I/O not allowed");
-		ok = NO;
-	}
-	if(!sequential && ioformatted==NAMEDIRECTED)
-	{
-		err("direct namelist I/O not allowed");
-		ok = NO;
-	}
-
-	if( ! ok ) {
-		statstruct = NO;
-		return;
-		}
-
-	/*
-   Now put out the I/O structure, statically if all the clauses
-   are constants, dynamically otherwise
-*/
-
-	if (intfile) {
-		ios = io_stuff + iostmt;
-		iostmt1 = IOREAD;
-		}
-	else {
-		ios = io_stuff;
-		iostmt1 = 0;
-		}
-	io_fields = ios->fields;
-	if(statstruct)
-	{
-		ioblkp = ALLOC(Addrblock);
-		ioblkp->tag = TADDR;
-		ioblkp->vtype = ios->type;
-		ioblkp->vclass = CLVAR;
-		ioblkp->vstg = STGINIT;
-		ioblkp->memno = ++lastvarno;
-		ioblkp->memoffset = ICON(0);
-		ioblkp -> uname_tag = UNAM_IDENT;
-		new_iob_data(ios,
-			temp_name("io_", lastvarno, ioblkp->user.ident));			}
-	else if(!(ioblkp = io_structs[iostmt1]))
-		io_structs[iostmt1] = ioblkp =
-			autovar(1, ios->type, ENULL, "");
-
-	ioset(TYIOINT, XERR, ICON(errbit));
-	if(iostmt == IOREAD)
-		ioset(TYIOINT, (intfile ? XIEND : XEND), ICON(endbit) );
-
-	if(intfile)
-	{
-		ioset(TYIOINT, XIRNUM, nump);
-		ioset(TYIOINT, XIRLEN, cpexpr(unitp->vleng) );
-		ioseta(XIUNIT, unitp);
-	}
-	else
-		ioset(TYIOINT, XUNIT, (expptr) unitp);
-
-	if(recp)
-		ioset(TYIOINT, /* intfile ? XIREC : */ XREC, (expptr) recp);
-
-	if(varfmt)
-		ioseta( intfile ? XIFMT : XFMT , fmtp);
-	else
-		ioset(TYADDR, intfile ? XIFMT : XFMT, (expptr) fmtp);
-
-	ioroutine[0] = 's';
-	ioroutine[1] = '_';
-	ioroutine[2] = iostmt==IOREAD ? 'r' : 'w';
-	ioroutine[3] = "ds"[sequential];
-	ioroutine[4] = "ufln"[ioformatted];
-	ioroutine[5] = "ei"[intfile];
-	ioroutine[6] = '\0';
-
-	putiocall( call1(TYINT, ioroutine, cpexpr((expptr)ioblkp) ));
-
-	if(statstruct)
-	{
-		frexpr((expptr)ioblkp);
-		statstruct = NO;
-		ioblkp = 0;	/* unnecessary */
-	}
-}
-
-
-
- LOCAL void
-dofopen(Void)
-{
-	register expptr p;
-
-	if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
-		ioset(TYIOINT, XUNIT, cpexpr(p) );
-	else
-		err("bad unit in open");
-	if( (p = V(IOSFILE)) )
-		if(p->headblock.vtype == TYCHAR)
-			ioset(TYIOINT, XFNAMELEN, cpexpr(p->headblock.vleng) );
-		else
-			err("bad file in open");
-
-	iosetc(XFNAME, p);
-
-	if(p = V(IOSRECL))
-		if( ISINT(p->headblock.vtype) )
-			ioset(TYIOINT, XRECLEN, cpexpr(p) );
-		else
-			err("bad recl");
-	else
-		ioset(TYIOINT, XRECLEN, ICON(0) );
-
-	iosetc(XSTATUS, V(IOSSTATUS));
-	iosetc(XACCESS, V(IOSACCESS));
-	iosetc(XFORMATTED, V(IOSFORM));
-	iosetc(XBLANK, V(IOSBLANK));
-
-	putiocall( call1(TYINT, "f_open", cpexpr((expptr)ioblkp) ));
-}
-
-
- LOCAL void
-dofclose(Void)
-{
-	register expptr p;
-
-	if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
-	{
-		ioset(TYIOINT, XUNIT, cpexpr(p) );
-		iosetc(XCLSTATUS, V(IOSSTATUS));
-		putiocall( call1(TYINT, "f_clos", cpexpr((expptr)ioblkp)) );
-	}
-	else
-		err("bad unit in close statement");
-}
-
-
- LOCAL void
-dofinquire(Void)
-{
-	register expptr p;
-	if(p = V(IOSUNIT))
-	{
-		if( V(IOSFILE) )
-			err("inquire by unit or by file, not both");
-		ioset(TYIOINT, XUNIT, cpexpr(p) );
-	}
-	else if( ! V(IOSFILE) )
-		err("must inquire by unit or by file");
-	iosetlc(IOSFILE, XFILE, XFILELEN);
-	iosetip(IOSEXISTS, XEXISTS);
-	iosetip(IOSOPENED, XOPEN);
-	iosetip(IOSNUMBER, XNUMBER);
-	iosetip(IOSNAMED, XNAMED);
-	iosetlc(IOSNAME, XNAME, XNAMELEN);
-	iosetlc(IOSACCESS, XQACCESS, XQACCLEN);
-	iosetlc(IOSSEQUENTIAL, XSEQ, XSEQLEN);
-	iosetlc(IOSDIRECT, XDIRECT, XDIRLEN);
-	iosetlc(IOSFORM, XFORM, XFORMLEN);
-	iosetlc(IOSFORMATTED, XFMTED, XFMTEDLEN);
-	iosetlc(IOSUNFORMATTED, XUNFMT, XUNFMTLEN);
-	iosetip(IOSRECL, XQRECL);
-	iosetip(IOSNEXTREC, XNEXTREC);
-	iosetlc(IOSBLANK, XQBLANK, XQBLANKLEN);
-
-	putiocall( call1(TYINT,  "f_inqu", cpexpr((expptr)ioblkp) ));
-}
-
-
-
- LOCAL void
-#ifdef KR_headers
-dofmove(subname)
-	char *subname;
-#else
-dofmove(char *subname)
-#endif
-{
-	register expptr p;
-
-	if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
-	{
-		ioset(TYIOINT, XUNIT, cpexpr(p) );
-		putiocall( call1(TYINT, subname, cpexpr((expptr)ioblkp) ));
-	}
-	else
-		err("bad unit in I/O motion statement");
-}
-
-static int ioset_assign = OPASSIGN;
-
- LOCAL void
-#ifdef KR_headers
-ioset(type, offset, p)
-	int type;
-	int offset;
-	register expptr p;
-#else
-ioset(int type, int offset, register expptr p)
-#endif
-{
-	offset /= SZLONG;
-	if(statstruct && ISCONST(p)) {
-		register char *s;
-		switch(type) {
-			case TYADDR:	/* stmt label */
-				s = "fmt_";
-				break;
-			case TYIOINT:
-				s = "";
-				break;
-			default:
-				badtype("ioset", type);
-			}
-		iob_list->fields[offset] =
-			string_num(s, p->constblock.Const.ci);
-		frexpr(p);
-		}
-	else {
-		register Addrp q;
-
-		q = ALLOC(Addrblock);
-		q->tag = TADDR;
-		q->vtype = type;
-		q->vstg = STGAUTO;
-		q->ntempelt = 1;
-		q->isarray = 0;
-		q->memoffset = ICON(0);
-		q->uname_tag = UNAM_IDENT;
-		sprintf(q->user.ident, "%s.%s",
-			statstruct ? iob_list->name : ioblkp->user.ident,
-			io_fields[offset + 1]);
-		if (type == TYADDR && p->tag == TCONST
-				   && p->constblock.vtype == TYADDR) {
-			/* kludge */
-			register Addrp p1;
-			p1 = ALLOC(Addrblock);
-			p1->tag = TADDR;
-			p1->vtype = type;
-			p1->vstg = STGAUTO;	/* wrong, but who cares? */
-			p1->ntempelt = 1;
-			p1->isarray = 0;
-			p1->memoffset = ICON(0);
-			p1->uname_tag = UNAM_IDENT;
-			sprintf(p1->user.ident, "fmt_%ld",
-				p->constblock.Const.ci);
-			frexpr(p);
-			p = (expptr)p1;
-			}
-		if (type == TYADDR && p->headblock.vtype == TYCHAR)
-			q->vtype = TYCHAR;
-		putexpr(mkexpr(ioset_assign, (expptr)q, p));
-		}
-}
-
-
-
-
- LOCAL void
-#ifdef KR_headers
-iosetc(offset, p)
-	int offset;
-	register expptr p;
-#else
-iosetc(int offset, register expptr p)
-#endif
-{
-	if(p == NULL)
-		ioset(TYADDR, offset, ICON(0) );
-	else if(p->headblock.vtype == TYCHAR) {
-		p = putx(fixtype((expptr)putchop(cpexpr(p))));
-		ioset(TYADDR, offset, addrof(p));
-		}
-	else
-		err("non-character control clause");
-}
-
-
-
- LOCAL void
-#ifdef KR_headers
-ioseta(offset, p)
-	int offset;
-	register Addrp p;
-#else
-ioseta(int offset, register Addrp p)
-#endif
-{
-	char *s, *s1;
-	static char who[] = "ioseta";
-	expptr e, mo;
-	Namep np;
-	ftnint ci;
-	int k;
-	char buf[24], buf1[24];
-	Extsym *comm;
-	extern int usedefsforcommon;
-
-	if(statstruct)
-	{
-		if (!p)
-			return;
-		if (p->tag != TADDR)
-			badtag(who, p->tag);
-		offset /= SZLONG;
-		switch(p->uname_tag) {
-		    case UNAM_NAME:
-			mo = p->memoffset;
-			if (mo->tag != TCONST)
-				badtag("ioseta/memoffset", mo->tag);
-			np = p->user.name;
-			np->visused = 1;
-			ci = mo->constblock.Const.ci - np->voffset;
-			if (np->vstg == STGCOMMON
-			&& !np->vcommequiv
-			&& !usedefsforcommon) {
-				comm = &extsymtab[np->vardesc.varno];
-				sprintf(buf, "%d.", comm->curno);
-				k = strlen(buf) + strlen(comm->cextname)
-					+ strlen(np->cvarname);
-				if (ci) {
-					sprintf(buf1, "+%ld", ci);
-					k += strlen(buf1);
-					}
-				else
-					buf1[0] = 0;
-				s = mem(k + 1, 0);
-				sprintf(s, "%s%s%s%s", comm->cextname, buf,
-					np->cvarname, buf1);
-				}
-			else if (ci) {
-				sprintf(buf,"%ld", ci);
-				s1 = p->user.name->cvarname;
-				k = strlen(buf) + strlen(s1);
-				sprintf(s = mem(k+2,0), "%s+%s", s1, buf);
-				}
-			else
-				s = cpstring(np->cvarname);
-			break;
-		    case UNAM_CONST:
-			s = tostring(p->user.Const.ccp1.ccp0,
-				(int)p->vleng->constblock.Const.ci);
-			break;
-		    default:
-			badthing("uname_tag", who, p->uname_tag);
-		    }
-		/* kludge for Hollerith */
-		if (p->vtype != TYCHAR) {
-			s1 = mem(strlen(s)+10,0);
-			sprintf(s1, "(char *)%s%s", p->isarray ? "" : "&", s);
-			s = s1;
-			}
-		iob_list->fields[offset] = s;
-	}
-	else {
-		if (!p)
-			e = ICON(0);
-		else if (p->vtype != TYCHAR) {
-			NOEXT("non-character variable as format or internal unit");
-			e = mkexpr(OPCHARCAST, (expptr)p, ENULL);
-			}
-		else
-			e = addrof((expptr)p);
-		ioset(TYADDR, offset, e);
-		}
-}
-
-
-
-
- LOCAL void
-#ifdef KR_headers
-iosetip(i, offset)
-	int i;
-	int offset;
-#else
-iosetip(int i, int offset)
-#endif
-{
-	register expptr p;
-
-	if(p = V(i))
-		if(p->tag==TADDR &&
-		    ONEOF(p->addrblock.vtype, inqmask) ) {
-			ioset_assign = OPASSIGNI;
-			ioset(TYADDR, offset, addrof(cpexpr(p)) );
-			ioset_assign = OPASSIGN;
-			}
-		else
-			errstr("impossible inquire parameter %s", ioc[i].iocname);
-	else
-		ioset(TYADDR, offset, ICON(0) );
-}
-
-
-
- LOCAL void
-#ifdef KR_headers
-iosetlc(i, offp, offl)
-	int i;
-	int offp;
-	int offl;
-#else
-iosetlc(int i, int offp, int offl)
-#endif
-{
-	register expptr p;
-	if( (p = V(i)) && p->headblock.vtype==TYCHAR)
-		ioset(TYIOINT, offl, cpexpr(p->headblock.vleng) );
-	iosetc(offp, p);
-}
diff --git a/usr.bin/f2c/iob.h b/usr.bin/f2c/iob.h
deleted file mode 100644
index 065d813..0000000
--- a/usr.bin/f2c/iob.h
+++ /dev/null
@@ -1,26 +0,0 @@
-struct iob_data {
-	struct iob_data *next;
-	char *type;
-	char *name;
-	char *fields[1];
-	};
-struct io_setup {
-	char **fields;
-	int nelt, type;
-	};
-
-struct defines {
-	struct defines *next;
-	char defname[1];
-	};
-
-typedef struct iob_data iob_data;
-typedef struct io_setup io_setup;
-typedef struct defines defines;
-
-extern iob_data *iob_list;
-extern struct Addrblock *io_structs[9];
-void	def_start Argdcl((FILEP, char*, char*, char*));
-void	new_iob_data Argdcl((io_setup*, char*));
-void	other_undefs Argdcl((FILEP));
-char*	tostring Argdcl((char*, int));
diff --git a/usr.bin/f2c/lex.c b/usr.bin/f2c/lex.c
deleted file mode 100644
index 900128e..0000000
--- a/usr.bin/f2c/lex.c
+++ /dev/null
@@ -1,1710 +0,0 @@
-/****************************************************************
-Copyright 1990, 1992 - 1997 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "tokdefs.h"
-#include "p1defs.h"
-
-#ifdef NO_EOF_CHAR_CHECK
-#undef EOF_CHAR
-#else
-#ifndef EOF_CHAR
-#define EOF_CHAR 26	/* ASCII control-Z */
-#endif
-#endif
-
-#define BLANK	' '
-#define MYQUOTE (2)
-#define SEOF 0
-
-/* card types */
-
-#define STEOF 1
-#define STINITIAL 2
-#define STCONTINUE 3
-
-/* lex states */
-
-#define NEWSTMT	1
-#define FIRSTTOKEN	2
-#define OTHERTOKEN	3
-#define RETEOS	4
-
-
-LOCAL int stkey;	/* Type of the current statement (DO, END, IF, etc) */
-static int needwkey;
-ftnint yystno;
-flag intonly;
-extern int new_dcl;
-LOCAL long int stno;
-LOCAL long int nxtstno;	/* Statement label */
-LOCAL int parlev;	/* Parentheses level */
-LOCAL int parseen;
-LOCAL int expcom;
-LOCAL int expeql;
-LOCAL char *nextch;
-LOCAL char *lastch;
-LOCAL char *nextcd 	= NULL;
-LOCAL char *endcd;
-LOCAL long prevlin;
-LOCAL long thislin;
-LOCAL int code;		/* Card type; INITIAL, CONTINUE or EOF */
-LOCAL int lexstate	= NEWSTMT;
-LOCAL char *sbuf;	/* Main buffer for Fortran source input. */
-LOCAL char *send;	/* Was = sbuf+20*66 with sbuf[1390]. */
-LOCAL int maxcont;
-LOCAL int nincl	= 0;	/* Current number of include files */
-LOCAL long firstline;
-LOCAL char *laststb, *stb0;
-extern int addftnsrc;
-static char **linestart;
-LOCAL int ncont;
-LOCAL char comstart[Table_size];
-#define USC (unsigned char *)
-
-static char anum_buf[Table_size];
-#define isalnum_(x) anum_buf[x]
-#define isalpha_(x) (anum_buf[x] == 1)
-
-#define COMMENT_BUF_STORE 4088
-
-typedef struct comment_buf {
-	struct comment_buf *next;
-	char *last;
-	char buf[COMMENT_BUF_STORE];
-	} comment_buf;
-static comment_buf *cbfirst, *cbcur;
-static char *cbinit, *cbnext, *cblast;
-static void flush_comments Argdcl((void));
-extern flag use_bs;
-static char *lastfile = "??", *lastfile0 = "?";
-static char fbuf[P1_FILENAME_MAX];
-static long lastline;
-static void putlineno(Void);
-
-
-/* Comment buffering data
-
-	Comments are kept in a list until the statement before them has
-   been parsed.  This list is implemented with the above comment_buf
-   structure and the pointers cbnext and cblast.
-
-	The comments are stored with terminating NULL, and no other
-   intervening space.  The last few bytes of each block are likely to
-   remain unused.
-*/
-
-/* struct Inclfile   holds the state information for each include file */
-struct Inclfile
-{
-	struct Inclfile *inclnext;
-	FILEP inclfp;
-	char *inclname;
-	int incllno;
-	char *incllinp;
-	int incllen;
-	int inclcode;
-	ftnint inclstno;
-};
-
-LOCAL struct Inclfile *inclp	=  NULL;
-struct Keylist {
-	char *keyname;
-	int keyval;
-	char notinf66;
-};
-struct Punctlist {
-	char punchar;
-	int punval;
-};
-struct Fmtlist {
-	char fmtchar;
-	int fmtval;
-};
-struct Dotlist {
-	char *dotname;
-	int dotval;
-	};
-LOCAL struct Keylist *keystart[26], *keyend[26];
-
-/* KEYWORD AND SPECIAL CHARACTER TABLES
-*/
-
-static struct Punctlist puncts[ ] =
-{
-	'(', SLPAR,
-	')', SRPAR,
-	'=', SEQUALS,
-	',', SCOMMA,
-	'+', SPLUS,
-	'-', SMINUS,
-	'*', SSTAR,
-	'/', SSLASH,
-	'$', SCURRENCY,
-	':', SCOLON,
-	'<', SLT,
-	'>', SGT,
-	0, 0 };
-
-LOCAL struct Dotlist  dots[ ] =
-{
-	"and.", SAND,
-	    "or.", SOR,
-	    "not.", SNOT,
-	    "true.", STRUE,
-	    "false.", SFALSE,
-	    "eq.", SEQ,
-	    "ne.", SNE,
-	    "lt.", SLT,
-	    "le.", SLE,
-	    "gt.", SGT,
-	    "ge.", SGE,
-	    "neqv.", SNEQV,
-	    "eqv.", SEQV,
-	    0, 0 };
-
-LOCAL struct Keylist  keys[ ] =
-{
-	{ "assign",  SASSIGN  },
-	{ "automatic",  SAUTOMATIC, YES  },
-	{ "backspace",  SBACKSPACE  },
-	{ "blockdata",  SBLOCK  },
-	{ "byte",	SBYTE	},
-	{ "call",  SCALL  },
-	{ "character",  SCHARACTER, YES  },
-	{ "close",  SCLOSE, YES  },
-	{ "common",  SCOMMON  },
-	{ "complex",  SCOMPLEX  },
-	{ "continue",  SCONTINUE  },
-	{ "data",  SDATA  },
-	{ "dimension",  SDIMENSION  },
-	{ "doubleprecision",  SDOUBLE  },
-	{ "doublecomplex", SDCOMPLEX, YES  },
-	{ "elseif",  SELSEIF, YES  },
-	{ "else",  SELSE, YES  },
-	{ "endfile",  SENDFILE  },
-	{ "endif",  SENDIF, YES  },
-	{ "enddo", SENDDO, YES },
-	{ "end",  SEND  },
-	{ "entry",  SENTRY, YES  },
-	{ "equivalence",  SEQUIV  },
-	{ "external",  SEXTERNAL  },
-	{ "format",  SFORMAT  },
-	{ "function",  SFUNCTION  },
-	{ "goto",  SGOTO  },
-	{ "implicit",  SIMPLICIT, YES  },
-	{ "include",  SINCLUDE, YES  },
-	{ "inquire",  SINQUIRE, YES  },
-	{ "intrinsic",  SINTRINSIC, YES  },
-	{ "integer",  SINTEGER  },
-	{ "logical",  SLOGICAL  },
-	{ "namelist", SNAMELIST, YES },
-	{ "none", SUNDEFINED, YES },
-	{ "open",  SOPEN, YES  },
-	{ "parameter",  SPARAM, YES  },
-	{ "pause",  SPAUSE  },
-	{ "print",  SPRINT  },
-	{ "program",  SPROGRAM, YES  },
-	{ "punch",  SPUNCH, YES  },
-	{ "read",  SREAD  },
-	{ "real",  SREAL  },
-	{ "return",  SRETURN  },
-	{ "rewind",  SREWIND  },
-	{ "save",  SSAVE, YES  },
-	{ "static",  SSTATIC, YES  },
-	{ "stop",  SSTOP  },
-	{ "subroutine",  SSUBROUTINE  },
-	{ "then",  STHEN, YES  },
-	{ "undefined", SUNDEFINED, YES  },
-	{ "while", SWHILE, YES  },
-	{ "write",  SWRITE  },
-	{ 0, 0 }
-};
-
-static void analyz Argdcl((void));
-static void crunch Argdcl((void));
-static int getcd Argdcl((char*, int));
-static int getcds Argdcl((void));
-static int getkwd Argdcl((void));
-static int gettok Argdcl((void));
-static void store_comment Argdcl((char*));
-LOCAL char *stbuf[3];
-
- int
-#ifdef KR_headers
-inilex(name)
-	char *name;
-#else
-inilex(char *name)
-#endif
-{
-	stbuf[0] = Alloc(3*P1_STMTBUFSIZE);
-	stbuf[1] = stbuf[0] + P1_STMTBUFSIZE;
-	stbuf[2] = stbuf[1] + P1_STMTBUFSIZE;
-	nincl = 0;
-	inclp = NULL;
-	doinclude(name);
-	lexstate = NEWSTMT;
-	return(NO);
-}
-
-
-
-/* throw away the rest of the current line */
- void
-flline(Void)
-{
-	lexstate = RETEOS;
-}
-
-
-
- char *
-#ifdef KR_headers
-lexline(n)
-	int *n;
-#else
-lexline(int *n)
-#endif
-{
-	*n = (lastch - nextch) + 1;
-	return(nextch);
-}
-
-
-
-
- void
-#ifdef KR_headers
-doinclude(name)
-	char *name;
-#else
-doinclude(char *name)
-#endif
-{
-	FILEP fp;
-	struct Inclfile *t;
-	char *name0, *lastslash, *s, *s0, *temp;
-	int j, k;
-	chainp I;
-	extern chainp Iargs;
-
-	err_lineno = -1;
-	if(inclp)
-	{
-		inclp->incllno = thislin;
-		inclp->inclcode = code;
-		inclp->inclstno = nxtstno;
-		if(nextcd && (j = endcd - nextcd) > 0)
-			inclp->incllinp = copyn(inclp->incllen = j, nextcd);
-		else
-			inclp->incllinp = 0;
-	}
-	nextcd = NULL;
-
-	if(++nincl >= MAXINCLUDES)
-		Fatal("includes nested too deep");
-	if(name[0] == '\0')
-		fp = stdin;
-	else if(name[0] == '/' || inclp == NULL
-#ifdef MSDOS
-		|| name[0] == '\\'
-		|| name[1] == ':'
-#endif
-		)
-		fp = fopen(name, textread);
-	else {
-		lastslash = NULL;
-		s = s0 = inclp->inclname;
-#ifdef MSDOS
-		if (s[1] == ':')
-			lastslash = s + 1;
-#endif
-		for(; *s ; ++s)
-			if(*s == '/'
-#ifdef MSDOS
-			|| *s == '\\'
-#endif
-			)
-				lastslash = s;
-		name0 = name;
-		if(lastslash) {
-			k = lastslash - s0 + 1;
-			temp = Alloc(k + strlen(name) + 1);
-			strncpy(temp, s0, k);
-			strcpy(temp+k, name);
-			name = temp;
-			}
-		fp = fopen(name, textread);
-		if (!fp && (I = Iargs)) {
-			k = strlen(name0) + 2;
-			for(; I; I = I->nextp) {
-				j = strlen(s = I->datap);
-				name = Alloc(j + k);
-				strcpy(name, s);
-				switch(s[j-1]) {
-					case '/':
-#ifdef MSDOS
-					case ':':
-					case '\\':
-#endif
-						break;
-					default:
-						name[j++] = '/';
-					}
-				strcpy(name+j, name0);
-				if (fp = fopen(name, textread)) {
-					free(name0);
-					goto havefp;
-					}
-				free(name);
-				name = name0;
-				}
-			}
-		}
-	if (fp)
-	{
- havefp:
-		t = inclp;
-		inclp = ALLOC(Inclfile);
-		inclp->inclnext = t;
-		prevlin = thislin = 0;
-		infname = inclp->inclname = name;
-		infile = inclp->inclfp = fp;
-		lastline = 0;
-		putlineno();
-		lastline = 0;
-	}
-	else
-	{
-		fprintf(diagfile, "Cannot open file %s\n", name);
-		done(1);
-	}
-}
-
-
-
-
- LOCAL int
-popinclude(Void)
-{
-	struct Inclfile *t;
-	register char *p;
-	register int k;
-
-	if(infile != stdin)
-		clf(&infile, infname, 1);	/* Close the input file */
-	free(infname);
-
-	--nincl;
-	err_lineno = -1;
-	t = inclp->inclnext;
-	free( (charptr) inclp);
-	inclp = t;
-	if(inclp == NULL) {
-		infname = 0;
-		return(NO);
-		}
-
-	infile = inclp->inclfp;
-	infname = inclp->inclname;
-	lineno = prevlin = thislin = inclp->incllno;
-	code = inclp->inclcode;
-	stno = nxtstno = inclp->inclstno;
-	if(inclp->incllinp)
-	{
-		lastline = 0;
-		putlineno();
-		lastline = lineno;
-		endcd = nextcd = sbuf;
-		k = inclp->incllen;
-		p = inclp->incllinp;
-		while(--k >= 0)
-			*endcd++ = *p++;
-		free( (charptr) (inclp->incllinp) );
-	}
-	else
-		nextcd = NULL;
-	return(YES);
-}
-
-
- void
-#ifdef KR_headers
-p1_line_number(line_number)
-	long line_number;
-#else
-p1_line_number(long line_number)
-#endif
-{
-	if (lastfile != lastfile0) {
-		p1puts(P1_FILENAME, fbuf);
-		lastfile0 = lastfile;
-		}
-	fprintf(pass1_file, "%d: %ld\n", P1_SET_LINE, line_number);
-	}
-
- static void
-putlineno(Void)
-{
-	extern int gflag;
-	register char *s0, *s1;
-
-	if (gflag) {
-		if (lastline)
-			p1_line_number(lastline);
-		lastline = firstline;
-		if (lastfile != infname)
-			if (lastfile = infname) {
-				strncpy(fbuf, lastfile, sizeof(fbuf));
-				fbuf[sizeof(fbuf)-1] = 0;
-				}
-			else
-				fbuf[0] = 0;
-		}
-	if (addftnsrc) {
-		if (laststb && *laststb) {
-			for(s1 = laststb; *s1; s1++) {
-				for(s0 = s1; *s1 != '\n'; s1++)
-					if (*s1 == '*' && s1[1] == '/')
-						*s1 = '+';
-				*s1 = 0;
-				p1puts(P1_FORTRAN, s0);
-				}
-			*laststb = 0;	/* prevent trouble after EOF */
-			}
-		laststb = stb0;
-		}
-	}
-
- int
-yylex(Void)
-{
-	static int  tokno;
-	int retval;
-
-	switch(lexstate)
-	{
-	case NEWSTMT :	/* need a new statement */
-		retval = getcds();
-		putlineno();
-		if(retval == STEOF) {
-			retval = SEOF;
-			break;
-		} /* if getcds() == STEOF */
-		crunch();
-		tokno = 0;
-		lexstate = FIRSTTOKEN;
-		yystno = stno;
-		stno = nxtstno;
-		toklen = 0;
-		retval = SLABEL;
-		break;
-
-first:
-	case FIRSTTOKEN :	/* first step on a statement */
-		analyz();
-		lexstate = OTHERTOKEN;
-		tokno = 1;
-		retval = stkey;
-		break;
-
-	case OTHERTOKEN :	/* return next token */
-		if(nextch > lastch)
-			goto reteos;
-		++tokno;
-		if( (stkey==SLOGIF || stkey==SELSEIF) && parlev==0 && tokno>3)
-			goto first;
-
-		if(stkey==SASSIGN && tokno==3 && nextch<lastch &&
-		    nextch[0]=='t' && nextch[1]=='o')
-		{
-			nextch+=2;
-			retval = STO;
-			break;
-		}
-		if (tokno == 2 && stkey == SDO) {
-			intonly = 1;
-			retval = gettok();
-			intonly = 0;
-			}
-		else
-			retval = gettok();
-		break;
-
-reteos:
-	case RETEOS:
-		lexstate = NEWSTMT;
-		retval = SEOS;
-		break;
-	default:
-		fatali("impossible lexstate %d", lexstate);
-		break;
-	}
-
-	if (retval == SEOF)
-	    flush_comments ();
-
-	return retval;
-}
-
- LOCAL void
-contmax(Void)
-{
-	lineno = thislin;
-	many("continuation lines", 'C', maxcontin);
-	}
-
-/* Get Cards.
-
-   Returns STEOF or STINITIAL, never STCONTINUE.  Any continuation cards get
-merged into one long card (hence the size of the buffer named   sbuf)   */
-
- LOCAL int
-getcds(Void)
-{
-	register char *p, *q;
-
-	flush_comments ();
-top:
-	if(nextcd == NULL)
-	{
-		code = getcd( nextcd = sbuf, 1 );
-		stno = nxtstno;
-		prevlin = thislin;
-	}
-	if(code == STEOF)
-		if( popinclude() )
-			goto top;
-		else
-			return(STEOF);
-
-	if(code == STCONTINUE)
-	{
-		lineno = thislin;
-		nextcd = NULL;
-		goto top;
-	}
-
-/* Get rid of unused space at the head of the buffer */
-
-	if(nextcd > sbuf)
-	{
-		q = nextcd;
-		p = sbuf;
-		while(q < endcd)
-			*p++ = *q++;
-		endcd = p;
-	}
-
-/* Be aware that the input (i.e. the string at the address   nextcd)   is NOT
-   NULL-terminated */
-
-/* This loop merges all continuations into one long statement, AND puts the next
-   card to be read at the end of the buffer (i.e. it stores the look-ahead card
-   when there's room) */
-
-	ncont = 0;
-	for(;;) {
-		nextcd = endcd;
-		if (ncont >= maxcont || nextcd+66 > send)
-			contmax();
-		linestart[ncont++] = nextcd;
-		if ((code = getcd(nextcd,0)) != STCONTINUE)
-			break;
-		if (ncont == 20 && noextflag) {
-			lineno = thislin;
-			errext("more than 19 continuation lines");
-			}
-		}
-	nextch = sbuf;
-	lastch = nextcd - 1;
-
-	lineno = prevlin;
-	prevlin = thislin;
-	return(STINITIAL);
-}
-
- static void
-#ifdef KR_headers
-bang(a, b, c, d, e)
-	char *a;
-	char *b;
-	char *c;
-	register char *d;
-	register char *e;
-#else
-bang(char *a, char *b, char *c, register char *d, register char *e)
-#endif
-		/* save ! comments */
-{
-	char buf[COMMENT_BUFFER_SIZE + 1];
-	register char *p, *pe;
-
-	p = buf;
-	pe = buf + COMMENT_BUFFER_SIZE;
-	*pe = 0;
-	while(a < b)
-		if (!(*p++ = *a++))
-			p[-1] = 0;
-	if (b < c)
-		*p++ = '\t';
-	while(d < e) {
-		if (!(*p++ = *d++))
-			p[-1] = ' ';
-		if (p == pe) {
-			store_comment(buf);
-			p = buf;
-			}
-		}
-	if (p > buf) {
-		while(--p >= buf && *p == ' ');
-		p[1] = 0;
-		store_comment(buf);
-		}
-	}
-
-
-/* getcd - Get next input card
-
-	This function reads the next input card from global file pointer   infile.
-It assumes that   b   points to currently empty storage somewhere in  sbuf  */
-
- LOCAL int
-#ifdef KR_headers
-getcd(b, nocont)
-	register char *b;
-	int nocont;
-#else
-getcd(register char *b, int nocont)
-#endif
-{
-	register int c;
-	register char *p, *bend;
-	int speclin;		/* Special line - true when the line is allowed
-				   to have more than 66 characters (e.g. the
-				   "&" shorthand for continuation, use of a "\t"
-				   to skip part of the label columns) */
-	static char a[6];	/* Statement label buffer */
-	static char *aend	= a+6;
-	static char *stb, *stbend;
-	static int nst;
-	char *atend, *endcd0;
-	extern int warn72;
-	char buf72[24];
-	int amp, i;
-	char storage[COMMENT_BUFFER_SIZE + 1];
-	char *pointer;
-	long L;
-
-top:
-	endcd = b;
-	bend = b+66;
-	amp = speclin = NO;
-	atend = aend;
-
-/* Handle the continuation shorthand of "&" in the first column, which stands
-   for "     x" */
-
-	if( (c = getc(infile)) == '&')
-	{
-		a[0] = c;
-		a[1] = 0;
-		a[5] = 'x';
-		amp = speclin = YES;
-		bend = send;
-		p = aend;
-	}
-
-/* Handle the Comment cards (a 'C', 'c', '*', or '!' in the first column). */
-
-	else if(comstart[c & (Table_size-1)])
-	{
-		if (feof (infile)
-#ifdef EOF_CHAR
-			 || c == EOF_CHAR
-#endif
-					)
-		    return STEOF;
-
-		if (c == '#') {
-			*endcd++ = c;
-			while((c = getc(infile)) != '\n')
-				if (c == EOF)
-					return STEOF;
-				else if (endcd < bend)
-					*endcd++ = c;
-			++thislin;
-			*endcd = 0;
-			if (b[1] == ' ')
-				p = b + 2;
-			else if (!strncmp(b,"#line ",6))
-				p = b + 6;
-			else {
- bad_cpp:
-				errstr("Bad # line: \"%s\"", b);
-				goto top;
-				}
-			if (*p < '1' || *p > '9')
-				goto bad_cpp;
-			L = *p - '0';
-			while((c = *++p) >= '0' && c <= '9')
-				L = 10*L + c - '0';
-			if (c != ' ' || *++p != '"')
-				goto bad_cpp;
-			bend = p;
-			while(*++p != '"')
-				if (!*p)
-					goto bad_cpp;
-			*p = 0;
-			i = p - bend++;
-			thislin = L - 1;
-			if (!infname || strcmp(infname, bend)) {
-				if (infname)
-					free(infname);
-				lastfile = 0;
-				infname = Alloc(i);
-				strcpy(infname, bend);
-				if (inclp)
-					inclp->inclname = infname;
-				}
-			goto top;
-			}
-
-		storage[COMMENT_BUFFER_SIZE] = c = '\0';
-		pointer = storage;
-		while( !feof (infile) && (*pointer++ = c = getc(infile)) != '\n') {
-
-/* Handle obscure end of file conditions on many machines */
-
-			if (feof (infile) && (c == '\377' || c == EOF)) {
-			    pointer--;
-			    break;
-			} /* if (feof (infile)) */
-
-			if (c == '\0')
-				*(pointer - 1) = ' ';
-
-			if (pointer == &storage[COMMENT_BUFFER_SIZE]) {
-				store_comment (storage);
-				pointer = storage;
-			} /* if (pointer == BUFFER_SIZE) */
-		} /* while */
-
-		if (pointer > storage) {
-		    if (c == '\n')
-
-/* Get rid of the newline */
-
-			pointer[-1] = 0;
-		    else
-			*pointer = 0;
-
-		    store_comment (storage);
-		} /* if */
-
-		if (feof (infile))
-		    if (c != '\n')	/* To allow the line index to
-					   increment correctly */
-			return STEOF;
-
-		++thislin;
-		goto top;
-	}
-
-	else if(c != EOF)
-	{
-
-/* Load buffer   a   with the statement label */
-
-		/* a tab in columns 1-6 skips to column 7 */
-		ungetc(c, infile);
-		for(p=a; p<aend && (c=getc(infile)) != '\n' && c!=EOF; )
-			if(c == '\t')
-
-/* The tab character translates into blank characters in the statement label */
-
-			{
-				atend = p;
-				while(p < aend)
-					*p++ = BLANK;
-				speclin = YES;
-				bend = send;
-			}
-			else
-				*p++ = c;
-	}
-
-/* By now we've read either a continuation character or the statement label
-   field */
-
-	if(c == EOF)
-		return(STEOF);
-
-/* The next 'if' block handles lines that have fewer than 7 characters */
-
-	if(c == '\n')
-	{
-		while(p < aend)
-			*p++ = BLANK;
-
-/* Blank out the buffer on lines which are not longer than 66 characters */
-
-		endcd0 = endcd;
-		if( ! speclin )
-			while(endcd < bend)
-				*endcd++ = BLANK;
-	}
-	else	{	/* read body of line */
-		if (warn72 & 2) {
-			speclin = YES;
-			bend = send;
-			}
-		while( endcd<bend && (c=getc(infile)) != '\n' && c!=EOF )
-			*endcd++ = c;
-		if(c == EOF)
-			return(STEOF);
-
-/* Drop any extra characters on the input card; this usually means those after
-   column 72 */
-
-		if(c != '\n')
-		{
-			i = 0;
-			while( (c=getc(infile)) != '\n' && c != EOF)
-				if (i < 23)
-					buf72[i++] = c;
-			if (warn72 && i && !speclin) {
-				buf72[i] = 0;
-				if (i >= 23)
-					strcpy(buf72+20, "...");
-				lineno = thislin + 1;
-				errstr("text after column 72: %s", buf72);
-				}
-			if(c == EOF)
-				return(STEOF);
-		}
-
-		endcd0 = endcd;
-		if( ! speclin )
-			while(endcd < bend)
-				*endcd++ = BLANK;
-	}
-
-/* The flow of control usually gets to this line (unless an earlier RETURN has
-   been taken) */
-
-	++thislin;
-
-	/* Fortran 77 specifies that a 0 in column 6 */
-	/* does not signify continuation */
-
-	if( !isspace(a[5]) && a[5]!='0') {
-		if (!amp)
-			for(p = a; p < aend;)
-				if (*p++ == '!' && p != aend)
-					goto initcheck;
-		if (addftnsrc && stb) {
-			if (stbend > stb + 7) { /* otherwise forget col 1-6 */
-				/* kludge around funny p1gets behavior */
-				*stb++ = '$';
-				if (amp)
-					*stb++ = '&';
-				else
-					for(p = a; p < atend;)
-						*stb++ = *p++;
-				}
-			if (endcd0 - b > stbend - stb) {
-				if (stb > stbend)
-					stb = stbend;
-				endcd0 = b + (stbend - stb);
-				}
-			for(p = b; p < endcd0;)
-				*stb++ = *p++;
-			*stb++ = '\n';
-			*stb = 0;
-			}
-		if (nocont) {
-			lineno = thislin;
-			errstr("illegal continuation card (starts \"%.6s\")",a);
-			}
-		else if (!amp && strncmp(a,"     ",5)) {
-			lineno = thislin;
-			errstr("labeled continuation line (starts \"%.6s\")",a);
-			}
-		return(STCONTINUE);
-		}
-initcheck:
-	for(p=a; p<atend; ++p)
-		if( !isspace(*p) ) {
-			if (*p++ != '!')
-				goto initline;
-			bang(p, atend, aend, b, endcd);
-			goto top;
-			}
-	for(p = b ; p<endcd ; ++p)
-		if( !isspace(*p) ) {
-			if (*p++ != '!')
-				goto initline;
-			bang(a, a, a, p, endcd);
-			goto top;
-			}
-
-/* Skip over blank cards by reading the next one right away */
-
-	goto top;
-
-initline:
-	if (!lastline)
-		lastline = thislin;
-	if (addftnsrc) {
-		nst = (nst+1)%3;
-		if (!laststb && stb0)
-			laststb = stb0;
-		stb0 = stb = stbuf[nst];
-		*stb++ = '$';	/* kludge around funny p1gets behavior */
-		stbend = stb + sizeof(stbuf[0])-2;
-		for(p = a; p < atend;)
-			*stb++ = *p++;
-		if (atend < aend)
-			*stb++ = '\t';
-		for(p = b; p < endcd0;)
-			*stb++ = *p++;
-		*stb++ = '\n';
-		*stb = 0;
-		}
-
-/* Set   nxtstno   equal to the integer value of the statement label */
-
-	nxtstno = 0;
-	bend = a + 5;
-	for(p = a ; p < bend ; ++p)
-		if( !isspace(*p) )
-			if(isdigit(*p))
-				nxtstno = 10*nxtstno + (*p - '0');
-			else if (*p == '!') {
-				if (!addftnsrc)
-					bang(p+1,atend,aend,b,endcd);
-				endcd = b;
-				break;
-				}
-			else	{
-				lineno = thislin;
-				errstr(
-				"nondigit in statement label field \"%.5s\"", a);
-				nxtstno = 0;
-				break;
-			}
-	firstline = thislin;
-	return(STINITIAL);
-}
-
- LOCAL void
-#ifdef KR_headers
-adjtoklen(newlen)
-	int newlen;
-#else
-adjtoklen(int newlen)
-#endif
-{
-	while(maxtoklen < newlen)
-		maxtoklen = 2*maxtoklen + 2;
-	if (token = (char *)realloc(token, maxtoklen))
-		return;
-	fprintf(stderr, "adjtoklen: realloc(%d) failure!\n", maxtoklen);
-	exit(2);
-	}
-
-/* crunch -- deletes all space characters, folds the backslash chars and
-   Hollerith strings, quotes the Fortran strings */
-
- LOCAL void
-crunch(Void)
-{
-	register char *i, *j, *j0, *j1, *prvstr;
-	int k, ten, nh, nh0, quote;
-
-	/* i is the next input character to be looked at
-	   j is the next output character */
-
-	new_dcl = needwkey = parlev = parseen = 0;
-	expcom = 0;	/* exposed ','s */
-	expeql = 0;	/* exposed equal signs */
-	j = sbuf;
-	prvstr = sbuf;
-	k = 0;
-	for(i=sbuf ; i<=lastch ; ++i)
-	{
-		if(isspace(*i) )
-			continue;
-		if (*i == '!') {
-			while(i >= linestart[k])
-				if (++k >= maxcont)
-					contmax();
-			j0 = linestart[k];
-			if (!addftnsrc)
-				bang(sbuf,sbuf,sbuf,i+1,j0);
-			i = j0-1;
-			continue;
-			}
-
-/* Keep everything in a quoted string */
-
-		if(*i=='\'' ||  *i=='"')
-		{
-			int len = 0;
-
-			quote = *i;
-			*j = MYQUOTE; /* special marker */
-			for(;;)
-			{
-				if(++i > lastch)
-				{
-					err("unbalanced quotes; closing quote supplied");
-					if (j >= lastch)
-						j = lastch - 1;
-					break;
-				}
-				if(*i == quote)
-					if(i<lastch && i[1]==quote) ++i;
-					else break;
-				else if(*i=='\\' && i<lastch && use_bs) {
-					++i;
-					*i = escapes[*(unsigned char *)i];
-					}
-				*++j = *i;
-				len++;
-			} /* for (;;) */
-
-			if ((len = j - sbuf) > maxtoklen)
-				adjtoklen(len);
-			j[1] = MYQUOTE;
-			j += 2;
-			prvstr = j;
-		}
-		else if( (*i=='h' || *i=='H')  && j>prvstr)	/* test for Hollerith strings */
-		{
-			j0 = j - 1;
-			if( ! isdigit(*j0)) goto copychar;
-			nh = *j0 - '0';
-			ten = 10;
-			j1 = prvstr;
-			if (j1 > sbuf && j1[-1] == MYQUOTE)
-				--j1;
-			if (j1+4 < j)
-				j1 = j-4;
-			for(;;) {
-				if (j0-- <= j1)
-					goto copychar;
-				if( ! isdigit(*j0 ) ) break;
-				nh += ten * (*j0-'0');
-				ten*=10;
-				}
-/* A Hollerith string must be preceded by a punctuation mark.
-   '*' is possible only as repetition factor in a data statement
-   not, in particular, in character*2h .
-   To avoid some confusion with missing commas in FORMAT statements,
-   treat a preceding string as a punctuation mark.
- */
-
-			if( !(*j0=='*'&&sbuf[0]=='d') && *j0!='/'
-			&& *j0!='(' && *j0!=',' && *j0!='=' && *j0!='.'
-			&& *j0 != MYQUOTE)
-				goto copychar;
-			nh0 = nh;
-			if(i+nh > lastch)
-			{
-				erri("%dH too big", nh);
-				nh = lastch - i;
-				nh0 = -1;
-			}
-			if (nh > maxtoklen)
-				adjtoklen(nh);
-			j0[1] = MYQUOTE; /* special marker */
-			j = j0 + 1;
-			while(nh-- > 0)
-			{
-				if (++i > lastch) {
- hol_overflow:
-					if (nh0 >= 0)
-					  erri("escapes make %dH too big",
-						nh0);
-					break;
-					}
-				if(*i == '\\' && use_bs) {
-					if (++i > lastch)
-						goto hol_overflow;
-					*i = escapes[*(unsigned char *)i];
-					}
-				*++j = *i;
-			}
-			j[1] = MYQUOTE;
-			j+=2;
-			prvstr = j;
-		}
-		else	{
-			if(*i == '(') parseen = ++parlev;
-			else if(*i == ')') --parlev;
-			else if(parlev == 0)
-				if(*i == '=') expeql = 1;
-				else if(*i == ',') expcom = 1;
-copychar:		/*not a string or space -- copy, shifting case if necessary */
-			if(shiftcase && isupper(*i))
-				*j++ = tolower(*i);
-			else	*j++ = *i;
-		}
-	}
-	lastch = j - 1;
-	nextch = sbuf;
-}
-
- LOCAL void
-analyz(Void)
-{
-	register char *i;
-
-	if(parlev != 0)
-	{
-		err("unbalanced parentheses, statement skipped");
-		stkey = SUNKNOWN;
-		lastch = sbuf - 1; /* prevent double error msg */
-		return;
-	}
-	if(nextch+2<=lastch && nextch[0]=='i' && nextch[1]=='f' && nextch[2]=='(')
-	{
-		/* assignment or if statement -- look at character after balancing paren */
-		parlev = 1;
-		for(i=nextch+3 ; i<=lastch; ++i)
-			if(*i == (MYQUOTE))
-			{
-				while(*++i != MYQUOTE)
-					;
-			}
-			else if(*i == '(')
-				++parlev;
-			else if(*i == ')')
-			{
-				if(--parlev == 0)
-					break;
-			}
-		if(i >= lastch)
-			stkey = SLOGIF;
-		else if(i[1] == '=')
-			stkey = SLET;
-		else if( isdigit(i[1]) )
-			stkey = SARITHIF;
-		else	stkey = SLOGIF;
-		if(stkey != SLET)
-			nextch += 2;
-	}
-	else if(expeql) /* may be an assignment */
-	{
-		if(expcom && nextch<lastch &&
-		    nextch[0]=='d' && nextch[1]=='o')
-		{
-			stkey = SDO;
-			nextch += 2;
-		}
-		else	stkey = SLET;
-	}
-	else if (parseen && nextch + 7 < lastch
-			&& nextch[2] != 'u' /* screen out "double..." early */
-			&& nextch[0] == 'd' && nextch[1] == 'o'
-			&& ((nextch[2] >= '0' && nextch[2] <= '9')
-				|| nextch[2] == ','
-				|| nextch[2] == 'w'))
-		{
-		stkey = SDO;
-		nextch += 2;
-		needwkey = 1;
-		}
-	/* otherwise search for keyword */
-	else	{
-		stkey = getkwd();
-		if(stkey==SGOTO && lastch>=nextch)
-			if(nextch[0]=='(')
-				stkey = SCOMPGOTO;
-			else if(isalpha_(* USC nextch))
-				stkey = SASGOTO;
-	}
-	parlev = 0;
-}
-
-
-
- LOCAL int
-getkwd(Void)
-{
-	register char *i, *j;
-	register struct Keylist *pk, *pend;
-	int k;
-
-	if(! isalpha_(* USC nextch) )
-		return(SUNKNOWN);
-	k = letter(nextch[0]);
-	if(pk = keystart[k])
-		for(pend = keyend[k] ; pk<=pend ; ++pk )
-		{
-			i = pk->keyname;
-			j = nextch;
-			while(*++i==*++j && *i!='\0')
-				;
-			if(*i=='\0' && j<=lastch+1)
-			{
-				nextch = j;
-				if(no66flag && pk->notinf66)
-					errstr("Not a Fortran 66 keyword: %s",
-					    pk->keyname);
-				return(pk->keyval);
-			}
-		}
-	return(SUNKNOWN);
-}
-
- void
-initkey(Void)
-{
-	register struct Keylist *p;
-	register int i,j;
-	register char *s;
-
-	for(i = 0 ; i<26 ; ++i)
-		keystart[i] = NULL;
-
-	for(p = keys ; p->keyname ; ++p) {
-		j = letter(p->keyname[0]);
-		if(keystart[j] == NULL)
-			keystart[j] = p;
-		keyend[j] = p;
-		}
-	i = (maxcontin + 2) * 66;
-	sbuf = (char *)ckalloc(i + 70);
-	send = sbuf + i;
-	maxcont = maxcontin + 1;
-	linestart = (char **)ckalloc(maxcont*sizeof(char*));
-	comstart['c'] = comstart['C'] = comstart['*'] = comstart['!'] =
-	comstart['#'] = 1;
-#ifdef EOF_CHAR
-	comstart[EOF_CHAR] = 1;
-#endif
-	s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_";
-	while(i = *s++)
-		anum_buf[i] = 1;
-	s = "0123456789";
-	while(i = *s++)
-		anum_buf[i] = 2;
-	}
-
- LOCAL int
-#ifdef KR_headers
-hexcheck(key)
-	int key;
-#else
-hexcheck(int key)
-#endif
-{
-	register int radix;
-	register char *p;
-	char *kind;
-
-	switch(key) {
-		case 'z':
-		case 'Z':
-		case 'x':
-		case 'X':
-			radix = 16;
-			key = SHEXCON;
-			kind = "hexadecimal";
-			break;
-		case 'o':
-		case 'O':
-			radix = 8;
-			key = SOCTCON;
-			kind = "octal";
-			break;
-		case 'b':
-		case 'B':
-			radix = 2;
-			key = SBITCON;
-			kind = "binary";
-			break;
-		default:
-			err("bad bit identifier");
-			return(SNAME);
-		}
-	for(p = token; *p; p++)
-		if (hextoi(*p) >= radix) {
-			errstr("invalid %s character", kind);
-			break;
-			}
-	return key;
-	}
-
-/* gettok -- moves the right amount of text from   nextch   into the   token
-   buffer.   token   initially contains garbage (leftovers from the prev token) */
-
- LOCAL int
-gettok(Void)
-{
-	int havdot, havexp, havdbl;
-	int radix, val;
-	struct Punctlist *pp;
-	struct Dotlist *pd;
-	register int ch;
-	static char	Exp_mi[] = "X**-Y treated as X**(-Y)",
-			Exp_pl[] = "X**+Y treated as X**(+Y)";
-
-	char *i, *j, *n1, *p;
-
-	ch = * USC nextch;
-	if(ch == (MYQUOTE))
-	{
-		++nextch;
-		p = token;
-		while(*nextch != MYQUOTE)
-			*p++ = *nextch++;
-		toklen = p - token;
-		*p = 0;
-		/* allow octal, binary, hex constants of the form 'abc'x (etc.) */
-		if (++nextch <= lastch && isalpha_(val = * USC nextch)) {
-			++nextch;
-			return hexcheck(val);
-			}
-		return (SHOLLERITH);
-	}
-
-	if(needkwd)
-	{
-		needkwd = 0;
-		return( getkwd() );
-	}
-
-	for(pp=puncts; pp->punchar; ++pp)
-		if(ch == pp->punchar) {
-			val = pp->punval;
-			if (++nextch <= lastch)
-			    switch(ch) {
-				case '/':
-					switch(*nextch) {
-					  case '/':
-						nextch++;
-						val = SCONCAT;
-						break;
-					  case '=':
-						goto sne;
-					  default:
-						if (new_dcl && parlev == 0)
-							val = SSLASHD;
-					  }
-					return val;
-				case '*':
-					if (*nextch == '*') {
-						nextch++;
-						if (noextflag
-						 && nextch <= lastch)
-						 	switch(*nextch) {
-							  case '-':
-								errext(Exp_mi);
-								break;
-							  case '+':
-								errext(Exp_pl);
-								}
-						return SPOWER;
-						}
-					break;
-				case '<':
-					switch(*nextch) {
-					  case '=':
-						nextch++;
-						val = SLE;
-						break;
-					  case '>':
- sne:
-						nextch++;
-						val = SNE;
-					  }
-					goto extchk;
-				case '=':
-					if (*nextch == '=') {
-						nextch++;
-						val = SEQ;
-						goto extchk;
-						}
-					break;
-				case '>':
-					if (*nextch == '=') {
-						nextch++;
-						val = SGE;
-						}
- extchk:
-					NOEXT("Fortran 8x comparison operator");
-					return val;
-				}
-			else if (ch == '/' && new_dcl && parlev == 0)
-				return SSLASHD;
-			switch(val) {
-				case SLPAR:
-					++parlev;
-					break;
-				case SRPAR:
-					--parlev;
-				}
-			return(val);
-			}
-	if(ch == '.')
-		if(nextch >= lastch) goto badchar;
-		else if(isdigit(nextch[1])) goto numconst;
-		else	{
-			for(pd=dots ; (j=pd->dotname) ; ++pd)
-			{
-				for(i=nextch+1 ; i<=lastch ; ++i)
-					if(*i != *j) break;
-					else if(*i != '.') ++j;
-					else	{
-						nextch = i+1;
-						return(pd->dotval);
-					}
-			}
-			goto badchar;
-		}
-	if( isalpha_(ch) )
-	{
-		p = token;
-		*p++ = *nextch++;
-		while(nextch<=lastch)
-			if( isalnum_(* USC nextch) )
-				*p++ = *nextch++;
-			else break;
-		toklen = p - token;
-		*p = 0;
-		if (needwkey) {
-			needwkey = 0;
-			if (toklen == 5
-				&& nextch <= lastch && *nextch == '(' /*)*/
-				&& !strcmp(token,"while"))
-			return(SWHILE);
-			}
-		if(inioctl && nextch<=lastch && *nextch=='=')
-		{
-			++nextch;
-			return(SNAMEEQ);
-		}
-		if(toklen>8 && eqn(8,token,"function")
-		&& isalpha_(* USC (token+8)) &&
-		    nextch<lastch && nextch[0]=='(' &&
-		    (nextch[1]==')' || isalpha_(* USC (nextch+1))) )
-		{
-			nextch -= (toklen - 8);
-			return(SFUNCTION);
-		}
-
-		if(toklen > MAXNAMELEN)
-		{
-			char buff[MAXNAMELEN+50];
-			sprintf(buff, toklen >= MAXNAMELEN+10
-				? "name %.*s... too long, truncated to %.*s"
-				: "name %s too long, truncated to %.*s",
-				MAXNAMELEN+6, token, MAXNAMELEN, token);
-			err(buff);
-			toklen = MAXNAMELEN;
-			token[MAXNAMELEN] = '\0';
-		}
-		if(toklen==1 && *nextch==MYQUOTE) {
-			val = token[0];
-			++nextch;
-			for(p = token ; *nextch!=MYQUOTE ; )
-				*p++ = *nextch++;
-			++nextch;
-			toklen = p - token;
-			*p = 0;
-			return hexcheck(val);
-		}
-		return(SNAME);
-	}
-
-	if (isdigit(ch)) {
-
-		/* Check for NAG's special hex constant */
-
-		if (nextch[1] == '#' && nextch < lastch
-		||  nextch[2] == '#' && isdigit(nextch[1])
-				     && lastch - nextch >= 2) {
-
-		    radix = atoi (nextch);
-		    if (*++nextch != '#')
-			nextch++;
-		    if (radix != 2 && radix != 8 && radix != 16) {
-		        erri("invalid base %d for constant, defaulting to hex",
-				radix);
-			radix = 16;
-		    } /* if */
-		    if (++nextch > lastch)
-			goto badchar;
-		    for (p = token; hextoi(*nextch) < radix;) {
-			*p++ = *nextch++;
-			if (nextch > lastch)
-				break;
-			}
-		    toklen = p - token;
-		    *p = 0;
-		    return (radix == 16) ? SHEXCON : ((radix == 8) ? SOCTCON :
-			    SBITCON);
-		    }
-		}
-	else
-		goto badchar;
-numconst:
-	havdot = NO;
-	havexp = NO;
-	havdbl = NO;
-	for(n1 = nextch ; nextch<=lastch ; ++nextch)
-	{
-		if(*nextch == '.')
-			if(havdot) break;
-			else if(nextch+2<=lastch && isalpha_(* USC (nextch+1))
-			    && isalpha_(* USC (nextch+2)))
-				break;
-			else	havdot = YES;
-		else if( !intonly && (*nextch=='d' || *nextch=='e') )
-		{
-			p = nextch;
-			havexp = YES;
-			if(*nextch == 'd')
-				havdbl = YES;
-			if(nextch<lastch)
-				if(nextch[1]=='+' || nextch[1]=='-')
-					++nextch;
-			if( ! isdigit(*++nextch) )
-			{
-				nextch = p;
-				havdbl = havexp = NO;
-				break;
-			}
-			for(++nextch ;
-			    nextch<=lastch && isdigit(* USC nextch);
-			    ++nextch);
-			break;
-		}
-		else if( ! isdigit(* USC nextch) )
-			break;
-	}
-	p = token;
-	i = n1;
-	while(i < nextch)
-		*p++ = *i++;
-	toklen = p - token;
-	*p = 0;
-	if(havdbl) return(SDCON);
-	if(havdot || havexp) return(SRCON);
-	return(SICON);
-badchar:
-	sbuf[0] = *nextch++;
-	return(SUNKNOWN);
-}
-
-/* Comment buffering code */
-
- static void
-#ifdef KR_headers
-store_comment(str)
-	char *str;
-#else
-store_comment(char *str)
-#endif
-{
-	int len;
-	comment_buf *ncb;
-
-	if (nextcd == sbuf) {
-		flush_comments();
-		p1_comment(str);
-		return;
-		}
-	len = strlen(str) + 1;
-	if (cbnext + len > cblast) {
-		ncb = 0;
-		if (cbcur) {
-			cbcur->last = cbnext;
-			ncb = cbcur->next;
-			}
-		if (!ncb) {
-			ncb = (comment_buf *) Alloc(sizeof(comment_buf));
-			if (cbcur)
-				cbcur->next = ncb;
-			else {
-				cbfirst = ncb;
-				cbinit = ncb->buf;
-				}
-			ncb->next = 0;
-			}
-		cbcur = ncb;
-		cbnext = ncb->buf;
-		cblast = cbnext + COMMENT_BUF_STORE;
-		}
-	strcpy(cbnext, str);
-	cbnext += len;
-	}
-
- static void
-flush_comments(Void)
-{
-	register char *s, *s1;
-	register comment_buf *cb;
-	if (cbnext == cbinit)
-		return;
-	cbcur->last = cbnext;
-	for(cb = cbfirst;; cb = cb->next) {
-		for(s = cb->buf; s < cb->last; s = s1) {
-			/* compute s1 = new s value first, since */
-			/* p1_comment may insert nulls into s */
-			s1 = s + strlen(s) + 1;
-			p1_comment(s);
-			}
-		if (cb == cbcur)
-			break;
-		}
-	cbcur = cbfirst;
-	cbnext = cbinit;
-	cblast = cbnext + COMMENT_BUF_STORE;
-	}
-
- void
-unclassifiable(Void)
-{
-	register char *s, *se;
-
-	s = sbuf;
-	se = lastch;
-	if (se < sbuf)
-		return;
-	lastch = s - 1;
-	if (++se - s > 10)
-		se = s + 10;
-	for(; s < se; s++)
-		if (*s == MYQUOTE) {
-			se = s;
-			break;
-			}
-	*se = 0;
-	errstr("unclassifiable statement (starts \"%s\")", sbuf);
-	}
diff --git a/usr.bin/f2c/machdefs.h b/usr.bin/f2c/machdefs.h
deleted file mode 100644
index 3ab8961..0000000
--- a/usr.bin/f2c/machdefs.h
+++ /dev/null
@@ -1,31 +0,0 @@
-#define TYLENG	TYLONG		/* char string length field */
-
-#define TYINT	TYLONG
-#define SZADDR	4
-#define SZSHORT	2
-#define SZINT	4
-
-#define SZLONG	4
-#define SZLENG	SZLONG
-
-#define SZDREAL 8
-
-/* Alignment restrictions */
-
-#define ALIADDR SZADDR
-#define ALISHORT SZSHORT
-#define ALILONG 4
-#define ALIDOUBLE 8
-#define ALIINT	ALILONG
-#define ALILENG	ALILONG
-
-#define BLANKCOMMON "_BLNK__"		/* Name for the unnamed
-					   common block; this is unique
-					   because of underscores */
-
-#define LABELFMT "%s:\n"
-
-#define MAXREGVAR 4
-#define TYIREG TYLONG
-#define MSKIREG  (M(TYSHORT)|M(TYLONG))	/* allowed types of DO indicies
-					   which can be put in registers */
diff --git a/usr.bin/f2c/main.c b/usr.bin/f2c/main.c
deleted file mode 100644
index 7237905..0000000
--- a/usr.bin/f2c/main.c
+++ /dev/null
@@ -1,710 +0,0 @@
-/****************************************************************
-Copyright 1990 - 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-extern char F2C_version[];
-
-#include "defs.h"
-#include "parse.h"
-
-int complex_seen, dcomplex_seen;
-
-LOCAL int Max_ftn_files;
-
-int badargs;
-char **ftn_files;
-int current_ftn_file = 0;
-
-flag ftn66flag = NO;
-flag nowarnflag = NO;
-flag noextflag = NO;
-flag  no66flag = NO;		/* Must also set noextflag to this
-					   same value */
-flag zflag = YES;		/* recognize double complex intrinsics */
-flag debugflag = NO;
-flag onetripflag = NO;
-flag shiftcase = YES;
-flag undeftype = NO;
-flag checksubs = NO;
-flag r8flag = NO;
-flag use_bs = YES;
-flag keepsubs = NO;
-flag byterev = NO;
-flag echo = NO;
-int intr_omit;
-static int no_cd, no_i90;
-#ifdef TYQUAD
-flag use_tyquad = YES;
-#endif
-int tyreal = TYREAL;
-int tycomplex = TYCOMPLEX;
-
-int maxregvar = MAXREGVAR;	/* if maxregvar > MAXREGVAR, error */
-int maxequiv = MAXEQUIV;
-int maxext = MAXEXT;
-int maxstno = MAXSTNO;
-int maxctl = MAXCTL;
-int maxhash = MAXHASH;
-int maxliterals = MAXLITERALS;
-int maxcontin = MAXCONTIN;
-int maxlablist = MAXLABLIST;
-int extcomm, ext1comm, useauto;
-int can_include = YES;	/* so we can disable includes for netlib */
-
-static char *def_i2 = "";
-
-static int useshortints = NO;	/* YES => tyint = TYSHORT */
-static int uselongints = NO;	/* YES => tyint = TYLONG */
-int addftnsrc = NO;		/* Include ftn source in output */
-int usedefsforcommon = NO;	/* Use #defines for common reference */
-int forcedouble = YES;		/* force real functions to double */
-int dneg = NO;			/* f77 treatment of unary minus */
-int Ansi = NO;
-int def_equivs = YES;
-int tyioint = TYLONG;
-int szleng = SZLENG;
-int inqmask = M(TYLONG)|M(TYLOGICAL);
-int wordalign = NO;
-int forcereal = NO;
-int warn72 = NO;
-static int skipC, skipversion;
-char *file_name, *filename0, *parens;
-int Castargs = 1;
-static int Castargs1;
-static int typedefs = 0;
-int chars_per_wd, gflag, protostatus;
-int infertypes = 1;
-char used_rets[TYSUBR+1];
-extern char *tmpdir;
-static int h0align = 0;
-char *halign, *ohalign;
-int krparens = NO;
-int hsize;	/* for padding under -h */
-int htype;	/* for wr_equiv_init under -h */
-chainp Iargs;
-char *o_coutput = 0;
-
-#define f2c_entry(swit,count,type,store,size) \
-	p_entry ("-", swit, 0, count, type, store, size)
-
-static arg_info table[] = {
-    f2c_entry ("o", P_ONE_ARG, P_STRING, &o_coutput, YES),
-    f2c_entry ("w66", P_NO_ARGS, P_INT, &ftn66flag, YES),
-    f2c_entry ("w", P_NO_ARGS, P_INT, &nowarnflag, YES),
-    f2c_entry ("66", P_NO_ARGS, P_INT, &no66flag, YES),
-    f2c_entry ("1", P_NO_ARGS, P_INT, &onetripflag, YES),
-    f2c_entry ("onetrip", P_NO_ARGS, P_INT, &onetripflag, YES),
-    f2c_entry ("I2", P_NO_ARGS, P_INT, &useshortints, YES),
-    f2c_entry ("I4", P_NO_ARGS, P_INT, &uselongints, YES),
-    f2c_entry ("U", P_NO_ARGS, P_INT, &shiftcase, NO),
-    f2c_entry ("u", P_NO_ARGS, P_INT, &undeftype, YES),
-    f2c_entry ("O", P_ONE_ARG, P_INT, &maxregvar, 0),
-    f2c_entry ("C", P_NO_ARGS, P_INT, &checksubs, YES),
-    f2c_entry ("Nq", P_ONE_ARG, P_INT, &maxequiv, 0),
-    f2c_entry ("Nx", P_ONE_ARG, P_INT, &maxext, 0),
-    f2c_entry ("Ns", P_ONE_ARG, P_INT, &maxstno, 0),
-    f2c_entry ("Nc", P_ONE_ARG, P_INT, &maxctl, 0),
-    f2c_entry ("Nn", P_ONE_ARG, P_INT, &maxhash, 0),
-    f2c_entry ("NL", P_ONE_ARG, P_INT, &maxliterals, 0),
-    f2c_entry ("NC", P_ONE_ARG, P_INT, &maxcontin, 0),
-    f2c_entry ("Nl", P_ONE_ARG, P_INT, &maxlablist, 0),
-    f2c_entry ("c", P_NO_ARGS, P_INT, &addftnsrc, YES),
-    f2c_entry ("p", P_NO_ARGS, P_INT, &usedefsforcommon, YES),
-    f2c_entry ("v", P_NO_ARGS, P_INT, &echo, YES),
-    f2c_entry ("R", P_NO_ARGS, P_INT, &forcedouble, NO),
-    f2c_entry ("!R", P_NO_ARGS, P_INT, &forcedouble, YES),
-    f2c_entry ("A", P_NO_ARGS, P_INT, &Ansi, YES),
-    f2c_entry ("ext", P_NO_ARGS, P_INT, &noextflag, YES),
-    f2c_entry ("z", P_NO_ARGS, P_INT, &zflag, NO),
-    f2c_entry ("a", P_NO_ARGS, P_INT, &useauto, YES),
-    f2c_entry ("r8", P_NO_ARGS, P_INT, &r8flag, YES),
-    f2c_entry ("i2", P_NO_ARGS, P_INT, &tyioint, NO),
-    f2c_entry ("w8", P_NO_ARGS, P_INT, &wordalign, YES),
-    f2c_entry ("!I", P_NO_ARGS, P_INT, &can_include, NO),
-    f2c_entry ("W", P_ONE_ARG, P_INT, &chars_per_wd, 0),
-    f2c_entry ("g", P_NO_ARGS, P_INT, &gflag, YES),
-    f2c_entry ("T", P_ONE_ARG, P_STRING, &tmpdir, 0),
-    f2c_entry ("E", P_NO_ARGS, P_INT, &extcomm, 1),
-    f2c_entry ("e1c", P_NO_ARGS, P_INT, &ext1comm, 1),
-    f2c_entry ("ec", P_NO_ARGS, P_INT, &ext1comm, 2),
-    f2c_entry ("C++", P_NO_ARGS, P_INT, &Ansi, 2),
-    f2c_entry ("P", P_NO_ARGS, P_INT, &Castargs, 3),
-    f2c_entry ("Ps", P_NO_ARGS, P_INT, &protostatus, 1),
-    f2c_entry ("!P", P_NO_ARGS, P_INT, &Castargs, 0),
-    f2c_entry ("!c", P_NO_ARGS, P_INT, &skipC, 1),
-    f2c_entry ("!it", P_NO_ARGS, P_INT, &infertypes, 0),
-    f2c_entry ("h", P_NO_ARGS, P_INT, &h0align, 1),
-    f2c_entry ("hd", P_NO_ARGS, P_INT, &h0align, 2),
-    f2c_entry ("kr", P_NO_ARGS, P_INT, &krparens, 1),
-    f2c_entry ("krd", P_NO_ARGS, P_INT, &krparens, 2),
-    f2c_entry ("!bs", P_NO_ARGS, P_INT, &use_bs, NO),
-    f2c_entry ("r", P_NO_ARGS, P_INT, &forcereal, YES),
-    f2c_entry ("72", P_NO_ARGS, P_INT, &warn72, 1),
-    f2c_entry ("f", P_NO_ARGS, P_INT, &warn72, 2),
-    f2c_entry ("s", P_NO_ARGS, P_INT, &keepsubs, 1),
-    f2c_entry ("d", P_ONE_ARG, P_STRING, &outbuf, 0),
-    f2c_entry ("cd", P_NO_ARGS, P_INT, &no_cd, 1),
-    f2c_entry ("i90", P_NO_ARGS, P_INT, &no_i90, 2),
-#ifdef TYQUAD
-    f2c_entry ("!i8", P_NO_ARGS, P_INT, &use_tyquad, NO),
-#endif
-
-	/* options omitted from man pages */
-
-	/* -b ==> for unformatted I/O, call do_unio (for noncharacter  */
-	/* data of length > 1 byte) and do_ucio (for the rest) rather  */
-	/* than do_uio.  This permits modifying libI77 to byte-reverse */
-	/* numeric data. */
-
-    f2c_entry ("b", P_NO_ARGS, P_INT, &byterev, YES),
-
-	/* -ev ==> implement equivalence with initialized pointers */
-    f2c_entry ("ev", P_NO_ARGS, P_INT, &def_equivs, NO),
-
-	/* -!it used to be the default when -it was more agressive */
-
-    f2c_entry ("it", P_NO_ARGS, P_INT, &infertypes, 1),
-
-	/* -Pd is similar to -P, but omits :ref: lines */
-    f2c_entry ("Pd", P_NO_ARGS, P_INT, &Castargs, 2),
-
-	/* -t ==> emit typedefs (under -A or -C++) for procedure
-		argument types used.  This is meant for netlib's
-		f2c service, so -A and -C++ will work with older
-		versions of f2c.h
-		*/
-    f2c_entry ("t", P_NO_ARGS, P_INT, &typedefs, 1),
-
-	/* -!V ==> omit version msg (to facilitate using diff in
-		regression testing)
-		*/
-    f2c_entry ("!V", P_NO_ARGS, P_INT, &skipversion, 1),
-
-	/* -Dnnn = debug level nnn */
-
-    f2c_entry ("D", P_ONE_ARG, P_INT, &debugflag, YES),
-
-	/* -dneg ==> under (default) -!R, imitate f77's bizarre	*/
-	/* treatment of unary minus of REAL expressions by	*/
-	/* promoting them to DOUBLE PRECISION . */
-
-    f2c_entry ("dneg", P_NO_ARGS, P_INT, &dneg, YES)
-}; /* table */
-
-extern char *c_functions;	/* "c_functions"	*/
-extern char *coutput;		/* "c_output"		*/
-extern char *initfname;		/* "raw_data"		*/
-extern char *blkdfname;		/* "block_data"		*/
-extern char *p1_file;		/* "p1_file"		*/
-extern char *p1_bakfile;	/* "p1_file.BAK"	*/
-extern char *sortfname;		/* "init_file"		*/
-extern char *proto_fname;	/* "proto_file"		*/
-FILE *protofile;
-
- void
-set_externs(Void)
-{
-    static char *hset[3] = { 0, "integer", "doublereal" };
-
-/* Adjust the global flags according to the command line parameters */
-
-    if (chars_per_wd > 0) {
-	typesize[TYADDR] = typesize[TYLONG] = typesize[TYREAL] =
-		typesize[TYLOGICAL] = chars_per_wd;
-	typesize[TYINT1] = typesize[TYLOGICAL1] = 1;
-	typesize[TYDREAL] = typesize[TYCOMPLEX] = chars_per_wd << 1;
-	typesize[TYDCOMPLEX] = chars_per_wd << 2;
-	typesize[TYSHORT] = typesize[TYLOGICAL2] = chars_per_wd >> 1;
-	typesize[TYCILIST] = 5*chars_per_wd;
-	typesize[TYICILIST] = 6*chars_per_wd;
-	typesize[TYOLIST] = 9*chars_per_wd;
-	typesize[TYCLLIST] = 3*chars_per_wd;
-	typesize[TYALIST] = 2*chars_per_wd;
-	typesize[TYINLIST] = 26*chars_per_wd;
-	}
-
-    if (wordalign)
-	typealign[TYDREAL] = typealign[TYDCOMPLEX] = typealign[TYREAL];
-    if (!tyioint) {
-	tyioint = TYSHORT;
-	szleng = typesize[TYSHORT];
-	def_i2 = "#define f2c_i2 1\n";
-	inqmask = M(TYSHORT)|M(TYLOGICAL2);
-	goto checklong;
-	}
-    else
-	szleng = typesize[TYLONG];
-    if (useshortints) {
-	/* inqmask = M(TYLONG); */
-	/* used to disallow LOGICAL in INQUIRE under -I2 */
- checklong:
-	protorettypes[TYLOGICAL] = "shortlogical";
-	casttypes[TYLOGICAL] = "K_fp";
-	if (uselongints)
-		err ("Can't use both long and short ints");
-	else {
-		tyint = tylogical = TYSHORT;
-		tylog = TYLOGICAL2;
-		}
-	}
-    else if (uselongints)
-	tyint = TYLONG;
-
-    if (h0align) {
-	if (tyint == TYLONG && wordalign)
-		h0align = 1;
-    	ohalign = halign = hset[h0align];
-	htype = h0align == 1 ? tyint : TYDREAL;
-	hsize = typesize[htype];
-	}
-
-    if (no66flag)
-	noextflag = no66flag;
-    if (noextflag)
-	zflag = 0;
-
-    if (r8flag) {
-	tyreal = TYDREAL;
-	tycomplex = TYDCOMPLEX;
-	r8fix();
-	}
-    if (forcedouble) {
-	protorettypes[TYREAL] = "E_f";
-	casttypes[TYREAL] = "E_fp";
-	}
-    else
-	dneg = 0;
-
-    if (maxregvar > MAXREGVAR) {
-	warni("-O%d: too many register variables", maxregvar);
-	maxregvar = MAXREGVAR;
-    } /* if maxregvar > MAXREGVAR */
-
-/* Check the list of input files */
-
-    {
-	int bad, i, cur_max = Max_ftn_files;
-
-	for (i = bad = 0; i < cur_max && ftn_files[i]; i++)
-	    if (ftn_files[i][0] == '-') {
-		errstr ("Invalid flag '%s'", ftn_files[i]);
-		bad++;
-		}
-	if (bad)
-		exit(1);
-
-    } /* block */
-} /* set_externs */
-
-
- static int
-comm2dcl(Void)
-{
-	Extsym *ext;
-	if (ext1comm)
-		for(ext = extsymtab; ext < nextext; ext++)
-			if (ext->extstg == STGCOMMON && !ext->extinit)
-				return ext1comm;
-	return 0;
-	}
-
- static void
-#ifdef KR_headers
-write_typedefs(outfile)
-	FILE *outfile;
-#else
-write_typedefs(FILE *outfile)
-#endif
-{
-	register int i;
-	register char *s, *p = 0;
-	static char st[4] = { TYREAL, TYCOMPLEX, TYDCOMPLEX, TYCHAR };
-	static char stl[4] = { 'E', 'C', 'Z', 'H' };
-
-	for(i = 0; i <= TYSUBR; i++)
-		if (s = usedcasts[i]) {
-			if (!p) {
-				p = Ansi == 1 ? "()" : "(...)";
-				nice_printf(outfile,
-				"/* Types for casting procedure arguments: */\
-\n\n#ifndef F2C_proc_par_types\n");
-				if (i == 0) {
-					nice_printf(outfile,
-			"typedef int /* Unknown procedure type */ (*%s)%s;\n",
-						 s, p);
-					continue;
-					}
-				}
-			nice_printf(outfile, "typedef %s (*%s)%s;\n",
-					c_type_decl(i,1), s, p);
-			}
-	for(i = !forcedouble; i < 4; i++)
-		if (used_rets[st[i]])
-			nice_printf(outfile,
-				"typedef %s %c_f; /* %s function */\n",
-				p = i ? "VOID" : "doublereal",
-				stl[i], ftn_types[st[i]]);
-	if (p)
-		nice_printf(outfile, "#endif\n\n");
-	}
-
- static void
-#ifdef KR_headers
-commonprotos(outfile)
-	register FILE *outfile;
-#else
-commonprotos(register FILE *outfile)
-#endif
-{
-	register Extsym *e, *ee;
-	register Argtypes *at;
-	Atype *a, *ae;
-	int k;
-	extern int proc_protochanges;
-
-	if (!outfile)
-		return;
-	for (e = extsymtab, ee = nextext; e < ee; e++)
-		if (e->extstg == STGCOMMON && e->allextp)
-			nice_printf(outfile, "/* comlen %s %ld */\n",
-				e->cextname, e->maxleng);
-	if (Castargs1 < 3)
-		return;
-
-	/* -Pr: special comments conveying current knowledge
-	    of external references */
-
-	k = proc_protochanges;
-	for (e = extsymtab, ee = nextext; e < ee; e++)
-		if (e->extstg == STGEXT
-		&& e->cextname != e->fextname)	/* not a library function */
-		    if (at = e->arginfo) {
-			if ((!e->extinit || at->changes & 1)
-				/* not defined here or
-					changed since definition */
-			&& at->nargs >= 0) {
-				nice_printf(outfile, "/*:ref: %s %d %d",
-					e->cextname, e->extype, at->nargs);
-				a = at->atypes;
-				for(ae = a + at->nargs; a < ae; a++)
-					nice_printf(outfile, " %d", a->type);
-				nice_printf(outfile, " */\n");
-				if (at->changes & 1)
-					k++;
-				}
-			}
-		    else if (e->extype)
-			/* typed external, never invoked */
-			nice_printf(outfile, "/*:ref: %s %d :*/\n",
-				e->cextname, e->extype);
-	if (k) {
-		nice_printf(outfile,
-	"/* Rerunning f2c -P may change prototypes or declarations. */\n");
-		if (nerr)
-			return;
-		if (protostatus)
-			done(4);
-		if (protofile != stdout) {
-			fprintf(diagfile,
-	"Rerunning \"f2c -P ... %s %s\" may change prototypes or declarations.\n",
-				filename0, proto_fname);
-			fflush(diagfile);
-			}
-		}
-	}
-
- static int
-#ifdef KR_headers
-I_args(argc, a)
-	int argc;
-	char **a;
-#else
-I_args(int argc, char **a)
-#endif
-{
-	char **a0, **a1, **ae, *s;
-
-	ae = a + argc;
-	a0 = a;
-	for(a1 = ++a; a < ae; a++) {
-		if (!(s = *a))
-			break;
-		if (*s == '-' && s[1] == 'I' && s[2]
-		  && (s[3] || s[2] != '2' && s[2] != '4'))
-			Iargs = mkchain(s+2, Iargs);
-		else
-			*a1++ = s;
-		}
-	Iargs = revchain(Iargs);
-	*a1 = 0;
-	return a1 - a0;
-	}
-
- int retcode = 0;
-
- int
-#ifdef KR_headers
-main(argc, argv)
-	int argc;
-	char **argv;
-#else
-main(int argc, char **argv)
-#endif
-{
-	int c2d, k;
-	FILE *c_output;
-	char *cdfilename;
-	static char stderrbuf[BUFSIZ];
-	extern char **dfltproc, *dflt1proc[];
-	extern char link_msg[];
-
-	diagfile = stderr;
-	setbuf(stderr, stderrbuf);	/* arrange for fast error msgs */
-
-	argc = I_args(argc, argv);	/* extract -I args */
-	Max_ftn_files = argc - 1;
-	ftn_files = (char **)ckalloc((argc+1)*sizeof(char *));
-
-	parse_args (argc, argv, table, sizeof(table)/sizeof(arg_info),
-		ftn_files, Max_ftn_files);
-	if (badargs)
-		return 1;
-	intr_omit = no_cd | no_i90;
-	if (keepsubs && checksubs) {
-		warn("-C suppresses -s\n");
-		keepsubs = 0;
-		}
-	if (!can_include && ext1comm == 2)
-		ext1comm = 1;
-	if (ext1comm && !extcomm)
-		extcomm = 2;
-	if (protostatus)
-		Castargs = 3;
-	Castargs1 = Castargs;
-	if (!Ansi) {
-		Castargs = 0;
-		parens = "()";
-		}
-	else if (!Castargs)
-		parens = Ansi == 1 ? "()" : "(...)";
-	else
-		dfltproc = dflt1proc;
-
-	outbuf_adjust();
-	set_externs();
-	fileinit();
-	read_Pfiles(ftn_files);
-
-	for(k = 1; ftn_files[k]; k++)
-		if (dofork())
-			break;
-	filename0 = file_name = ftn_files[current_ftn_file = k - 1];
-
-	set_tmp_names();
-	sigcatch(0);
-
-	c_file   = opf(c_functions, textwrite);
-	pass1_file=opf(p1_file, binwrite);
-	initkey();
-	if (file_name && *file_name) {
-		if (debugflag != 1) {
-		        if (!o_coutput)
-			  coutput = c_name(file_name,'c');
-			else
-			  coutput = o_coutput;
-			if (Castargs1 >= 2)
-				proto_fname = c_name(file_name,'P');
-			}
-		cdfilename = coutput;
-		if (skipC)
-			coutput = 0;
-		if (coutput[0] == '-'){
-		        c_output = stdout;
-			coutput = 0;
-		      }
-		else if (!(c_output = fopen(coutput, textwrite))) {
-			file_name = coutput;
-			coutput = 0;	/* don't delete read-only .c file */
-			fatalstr("can't open %.86s", file_name);
-			}
-
-		if (Castargs1 >= 2
-		&& !(protofile = fopen(proto_fname, textwrite)))
-			fatalstr("Can't open %.84s\n", proto_fname);
-		}
-	else {
-		file_name = "";
-		cdfilename = "f2c_out.c";
-		c_output = stdout;
-		coutput = 0;
-		if (Castargs1 >= 2) {
-			protofile = stdout;
-			if (!skipC)
-				printf("#ifdef P_R_O_T_O_T_Y_P_E_S\n");
-			}
-		}
-
-	if(inilex( copys(file_name) ))
-		done(1);
-	if (filename0 && echo) {
-		fprintf(diagfile, "%s:\n", file_name);
-		fflush(diagfile);
-		}
-
-	procinit();
-	if(k = yyparse())
-	{
-		fprintf(diagfile, "Bad parse, return code %d\n", k);
-		done(1);
-	}
-
-	commonprotos(protofile);
-	if (protofile == stdout && !skipC)
-		printf("#endif\n\n");
-
-	if (nerr || skipC)
-		goto C_skipped;
-
-
-/* Write out the declarations which are global to this file */
-
-	if ((c2d = comm2dcl()) == 1)
-		nice_printf(c_output, "/*>>>'/dev/null'<<<*/\n\n\
-/* Split this into several files by piping it through\n\n\
-sed \"s/^\\/\\*>>>'\\(.*\\)'<<<\\*\\/\\$/cat >'\\1' <<'\\/*<<<\\1>>>*\\/'/\" | /bin/sh\n\
- */\n\
-/*<<</dev/null>>>*/\n\
-/*>>>'%s'<<<*/\n", cdfilename);
-	if (gflag)
-		nice_printf (c_output, "#line 1 \"%s\"\n", file_name);
-	if (!skipversion) {
-		nice_printf (c_output, "/* %s -- translated by f2c ", file_name);
-		nice_printf (c_output, "(version %s).\n", F2C_version);
-		nice_printf (c_output,
-	"   You must link the resulting object file with the libraries:\n\
-	%s   (in that order)\n*/\n\n", link_msg);
-		}
-	if (Ansi == 2)
-		nice_printf(c_output,
-			"#ifdef __cplusplus\nextern \"C\" {\n#endif\n");
-	nice_printf (c_output, "%s#include \"f2c.h\"\n\n", def_i2);
-	if (gflag)
-		nice_printf (c_output, "#line 1 \"%s\"\n", file_name);
-	if (Castargs && typedefs)
-		write_typedefs(c_output);
-	nice_printf (c_file, "\n");
-	fclose (c_file);
-	c_file = c_output;		/* HACK to get the next indenting
-					   to work */
-	wr_common_decls (c_output);
-	if (blkdfile)
-		list_init_data(&blkdfile, blkdfname, c_output);
-	wr_globals (c_output);
-	if ((c_file = fopen (c_functions, textread)) == (FILE *) NULL)
-	    Fatal("main - couldn't reopen c_functions");
-	ffilecopy (c_file, c_output);
-	if (*main_alias) {
-	    nice_printf (c_output, "/* Main program alias */ ");
-	    nice_printf (c_output, "int %s () { MAIN__ ();%s }\n",
-		    main_alias, Ansi ? " return 0;" : "");
-	    }
-	if (Ansi == 2)
-		nice_printf(c_output,
-			"#ifdef __cplusplus\n\t}\n#endif\n");
-	if (c2d) {
-		if (c2d == 1)
-			fprintf(c_output, "/*<<<%s>>>*/\n", cdfilename);
-		else
-			fclose(c_output);
-		def_commons(c_output);
-		}
-	if (c2d != 2)
-		fclose (c_output);
-
- C_skipped:
-	if(parstate != OUTSIDE)
-		{
-		warn("missing final end statement");
-		endproc();
-	        nerr = 1;
-		}
-	done(nerr ? 1 : 0);
-	/* NOT REACHED */ return 0;
-}
-
-
- FILEP
-#ifdef KR_headers
-opf(fn, mode)
-	char *fn;
-	char *mode;
-#else
-opf(char *fn, char *mode)
-#endif
-{
-	FILEP fp;
-	if( fp = fopen(fn, mode) )
-		return(fp);
-
-	fatalstr("cannot open intermediate file %s", fn);
-	/* NOT REACHED */ return 0;
-}
-
-
- void
-#ifdef KR_headers
-clf(p, what, quit)
-	FILEP *p;
-	char *what;
-	int quit;
-#else
-clf(FILEP *p, char *what, int quit)
-#endif
-{
-	if(p!=NULL && *p!=NULL && *p!=stdout)
-	{
-		if(ferror(*p)) {
-			fprintf(stderr, "I/O error on %s\n", what);
-			if (quit)
-				done(3);
-			retcode = 3;
-			}
-		fclose(*p);
-	}
-	*p = NULL;
-}
-
-
- void
-#ifdef KR_headers
-done(k)
-	int k;
-#else
-done(int k)
-#endif
-{
-	clf(&initfile, "initfile", 0);
-	clf(&c_file, "c_file", 0);
-	clf(&pass1_file, "pass1_file", 0);
-	Un_link_all(k);
-	exit(k|retcode);
-}
diff --git a/usr.bin/f2c/malloc.c b/usr.bin/f2c/malloc.c
deleted file mode 100644
index 7bd54bc..0000000
--- a/usr.bin/f2c/malloc.c
+++ /dev/null
@@ -1,182 +0,0 @@
-/****************************************************************
-Copyright 1990, 1994 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#ifndef CRAY
-#define STACKMIN 512
-#define MINBLK (2*sizeof(struct mem) + 16)
-#define F _malloc_free_
-#define SBGULP 8192
-#include "string.h"	/* for memcpy */
-
-#ifdef KR_headers
-#define Char char
-#define Unsigned unsigned
-#define Int /*int*/
-#else
-#define Char void
-#define Unsigned size_t
-#define Int int
-#endif
-
-typedef struct mem {
-	struct mem *next;
-	Unsigned len;
-	} mem;
-
-mem *F;
-
- Char *
-#ifdef KR_headers
-malloc(size)
-	register Unsigned size;
-#else
-malloc(register Unsigned size)
-#endif
-{
-	register mem *p, *q, *r, *s;
-	unsigned register k, m;
-	extern Char *sbrk(Int);
-	char *top, *top1;
-
-	size = (size+7) & ~7;
-	r = (mem *) &F;
-	for (p = F, q = 0; p; r = p, p = p->next) {
-		if ((k = p->len) >= size && (!q || m > k)) {
-			m = k;
-			q = p;
-			s = r;
-			}
-		}
-	if (q) {
-		if (q->len - size >= MINBLK) { /* split block */
-			p = (mem *) (((char *) (q+1)) + size);
-			p->next = q->next;
-			p->len = q->len - size - sizeof(mem);
-			s->next = p;
-			q->len = size;
-			}
-		else
-			s->next = q->next;
-		}
-	else {
-		top = (Char *)(((long)sbrk(0) + 7) & ~7);
-		if (F && (char *)(F+1) + F->len == top) {
-			q = F;
-			F = F->next;
-			}
-		else
-			q = (mem *) top;
-		top1 = (char *)(q+1) + size;
-		if (sbrk((int)(top1-top+SBGULP)) == (Char *) -1)
-			return 0;
-		r = (mem *)top1;
-		r->len = SBGULP - sizeof(mem);
-		r->next = F;
-		F = r;
-		q->len = size;
-		}
-	return (Char *) (q+1);
-	}
-
- void
-#ifdef KR_headers
-free(f)
-	Char *f;
-#else
-free(Char *f)
-#endif
-{
-	mem *p, *q, *r;
-	char *pn, *qn;
-
-	if (!f) return;
-	q = (mem *) ((char *)f - sizeof(mem));
-	qn = (char *)f + q->len;
-	for (p = F, r = (mem *) &F; ; r = p, p = p->next) {
-		if (qn == (Char *) p) {
-			q->len += p->len + sizeof(mem);
-			p = p->next;
-			}
-		pn = p ? ((char *) (p+1)) + p->len : 0;
-		if (pn == (Char *) q) {
-			p->len += sizeof(mem) + q->len;
-			q->len = 0;
-			q->next = p;
-			r->next = p;
-			break;
-			}
-		if (pn < (char *) q) {
-			r->next = q;
-			q->next = p;
-			break;
-			}
-		}
-	}
-
- Char *
-#ifdef KR_headers
-realloc(f, size)
-	Char *f;
-	Unsigned size;
-#else
-realloc(Char *f, Unsigned size)
-#endif
-{
-	mem *p;
-	Char *q, *f1;
-	Unsigned s1;
-
-	if (!f) return malloc(size);
-	p = (mem *) ((char *)f - sizeof(mem));
-	s1 = p->len;
-	free(f);
-	if (s1 > size)
-		s1 = size + 7 & ~7;
-	if (!p->len) {
-		f1 = (Char *)(p->next + 1);
-		memcpy(f1, f, s1);
-		f = f1;
-		}
-	q = malloc(size);
-	if (q && q != f)
-		memcpy(q, f, s1);
-	return q;
-	}
-
-/* The following (calloc) should really be in a separate file, */
-/* but defining it here sometimes avoids confusion on systems */
-/* that do not provide calloc in its own file. */
-
- Char *
-#ifdef KR_headers
-calloc(n, m) Unsigned m, n;
-#else
-calloc(Unsigned n, Unsigned m)
-#endif
-{
-	Char *rv = malloc(n *= m);
-	if (n && rv)
-		memset(rv, 0, n);
-	return rv;
-	}
-#endif
diff --git a/usr.bin/f2c/mem.c b/usr.bin/f2c/mem.c
deleted file mode 100644
index 4e3d777..0000000
--- a/usr.bin/f2c/mem.c
+++ /dev/null
@@ -1,268 +0,0 @@
-/****************************************************************
-Copyright 1990, 1991, 1994 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "iob.h"
-
-#define MEMBSIZE	32000
-#define GMEMBSIZE	16000
-
- char *
-#ifdef KR_headers
-gmem(n, round)
-	int n;
-	int round;
-#else
-gmem(int n, int round)
-#endif
-{
-	static char *last, *next;
-	char *rv;
-	if (round)
-#ifdef CRAY
-		if ((long)next & 0xe000000000000000)
-			next = (char *)(((long)next & 0x1fffffffffffffff) + 1);
-#else
-#ifdef MSDOS
-		if ((int)next & 1)
-			next++;
-#else
-		next = (char *)(((long)next + sizeof(char *)-1)
-				& ~((long)sizeof(char *)-1));
-#endif
-#endif
-	rv = next;
-	if ((next += n) > last) {
-		rv = Alloc(n + GMEMBSIZE);
-
-		next = rv + n;
-		last = next + GMEMBSIZE;
-		}
-	return rv;
-	}
-
- struct memblock {
-	struct memblock *next;
-	char buf[MEMBSIZE];
-	};
- typedef struct memblock memblock;
-
- static memblock *mem0;
- memblock *curmemblock, *firstmemblock;
-
- char *mem_first, *mem_next, *mem_last, *mem0_last;
-
- void
-mem_init(Void)
-{
-	curmemblock = firstmemblock = mem0
-		= (memblock *)Alloc(sizeof(memblock));
-	mem_first = mem0->buf;
-	mem_next  = mem0->buf;
-	mem_last  = mem0->buf + MEMBSIZE;
-	mem0_last = mem0->buf + MEMBSIZE;
-	mem0->next = 0;
-	}
-
- char *
-#ifdef KR_headers
-mem(n, round)
-	int n;
-	int round;
-#else
-mem(int n, int round)
-#endif
-{
-	memblock *b;
-	register char *rv, *s;
-
-	if (round)
-#ifdef CRAY
-		if ((long)mem_next & 0xe000000000000000)
-			mem_next = (char *)(((long)mem_next & 0x1fffffffffffffff) + 1);
-#else
-#ifdef MSDOS
-		if ((int)mem_next & 1)
-			mem_next++;
-#else
-		mem_next = (char *)(((long)mem_next + sizeof(char *)-1)
-				& ~((long)sizeof(char *)-1));
-#endif
-#endif
-	rv = mem_next;
-	s = rv + n;
-	if (s >= mem_last) {
-		if (n > MEMBSIZE)  {
-			fprintf(stderr, "mem(%d) failure!\n", n);
-			exit(1);
-			}
-		if (!(b = curmemblock->next)) {
-			b = (memblock *)Alloc(sizeof(memblock));
-			curmemblock->next = b;
-			b->next = 0;
-			}
-		curmemblock = b;
-		rv = b->buf;
-		mem_last = rv + sizeof(b->buf);
-		s = rv + n;
-		}
-	mem_next = s;
-	return rv;
-	}
-
- char *
-#ifdef KR_headers
-tostring(s, n)
-	register char *s;
-	int n;
-#else
-tostring(register char *s, int n)
-#endif
-{
-	register char *s1, *se, **sf;
-	char *rv, *s0;
-	register int k = n + 2, t;
-
-	sf = str_fmt;
-	sf['%'] = "%";
-	s0 = s;
-	se = s + n;
-	for(; s < se; s++) {
-		t = *(unsigned char *)s;
-		s1 = sf[t];
-		while(*++s1)
-			k++;
-		}
-	sf['%'] = "%%";
-	rv = s1 = mem(k,0);
-	*s1++ = '"';
-	for(s = s0; s < se; s++) {
-		t = *(unsigned char *)s;
-		sprintf(s1, sf[t], t);
-		s1 += strlen(s1);
-		}
-	*s1 = 0;
-	return rv;
-	}
-
- char *
-#ifdef KR_headers
-cpstring(s)
-	register char *s;
-#else
-cpstring(register char *s)
-#endif
-{
-	return strcpy(mem(strlen(s)+1,0), s);
-	}
-
- void
-#ifdef KR_headers
-new_iob_data(ios, name)
-	register io_setup *ios;
-	char *name;
-#else
-new_iob_data(register io_setup *ios, char *name)
-#endif
-{
-	register iob_data *iod;
-	register char **s, **se;
-
-	iod = (iob_data *)
-		mem(sizeof(iob_data) + ios->nelt*sizeof(char *), 1);
-	iod->next = iob_list;
-	iob_list = iod;
-	iod->type = ios->fields[0];
-	iod->name = cpstring(name);
-	s = iod->fields;
-	se = s + ios->nelt;
-	while(s < se)
-		*s++ = "0";
-	*s = 0;
-	}
-
- char *
-#ifdef KR_headers
-string_num(pfx, n)
-	char *pfx;
-	long n;
-#else
-string_num(char *pfx, long n)
-#endif
-{
-	char buf[32];
-	sprintf(buf, "%s%ld", pfx, n);
-	/* can't trust return type of sprintf -- BSD gets it wrong */
-	return strcpy(mem(strlen(buf)+1,0), buf);
-	}
-
-static defines *define_list;
-
- void
-#ifdef KR_headers
-def_start(outfile, s1, s2, post)
-	FILE *outfile;
-	char *s1;
-	char *s2;
-	char *post;
-#else
-def_start(FILE *outfile, char *s1, char *s2, char *post)
-#endif
-{
-	defines *d;
-	int n, n1;
-	extern int in_define;
-
-	n = n1 = strlen(s1);
-	if (s2)
-		n += strlen(s2);
-	d = (defines *)mem(sizeof(defines)+n, 1);
-	d->next = define_list;
-	define_list = d;
-	strcpy(d->defname, s1);
-	if (s2)
-		strcpy(d->defname + n1, s2);
-	in_define = 1;
-	nice_printf(outfile, "#define %s", d->defname);
-	if (post)
-		nice_printf(outfile, " %s", post);
-	}
-
- void
-#ifdef KR_headers
-other_undefs(outfile)
-	FILE *outfile;
-#else
-other_undefs(FILE *outfile)
-#endif
-{
-	defines *d;
-	if (d = define_list) {
-		define_list = 0;
-		nice_printf(outfile, "\n");
-		do
-			nice_printf(outfile, "#undef %s\n", d->defname);
-			while(d = d->next);
-		nice_printf(outfile, "\n");
-		}
-	}
diff --git a/usr.bin/f2c/memset.c b/usr.bin/f2c/memset.c
deleted file mode 100644
index 4d6ab47..0000000
--- a/usr.bin/f2c/memset.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/****************************************************************
-Copyright 1990 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-/* This is for the benefit of people whose systems don't provide
- * memset, memcpy, and memcmp.  If yours is such a system, adjust
- * the makefile by adding memset.o to the "OBJECTS =" assignment.
- * WARNING: the memcpy below is adequate for f2c, but is not a
- * general memcpy routine (which must correctly handle overlapping
- * fields).
- */
-
- int
-memcmp(s1, s2, n)
- register char *s1, *s2;
- int n;
-{
-	register char *se;
-
-	for(se = s1 + n; s1 < se; s1++, s2++)
-		if (*s1 != *s2)
-			return *s1 - *s2;
-	return 0;
-	}
-
- char *
-memcpy(s1, s2, n)
- register char *s1, *s2;
- int n;
-{
-	register char *s0 = s1, *se = s1 + n;
-
-	while(s1 < se)
-		*s1++ = *s2++;
-	return s0;
-	}
-
-memset(s, c, n)
- register char *s;
- register int c;
- int n;
-{
-	register char *se = s + n;
-
-	while(s < se)
-		*s++ = c;
-	}
diff --git a/usr.bin/f2c/misc.c b/usr.bin/f2c/misc.c
deleted file mode 100644
index f5cca53..0000000
--- a/usr.bin/f2c/misc.c
+++ /dev/null
@@ -1,1329 +0,0 @@
-/****************************************************************
-Copyright 1990, 1992 - 1995 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "limits.h"
-
- int
-#ifdef KR_headers
-oneof_stg(name, stg, mask)
-	Namep name;
-	int stg;
-	int mask;
-#else
-oneof_stg(Namep name, int stg, int mask)
-#endif
-{
-	if (stg == STGCOMMON && name) {
-		if ((mask & M(STGEQUIV)))
-			return name->vcommequiv;
-		if ((mask & M(STGCOMMON)))
-			return !name->vcommequiv;
-		}
-	return ONEOF(stg, mask);
-	}
-
-
-/* op_assign -- given a binary opcode, return the associated assignment
-   operator */
-
- int
-#ifdef KR_headers
-op_assign(opcode)
-	int opcode;
-#else
-op_assign(int opcode)
-#endif
-{
-    int retval = -1;
-
-    switch (opcode) {
-        case OPPLUS: retval = OPPLUSEQ; break;
-	case OPMINUS: retval = OPMINUSEQ; break;
-	case OPSTAR: retval = OPSTAREQ; break;
-	case OPSLASH: retval = OPSLASHEQ; break;
-	case OPMOD: retval = OPMODEQ; break;
-	case OPLSHIFT: retval = OPLSHIFTEQ; break;
-	case OPRSHIFT: retval = OPRSHIFTEQ; break;
-	case OPBITAND: retval = OPBITANDEQ; break;
-	case OPBITXOR: retval = OPBITXOREQ; break;
-	case OPBITOR: retval = OPBITOREQ; break;
-	default:
-	    erri ("op_assign:  bad opcode '%d'", opcode);
-	    break;
-    } /* switch */
-
-    return retval;
-} /* op_assign */
-
-
- char *
-#ifdef KR_headers
-Alloc(n)
-	int n;
-#else
-Alloc(int n)
-#endif
-		/* error-checking version of malloc */
-		/* ckalloc initializes memory to 0; Alloc does not */
-{
-	char errbuf[32];
-	register char *rv;
-
-	rv = malloc(n);
-	if (!rv) {
-		sprintf(errbuf, "malloc(%d) failure!", n);
-		Fatal(errbuf);
-		}
-	return rv;
-	}
-
- void
-#ifdef KR_headers
-cpn(n, a, b)
-	register int n;
-	register char *a;
-	register char *b;
-#else
-cpn(register int n, register char *a, register char *b)
-#endif
-{
-	while(--n >= 0)
-		*b++ = *a++;
-}
-
-
- int
-#ifdef KR_headers
-eqn(n, a, b)
-	register int n;
-	register char *a;
-	register char *b;
-#else
-eqn(register int n, register char *a, register char *b)
-#endif
-{
-	while(--n >= 0)
-		if(*a++ != *b++)
-			return(NO);
-	return(YES);
-}
-
-
-
-
-
-
- int
-#ifdef KR_headers
-cmpstr(a, b, la, lb)
-	register char *a;
-	register char *b;
-	ftnint la;
-	ftnint lb;
-#else
-cmpstr(register char *a, register char *b, ftnint la, ftnint lb)
-#endif
-	/* compare two strings */
-{
-	register char *aend, *bend;
-	aend = a + la;
-	bend = b + lb;
-
-
-	if(la <= lb)
-	{
-		while(a < aend)
-			if(*a != *b)
-				return( *a - *b );
-			else
-			{
-				++a;
-				++b;
-			}
-
-		while(b < bend)
-			if(*b != ' ')
-				return(' ' - *b);
-			else
-				++b;
-	}
-
-	else
-	{
-		while(b < bend)
-			if(*a != *b)
-				return( *a - *b );
-			else
-			{
-				++a;
-				++b;
-			}
-		while(a < aend)
-			if(*a != ' ')
-				return(*a - ' ');
-			else
-				++a;
-	}
-	return(0);
-}
-
-
-/* hookup -- Same as LISP NCONC, that is a destructive append of two lists */
-
- chainp
-#ifdef KR_headers
-hookup(x, y)
-	register chainp x;
-	register chainp y;
-#else
-hookup(register chainp x, register chainp y)
-#endif
-{
-	register chainp p;
-
-	if(x == NULL)
-		return(y);
-
-	for(p = x ; p->nextp ; p = p->nextp)
-		;
-	p->nextp = y;
-	return(x);
-}
-
-
-
- struct Listblock *
-#ifdef KR_headers
-mklist(p)
-	chainp p;
-#else
-mklist(chainp p)
-#endif
-{
-	register struct Listblock *q;
-
-	q = ALLOC(Listblock);
-	q->tag = TLIST;
-	q->listp = p;
-	return(q);
-}
-
-
- chainp
-#ifdef KR_headers
-mkchain(p, q)
-	register char * p;
-	register chainp q;
-#else
-mkchain(register char * p, register chainp q)
-#endif
-{
-	register chainp r;
-
-	if(chains)
-	{
-		r = chains;
-		chains = chains->nextp;
-	}
-	else
-		r = ALLOC(Chain);
-
-	r->datap = p;
-	r->nextp = q;
-	return(r);
-}
-
- chainp
-#ifdef KR_headers
-revchain(next)
-	register chainp next;
-#else
-revchain(register chainp next)
-#endif
-{
-	register chainp p, prev = 0;
-
-	while(p = next) {
-		next = p->nextp;
-		p->nextp = prev;
-		prev = p;
-		}
-	return prev;
-	}
-
-
-/* addunder -- turn a cvarname into an external name */
-/* The cvarname may already end in _ (to avoid C keywords); */
-/* if not, it has room for appending an _. */
-
- char *
-#ifdef KR_headers
-addunder(s)
-	register char *s;
-#else
-addunder(register char *s)
-#endif
-{
-	register int c, i, j;
-	char *s0 = s;
-
-	i = j = 0;
-	while(c = *s++)
-		if (c == '_')
-			i++, j++;
-		else
-			i = 0;
-	if (!i) {
-		*s-- = 0;
-		*s = '_';
-		}
-	else if (j == 2)
-		s[-2] = 0;
-	return( s0 );
-	}
-
-
-/* copyn -- return a new copy of the input Fortran-string */
-
- char *
-#ifdef KR_headers
-copyn(n, s)
-	register int n;
-	register char *s;
-#else
-copyn(register int n, register char *s)
-#endif
-{
-	register char *p, *q;
-
-	p = q = (char *) Alloc(n);
-	while(--n >= 0)
-		*q++ = *s++;
-	return(p);
-}
-
-
-
-/* copys -- return a new copy of the input C-string */
-
- char *
-#ifdef KR_headers
-copys(s)
-	char *s;
-#else
-copys(char *s)
-#endif
-{
-	return( copyn( strlen(s)+1 , s) );
-}
-
-
-
-/* convci -- Convert Fortran-string to integer; assumes that input is a
-   legal number, with no trailing blanks */
-
- ftnint
-#ifdef KR_headers
-convci(n, s)
-	register int n;
-	register char *s;
-#else
-convci(register int n, register char *s)
-#endif
-{
-	ftnint sum, t;
-	char buff[100], *s0;
-	int n0;
-
-	s0 = s;
-	n0 = n;
-	sum = 0;
-	while(n-- > 0) {
-		/* sum = 10*sum + (*s++ - '0'); */
-		t = *s++ - '0';
-		if (sum > LONG_MAX/10) {
- ovfl:
-			if (n0 > 60)
-				n0 = 60;
-			sprintf(buff, "integer constant %.*s truncated.",
-				n0, s0);
-			err(buff);
-			return LONG_MAX;
-			}
-		sum *= 10;
-		if (sum > LONG_MAX - t)
-			goto ovfl;
-		sum += t;
-		}
-	return(sum);
-	}
-
-/* convic - Convert Integer constant to string */
-
- char *
-#ifdef KR_headers
-convic(n)
-	ftnint n;
-#else
-convic(ftnint n)
-#endif
-{
-	static char s[20];
-	register char *t;
-
-	s[19] = '\0';
-	t = s+19;
-
-	do	{
-		*--t = '0' + n%10;
-		n /= 10;
-	} while(n > 0);
-
-	return(t);
-}
-
-
-
-/* mkname -- add a new identifier to the environment, including the closed
-   hash table. */
-
- Namep
-#ifdef KR_headers
-mkname(s)
-	register char *s;
-#else
-mkname(register char *s)
-#endif
-{
-	struct Hashentry *hp;
-	register Namep q;
-	register int c, hash, i;
-	register char *t;
-	char *s0;
-	char errbuf[64];
-
-	hash = i = 0;
-	s0 = s;
-	while(c = *s++) {
-		hash += c;
-		if (c == '_')
-			i = 2;
-		}
-	if (!i && in_vector(s0,c_keywords,n_keywords) >= 0)
-		i = 2;
-	hash %= maxhash;
-
-/* Add the name to the closed hash table */
-
-	hp = hashtab + hash;
-
-	while(q = hp->varp)
-		if( hash == hp->hashval && !strcmp(s0,q->fvarname) )
-			return(q);
-		else if(++hp >= lasthash)
-			hp = hashtab;
-
-	if(++nintnames >= maxhash-1)
-		many("names", 'n', maxhash);	/* Fatal error */
-	hp->varp = q = ALLOC(Nameblock);
-	hp->hashval = hash;
-	q->tag = TNAME;	/* TNAME means the tag type is NAME */
-	c = s - s0;
-	if (c > 7 && noextflag) {
-		sprintf(errbuf, "\"%.35s%s\" over 6 characters long", s0,
-			c > 36 ? "..." : "");
-		errext(errbuf);
-		}
-	q->fvarname = strcpy(mem(c,0), s0);
-	t = q->cvarname = mem(c + i + 1, 0);
-	s = s0;
-	/* add __ to the end of any name containing _ and to any C keyword */
-	while(*t = *s++)
-		t++;
-	if (i) {
-		do *t++ = '_';
-			while(--i > 0);
-		*t = 0;
-		}
-	return(q);
-}
-
-
- struct Labelblock *
-#ifdef KR_headers
-mklabel(l)
-	ftnint l;
-#else
-mklabel(ftnint l)
-#endif
-{
-	register struct Labelblock *lp;
-
-	if(l <= 0)
-		return(NULL);
-
-	for(lp = labeltab ; lp < highlabtab ; ++lp)
-		if(lp->stateno == l)
-			return(lp);
-
-	if(++highlabtab > labtabend)
-		many("statement labels", 's', maxstno);
-
-	lp->stateno = l;
-	lp->labelno = (int)newlabel();
-	lp->blklevel = 0;
-	lp->labused = NO;
-	lp->fmtlabused = NO;
-	lp->labdefined = NO;
-	lp->labinacc = NO;
-	lp->labtype = LABUNKNOWN;
-	lp->fmtstring = 0;
-	return(lp);
-}
-
- long
-newlabel(Void)
-{
-	return ++lastlabno;
-}
-
-
-/* this label appears in a branch context */
-
- struct Labelblock *
-#ifdef KR_headers
-execlab(stateno)
-	ftnint stateno;
-#else
-execlab(ftnint stateno)
-#endif
-{
-	register struct Labelblock *lp;
-
-	if(lp = mklabel(stateno))
-	{
-		if(lp->labinacc)
-			warn1("illegal branch to inner block, statement label %s",
-			    convic(stateno) );
-		else if(lp->labdefined == NO)
-			lp->blklevel = blklevel;
-		if(lp->labtype == LABFORMAT)
-			err("may not branch to a format");
-		else
-			lp->labtype = LABEXEC;
-	}
-	else
-		execerr("illegal label %s", convic(stateno));
-
-	return(lp);
-}
-
-
-/* find or put a name in the external symbol table */
-
- Extsym *
-#ifdef KR_headers
-mkext1(f, s)
-	char *f;
-	char *s;
-#else
-mkext1(char *f, char *s)
-#endif
-{
-	Extsym *p;
-
-	for(p = extsymtab ; p<nextext ; ++p)
-		if(!strcmp(s,p->cextname))
-			return( p );
-
-	if(nextext >= lastext)
-		many("external symbols", 'x', maxext);
-
-	nextext->fextname = strcpy(gmem(strlen(f)+1,0), f);
-	nextext->cextname = f == s
-				? nextext->fextname
-				: strcpy(gmem(strlen(s)+1,0), s);
-	nextext->extstg = STGUNKNOWN;
-	nextext->extp = 0;
-	nextext->allextp = 0;
-	nextext->extleng = 0;
-	nextext->maxleng = 0;
-	nextext->extinit = 0;
-	nextext->curno = nextext->maxno = 0;
-	return( nextext++ );
-}
-
-
- Extsym *
-#ifdef KR_headers
-mkext(f, s)
-	char *f;
-	char *s;
-#else
-mkext(char *f, char *s)
-#endif
-{
-	Extsym *e = mkext1(f, s);
-	if (e->extstg == STGCOMMON)
-		errstr("%.52s cannot be a subprogram: it is a common block.",f);
-	return e;
-	}
-
- Addrp
-#ifdef KR_headers
-builtin(t, s, dbi)
-	int t;
-	char *s;
-	int dbi;
-#else
-builtin(int t, char *s, int dbi)
-#endif
-{
-	register Extsym *p;
-	register Addrp q;
-	extern chainp used_builtins;
-
-	p = mkext(s,s);
-	if(p->extstg == STGUNKNOWN)
-		p->extstg = STGEXT;
-	else if(p->extstg != STGEXT)
-	{
-		errstr("improper use of builtin %s", s);
-		return(0);
-	}
-
-	q = ALLOC(Addrblock);
-	q->tag = TADDR;
-	q->vtype = t;
-	q->vclass = CLPROC;
-	q->vstg = STGEXT;
-	q->memno = p - extsymtab;
-	q->dbl_builtin = dbi;
-
-/* A NULL pointer here tells you to use   memno   to check the external
-   symbol table */
-
-	q -> uname_tag = UNAM_EXTERN;
-
-/* Add to the list of used builtins */
-
-	if (dbi >= 0)
-		add_extern_to_list (q, &used_builtins);
-	return(q);
-}
-
-
- void
-#ifdef KR_headers
-add_extern_to_list(addr, list_store)
-	Addrp addr;
-	chainp *list_store;
-#else
-add_extern_to_list(Addrp addr, chainp *list_store)
-#endif
-{
-    chainp last = CHNULL;
-    chainp list;
-    int memno;
-
-    if (list_store == (chainp *) NULL || addr == (Addrp) NULL)
-	return;
-
-    list = *list_store;
-    memno = addr -> memno;
-
-    for (;list; last = list, list = list -> nextp) {
-	Addrp this = (Addrp) (list -> datap);
-
-	if (this -> tag == TADDR && this -> uname_tag == UNAM_EXTERN &&
-		this -> memno == memno)
-	    return;
-    } /* for */
-
-    if (*list_store == CHNULL)
-	*list_store = mkchain((char *)cpexpr((expptr)addr), CHNULL);
-    else
-	last->nextp = mkchain((char *)cpexpr((expptr)addr), CHNULL);
-
-} /* add_extern_to_list */
-
-
- void
-#ifdef KR_headers
-frchain(p)
-	register chainp *p;
-#else
-frchain(register chainp *p)
-#endif
-{
-	register chainp q;
-
-	if(p==0 || *p==0)
-		return;
-
-	for(q = *p; q->nextp ; q = q->nextp)
-		;
-	q->nextp = chains;
-	chains = *p;
-	*p = 0;
-}
-
- void
-#ifdef KR_headers
-frexchain(p)
-	register chainp *p;
-#else
-frexchain(register chainp *p)
-#endif
-{
-	register chainp q, r;
-
-	if (q = *p) {
-		for(;;q = r) {
-			frexpr((expptr)q->datap);
-			if (!(r = q->nextp))
-				break;
-			}
-		q->nextp = chains;
-		chains = *p;
-		*p = 0;
-		}
-	}
-
-
- tagptr
-#ifdef KR_headers
-cpblock(n, p)
-	register int n;
-	register char *p;
-#else
-cpblock(register int n, register char *p)
-#endif
-{
-	register ptr q;
-
-	memcpy((char *)(q = ckalloc(n)), (char *)p, n);
-	return( (tagptr) q);
-}
-
-
-
- ftnint
-#ifdef KR_headers
-lmax(a, b)
-	ftnint a;
-	ftnint b;
-#else
-lmax(ftnint a, ftnint b)
-#endif
-{
-	return( a>b ? a : b);
-}
-
- ftnint
-#ifdef KR_headers
-lmin(a, b)
-	ftnint a;
-	ftnint b;
-#else
-lmin(ftnint a, ftnint b)
-#endif
-{
-	return(a < b ? a : b);
-}
-
-
-
-
-#ifdef KR_headers
-maxtype(t1, t2)
-	int t1;
-	int t2;
-#else
-maxtype(int t1, int t2)
-#endif
-{
-	int t;
-
-	t = t1 >= t2 ? t1 : t2;
-	if(t==TYCOMPLEX && (t1==TYDREAL || t2==TYDREAL) )
-		t = TYDCOMPLEX;
-	return(t);
-}
-
-
-
-/* return log base 2 of n if n a power of 2; otherwise -1 */
- int
-#ifdef KR_headers
-log_2(n)
-	ftnint n;
-#else
-log_2(ftnint n)
-#endif
-{
-	int k;
-
-	/* trick based on binary representation */
-
-	if(n<=0 || (n & (n-1))!=0)
-		return(-1);
-
-	for(k = 0 ;  n >>= 1  ; ++k)
-		;
-	return(k);
-}
-
-
- void
-frrpl(Void)
-{
-	struct Rplblock *rp;
-
-	while(rpllist)
-	{
-		rp = rpllist->rplnextp;
-		free( (charptr) rpllist);
-		rpllist = rp;
-	}
-}
-
-
-
-/* Call a Fortran function with an arbitrary list of arguments */
-
-int callk_kludge;
-
- expptr
-#ifdef KR_headers
-callk(type, name, args)
-	int type;
-	char *name;
-	chainp args;
-#else
-callk(int type, char *name, chainp args)
-#endif
-{
-	register expptr p;
-
-	p = mkexpr(OPCALL,
-		(expptr)builtin(callk_kludge ? callk_kludge : type, name, 0),
-		(expptr)args);
-	p->exprblock.vtype = type;
-	return(p);
-}
-
-
-
- expptr
-#ifdef KR_headers
-call4(type, name, arg1, arg2, arg3, arg4)
-	int type;
-	char *name;
-	expptr arg1;
-	expptr arg2;
-	expptr arg3;
-	expptr arg4;
-#else
-call4(int type, char *name, expptr arg1, expptr arg2, expptr arg3, expptr arg4)
-#endif
-{
-	struct Listblock *args;
-	args = mklist( mkchain((char *)arg1,
-			mkchain((char *)arg2,
-				mkchain((char *)arg3,
-	    				mkchain((char *)arg4, CHNULL)) ) ) );
-	return( callk(type, name, (chainp)args) );
-}
-
-
-
-
- expptr
-#ifdef KR_headers
-call3(type, name, arg1, arg2, arg3)
-	int type;
-	char *name;
-	expptr arg1;
-	expptr arg2;
-	expptr arg3;
-#else
-call3(int type, char *name, expptr arg1, expptr arg2, expptr arg3)
-#endif
-{
-	struct Listblock *args;
-	args = mklist( mkchain((char *)arg1,
-			mkchain((char *)arg2,
-				mkchain((char *)arg3, CHNULL) ) ) );
-	return( callk(type, name, (chainp)args) );
-}
-
-
-
-
-
- expptr
-#ifdef KR_headers
-call2(type, name, arg1, arg2)
-	int type;
-	char *name;
-	expptr arg1;
-	expptr arg2;
-#else
-call2(int type, char *name, expptr arg1, expptr arg2)
-#endif
-{
-	struct Listblock *args;
-
-	args = mklist( mkchain((char *)arg1, mkchain((char *)arg2, CHNULL) ) );
-	return( callk(type,name, (chainp)args) );
-}
-
-
-
-
- expptr
-#ifdef KR_headers
-call1(type, name, arg)
-	int type;
-	char *name;
-	expptr arg;
-#else
-call1(int type, char *name, expptr arg)
-#endif
-{
-	return( callk(type,name, (chainp)mklist(mkchain((char *)arg,CHNULL)) ));
-}
-
-
- expptr
-#ifdef KR_headers
-call0(type, name)
-	int type;
-	char *name;
-#else
-call0(int type, char *name)
-#endif
-{
-	return( callk(type, name, CHNULL) );
-}
-
-
-
- struct Impldoblock *
-#ifdef KR_headers
-mkiodo(dospec, list)
-	chainp dospec;
-	chainp list;
-#else
-mkiodo(chainp dospec, chainp list)
-#endif
-{
-	register struct Impldoblock *q;
-
-	q = ALLOC(Impldoblock);
-	q->tag = TIMPLDO;
-	q->impdospec = dospec;
-	q->datalist = list;
-	return(q);
-}
-
-
-
-
-/* ckalloc -- Allocate 1 memory unit of size   n,   checking for out of
-   memory error */
-
- ptr
-#ifdef KR_headers
-ckalloc(n)
-	register int n;
-#else
-ckalloc(register int n)
-#endif
-{
-	register ptr p;
-	p = (ptr)calloc(1, (unsigned) n);
-	if (p || !n)
-		return(p);
-	fprintf(stderr, "failing to get %d bytes\n",n);
-	Fatal("out of memory");
-	/* NOT REACHED */ return 0;
-}
-
-
- int
-#ifdef KR_headers
-isaddr(p)
-	register expptr p;
-#else
-isaddr(register expptr p)
-#endif
-{
-	if(p->tag == TADDR)
-		return(YES);
-	if(p->tag == TEXPR)
-		switch(p->exprblock.opcode)
-		{
-		case OPCOMMA:
-			return( isaddr(p->exprblock.rightp) );
-
-		case OPASSIGN:
-		case OPASSIGNI:
-		case OPPLUSEQ:
-		case OPMINUSEQ:
-		case OPSLASHEQ:
-		case OPMODEQ:
-		case OPLSHIFTEQ:
-		case OPRSHIFTEQ:
-		case OPBITANDEQ:
-		case OPBITXOREQ:
-		case OPBITOREQ:
-			return( isaddr(p->exprblock.leftp) );
-		}
-	return(NO);
-}
-
-
-
- int
-#ifdef KR_headers
-isstatic(p)
-	register expptr p;
-#else
-isstatic(register expptr p)
-#endif
-{
-	extern int useauto;
-	if(p->headblock.vleng && !ISCONST(p->headblock.vleng))
-		return(NO);
-
-	switch(p->tag)
-	{
-	case TCONST:
-		return(YES);
-
-	case TADDR:
-		if(ONEOF(p->addrblock.vstg,MSKSTATIC) &&
-		    ISCONST(p->addrblock.memoffset) && !useauto)
-			return(YES);
-
-	default:
-		return(NO);
-	}
-}
-
-
-
-/* addressable -- return True iff it is a constant value, or can be
-   referenced by constant values */
-
- int
-#ifdef KR_headers
-addressable(p)
-	register expptr p;
-#else
-addressable(register expptr p)
-#endif
-{
-	switch(p->tag)
-	{
-	case TCONST:
-		return(YES);
-
-	case TADDR:
-		return( addressable(p->addrblock.memoffset) );
-
-	default:
-		return(NO);
-	}
-}
-
-
-/* isnegative_const -- returns true if the constant is negative.  Returns
-   false for imaginary and nonnumeric constants */
-
- int
-#ifdef KR_headers
-isnegative_const(cp)
-	struct Constblock *cp;
-#else
-isnegative_const(struct Constblock *cp)
-#endif
-{
-    int retval;
-
-    if (cp == NULL)
-	return 0;
-
-    switch (cp -> vtype) {
-	case TYINT1:
-        case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-	    retval = cp -> Const.ci < 0;
-	    break;
-	case TYREAL:
-	case TYDREAL:
-		retval = cp->vstg ? *cp->Const.cds[0] == '-'
-				  :  cp->Const.cd[0] < 0.0;
-	    break;
-	default:
-
-	    retval = 0;
-	    break;
-    } /* switch */
-
-    return retval;
-} /* isnegative_const */
-
- void
-#ifdef KR_headers
-negate_const(cp)
-	Constp cp;
-#else
-negate_const(Constp cp)
-#endif
-{
-    if (cp == (struct Constblock *) NULL)
-	return;
-
-    switch (cp -> vtype) {
-	case TYINT1:
-	case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-	    cp -> Const.ci = - cp -> Const.ci;
-	    break;
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-		if (cp->vstg)
-		    switch(*cp->Const.cds[1]) {
-			case '-':
-				++cp->Const.cds[1];
-				break;
-			case '0':
-				break;
-			default:
-				--cp->Const.cds[1];
-			}
-		else
-	    		cp->Const.cd[1] = -cp->Const.cd[1];
-		/* no break */
-	case TYREAL:
-	case TYDREAL:
-		if (cp->vstg)
-		    switch(*cp->Const.cds[0]) {
-			case '-':
-				++cp->Const.cds[0];
-				break;
-			case '0':
-				break;
-			default:
-				--cp->Const.cds[0];
-			}
-		else
-	    		cp->Const.cd[0] = -cp->Const.cd[0];
-	    break;
-	case TYCHAR:
-	case TYLOGICAL1:
-	case TYLOGICAL2:
-	case TYLOGICAL:
-	    erri ("negate_const:  can't negate type '%d'", cp -> vtype);
-	    break;
-	default:
-	    erri ("negate_const:  bad type '%d'",
-		    cp -> vtype);
-	    break;
-    } /* switch */
-} /* negate_const */
-
- void
-#ifdef KR_headers
-ffilecopy(infp, outfp)
-	FILE *infp;
-	FILE *outfp;
-#else
-ffilecopy(FILE *infp, FILE *outfp)
-#endif
-{
-    while (!feof (infp)) {
-	register c = getc (infp);
-	if (!feof (infp))
-	putc (c, outfp);
-    } /* while */
-} /* ffilecopy */
-
-
-/* in_vector -- verifies whether   str   is in c_keywords.
-   If so, the index is returned else  -1  is returned.
-   c_keywords must be in alphabetical order (as defined by strcmp).
-*/
-
- int
-#ifdef KR_headers
-in_vector(str, keywds, n)
-	char *str;
-	char **keywds;
-	register int n;
-#else
-in_vector(char *str, char **keywds, register int n)
-#endif
-{
-	register char **K = keywds;
-	register int n1, t;
-
-	do {
-		n1 = n >> 1;
-		if (!(t = strcmp(str, K[n1])))
-			return K - keywds + n1;
-		if (t < 0)
-			n = n1;
-		else {
-			n -= ++n1;
-			K += n1;
-			}
-		}
-		while(n > 0);
-
-	return -1;
-	} /* in_vector */
-
-
- int
-#ifdef KR_headers
-is_negatable(Const)
-	Constp Const;
-#else
-is_negatable(Constp Const)
-#endif
-{
-    int retval = 0;
-    if (Const != (Constp) NULL)
-	switch (Const -> vtype) {
-	    case TYINT1:
-		retval = Const -> Const.ci >= -BIGGEST_CHAR;
-		break;
-	    case TYSHORT:
-	        retval = Const -> Const.ci >= -BIGGEST_SHORT;
-	        break;
-	    case TYLONG:
-#ifdef TYQUAD
-	    case TYQUAD:
-#endif
-	        retval = Const -> Const.ci >= -BIGGEST_LONG;
-	        break;
-	    case TYREAL:
-	    case TYDREAL:
-	    case TYCOMPLEX:
-	    case TYDCOMPLEX:
-	        retval = 1;
-	        break;
-	    case TYLOGICAL1:
-	    case TYLOGICAL2:
-	    case TYLOGICAL:
-	    case TYCHAR:
-	    case TYSUBR:
-	    default:
-	        retval = 0;
-	        break;
-	} /* switch */
-
-    return retval;
-} /* is_negatable */
-
- void
-#ifdef KR_headers
-backup(fname, bname)
-	char *fname;
-	char *bname;
-#else
-backup(char *fname, char *bname)
-#endif
-{
-	FILE *b, *f;
-	static char couldnt[] = "Couldn't open %.80s";
-
-	if (!(f = fopen(fname, binread))) {
-		warn1(couldnt, fname);
-		return;
-		}
-	if (!(b = fopen(bname, binwrite))) {
-		warn1(couldnt, bname);
-		return;
-		}
-	ffilecopy(f, b);
-	fclose(f);
-	fclose(b);
-	}
-
-
-/* struct_eq -- returns YES if structures have the same field names and
-   types, NO otherwise */
-
- int
-#ifdef KR_headers
-struct_eq(s1, s2)
-	chainp s1;
-	chainp s2;
-#else
-struct_eq(chainp s1, chainp s2)
-#endif
-{
-    struct Dimblock *d1, *d2;
-    Constp cp1, cp2;
-
-    if (s1 == CHNULL && s2 == CHNULL)
-	return YES;
-    for(; s1 && s2; s1 = s1->nextp, s2 = s2->nextp) {
-	register Namep v1 = (Namep) s1 -> datap;
-	register Namep v2 = (Namep) s2 -> datap;
-
-	if (v1 == (Namep) NULL || v1 -> tag != TNAME ||
-		v2 == (Namep) NULL || v2 -> tag != TNAME)
-	    return NO;
-
-	if (v1->vtype != v2->vtype || v1->vclass != v2->vclass
-		|| strcmp(v1->fvarname, v2->fvarname))
-	    return NO;
-
-	/* compare dimensions (needed for comparing COMMON blocks) */
-
-	if (d1 = v1->vdim) {
-		if (!(cp1 = (Constp)d1->nelt) || cp1->tag != TCONST
-		||  !(d2 = v2->vdim)
-		||  !(cp2 = (Constp)d2->nelt) || cp2->tag != TCONST
-		||  cp1->Const.ci != cp2->Const.ci)
-			return NO;
-		}
-	else if (v2->vdim)
-		return NO;
-    } /* while s1 != CHNULL && s2 != CHNULL */
-
-    return s1 == CHNULL && s2 == CHNULL;
-} /* struct_eq */
diff --git a/usr.bin/f2c/names.c b/usr.bin/f2c/names.c
deleted file mode 100644
index b0e1058..0000000
--- a/usr.bin/f2c/names.c
+++ /dev/null
@@ -1,835 +0,0 @@
-/****************************************************************
-Copyright 1990, 1992 - 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "output.h"
-#include "names.h"
-#include "iob.h"
-
-
-/* Names generated by the translator are guaranteed to be unique from the
-   Fortan names because Fortran does not allow underscores in identifiers,
-   and all of the system generated names do have underscores.  The various
-   naming conventions are outlined below:
-
-	FORMAT		APPLICATION
-   ----------------------------------------------------------------------
-	io_#		temporaries generated by IO calls; these will
-			contain the device number (e.g. 5, 6, 0)
-	ret_val		function return value, required for complex and
-			character functions.
-	ret_val_len	length of the return value in character functions
-
-	ssss_len	length of character argument "ssss"
-
-	c_#		member of the literal pool, where # is an
-			arbitrary label assigned by the system
-	cs_#		short integer constant in the literal pool
-	t_#		expression temporary, # is the depth of arguments
-			on the stack.
-	L#		label "#", given by user in the Fortran program.
-			This is unique because Fortran labels are numeric
-	pad_#		label on an init field required for alignment
-	xxx_init	label on a common block union, if a block data
-			requires a separate declaration
-*/
-
-/* generate variable references */
-
- char *
-#ifdef KR_headers
-c_type_decl(type, is_extern)
-	int type;
-	int is_extern;
-#else
-c_type_decl(int type, int is_extern)
-#endif
-{
-    static char buff[100];
-
-    switch (type) {
-	case TYREAL:	if (!is_extern || !forcedouble)
-				{ strcpy (buff, "real");break; }
-	case TYDREAL:	strcpy (buff, "doublereal");	break;
-	case TYCOMPLEX:	if (is_extern)
-			    strcpy (buff, "/* Complex */ VOID");
-			else
-			    strcpy (buff, "complex");
-			break;
-	case TYDCOMPLEX:if (is_extern)
-			    strcpy (buff, "/* Double Complex */ VOID");
-			else
-			    strcpy (buff, "doublecomplex");
-			break;
-	case TYADDR:
-	case TYINT1:
-	case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-	case TYLOGICAL1:
-	case TYLOGICAL2:
-	case TYLOGICAL:	strcpy(buff, typename[type]);
-			break;
-	case TYCHAR:	if (is_extern)
-			    strcpy (buff, "/* Character */ VOID");
-			else
-			    strcpy (buff, "char");
-			break;
-
-        case TYUNKNOWN:	strcpy (buff, "UNKNOWN");
-
-/* If a procedure's type is unknown, assume it's a subroutine */
-
-			if (!is_extern)
-			    break;
-
-/* Subroutines must return an INT, because they might return a label
-   value.  Even if one doesn't, the caller will EXPECT it to. */
-
-	case TYSUBR:	strcpy (buff, "/* Subroutine */ int");
-							break;
-	case TYERROR:	strcpy (buff, "ERROR");		break;
-	case TYVOID:	strcpy (buff, "void");		break;
-	case TYCILIST:	strcpy (buff, "cilist");	break;
-	case TYICILIST:	strcpy (buff, "icilist");	break;
-	case TYOLIST:	strcpy (buff, "olist");		break;
-	case TYCLLIST:	strcpy (buff, "cllist");	break;
-	case TYALIST:	strcpy (buff, "alist");		break;
-	case TYINLIST:	strcpy (buff, "inlist");	break;
-	case TYFTNLEN:	strcpy (buff, "ftnlen");	break;
-	default:	sprintf (buff, "BAD DECL '%d'", type);
-							break;
-    } /* switch */
-
-    return buff;
-} /* c_type_decl */
-
-
- char *
-new_func_length(Void)
-{ return "ret_val_len"; }
-
- char *
-#ifdef KR_headers
-new_arg_length(arg)
-	Namep arg;
-#else
-new_arg_length(Namep arg)
-#endif
-{
-	static char buf[64];
-	char *fmt = "%s_len", *s = arg->fvarname;
-	switch(*s) {
-	  case 'r':
-		if (!strcmp(s+1, "et_val"))
-			goto adjust_fmt;
-		break;
-	  case 'h':
-	  case 'i':
-		if (!s[1]) {
- adjust_fmt:
-			fmt = "%s_length"; /* avoid conflict with libF77 */
-			}
-	  }
-	sprintf (buf, fmt, s);
-	return buf;
-} /* new_arg_length */
-
-
-/* declare_new_addr -- Add a new local variable to the function, given a
-   pointer to an Addrblock structure (which must have the uname_tag set)
-   This list of idents will be printed in reverse (i.e., chronological)
-   order */
-
- void
-#ifdef KR_headers
-declare_new_addr(addrp)
-	struct Addrblock *addrp;
-#else
-declare_new_addr(struct Addrblock *addrp)
-#endif
-{
-    extern chainp new_vars;
-
-    new_vars = mkchain((char *)cpexpr((expptr)addrp), new_vars);
-} /* declare_new_addr */
-
-
- void
-#ifdef KR_headers
-wr_nv_ident_help(outfile, addrp)
-	FILE *outfile;
-	struct Addrblock *addrp;
-#else
-wr_nv_ident_help(FILE *outfile, struct Addrblock *addrp)
-#endif
-{
-    int eltcount = 0;
-
-    if (addrp == (struct Addrblock *) NULL)
-	return;
-
-    if (addrp -> isarray) {
-	frexpr (addrp -> memoffset);
-	addrp -> memoffset = ICON(0);
-	eltcount = addrp -> ntempelt;
-	addrp -> ntempelt = 0;
-	addrp -> isarray = 0;
-    } /* if */
-    out_addr (outfile, addrp);
-    if (eltcount)
-	nice_printf (outfile, "[%d]", eltcount);
-} /* wr_nv_ident_help */
-
- int
-#ifdef KR_headers
-nv_type_help(addrp)
-	struct Addrblock *addrp;
-#else
-nv_type_help(struct Addrblock *addrp)
-#endif
-{
-    if (addrp == (struct Addrblock *) NULL)
-	return -1;
-
-    return addrp -> vtype;
-} /* nv_type_help */
-
-
-/* lit_name -- returns a unique identifier for the given literal.  Make
-   the label useful, when possible.  For example:
-
-	1 -> c_1		(constant 1)
-	2 -> c_2		(constant 2)
-	1000 -> c_1000		(constant 1000)
-	1000000 -> c_b<memno>	(big constant number)
-	1.2 -> c_1_2		(constant 1.2)
-	1.234345 -> c_b<memno>	(big constant number)
-	-1 -> c_n1		(constant -1)
-	-1.0 -> c_n1_0		(constant -1.0)
-	.true. -> c_true	(constant true)
-	.false. -> c_false	(constant false)
-	default -> c_b<memno>	(default label)
-*/
-
- char *
-#ifdef KR_headers
-lit_name(litp)
-	struct Literal *litp;
-#else
-lit_name(struct Literal *litp)
-#endif
-{
-	static char buf[CONST_IDENT_MAX];
-	ftnint val;
-	char *fmt;
-
-	if (litp == (struct Literal *) NULL)
-		return NULL;
-
-	switch (litp -> littype) {
-	case TYINT1:
-		val = litp -> litval.litival;
-		if (val >= 256 || val < -255)
-			sprintf (buf, "ci1_b%ld", litp -> litnum);
-		else if (val < 0)
-			sprintf (buf, "ci1_n%ld", -val);
-		else
-			sprintf(buf, "ci1__%ld", val);
-		break;
-        case TYSHORT:
-		val = litp -> litval.litival;
-		if (val >= 32768 || val <= -32769)
-			sprintf (buf, "cs_b%ld", litp -> litnum);
-		else if (val < 0)
-			sprintf (buf, "cs_n%ld", -val);
-		else
-			sprintf (buf, "cs__%ld", val);
-		break;
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-		val = litp -> litval.litival;
-		if (val >= 100000 || val <= -10000)
-			sprintf (buf, "c_b%ld", litp -> litnum);
-		else if (val < 0)
-			sprintf (buf, "c_n%ld", -val);
-		else
-			sprintf (buf, "c__%ld", val);
-		break;
-	case TYLOGICAL1:
-		fmt = "cl1_%s";
-		goto spr_logical;
-	case TYLOGICAL2:
-		fmt = "cl2_%s";
-		goto spr_logical;
-	case TYLOGICAL:
-		fmt = "c_%s";
-	spr_logical:
-		sprintf (buf, fmt, (litp -> litval.litival
-					? "true" : "false"));
-		break;
-	case TYREAL:
-	case TYDREAL:
-		/* Given a limit of 6 or 8 character on external names,	*/
-		/* few f.p. values can be meaningfully encoded in the	*/
-		/* constant name.  Just going with the default cb_#	*/
-		/* seems to be the best course for floating-point	*/
-		/* constants.	*/
-	case TYCHAR:
-		/* Shouldn't be any of these */
-	case TYADDR:
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-	case TYSUBR:
-	default:
-		sprintf (buf, "c_b%ld", litp -> litnum);
-    } /* switch */
-    return buf;
-} /* lit_name */
-
-
-
- char *
-#ifdef KR_headers
-comm_union_name(count)
-	int count;
-#else
-comm_union_name(int count)
-#endif
-{
-	static char buf[12];
-
-	sprintf(buf, "%d", count);
-	return buf;
-	}
-
-
-
-
-/* wr_globals -- after every function has been translated, we need to
-   output the global declarations, such as the static table of constant
-   values */
-
- void
-#ifdef KR_headers
-wr_globals(outfile)
-	FILE *outfile;
-#else
-wr_globals(FILE *outfile)
-#endif
-{
-    struct Literal *litp, *lastlit;
-    extern int hsize;
-    char *litname;
-    int did_one, t;
-    struct Constblock cb;
-    ftnint x, y;
-
-    if (nliterals == 0)
-	return;
-
-    lastlit = litpool + nliterals;
-    did_one = 0;
-    for (litp = litpool; litp < lastlit; litp++) {
-	if (!litp->lituse)
-		continue;
-	litname = lit_name(litp);
-	if (!did_one) {
-		margin_printf(outfile, "/* Table of constant values */\n\n");
-		did_one = 1;
-		}
-	cb.vtype = litp->littype;
-	if (litp->littype == TYCHAR) {
-		x = litp->litval.litival2[0] + litp->litval.litival2[1];
-		if (y = x % hsize)
-			x += y = hsize - y;
-		nice_printf(outfile,
-			"static struct { %s fill; char val[%ld+1];", halign, x);
-		nice_printf(outfile, " char fill2[%ld];", hsize - 1);
-		nice_printf(outfile, " } %s_st = { 0,", litname);
-		cb.vleng = ICON(litp->litval.litival2[0]);
-		cb.Const.ccp = litp->cds[0];
-		cb.Const.ccp1.blanks = litp->litval.litival2[1] + y;
-		cb.vtype = TYCHAR;
-		out_const(outfile, &cb);
-		frexpr(cb.vleng);
-		nice_printf(outfile, " };\n");
-		nice_printf(outfile, "#define %s %s_st.val\n", litname, litname);
-		continue;
-		}
-	nice_printf(outfile, "static %s %s = ",
-		c_type_decl(litp->littype,0), litname);
-
-	t = litp->littype;
-	if (ONEOF(t, MSKREAL|MSKCOMPLEX)) {
-		cb.vstg = 1;
-		cb.Const.cds[0] = litp->cds[0];
-		cb.Const.cds[1] = litp->cds[1];
-		}
-	else {
-		memcpy((char *)&cb.Const, (char *)&litp->litval,
-			sizeof(cb.Const));
-		cb.vstg = 0;
-		}
-	out_const(outfile, &cb);
-
-	nice_printf (outfile, ";\n");
-    } /* for */
-    if (did_one)
-    	nice_printf (outfile, "\n");
-} /* wr_globals */
-
- ftnint
-#ifdef KR_headers
-commlen(vl)
-	register chainp vl;
-#else
-commlen(register chainp vl)
-#endif
-{
-	ftnint size;
-	int type;
-	struct Dimblock *t;
-	Namep v;
-
-	while(vl->nextp)
-		vl = vl->nextp;
-	v = (Namep)vl->datap;
-	type = v->vtype;
-	if (type == TYCHAR)
-		size = v->vleng->constblock.Const.ci;
-	else
-		size = typesize[type];
-	if ((t = v->vdim) && ISCONST(t->nelt))
-		size *= t->nelt->constblock.Const.ci;
-	return size + v->voffset;
-	}
-
- static void	/* Pad common block if an EQUIVALENCE extended it. */
-#ifdef KR_headers
-pad_common(c)
-	Extsym *c;
-#else
-pad_common(Extsym *c)
-#endif
-{
-	register chainp cvl;
-	register Namep v;
-	long L = c->maxleng;
-	int type;
-	struct Dimblock *t;
-	int szshort = typesize[TYSHORT];
-
-	for(cvl = c->allextp; cvl; cvl = cvl->nextp)
-		if (commlen((chainp)cvl->datap) >= L)
-			return;
-	v = ALLOC(Nameblock);
-	v->vtype = type = L % szshort ? TYCHAR
-				      : type_choice[L/szshort % 4];
-	v->vstg = STGCOMMON;
-	v->vclass = CLVAR;
-	v->tag = TNAME;
-	v->vdim = t = ALLOC(Dimblock);
-	t->ndim = 1;
-	t->dims[0].dimsize = ICON(L / typesize[type]);
-	v->fvarname = v->cvarname = "eqv_pad";
-	if (type == TYCHAR)
-		v->vleng = ICON(1);
-	c->allextp = mkchain((char *)mkchain((char *)v, CHNULL), c->allextp);
-	}
-
-
-/* wr_common_decls -- outputs the common declarations in one of three
-   formats.  If all references to a common block look the same (field
-   names and types agree), only one actual declaration will appear.
-   Otherwise, the same block will require many structs.  If there is no
-   block data, these structs will be union'ed together (so the linker
-   knows the size of the largest one).  If there IS a block data, only
-   that version will be associated with the variable, others will only be
-   defined as types, so the pointer can be cast to it.  e.g.
-
-	FORTRAN				C
-----------------------------------------------------------------------
-	common /com1/ a, b, c		struct { real a, b, c; } com1_;
-
-	common /com1/ a, b, c		union {
-	common /com1/ i, j, k		    struct { real a, b, c; } _1;
-					    struct { integer i, j, k; } _2;
-					} com1_;
-
-	common /com1/ a, b, c		struct com1_1_ { real a, b, c; };
-	block data			struct { integer i, j, k; } com1_ =
-	common /com1/ i, j, k		  { 1, 2, 3 };
-	data i/1/, j/2/, k/3/
-
-
-   All of these versions will be followed by #defines, since the code in
-   the function bodies can't know ahead of time which of these options
-   will be taken */
-
-/* Macros for deciding the output type */
-
-#define ONE_STRUCT 1
-#define UNION_STRUCT 2
-#define INIT_STRUCT 3
-
- void
-#ifdef KR_headers
-wr_common_decls(outfile)
-	FILE *outfile;
-#else
-wr_common_decls(FILE *outfile)
-#endif
-{
-    Extsym *ext;
-    extern int extcomm;
-    static char *Extern[4] = {"", "Extern ", "extern "};
-    char *E, *E0 = Extern[extcomm];
-    int did_one = 0;
-
-    for (ext = extsymtab; ext < nextext; ext++) {
-	if (ext -> extstg == STGCOMMON && ext->allextp) {
-	    chainp comm;
-	    int count = 1;
-	    int which;			/* which display to use;
-					   ONE_STRUCT, UNION or INIT */
-
-	    if (!did_one)
-		nice_printf (outfile, "/* Common Block Declarations */\n\n");
-
-	    pad_common(ext);
-
-/* Construct the proper, condensed list of structs; eliminate duplicates
-   from the initial list   ext -> allextp   */
-
-	    comm = ext->allextp = revchain(ext->allextp);
-
-	    if (ext -> extinit)
-		which = INIT_STRUCT;
-	    else if (comm->nextp) {
-		which = UNION_STRUCT;
-		nice_printf (outfile, "%sunion {\n", E0);
-		next_tab (outfile);
-		E = "";
-		}
-	    else {
-		which = ONE_STRUCT;
-		E = E0;
-		}
-
-	    for (; comm; comm = comm -> nextp, count++) {
-
-		if (which == INIT_STRUCT)
-		    nice_printf (outfile, "struct %s%d_ {\n",
-			    ext->cextname, count);
-		else
-		    nice_printf (outfile, "%sstruct {\n", E);
-
-		next_tab (c_file);
-
-		wr_struct (outfile, (chainp) comm -> datap);
-
-		prev_tab (c_file);
-		if (which == UNION_STRUCT)
-		    nice_printf (outfile, "} _%d;\n", count);
-		else if (which == ONE_STRUCT)
-		    nice_printf (outfile, "} %s;\n", ext->cextname);
-		else
-		    nice_printf (outfile, "};\n");
-	    } /* for */
-
-	    if (which == UNION_STRUCT) {
-		prev_tab (c_file);
-		nice_printf (outfile, "} %s;\n", ext->cextname);
-	    } /* if */
-	    did_one = 1;
-	    nice_printf (outfile, "\n");
-
-	    for (count = 1, comm = ext -> allextp; comm;
-		    comm = comm -> nextp, count++) {
-		def_start(outfile, ext->cextname,
-			comm_union_name(count), "");
-		switch (which) {
-		    case ONE_STRUCT:
-		        extern_out (outfile, ext);
-		        break;
-		    case UNION_STRUCT:
-		        nice_printf (outfile, "(");
-			extern_out (outfile, ext);
-			nice_printf(outfile, "._%d)", count);
-		        break;
-		    case INIT_STRUCT:
-			nice_printf (outfile, "(*(struct ");
-			extern_out (outfile, ext);
-			nice_printf (outfile, "%d_ *) &", count);
-			extern_out (outfile, ext);
-			nice_printf (outfile, ")");
-		        break;
-		} /* switch */
-		nice_printf (outfile, "\n");
-	    } /* for count = 1, comm = ext -> allextp */
-	    nice_printf (outfile, "\n");
-	} /* if ext -> extstg == STGCOMMON */
-    } /* for ext = extsymtab */
-} /* wr_common_decls */
-
- void
-#ifdef KR_headers
-wr_struct(outfile, var_list)
-	FILE *outfile;
-	chainp var_list;
-#else
-wr_struct(FILE *outfile, chainp var_list)
-#endif
-{
-    int last_type = -1;
-    int did_one = 0;
-    chainp this_var;
-
-    for (this_var = var_list; this_var; this_var = this_var -> nextp) {
-	Namep var = (Namep) this_var -> datap;
-	int type;
-	char *comment = NULL;
-
-	if (var == (Namep) NULL)
-	    err ("wr_struct:  null variable");
-	else if (var -> tag != TNAME)
-	    erri ("wr_struct:  bad tag on variable '%d'",
-		    var -> tag);
-
-	type = var -> vtype;
-
-	if (last_type == type && did_one)
-	    nice_printf (outfile, ", ");
-	else {
-	    if (did_one)
-		nice_printf (outfile, ";\n");
-	    nice_printf (outfile, "%s ",
-		    c_type_decl (type, var -> vclass == CLPROC));
-	} /* else */
-
-/* Character type is really a string type.  Put out a '*' for parameters
-   with unknown length and functions returning character */
-
-	if (var -> vtype == TYCHAR && (!ISICON ((var -> vleng))
-		|| var -> vclass == CLPROC))
-	    nice_printf (outfile, "*");
-
-	var -> vstg = STGAUTO;
-	out_name (outfile, var);
-	if (var -> vclass == CLPROC)
-	    nice_printf (outfile, "()");
-	else if (var -> vdim)
-	    comment = wr_ardecls(outfile, var->vdim,
-				var->vtype == TYCHAR && ISICON(var->vleng)
-				? var->vleng->constblock.Const.ci : 1L);
-	else if (var -> vtype == TYCHAR && var -> vclass != CLPROC &&
-	    ISICON ((var -> vleng)))
-	    nice_printf (outfile, "[%ld]",
-		    var -> vleng -> constblock.Const.ci);
-
-	if (comment)
-	    nice_printf (outfile, "%s", comment);
-	did_one = 1;
-	last_type = type;
-    } /* for this_var */
-
-    if (did_one)
-	nice_printf (outfile, ";\n");
-} /* wr_struct */
-
-
- char *
-#ifdef KR_headers
-user_label(stateno)
-	ftnint stateno;
-#else
-user_label(ftnint stateno)
-#endif
-{
-	static char buf[USER_LABEL_MAX + 1];
-	static char *Lfmt[2] = { "L_%ld", "L%ld" };
-
-	if (stateno >= 0)
-		sprintf(buf, Lfmt[shiftcase], stateno);
-	else
-		sprintf(buf, "L_%s", extsymtab[-1-stateno].fextname);
-	return buf;
-} /* user_label */
-
-
- char *
-#ifdef KR_headers
-temp_name(starter, num, storage)
-	char *starter;
-	int num;
-	char *storage;
-#else
-temp_name(char *starter, int num, char *storage)
-#endif
-{
-    static char buf[IDENT_LEN];
-    char *pointer = buf;
-    char *prefix = "t";
-
-    if (storage)
-	pointer = storage;
-
-    if (starter && *starter)
-	prefix = starter;
-
-    sprintf (pointer, "%s__%d", prefix, num);
-    return pointer;
-} /* temp_name */
-
-
- char *
-#ifdef KR_headers
-equiv_name(memno, store)
-	int memno;
-	char *store;
-#else
-equiv_name(int memno, char *store)
-#endif
-{
-    static char buf[IDENT_LEN];
-    char *pointer = buf;
-
-    if (store)
-	pointer = store;
-
-    sprintf (pointer, "%s_%d", EQUIV_INIT_NAME, memno);
-    return pointer;
-} /* equiv_name */
-
- void
-#ifdef KR_headers
-def_commons(of)
-	FILE *of;
-#else
-def_commons(FILE *of)
-#endif
-{
-	Extsym *ext;
-	int c, onefile, Union;
-	chainp comm;
-	extern int ext1comm;
-	FILE *c_filesave = c_file;
-
-	if (ext1comm == 1) {
-		onefile = 1;
-		c_file = of;
-		fprintf(of, "/*>>>'/dev/null'<<<*/\n\
-#ifdef Define_COMMONs\n\
-/*<<</dev/null>>>*/\n");
-		}
-	else
-		onefile = 0;
-	for(ext = extsymtab; ext < nextext; ext++)
-		if (ext->extstg == STGCOMMON
-		&& !ext->extinit && (comm = ext->allextp)) {
-			sprintf(outbtail, "%scom.c", ext->cextname);
-			if (onefile)
-				fprintf(of, "/*>>>'%s'<<<*/\n",
-					outbtail);
-			else {
-				c_file = of = fopen(outbuf,textwrite);
-				if (!of)
-					fatalstr("can't open %s", outbuf);
-				}
-			fprintf(of, "#include \"f2c.h\"\n");
-			if (Ansi == 2)
-				fprintf(of,
-			 "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n");
-			if (comm->nextp) {
-				Union = 1;
-				nice_printf(of, "union {\n");
-				next_tab(of);
-				}
-			else
-				Union = 0;
-			for(c = 1; comm; comm = comm->nextp) {
-				nice_printf(of, "struct {\n");
-				next_tab(of);
-				wr_struct(of, (chainp)comm->datap);
-				prev_tab(of);
-				if (Union)
-					nice_printf(of, "} _%d;\n", c++);
-				}
-			if (Union)
-				prev_tab(of);
-			nice_printf(of, "} %s;\n", ext->cextname);
-			if (Ansi == 2)
-				fprintf(of,
-			 "\n#ifdef __cplusplus\n}\n#endif\n");
-			if (onefile)
-				fprintf(of, "/*<<<%s>>>*/\n", outbtail);
-			else
-				fclose(of);
-			}
-	if (onefile)
-		fprintf(of, "/*>>>'/dev/null'<<<*/\n#endif\n\
-/*<<</dev/null>>>*/\n");
-	c_file = c_filesave;
-	}
-
-/* C Language keywords.  Needed to filter unwanted fortran identifiers like
- * "int", etc.  Source:  Kernighan & Ritchie, eds. 1 and 2; Stroustrup.
- * Also includes C++ keywords and types used for I/O in f2c.h .
- * These keywords must be in alphabetical order (as defined by strcmp()).
- */
-
-char *c_keywords[] = {
-	"Long", "Multitype", "Namelist", "Vardesc", "abs", "acos",
-	"addr", "address", "aerr", "alist", "asin", "asm", "atan",
-	"atan2", "aunit", "auto", "break", "c", "case", "catch", "cerr",
-	"char", "ciend", "cierr", "cifmt", "cilist", "cirec", "ciunit",
-	"class", "cllist", "complex", "const", "continue", "cos",
-	"cosh", "csta", "cunit", "d", "dabs", "default", "defined",
-	"delete", "dims", "dmax", "dmin", "do", "double",
-	"doublecomplex", "doublereal", "else", "entry", "enum", "exp",
-	"extern", "far", "flag", "float", "for", "friend", "ftnint",
-	"ftnlen", "goto", "h", "huge", "i", "iciend", "icierr",
-	"icifmt", "icilist", "icirlen", "icirnum", "iciunit", "if",
-	"inacc", "inacclen", "inblank", "inblanklen", "include",
-	"indir", "indirlen", "inerr", "inex", "infile", "infilen",
-	"infmt", "infmtlen", "inform", "informlen", "inline", "inlist",
-	"inname", "innamed", "innamlen", "innrec", "innum", "inopen",
-	"inrecl", "inseq", "inseqlen", "int", "integer", "integer1",
-	"inunf", "inunflen", "inunit", "log", "logical", "logical1",
-	"long", "longint", "max", "min", "name", "near", "new", "nvars",
-	"oacc", "oblnk", "oerr", "ofm", "ofnm", "ofnmlen", "olist",
-	"operator", "orl", "osta", "ounit", "overload", "private",
-	"protected", "public", "r", "real", "register", "return",
-	"short", "shortint", "shortlogical", "signed", "sin", "sinh",
-	"sizeof", "sqrt", "static", "struct", "switch", "tan", "tanh",
-	"template", "this", "try", "type", "typedef", "uinteger",
-	"ulongint", "union", "unsigned", "vars", "virtual", "void",
-	"volatile", "while", "z"
-	}; /* c_keywords */
-
-int n_keywords = sizeof(c_keywords)/sizeof(char *);
diff --git a/usr.bin/f2c/names.h b/usr.bin/f2c/names.h
deleted file mode 100644
index 16bcc0b..0000000
--- a/usr.bin/f2c/names.h
+++ /dev/null
@@ -1,19 +0,0 @@
-#define CONST_IDENT_MAX 30
-#define IO_IDENT_MAX 30
-#define ARGUMENT_MAX 30
-#define USER_LABEL_MAX 30
-
-#define EQUIV_INIT_NAME "equiv"
-
-#define write_nv_ident(fp,a) wr_nv_ident_help ((fp), (struct Addrblock *) (a))
-#define nv_type(x) nv_type_help ((struct Addrblock *) x)
-
-extern char *c_keywords[];
-
-char*	c_type_decl Argdcl((int, int));
-void	declare_new_addr Argdcl((Addrp));
-char*	new_arg_length Argdcl((Namep));
-char*	new_func_length Argdcl((void));
-int	nv_type_help Argdcl((Addrp));
-char*	temp_name Argdcl((char*, int, char*));
-char*	user_label Argdcl((long int));
diff --git a/usr.bin/f2c/niceprintf.c b/usr.bin/f2c/niceprintf.c
deleted file mode 100644
index e2d3825..0000000
--- a/usr.bin/f2c/niceprintf.c
+++ /dev/null
@@ -1,445 +0,0 @@
-/****************************************************************
-Copyright 1990, 1991, 1993, 1994 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "names.h"
-#include "output.h"
-#ifndef KR_headers
-#include "stdarg.h"
-#endif
-
-#define TOO_LONG_INDENT (2 * tab_size)
-#define MAX_INDENT 44
-#define MIN_INDENT 22
-static int last_was_newline = 0;
-int sharp_line = 0;
-int indent = 0;
-int in_comment = 0;
-int in_define = 0;
- extern int gflag1;
- extern char filename[];
-
- static void ind_printf Argdcl((int, FILE*, char*, va_list));
-
- static void
-#ifdef KR_headers
-write_indent(fp, use_indent, extra_indent, start, end)
-	FILE *fp;
-	int use_indent;
-	int extra_indent;
-	char *start;
-	char *end;
-#else
-write_indent(FILE *fp, int use_indent, int extra_indent, char *start, char *end)
-#endif
-{
-    int ind, tab;
-
-    if (sharp_line) {
-	fprintf(fp, "#line %ld \"%s\"\n", lineno, filename);
-	sharp_line = 0;
-	}
-    if (in_define == 1) {
-	in_define = 2;
-	use_indent = 0;
-	}
-    if (last_was_newline && use_indent) {
-	if (*start == '\n') do {
-		putc('\n', fp);
-		if (++start > end)
-			return;
-		}
-		while(*start == '\n');
-
-	ind = indent <= MAX_INDENT
-		? indent
-		: MIN_INDENT + indent % (MAX_INDENT - MIN_INDENT);
-
-	tab = ind + extra_indent;
-
-	while (tab > 7) {
-	    putc ('\t', fp);
-	    tab -= 8;
-	} /* while */
-
-	while (tab-- > 0)
-	    putc (' ', fp);
-    } /* if last_was_newline */
-
-    while (start <= end)
-	putc (*start++, fp);
-} /* write_indent */
-
-#ifdef KR_headers
-/*VARARGS2*/
-  void
- margin_printf (fp, a, b, c, d, e, f, g)
-  FILE *fp;
-  char *a;
-  long b, c, d, e, f, g;
-{
-    ind_printf (0, fp, a, b, c, d, e, f, g);
-} /* margin_printf */
-
-/*VARARGS2*/
-  void
- nice_printf (fp, a, b, c, d, e, f, g)
-  FILE *fp;
-  char *a;
-  long b, c, d, e, f, g;
-{
-    ind_printf (1, fp, a, b, c, d, e, f, g);
-} /* nice_printf */
-#define SPRINTF(x,a,b,c,d,e,f,g) sprintf(x,a,b,c,d,e,f,g)
-
-#else /* if (!defined(KR_HEADERS)) */
-
-#define SPRINTF(x,a,b,c,d,e,f,g) vsprintf(x,a,ap)
-
-  void
- margin_printf(FILE *fp, char *fmt, ...)
-{
-	va_list ap;
-	va_start(ap,fmt);
-	ind_printf(0, fp, fmt, ap);
-	va_end(ap);
-	}
-
-  void
- nice_printf(FILE *fp, char *fmt, ...)
-{
-	va_list ap;
-	va_start(ap,fmt);
-	ind_printf(1, fp, fmt, ap);
-	va_end(ap);
-	}
-#endif
-
-#define  max_line_len c_output_line_length
- 		/* 74Number of characters allowed on an output
-			           line.  This assumes newlines are handled
-			           nicely, i.e. a newline after a full text
-			           line on a terminal is ignored */
-
-/* output_buf   holds the text of the next line to be printed.  It gets
-   flushed when a newline is printed.   next_slot   points to the next
-   available location in the output buffer, i.e. where the next call to
-   nice_printf will have its output stored */
-
-static char *output_buf;
-static char *next_slot;
-static char *string_start;
-
-static char *word_start = NULL;
-static int cursor_pos = 0;
-static int In_string = 0;
-
- void
-np_init(Void)
-{
-	next_slot = output_buf = Alloc(MAX_OUTPUT_SIZE);
-	memset(output_buf, 0, MAX_OUTPUT_SIZE);
-	}
-
- static char *
-#ifdef KR_headers
-adjust_pointer_in_string(pointer)
-	register char *pointer;
-#else
-adjust_pointer_in_string(register char *pointer)
-#endif
-{
-	register char *s, *s1, *se, *s0;
-
-	/* arrange not to break \002 */
-	s1 = string_start ? string_start : output_buf;
-	for(s = s1; s < pointer; s++) {
-		s0 = s1;
-		s1 = s;
-		if (*s == '\\') {
-			se = s++ + 4;
-			if (se > pointer)
-				break;
-			if (*s < '0' || *s > '7')
-				continue;
-			while(++s < se)
-				if (*s < '0' || *s > '7')
-					break;
-			--s;
-			}
-		}
-	return s0 - 1;
-	}
-
-/* ANSI says strcpy's behavior is undefined for overlapping args,
- * so we roll our own fwd_strcpy: */
-
- static void
-#ifdef KR_headers
-fwd_strcpy(t, s)
-	register char *t;
-	register char *s;
-#else
-fwd_strcpy(register char *t, register char *s)
-#endif
-{ while(*t++ = *s++); }
-
-/* isident -- true iff character could belong to a unit.  C allows
-   letters, numbers and underscores in identifiers.  This also doubles as
-   a check for numeric constants, since we include the decimal point and
-   minus sign.  The minus has to be here, since the constant "10e-2"
-   cannot be broken up.  The '.' also prevents structure references from
-   being broken, which is a quite acceptable side effect */
-
-#define isident(x) (Tr[x] & 1)
-#define isntident(x) (!Tr[x])
-
-  static void
-#ifdef KR_headers
- ind_printf (use_indent, fp, a, b, c, d, e, f, g)
-  int use_indent;
-  FILE *fp;
-  char *a;
-  long b, c, d, e, f, g;
-#else
- ind_printf (int use_indent, FILE *fp, char *a, va_list ap)
-#endif
-{
-    extern int max_line_len;
-    extern FILEP c_file;
-    extern char tr_tab[];	/* in output.c */
-    register char *Tr = tr_tab;
-    int ch, cmax, inc, ind;
-    static int extra_indent, last_indent, set_cursor = 1;
-
-    cursor_pos += indent - last_indent;
-    last_indent = indent;
-    SPRINTF (next_slot, a, b, c, d, e, f, g);
-
-    if (fp != c_file) {
-	fprintf (fp,"%s", next_slot);
-	return;
-    } /* if fp != c_file */
-
-    do {
-	char *pointer;
-
-/* The   for   loop will parse one output line */
-
-	if (set_cursor) {
-		ind = indent <= MAX_INDENT
-			? indent
-			: MIN_INDENT + indent % (MAX_INDENT - MIN_INDENT);
-		cursor_pos = extra_indent;
-		if (use_indent)
-			cursor_pos += ind;
-		set_cursor = 0;
-		}
-	if (in_comment) {
-		cmax = max_line_len + 32;	/* let comments be wider */
-        	for (pointer = next_slot; *pointer && *pointer != '\n' &&
-				cursor_pos <= cmax; pointer++)
-			cursor_pos++;
-		}
-	else
-          for (pointer = next_slot; *pointer && *pointer != '\n' &&
-		cursor_pos <= max_line_len; pointer++) {
-
-	    /* Update state variables here */
-
-	    if (In_string) {
-		switch(*pointer) {
-			case '\\':
-				if (++cursor_pos > max_line_len) {
-					cursor_pos -= 2;
-					--pointer;
-					goto overflow;
-					}
-				++pointer;
-				break;
-			case '"':
-				In_string = 0;
-				word_start = 0;
-			}
-		}
-	    else switch (*pointer) {
-	        case '"':
-			if (cursor_pos + 5 > max_line_len) {
-				word_start = 0;
-				--pointer;
-				goto overflow;
-				}
-			In_string = 1;
-			string_start = word_start = pointer;
-		    	break;
-	        case '\'':
-			if (pointer[1] == '\\')
-				if ((ch = pointer[2]) >= '0' && ch <= '7')
-					for(inc = 3; pointer[inc] != '\''
-						&& ++inc < 5;);
-				else
-					inc = 3;
-			else
-				inc = 2;
-			/*debug*/ if (pointer[inc] != '\'')
-			/*debug*/  fatalstr("Bad character constant %.10s",
-					pointer);
-			if ((cursor_pos += inc) > max_line_len) {
-				cursor_pos -= inc;
-				word_start = 0;
-				--pointer;
-				goto overflow;
-				}
-			word_start = pointer;
-			pointer += inc;
-			break;
-		case '\t':
-		    cursor_pos = 8 * ((cursor_pos + 8) / 8) - 1;
-		    break;
-		default: {
-
-/* HACK  Assumes that all characters in an atomic C token will be written
-   at the same time.  Must check for tokens first, since '-' is considered
-   part of an identifier; checking isident first would mean breaking up "->" */
-
-		    if (word_start) {
-			if (isntident(*(unsigned char *)pointer))
-				word_start = NULL;
-			}
-		    else if (isident(*(unsigned char *)pointer))
-			word_start = pointer;
-		    break;
-		} /* default */
-	    } /* switch */
-	    cursor_pos++;
-	} /* for pointer = next_slot */
- overflow:
-	if (*pointer == '\0') {
-
-/* The output line is not complete, so break out and don't output
-   anything.  The current line fragment will be stored in the buffer */
-
-	    next_slot = pointer;
-	    break;
-	} else {
-	    char last_char;
-	    int in_string0 = In_string;
-
-/* If the line was too long, move   pointer   back to the character before
-   the current word.  This allows line breaking on word boundaries.  Make
-   sure that 80 character comment lines get broken up somehow.  We assume
-   that any non-string 80 character identifier must be in a comment.
-*/
-
-	    if (*pointer == '\n')
-		in_define = 0;
-	    else if (word_start && word_start > output_buf)
-		if (In_string)
-			if (string_start && pointer - string_start < 5)
-				pointer = string_start - 1;
-			else {
-				pointer = adjust_pointer_in_string(pointer);
-				string_start = 0;
-				}
-		else if (word_start == string_start
-				&& pointer - string_start >= 5) {
-			pointer = adjust_pointer_in_string(next_slot);
-			In_string = 1;
-			string_start = 0;
-			}
-		else
-			pointer = word_start - 1;
-	    else if (cursor_pos > max_line_len) {
-#ifndef ANSI_Libraries
-		extern char *strchr();
-#endif
-		if (In_string) {
-			pointer = adjust_pointer_in_string(pointer);
-			if (string_start && pointer > string_start)
-				string_start = 0;
-			}
-		else if (strchr("&*+-/<=>|", *pointer)
-			&& strchr("!%&*+-/<=>^|", pointer[-1])) {
-			pointer -= 2;
-			if (strchr("<>", *pointer)) /* <<=, >>= */
-				pointer--;
-			}
-		else {
-			if (word_start)
-				while(isident(*(unsigned char *)pointer))
-					pointer++;
-			pointer--;
-			}
-		}
-	    last_char = *pointer;
-	    write_indent(fp, use_indent, extra_indent, output_buf, pointer);
-	    next_slot = output_buf;
-	    if (In_string && !string_start && Ansi == 1 && last_char != '\n')
-		*next_slot++ = '"';
-	    fwd_strcpy(next_slot, pointer + 1);
-
-/* insert a line break */
-
-	    if (last_char == '\n') {
-		if (In_string)
-			last_was_newline = 0;
-		else {
-			last_was_newline = 1;
-			extra_indent = 0;
-			sharp_line = gflag1;
-			}
-		}
-	    else {
-		extra_indent = TOO_LONG_INDENT;
-		if (In_string && !string_start) {
-			if (Ansi == 1) {
-				fprintf(fp, gflag1 ? "\"\\\n" : "\"\n");
-				use_indent = 1;
-				last_was_newline = 1;
-				}
-			else {
-				fprintf(fp, "\\\n");
-				last_was_newline = 0;
-				}
-			In_string = in_string0;
-			}
-		else {
-			if (in_define/* | gflag1*/)
-				putc('\\', fp);
-			putc ('\n', fp);
-			last_was_newline = 1;
-			}
-	    } /* if *pointer != '\n' */
-
-	    if (In_string && Ansi != 1 && !string_start)
-		cursor_pos = 0;
-	    else
-		set_cursor = 1;
-
-	    string_start = word_start = NULL;
-
-	} /* else */
-
-    } while (*next_slot);
-
-} /* ind_printf */
diff --git a/usr.bin/f2c/niceprintf.h b/usr.bin/f2c/niceprintf.h
deleted file mode 100644
index 24c65d4..0000000
--- a/usr.bin/f2c/niceprintf.h
+++ /dev/null
@@ -1,16 +0,0 @@
-/* niceprintf.h -- contains constants and macros from the output filter
-   for the generated C code.  We use macros for increased speed, less
-   function overhead.  */
-
-#define MAX_OUTPUT_SIZE 6000	/* Number of chars on one output line PLUS
-				   the length of the longest string
-				   printed using   nice_printf   */
-
-
-
-#define next_tab(fp) (indent += tab_size)
-
-#define prev_tab(fp) (indent -= tab_size)
-
-
-
diff --git a/usr.bin/f2c/output.c b/usr.bin/f2c/output.c
deleted file mode 100644
index 5f650e7..0000000
--- a/usr.bin/f2c/output.c
+++ /dev/null
@@ -1,1711 +0,0 @@
-/****************************************************************
-Copyright 1990 - 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "names.h"
-#include "output.h"
-
-#ifndef TRUE
-#define TRUE 1
-#endif
-#ifndef FALSE
-#define FALSE 0
-#endif
-
-char _assoc_table[] = { 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0 };
-
-/* Opcode table -- This array is indexed by the OP_____ macros defined in
-   defines.h; these macros are expected to be adjacent integers, so that
-   this table is as small as possible. */
-
-table_entry opcode_table[] = {
-				{ 0, 0, NULL },
-	/* OPPLUS 1 */		{ BINARY_OP, 12, "%l + %r" },
-	/* OPMINUS 2 */		{ BINARY_OP, 12, "%l - %r" },
-	/* OPSTAR 3 */		{ BINARY_OP, 13, "%l * %r" },
-	/* OPSLASH 4 */		{ BINARY_OP, 13, "%l / %r" },
-	/* OPPOWER 5 */		{ BINARY_OP,  0, "power (%l, %r)" },
-	/* OPNEG 6 */		{ UNARY_OP,  14, "-%l" },
-	/* OPOR 7 */		{ BINARY_OP,  4, "%l || %r" },
-	/* OPAND 8 */		{ BINARY_OP,  5, "%l && %r" },
-	/* OPEQV 9 */		{ BINARY_OP,  9, "%l == %r" },
-	/* OPNEQV 10 */		{ BINARY_OP,  9, "%l != %r" },
-	/* OPNOT 11 */		{ UNARY_OP,  14, "! %l" },
-	/* OPCONCAT 12 */	{ BINARY_OP,  0, "concat (%l, %r)" },
-	/* OPLT 13 */		{ BINARY_OP, 10, "%l < %r" },
-	/* OPEQ 14 */		{ BINARY_OP,  9, "%l == %r" },
-	/* OPGT 15 */		{ BINARY_OP, 10, "%l > %r" },
-	/* OPLE 16 */		{ BINARY_OP, 10, "%l <= %r" },
-	/* OPNE 17 */		{ BINARY_OP,  9, "%l != %r" },
-	/* OPGE 18 */		{ BINARY_OP, 10, "%l >= %r" },
-	/* OPCALL 19 */		{ BINARY_OP, 15, SPECIAL_FMT },
-	/* OPCCALL 20 */	{ BINARY_OP, 15, SPECIAL_FMT },
-
-/* Left hand side of an assignment cannot have outermost parens */
-
-	/* OPASSIGN 21 */	{ BINARY_OP,  2, "%l = %r" },
-	/* OPPLUSEQ 22 */	{ BINARY_OP,  2, "%l += %r" },
-	/* OPSTAREQ 23 */	{ BINARY_OP,  2, "%l *= %r" },
-	/* OPCONV 24 */		{ BINARY_OP, 14, "%l" },
-	/* OPLSHIFT 25 */	{ BINARY_OP, 11, "%l << %r" },
-	/* OPMOD 26 */		{ BINARY_OP, 13, "%l %% %r" },
-	/* OPCOMMA 27 */	{ BINARY_OP,  1, "%l, %r" },
-
-/* Don't want to nest the colon operator in parens */
-
-	/* OPQUEST 28 */	{ BINARY_OP, 3, "%l ? %r" },
-	/* OPCOLON 29 */	{ BINARY_OP, 3, "%l : %r" },
-	/* OPABS 30 */		{ UNARY_OP,  0, "abs(%l)" },
-	/* OPMIN 31 */		{ BINARY_OP,   0, SPECIAL_FMT },
-	/* OPMAX 32 */		{ BINARY_OP,   0, SPECIAL_FMT },
-	/* OPADDR 33 */		{ UNARY_OP, 14, "&%l" },
-
-	/* OPCOMMA_ARG 34 */	{ BINARY_OP, 15, SPECIAL_FMT },
-	/* OPBITOR 35 */	{ BINARY_OP,  6, "%l | %r" },
-	/* OPBITAND 36 */	{ BINARY_OP,  8, "%l & %r" },
-	/* OPBITXOR 37 */	{ BINARY_OP,  7, "%l ^ %r" },
-	/* OPBITNOT 38 */	{ UNARY_OP,  14, "~ %l" },
-	/* OPRSHIFT 39 */	{ BINARY_OP, 11, "%l >> %r" },
-
-/* This isn't quite right -- it doesn't handle arrays, for instance */
-
-	/* OPWHATSIN 40 */	{ UNARY_OP,  14, "*%l" },
-	/* OPMINUSEQ 41 */	{ BINARY_OP,  2, "%l -= %r" },
-	/* OPSLASHEQ 42 */	{ BINARY_OP,  2, "%l /= %r" },
-	/* OPMODEQ 43 */	{ BINARY_OP,  2, "%l %%= %r" },
-	/* OPLSHIFTEQ 44 */	{ BINARY_OP,  2, "%l <<= %r" },
-	/* OPRSHIFTEQ 45 */	{ BINARY_OP,  2, "%l >>= %r" },
-	/* OPBITANDEQ 46 */	{ BINARY_OP,  2, "%l &= %r" },
-	/* OPBITXOREQ 47 */	{ BINARY_OP,  2, "%l ^= %r" },
-	/* OPBITOREQ 48 */	{ BINARY_OP,  2, "%l |= %r" },
-	/* OPPREINC 49 */	{ UNARY_OP,  14, "++%l" },
-	/* OPPREDEC 50 */	{ UNARY_OP,  14, "--%l" },
-	/* OPDOT 51 */		{ BINARY_OP, 15, "%l.%r" },
-	/* OPARROW 52 */	{ BINARY_OP, 15, "%l -> %r"},
-	/* OPNEG1 53 */		{ UNARY_OP,  14, "-%l" },
-	/* OPDMIN 54 */		{ BINARY_OP, 0, "dmin(%l,%r)" },
-	/* OPDMAX 55 */		{ BINARY_OP, 0, "dmax(%l,%r)" },
-	/* OPASSIGNI 56 */	{ BINARY_OP,  2, "%l = &%r" },
-	/* OPIDENTITY 57 */	{ UNARY_OP, 15, "%l" },
-	/* OPCHARCAST 58 */	{ UNARY_OP, 14, "(char *)&%l" },
-	/* OPDABS 59 */		{ UNARY_OP, 0, "dabs(%l)" },
-	/* OPMIN2 60 */		{ BINARY_OP,   0, "min(%l,%r)" },
-	/* OPMAX2 61 */		{ BINARY_OP,   0, "max(%l,%r)" },
-	/* OPBITTEST 62 */	{ BINARY_OP,   0, "bit_test(%l,%r)" },
-	/* OPBITCLR 63 */	{ BINARY_OP,   0, "bit_clear(%l,%r)" },
-	/* OPBITSET 64 */	{ BINARY_OP,   0, "bit_set(%l,%r)" },
-#ifdef TYQUAD
-	/* OPQBITCLR 65 */	{ BINARY_OP,   0, "qbit_clear(%l,%r)" },
-	/* OPQBITSET 66 */	{ BINARY_OP,   0, "qbit_set(%l,%r)" },
-#endif
-
-/* kludge to imitate (under forcedouble) f77's bizarre treatement of OPNEG... */
-
-	/* OPNEG KLUDGE */	{ UNARY_OP,  14, "-(doublereal)%l" }
-}; /* opcode_table */
-
-#define OPNEG_KLUDGE (sizeof(opcode_table)/sizeof(table_entry) - 1)
-
-extern int dneg;
-static char opeqable[sizeof(opcode_table)/sizeof(table_entry)];
-
-
-static void output_arg_list Argdcl((FILEP, struct Listblock*));
-static void output_binary Argdcl((FILEP, Exprp));
-static void output_list Argdcl((FILEP, struct Listblock*));
-static void output_literal Argdcl((FILEP, long, Constp));
-static void output_prim Argdcl((FILEP, struct Primblock*));
-static void output_unary Argdcl((FILEP, Exprp));
-
-
- void
-#ifdef KR_headers
-expr_out(fp, e)
-	FILE *fp;
-	expptr e;
-#else
-expr_out(FILE *fp, expptr e)
-#endif
-{
-    if (e == (expptr) NULL)
-	return;
-
-    switch (e -> tag) {
-	case TNAME:	out_name (fp, (struct Nameblock *) e);
-			return;
-
-	case TCONST:	out_const(fp, &e->constblock);
-			goto end_out;
-	case TEXPR:
-	    		break;
-
-	case TADDR:	out_addr (fp, &(e -> addrblock));
-			goto end_out;
-
-	case TPRIM:	if (!nerr)
-				warn ("expr_out: got TPRIM");
-			output_prim (fp, &(e -> primblock));
-			return;
-
-	case TLIST:	output_list (fp, &(e -> listblock));
- end_out:		frexpr(e);
-			return;
-
-	case TIMPLDO:	err ("expr_out: got TIMPLDO");
-			return;
-
-	case TERROR:
-	default:
-			erri ("expr_out: bad tag '%d'", e -> tag);
-    } /* switch */
-
-/* Now we know that the tag is TEXPR */
-
-/* Optimize on simple expressions, such as "a = a + b" ==> "a += b" */
-
-    if (e -> exprblock.opcode == OPASSIGN && e -> exprblock.rightp &&
-	e -> exprblock.rightp -> tag == TEXPR) {
-	int opcode;
-
-	opcode = e -> exprblock.rightp -> exprblock.opcode;
-
-	if (opeqable[opcode]) {
-	    expptr leftp, rightp;
-
-	    if ((leftp = e -> exprblock.leftp) &&
-		(rightp = e -> exprblock.rightp -> exprblock.leftp)) {
-
-		if (same_ident (leftp, rightp)) {
-		    expptr temp = e -> exprblock.rightp;
-
-		    e -> exprblock.opcode = op_assign(opcode);
-
-		    e -> exprblock.rightp = temp -> exprblock.rightp;
-		    temp->exprblock.rightp = 0;
-		    frexpr(temp);
-		} /* if same_ident (leftp, rightp) */
-	    } /* if leftp && rightp */
-	} /* if opcode == OPPLUS || */
-    } /* if e -> exprblock.opcode == OPASSIGN */
-
-
-/* Optimize on increment or decrement by 1 */
-
-    {
-	int opcode = e -> exprblock.opcode;
-	expptr leftp = e -> exprblock.leftp;
-	expptr rightp = e -> exprblock.rightp;
-
-	if (leftp && rightp && (leftp -> headblock.vstg == STGARG ||
-		ISINT (leftp -> headblock.vtype)) &&
-		(opcode == OPPLUSEQ || opcode == OPMINUSEQ) &&
-		ISINT (rightp -> headblock.vtype) &&
-		ISICON (e -> exprblock.rightp) &&
-		(ISONE (e -> exprblock.rightp) ||
-		e -> exprblock.rightp -> constblock.Const.ci == -1)) {
-
-/* Allow for the '-1' constant value */
-
-	    if (!ISONE (e -> exprblock.rightp))
-		opcode = (opcode == OPPLUSEQ) ? OPMINUSEQ : OPPLUSEQ;
-
-/* replace the existing opcode */
-
-	    if (opcode == OPPLUSEQ)
-		e -> exprblock.opcode = OPPREINC;
-	    else
-		e -> exprblock.opcode = OPPREDEC;
-
-/* Free up storage used by the right hand side */
-
-	    frexpr (e -> exprblock.rightp);
-	    e->exprblock.rightp = 0;
-	} /* if opcode == OPPLUS */
-    } /* block */
-
-
-    if (is_unary_op (e -> exprblock.opcode))
-	output_unary (fp, &(e -> exprblock));
-    else if (is_binary_op (e -> exprblock.opcode))
-	output_binary (fp, &(e -> exprblock));
-    else
-	erri ("expr_out: bad opcode '%d'", (int) e -> exprblock.opcode);
-
-    free((char *)e);
-
-} /* expr_out */
-
-
- void
-#ifdef KR_headers
-out_and_free_statement(outfile, expr)
-	FILE *outfile;
-	expptr expr;
-#else
-out_and_free_statement(FILE *outfile, expptr expr)
-#endif
-{
-    if (expr)
-	expr_out (outfile, expr);
-
-    nice_printf (outfile, ";\n");
-} /* out_and_free_statement */
-
-
-
- int
-#ifdef KR_headers
-same_ident(left, right)
-	expptr left;
-	expptr right;
-#else
-same_ident(expptr left, expptr right)
-#endif
-{
-    if (!left || !right)
-	return 0;
-
-    if (left -> tag == TNAME && right -> tag == TNAME && left == right)
-	return 1;
-
-    if (left -> tag == TADDR && right -> tag == TADDR &&
-	    left -> addrblock.uname_tag == right -> addrblock.uname_tag)
-	switch (left -> addrblock.uname_tag) {
-	    case UNAM_REF:
-	    case UNAM_NAME:
-
-/* Check for array subscripts */
-
-		if (left -> addrblock.user.name -> vdim ||
-			right -> addrblock.user.name -> vdim)
-		    if (left -> addrblock.user.name !=
-			    right -> addrblock.user.name ||
-			    !same_expr (left -> addrblock.memoffset,
-			    right -> addrblock.memoffset))
-			return 0;
-
-		return same_ident ((expptr) (left -> addrblock.user.name),
-			(expptr) right -> addrblock.user.name);
-	    case UNAM_IDENT:
-		return strcmp(left->addrblock.user.ident,
-				right->addrblock.user.ident) == 0;
-	    case UNAM_CHARP:
-		return strcmp(left->addrblock.user.Charp,
-				right->addrblock.user.Charp) == 0;
-	    default:
-	        return 0;
-	} /* switch */
-
-    if (left->tag == TEXPR && left->exprblock.opcode == OPWHATSIN
-	&& right->tag == TEXPR && right->exprblock.opcode == OPWHATSIN)
-		return same_ident(left->exprblock.leftp,
-				 right->exprblock.leftp);
-
-    return 0;
-} /* same_ident */
-
- static int
-#ifdef KR_headers
-samefpconst(c1, c2, n)
-	register Constp c1;
-	register Constp c2;
-	register int n;
-#else
-samefpconst(register Constp c1, register Constp c2, register int n)
-#endif
-{
-	char *s1, *s2;
-	if (!c1->vstg && !c2->vstg)
-		return c1->Const.cd[n] == c2->Const.cd[n];
-	s1 = c1->vstg ? c1->Const.cds[n] : dtos(c1->Const.cd[n]);
-	s2 = c2->vstg ? c2->Const.cds[n] : dtos(c2->Const.cd[n]);
-	return !strcmp(s1, s2);
-	}
-
- static int
-#ifdef KR_headers
-sameconst(c1, c2)
-	register Constp c1;
-	register Constp c2;
-#else
-sameconst(register Constp c1, register Constp c2)
-#endif
-{
-	switch(c1->vtype) {
-		case TYCOMPLEX:
-		case TYDCOMPLEX:
-			if (!samefpconst(c1,c2,1))
-				return 0;
-		case TYREAL:
-		case TYDREAL:
-			return samefpconst(c1,c2,0);
-		case TYCHAR:
-			return c1->Const.ccp1.blanks == c2->Const.ccp1.blanks
-			    &&	   c1->vleng->constblock.Const.ci
-				== c2->vleng->constblock.Const.ci
-			    && !memcmp(c1->Const.ccp, c2->Const.ccp,
-					(int)c1->vleng->constblock.Const.ci);
-		case TYSHORT:
-		case TYINT:
-		case TYLOGICAL:
-			return c1->Const.ci == c2->Const.ci;
-		}
-	err("unexpected type in sameconst");
-	return 0;
-	}
-
-/* same_expr -- Returns true only if   e1 and e2   match.  This is
-   somewhat pessimistic, but can afford to be because it's just used to
-   optimize on the assignment operators (+=, -=, etc). */
-
- int
-#ifdef KR_headers
-same_expr(e1, e2)
-	expptr e1;
-	expptr e2;
-#else
-same_expr(expptr e1, expptr e2)
-#endif
-{
-    if (!e1 || !e2)
-	return !e1 && !e2;
-
-    if (e1 -> tag != e2 -> tag || e1 -> headblock.vtype != e2 -> headblock.vtype)
-	return 0;
-
-    switch (e1 -> tag) {
-        case TEXPR:
-	    if (e1 -> exprblock.opcode != e2 -> exprblock.opcode)
-		return 0;
-
-	    return same_expr (e1 -> exprblock.leftp, e2 -> exprblock.leftp) &&
-		   same_expr (e1 -> exprblock.rightp, e2 -> exprblock.rightp);
-	case TNAME:
-	case TADDR:
-	    return same_ident (e1, e2);
-	case TCONST:
-	    return sameconst(&e1->constblock, &e2->constblock);
-	default:
-	    return 0;
-    } /* switch */
-} /* same_expr */
-
-
-
- void
-#ifdef KR_headers
-out_name(fp, namep)
-	FILE *fp;
-	Namep namep;
-#else
-out_name(FILE *fp, Namep namep)
-#endif
-{
-    extern int usedefsforcommon;
-    Extsym *comm;
-
-    if (namep == NULL)
-	return;
-
-/* DON'T want to use oneof_stg() here; need to find the right common name
-   */
-
-    if (namep->vstg == STGCOMMON && !namep->vcommequiv && !usedefsforcommon) {
-	comm = &extsymtab[namep->vardesc.varno];
-	extern_out(fp, comm);
-	nice_printf(fp, "%d.", comm->curno);
-    } /* if namep -> vstg == STGCOMMON */
-
-    if (namep->vprocclass == PTHISPROC && namep->vtype != TYSUBR)
-	nice_printf(fp, xretslot[namep->vtype]->user.ident);
-    else
-	nice_printf (fp, "%s", namep->cvarname);
-} /* out_name */
-
-
-#define cpd(n) cp->vstg ? cp->Const.cds[n] : dtos(cp->Const.cd[n])
-
- void
-#ifdef KR_headers
-out_const(fp, cp)
-	FILE *fp;
-	register Constp cp;
-#else
-out_const(FILE *fp, register Constp cp)
-#endif
-{
-    static char real_buf[50], imag_buf[50];
-    unsigned int k;
-    int type = cp->vtype;
-
-    switch (type) {
-	case TYINT1:
-        case TYSHORT:
-	    nice_printf (fp, "%ld", cp->Const.ci);	/* don't cast ci! */
-	    break;
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-	    nice_printf (fp, "%ld", cp->Const.ci);	/* don't cast ci! */
-	    break;
-	case TYREAL:
-	    nice_printf(fp, "%s", flconst(real_buf, cpd(0)));
-	    break;
-	case TYDREAL:
-	    nice_printf(fp, "%s", cpd(0));
-	    break;
-	case TYCOMPLEX:
-	    nice_printf(fp, cm_fmt_string, flconst(real_buf, cpd(0)),
-			flconst(imag_buf, cpd(1)));
-	    break;
-	case TYDCOMPLEX:
-	    nice_printf(fp, dcm_fmt_string, cpd(0), cpd(1));
-	    break;
-	case TYLOGICAL1:
-	case TYLOGICAL2:
-	case TYLOGICAL:
-	    nice_printf (fp, "%s", cp->Const.ci ? "TRUE_" : "FALSE_");
-	    break;
-	case TYCHAR: {
-	    char *c = cp->Const.ccp, *ce;
-
-	    if (c == NULL) {
-		nice_printf (fp, "\"\"");
-		break;
-	    } /* if c == NULL */
-
-	    nice_printf (fp, "\"");
-	    ce = c + cp->vleng->constblock.Const.ci;
-	    while(c < ce) {
-		k = *(unsigned char *)c++;
-		nice_printf(fp, str_fmt[k], k);
-		}
-	    for(k = cp->Const.ccp1.blanks; k > 0; k--)
-		nice_printf(fp, " ");
-	    nice_printf (fp, "\"");
-	    break;
-	} /* case TYCHAR */
-	default:
-	    erri ("out_const:  bad type '%d'", (int) type);
-	    break;
-    } /* switch */
-
-} /* out_const */
-#undef cpd
-
- static void
-#ifdef KR_headers
-out_args(fp, ep)
-	FILE *fp;
-	expptr ep;
-#else
-out_args(FILE *fp, expptr ep)
-#endif
-{
-	chainp arglist;
-
-	if(ep->tag != TLIST)
-		badtag("out_args", ep->tag);
-	for(arglist = ep->listblock.listp;;) {
-		expr_out(fp, (expptr)arglist->datap);
-		arglist->datap = 0;
-		if (!(arglist = arglist->nextp))
-			break;
-		nice_printf(fp, ", ");
-		}
-	}
-
-
-/* out_addr -- this routine isn't local because it is called by the
-   system-generated identifier printing routines */
-
- void
-#ifdef KR_headers
-out_addr(fp, addrp)
-	FILE *fp;
-	struct Addrblock *addrp;
-#else
-out_addr(FILE *fp, struct Addrblock *addrp)
-#endif
-{
-	extern Extsym *extsymtab;
-	int was_array = 0;
-	char *s;
-
-
-	if (addrp == NULL)
-		return;
-	if (doin_setbound
-			&& addrp->vstg == STGARG
-			&& addrp->vtype != TYCHAR
-			&& ISICON(addrp->memoffset)
-			&& !addrp->memoffset->constblock.Const.ci)
-		nice_printf(fp, "*");
-
-	switch (addrp -> uname_tag) {
-	    case UNAM_REF:
-		nice_printf(fp, "%s_%s(", addrp->user.name->cvarname,
-			addrp->cmplx_sub ? "subscr" : "ref");
-		out_args(fp, addrp->memoffset);
-		nice_printf(fp, ")");
-		return;
-	    case UNAM_NAME:
-		out_name (fp, addrp -> user.name);
-		break;
-	    case UNAM_IDENT:
-		if (*(s = addrp->user.ident) == ' ') {
-			if (multitype)
-				nice_printf(fp, "%s",
-					xretslot[addrp->vtype]->user.ident);
-			else
-				nice_printf(fp, "%s", s+1);
-			}
-		else {
-			nice_printf(fp, "%s", s);
-			}
-		break;
-	    case UNAM_CHARP:
-		nice_printf(fp, "%s", addrp->user.Charp);
-		break;
-	    case UNAM_EXTERN:
-		extern_out (fp, &extsymtab[addrp -> memno]);
-		break;
-	    case UNAM_CONST:
-		switch(addrp->vstg) {
-			case STGCONST:
-				out_const(fp, (Constp)addrp);
-				break;
-			case STGMEMNO:
-				output_literal (fp, addrp->memno,
-					(Constp)addrp);
-				break;
-			default:
-			Fatal("unexpected vstg in out_addr");
-			}
-		break;
-	    case UNAM_UNKNOWN:
-	    default:
-		nice_printf (fp, "Unknown Addrp");
-		break;
-	} /* switch */
-
-/* It's okay to just throw in the brackets here because they have a
-   precedence level of 15, the highest value.  */
-
-    if ((addrp->uname_tag == UNAM_NAME && addrp->user.name->vdim
-			|| addrp->ntempelt > 1 || addrp->isarray)
-	&& addrp->vtype != TYCHAR) {
-	expptr offset;
-
-	was_array = 1;
-
-	offset = addrp -> memoffset;
-	addrp->memoffset = 0;
-	if (ONEOF(addrp->vstg, M(STGCOMMON)|M(STGEQUIV))
-		&& addrp -> uname_tag == UNAM_NAME
-		&& !addrp->skip_offset)
-	    offset = mkexpr (OPMINUS, offset, mkintcon (
-		    addrp -> user.name -> voffset));
-
-	nice_printf (fp, "[");
-
-	offset = mkexpr (OPSLASH, offset,
-		ICON (typesize[addrp -> vtype] * (addrp -> Field ? 2 : 1)));
-	expr_out (fp, offset);
-	nice_printf (fp, "]");
-	}
-
-/* Check for structure field reference */
-
-    if (addrp -> Field && addrp -> uname_tag != UNAM_CONST &&
-	    addrp -> uname_tag != UNAM_UNKNOWN) {
-	if (oneof_stg((addrp -> uname_tag == UNAM_NAME ? addrp -> user.name :
-		(Namep) NULL), addrp -> vstg, M(STGARG)|M(STGEQUIV))
-		&& !was_array && (addrp->vclass != CLPROC || !multitype))
-	    nice_printf (fp, "->%s", addrp -> Field);
-	else
-	    nice_printf (fp, ".%s", addrp -> Field);
-    } /* if */
-
-/* Check for character subscripting */
-
-    if (addrp->vtype == TYCHAR &&
-	    (addrp->vclass != CLPROC || addrp->uname_tag == UNAM_NAME
-			&& addrp->user.name->vprocclass == PTHISPROC) &&
-	    addrp -> memoffset &&
-	    (addrp -> uname_tag != UNAM_NAME ||
-	     addrp -> user.name -> vtype == TYCHAR) &&
-	    (!ISICON (addrp -> memoffset) ||
-	     (addrp -> memoffset -> constblock.Const.ci))) {
-
-	int use_paren = 0;
-	expptr e = addrp -> memoffset;
-
-	if (!e)
-		return;
-	addrp->memoffset = 0;
-
-	if (ONEOF(addrp->vstg, M(STGCOMMON)|M(STGEQUIV))
-	 && addrp -> uname_tag == UNAM_NAME) {
-	    e = mkexpr (OPMINUS, e, mkintcon (addrp -> user.name -> voffset));
-
-/* mkexpr will simplify it to zero if possible */
-	    if (e->tag == TCONST && e->constblock.Const.ci == 0)
-		return;
-	} /* if addrp -> vstg == STGCOMMON */
-
-/* In the worst case, parentheses might be needed OUTSIDE the expression,
-   too.  But since I think this subscripting can only appear as a
-   parameter in a procedure call, I don't think outside parens will ever
-   be needed.  INSIDE parens are handled below */
-
-	nice_printf (fp, " + ");
-	if (e -> tag == TEXPR) {
-	    int arg_prec = op_precedence (e -> exprblock.opcode);
-	    int prec = op_precedence (OPPLUS);
-	    use_paren = arg_prec && (arg_prec < prec || (arg_prec == prec &&
-		    is_left_assoc (OPPLUS)));
-	} /* if e -> tag == TEXPR */
-	if (use_paren) nice_printf (fp, "(");
-	expr_out (fp, e);
-	if (use_paren) nice_printf (fp, ")");
-    } /* if */
-} /* out_addr */
-
-
- static void
-#ifdef KR_headers
-output_literal(fp, memno, cp)
-	FILE *fp;
-	long memno;
-	Constp cp;
-#else
-output_literal(FILE *fp, long memno, Constp cp)
-#endif
-{
-    struct Literal *litp, *lastlit;
-
-    lastlit = litpool + nliterals;
-
-    for (litp = litpool; litp < lastlit; litp++) {
-	if (litp -> litnum == memno)
-	    break;
-    } /* for litp */
-
-    if (litp >= lastlit)
-	out_const (fp, cp);
-    else {
-	nice_printf (fp, "%s", lit_name (litp));
-	litp->lituse++;
-	}
-} /* output_literal */
-
-
- static void
-#ifdef KR_headers
-output_prim(fp, primp)
-	FILE *fp;
-	struct Primblock *primp;
-#else
-output_prim(FILE *fp, struct Primblock *primp)
-#endif
-{
-    if (primp == NULL)
-	return;
-
-    out_name (fp, primp -> namep);
-    if (primp -> argsp)
-	output_arg_list (fp, primp -> argsp);
-
-    if (primp -> fcharp != (expptr) NULL || primp -> lcharp != (expptr) NULL)
-	nice_printf (fp, "Sorry, no substrings yet");
-}
-
-
-
- static void
-#ifdef KR_headers
-output_arg_list(fp, listp)
-	FILE *fp;
-	struct Listblock *listp;
-#else
-output_arg_list(FILE *fp, struct Listblock *listp)
-#endif
-{
-    chainp arg_list;
-
-    if (listp == (struct Listblock *) NULL || listp -> listp == (chainp) NULL)
-	return;
-
-    nice_printf (fp, "(");
-
-    for (arg_list = listp -> listp; arg_list; arg_list = arg_list -> nextp) {
-	expr_out (fp, (expptr) arg_list -> datap);
-	if (arg_list -> nextp != (chainp) NULL)
-
-/* Might want to add a hook in here to accomodate the style setting which
-   wants spaces after commas */
-
-	    nice_printf (fp, ",");
-    } /* for arg_list */
-
-    nice_printf (fp, ")");
-} /* output_arg_list */
-
-
-
- static void
-#ifdef KR_headers
-output_unary(fp, e)
-	FILE *fp;
-	struct Exprblock *e;
-#else
-output_unary(FILE *fp, struct Exprblock *e)
-#endif
-{
-    if (e == NULL)
-	return;
-
-    switch (e -> opcode) {
-        case OPNEG:
-		if (e->vtype == TYREAL && dneg) {
-			e->opcode = OPNEG_KLUDGE;
-			output_binary(fp,e);
-			e->opcode = OPNEG;
-			break;
-			}
-	case OPNEG1:
-	case OPNOT:
-	case OPABS:
-	case OPBITNOT:
-	case OPWHATSIN:
-	case OPPREINC:
-	case OPPREDEC:
-	case OPADDR:
-	case OPIDENTITY:
-	case OPCHARCAST:
-	case OPDABS:
-	    output_binary (fp, e);
-	    break;
-	case OPCALL:
-	case OPCCALL:
-	    nice_printf (fp, "Sorry, no OPCALL yet");
-	    break;
-	default:
-	    erri ("output_unary: bad opcode", (int) e -> opcode);
-	    break;
-    } /* switch */
-} /* output_unary */
-
-
- static char *
-#ifdef KR_headers
-findconst(m)
-	register long m;
-#else
-findconst(register long m)
-#endif
-{
-	register struct Literal *litp, *litpe;
-
-	litp = litpool;
-	for(litpe = litp + nliterals; litp < litpe; litp++)
-		if (litp->litnum ==  m)
-			return litp->cds[0];
-	Fatal("findconst failure!");
-	return 0;
-	}
-
- static int
-#ifdef KR_headers
-opconv_fudge(fp, e)
-	FILE *fp;
-	struct Exprblock *e;
-#else
-opconv_fudge(FILE *fp, struct Exprblock *e)
-#endif
-{
-	/* special handling for conversions, ichar and character*1 */
-	register expptr lp;
-	register union Expression *Offset;
-	register char *cp;
-	int lt;
-	char buf[8], *s;
-	unsigned int k;
-	Namep np;
-	Addrp ap;
-
-	if (!(lp = e->leftp))	/* possible with erroneous Fortran */
-		return 1;
-	lt = lp->headblock.vtype;
-	if (lt == TYCHAR) {
-		switch(lp->tag) {
-			case TNAME:
-				nice_printf(fp, "*(unsigned char *)");
-				out_name(fp, (Namep)lp);
-				return 1;
-			case TCONST:
- tconst:
-				cp = lp->constblock.Const.ccp;
- tconst1:
-				k = *(unsigned char *)cp;
-				if (k < 128) { /* ASCII character */
-					sprintf(buf, chr_fmt[k], k);
-					nice_printf(fp, "'%s'", buf);
-					}
-				else
-					nice_printf(fp, "%d", k);
-				return 1;
-			case TADDR:
-				switch(lp->addrblock.vstg) {
-				    case STGMEMNO:
-					if (halign && e->vtype != TYCHAR) {
-						nice_printf(fp, "*(%s *)",
-						    c_type_decl(e->vtype,0));
-						expr_out(fp, lp);
-						return 1;
-						}
-					cp = findconst(lp->addrblock.memno);
-					goto tconst1;
-				    case STGCONST:
-					goto tconst;
-				    }
-				lp->addrblock.vtype = tyint;
-				Offset = lp->addrblock.memoffset;
-				switch(lp->addrblock.uname_tag) {
-				  case UNAM_REF:
-					nice_printf(fp, "*(unsigned char *)");
-					return 0;
-				  case UNAM_NAME:
-					np = lp->addrblock.user.name;
-					if (ONEOF(np->vstg,
-					    M(STGCOMMON)|M(STGEQUIV)))
-						Offset = mkexpr(OPMINUS, Offset,
-							ICON(np->voffset));
-					}
-				lp->addrblock.memoffset = Offset ?
-					mkexpr(OPSTAR, Offset,
-						ICON(typesize[tyint]))
-					: ICON(0);
-				lp->addrblock.isarray = 1;
-				/* STGCOMMON or STGEQUIV would cause */
-				/* voffset to be added in a second time */
-				lp->addrblock.vstg = STGUNKNOWN;
-				nice_printf(fp, "*(unsigned char *)&");
-				return 0;
-			default:
-				badtag("opconv_fudge", lp->tag);
-			}
-		}
-	if (lt != e->vtype) {
-		s = c_type_decl(e->vtype, 0);
-		if (ISCOMPLEX(lt)) {
- tryagain:
-			np = (Namep)e->leftp;
-			switch(np->tag) {
-			  case TNAME:
-				nice_printf(fp, "(%s) %s%sr", s,
-					np->cvarname,
-					np->vstg == STGARG ? "->" : ".");
-				return 1;
-			  case TADDR:
-				ap = (Addrp)np;
-				switch(ap->uname_tag) {
-				  case UNAM_IDENT:
-					nice_printf(fp, "(%s) %s.r", s,
-						ap->user.ident);
-					return 1;
-				  case UNAM_NAME:
-					nice_printf(fp, "(%s) ", s);
-					out_addr(fp, ap);
-					nice_printf(fp, ".r");
-					return 1;
-				  }
-			  case TEXPR:
-				e = (Exprp)np;
-				if (e->opcode == OPWHATSIN)
-					goto tryagain;
-			  default:
-				fatali("Unexpected tag %d in opconv_fudge",
-					np->tag);
-			  }
-			}
-		nice_printf(fp, "(%s) ", s);
-		}
-	return 0;
-	}
-
-
- static void
-#ifdef KR_headers
-output_binary(fp, e)
-	FILE *fp;
-	struct Exprblock *e;
-#else
-output_binary(FILE *fp, struct Exprblock *e)
-#endif
-{
-    char *format;
-    extern table_entry opcode_table[];
-    int prec;
-
-    if (e == NULL || e -> tag != TEXPR)
-	return;
-
-/* Instead of writing a huge switch, I've incorporated the output format
-   into a table.  Things like "%l" and "%r" stand for the left and
-   right subexpressions.  This should allow both prefix and infix
-   functions to be specified (e.g. "(%l * %r", "z_div (%l, %r").  Of
-   course, I should REALLY think out the ramifications of writing out
-   straight text, as opposed to some intermediate format, which could
-   figure out and optimize on the the number of required blanks (we don't
-   want "x - (-y)" to become "x --y", for example).  Special cases (such as
-   incomplete implementations) could still be implemented as part of the
-   switch, they will just have some dummy value instead of the string
-   pattern.  Another difficulty is the fact that the complex functions
-   will differ from the integer and real ones */
-
-/* Handle a special case.  We don't want to output "x + - 4", or "y - - 3"
-*/
-    if ((e -> opcode == OPPLUS || e -> opcode == OPMINUS) &&
-	    e -> rightp && e -> rightp -> tag == TCONST &&
-	    isnegative_const (&(e -> rightp -> constblock)) &&
-	    is_negatable (&(e -> rightp -> constblock))) {
-
-	e -> opcode = (e -> opcode == OPPLUS) ? OPMINUS : OPPLUS;
-	negate_const (&(e -> rightp -> constblock));
-    } /* if e -> opcode == PLUS or MINUS */
-
-    prec = op_precedence (e -> opcode);
-    format = op_format (e -> opcode);
-
-    if (format != SPECIAL_FMT) {
-	while (*format) {
-	    if (*format == '%') {
-		int arg_prec, use_paren = 0;
-		expptr lp, rp;
-
-		switch (*(format + 1)) {
-		    case 'l':
-			lp = e->leftp;
-			if (lp && lp->tag == TEXPR) {
-			    arg_prec = op_precedence(lp->exprblock.opcode);
-
-			    use_paren = arg_prec &&
-			        (arg_prec < prec || (arg_prec == prec &&
-				    is_right_assoc (prec)));
-			} /* if e -> leftp */
-			if (e->opcode == OPCONV && opconv_fudge(fp,e))
-				break;
-			if (use_paren)
-			    nice_printf (fp, "(");
-		        expr_out(fp, lp);
-			if (use_paren)
-			    nice_printf (fp, ")");
-		        break;
-		    case 'r':
-			rp = e->rightp;
-			if (rp && rp->tag == TEXPR) {
-			    arg_prec = op_precedence(rp->exprblock.opcode);
-
-			    use_paren = arg_prec &&
-			        (arg_prec < prec || (arg_prec == prec &&
-				    is_left_assoc (prec)));
-			    use_paren = use_paren ||
-				(rp->exprblock.opcode == OPNEG
-				&& prec >= op_precedence(OPMINUS));
-			} /* if e -> rightp */
-			if (use_paren)
-			    nice_printf (fp, "(");
-		        expr_out(fp, rp);
-			if (use_paren)
-			    nice_printf (fp, ")");
-		        break;
-		    case '\0':
-		    case '%':
-		        nice_printf (fp, "%%");
-		        break;
-		    default:
-		        erri ("output_binary: format err: '%%%c' illegal",
-				(int) *(format + 1));
-		        break;
-		} /* switch */
-		format += 2;
-	    } else
-		nice_printf (fp, "%c", *format++);
-	} /* while *format */
-    } else {
-
-/* Handle Special cases of formatting */
-
-	switch (e -> opcode) {
-		case OPCCALL:
-		case OPCALL:
-			out_call (fp, (int) e -> opcode, e -> vtype,
-					e -> vleng, e -> leftp, e -> rightp);
-			break;
-
-		case OPCOMMA_ARG:
-			doin_setbound = 1;
-			nice_printf(fp, "(");
-			expr_out(fp, e->leftp);
-			nice_printf(fp, ", &");
-			doin_setbound = 0;
-			expr_out(fp, e->rightp);
-			nice_printf(fp, ")");
-			break;
-
-		case OPADDR:
-		default:
-	        	nice_printf (fp, "Sorry, can't format OPCODE '%d'",
-				e -> opcode);
-	        	break;
-		}
-
-    } /* else */
-} /* output_binary */
-
- void
-#ifdef KR_headers
-out_call(outfile, op, ftype, len, name, args)
-	FILE *outfile;
-	int op;
-	int ftype;
-	expptr len;
-	expptr name;
-	expptr args;
-#else
-out_call(FILE *outfile, int op, int ftype, expptr len, expptr name, expptr args)
-#endif
-{
-    chainp arglist;		/* Pointer to any actual arguments */
-    chainp cp;			/* Iterator over argument lists */
-    Addrp ret_val = (Addrp) NULL;
-				/* Function return value buffer, if any is
-				   required */
-    int byvalue;		/* True iff we're calling a C library
-				   routine */
-    int done_once;		/* Used for writing commas to   outfile   */
-    int narg, t;
-    register expptr q;
-    long L;
-    Argtypes *at;
-    Atype *A, *Ac;
-    Namep np;
-    extern int forcereal;
-
-/* Don't use addresses if we're calling a C function */
-
-    byvalue = op == OPCCALL;
-
-    if (args)
-	arglist = args -> listblock.listp;
-    else
-	arglist = CHNULL;
-
-/* If this is a CHARACTER function, the first argument is the result */
-
-    if (ftype == TYCHAR)
-	if (ISICON (len)) {
-	    ret_val = (Addrp) (arglist -> datap);
-	    arglist = arglist -> nextp;
-	} else {
-	    err ("adjustable character function");
-	    return;
-	} /* else */
-
-/* If this is a COMPLEX function, the first argument is the result */
-
-    else if (ISCOMPLEX (ftype)) {
-	ret_val = (Addrp) (arglist -> datap);
-	arglist = arglist -> nextp;
-    } /* if ISCOMPLEX */
-
-    /* prepare to cast procedure parameters -- set A if we know how */
-    np = name->tag == TEXPR && name->exprblock.opcode == OPWHATSIN
-	? (Namep)name->exprblock.leftp : (Namep)name;
-
-    A = Ac = 0;
-    if (np->tag == TNAME && (at = np->arginfo)) {
-	if (at->nargs > 0)
-		A = at->atypes;
-	if (Ansi && (at->defined || at->nargs > 0))
-		Ac = at->atypes;
-    	}
-
-/* Now we can actually start to write out the function invocation */
-
-    if (ftype == TYREAL && forcereal)
-	nice_printf(outfile, "(real)");
-    if (name -> tag == TEXPR && name -> exprblock.opcode == OPWHATSIN) {
-	nice_printf (outfile, "(");
-	expr_out (outfile, name);
-	nice_printf (outfile, ")");
-	}
-    else
-	expr_out(outfile, name);
-
-    nice_printf(outfile, "(");
-
-    if (ret_val) {
-	if (ISCOMPLEX (ftype))
-	    nice_printf (outfile, "&");
-	expr_out (outfile, (expptr) ret_val);
-	if (Ac)
-		Ac++;
-
-/* The length of the result of a character function is the second argument */
-/* It should be in place from putcall(), so we won't touch it explicitly */
-
-    } /* if ret_val */
-    done_once = ret_val ? TRUE : FALSE;
-
-/* Now run through the named arguments */
-
-    narg = -1;
-    for (cp = arglist; cp; cp = cp -> nextp, done_once = TRUE) {
-
-	if (done_once)
-	    nice_printf (outfile, ", ");
-	narg++;
-
-	if (!( q = (expptr)cp->datap) )
-		continue;
-
-	if (q->tag == TADDR) {
-		if (q->addrblock.vtype > TYERROR) {
-			/* I/O block */
-			nice_printf(outfile, "&%s", q->addrblock.user.ident);
-			continue;
-			}
-		if (!byvalue && q->addrblock.isarray
-		&& q->addrblock.vtype != TYCHAR
-		&& q->addrblock.memoffset->tag == TCONST) {
-
-			/* check for 0 offset -- after */
-			/* correcting for equivalence. */
-			L = q->addrblock.memoffset->constblock.Const.ci;
-			if (ONEOF(q->addrblock.vstg, M(STGCOMMON)|M(STGEQUIV))
-					&& q->addrblock.uname_tag == UNAM_NAME)
-				L -= q->addrblock.user.name->voffset;
-			if (L)
-				goto skip_deref;
-
-			if (Ac && narg < at->dnargs
-			 && q->headblock.vtype != (t = Ac[narg].type)
-			 && t > TYADDR && t < TYSUBR)
-				nice_printf(outfile, "(%s*)", typename[t]);
-
-			/* &x[0] == x */
-			/* This also prevents &sizeof(doublereal)[0] */
-
-			switch(q->addrblock.uname_tag) {
-			    case UNAM_NAME:
-				out_name(outfile, q->addrblock.user.name);
-				continue;
-			    case UNAM_IDENT:
-				nice_printf(outfile, "%s",
-					q->addrblock.user.ident);
-				continue;
-			    case UNAM_CHARP:
-				nice_printf(outfile, "%s",
-					q->addrblock.user.Charp);
-				continue;
-			    case UNAM_EXTERN:
-				extern_out(outfile,
-					&extsymtab[q->addrblock.memno]);
-				continue;
-			    }
-			}
-		}
-
-/* Skip over the dereferencing operator generated only for the
-   intermediate file */
- skip_deref:
-	if (q -> tag == TEXPR && q -> exprblock.opcode == OPWHATSIN)
-	    q = q -> exprblock.leftp;
-
-	if (q->headblock.vclass == CLPROC) {
-	    if (Castargs && (q->tag != TNAME
-				|| q->nameblock.vprocclass != PTHISPROC)
-			 && (q->tag != TADDR
-				|| q->addrblock.uname_tag != UNAM_NAME
-				|| q->addrblock.user.name->vprocclass
-								!= PTHISPROC))
-		{
-		if (A && (t = A[narg].type) >= 200)
-			t %= 100;
-		else {
-			t = q->headblock.vtype;
-			if (q->tag == TNAME && q->nameblock.vimpltype)
-				t = TYUNKNOWN;
-			}
-		nice_printf(outfile, "(%s)", usedcasts[t] = casttypes[t]);
-		}
-	    }
-	else if (Ac && narg < at->dnargs
-		&& q->headblock.vtype != (t = Ac[narg].type)
-		&& t > TYADDR && t < TYSUBR)
-		nice_printf(outfile, "(%s*)", typename[t]);
-
-	if ((q -> tag == TADDR || q-> tag == TNAME) &&
-		(byvalue || q -> headblock.vstg != STGREG)) {
-	    if (q -> headblock.vtype != TYCHAR)
-	      if (byvalue) {
-
-		if (q -> tag == TADDR &&
-			q -> addrblock.uname_tag == UNAM_NAME &&
-			! q -> addrblock.user.name -> vdim &&
-			oneof_stg(q -> addrblock.user.name, q -> addrblock.vstg,
-					M(STGARG)|M(STGEQUIV)) &&
-			! ISCOMPLEX(q->addrblock.user.name->vtype))
-		    nice_printf (outfile, "*");
-		else if (q -> tag == TNAME
-			&& oneof_stg(&q->nameblock, q -> nameblock.vstg,
-				M(STGARG)|M(STGEQUIV))
-			&& !(q -> nameblock.vdim))
-		    nice_printf (outfile, "*");
-
-	      } else {
-		expptr memoffset;
-
-		if (q->tag == TADDR && (
-			!ONEOF (q -> addrblock.vstg, M(STGEXT)|M(STGLENG))
-			&& (ONEOF(q->addrblock.vstg,
-				M(STGCOMMON)|M(STGEQUIV)|M(STGMEMNO))
-			    || ((memoffset = q->addrblock.memoffset)
-				&& (!ISICON(memoffset)
-				|| memoffset->constblock.Const.ci)))
-			|| ONEOF(q->addrblock.vstg,
-					M(STGINIT)|M(STGAUTO)|M(STGBSS))
-				&& !q->addrblock.isarray))
-		    nice_printf (outfile, "&");
-		else if (q -> tag == TNAME
-			&& !oneof_stg(&q->nameblock, q -> nameblock.vstg,
-				M(STGARG)|M(STGEXT)|M(STGEQUIV)))
-		    nice_printf (outfile, "&");
-	    } /* else */
-
-	    expr_out (outfile, q);
-	} /* if q -> tag == TADDR || q -> tag == TNAME */
-
-/* Might be a Constant expression, e.g. string length, character constants */
-
-	else if (q -> tag == TCONST) {
-		if (q->constblock.vtype == TYLONG)
-			nice_printf(outfile, "(ftnlen)%ld",
-				q->constblock.Const.ci);
-		else
-			out_const(outfile, &q->constblock);
-	    }
-
-/* Must be some other kind of expression, or register var, or constant.
-   In particular, this is likely to be a temporary variable assignment
-   which was generated in p1put_call */
-
-	else if (!ISCOMPLEX (q -> headblock.vtype) && !ISCHAR (q)){
-	    int use_paren = q -> tag == TEXPR &&
-		    op_precedence (q -> exprblock.opcode) <=
-		    op_precedence (OPCOMMA);
-	    if (q->headblock.vtype == TYREAL && forcereal) {
-		nice_printf(outfile, "(real)");
-		use_paren = 1;
-		}
-	    if (use_paren) nice_printf (outfile, "(");
-	    expr_out (outfile, q);
-	    if (use_paren) nice_printf (outfile, ")");
-	} /* if !ISCOMPLEX */
-	else
-	    err ("out_call:  unknown parameter");
-
-    } /* for (cp = arglist */
-
-    if (arglist)
-	frchain (&arglist);
-
-    nice_printf (outfile, ")");
-
-} /* out_call */
-
-
- char *
-#ifdef KR_headers
-flconst(buf, x)
-	char *buf;
-	char *x;
-#else
-flconst(char *buf, char *x)
-#endif
-{
-	sprintf(buf, fl_fmt_string, x);
-	return buf;
-	}
-
- char *
-#ifdef KR_headers
-dtos(x)
-	double x;
-#else
-dtos(double x)
-#endif
-{
-	static char buf[64];
-#ifdef USE_DTOA
-	g_fmt(buf, x);
-#else
-	sprintf(buf, db_fmt_string, x);
-#endif
-	return strcpy(mem(strlen(buf)+1,0), buf);
-	}
-
-char tr_tab[Table_size];
-
-/* out_init -- Initialize the data structures used by the routines in
-   output.c.  These structures include the output format to be used for
-   Float, Double, Complex, and Double Complex constants. */
-
- void
-out_init(Void)
-{
-    extern int tab_size;
-    register char *s;
-
-    s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+-.";
-    while(*s)
-	tr_tab[*s++] = 3;
-    tr_tab['>'] = 1;
-
-	opeqable[OPPLUS] = 1;
-	opeqable[OPMINUS] = 1;
-	opeqable[OPSTAR] = 1;
-	opeqable[OPSLASH] = 1;
-	opeqable[OPMOD] = 1;
-	opeqable[OPLSHIFT] = 1;
-	opeqable[OPBITAND] = 1;
-	opeqable[OPBITXOR] = 1;
-	opeqable[OPBITOR ] = 1;
-
-
-/* Set the output format for both types of floating point constants */
-
-    if (fl_fmt_string == NULL || *fl_fmt_string == '\0')
-	fl_fmt_string = Ansi == 1 ? "%sf" : "(float)%s";
-
-    if (db_fmt_string == NULL || *db_fmt_string == '\0')
-	db_fmt_string = "%.17g";
-
-/* Set the output format for both types of complex constants.  They will
-   have string parameters rather than float or double so that the decimal
-   point may be added to the strings generated by the {db,fl}_fmt_string
-   formats above */
-
-    if (cm_fmt_string == NULL || *cm_fmt_string == '\0') {
-	cm_fmt_string = "{%s,%s}";
-    } /* if cm_fmt_string == NULL */
-
-    if (dcm_fmt_string == NULL || *dcm_fmt_string == '\0') {
-	dcm_fmt_string = "{%s,%s}";
-    } /* if dcm_fmt_string == NULL */
-
-    tab_size = 4;
-} /* out_init */
-
-
- void
-#ifdef KR_headers
-extern_out(fp, extsym)
-	FILE *fp;
-	Extsym *extsym;
-#else
-extern_out(FILE *fp, Extsym *extsym)
-#endif
-{
-    if (extsym == (Extsym *) NULL)
-	return;
-
-    nice_printf (fp, "%s", extsym->cextname);
-
-} /* extern_out */
-
-
-
- static void
-#ifdef KR_headers
-output_list(fp, listp)
-	FILE *fp;
-	struct Listblock *listp;
-#else
-output_list(FILE *fp, struct Listblock *listp)
-#endif
-{
-    int did_one = 0;
-    chainp elts;
-
-    nice_printf (fp, "(");
-    if (listp)
-	for (elts = listp -> listp; elts; elts = elts -> nextp) {
-	    if (elts -> datap) {
-		if (did_one)
-		    nice_printf (fp, ", ");
-		expr_out (fp, (expptr) elts -> datap);
-		did_one = 1;
-	    } /* if elts -> datap */
-	} /* for elts */
-    nice_printf (fp, ")");
-} /* output_list */
-
-
- void
-#ifdef KR_headers
-out_asgoto(outfile, expr)
-	FILE *outfile;
-	expptr expr;
-#else
-out_asgoto(FILE *outfile, expptr expr)
-#endif
-{
-    chainp value;
-    Namep namep;
-    int k;
-
-    if (expr == (expptr) NULL) {
-	err ("out_asgoto:  NULL variable expr");
-	return;
-    } /* if expr */
-
-    nice_printf (outfile, Ansi ? "switch (" : "switch ((int)"); /*)*/
-    expr_out (outfile, expr);
-    nice_printf (outfile, ") {\n");
-    next_tab (outfile);
-
-/* The initial addrp value will be stored as a namep pointer */
-
-    switch(expr->tag) {
-	case TNAME:
-		/* local variable */
-		namep = &expr->nameblock;
-		break;
-	case TEXPR:
-		if (expr->exprblock.opcode == OPWHATSIN
-		 && expr->exprblock.leftp->tag == TNAME)
-			/* argument */
-			namep = &expr->exprblock.leftp->nameblock;
-		else
-			goto bad;
-		break;
-	case TADDR:
-		if (expr->addrblock.uname_tag == UNAM_NAME) {
-			/* initialized local variable */
-			namep = expr->addrblock.user.name;
-			break;
-			}
-	default:
- bad:
-		err("out_asgoto:  bad expr");
-		return;
-	}
-
-    for(k = 0, value = namep -> varxptr.assigned_values; value;
-	    value = value->nextp, k++) {
-	nice_printf (outfile, "case %d: goto %s;\n", k,
-		user_label((long)value->datap));
-    } /* for value */
-    prev_tab (outfile);
-
-    nice_printf (outfile, "}\n");
-} /* out_asgoto */
-
- void
-#ifdef KR_headers
-out_if(outfile, expr)
-	FILE *outfile;
-	expptr expr;
-#else
-out_if(FILE *outfile, expptr expr)
-#endif
-{
-    nice_printf (outfile, "if (");
-    expr_out (outfile, expr);
-    nice_printf (outfile, ") {\n");
-    next_tab (outfile);
-} /* out_if */
-
- static void
-#ifdef KR_headers
-output_rbrace(outfile, s)
-	FILE *outfile;
-	char *s;
-#else
-output_rbrace(FILE *outfile, char *s)
-#endif
-{
-	extern int last_was_label;
-	register char *fmt;
-
-	if (last_was_label) {
-		last_was_label = 0;
-		fmt = ";%s";
-		}
-	else
-		fmt = "%s";
-	nice_printf(outfile, fmt, s);
-	}
-
- void
-#ifdef KR_headers
-out_else(outfile)
-	FILE *outfile;
-#else
-out_else(FILE *outfile)
-#endif
-{
-    prev_tab (outfile);
-    output_rbrace(outfile, "} else {\n");
-    next_tab (outfile);
-} /* out_else */
-
- void
-#ifdef KR_headers
-elif_out(outfile, expr)
-	FILE *outfile;
-	expptr expr;
-#else
-elif_out(FILE *outfile, expptr expr)
-#endif
-{
-    prev_tab (outfile);
-    output_rbrace(outfile, "} else ");
-    out_if (outfile, expr);
-} /* elif_out */
-
- void
-#ifdef KR_headers
-endif_out(outfile)
-	FILE *outfile;
-#else
-endif_out(FILE *outfile)
-#endif
-{
-    prev_tab (outfile);
-    output_rbrace(outfile, "}\n");
-} /* endif_out */
-
- void
-#ifdef KR_headers
-end_else_out(outfile)
-	FILE *outfile;
-#else
-end_else_out(FILE *outfile)
-#endif
-{
-    prev_tab (outfile);
-    output_rbrace(outfile, "}\n");
-} /* end_else_out */
-
-
-
- void
-#ifdef KR_headers
-compgoto_out(outfile, index, labels)
-	FILE *outfile;
-	expptr index;
-	expptr labels;
-#else
-compgoto_out(FILE *outfile, expptr index, expptr labels)
-#endif
-{
-    char *s1, *s2;
-
-    if (index == ENULL)
-	err ("compgoto_out:  null index for computed goto");
-    else if (labels && labels -> tag != TLIST)
-	erri ("compgoto_out:  expected label list, got tag '%d'",
-		labels -> tag);
-    else {
-	chainp elts;
-	int i = 1;
-
-	s2 = /*(*/ ") {\n"; /*}*/
-	if (Ansi)
-		s1 = "switch ("; /*)*/
-	else if (index->tag == TNAME || index->tag == TEXPR
-				&& index->exprblock.opcode == OPWHATSIN)
-		s1 = "switch ((int)"; /*)*/
-	else {
-		s1 = "switch ((int)(";
-		s2 = ")) {\n"; /*}*/
-		}
-	nice_printf(outfile, s1);
-	expr_out (outfile, index);
-	nice_printf (outfile, s2);
-	next_tab (outfile);
-
-	for (elts = labels -> listblock.listp; elts; elts = elts -> nextp, i++) {
-	    if (elts -> datap) {
-		if (ISICON(((expptr) (elts -> datap))))
-		    nice_printf (outfile, "case %d:  goto %s;\n", i,
-			user_label(((expptr)(elts->datap))->constblock.Const.ci));
-		else
-		    err ("compgoto_out:  bad label in label list");
-	    } /* if (elts -> datap) */
-	} /* for elts */
-	prev_tab (outfile);
-	nice_printf (outfile, /*{*/ "}\n");
-    } /* else */
-} /* compgoto_out */
-
-
- void
-#ifdef KR_headers
-out_for(outfile, init, test, inc)
-	FILE *outfile;
-	expptr init;
-	expptr test;
-	expptr inc;
-#else
-out_for(FILE *outfile, expptr init, expptr test, expptr inc)
-#endif
-{
-    nice_printf (outfile, "for (");
-    expr_out (outfile, init);
-    nice_printf (outfile, "; ");
-    expr_out (outfile, test);
-    nice_printf (outfile, "; ");
-    expr_out (outfile, inc);
-    nice_printf (outfile, ") {\n");
-    next_tab (outfile);
-} /* out_for */
-
-
- void
-#ifdef KR_headers
-out_end_for(outfile)
-	FILE *outfile;
-#else
-out_end_for(FILE *outfile)
-#endif
-{
-    prev_tab (outfile);
-    nice_printf (outfile, "}\n");
-} /* out_end_for */
diff --git a/usr.bin/f2c/output.h b/usr.bin/f2c/output.h
deleted file mode 100644
index 97e3a0a..0000000
--- a/usr.bin/f2c/output.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/* nice_printf -- same arguments as fprintf.
-
-	All output which is to become C code must be directed through this
-   function.  For now, no buffering is done.  Later on, every line of
-   output will be filtered to accomodate the style definitions (e.g. one
-   statement per line, spaces between function names and argument lists,
-   etc.)
-*/
-#include "niceprintf.h"
-
-
-/* Definitions for the opcode table.  The table is indexed by the macros
-   which are #defined in   defines.h   */
-
-#define UNARY_OP 01
-#define BINARY_OP 02
-
-#define SPECIAL_FMT NULL
-
-#define is_unary_op(x) (opcode_table[x].type == UNARY_OP)
-#define is_binary_op(x) (opcode_table[x].type == BINARY_OP)
-#define op_precedence(x) (opcode_table[x].prec)
-#define op_format(x) (opcode_table[x].format)
-
-/* _assoc_table -- encodes left-associativity and right-associativity
-   information; indexed by precedence level.  Only 2, 3, 14 are
-   right-associative.  Source:  Kernighan & Ritchie, p. 49 */
-
-extern char _assoc_table[];
-
-#define is_right_assoc(x) (_assoc_table [x])
-#define is_left_assoc(x) (! _assoc_table [x])
-
-
-typedef struct {
-    int type;			/* UNARY_OP or BINARY_OP */
-    int prec;			/* Precedence level, useful for adjusting
-				   number of parens to insert.  Zero is a
-				   special level, and 2, 3, 14 are
-				   right-associative */
-    char *format;
-} table_entry;
-
-
-extern char *fl_fmt_string;	/* Float constant format string */
-extern char *db_fmt_string;	/* Double constant format string */
-extern char *cm_fmt_string;	/* Complex constant format string */
-extern char *dcm_fmt_string;	/* Double Complex constant format string */
-
-extern int indent;		/* Number of spaces to indent; this is a
-				   temporary fix */
-extern int tab_size;		/* Number of spaces in each tab */
-extern int in_string;
-
-extern table_entry opcode_table[];
-
-
-void	compgoto_out Argdcl((FILEP, tagptr, tagptr));
-void	endif_out Argdcl((FILEP));
-void	expr_out Argdcl((FILEP, tagptr));
-void	out_and_free_statement Argdcl((FILEP, tagptr));
-void	out_end_for Argdcl((FILEP));
-void	out_if Argdcl((FILEP, tagptr));
-void	out_name Argdcl((FILEP, Namep));
diff --git a/usr.bin/f2c/p1defs.h b/usr.bin/f2c/p1defs.h
deleted file mode 100644
index c76af22..0000000
--- a/usr.bin/f2c/p1defs.h
+++ /dev/null
@@ -1,158 +0,0 @@
-#define P1_UNKNOWN 0
-#define P1_COMMENT 1		/* Fortan comment string */
-#define P1_EOF 2		/* End of file dummy token */
-#define P1_SET_LINE 3		/* Reset the line counter */
-#define P1_FILENAME 4		/* Name of current input file */
-#define P1_NAME_POINTER 5	/* Pointer to hash table entry */
-#define P1_CONST 6		/* Some constant value */
-#define P1_EXPR 7		/* Followed by opcode */
-
-/* The next two tokens could be grouped together, since they always come
-   from an Addr structure */
-
-#define P1_IDENT 8		/* Char string identifier in addrp->user
-				   field */
-#define P1_EXTERN 9		/* Pointer to external symbol entry */
-
-#define P1_HEAD 10		/* Function header info */
-#define P1_LIST 11		/* A list of data (e.g. arguments) will
-				   follow the tag, type, and count */
-#define P1_LITERAL 12		/* Hold the index into the literal pool */
-#define P1_LABEL 13		/* label value */
-#define P1_ASGOTO 14		/* Store the hash table pointer of
-				   variable used in assigned goto */
-#define P1_GOTO 15		/* Store the statement number */
-#define P1_IF 16		/* store the condition as an expression */
-#define P1_ELSE 17		/* No data */
-#define P1_ELIF 18		/* store the condition as an expression */
-#define P1_ENDIF 19		/* Marks the end of a block IF */
-#define P1_ENDELSE 20		/* Marks the end of a block ELSE */
-#define P1_ADDR 21		/* Addr data; used for arrays, common and
-				   equiv addressing, NOT for names, idents
-				   or externs */
-#define P1_SUBR_RET 22		/* Subroutine return; the return expression
-				   follows */
-#define P1_COMP_GOTO 23		/* Computed goto; has expr, label list */
-#define P1_FOR 24		/* C FOR loop; three expressions follow */
-#define P1_ENDFOR 25		/* End of C FOR loop */
-#define P1_FORTRAN 26		/* original Fortran source */
-#define P1_CHARP 27		/* user.Charp field -- for long names */
-#define P1_WHILE1START 28	/* start of DO WHILE */
-#define P1_WHILE2START 29	/* rest of DO WHILE */
-#define P1_PROCODE 30		/* invoke procode() -- to adjust params */
-#define P1_ELSEIFSTART 31	/* handle extra code for abs, min, max
-				   in else if() */
-
-#define P1_FILENAME_MAX	256	/* max filename length to retain (for -g) */
-#define P1_STMTBUFSIZE 1400
-
-
-
-#define COMMENT_BUFFER_SIZE 255	/* max number of chars in each comment */
-#define CONSTANT_STR_MAX 1000	/* max number of chars in string constant */
-
-void	p1_asgoto Argdcl((Addrp));
-void	p1_comment Argdcl((char*));
-void	p1_elif Argdcl((tagptr));
-void	p1_else Argdcl((void));
-void	p1_endif Argdcl((void));
-void	p1_expr Argdcl((tagptr));
-void	p1_for Argdcl((tagptr, tagptr, tagptr));
-void	p1_goto Argdcl((long int));
-void	p1_head Argdcl((int, char*));
-void	p1_if Argdcl((tagptr));
-void	p1_label Argdcl((long int));
-void	p1_line_number Argdcl((long int));
-void	p1_subr_ret Argdcl((tagptr));
-void	p1comp_goto Argdcl((tagptr, int, struct Labelblock**));
-void	p1else_end Argdcl((void));
-void	p1for_end Argdcl((void));
-void	p1put Argdcl((int));
-void	p1puts Argdcl((int, char*));
-
-/* The pass 1 intermediate file has the following format:
-
-	<ascii-integer-rep> [ : [ <sp> [ <data> ]]] \n
-
-   e.g.   1: This is a comment
-
-   This format is destined to change in the future, but for now a readable
-   form is more desirable than a compact form.
-
-   NOTES ABOUT THE P1 FORMAT
-   ----------------------------------------------------------------------
-
-	P1_COMMENT:  The comment string (in   <data>)   may be at most
-		COMMENT_BUFFER_SIZE bytes long.  It must contain no newlines
-		or null characters.  A side effect of the way comments are
-		read in   lex.c   is that no '\377' chars may be in a
-		comment either.
-
-	P1_SET_LINE:  <data>  holds the line number in the current source file.
-
-	P1_INC_LINE:  Increment the source line number;   <data>   is empty.
-
-	P1_NAME_POINTER:  <data>   holds the integer representation of a
-			  pointer into a hash table entry.
-
-	P1_CONST:  the first field in   <data>   is a type tag (one of the
-		   TYxxxx   macros), the next field holds the constant
-		   value
-
-	P1_EXPR:  <data>   holds the opcode number of the expression,
-		  followed by the type of the expression (required for
-		  OPCONV).  Next is the value of   vleng.
-		  The type of operation represented by the
-		  opcode determines how many of the following data items
-		  are part of this expression.
-
-	P1_IDENT:  <data>   holds the type, then storage, then the
-		   char string identifier in the   addrp->user   field.
-
-	P1_EXTERN:  <data>   holds an offset into the external symbol
-		    table entry
-
-	P1_HEAD:  the first field in   <data>  is the procedure class, the
-		  second is the name of the procedure
-
-	P1_LIST:  the first field in   <data>   is the tag, the second the
-		  type of the list, the third the number of elements in
-		  the list
-
-	P1_LITERAL:  <data>   holds the   litnum   of a value in the
-		     literal pool.
-
-	P1_LABEL:  <data>   holds the statement number of the current
-		   line
-
-	P1_ASGOTO:  <data>   holds the hash table pointer of the variable
-
-	P1_GOTO:  <data>   holds the statement number to jump to
-
-	P1_IF:  <data>   is empty, the following expression is the IF
-	        condition.
-
-	P1_ELSE:  <data>   is empty.
-
-	P1_ELIF:  <data>   is empty, the following expression is the IF
-		  condition.
-
-	P1_ENDIF:  <data>   is empty.
-
-	P1_ENDELSE:  <data>   is empty.
-
-	P1_ADDR:   <data>   holds a direct copy of the structure.  The
-		  next expression is a copy of    vleng,   and the next a
-		  copy of    memoffset.
-
-	P1_SUBR_RET:  The next token is an expression for the return value.
-
-	P1_COMP_GOTO:  The next token is an integer expression, the
-		       following one a list of labels.
-
-	P1_FOR:  The next three expressions are the Init, Test, and
-	         Increment expressions of a C FOR loop.
-
-	P1_ENDFOR:  Marks the end of the body of a FOR loop
-
-*/
diff --git a/usr.bin/f2c/p1output.c b/usr.bin/f2c/p1output.c
deleted file mode 100644
index 93204ab..0000000
--- a/usr.bin/f2c/p1output.c
+++ /dev/null
@@ -1,723 +0,0 @@
-/****************************************************************
-Copyright 1990, 1991, 1993, 1994 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "p1defs.h"
-#include "output.h"
-#include "names.h"
-
-
-static void p1_addr Argdcl((Addrp));
-static void p1_big_addr Argdcl((Addrp));
-static void p1_binary Argdcl((Exprp));
-static void p1_const Argdcl((Constp));
-static void p1_list Argdcl((struct Listblock*));
-static void p1_literal Argdcl((long int));
-static void p1_name Argdcl((Namep));
-static void p1_unary Argdcl((Exprp));
-static void p1putd Argdcl((int, long int));
-static void p1putdd Argdcl((int, int, int));
-static void p1putddd Argdcl((int, int, int, int));
-static void p1putdds Argdcl((int, int, int, char*));
-static void p1putds Argdcl((int, int, char*));
-static void p1putn Argdcl((int, int, char*));
-
-
-/* p1_comment -- save the text of a Fortran comment in the intermediate
-   file.  Make sure that there are no spurious "/ *" or "* /" characters by
-   mapping them onto "/+" and "+/".   str   is assumed to hold no newlines and be
-   null terminated; it may be modified by this function. */
-
- void
-#ifdef KR_headers
-p1_comment(str)
-	char *str;
-#else
-p1_comment(char *str)
-#endif
-{
-    register unsigned char *pointer, *ustr;
-
-    if (!str)
-	return;
-
-/* Get rid of any open or close comment combinations that may be in the
-   Fortran input */
-
-	ustr = (unsigned char *)str;
-	for(pointer = ustr; *pointer; pointer++)
-		if (*pointer == '*' && (pointer[1] == '/'
-					|| pointer > ustr && pointer[-1] == '/'))
-			*pointer = '+';
-	/* trim trailing white space */
-#ifdef isascii
-	while(--pointer >= ustr && (!isascii(*pointer) || isspace(*pointer)));
-#else
-	while(--pointer >= ustr && isspace(*pointer));
-#endif
-	pointer[1] = 0;
-	p1puts (P1_COMMENT, str);
-} /* p1_comment */
-
-/* p1_name -- Writes the address of a hash table entry into the
-   intermediate file */
-
- static void
-#ifdef KR_headers
-p1_name(namep)
-	Namep namep;
-#else
-p1_name(Namep namep)
-#endif
-{
-	p1putd (P1_NAME_POINTER, (long) namep);
-	namep->visused = 1;
-} /* p1_name */
-
-
-
- void
-#ifdef KR_headers
-p1_expr(expr)
-	expptr expr;
-#else
-p1_expr(expptr expr)
-#endif
-{
-/* An opcode of 0 means a null entry */
-
-    if (expr == ENULL) {
-	p1putdd (P1_EXPR, 0, TYUNKNOWN);	/* Should this be TYERROR? */
-	return;
-    } /* if (expr == ENULL) */
-
-    switch (expr -> tag) {
-        case TNAME:
-		p1_name ((Namep) expr);
-		return;
-	case TCONST:
-		p1_const(&expr->constblock);
-		return;
-	case TEXPR:
-		/* Fall through the switch */
-		break;
-	case TADDR:
-		p1_addr (&(expr -> addrblock));
-		goto freeup;
-	case TPRIM:
-		warn ("p1_expr:  got TPRIM");
-		return;
-	case TLIST:
-		p1_list (&(expr->listblock));
-		frchain( &(expr->listblock.listp) );
-		return;
-	case TERROR:
-		return;
-	default:
-		erri ("p1_expr: bad tag '%d'", (int) (expr -> tag));
-		return;
-	}
-
-/* Now we know that the tag is TEXPR */
-
-    if (is_unary_op (expr -> exprblock.opcode))
-	p1_unary (&(expr -> exprblock));
-    else if (is_binary_op (expr -> exprblock.opcode))
-	p1_binary (&(expr -> exprblock));
-    else
-	erri ("p1_expr:  bad opcode '%d'", (int) expr -> exprblock.opcode);
- freeup:
-    free((char *)expr);
-
-} /* p1_expr */
-
-
-
- static void
-#ifdef KR_headers
-p1_const(cp)
-	register Constp cp;
-#else
-p1_const(register Constp cp)
-#endif
-{
-	int type = cp->vtype;
-	expptr vleng = cp->vleng;
-	union Constant *c = &cp->Const;
-	char cdsbuf0[64], cdsbuf1[64];
-	char *cds0, *cds1;
-
-    switch (type) {
-	case TYINT1:
-        case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-	case TYLOGICAL:
-	case TYLOGICAL1:
-	case TYLOGICAL2:
-	    fprintf(pass1_file, "%d: %d %ld\n", P1_CONST, type, c->ci);
-	    break;
-	case TYREAL:
-	case TYDREAL:
-		fprintf(pass1_file, "%d: %d %s\n", P1_CONST, type,
-			cp->vstg ? c->cds[0] : cds(dtos(c->cd[0]), cdsbuf0));
-	    break;
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-		if (cp->vstg) {
-			cds0 = c->cds[0];
-			cds1 = c->cds[1];
-			}
-		else {
-			cds0 = cds(dtos(c->cd[0]), cdsbuf0);
-			cds1 = cds(dtos(c->cd[1]), cdsbuf1);
-			}
-		fprintf(pass1_file, "%d: %d %s %s\n", P1_CONST, type,
-			cds0, cds1);
-	    break;
-	case TYCHAR:
-	    if (vleng && !ISICON (vleng))
-		erri("p1_const:  bad vleng '%d'\n", (int) vleng);
-	    else
-		fprintf(pass1_file, "%d: %d %lx\n", P1_CONST, type,
-			cpexpr((expptr)cp));
-	    break;
-	default:
-	    erri ("p1_const:  bad constant type '%d'", type);
-	    break;
-    } /* switch */
-} /* p1_const */
-
-
- void
-#ifdef KR_headers
-p1_asgoto(addrp)
-	Addrp addrp;
-#else
-p1_asgoto(Addrp addrp)
-#endif
-{
-    p1put (P1_ASGOTO);
-    p1_addr (addrp);
-} /* p1_asgoto */
-
-
- void
-#ifdef KR_headers
-p1_goto(stateno)
-	ftnint stateno;
-#else
-p1_goto(ftnint stateno)
-#endif
-{
-    p1putd (P1_GOTO, stateno);
-} /* p1_goto */
-
-
- static void
-#ifdef KR_headers
-p1_addr(addrp)
-	register struct Addrblock *addrp;
-#else
-p1_addr(register struct Addrblock *addrp)
-#endif
-{
-    int stg;
-
-    if (addrp == (struct Addrblock *) NULL)
-	return;
-
-    stg = addrp -> vstg;
-
-    if (ONEOF(stg, M(STGINIT)|M(STGREG))
-	|| ONEOF(stg, M(STGCOMMON)|M(STGEQUIV)) &&
-		(!ISICON(addrp->memoffset)
-		|| (addrp->uname_tag == UNAM_NAME
-			? addrp->memoffset->constblock.Const.ci
-				!= addrp->user.name->voffset
-			: addrp->memoffset->constblock.Const.ci))
-	|| ONEOF(stg, M(STGBSS)|M(STGINIT)|M(STGAUTO)|M(STGARG)) &&
-		(!ISICON(addrp->memoffset)
-			|| addrp->memoffset->constblock.Const.ci)
-	|| addrp->Field || addrp->isarray || addrp->vstg == STGLENG)
-	{
-		p1_big_addr (addrp);
-		return;
-	}
-
-/* Write out a level of indirection for non-array arguments, which have
-   addrp -> memoffset   set and are handled by   p1_big_addr().
-   Lengths are passed by value, so don't check STGLENG
-   28-Jun-89 (dmg)  Added the check for != TYCHAR
- */
-
-    if (oneof_stg ( addrp -> uname_tag == UNAM_NAME ? addrp -> user.name : NULL,
-	    stg, M(STGARG)|M(STGEQUIV)) && addrp->vtype != TYCHAR) {
-	p1putdd (P1_EXPR, OPWHATSIN, addrp -> vtype);
-	p1_expr (ENULL);	/* Put dummy   vleng   */
-    } /* if stg == STGARG */
-
-    switch (addrp -> uname_tag) {
-        case UNAM_NAME:
-	    p1_name (addrp -> user.name);
-	    break;
-	case UNAM_IDENT:
-	    p1putdds(P1_IDENT, addrp->vtype, addrp->vstg,
-				addrp->user.ident);
-	    break;
-	case UNAM_CHARP:
-		p1putdds(P1_CHARP, addrp->vtype, addrp->vstg,
-				addrp->user.Charp);
-		break;
-	case UNAM_EXTERN:
-	    p1putd (P1_EXTERN, (long) addrp -> memno);
-	    if (addrp->vclass == CLPROC)
-		extsymtab[addrp->memno].extype = addrp->vtype;
-	    break;
-	case UNAM_CONST:
-	    if (addrp -> memno != BAD_MEMNO)
-		p1_literal (addrp -> memno);
-	    else
-		p1_const((struct Constblock *)addrp);
-	    break;
-	case UNAM_UNKNOWN:
-	default:
-	    erri ("p1_addr:  unknown uname_tag '%d'", addrp -> uname_tag);
-	    break;
-    } /* switch */
-} /* p1_addr */
-
-
- static void
-#ifdef KR_headers
-p1_list(listp)
-	struct Listblock *listp;
-#else
-p1_list(struct Listblock *listp)
-#endif
-{
-    chainp lis;
-    int count = 0;
-
-    if (listp == (struct Listblock *) NULL)
-	return;
-
-/* Count the number of parameters in the list */
-
-    for (lis = listp -> listp; lis; lis = lis -> nextp)
-	count++;
-
-    p1putddd (P1_LIST, listp -> tag, listp -> vtype, count);
-
-    for (lis = listp -> listp; lis; lis = lis -> nextp)
-	p1_expr ((expptr) lis -> datap);
-
-} /* p1_list */
-
-
- void
-#ifdef KR_headers
-p1_label(lab)
-	long lab;
-#else
-p1_label(long lab)
-#endif
-{
-	if (parstate < INDATA)
-		earlylabs = mkchain((char *)lab, earlylabs);
-	else
-		p1putd (P1_LABEL, lab);
-	}
-
-
-
- static void
-#ifdef KR_headers
-p1_literal(memno)
-	long memno;
-#else
-p1_literal(long memno)
-#endif
-{
-    p1putd (P1_LITERAL, memno);
-} /* p1_literal */
-
-
- void
-#ifdef KR_headers
-p1_if(expr)
-	expptr expr;
-#else
-p1_if(expptr expr)
-#endif
-{
-    p1put (P1_IF);
-    p1_expr (expr);
-} /* p1_if */
-
-
-
-
- void
-#ifdef KR_headers
-p1_elif(expr)
-	expptr expr;
-#else
-p1_elif(expptr expr)
-#endif
-{
-    p1put (P1_ELIF);
-    p1_expr (expr);
-} /* p1_elif */
-
-
-
-
- void
-p1_else(Void)
-{
-    p1put (P1_ELSE);
-} /* p1_else */
-
-
-
-
- void
-p1_endif(Void)
-{
-    p1put (P1_ENDIF);
-} /* p1_endif */
-
-
-
-
- void
-p1else_end(Void)
-{
-    p1put (P1_ENDELSE);
-} /* p1else_end */
-
-
- static void
-#ifdef KR_headers
-p1_big_addr(addrp)
-	Addrp addrp;
-#else
-p1_big_addr(Addrp addrp)
-#endif
-{
-    if (addrp == (Addrp) NULL)
-	return;
-
-    p1putn (P1_ADDR, (int)sizeof(struct Addrblock), (char *) addrp);
-    p1_expr (addrp -> vleng);
-    p1_expr (addrp -> memoffset);
-    if (addrp->uname_tag == UNAM_NAME)
-	addrp->user.name->visused = 1;
-} /* p1_big_addr */
-
-
-
- static void
-#ifdef KR_headers
-p1_unary(e)
-	struct Exprblock *e;
-#else
-p1_unary(struct Exprblock *e)
-#endif
-{
-    if (e == (struct Exprblock *) NULL)
-	return;
-
-    p1putdd (P1_EXPR, (int) e -> opcode, e -> vtype);
-    p1_expr (e -> vleng);
-
-    switch (e -> opcode) {
-        case OPNEG:
-	case OPNEG1:
-	case OPNOT:
-	case OPABS:
-	case OPBITNOT:
-	case OPPREINC:
-	case OPPREDEC:
-	case OPADDR:
-	case OPIDENTITY:
-	case OPCHARCAST:
-	case OPDABS:
-	    p1_expr(e -> leftp);
-	    break;
-	default:
-	    erri ("p1_unary: bad opcode '%d'", (int) e -> opcode);
-	    break;
-    } /* switch */
-
-} /* p1_unary */
-
-
- static void
-#ifdef KR_headers
-p1_binary(e)
-	struct Exprblock *e;
-#else
-p1_binary(struct Exprblock *e)
-#endif
-{
-    if (e == (struct Exprblock *) NULL)
-	return;
-
-    p1putdd (P1_EXPR, e -> opcode, e -> vtype);
-    p1_expr (e -> vleng);
-    p1_expr (e -> leftp);
-    p1_expr (e -> rightp);
-} /* p1_binary */
-
-
- void
-#ifdef KR_headers
-p1_head(class, name)
-	int class;
-	char *name;
-#else
-p1_head(int class, char *name)
-#endif
-{
-    p1putds (P1_HEAD, class, name ? name : "");
-} /* p1_head */
-
-
- void
-#ifdef KR_headers
-p1_subr_ret(retexp)
-	expptr retexp;
-#else
-p1_subr_ret(expptr retexp)
-#endif
-{
-
-    p1put (P1_SUBR_RET);
-    p1_expr (cpexpr(retexp));
-} /* p1_subr_ret */
-
-
-
- void
-#ifdef KR_headers
-p1comp_goto(index, count, labels)
-	expptr index;
-	int count;
-	struct Labelblock **labels;
-#else
-p1comp_goto(expptr index, int count, struct Labelblock **labels)
-#endif
-{
-    struct Constblock c;
-    int i;
-    register struct Labelblock *L;
-
-    p1put (P1_COMP_GOTO);
-    p1_expr (index);
-
-/* Write out a P1_LIST directly, to avoid the overhead of allocating a
-   list before it's needed HACK HACK HACK */
-
-    p1putddd (P1_LIST, TLIST, TYUNKNOWN, count);
-    c.vtype = TYLONG;
-    c.vleng = 0;
-
-    for (i = 0; i < count; i++) {
-	L = labels[i];
-	L->labused = 1;
-	c.Const.ci = L->stateno;
-	p1_const(&c);
-    } /* for i = 0 */
-} /* p1comp_goto */
-
-
-
- void
-#ifdef KR_headers
-p1_for(init, test, inc)
-	expptr init;
-	expptr test;
-	expptr inc;
-#else
-p1_for(expptr init, expptr test, expptr inc)
-#endif
-{
-    p1put (P1_FOR);
-    p1_expr (init);
-    p1_expr (test);
-    p1_expr (inc);
-} /* p1_for */
-
-
- void
-p1for_end(Void)
-{
-    p1put (P1_ENDFOR);
-} /* p1for_end */
-
-
-
-
-/* ----------------------------------------------------------------------
-   The intermediate file actually gets written ONLY by the routines below.
-   To change the format of the file, you need only change these routines.
-   ----------------------------------------------------------------------
-*/
-
-
-/* p1puts -- Put a typed string into the Pass 1 intermediate file.  Assumes that
-   str   contains no newlines and is null-terminated. */
-
- void
-#ifdef KR_headers
-p1puts(type, str)
-	int type;
-	char *str;
-#else
-p1puts(int type, char *str)
-#endif
-{
-    fprintf (pass1_file, "%d: %s\n", type, str);
-} /* p1puts */
-
-
-/* p1putd -- Put a typed integer into the Pass 1 intermediate file. */
-
- static void
-#ifdef KR_headers
-p1putd(type, value)
-	int type;
-	long value;
-#else
-p1putd(int type, long value)
-#endif
-{
-    fprintf (pass1_file, "%d: %ld\n", type, value);
-} /* p1_putd */
-
-
-/* p1putdd -- Put a typed pair of integers into the intermediate file. */
-
- static void
-#ifdef KR_headers
-p1putdd(type, v1, v2)
-	int type;
-	int v1;
-	int v2;
-#else
-p1putdd(int type, int v1, int v2)
-#endif
-{
-    fprintf (pass1_file, "%d: %d %d\n", type, v1, v2);
-} /* p1putdd */
-
-
-/* p1putddd -- Put a typed triple of integers into the intermediate file. */
-
- static void
-#ifdef KR_headers
-p1putddd(type, v1, v2, v3)
-	int type;
-	int v1;
-	int v2;
-	int v3;
-#else
-p1putddd(int type, int v1, int v2, int v3)
-#endif
-{
-    fprintf (pass1_file, "%d: %d %d %d\n", type, v1, v2, v3);
-} /* p1putddd */
-
- union dL {
-	double d;
-	long L[2];
-	};
-
- static void
-#ifdef KR_headers
-p1putn(type, count, str)
-	int type;
-	int count;
-	char *str;
-#else
-p1putn(int type, int count, char *str)
-#endif
-{
-    int i;
-
-    fprintf (pass1_file, "%d: ", type);
-
-    for (i = 0; i < count; i++)
-	putc (str[i], pass1_file);
-
-    putc ('\n', pass1_file);
-} /* p1putn */
-
-
-
-/* p1put -- Put a type marker into the intermediate file. */
-
- void
-#ifdef KR_headers
-p1put(type)
-	int type;
-#else
-p1put(int type)
-#endif
-{
-    fprintf (pass1_file, "%d:\n", type);
-} /* p1put */
-
-
-
- static void
-#ifdef KR_headers
-p1putds(type, i, str)
-	int type;
-	int i;
-	char *str;
-#else
-p1putds(int type, int i, char *str)
-#endif
-{
-    fprintf (pass1_file, "%d: %d %s\n", type, i, str);
-} /* p1putds */
-
-
- static void
-#ifdef KR_headers
-p1putdds(token, type, stg, str)
-	int token;
-	int type;
-	int stg;
-	char *str;
-#else
-p1putdds(int token, int type, int stg, char *str)
-#endif
-{
-    fprintf (pass1_file, "%d: %d %d %s\n", token, type, stg, str);
-} /* p1putdds */
diff --git a/usr.bin/f2c/parse.h b/usr.bin/f2c/parse.h
deleted file mode 100644
index 6de2399..0000000
--- a/usr.bin/f2c/parse.h
+++ /dev/null
@@ -1,47 +0,0 @@
-#ifndef PARSE_INCLUDE
-#define PARSE_INCLUDE
-
-/* macros for the   parse_args   routine */
-
-#define P_STRING 1		/* Macros for the result_type attribute */
-#define P_CHAR 2
-#define P_SHORT 3
-#define P_INT 4
-#define P_LONG 5
-#define P_FILE 6
-#define P_OLD_FILE 7
-#define P_NEW_FILE 8
-#define P_FLOAT 9
-#define P_DOUBLE 10
-
-#define P_CASE_INSENSITIVE 01	/* Macros for the   flags   attribute */
-#define P_REQUIRED_PREFIX 02
-
-#define P_NO_ARGS 0		/* Macros for the   arg_count   attribute */
-#define P_ONE_ARG 1
-#define P_INFINITE_ARGS 2
-
-#define p_entry(pref,swit,flag,count,type,store,size) \
-    { (pref), (swit), (flag), (count), (type), (int *) (store), (size) }
-
-typedef struct {
-    char *prefix;
-    char *string;
-    int flags;
-    int count;
-    int result_type;
-    int *result_ptr;
-    int table_size;
-} arg_info;
-
-#ifdef KR_headers
-#define Argdcl(x) ()
-#else
-#define Argdcl(x) x
-#endif
-int	arg_verify Argdcl((char**, arg_info*, int));
-void	init_store Argdcl((arg_info*, int));
-int	match_table Argdcl((char*, arg_info*, int, int, int*));
-int	parse_args Argdcl((int, char**, arg_info*, int, char**, int));
-
-#endif
diff --git a/usr.bin/f2c/parse_args.c b/usr.bin/f2c/parse_args.c
deleted file mode 100644
index b6dc75d..0000000
--- a/usr.bin/f2c/parse_args.c
+++ /dev/null
@@ -1,557 +0,0 @@
-/****************************************************************
-Copyright 1990, 1994-5 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-/* parse_args
-
-	This function will parse command line input into appropriate data
-   structures, output error messages when appropriate and provide some
-   minimal type conversion.
-
-	Input to the function consists of the standard   argc,argv
-   values, and a table which directs the parser.  Each table entry has the
-   following components:
-
-	prefix -- the (optional) switch character string, e.g. "-" "/" "="
-	switch -- the command string, e.g. "o" "data" "file" "F"
-	flags -- control flags, e.g.   CASE_INSENSITIVE, REQUIRED_PREFIX
-	arg_count -- number of arguments this command requires, e.g. 0 for
-		     booleans, 1 for filenames, INFINITY for input files
-	result_type -- how to interpret the switch arguments, e.g. STRING,
-		       CHAR, FILE, OLD_FILE, NEW_FILE
-	result_ptr -- pointer to storage for the result, be it a table or
-		      a string or whatever
-	table_size -- if the arguments fill a table, the maximum number of
-		      entries; if there are no arguments, the value to
-		      load into the result storage
-
-	Although the table can be used to hold a list of filenames, only
-   scalar values (e.g. pointers) can be stored in the table.  No vector
-   processing will be done, only pointers to string storage will be moved.
-
-	An example entry, which could be used to parse input filenames, is:
-
-	"-", "o", 0, oo, OLD_FILE, infilenames, INFILE_TABLE_SIZE
-
-*/
-
-#include <stdio.h>
-#ifndef NULL
-/* ANSI C */
-#include <stddef.h>
-#endif
-#ifdef KR_headers
-extern double atof();
-#else
-#include "stdlib.h"
-#include "string.h"
-#endif
-#include "parse.h"
-#include <math.h>	     /* For atof */
-#include <ctype.h>
-
-#define MAX_INPUT_SIZE 1000
-
-#define arg_prefix(x) ((x).prefix)
-#define arg_string(x) ((x).string)
-#define arg_flags(x) ((x).flags)
-#define arg_count(x) ((x).count)
-#define arg_result_type(x) ((x).result_type)
-#define arg_result_ptr(x) ((x).result_ptr)
-#define arg_table_size(x) ((x).table_size)
-
-#ifndef TRUE
-#define TRUE 1
-#endif
-#ifndef FALSE
-#define FALSE 0
-#endif
-typedef int boolean;
-
-
-static char *this_program = "";
-
-static int arg_parse Argdcl((char*, arg_info*));
-static char *lower_string Argdcl((char*, char*));
-static int match Argdcl((char*, char*, arg_info*, boolean));
-static int put_one_arg Argdcl((int, char*, char**, char*, char*));
-extern int badargs;
-
-
- boolean
-#ifdef KR_headers
-parse_args(argc, argv, table, entries, others, other_count)
-	int argc;
-	char **argv;
-	arg_info *table;
-	int entries;
-	char **others;
-	int other_count;
-#else
-parse_args(int argc, char **argv, arg_info *table, int entries, char **others, int other_count)
-#endif
-{
-    boolean result;
-
-    if (argv)
-	this_program = argv[0];
-
-/* Check the validity of the table and its parameters */
-
-    result = arg_verify (argv, table, entries);
-
-/* Initialize the storage values */
-
-    init_store (table, entries);
-
-    if (result) {
-	boolean use_prefix = TRUE;
-	char *argv0;
-
-	argc--;
-	argv0 = *++argv;
-	while (argc) {
-	    int index, length;
-
-	    index = match_table (*argv, table, entries, use_prefix, &length);
-	    if (index < 0) {
-
-/* The argument doesn't match anything in the table */
-
-		if (others) {
-
-		    if (*argv > argv0)
-			*--*argv = '-';	/* complain at invalid flag */
-
-		    if (other_count > 0) {
-			*others++ = *argv;
-			other_count--;
-		    } else {
-			fprintf (stderr, "%s:  too many parameters: ",
-				this_program);
-			fprintf (stderr, "'%s' ignored\n", *argv);
-			badargs++;
-		    } /* else */
-		} /* if (others) */
-		argv0 = *++argv;
-		argc--;
-	    } else {
-
-/* A match was found */
-
-		if (length >= strlen (*argv)) {
-		    argc--;
-		    argv0 = *++argv;
-		    use_prefix = TRUE;
-		} else {
-		    (*argv) += length;
-		    use_prefix = FALSE;
-		} /* else */
-
-/* Parse any necessary arguments */
-
-		if (arg_count (table[index]) != P_NO_ARGS) {
-
-/* Now   length   will be used to store the number of parsed characters */
-
-		    length = arg_parse(*argv, &table[index]);
-		    if (*argv == NULL)
-			argc = 0;
-		    else if (length >= strlen (*argv)) {
-			argc--;
-			argv0 = *++argv;
-			use_prefix = TRUE;
-		    } else {
-			(*argv) += length;
-			use_prefix = FALSE;
-		    } /* else */
-		} /* if (argv_count != P_NO_ARGS) */
-		  else
-		    *arg_result_ptr(table[index]) =
-			    arg_table_size(table[index]);
-	    } /* else */
-	} /* while (argc) */
-    } /* if (result) */
-
-    return result;
-} /* parse_args */
-
-
- boolean
-#ifdef KR_headers
-arg_verify(argv, table, entries)
-	char **argv;
-	arg_info *table;
-	int entries;
-#else
-arg_verify(char **argv, arg_info *table, int entries)
-#endif
-{
-    int i;
-    char *this_program = "";
-
-    if (argv)
-	this_program = argv[0];
-
-    for (i = 0; i < entries; i++) {
-	arg_info *arg = &table[i];
-
-/* Check the argument flags */
-
-	if (arg_flags (*arg) & ~(P_CASE_INSENSITIVE | P_REQUIRED_PREFIX)) {
-	    fprintf (stderr, "%s [arg_verify]:  too many ", this_program);
-	    fprintf (stderr, "flags in entry %d:  '%x' (hex)\n", i,
-		    arg_flags (*arg));
-	    badargs++;
-	} /* if */
-
-/* Check the argument count */
-
-	{ int count = arg_count (*arg);
-
-	    if (count != P_NO_ARGS && count != P_ONE_ARG && count !=
-		    P_INFINITE_ARGS) {
-		fprintf (stderr, "%s [arg_verify]:  invalid ", this_program);
-		fprintf (stderr, "argument count in entry %d:  '%d'\n", i,
-			count);
-		badargs++;
-	    } /* if count != P_NO_ARGS ... */
-
-/* Check the result field; want to be able to store results */
-
-	      else
-		if (arg_result_ptr (*arg) == (int *) NULL) {
-		    fprintf (stderr, "%s [arg_verify]:  ", this_program);
-		    fprintf (stderr, "no argument storage given for ");
-		    fprintf (stderr, "entry %d\n", i);
-		    badargs++;
-		} /* if arg_result_ptr */
-	}
-
-/* Check the argument type */
-
-	{ int type = arg_result_type (*arg);
-
-	    if (type < P_STRING || type > P_DOUBLE) {
-		    fprintf(stderr,
-			"%s [arg_verify]:  bad arg type in entry %d:  '%d'\n",
-			this_program, i, type);
-		    badargs++;
-		    }
-	}
-
-/* Check table size */
-
-	{ int size = arg_table_size (*arg);
-
-	    if (arg_count (*arg) == P_INFINITE_ARGS && size < 1) {
-		fprintf (stderr, "%s [arg_verify]:  bad ", this_program);
-		fprintf (stderr, "table size in entry %d:  '%d'\n", i,
-			size);
-		badargs++;
-	    } /* if (arg_count == P_INFINITE_ARGS && size < 1) */
-	}
-
-    } /* for i = 0 */
-
-    return TRUE;
-} /* arg_verify */
-
-
-/* match_table -- returns the index of the best entry matching the input,
-   -1 if no match.  The best match is the one of longest length which
-   appears lowest in the table.  The length of the match will be returned
-   in   length   ONLY IF a match was found.   */
-
- int
-#ifdef KR_headers
-match_table(norm_input, table, entries, use_prefix, length)
-	register char *norm_input;
-	arg_info *table;
-	int entries;
-	boolean use_prefix;
-	int *length;
-#else
-match_table(register char *norm_input, arg_info *table, int entries, boolean use_prefix, int *length)
-#endif
-{
-    char low_input[MAX_INPUT_SIZE];
-    register int i;
-    int best_index = -1, best_length = 0;
-
-/* FUNCTION BODY */
-
-    (void) lower_string (low_input, norm_input);
-
-    for (i = 0; i < entries; i++) {
-	int this_length = match(norm_input, low_input, &table[i], use_prefix);
-
-	if (this_length > best_length) {
-	    best_index = i;
-	    best_length = this_length;
-	} /* if (this_length > best_length) */
-    } /* for (i = 0) */
-
-    if (best_index > -1 && length != (int *) NULL)
-	*length = best_length;
-
-    return best_index;
-} /* match_table */
-
-
-/* match -- takes an input string and table entry, and returns the length
-   of the longer match.
-
-	0 ==> input doesn't match
-
-   For example:
-
-	INPUT	PREFIX	STRING	RESULT
-----------------------------------------------------------------------
-	"abcd"	"-"	"d"	0
-	"-d"	"-"	"d"	2    (i.e. "-d")
-	"dout"	"-"	"d"	1    (i.e. "d")
-	"-d"	""	"-d"	2    (i.e. "-d")
-	"dd"	"d"	"d"	2	<= here's the weird one
-*/
-
- static int
-#ifdef KR_headers
-match(norm_input, low_input, entry, use_prefix)
-	char *norm_input;
-	char *low_input;
-	arg_info *entry;
-	boolean use_prefix;
-#else
-match(char *norm_input, char *low_input, arg_info *entry, boolean use_prefix)
-#endif
-{
-    char *norm_prefix = arg_prefix (*entry);
-    char *norm_string = arg_string (*entry);
-    boolean prefix_match = FALSE, string_match = FALSE;
-    int result = 0;
-
-/* Buffers for the lowercased versions of the strings being compared.
-   These are used when the switch is to be case insensitive */
-
-    static char low_prefix[MAX_INPUT_SIZE];
-    static char low_string[MAX_INPUT_SIZE];
-    int prefix_length = strlen (norm_prefix);
-    int string_length = strlen (norm_string);
-
-/* Pointers for the required strings (lowered or nonlowered) */
-
-    register char *input, *prefix, *string;
-
-/* FUNCTION BODY */
-
-/* Use the appropriate strings to handle case sensitivity */
-
-    if (arg_flags (*entry) & P_CASE_INSENSITIVE) {
-	input = low_input;
-	prefix = lower_string (low_prefix, norm_prefix);
-	string = lower_string (low_string, norm_string);
-    } else {
-	input = norm_input;
-	prefix = norm_prefix;
-	string = norm_string;
-    } /* else */
-
-/* First, check the string formed by concatenating the prefix onto the
-   switch string, but only when the prefix is not being ignored */
-
-    if (use_prefix && prefix != NULL && *prefix != '\0')
-	 prefix_match = (strncmp (input, prefix, prefix_length) == 0) &&
-		(strncmp (input + prefix_length, string, string_length) == 0);
-
-/* Next, check just the switch string, if that's allowed */
-
-    if (!use_prefix && (arg_flags (*entry) & P_REQUIRED_PREFIX) == 0)
-	string_match = strncmp (input, string, string_length) == 0;
-
-    if (prefix_match)
-	result = prefix_length + string_length;
-    else if (string_match)
-	result = string_length;
-
-    return result;
-} /* match */
-
-
- static char *
-#ifdef KR_headers
-lower_string(dest, src)
-	char *dest;
-	char *src;
-#else
-lower_string(char *dest, char *src)
-#endif
-{
-    char *result = dest;
-    register int c;
-
-    if (dest == NULL || src == NULL)
-	result = NULL;
-    else
-	while (*dest++ = (c = *src++) >= 'A' && c <= 'Z' ? tolower(c) : c);
-
-    return result;
-} /* lower_string */
-
-
-/* arg_parse -- returns the number of characters parsed for this entry */
-
- static int
-#ifdef KR_headers
-arg_parse(str, entry)
-	char *str;
-	arg_info *entry;
-#else
-arg_parse(char *str, arg_info *entry)
-#endif
-{
-    int length = 0;
-
-    if (arg_count (*entry) == P_ONE_ARG) {
-	char **store = (char **) arg_result_ptr (*entry);
-
-	length = put_one_arg (arg_result_type (*entry), str, store,
-		arg_prefix (*entry), arg_string (*entry));
-
-    } /* if (arg_count == P_ONE_ARG) */
-      else { /* Must be a table of arguments */
-	char **store = (char **) arg_result_ptr (*entry);
-
-	if (store) {
-	    while (*store)
-		store++;
-
-	    length = put_one_arg(arg_result_type (*entry), str, store++,
-		    arg_prefix (*entry), arg_string (*entry));
-
-	    *store = (char *) NULL;
-	} /* if (store) */
-    } /* else */
-
-    return length;
-} /* arg_parse */
-
-
- static int
-#ifdef KR_headers
-put_one_arg(type, str, store, prefix, string)
-	int type;
-	char *str;
-	char **store;
-	char *prefix;
-	char *string;
-#else
-put_one_arg(int type, char *str, char **store, char *prefix, char *string)
-#endif
-{
-    int length = 0;
-    long L;
-
-    if (store) {
-	switch (type) {
-	    case P_STRING:
-	    case P_FILE:
-	    case P_OLD_FILE:
-	    case P_NEW_FILE:
-		if (str == NULL) {
-			fprintf(stderr, "%s: Missing argument after '%s%s'\n",
-				this_program, prefix, string);
-			length = 0;
-			badargs++;
-			}
-		else
-			length = strlen(*store = str);
-		break;
-	    case P_CHAR:
-		*((char *) store) = *str;
-		length = 1;
-		break;
-	    case P_SHORT:
-		L = atol(str);
-		*(short *)store = (short) L;
-		if (L != *(short *)store) {
-		    fprintf(stderr,
-	"%s%s parameter '%ld' is not a SHORT INT (truncating to %d)\n",
-			    prefix, string, L, *(short *)store);
-		    badargs++;
-		    }
-		length = strlen (str);
-		break;
-	    case P_INT:
-		L = atol(str);
-		*(int *)store = (int)L;
-		if (L != *(int *)store) {
-		    fprintf(stderr,
-	"%s%s parameter '%ld' is not an INT (truncating to %d)\n",
-			    prefix, string, L, *(int *)store);
-		    badargs++;
-		    }
-		length = strlen (str);
-		break;
-	    case P_LONG:
-		*(long *)store = atol(str);
-		length = strlen (str);
-		break;
-	    case P_FLOAT:
-		*((float *) store) = (float) atof(str);
-		length = strlen (str);
-		break;
-	    case P_DOUBLE:
-		*((double *) store) = (double) atof(str);
-		length = strlen (str);
-		break;
-	    default:
-		fprintf (stderr, "put_one_arg:  bad type '%d'\n", type);
-		badargs++;
-		break;
-	} /* switch */
-    } /* if (store) */
-
-    return length;
-} /* put_one_arg */
-
-
- void
-#ifdef KR_headers
-init_store(table, entries)
-	arg_info *table;
-	int entries;
-#else
-init_store(arg_info *table, int entries)
-#endif
-{
-    int index;
-
-    for (index = 0; index < entries; index++)
-	if (arg_count (table[index]) == P_INFINITE_ARGS) {
-	    char **place = (char **) arg_result_ptr (table[index]);
-
-	    if (place)
-		*place = (char *) NULL;
-	} /* if arg_count == P_INFINITE_ARGS */
-
-} /* init_store */
diff --git a/usr.bin/f2c/pccdefs.h b/usr.bin/f2c/pccdefs.h
deleted file mode 100644
index bde8117..0000000
--- a/usr.bin/f2c/pccdefs.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/* The following numbers are strange, and implementation-dependent */
-
-#define P2BAD -1
-#define P2NAME 2
-#define P2ICON 4		/* Integer constant */
-#define P2PLUS 6
-#define P2PLUSEQ 7
-#define P2MINUS 8
-#define P2NEG 10
-#define P2STAR 11
-#define P2STAREQ 12
-#define P2INDIRECT 13
-#define P2BITAND 14
-#define P2BITOR 17
-#define P2BITXOR 19
-#define P2QUEST 21
-#define P2COLON 22
-#define P2ANDAND 23
-#define P2OROR 24
-#define P2GOTO 37
-#define P2LISTOP 56
-#define P2ASSIGN 58
-#define P2COMOP 59
-#define P2SLASH 60
-#define P2MOD 62
-#define P2LSHIFT 64
-#define P2RSHIFT 66
-#define P2CALL 70
-#define P2CALL0 72
-
-#define P2NOT 76
-#define P2BITNOT 77
-#define P2EQ 80
-#define P2NE 81
-#define P2LE 82
-#define P2LT 83
-#define P2GE 84
-#define P2GT 85
-#define P2REG 94
-#define P2OREG 95
-#define P2CONV 104
-#define P2FORCE 108
-#define P2CBRANCH 109
-
-/* special operators included only for fortran's use */
-
-#define P2PASS 200
-#define P2STMT 201
-#define P2SWITCH 202
-#define P2LBRACKET 203
-#define P2RBRACKET 204
-#define P2EOF 205
-#define P2ARIF 206
-#define P2LABEL 207
-
-#define P2SHORT 3
-#define P2INT 4
-#define P2LONG 4
-
-#define P2CHAR 2
-#define P2REAL 6
-#define P2DREAL 7
-#define P2PTR 020
-#define P2FUNCT 040
diff --git a/usr.bin/f2c/pread.c b/usr.bin/f2c/pread.c
deleted file mode 100644
index eb1576a..0000000
--- a/usr.bin/f2c/pread.c
+++ /dev/null
@@ -1,990 +0,0 @@
-/****************************************************************
-Copyright 1990, 1992, 1993, 1994 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-
- static char Ptok[128], Pct[Table_size];
- static char *Pfname;
- static long Plineno;
- static int Pbad;
- static int *tfirst, *tlast, *tnext, tmax;
-
-#define P_space	1
-#define P_anum	2
-#define P_delim	3
-#define P_slash	4
-
-#define TGULP	100
-
- static void
-trealloc(Void)
-{
-	int k = tmax;
-	tfirst = (int *)realloc((char *)tfirst,
-		(tmax += TGULP)*sizeof(int));
-	if (!tfirst) {
-		fprintf(stderr,
-		"Pfile: realloc failure!\n");
-		exit(2);
-		}
-	tlast = tfirst + tmax;
-	tnext = tfirst + k;
-	}
-
- static void
-#ifdef KR_headers
-badchar(c)
-	int c;
-#else
-badchar(int c)
-#endif
-{
-	fprintf(stderr,
-		"unexpected character 0x%.2x = '%c' on line %ld of %s\n",
-		c, c, Plineno, Pfname);
-	exit(2);
-	}
-
- static void
-bad_type(Void)
-{
-	fprintf(stderr,
-		"unexpected type \"%s\" on line %ld of %s\n",
-		Ptok, Plineno, Pfname);
-	exit(2);
-	}
-
- static void
-#ifdef KR_headers
-badflag(tname, option)
-	char *tname;
-	char *option;
-#else
-badflag(char *tname, char *option)
-#endif
-{
-	fprintf(stderr, "%s type from `f2c -%s` on line %ld of %s\n",
-		tname, option, Plineno, Pfname);
-	Pbad++;
-	}
-
- static void
-#ifdef KR_headers
-detected(msg)
-	char *msg;
-#else
-detected(char *msg)
-#endif
-{
-	fprintf(stderr,
-	"%sdetected on line %ld of %s\n", msg, Plineno, Pfname);
-	Pbad++;
-	}
-
-#if 0
- static void
-#ifdef KR_headers
-checklogical(k)
-	int k;
-#else
-checklogical(int k)
-#endif
-{
-	static int lastmsg = 0;
-	static int seen[2] = {0,0};
-
-	seen[k] = 1;
-	if (seen[1-k]) {
-		if (lastmsg < 3) {
-			lastmsg = 3;
-			detected(
-	"Illegal combination of LOGICAL types -- mixing -I4 with -I2 or -i2\n\t");
-			}
-		return;
-		}
-	if (k) {
-		if (tylogical == TYLONG || lastmsg >= 2)
-			return;
-		if (!lastmsg) {
-			lastmsg = 2;
-			badflag("LOGICAL", "I4");
-			}
-		}
-	else {
-		if (tylogical == TYSHORT || lastmsg & 1)
-			return;
-		if (!lastmsg) {
-			lastmsg = 1;
-			badflag("LOGICAL", "i2` or `f2c -I2");
-			}
-		}
-	}
-#else
-#define checklogical(n) /* */
-#endif
-
- static void
-#ifdef KR_headers
-checkreal(k)
-	int k;
-#else
-checkreal(int k)
-#endif
-{
-	static int warned = 0;
-	static int seen[2] = {0,0};
-
-	seen[k] = 1;
-	if (seen[1-k]) {
-		if (warned < 2)
-			detected("Illegal mixture of -R and -!R ");
-		warned = 2;
-		return;
-		}
-	if (k == forcedouble || warned)
-		return;
-	warned = 1;
-	badflag("REAL return", k ? "!R" : "R");
-	}
-
- static void
-#ifdef KR_headers
-Pnotboth(e)
-	Extsym *e;
-#else
-Pnotboth(Extsym *e)
-#endif
-{
-	if (e->curno)
-		return;
-	Pbad++;
-	e->curno = 1;
-	fprintf(stderr,
-	"%s cannot be both a procedure and a common block (line %ld of %s)\n",
-		e->fextname, Plineno, Pfname);
-	}
-
- static int
-#ifdef KR_headers
-numread(pf, n)
-	register FILE *pf;
-	int *n;
-#else
-numread(register FILE *pf, int *n)
-#endif
-{
-	register int c, k;
-
-	if ((c = getc(pf)) < '0' || c > '9')
-		return c;
-	k = c - '0';
-	for(;;) {
-		if ((c = getc(pf)) == ' ') {
-			*n = k;
-			return c;
-			}
-		if (c < '0' || c > '9')
-			break;
-		k = 10*k + c - '0';
-		}
-	return c;
-	}
-
- static void argverify Argdcl((int, Extsym*));
- static void Pbadret Argdcl((int ftype, Extsym *p));
-
- static int
-#ifdef KR_headers
-readref(pf, e, ftype)
-	register FILE *pf;
-	Extsym *e;
-	int ftype;
-#else
-readref(register FILE *pf, Extsym *e, int ftype)
-#endif
-{
-	register int c, *t;
-	int i, nargs, type;
-	Argtypes *at;
-	Atype *a, *ae;
-
-	if (ftype > TYSUBR)
-		return 0;
-	if ((c = numread(pf, &nargs)) != ' ') {
-		if (c != ':')
-			return c == EOF;
-		/* just a typed external */
-		if (e->extstg == STGUNKNOWN) {
-			at = 0;
-			goto justsym;
-			}
-		if (e->extstg == STGEXT) {
-			if (e->extype != ftype)
-				Pbadret(ftype, e);
-			}
-		else
-			Pnotboth(e);
-		return 0;
-		}
-
-	tnext = tfirst;
-	for(i = 0; i < nargs; i++) {
-		if ((c = numread(pf, &type)) != ' '
-		|| type >= 500
-		|| type != TYFTNLEN + 100 && type % 100 > TYSUBR)
-			return c == EOF;
-		if (tnext >= tlast)
-			trealloc();
-		*tnext++ = type;
-		}
-
-	if (e->extstg == STGUNKNOWN) {
- save_at:
-		at = (Argtypes *)
-			gmem(sizeof(Argtypes) + (nargs-1)*sizeof(Atype), 1);
-		at->dnargs = at->nargs = nargs;
-		at->changes = 0;
-		t = tfirst;
-		a = at->atypes;
-		for(ae = a + nargs; a < ae; a++) {
-			a->type = *t++;
-			a->cp = 0;
-			}
- justsym:
-		e->extstg = STGEXT;
-		e->extype = ftype;
-		e->arginfo = at;
-		}
-	else if (e->extstg != STGEXT) {
-		Pnotboth(e);
-		}
-	else if (!e->arginfo) {
-		if (e->extype != ftype)
-			Pbadret(ftype, e);
-		else
-			goto save_at;
-		}
-	else
-		argverify(ftype, e);
-	return 0;
-	}
-
- static int
-#ifdef KR_headers
-comlen(pf)
-	register FILE *pf;
-#else
-comlen(register FILE *pf)
-#endif
-{
-	register int c;
-	register char *s, *se;
-	char buf[128], cbuf[128];
-	int refread;
-	long L;
-	Extsym *e;
-
-	if ((c = getc(pf)) == EOF)
-		return 1;
-	if (c == ' ') {
-		refread = 0;
-		s = "comlen ";
-		}
-	else if (c == ':') {
-		refread = 1;
-		s = "ref: ";
-		}
-	else {
- ret0:
-		if (c == '*')
-			ungetc(c,pf);
-		return 0;
-		}
-	while(*s) {
-		if ((c = getc(pf)) == EOF)
-			return 1;
-		if (c != *s++)
-			goto ret0;
-		}
-	s = buf;
-	se = buf + sizeof(buf) - 1;
-	for(;;) {
-		if ((c = getc(pf)) == EOF)
-			return 1;
-		if (c == ' ')
-			break;
-		if (s >= se || Pct[c] != P_anum)
-			goto ret0;
-		*s++ = c;
-		}
-	*s-- = 0;
-	if (s <= buf || *s != '_')
-		return 0;
-	strcpy(cbuf,buf);
-	*s-- = 0;
-	if (*s == '_') {
-		*s-- = 0;
-		if (s <= buf)
-			return 0;
-		}
-	for(L = 0;;) {
-		if ((c = getc(pf)) == EOF)
-			return 1;
-		if (c == ' ')
-			break;
-		if (c < '0' && c > '9')
-			goto ret0;
-		L = 10*L + c - '0';
-		}
-	if (!L && !refread)
-		return 0;
-	e = mkext1(buf, cbuf);
-	if (refread)
-		return readref(pf, e, (int)L);
-	if (e->extstg == STGUNKNOWN) {
-		e->extstg = STGCOMMON;
-		e->maxleng = L;
-		}
-	else if (e->extstg != STGCOMMON)
-		Pnotboth(e);
-	else if (e->maxleng != L) {
-		fprintf(stderr,
-	"incompatible lengths for common block %s (line %ld of %s)\n",
-				    buf, Plineno, Pfname);
-		if (e->maxleng < L)
-			e->maxleng = L;
-		}
-	return 0;
-	}
-
- static int
-#ifdef KR_headers
-Ptoken(pf, canend)
-	FILE *pf;
-	int canend;
-#else
-Ptoken(FILE *pf, int canend)
-#endif
-{
-	register int c;
-	register char *s, *se;
-
- top:
-	for(;;) {
-		c = getc(pf);
-		if (c == EOF) {
-			if (canend)
-				return 0;
-			goto badeof;
-			}
-		if (Pct[c] != P_space)
-			break;
-		if (c == '\n')
-			Plineno++;
-		}
-	switch(Pct[c]) {
-		case P_anum:
-			if (c == '_')
-				badchar(c);
-			s = Ptok;
-			se = s + sizeof(Ptok) - 1;
-			do {
-				if (s < se)
-					*s++ = c;
-				if ((c = getc(pf)) == EOF) {
- badeof:
-					fprintf(stderr,
-					"unexpected end of file in %s\n",
-						Pfname);
-					exit(2);
-					}
-				}
-				while(Pct[c] == P_anum);
-			ungetc(c,pf);
-			*s = 0;
-			return P_anum;
-
-		case P_delim:
-			return c;
-
-		case P_slash:
-			if ((c = getc(pf)) != '*') {
-				if (c == EOF)
-					goto badeof;
-				badchar('/');
-				}
-			if (canend && comlen(pf))
-				goto badeof;
-			for(;;) {
-				while((c = getc(pf)) != '*') {
-					if (c == EOF)
-						goto badeof;
-					if (c == '\n')
-						Plineno++;
-					}
- slashseek:
-				switch(getc(pf)) {
-					case '/':
-						goto top;
-					case EOF:
-						goto badeof;
-					case '*':
-						goto slashseek;
-					}
-				}
-		default:
-			badchar(c);
-		}
-	/* NOT REACHED */
-	return 0;
-	}
-
- static int
-Pftype(Void)
-{
-	switch(Ptok[0]) {
-		case 'C':
-			if (!strcmp(Ptok+1, "_f"))
-				return TYCOMPLEX;
-			break;
-		case 'E':
-			if (!strcmp(Ptok+1, "_f")) {
-				/* TYREAL under forcedouble */
-				checkreal(1);
-				return TYREAL;
-				}
-			break;
-		case 'H':
-			if (!strcmp(Ptok+1, "_f"))
-				return TYCHAR;
-			break;
-		case 'Z':
-			if (!strcmp(Ptok+1, "_f"))
-				return TYDCOMPLEX;
-			break;
-		case 'd':
-			if (!strcmp(Ptok+1, "oublereal"))
-				return TYDREAL;
-			break;
-		case 'i':
-			if (!strcmp(Ptok+1, "nt"))
-				return TYSUBR;
-			if (!strcmp(Ptok+1, "nteger"))
-				return TYLONG;
-			if (!strcmp(Ptok+1, "nteger1"))
-				return TYINT1;
-			break;
-		case 'l':
-			if (!strcmp(Ptok+1, "ogical")) {
-				checklogical(1);
-				return TYLOGICAL;
-				}
-			if (!strcmp(Ptok+1, "ogical1"))
-				return TYLOGICAL1;
-#ifdef TYQUAD
-			if (!strcmp(Ptok+1, "ongint"))
-				return TYQUAD;
-#endif
-			break;
-		case 'r':
-			if (!strcmp(Ptok+1, "eal")) {
-				checkreal(0);
-				return TYREAL;
-				}
-			break;
-		case 's':
-			if (!strcmp(Ptok+1, "hortint"))
-				return TYSHORT;
-			if (!strcmp(Ptok+1, "hortlogical")) {
-				checklogical(0);
-				return TYLOGICAL2;
-				}
-			break;
-		}
-	bad_type();
-	/* NOT REACHED */
-	return 0;
-	}
-
- static void
-#ifdef KR_headers
-wanted(i, what)
-	int i;
-	char *what;
-#else
-wanted(int i, char *what)
-#endif
-{
-	if (i != P_anum) {
-		Ptok[0] = i;
-		Ptok[1] = 0;
-		}
-	fprintf(stderr,"Error: expected %s, not \"%s\" (line %ld of %s)\n",
-		what, Ptok, Plineno, Pfname);
-	exit(2);
-	}
-
- static int
-#ifdef KR_headers
-Ptype(pf)
-	FILE *pf;
-#else
-Ptype(FILE *pf)
-#endif
-{
-	int i, rv;
-
-	i = Ptoken(pf,0);
-	if (i == ')')
-		return 0;
-	if (i != P_anum)
-		badchar(i);
-
-	rv = 0;
-	switch(Ptok[0]) {
-		case 'C':
-			if (!strcmp(Ptok+1, "_fp"))
-				rv = TYCOMPLEX+200;
-			break;
-		case 'D':
-			if (!strcmp(Ptok+1, "_fp"))
-				rv = TYDREAL+200;
-			break;
-		case 'E':
-		case 'R':
-			if (!strcmp(Ptok+1, "_fp"))
-				rv = TYREAL+200;
-			break;
-		case 'H':
-			if (!strcmp(Ptok+1, "_fp"))
-				rv = TYCHAR+200;
-			break;
-		case 'I':
-			if (!strcmp(Ptok+1, "_fp"))
-				rv = TYLONG+200;
-			else if (!strcmp(Ptok+1, "1_fp"))
-				rv = TYINT1+200;
-#ifdef TYQUAD
-			else if (!strcmp(Ptok+1, "8_fp"))
-				rv = TYQUAD+200;
-#endif
-			break;
-		case 'J':
-			if (!strcmp(Ptok+1, "_fp"))
-				rv = TYSHORT+200;
-			break;
-		case 'K':
-			checklogical(0);
-			goto Logical;
-		case 'L':
-			checklogical(1);
- Logical:
-			if (!strcmp(Ptok+1, "_fp"))
-				rv = TYLOGICAL+200;
-			else if (!strcmp(Ptok+1, "1_fp"))
-				rv = TYLOGICAL1+200;
-			else if (!strcmp(Ptok+1, "2_fp"))
-				rv = TYLOGICAL2+200;
-			break;
-		case 'S':
-			if (!strcmp(Ptok+1, "_fp"))
-				rv = TYSUBR+200;
-			break;
-		case 'U':
-			if (!strcmp(Ptok+1, "_fp"))
-				rv = TYUNKNOWN+300;
-			break;
-		case 'Z':
-			if (!strcmp(Ptok+1, "_fp"))
-				rv = TYDCOMPLEX+200;
-			break;
-		case 'c':
-			if (!strcmp(Ptok+1, "har"))
-				rv = TYCHAR;
-			else if (!strcmp(Ptok+1, "omplex"))
-				rv = TYCOMPLEX;
-			break;
-		case 'd':
-			if (!strcmp(Ptok+1, "oublereal"))
-				rv = TYDREAL;
-			else if (!strcmp(Ptok+1, "oublecomplex"))
-				rv = TYDCOMPLEX;
-			break;
-		case 'f':
-			if (!strcmp(Ptok+1, "tnlen"))
-				rv = TYFTNLEN+100;
-			break;
-		case 'i':
-			if (!strncmp(Ptok+1, "nteger", 6)) {
-				if (!Ptok[7])
-					rv = TYLONG;
-				else if (Ptok[7] == '1' && !Ptok[8])
-					rv = TYINT1;
-				}
-			break;
-		case 'l':
-			if (!strncmp(Ptok+1, "ogical", 6)) {
-				if (!Ptok[7]) {
-					checklogical(1);
-					rv = TYLOGICAL;
-					}
-				else if (Ptok[7] == '1' && !Ptok[8])
-					rv = TYLOGICAL1;
-				}
-#ifdef TYQUAD
-			else if (!strcmp(Ptok+1,"ongint"))
-				rv = TYQUAD;
-#endif
-			break;
-		case 'r':
-			if (!strcmp(Ptok+1, "eal"))
-				rv = TYREAL;
-			break;
-		case 's':
-			if (!strcmp(Ptok+1, "hortint"))
-				rv = TYSHORT;
-			else if (!strcmp(Ptok+1, "hortlogical")) {
-				checklogical(0);
-				rv = TYLOGICAL2;
-				}
-			break;
-		case 'v':
-			if (tnext == tfirst && !strcmp(Ptok+1, "oid")) {
-				if ((i = Ptoken(pf,0)) != /*(*/ ')')
-					wanted(i, /*(*/ "\")\"");
-				return 0;
-				}
-		}
-	if (!rv)
-		bad_type();
-	if (rv < 100 && (i = Ptoken(pf,0)) != '*')
-			wanted(i, "\"*\"");
-	if ((i = Ptoken(pf,0)) == P_anum)
-		i = Ptoken(pf,0);	/* skip variable name */
-	switch(i) {
-		case ')':
-			ungetc(i,pf);
-			break;
-		case ',':
-			break;
-		default:
-			wanted(i, "\",\" or \")\"");
-		}
-	return rv;
-	}
-
- static char *
-trimunder(Void)
-{
-	register char *s;
-	register int n;
-	static char buf[128];
-
-	s = Ptok + strlen(Ptok) - 1;
-	if (*s != '_') {
-		fprintf(stderr,
-			"warning: %s does not end in _ (line %ld of %s)\n",
-			Ptok, Plineno, Pfname);
-		return Ptok;
-		}
-	if (s[-1] == '_')
-		s--;
-	strncpy(buf, Ptok, n = s - Ptok);
-	buf[n] = 0;
-	return buf;
-	}
-
- static void
-#ifdef KR_headers
-Pbadmsg(msg, p)
-	char *msg;
-	Extsym *p;
-#else
-Pbadmsg(char *msg, Extsym *p)
-#endif
-{
-	Pbad++;
-	fprintf(stderr, "%s for %s (line %ld of %s):\n\t", msg,
-		p->fextname, Plineno, Pfname);
-	p->arginfo->nargs = -1;
-	}
-
- static void
-#ifdef KR_headers
-Pbadret(ftype, p)
-	int ftype;
-	Extsym *p;
-#else
-Pbadret(int ftype, Extsym *p)
-#endif
-{
-	char buf1[32], buf2[32];
-
-	Pbadmsg("inconsistent types",p);
-	fprintf(stderr, "here %s, previously %s\n",
-		Argtype(ftype+200,buf1),
-		Argtype(p->extype+200,buf2));
-	}
-
- static void
-#ifdef KR_headers
-argverify(ftype, p)
-	int ftype;
-	Extsym *p;
-#else
-argverify(int ftype, Extsym *p)
-#endif
-{
-	Argtypes *at;
-	register Atype *aty;
-	int i, j, k;
-	register int *t, *te;
-	char buf1[32], buf2[32];
-
-	at = p->arginfo;
-	if (at->nargs < 0)
-		return;
-	if (p->extype != ftype) {
-		Pbadret(ftype, p);
-		return;
-		}
-	t = tfirst;
-	te = tnext;
-	i = te - t;
-	if (at->nargs != i) {
-		j = at->nargs;
-		Pbadmsg("differing numbers of arguments",p);
-		fprintf(stderr, "here %d, previously %d\n",
-			i, j);
-		return;
-		}
-	for(aty = at->atypes; t < te; t++, aty++) {
-		if (*t == aty->type)
-			continue;
-		j = aty->type;
-		k = *t;
-		if (k >= 300 || k == j)
-			continue;
-		if (j >= 300) {
-			if (k >= 200) {
-				if (k == TYUNKNOWN + 200)
-					continue;
-				if (j % 100 != k - 200
-				 && k != TYSUBR + 200
-				 && j != TYUNKNOWN + 300
-				 && !type_fixup(at,aty,k))
-					goto badtypes;
-				}
-			else if (j % 100 % TYSUBR != k % TYSUBR
-					&& !type_fixup(at,aty,k))
-				goto badtypes;
-			}
-		else if (k < 200 || j < 200)
-			goto badtypes;
-		else if (k == TYUNKNOWN+200)
-			continue;
-		else if (j != TYUNKNOWN+200)
-			{
- badtypes:
-			Pbadmsg("differing calling sequences",p);
-			i = t - tfirst + 1;
-			fprintf(stderr,
-				"arg %d: here %s, prevously %s\n",
-				i, Argtype(k,buf1), Argtype(j,buf2));
-			return;
-			}
-		/* We've subsequently learned the right type,
-		   as in the call on zoo below...
-
-			subroutine foo(x, zap)
-			external zap
-			call goo(zap)
-			x = zap(3)
-			call zoo(zap)
-			end
-		 */
-		aty->type = k;
-		at->changes = 1;
-		}
-	}
-
- static void
-#ifdef KR_headers
-newarg(ftype, p)
-	int ftype;
-	Extsym *p;
-#else
-newarg(int ftype, Extsym *p)
-#endif
-{
-	Argtypes *at;
-	register Atype *aty;
-	register int *t, *te;
-	int i, k;
-
-	if (p->extstg == STGCOMMON) {
-		Pnotboth(p);
-		return;
-		}
-	p->extstg = STGEXT;
-	p->extype = ftype;
-	p->exproto = 1;
-	t = tfirst;
-	te = tnext;
-	i = te - t;
-	k = sizeof(Argtypes) + (i-1)*sizeof(Atype);
-	at = p->arginfo = (Argtypes *)gmem(k,1);
-	at->dnargs = at->nargs = i;
-	at->defined = at->changes = 0;
-	for(aty = at->atypes; t < te; aty++) {
-		aty->type = *t++;
-		aty->cp = 0;
-		}
-	}
-
- static int
-#ifdef KR_headers
-Pfile(fname)
-	char *fname;
-#else
-Pfile(char *fname)
-#endif
-{
-	char *s;
-	int ftype, i;
-	FILE *pf;
-	Extsym *p;
-
-	for(s = fname; *s; s++);
-	if (s - fname < 2
-	|| s[-2] != '.'
-	|| (s[-1] != 'P' && s[-1] != 'p'))
-		return 0;
-
-	if (!(pf = fopen(fname, textread))) {
-		fprintf(stderr, "can't open %s\n", fname);
-		exit(2);
-		}
-	Pfname = fname;
-	Plineno = 1;
-	if (!Pct[' ']) {
-		for(s = " \t\n\r\v\f"; *s; s++)
-			Pct[*s] = P_space;
-		for(s = "*,();"; *s; s++)
-			Pct[*s] = P_delim;
-		for(i = '0'; i <= '9'; i++)
-			Pct[i] = P_anum;
-		for(s = "abcdefghijklmnopqrstuvwxyz"; i = *s; s++)
-			Pct[i] = Pct[i+'A'-'a'] = P_anum;
-		Pct['_'] = P_anum;
-		Pct['/'] = P_slash;
-		}
-
-	for(;;) {
-		if (!(i = Ptoken(pf,1)))
-			break;
-		if (i != P_anum
-		|| !strcmp(Ptok, "extern") && (i = Ptoken(pf,0)) != P_anum)
-			badchar(i);
-		ftype = Pftype();
- getname:
-		if ((i = Ptoken(pf,0)) != P_anum)
-			badchar(i);
-		p = mkext1(trimunder(), Ptok);
-
-		if ((i = Ptoken(pf,0)) != '(')
-			badchar(i);
-		tnext = tfirst;
-		while(i = Ptype(pf)) {
-			if (tnext >= tlast)
-				trealloc();
-			*tnext++ = i;
-			}
-		if (p->arginfo) {
-			argverify(ftype, p);
-			if (p->arginfo->nargs < 0)
-				newarg(ftype, p);
-			}
-		else
-			newarg(ftype, p);
-		p->arginfo->defined = 1;
-		i = Ptoken(pf,0);
-		switch(i) {
-			case ';':
-				break;
-			case ',':
-				goto getname;
-			default:
-				wanted(i, "\";\" or \",\"");
-			}
-		}
-	fclose(pf);
-	return 1;
-	}
-
- void
-#ifdef KR_headers
-read_Pfiles(ffiles)
-	char **ffiles;
-#else
-read_Pfiles(char **ffiles)
-#endif
-{
-	char **f1files, **f1files0, *s;
-	int k;
-	register Extsym *e, *ee;
-	register Argtypes *at;
-	extern int retcode;
-
-	f1files0 = f1files = ffiles;
-	while(s = *ffiles++)
-		if (!Pfile(s))
-			*f1files++ = s;
-	if (Pbad)
-		retcode = 8;
-	if (tfirst) {
-		free((char *)tfirst);
-		/* following should be unnecessary, as we won't be back here */
-		tfirst = tnext = tlast = 0;
-		tmax = 0;
-		}
-	*f1files = 0;
-	if (f1files == f1files0)
-		f1files[1] = 0;
-
-	k = 0;
-	ee = nextext;
-	for (e = extsymtab; e < ee; e++)
-		if (e->extstg == STGEXT
-		&& (at = e->arginfo)) {
-			if (at->nargs < 0 || at->changes)
-				k++;
-			at->changes = 2;
-			}
-	if (k) {
-		fprintf(diagfile,
-		"%d prototype%s updated while reading prototypes.\n", k,
-			k > 1 ? "s" : "");
-		}
-	fflush(diagfile);
-	}
diff --git a/usr.bin/f2c/proc.c b/usr.bin/f2c/proc.c
deleted file mode 100644
index e3afb81..0000000
--- a/usr.bin/f2c/proc.c
+++ /dev/null
@@ -1,1829 +0,0 @@
-/****************************************************************
-Copyright 1990, 1994-6 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "names.h"
-#include "output.h"
-#include "p1defs.h"
-
-/* round a up to the nearest multiple of b:
-
-   a = b * floor ( (a + (b - 1)) / b )*/
-
-#undef roundup
-#define roundup(a,b)    ( b * ( (a+b-1)/b) )
-
-#define EXNULL (union Expression *)0
-
-static void dobss Argdcl((void));
-static void docomleng Argdcl((void));
-static void docommon Argdcl((void));
-static void doentry Argdcl((struct Entrypoint*));
-static void epicode Argdcl((void));
-static int nextarg Argdcl((int));
-static void retval Argdcl((int));
-
-static char Blank[] = BLANKCOMMON;
-
- static char *postfix[] = { "g", "h", "i",
-#ifdef TYQUAD
-					"j",
-#endif
-					"r", "d", "c", "z", "g", "h", "i" };
-
- chainp new_procs;
- int prev_proc, proc_argchanges, proc_protochanges;
-
- void
-#ifdef KR_headers
-changedtype(q)
-	Namep q;
-#else
-changedtype(Namep q)
-#endif
-{
-	char buf[200];
-	int qtype, type1;
-	register Extsym *e;
-	Argtypes *at;
-
-	if (q->vtypewarned)
-		return;
-	q->vtypewarned = 1;
-	qtype = q->vtype;
-	e = &extsymtab[q->vardesc.varno];
-	if (!(at = e->arginfo)) {
-		if (!e->exused)
-			return;
-		}
-	else if (at->changes & 2 && qtype != TYUNKNOWN && !at->defined)
-		proc_protochanges++;
-	type1 = e->extype;
-	if (type1 == TYUNKNOWN)
-		return;
-	if (qtype == TYUNKNOWN)
-		/* e.g.,
-			subroutine foo
-			end
-			external foo
-			call goo(foo)
-			end
-		*/
-		return;
-	sprintf(buf, "%.90s: inconsistent declarations:\n\
-	here %s%s, previously %s%s.", q->fvarname, ftn_types[qtype],
-		qtype == TYSUBR ? "" : " function",
-		ftn_types[type1], type1 == TYSUBR ? "" : " function");
-	warn(buf);
-	}
-
- void
-#ifdef KR_headers
-unamstring(q, s)
-	register Addrp q;
-	register char *s;
-#else
-unamstring(register Addrp q, register char *s)
-#endif
-{
-	register int k;
-	register char *t;
-
-	k = strlen(s);
-	if (k < IDENT_LEN) {
-		q->uname_tag = UNAM_IDENT;
-		t = q->user.ident;
-		}
-	else {
-		q->uname_tag = UNAM_CHARP;
-		q->user.Charp = t = mem(k+1, 0);
-		}
-	strcpy(t, s);
-	}
-
- static void
-fix_entry_returns(Void)	/* for multiple entry points */
-{
-	Addrp a;
-	int i;
-	struct Entrypoint *e;
-	Namep np;
-
-	e = entries = (struct Entrypoint *)revchain((chainp)entries);
-	allargs = revchain(allargs);
-	if (!multitype)
-		return;
-
-	/* TYLOGICAL should have been turned into TYLONG or TYSHORT by now */
-
-	for(i = TYINT1; i <= TYLOGICAL; i++)
-		if (a = xretslot[i])
-			sprintf(a->user.ident, "(*ret_val).%s",
-				postfix[i-TYINT1]);
-
-	do {
-		np = e->enamep;
-		switch(np->vtype) {
-			case TYINT1:
-			case TYSHORT:
-			case TYLONG:
-#ifdef TYQUAD
-			case TYQUAD:
-#endif
-			case TYREAL:
-			case TYDREAL:
-			case TYCOMPLEX:
-			case TYDCOMPLEX:
-			case TYLOGICAL1:
-			case TYLOGICAL2:
-			case TYLOGICAL:
-				np->vstg = STGARG;
-			}
-		}
-		while(e = e->entnextp);
-	}
-
- static void
-#ifdef KR_headers
-putentries(outfile)
-	FILE *outfile;
-#else
-putentries(FILE *outfile)
-#endif
-	/* put out wrappers for multiple entries */
-{
-	char base[MAXNAMELEN+4];
-	struct Entrypoint *e;
-	Namep *A, *Ae, *Ae1, **Alp, *a, **a1, np;
-	chainp args, lengths;
-	int i, k, mt, nL, t, type;
-	extern char *dfltarg[], **dfltproc;
-
-	e = entries;
-	if (!e->enamep) /* only possible with erroneous input */
-		return;
-	nL = (nallargs + nallchargs) * sizeof(Namep *);
-	A = (Namep *)ckalloc(nL + nallargs*sizeof(Namep **));
-	Ae = A + nallargs;
-	Alp = (Namep **)(Ae1 = Ae + nallchargs);
-	i = k = 0;
-	for(a1 = Alp, args = allargs; args; a1++, args = args->nextp) {
-		np = (Namep)args->datap;
-		if (np->vtype == TYCHAR && np->vclass != CLPROC)
-			*a1 = &Ae[i++];
-		}
-
-	mt = multitype;
-	multitype = 0;
-	sprintf(base, "%s0_", e->enamep->cvarname);
-	do {
-		np = e->enamep;
-		lengths = length_comp(e, 0);
-		proctype = type = np->vtype;
-		if (protofile)
-			protowrite(protofile, type, np->cvarname, e, lengths);
-		nice_printf(outfile, "\n%s ", c_type_decl(type, 1));
-		nice_printf(outfile, "%s", np->cvarname);
-		if (!Ansi) {
-			listargs(outfile, e, 0, lengths);
-			nice_printf(outfile, "\n");
-			}
-	    	list_arg_types(outfile, e, lengths, 0, "\n");
-		nice_printf(outfile, "{\n");
-		frchain(&lengths);
-		next_tab(outfile);
-		if (mt)
-			nice_printf(outfile,
-				"Multitype ret_val;\n%s(%d, &ret_val",
-				base, k); /*)*/
-		else if (ISCOMPLEX(type))
-			nice_printf(outfile, "%s(%d,%s", base, k,
-				xretslot[type]->user.ident); /*)*/
-		else if (type == TYCHAR)
-			nice_printf(outfile,
-				"%s(%d, ret_val, ret_val_len", base, k); /*)*/
-		else
-			nice_printf(outfile, "return %s(%d", base, k); /*)*/
-		k++;
-		memset((char *)A, 0, nL);
-		for(args = e->arglist; args; args = args->nextp) {
-			np = (Namep)args->datap;
-			A[np->argno] = np;
-			if (np->vtype == TYCHAR && np->vclass != CLPROC)
-				*Alp[np->argno] = np;
-			}
-		args = allargs;
-		for(a = A; a < Ae; a++, args = args->nextp) {
-			t = ((Namep)args->datap)->vtype;
-			nice_printf(outfile, ", %s", (np = *a)
-				? np->cvarname
-				: ((Namep)args->datap)->vclass == CLPROC
-				? dfltproc[((Namep)args->datap)->vimpltype
-					? (Castargs ? TYUNKNOWN : TYSUBR)
-					: t == TYREAL && forcedouble && !Castargs
-					? TYDREAL : t]
-				: dfltarg[((Namep)args->datap)->vtype]);
-			}
-		for(; a < Ae1; a++)
-			if (np = *a)
-				nice_printf(outfile, ", %s",
-					new_arg_length(np));
-			else
-				nice_printf(outfile, ", (ftnint)0");
-		nice_printf(outfile, /*(*/ ");\n");
-		if (mt) {
-			if (type == TYCOMPLEX)
-				nice_printf(outfile,
-		    "r_v->r = ret_val.c.r; r_v->i = ret_val.c.i;\n");
-			else if (type == TYDCOMPLEX)
-				nice_printf(outfile,
-		    "r_v->r = ret_val.z.r; r_v->i = ret_val.z.i;\n");
-			else if (type <= TYLOGICAL)
-				nice_printf(outfile, "return ret_val.%s;\n",
-					postfix[type-TYINT1]);
-			}
-		nice_printf(outfile, "}\n");
-		prev_tab(outfile);
-		}
-		while(e = e->entnextp);
-	free((char *)A);
-	}
-
- static void
-#ifdef KR_headers
-entry_goto(outfile)
-	FILE *outfile;
-#else
-entry_goto(FILE *outfile)
-#endif
-{
-	struct Entrypoint *e = entries;
-	int k = 0;
-
-	nice_printf(outfile, "switch(n__) {\n");
-	next_tab(outfile);
-	while(e = e->entnextp)
-		nice_printf(outfile, "case %d: goto %s;\n", ++k,
-			user_label((long)(extsymtab - e->entryname - 1)));
-	nice_printf(outfile, "}\n\n");
-	prev_tab(outfile);
-	}
-
-/* start a new procedure */
-
- void
-newproc(Void)
-{
-	if(parstate != OUTSIDE)
-	{
-		execerr("missing end statement", CNULL);
-		endproc();
-	}
-
-	parstate = INSIDE;
-	procclass = CLMAIN;	/* default */
-}
-
- static void
-zap_changes(Void)
-{
-	register chainp cp;
-	register Argtypes *at;
-
-	/* arrange to get correct count of prototypes that would
-	   change by running f2c again */
-
-	if (prev_proc && proc_argchanges)
-		proc_protochanges++;
-	prev_proc = proc_argchanges = 0;
-	for(cp = new_procs; cp; cp = cp->nextp)
-		if (at = ((Namep)cp->datap)->arginfo)
-			at->changes &= ~1;
-	frchain(&new_procs);
-	}
-
-/* end of procedure. generate variables, epilogs, and prologs */
-
- void
-endproc(Void)
-{
-	struct Labelblock *lp;
-	Extsym *ext;
-
-	if(parstate < INDATA)
-		enddcl();
-	if(ctlstack >= ctls)
-		err("DO loop or BLOCK IF not closed");
-	for(lp = labeltab ; lp < labtabend ; ++lp)
-		if(lp->stateno!=0 && lp->labdefined==NO)
-			errstr("missing statement label %s",
-				convic(lp->stateno) );
-
-/* Save copies of the common variables in extptr -> allextp */
-
-	for (ext = extsymtab; ext < nextext; ext++)
-		if (ext -> extstg == STGCOMMON && ext -> extp) {
-			extern int usedefsforcommon;
-
-/* Write out the abbreviations for common block reference */
-
-			copy_data (ext -> extp);
-			if (usedefsforcommon) {
-				wr_abbrevs (c_file, 1, ext -> extp);
-				ext -> used_here = 1;
-				}
-			else
-				ext -> extp = CHNULL;
-
-			}
-
-	if (nentry > 1)
-		fix_entry_returns();
-	epicode();
-	donmlist();
-	dobss();
-	start_formatting ();
-	if (nentry > 1)
-		putentries(c_file);
-
-	zap_changes();
-	procinit();	/* clean up for next procedure */
-}
-
-
-
-/* End of declaration section of procedure.  Allocate storage. */
-
- void
-enddcl(Void)
-{
-	register struct Entrypoint *ep;
-	struct Entrypoint *ep0;
-	chainp cp;
-	extern char *err_proc;
-	static char comblks[] = "common blocks";
-
-	err_proc = comblks;
-	docommon();
-
-/* Now the hash table entries for fields of common blocks have STGCOMMON,
-   vdcldone, voffset, and varno.  And the common blocks themselves have
-   their full sizes in extleng. */
-
-	err_proc = "equivalences";
-	doequiv();
-
-	err_proc = comblks;
-	docomleng();
-
-/* This implies that entry points in the declarations are buffered in
-   entries   but not written out */
-
-	err_proc = "entries";
-	if (ep = ep0 = (struct Entrypoint *)revchain((chainp)entries)) {
-		/* entries could be 0 in case of an error */
-		do doentry(ep);
-			while(ep = ep->entnextp);
-		entries = (struct Entrypoint *)revchain((chainp)ep0);
-		}
-
-	err_proc = 0;
-	parstate = INEXEC;
-	p1put(P1_PROCODE);
-	freetemps();
-	if (earlylabs) {
-		for(cp = earlylabs = revchain(earlylabs); cp; cp = cp->nextp)
-			p1_label((long)cp->datap);
-		frchain(&earlylabs);
-		}
-	p1_line_number(lineno); /* for files that start with a MAIN program */
-				/* that starts with an executable statement */
-}
-
-/* ROUTINES CALLED WHEN ENCOUNTERING ENTRY POINTS */
-
-/* Main program or Block data */
-
- void
-#ifdef KR_headers
-startproc(progname, class)
-	Extsym *progname;
-	int class;
-#else
-startproc(Extsym *progname, int class)
-#endif
-{
-	extern flag echo;
-
-	register struct Entrypoint *p;
-
-	p = ALLOC(Entrypoint);
-	if(class == CLMAIN) {
-		puthead(CNULL, CLMAIN);
-		if (progname)
-		    strcpy (main_alias, progname->cextname);
-	} else {
-		if (progname) {
-			/* Construct an empty subroutine with this name */
-			/* in case the name is needed to force loading */
-			/* of this block-data subprogram: the name can */
-			/* appear elsewhere in an external statement. */
-			entrypt(CLPROC, TYSUBR, (ftnint)0, progname, (chainp)0);
-			endproc();
-			newproc();
-			}
-		puthead(CNULL, CLBLOCK);
-		}
-	if(class == CLMAIN)
-		newentry( mkname(" MAIN"), 0 )->extinit = 1;
-	p->entryname = progname;
-	entries = p;
-
-	procclass = class;
-	if (echo) {
-		fprintf(diagfile, "   %s", (class==CLMAIN ? "MAIN" : "BLOCK DATA") );
-		if(progname) {
-			fprintf(diagfile, " %s", progname->fextname);
-			procname = progname->cextname;
-			}
-		fprintf(diagfile, ":\n");
-		fflush(diagfile);
-		}
-}
-
-/* subroutine or function statement */
-
- Extsym *
-#ifdef KR_headers
-newentry(v, substmsg)
-	register Namep v;
-	int substmsg;
-#else
-newentry(register Namep v, int substmsg)
-#endif
-{
-	register Extsym *p;
-	char buf[128], badname[64];
-	static int nbad = 0;
-	static char already[] = "external name already used";
-
-	p = mkext(v->fvarname, addunder(v->cvarname));
-
-	if(p->extinit || ! ONEOF(p->extstg, M(STGUNKNOWN)|M(STGEXT)) )
-	{
-		sprintf(badname, "%s_bad%d", v->fvarname, ++nbad);
-		if (substmsg) {
-			sprintf(buf,"%s\n\tsubstituting \"%s\"",
-				already, badname);
-			dclerr(buf, v);
-			}
-		else
-			dclerr(already, v);
-		p = mkext(v->fvarname, badname);
-	}
-	v->vstg = STGAUTO;
-	v->vprocclass = PTHISPROC;
-	v->vclass = CLPROC;
-	if (p->extstg == STGEXT)
-		prev_proc = 1;
-	else
-		p->extstg = STGEXT;
-	p->extinit = YES;
-	v->vardesc.varno = p - extsymtab;
-	return(p);
-}
-
- void
-#ifdef KR_headers
-entrypt(class, type, length, entry, args)
-	int class;
-	int type;
-	ftnint length;
-	Extsym *entry;
-	chainp args;
-#else
-entrypt(int class, int type, ftnint length, Extsym *entry, chainp args)
-#endif
-{
-	extern flag echo;
-
-	register Namep q;
-	register struct Entrypoint *p;
-
-	if(class != CLENTRY)
-		puthead( procname = entry->cextname, class);
-	else if (echo)
-		fprintf(diagfile, "       entry ");
-	if (echo){
-		fprintf(diagfile, "   %s:\n", entry->fextname);
-		fflush(diagfile);
-		}
-	q = mkname(entry->fextname);
-	if (type == TYSUBR)
-		q->vstg = STGEXT;
-
-	type = lengtype(type, length);
-	if(class == CLPROC)
-	{
-		procclass = CLPROC;
-		proctype = type;
-		procleng = type == TYCHAR ? length : 0;
-	}
-
-	p = ALLOC(Entrypoint);
-
-	p->entnextp = entries;
-	entries = p;
-
-	p->entryname = entry;
-	p->arglist = revchain(args);
-	p->enamep = q;
-
-	if(class == CLENTRY)
-	{
-		class = CLPROC;
-		if(proctype == TYSUBR)
-			type = TYSUBR;
-	}
-
-	q->vclass = class;
-	q->vprocclass = 0;
-	settype(q, type, length);
-	q->vprocclass = PTHISPROC;
-	/* hold all initial entry points till end of declarations */
-	if(parstate >= INDATA)
-		doentry(p);
-}
-
-/* generate epilogs */
-
-/* epicode -- write out the proper function return mechanism at the end of
-   the procedure declaration.  Handles multiple return value types, as
-   well as cooercion into the proper value */
-
- LOCAL void
-epicode(Void)
-{
-	extern int lastwasbranch;
-
-	if(procclass==CLPROC)
-	{
-		if(proctype==TYSUBR)
-		{
-
-/* Return a zero only when the alternate return mechanism has been
-   specified in the function header */
-
-			if ((substars || Ansi) && lastwasbranch != YES)
-			    p1_subr_ret (ICON(0));
-		}
-		else if (!multitype && lastwasbranch != YES)
-			retval(proctype);
-	}
-	else if (procclass == CLMAIN && Ansi && lastwasbranch != YES)
-		p1_subr_ret (ICON(0));
-	lastwasbranch = NO;
-}
-
-
-/* generate code to return value of type  t */
-
- LOCAL void
-#ifdef KR_headers
-retval(t)
-	register int t;
-#else
-retval(register int t)
-#endif
-{
-	register Addrp p;
-
-	switch(t)
-	{
-	case TYCHAR:
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-		break;
-
-	case TYLOGICAL:
-		t = tylogical;
-	case TYINT1:
-	case TYADDR:
-	case TYSHORT:
-	case TYLONG:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-	case TYREAL:
-	case TYDREAL:
-	case TYLOGICAL1:
-	case TYLOGICAL2:
-		p = (Addrp) cpexpr((expptr)retslot);
-		p->vtype = t;
-		p1_subr_ret (mkconv (t, fixtype((expptr)p)));
-		break;
-
-	default:
-		badtype("retval", t);
-	}
-}
-
-
-/* Do parameter adjustments */
-
- void
-#ifdef KR_headers
-procode(outfile)
-	FILE *outfile;
-#else
-procode(FILE *outfile)
-#endif
-{
-	prolog(outfile, allargs);
-
-	if (nentry > 1)
-		entry_goto(outfile);
-	}
-
- static void
-#ifdef KR_headers
-bad_dimtype(q) Namep q;
-#else
-bad_dimtype(Namep q)
-#endif
-{
-	errstr("bad dimension type for %.70s", q->fvarname);
-	}
-
-/* Finish bound computations now that all variables are declared.
- * This used to be in setbound(), but under -u the following incurred
- * an erroneous error message:
- *	subroutine foo(x,n)
- *	real x(n)
- *	integer n
- */
-
- static void
-#ifdef KR_headers
-dim_finish(v)
-	Namep v;
-#else
-dim_finish(Namep v)
-#endif
-{
-	register struct Dimblock *p;
-	register expptr q;
-	register int i, nd;
-
-	p = v->vdim;
-	v->vdimfinish = 0;
-	nd = p->ndim;
-	doin_setbound = 1;
-	for(i = 0; i < nd; i++)
-		if (q = p->dims[i].dimexpr) {
-			q = p->dims[i].dimexpr = make_int_expr(putx(fixtype(q)));
-			if (!ONEOF(q->headblock.vtype, MSKINT|MSKREAL))
-				bad_dimtype(v);
-			}
-	if (q = p->basexpr)
-		p->basexpr = make_int_expr(putx(fixtype(q)));
-	doin_setbound = 0;
-	}
-
- static void
-#ifdef KR_headers
-duparg(q)
-	Namep q;
-#else
-duparg(Namep q)
-#endif
-{ errstr("duplicate argument %.80s", q->fvarname); }
-
-/*
-   manipulate argument lists (allocate argument slot positions)
- * keep track of return types and labels
- */
-
- LOCAL void
-#ifdef KR_headers
-doentry(ep)
-	struct Entrypoint *ep;
-#else
-doentry(struct Entrypoint *ep)
-#endif
-{
-	register int type;
-	register Namep np;
-	chainp p, p1;
-	register Namep q;
-	Addrp rs;
-	int it, k;
-	extern char dflttype[26];
-	Extsym *entryname = ep->entryname;
-
-	if (++nentry > 1)
-		p1_label((long)(extsymtab - entryname - 1));
-
-/* The main program isn't allowed to have parameters, so any given
-   parameters are ignored */
-
-	if(procclass == CLMAIN || procclass == CLBLOCK)
-		return;
-
-/* So now we're working with something other than CLMAIN or CLBLOCK.
-   Determine the type of its return value. */
-
-	impldcl( np = mkname(entryname->fextname) );
-	type = np->vtype;
-	proc_argchanges = prev_proc && type != entryname->extype;
-	entryname->extseen = 1;
-	if(proctype == TYUNKNOWN)
-		if( (proctype = type) == TYCHAR)
-			procleng = np->vleng ? np->vleng->constblock.Const.ci
-					     : (ftnint) (-1);
-
-	if(proctype == TYCHAR)
-	{
-		if(type != TYCHAR)
-			err("noncharacter entry of character function");
-
-/* Functions returning type   char   can only have multiple entries if all
-   entries return the same length */
-
-		else if( (np->vleng ? np->vleng->constblock.Const.ci :
-		    (ftnint) (-1)) != procleng)
-			err("mismatched character entry lengths");
-	}
-	else if(type == TYCHAR)
-		err("character entry of noncharacter function");
-	else if(type != proctype)
-		multitype = YES;
-	if(rtvlabel[type] == 0)
-		rtvlabel[type] = (int)newlabel();
-	ep->typelabel = rtvlabel[type];
-
-	if(type == TYCHAR)
-	{
-		if(chslot < 0)
-		{
-			chslot = nextarg(TYADDR);
-			chlgslot = nextarg(TYLENG);
-		}
-		np->vstg = STGARG;
-
-/* Put a new argument in the function, one which will hold the result of
-   a character function.  This will have to be named sometime, probably in
-   mkarg(). */
-
-		if(procleng < 0) {
-			np->vleng = (expptr) mkarg(TYLENG, chlgslot);
-			np->vleng->addrblock.uname_tag = UNAM_IDENT;
-			strcpy (np -> vleng -> addrblock.user.ident,
-				new_func_length());
-			}
-		if (!xretslot[TYCHAR]) {
-			xretslot[TYCHAR] = rs =
-				autovar(0, type, ISCONST(np->vleng)
-					? np->vleng : ICON(0), "");
-			strcpy(rs->user.ident, "ret_val");
-			}
-	}
-
-/* Handle a   complex   return type -- declare a new parameter (pointer to
-   a complex value) */
-
-	else if( ISCOMPLEX(type) ) {
-		if (!xretslot[type])
-			xretslot[type] =
-				autovar(0, type, EXNULL, " ret_val");
-				/* the blank is for use in out_addr */
-		np->vstg = STGARG;
-		if(cxslot < 0)
-			cxslot = nextarg(TYADDR);
-		}
-	else if (type != TYSUBR) {
-		if (type == TYUNKNOWN) {
-			dclerr("untyped function", np);
-			proctype = type = np->vtype =
-				dflttype[letter(np->fvarname[0])];
-			}
-		if (!xretslot[type])
-			xretslot[type] = retslot =
-				autovar(1, type, EXNULL, " ret_val");
-				/* the blank is for use in out_addr */
-		np->vstg = STGAUTO;
-		}
-
-	for(p = ep->arglist ; p ; p = p->nextp)
-		if(! (( q = (Namep) (p->datap) )->vknownarg) ) {
-			q->vknownarg = 1;
-			q->vardesc.varno = nextarg(TYADDR);
-			allargs = mkchain((char *)q, allargs);
-			q->argno = nallargs++;
-			}
-		else if (nentry == 1)
-			duparg(q);
-		else for(p1 = ep->arglist ; p1 != p; p1 = p1->nextp)
-			if ((Namep)p1->datap == q)
-				duparg(q);
-
-	k = 0;
-	for(p = ep->arglist ; p ; p = p->nextp) {
-		if(! (( q = (Namep) (p->datap) )->vdcldone) )
-			{
-			impldcl(q);
-			q->vdcldone = YES;
-			if(q->vtype == TYCHAR)
-				{
-
-/* If we don't know the length of a char*(*) (i.e. a string), we must add
-   in this additional length argument. */
-
-				++nallchargs;
-				if (q->vclass == CLPROC)
-					nallchargs--;
-				else if (q->vleng == NULL) {
-					/* character*(*) */
-					q->vleng = (expptr)
-					    mkarg(TYLENG, nextarg(TYLENG) );
-					unamstring((Addrp)q->vleng,
-						new_arg_length(q));
-					}
-				}
-			}
-		if (q->vdimfinish)
-			dim_finish(q);
-		if (q->vtype == TYCHAR && q->vclass != CLPROC)
-			k++;
-		}
-
-	if (entryname->extype != type)
-		changedtype(np);
-
-	/* save information for checking consistency of arg lists */
-
-	it = infertypes;
-	if (entryname->exproto)
-		infertypes = 1;
-	save_argtypes(ep->arglist, &entryname->arginfo, &np->arginfo,
-			0, np->fvarname, STGEXT, k, np->vtype, 2);
-	infertypes = it;
-}
-
-
-
- LOCAL int
-#ifdef KR_headers
-nextarg(type)
-	int type;
-#else
-nextarg(int type)
-#endif
-{
-	type = type;	/* shut up warning */
-	return(lastargslot++);
-	}
-
- LOCAL void
-#ifdef KR_headers
-dim_check(q)
-	Namep q;
-#else
-dim_check(Namep q)
-#endif
-{
-	register struct Dimblock *vdim = q->vdim;
-	register expptr nelt;
-
-	if(!(nelt = vdim->nelt) || !ISCONST(nelt))
-		dclerr("adjustable dimension on non-argument", q);
-	else if (!ONEOF(nelt->headblock.vtype, MSKINT|MSKREAL))
-		bad_dimtype(q);
-	else if (ISINT(nelt->headblock.vtype)
-			? nelt->constblock.Const.ci <= 0
-			: nelt->constblock.Const.cd[0] <= 0.)
-		dclerr("nonpositive dimension", q);
-	}
-
- LOCAL void
-dobss(Void)
-{
-	register struct Hashentry *p;
-	register Namep q;
-	int qstg, qclass, qtype;
-	Extsym *e;
-
-	for(p = hashtab ; p<lasthash ; ++p)
-		if(q = p->varp)
-		{
-			qstg = q->vstg;
-			qtype = q->vtype;
-			qclass = q->vclass;
-
-			if( (qclass==CLUNKNOWN && qstg!=STGARG) ||
-			    (qclass==CLVAR && qstg==STGUNKNOWN) ) {
-				if (!(q->vis_assigned | q->vimpldovar))
-					warn1("local variable %s never used",
-						q->fvarname);
-				}
-			else if(qclass==CLVAR && qstg==STGBSS)
-			{ ; }
-
-/* Give external procedures the proper storage class */
-
-			else if(qclass==CLPROC && q->vprocclass==PEXTERNAL
-					&& qstg!=STGARG) {
-				e = mkext(q->fvarname,addunder(q->cvarname));
-				e->extstg = STGEXT;
-				q->vardesc.varno = e - extsymtab;
-				if (e->extype != qtype)
-					changedtype(q);
-				}
-			if(qclass==CLVAR) {
-			    if (qstg != STGARG && q->vdim)
-				dim_check(q);
-			} /* if qclass == CLVAR */
-		}
-
-}
-
-
- void
-donmlist(Void)
-{
-	register struct Hashentry *p;
-	register Namep q;
-
-	for(p=hashtab; p<lasthash; ++p)
-		if( (q = p->varp) && q->vclass==CLNAMELIST)
-			namelist(q);
-}
-
-
-/* iarrlen -- Returns the size of the array in bytes, or -1 */
-
- ftnint
-#ifdef KR_headers
-iarrlen(q)
-	register Namep q;
-#else
-iarrlen(register Namep q)
-#endif
-{
-	ftnint leng;
-
-	leng = typesize[q->vtype];
-	if(leng <= 0)
-		return(-1);
-	if(q->vdim)
-		if( ISICON(q->vdim->nelt) )
-			leng *= q->vdim->nelt->constblock.Const.ci;
-		else	return(-1);
-	if(q->vleng)
-		if( ISICON(q->vleng) )
-			leng *= q->vleng->constblock.Const.ci;
-		else return(-1);
-	return(leng);
-}
-
- void
-#ifdef KR_headers
-namelist(np)
-	Namep np;
-#else
-namelist(Namep np)
-#endif
-{
-	register chainp q;
-	register Namep v;
-	int y;
-
-	if (!np->visused)
-		return;
-	y = 0;
-
-	for(q = np->varxptr.namelist ; q ; q = q->nextp)
-	{
-		vardcl( v = (Namep) (q->datap) );
-		if( !ONEOF(v->vstg, MSKSTATIC) )
-			dclerr("may not appear in namelist", v);
-		else {
-			v->vnamelist = 1;
-			v->visused = 1;
-			v->vsave = 1;
-			y = 1;
-			}
-	np->visused = y;
-	}
-}
-
-/* docommon -- called at the end of procedure declarations, before
-   equivalences and the procedure body */
-
- LOCAL void
-docommon(Void)
-{
-    register Extsym *extptr;
-    register chainp q, q1;
-    struct Dimblock *t;
-    expptr neltp;
-    register Namep comvar;
-    ftnint size;
-    int i, k, pref, type;
-    extern int type_pref[];
-
-    for(extptr = extsymtab ; extptr<nextext ; ++extptr)
-	if (extptr->extstg == STGCOMMON && (q = extptr->extp)) {
-
-/* If a common declaration also had a list of variables ... */
-
-	    q = extptr->extp = revchain(q);
-	    pref = 1;
-	    for(k = TYCHAR; q ; q = q->nextp)
-	    {
-		comvar = (Namep) (q->datap);
-
-		if(comvar->vdcldone == NO)
-		    vardcl(comvar);
-		type = comvar->vtype;
-		if (pref < type_pref[type])
-			pref = type_pref[k = type];
-		if(extptr->extleng % typealign[type] != 0) {
-		    dclerr("common alignment", comvar);
-		    --nerr; /* don't give bad return code for this */
-#if 0
-		    extptr->extleng = roundup(extptr->extleng, typealign[type]);
-#endif
-		} /* if extptr -> extleng % */
-
-/* Set the offset into the common block */
-
-		comvar->voffset = extptr->extleng;
-		comvar->vardesc.varno = extptr - extsymtab;
-		if(type == TYCHAR)
-			if (comvar->vleng)
-				size = comvar->vleng->constblock.Const.ci;
-			else  {
-				dclerr("character*(*) in common", comvar);
-				size = 1;
-				}
-		else
-			size = typesize[type];
-		if(t = comvar->vdim)
-		    if( (neltp = t->nelt) && ISCONST(neltp) )
-			size *= neltp->constblock.Const.ci;
-		    else
-			dclerr("adjustable array in common", comvar);
-
-/* Adjust the length of the common block so far */
-
-		extptr->extleng += size;
-	    } /* for */
-
-	    extptr->extype = k;
-
-/* Determine curno and, if new, save this identifier chain */
-
-	    q1 = extptr->extp;
-	    for (q = extptr->allextp, i = 0; q; i++, q = q->nextp)
-		if (struct_eq((chainp)q->datap, q1))
-			break;
-	    if (q)
-		extptr->curno = extptr->maxno - i;
-	    else {
-		extptr->curno = ++extptr->maxno;
-		extptr->allextp = mkchain((char *)extptr->extp,
-						extptr->allextp);
-		}
-	} /* if extptr -> extstg == STGCOMMON */
-
-/* Now the hash table entries have STGCOMMON, vdcldone, voffset, and
-   varno.  And the common block itself has its full size in extleng. */
-
-} /* docommon */
-
-
-/* copy_data -- copy the Namep entries so they are available even after
-   the hash table is empty */
-
- void
-#ifdef KR_headers
-copy_data(list)
-	chainp list;
-#else
-copy_data(chainp list)
-#endif
-{
-    for (; list; list = list -> nextp) {
-	Namep namep = ALLOC (Nameblock);
-	int size, nd, i;
-	struct Dimblock *dp;
-
-	cpn(sizeof(struct Nameblock), list->datap, (char *)namep);
-	namep->fvarname = strcpy(gmem(strlen(namep->fvarname)+1,0),
-		namep->fvarname);
-	namep->cvarname = strcmp(namep->fvarname, namep->cvarname)
-		? strcpy(gmem(strlen(namep->cvarname)+1,0), namep->cvarname)
-		: namep->fvarname;
-	if (namep -> vleng)
-	    namep -> vleng = (expptr) cpexpr (namep -> vleng);
-	if (namep -> vdim) {
-	    nd = namep -> vdim -> ndim;
-	    size = sizeof(int) + (3 + 2 * nd) * sizeof (expptr);
-	    dp = (struct Dimblock *) ckalloc (size);
-	    cpn(size, (char *)namep->vdim, (char *)dp);
-	    namep -> vdim = dp;
-	    dp->nelt = (expptr)cpexpr(dp->nelt);
-	    for (i = 0; i < nd; i++) {
-		dp -> dims[i].dimsize = (expptr) cpexpr (dp -> dims[i].dimsize);
-	    } /* for */
-	} /* if */
-	list -> datap = (char *) namep;
-    } /* for */
-} /* copy_data */
-
-
-
- LOCAL void
-docomleng(Void)
-{
-	register Extsym *p;
-
-	for(p = extsymtab ; p < nextext ; ++p)
-		if(p->extstg == STGCOMMON)
-		{
-			if(p->maxleng!=0 && p->extleng!=0 && p->maxleng!=p->extleng
-			    && strcmp(Blank, p->cextname) )
-				warn1("incompatible lengths for common block %.60s",
-				    p->fextname);
-			if(p->maxleng < p->extleng)
-				p->maxleng = p->extleng;
-			p->extleng = 0;
-		}
-}
-
-
-/* ROUTINES DEALING WITH AUTOMATIC AND TEMPORARY STORAGE */
-
- void
-#ifdef KR_headers
-frtemp(p)
-	Addrp p;
-#else
-frtemp(Addrp p)
-#endif
-{
-	/* put block on chain of temps to be reclaimed */
-	holdtemps = mkchain((char *)p, holdtemps);
-}
-
- void
-freetemps(Void)
-{
-	register chainp p, p1;
-	register Addrp q;
-	register int t;
-
-	p1 = holdtemps;
-	while(p = p1) {
-		q = (Addrp)p->datap;
-		t = q->vtype;
-		if (t == TYCHAR && q->varleng != 0) {
-			/* restore clobbered character string lengths */
-			frexpr(q->vleng);
-			q->vleng = ICON(q->varleng);
-			}
-		p1 = p->nextp;
-		p->nextp = templist[t];
-		templist[t] = p;
-		}
-	holdtemps = 0;
-	}
-
-/* allocate an automatic variable slot for each of   nelt   variables */
-
- Addrp
-#ifdef KR_headers
-autovar(nelt0, t, lengp, name)
-	register int nelt0;
-	register int t;
-	expptr lengp;
-	char *name;
-#else
-autovar(register int nelt0, register int t, expptr lengp, char *name)
-#endif
-{
-	ftnint leng;
-	register Addrp q;
-	register int nelt = nelt0 > 0 ? nelt0 : 1;
-	extern char *av_pfix[];
-
-	if(t == TYCHAR)
-		if( ISICON(lengp) )
-			leng = lengp->constblock.Const.ci;
-		else	{
-			Fatal("automatic variable of nonconstant length");
-		}
-	else
-		leng = typesize[t];
-
-	q = ALLOC(Addrblock);
-	q->tag = TADDR;
-	q->vtype = t;
-	if(t == TYCHAR)
-	{
-		q->vleng = ICON(leng);
-		q->varleng = leng;
-	}
-	q->vstg = STGAUTO;
-	q->ntempelt = nelt;
-	q->isarray = (nelt > 1);
-	q->memoffset = ICON(0);
-
-	/* kludge for nls so we can have ret_val rather than ret_val_4 */
-	if (*name == ' ')
-		unamstring(q, name);
-	else {
-		q->uname_tag = UNAM_IDENT;
-		temp_name(av_pfix[t], ++autonum[t], q->user.ident);
-		}
-	if (nelt0 > 0)
-		declare_new_addr (q);
-	return(q);
-}
-
-
-/* Returns a temporary of the appropriate type.  Will reuse existing
-   temporaries when possible */
-
- Addrp
-#ifdef KR_headers
-mktmpn(nelt, type, lengp)
-	int nelt;
-	register int type;
-	expptr lengp;
-#else
-mktmpn(int nelt, register int type, expptr lengp)
-#endif
-{
-	ftnint leng;
-	chainp p, oldp;
-	register Addrp q;
-	extern int krparens;
-
-	if(type==TYUNKNOWN || type==TYERROR)
-		badtype("mktmpn", type);
-
-	if(type==TYCHAR)
-		if(lengp && ISICON(lengp) )
-			leng = lengp->constblock.Const.ci;
-		else	{
-			err("adjustable length");
-			return( (Addrp) errnode() );
-		}
-	else if (type > TYCHAR || type < TYADDR) {
-		erri("mktmpn: unexpected type %d", type);
-		exit(1);
-		}
-/*
- * if a temporary of appropriate shape is on the templist,
- * remove it from the list and return it
- */
-	if (krparens == 2 && ONEOF(type,M(TYREAL)|M(TYCOMPLEX)))
-		type++;
-	for(oldp=CHNULL, p=templist[type];  p  ;  oldp=p, p=p->nextp)
-	{
-		q = (Addrp) (p->datap);
-		if(q->ntempelt==nelt &&
-		    (type!=TYCHAR || q->vleng->constblock.Const.ci==leng) )
-		{
-			if(oldp)
-				oldp->nextp = p->nextp;
-			else
-				templist[type] = p->nextp;
-			free( (charptr) p);
-			return(q);
-		}
-	}
-	q = autovar(nelt, type, lengp, "");
-	return(q);
-}
-
-
-
-
-/* mktmp -- create new local variable; call it something like   name
-   lengp   is taken directly, not copied */
-
- Addrp
-#ifdef KR_headers
-mktmp(type, lengp)
-	int type;
-	expptr lengp;
-#else
-mktmp(int type, expptr lengp)
-#endif
-{
-	Addrp rv;
-	/* arrange for temporaries to be recycled */
-	/* at the end of this statement... */
-	rv = mktmpn(1,type,lengp);
-	frtemp((Addrp)cpexpr((expptr)rv));
-	return rv;
-}
-
-/* mktmp0 omits frtemp() */
- Addrp
-#ifdef KR_headers
-mktmp0(type, lengp)
-	int type;
-	expptr lengp;
-#else
-mktmp0(int type, expptr lengp)
-#endif
-{
-	Addrp rv;
-	/* arrange for temporaries to be recycled */
-	/* when this Addrp is freed */
-	rv = mktmpn(1,type,lengp);
-	rv->istemp = YES;
-	return rv;
-}
-
-/* VARIOUS ROUTINES FOR PROCESSING DECLARATIONS */
-
-/* comblock -- Declare a new common block.  Input parameters name the block;
-   s   will be NULL if the block is unnamed */
-
- Extsym *
-#ifdef KR_headers
-comblock(s)
-	register char *s;
-#else
-comblock(register char *s)
-#endif
-{
-	Extsym *p;
-	register char *t;
-	register int c, i;
-	char cbuf[256], *s0;
-
-/* Give the unnamed common block a unique name */
-
-	if(*s == 0)
-		p = mkext1(s0 = Blank, Blank);
-	else {
-		s0 = s;
-		t = cbuf;
-		for(i = 0; c = *t = *s++; t++)
-			if (c == '_')
-				i = 1;
-		if (i)
-			*t++ = '_';
-		t[0] = '_';
-		t[1] = 0;
-		p = mkext1(s0,cbuf);
-		}
-	if(p->extstg == STGUNKNOWN)
-		p->extstg = STGCOMMON;
-	else if(p->extstg != STGCOMMON)
-	{
-		errstr("%.52s cannot be a common block: it is a subprogram.",
-			s0);
-		return(0);
-	}
-
-	return( p );
-}
-
-
-/* incomm -- add a new variable to a common declaration */
-
- void
-#ifdef KR_headers
-incomm(c, v)
-	Extsym *c;
-	Namep v;
-#else
-incomm(Extsym *c, Namep v)
-#endif
-{
-	if (!c)
-		return;
-	if(v->vstg != STGUNKNOWN && !v->vimplstg)
-		dclerr(v->vstg == STGARG
-			? "dummy arguments cannot be in common"
-			: "incompatible common declaration", v);
-	else
-	{
-		v->vstg = STGCOMMON;
-		c->extp = mkchain((char *)v, c->extp);
-	}
-}
-
-
-
-
-/* settype -- set the type or storage class of a Namep object.  If
-   v -> vstg == STGUNKNOWN && type < 0,   attempt to reset vstg to be
-   -type.  This function will not change any earlier definitions in   v,
-   in will only attempt to fill out more information give the other params */
-
- void
-#ifdef KR_headers
-settype(v, type, length)
-	register Namep v;
-	register int type;
-	register ftnint length;
-#else
-settype(register Namep v, register int type, register ftnint length)
-#endif
-{
-	int type1;
-
-	if(type == TYUNKNOWN)
-		return;
-
-	if(type==TYSUBR && v->vtype!=TYUNKNOWN && v->vstg==STGARG)
-	{
-		v->vtype = TYSUBR;
-		frexpr(v->vleng);
-		v->vleng = 0;
-		v->vimpltype = 0;
-	}
-	else if(type < 0)	/* storage class set */
-	{
-		if(v->vstg == STGUNKNOWN)
-			v->vstg = - type;
-		else if(v->vstg != -type)
-			dclerr("incompatible storage declarations", v);
-	}
-	else if(v->vtype == TYUNKNOWN
-		|| v->vtype != type
-			&& (v->vimpltype || v->vinftype || v->vinfproc))
-	{
-		if( (v->vtype = lengtype(type, length))==TYCHAR )
-			if (length>=0)
-				v->vleng = ICON(length);
-			else if (parstate >= INDATA)
-				v->vleng = ICON(1);	/* avoid a memory fault */
-		v->vimpltype = 0;
-		v->vinftype = 0; /* 19960709 */
-		v->vinfproc = 0; /* 19960709 */
-
-		if (v->vclass == CLPROC) {
-			if (v->vstg == STGEXT
-			 && (type1 = extsymtab[v->vardesc.varno].extype)
-			 &&  type1 != v->vtype)
-				changedtype(v);
-			else if (v->vprocclass == PTHISPROC
-					&& (parstate >= INDATA
-						|| procclass == CLMAIN)
-					&& !xretslot[type]) {
-				xretslot[type] = autovar(ONEOF(type,
-					MSKCOMPLEX|MSKCHAR) ? 0 : 1, type,
-					v->vleng, " ret_val");
-				if (procclass == CLMAIN)
-					errstr(
-				"illegal use of %.60s (main program name)",
-					v->fvarname);
-				/* not completely right, but enough to */
-				/* avoid memory faults; we won't */
-				/* emit any C as we have illegal Fortran */
-				}
-			}
-	}
-	else if(v->vtype != type && v->vtype != lengtype(type, length)) {
- incompat:
-		dclerr("incompatible type declarations", v);
-		}
-	else if (type==TYCHAR)
-		if (v->vleng && v->vleng->constblock.Const.ci != length)
-			goto incompat;
-		else if (parstate >= INDATA)
-			v->vleng = ICON(1);	/* avoid a memory fault */
-}
-
-
-
-
-
-/* lengtype -- returns the proper compiler type, given input of Fortran
-   type and length specifier */
-
- int
-#ifdef KR_headers
-lengtype(type, len)
-	register int type;
-	ftnint len;
-#else
-lengtype(register int type, ftnint len)
-#endif
-{
-	register int length = (int)len;
-	switch(type)
-	{
-	case TYREAL:
-		if(length == typesize[TYDREAL])
-			return(TYDREAL);
-		if(length == typesize[TYREAL])
-			goto ret;
-		break;
-
-	case TYCOMPLEX:
-		if(length == typesize[TYDCOMPLEX])
-			return(TYDCOMPLEX);
-		if(length == typesize[TYCOMPLEX])
-			goto ret;
-		break;
-
-	case TYINT1:
-	case TYSHORT:
-	case TYDREAL:
-	case TYDCOMPLEX:
-	case TYCHAR:
-	case TYLOGICAL1:
-	case TYLOGICAL2:
-	case TYUNKNOWN:
-	case TYSUBR:
-	case TYERROR:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
-		goto ret;
-
-	case TYLOGICAL:
-		switch(length) {
-			case 0: return tylog;
-			case 1:	return TYLOGICAL1;
-			case 2: return TYLOGICAL2;
-			case 4: goto ret;
-			}
-		break;
-
-	case TYLONG:
-		if(length == 0)
-			return(tyint);
-		if (length == 1)
-			return TYINT1;
-		if(length == typesize[TYSHORT])
-			return(TYSHORT);
-#ifdef TYQUAD
-		if(length == typesize[TYQUAD] && use_tyquad)
-			return(TYQUAD);
-#endif
-		if(length == typesize[TYLONG])
-			goto ret;
-		break;
-	default:
-		badtype("lengtype", type);
-	}
-
-	if(len != 0)
-		err("incompatible type-length combination");
-
-ret:
-	return(type);
-}
-
-
-
-
-
-/* setintr -- Set Intrinsic function */
-
- void
-#ifdef KR_headers
-setintr(v)
-	register Namep v;
-#else
-setintr(register Namep v)
-#endif
-{
-	int k;
-
-	if(k = intrfunct(v->fvarname)) {
-		if ((*(struct Intrpacked *)&k).f4)
-			if (noextflag)
-				goto unknown;
-			else
-				dcomplex_seen++;
-		v->vardesc.varno = k;
-		}
-	else {
- unknown:
-		dclerr("unknown intrinsic function", v);
-		return;
-		}
-	if(v->vstg == STGUNKNOWN)
-		v->vstg = STGINTR;
-	else if(v->vstg!=STGINTR)
-		dclerr("incompatible use of intrinsic function", v);
-	if(v->vclass==CLUNKNOWN)
-		v->vclass = CLPROC;
-	if(v->vprocclass == PUNKNOWN)
-		v->vprocclass = PINTRINSIC;
-	else if(v->vprocclass != PINTRINSIC)
-		dclerr("invalid intrinsic declaration", v);
-}
-
-
-
-/* setext -- Set External declaration -- assume that unknowns will become
-   procedures */
-
- void
-#ifdef KR_headers
-setext(v)
-	register Namep v;
-#else
-setext(register Namep v)
-#endif
-{
-	if(v->vclass == CLUNKNOWN)
-		v->vclass = CLPROC;
-	else if(v->vclass != CLPROC)
-		dclerr("invalid external declaration", v);
-
-	if(v->vprocclass == PUNKNOWN)
-		v->vprocclass = PEXTERNAL;
-	else if(v->vprocclass != PEXTERNAL)
-		dclerr("invalid external declaration", v);
-} /* setext */
-
-
-
-
-/* create dimensions block for array variable */
-
- void
-#ifdef KR_headers
-setbound(v, nd, dims)
-	register Namep v;
-	int nd;
-	struct Dims *dims;
-#else
-setbound(register Namep v, int nd, struct Dims *dims)
-#endif
-{
-	register expptr q, t;
-	register struct Dimblock *p;
-	int i;
-	extern chainp new_vars;
-	char buf[256];
-
-	if(v->vclass == CLUNKNOWN)
-		v->vclass = CLVAR;
-	else if(v->vclass != CLVAR)
-	{
-		dclerr("only variables may be arrays", v);
-		return;
-	}
-
-	v->vdim = p = (struct Dimblock *)
-	    ckalloc( sizeof(int) + (3+2*nd)*sizeof(expptr) );
-	p->ndim = nd--;
-	p->nelt = ICON(1);
-	doin_setbound = 1;
-
-	if (noextflag)
-		for(i = 0; i <= nd; i++)
-			if (((q = dims[i].lb) && !ISINT(q->headblock.vtype))
-			 || ((q = dims[i].ub) && !ISINT(q->headblock.vtype))) {
-				sprintf(buf, "dimension %d of %s is not an integer.",
-					i+1, v->fvarname);
-				errext(buf);
-				break;
-				}
-
-	for(i = 0; i <= nd; i++) {
-		if (((q = dims[i].lb) && !ISINT(q->headblock.vtype)))
-			dims[i].lb = mkconv(TYINT, q);
-		if (((q = dims[i].ub) && !ISINT(q->headblock.vtype)))
-			dims[i].ub = mkconv(TYINT, q);
-		}
-
-	for(i = 0; i <= nd; ++i)
-	{
-		if( (q = dims[i].ub) == NULL)
-		{
-			if(i == nd)
-			{
-				frexpr(p->nelt);
-				p->nelt = NULL;
-			}
-			else
-				err("only last bound may be asterisk");
-			p->dims[i].dimsize = ICON(1);
-			p->dims[i].dimexpr = NULL;
-		}
-		else
-		{
-
-			if(dims[i].lb)
-			{
-				q = mkexpr(OPMINUS, q, cpexpr(dims[i].lb));
-				q = mkexpr(OPPLUS, q, ICON(1) );
-			}
-			if( ISCONST(q) )
-			{
-				p->dims[i].dimsize = q;
-				p->dims[i].dimexpr = (expptr) PNULL;
-			}
-			else {
-				sprintf(buf, " %s_dim%d", v->fvarname, i+1);
-				p->dims[i].dimsize = (expptr)
-					autovar(1, tyint, EXNULL, buf);
-				p->dims[i].dimexpr = q;
-				if (i == nd)
-					v->vlastdim = new_vars;
-				v->vdimfinish = 1;
-			}
-			if(p->nelt)
-				p->nelt = mkexpr(OPSTAR, p->nelt,
-				    cpexpr(p->dims[i].dimsize) );
-		}
-	}
-
-	q = dims[nd].lb;
-	if(q == NULL)
-		q = ICON(1);
-
-	for(i = nd-1 ; i>=0 ; --i)
-	{
-		t = dims[i].lb;
-		if(t == NULL)
-			t = ICON(1);
-		if(p->dims[i].dimsize)
-			q = mkexpr(OPPLUS, t,
-				mkexpr(OPSTAR, cpexpr(p->dims[i].dimsize), q));
-	}
-
-	if( ISCONST(q) )
-	{
-		p->baseoffset = q;
-		p->basexpr = NULL;
-	}
-	else
-	{
-		sprintf(buf, " %s_offset", v->fvarname);
-		p->baseoffset = (expptr) autovar(1, tyint, EXNULL, buf);
-		p->basexpr = q;
-		v->vdimfinish = 1;
-	}
-	doin_setbound = 0;
-}
-
-
- void
-#ifdef KR_headers
-wr_abbrevs(outfile, function_head, vars)
-	FILE *outfile;
-	int function_head;
-	chainp vars;
-#else
-wr_abbrevs(FILE *outfile, int function_head, chainp vars)
-#endif
-{
-    for (; vars; vars = vars -> nextp) {
-	Namep name = (Namep) vars -> datap;
-	if (!name->visused)
-		continue;
-
-	if (function_head)
-	    nice_printf (outfile, "#define ");
-	else
-	    nice_printf (outfile, "#undef ");
-	out_name (outfile, name);
-
-	if (function_head) {
-	    Extsym *comm = &extsymtab[name -> vardesc.varno];
-
-	    nice_printf (outfile, " (");
-	    extern_out (outfile, comm);
-	    nice_printf (outfile, "%d.", comm->curno);
-	    nice_printf (outfile, "%s)", name->cvarname);
-	} /* if function_head */
-	nice_printf (outfile, "\n");
-    } /* for */
-} /* wr_abbrevs */
diff --git a/usr.bin/f2c/put.c b/usr.bin/f2c/put.c
deleted file mode 100644
index 25425c5..0000000
--- a/usr.bin/f2c/put.c
+++ /dev/null
@@ -1,441 +0,0 @@
-/****************************************************************
-Copyright 1990, 1991, 1993, 1994, 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-/*
- * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
- * JOHNSON (PORTABLE) AND RITCHIE FAMILIES OF SECOND PASSES
-*/
-
-#include "defs.h"
-#include "names.h"		/* For LOCAL_CONST_NAME */
-#include "pccdefs.h"
-#include "p1defs.h"
-
-/* Definitions for   putconst()   */
-
-#define LIT_CHAR 1
-#define LIT_FLOAT 2
-#define LIT_INT 3
-
-
-/*
-char *ops [ ] =
-	{
-	"??", "+", "-", "*", "/", "**", "-",
-	"OR", "AND", "EQV", "NEQV", "NOT",
-	"CONCAT",
-	"<", "==", ">", "<=", "!=", ">=",
-	" of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ",
-	" , ", " ? ", " : "
-	" abs ", " min ", " max ", " addr ", " indirect ",
-	" bitor ", " bitand ", " bitxor ", " bitnot ", " >> ",
-	};
-*/
-
-/* Each of these values is defined in   pccdefs   */
-
-int ops2 [ ] =
-{
-	P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG,
-	P2OROR, P2ANDAND, P2EQ, P2NE, P2NOT,
-	P2BAD,
-	P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE,
-	P2CALL, P2CALL, P2ASSIGN, P2PLUSEQ, P2STAREQ, P2CONV, P2LSHIFT, P2MOD,
-	P2COMOP, P2QUEST, P2COLON,
-	1, P2BAD, P2BAD, P2BAD, P2BAD,
-	P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT,
-	P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
-	P2BAD, P2BAD, P2BAD, P2BAD,
-	1,1,1,1,1, /* OPNEG1, OPDMIN, OPDMAX, OPASSIGNI, OPIDENTITY */
-	1,1,1,1,   /* OPCHARCAST, OPDABS, OPMIN2, OPMAX2 */
-	1,1,1,1,1  /* OPBITTEST, OPBITCLR, OPBITSET, OPQBIT{CLR,SET} */
-};
-
-
- void
-#ifdef KR_headers
-putexpr(p)
-	expptr p;
-#else
-putexpr(expptr p)
-#endif
-{
-/* Write the expression to the p1 file */
-
-	p = (expptr) putx (fixtype (p));
-	p1_expr (p);
-}
-
-
-
-
-
- expptr
-#ifdef KR_headers
-putassign(lp, rp)
-	expptr lp;
-	expptr rp;
-#else
-putassign(expptr lp, expptr rp)
-#endif
-{
-	return putx(fixexpr((Exprp)mkexpr(OPASSIGN, lp, rp)));
-}
-
-
-
-
- void
-#ifdef KR_headers
-puteq(lp, rp)
-	expptr lp;
-	expptr rp;
-#else
-puteq(expptr lp, expptr rp)
-#endif
-{
-	putexpr(mkexpr(OPASSIGN, lp, rp) );
-}
-
-
-
-
-/* put code for  a *= b */
-
- expptr
-#ifdef KR_headers
-putsteq(a, b)
-	Addrp a;
-	Addrp b;
-#else
-putsteq(Addrp a, Addrp b)
-#endif
-{
-	return putx( fixexpr((Exprp)
-		mkexpr(OPSTAREQ, cpexpr((expptr)a), cpexpr((expptr)b))));
-}
-
-
-
-
- Addrp
-#ifdef KR_headers
-mkfield(res, f, ty)
-	register Addrp res;
-	char *f;
-	int ty;
-#else
-mkfield(register Addrp res, char *f, int ty)
-#endif
-{
-    res -> vtype = ty;
-    res -> Field = f;
-    return res;
-} /* mkfield */
-
-
- Addrp
-#ifdef KR_headers
-realpart(p)
-	register Addrp p;
-#else
-realpart(register Addrp p)
-#endif
-{
-	register Addrp q;
-
-	if (p->tag == TADDR
-	 && p->uname_tag == UNAM_CONST
-	 && ISCOMPLEX (p->vtype))
-		return (Addrp)mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
-			p->user.kludge.vstg1 ? p->user.Const.cds[0]
-				: cds(dtos(p->user.Const.cd[0]),CNULL));
-
-	q = (Addrp) cpexpr((expptr) p);
-	if( ISCOMPLEX(p->vtype) )
-		q = mkfield (q, "r", p -> vtype + TYREAL - TYCOMPLEX);
-
-	return(q);
-}
-
-
-
-
- expptr
-#ifdef KR_headers
-imagpart(p)
-	register Addrp p;
-#else
-imagpart(register Addrp p)
-#endif
-{
-	register Addrp q;
-
-	if( ISCOMPLEX(p->vtype) )
-	{
-		if (p->tag == TADDR && p->uname_tag == UNAM_CONST)
-			return mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
-				p->user.kludge.vstg1 ? p->user.Const.cds[1]
-				: cds(dtos(p->user.Const.cd[1]),CNULL));
-		q = (Addrp) cpexpr((expptr) p);
-		q = mkfield (q, "i", p -> vtype + TYREAL - TYCOMPLEX);
-		return( (expptr) q );
-	}
-	else
-
-/* Cast an integer type onto a Double Real type */
-
-		return( mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , "0"));
-}
-
-
-
-
-
-/* ncat -- computes the number of adjacent concatenation operations */
-
- int
-#ifdef KR_headers
-ncat(p)
-	register expptr p;
-#else
-ncat(register expptr p)
-#endif
-{
-	if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
-		return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) );
-	else	return(1);
-}
-
-
-
-
-/* lencat -- returns the length of the concatenated string.  Each
-   substring must have a static (i.e. compile-time) fixed length */
-
- ftnint
-#ifdef KR_headers
-lencat(p)
-	register expptr p;
-#else
-lencat(register expptr p)
-#endif
-{
-	if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
-		return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) );
-	else if( p->headblock.vleng!=NULL && ISICON(p->headblock.vleng) )
-		return(p->headblock.vleng->constblock.Const.ci);
-	else if(p->tag==TADDR && p->addrblock.varleng!=0)
-		return(p->addrblock.varleng);
-	else
-	{
-		err("impossible element in concatenation");
-		return(0);
-	}
-}
-
-/* putconst -- Creates a new Addrp value which maps onto the input
-   constant value.  The Addrp doesn't retain the value of the constant,
-   instead that value is copied into a table of constants (called
-   litpool,   for pool of literal values).  The only way to retrieve the
-   actual value of the constant is to look at the   memno   field of the
-   Addrp result.  You know that the associated literal is the one referred
-   to by   q   when   (q -> memno == litp -> litnum).
-*/
-
- Addrp
-#ifdef KR_headers
-putconst(p)
-	register Constp p;
-#else
-putconst(register Constp p)
-#endif
-{
-	register Addrp q;
-	struct Literal *litp, *lastlit;
-	int k, len, type;
-	int litflavor;
-	double cd[2];
-	ftnint nblanks;
-	char *strp;
-	char cdsbuf0[64], cdsbuf1[64], *ds[2];
-
-	if (p->tag != TCONST)
-		badtag("putconst", p->tag);
-
-	q = ALLOC(Addrblock);
-	q->tag = TADDR;
-	type = p->vtype;
-	q->vtype = ( type==TYADDR ? tyint : type );
-	q->vleng = (expptr) cpexpr(p->vleng);
-	q->vstg = STGCONST;
-
-/* Create the new label for the constant.  This is wasteful of labels
-   because when the constant value already exists in the literal pool,
-   this label gets thrown away and is never reclaimed.  It might be
-   cleaner to move this down past the first   switch()   statement below */
-
-	q->memno = newlabel();
-	q->memoffset = ICON(0);
-	q -> uname_tag = UNAM_CONST;
-
-/* Copy the constant info into the Addrblock; do this by copying the
-   largest storage elts */
-
-	q -> user.Const = p -> Const;
-	q->user.kludge.vstg1 = p->vstg;	/* distinguish string from binary fp */
-
-	/* check for value in literal pool, and update pool if necessary */
-
-	k = 1;
-	switch(type)
-	{
-	case TYCHAR:
-		if (halign) {
-			strp = p->Const.ccp;
-			nblanks = p->Const.ccp1.blanks;
-			len = p->vleng->constblock.Const.ci;
-			litflavor = LIT_CHAR;
-			goto loop;
-			}
-		else
-			q->memno = BAD_MEMNO;
-		break;
-	case TYCOMPLEX:
-	case TYDCOMPLEX:
-		k = 2;
-		if (p->vstg)
-			cd[1] = atof(ds[1] = p->Const.cds[1]);
-		else
-			ds[1] = cds(dtos(cd[1] = p->Const.cd[1]), cdsbuf1);
-	case TYREAL:
-	case TYDREAL:
-		litflavor = LIT_FLOAT;
-		if (p->vstg)
-			cd[0] = atof(ds[0] = p->Const.cds[0]);
-		else
-			ds[0] = cds(dtos(cd[0] = p->Const.cd[0]), cdsbuf0);
-		goto loop;
-
-	case TYLOGICAL1:
-	case TYLOGICAL2:
-	case TYLOGICAL:
-	case TYLONG:
-	case TYSHORT:
-	case TYINT1:
-#ifdef TYQUAD
-	case TYQUAD:
-#endif
- lit_int_flavor:
-		litflavor = LIT_INT;
-
-/* Scan the literal pool for this constant value.  If this same constant
-   has been assigned before, use the same label.  Note that this routine
-   does NOT consider two differently-typed constants with the same bit
-   pattern to be the same constant */
-
- loop:
-		lastlit = litpool + nliterals;
-		for(litp = litpool ; litp<lastlit ; ++litp)
-
-/* Remove this type checking to ensure that all bit patterns are reused */
-
-			if(type == litp->littype) switch(litflavor)
-			{
-			case LIT_CHAR:
-				if (len == (int)litp->litval.litival2[0]
-				&& nblanks == litp->litval.litival2[1]
-				&& !memcmp(strp, litp->cds[0], len)) {
-					q->memno = litp->litnum;
-					frexpr((expptr)p);
-					q->user.Const.ccp1.ccp0 = litp->cds[0];
-					return(q);
-					}
-				break;
-			case LIT_FLOAT:
-				if(cd[0] == litp->litval.litdval[0]
-				&& !strcmp(ds[0], litp->cds[0])
-				&& (k == 1 ||
-				    cd[1] == litp->litval.litdval[1]
-				    && !strcmp(ds[1], litp->cds[1]))) {
-ret:
-					q->memno = litp->litnum;
-					frexpr((expptr)p);
-					return(q);
-					}
-				break;
-
-			case LIT_INT:
-				if(p->Const.ci == litp->litval.litival)
-					goto ret;
-				break;
-			}
-
-/* If there's room in the literal pool, add this new value to the pool */
-
-		if(nliterals < maxliterals)
-		{
-			++nliterals;
-
-			/* litp   now points to the next free elt */
-
-			litp->littype = type;
-			litp->litnum = q->memno;
-			switch(litflavor)
-			{
-			case LIT_CHAR:
-				litp->litval.litival2[0] = len;
-				litp->litval.litival2[1] = nblanks;
-				q->user.Const.ccp = litp->cds[0] =
-					memcpy(gmem(len,0), strp, len);
-				break;
-
-			case LIT_FLOAT:
-				litp->litval.litdval[0] = cd[0];
-				litp->cds[0] = copys(ds[0]);
-				if (k == 2) {
-					litp->litval.litdval[1] = cd[1];
-					litp->cds[1] = copys(ds[1]);
-					}
-				break;
-
-			case LIT_INT:
-				litp->litval.litival = p->Const.ci;
-				break;
-			} /* switch (litflavor) */
-		}
-		else
-			many("literal constants", 'L', maxliterals);
-
-		break;
-	case TYADDR:
-	    break;
-	default:
-		badtype ("putconst", p -> vtype);
-		break;
-	} /* switch */
-
-	if (type != TYCHAR || halign)
-	    frexpr((expptr)p);
-	return( q );
-}
diff --git a/usr.bin/f2c/putpcc.c b/usr.bin/f2c/putpcc.c
deleted file mode 100644
index 87d4550..0000000
--- a/usr.bin/f2c/putpcc.c
+++ /dev/null
@@ -1,2079 +0,0 @@
-/****************************************************************
-Copyright 1990 - 1996 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-/* INTERMEDIATE CODE GENERATION FOR S. C. JOHNSON C COMPILERS */
-/* NEW VERSION USING BINARY POLISH POSTFIX INTERMEDIATE */
-
-#include "defs.h"
-#include "pccdefs.h"
-#include "output.h"		/* for nice_printf */
-#include "names.h"
-#include "p1defs.h"
-
-static Addrp intdouble Argdcl((Addrp));
-static Addrp putcx1 Argdcl((tagptr));
-static tagptr putaddr Argdcl((tagptr));
-static tagptr putcall Argdcl((tagptr, Addrp*));
-static tagptr putcat Argdcl((tagptr, tagptr));
-static Addrp putch1 Argdcl((tagptr));
-static tagptr putchcmp Argdcl((tagptr));
-static tagptr putcheq Argdcl((tagptr));
-static void putct1 Argdcl((tagptr, Addrp, Addrp, ptr));
-static tagptr putcxcmp Argdcl((tagptr));
-static Addrp putcxeq Argdcl((tagptr));
-static tagptr putmnmx Argdcl((tagptr));
-static tagptr putop Argdcl((tagptr));
-static tagptr putpower Argdcl((tagptr));
-
-extern int init_ac[TYSUBR+1];
-extern int ops2[];
-extern int proc_argchanges, proc_protochanges;
-extern int krparens;
-
-#define P2BUFFMAX 128
-
-/* Puthead -- output the header information about subroutines, functions
-   and entry points */
-
- void
-#ifdef KR_headers
-puthead(s, class)
-	char *s;
-	int class;
-#else
-puthead(char *s, int class)
-#endif
-{
-	if (headerdone == NO) {
-		if (class == CLMAIN)
-			s = "MAIN__";
-		p1_head (class, s);
-		headerdone = YES;
-		}
-}
-
- void
-#ifdef KR_headers
-putif(p, else_if_p)
-	register expptr p;
-	int else_if_p;
-#else
-putif(register expptr p, int else_if_p)
-#endif
-{
-	register int k;
-	int n;
-	long where;
-
-	if (else_if_p) {
-		p1put(P1_ELSEIFSTART);
-		where = ftell(pass1_file);
-		}
-	if( !ISLOGICAL((k = (p = fixtype(p))->headblock.vtype )) )
-	{
-		if(k != TYERROR)
-			err("non-logical expression in IF statement");
-		}
-	else {
-		if (else_if_p) {
-			if (ei_next >= ei_last)
-				{
-				k = ei_last - ei_first;
-				n = k + 100;
-				ei_next = mem(n,0);
-				ei_last = ei_first + n;
-				if (k)
-					memcpy(ei_next, ei_first, k);
-				ei_first =  ei_next;
-				ei_next += k;
-				ei_last = ei_first + n;
-				}
-			p = putx(p);
-			if (*ei_next++ = ftell(pass1_file) > where) {
-				p1_if(p);
-				new_endif();
-				}
-			else
-				p1_elif(p);
-			}
-		else {
-			p = putx(p);
-			p1_if(p);
-			}
-		}
-	}
-
- void
-#ifdef KR_headers
-putout(p)
-	expptr p;
-#else
-putout(expptr p)
-#endif
-{
-	p1_expr (p);
-
-/* Used to make temporaries in holdtemps available here, but they */
-/* may be reused too soon (e.g. when multiple **'s are involved). */
-}
-
-
- void
-#ifdef KR_headers
-putcmgo(index, nlab, labs)
-	expptr index;
-	int nlab;
-	struct Labelblock **labs;
-#else
-putcmgo(expptr index, int nlab, struct Labelblock **labs)
-#endif
-{
-	if(! ISINT(index->headblock.vtype) )
-	{
-		execerr("computed goto index must be integer", CNULL);
-		return;
-	}
-
-	p1comp_goto (index, nlab, labs);
-}
-
- static expptr
-#ifdef KR_headers
-krput(p)
-	register expptr p;
-#else
-krput(register expptr p)
-#endif
-{
-	register expptr e, e1;
-	register unsigned op;
-	int t = krparens == 2 ? TYDREAL : p->exprblock.vtype;
-
-	op = p->exprblock.opcode;
-	e = p->exprblock.leftp;
-	if (e->tag == TEXPR && e->exprblock.opcode == op) {
-		e1 = (expptr)mktmp(t, ENULL);
-		putout(putassign(cpexpr(e1), e));
-		p->exprblock.leftp = e1;
-		}
-	else
-		p->exprblock.leftp = putx(e);
-
-	e = p->exprblock.rightp;
-	if (e->tag == TEXPR && e->exprblock.opcode == op) {
-		e1 = (expptr)mktmp(t, ENULL);
-		putout(putassign(cpexpr(e1), e));
-		p->exprblock.rightp = e1;
-		}
-	else
-		p->exprblock.rightp = putx(e);
-	return p;
-	}
-
- expptr
-#ifdef KR_headers
-putx(p)
-	register expptr p;
-#else
-putx(register expptr p)
-#endif
-{
-	int opc;
-	int k;
-
-	if (p)
-	  switch(p->tag)
-	{
-	case TERROR:
-		break;
-
-	case TCONST:
-		switch(p->constblock.vtype)
-		{
-		case TYLOGICAL1:
-		case TYLOGICAL2:
-		case TYLOGICAL:
-#ifdef TYQUAD
-		case TYQUAD:
-#endif
-		case TYLONG:
-		case TYSHORT:
-		case TYINT1:
-			break;
-
-		case TYADDR:
-			break;
-		case TYREAL:
-		case TYDREAL:
-
-/* Don't write it out to the p2 file, since you'd need to call putconst,
-   which is just what we need to avoid in the translator */
-
-			break;
-		default:
-			p = putx( (expptr)putconst((Constp)p) );
-			break;
-		}
-		break;
-
-	case TEXPR:
-		switch(opc = p->exprblock.opcode)
-		{
-		case OPCALL:
-		case OPCCALL:
-			if( ISCOMPLEX(p->exprblock.vtype) )
-				p = putcxop(p);
-			else	p = putcall(p, (Addrp *)NULL);
-			break;
-
-		case OPMIN:
-		case OPMAX:
-			p = putmnmx(p);
-			break;
-
-
-		case OPASSIGN:
-			if(ISCOMPLEX(p->exprblock.leftp->headblock.vtype)
-			    || ISCOMPLEX(p->exprblock.rightp->headblock.vtype)) {
-				(void) putcxeq(p);
-				p = ENULL;
-			} else if( ISCHAR(p) )
-				p = putcheq(p);
-			else
-				goto putopp;
-			break;
-
-		case OPEQ:
-		case OPNE:
-			if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) ||
-			    ISCOMPLEX(p->exprblock.rightp->headblock.vtype) )
-			{
-				p = putcxcmp(p);
-				break;
-			}
-		case OPLT:
-		case OPLE:
-		case OPGT:
-		case OPGE:
-			if(ISCHAR(p->exprblock.leftp))
-			{
-				p = putchcmp(p);
-				break;
-			}
-			goto putopp;
-
-		case OPPOWER:
-			p = putpower(p);
-			break;
-
-		case OPSTAR:
-			/*   m * (2**k) -> m<<k   */
-			if(INT(p->exprblock.leftp->headblock.vtype) &&
-			    ISICON(p->exprblock.rightp) &&
-			    ( (k = log_2(p->exprblock.rightp->constblock.Const.ci))>0) )
-			{
-				p->exprblock.opcode = OPLSHIFT;
-				frexpr(p->exprblock.rightp);
-				p->exprblock.rightp = ICON(k);
-				goto putopp;
-			}
-			if (krparens && ISREAL(p->exprblock.vtype))
-				return krput(p);
-
-		case OPMOD:
-			goto putopp;
-		case OPPLUS:
-			if (krparens && ISREAL(p->exprblock.vtype))
-				return krput(p);
-		case OPMINUS:
-		case OPSLASH:
-		case OPNEG:
-		case OPNEG1:
-		case OPABS:
-		case OPDABS:
-			if( ISCOMPLEX(p->exprblock.vtype) )
-				p = putcxop(p);
-			else	goto putopp;
-			break;
-
-		case OPCONV:
-			if( ISCOMPLEX(p->exprblock.vtype) )
-				p = putcxop(p);
-			else if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) )
-			{
-				p = putx( mkconv(p->exprblock.vtype,
-				    (expptr)realpart(putcx1(p->exprblock.leftp))));
-			}
-			else	goto putopp;
-			break;
-
-		case OPNOT:
-		case OPOR:
-		case OPAND:
-		case OPEQV:
-		case OPNEQV:
-		case OPADDR:
-		case OPPLUSEQ:
-		case OPSTAREQ:
-		case OPCOMMA:
-		case OPQUEST:
-		case OPCOLON:
-		case OPBITOR:
-		case OPBITAND:
-		case OPBITXOR:
-		case OPBITNOT:
-		case OPLSHIFT:
-		case OPRSHIFT:
-		case OPASSIGNI:
-		case OPIDENTITY:
-		case OPCHARCAST:
-		case OPMIN2:
-		case OPMAX2:
-		case OPDMIN:
-		case OPDMAX:
-		case OPBITTEST:
-		case OPBITCLR:
-		case OPBITSET:
-#ifdef TYQUAD
-		case OPQBITSET:
-		case OPQBITCLR:
-#endif
-putopp:
-			p = putop(p);
-			break;
-
-		case OPCONCAT:
-			/* weird things like ichar(a//a) */
-			p = (expptr)putch1(p);
-			break;
-
-		default:
-			badop("putx", opc);
-			p = errnode ();
-		}
-		break;
-
-	case TADDR:
-		p = putaddr(p);
-		break;
-
-	default:
-		badtag("putx", p->tag);
-		p = errnode ();
-	}
-
-	return p;
-}
-
-
-
- LOCAL expptr
-#ifdef KR_headers
-putop(p)
-	expptr p;
-#else
-putop(expptr p)
-#endif
-{
-	expptr lp, tp;
-	int pt, lt, lt1;
-	int comma;
-	char *hsave;
-
-	switch(p->exprblock.opcode)	/* check for special cases and rewrite */
-	{
-	case OPCONV:
-		pt = p->exprblock.vtype;
-		lp = p->exprblock.leftp;
-		lt = lp->headblock.vtype;
-
-/* Simplify nested type casts */
-
-		while(p->tag==TEXPR && p->exprblock.opcode==OPCONV &&
-		    ( (ISREAL(pt)&&ONEOF(lt,MSKREAL|MSKCOMPLEX)) ||
-		    (INT(pt)&&(ONEOF(lt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) ))
-		{
-			if(pt==TYDREAL && lt==TYREAL)
-			{
-				if(lp->tag==TEXPR
-				&& lp->exprblock.opcode == OPCONV) {
-				    lt1 = lp->exprblock.leftp->headblock.vtype;
-				    if (lt1 == TYDREAL) {
-					lp->exprblock.leftp =
-						putx(lp->exprblock.leftp);
-					return p;
-					}
-				    if (lt1 == TYDCOMPLEX) {
-					lp->exprblock.leftp = putx(
-						(expptr)realpart(
-						putcx1(lp->exprblock.leftp)));
-					return p;
-					}
-				    }
-				break;
-			}
-			else if (ISREAL(pt) && ISCOMPLEX(lt)) {
-				p->exprblock.leftp = putx(mkconv(pt,
-					(expptr)realpart(
-						putcx1(p->exprblock.leftp))));
-				break;
-				}
-			if(lt==TYCHAR && lp->tag==TEXPR &&
-			    lp->exprblock.opcode==OPCALL)
-			{
-
-/* May want to make a comma expression here instead.  I had one, but took
-   it out for my convenience, not for the convenience of the end user */
-
-				putout (putcall (lp, (Addrp *) &(p ->
-				    exprblock.leftp)));
-				return putop (p);
-			}
-			if (lt == TYCHAR) {
-				if (ISCONST(p->exprblock.leftp)
-				 && ISNUMERIC(p->exprblock.vtype)) {
-					hsave = halign;
-					halign = 0;
-					p->exprblock.leftp = putx((expptr)
-						putconst((Constp)
-							p->exprblock.leftp));
-					halign = hsave;
-					}
-				else
-					p->exprblock.leftp =
-						putx(p->exprblock.leftp);
-				return p;
-				}
-			if (pt < lt && ONEOF(lt,MSKINT|MSKREAL))
-				break;
-			frexpr(p->exprblock.vleng);
-			free( (charptr) p );
-			p = lp;
-			if (p->tag != TEXPR)
-				goto retputx;
-			pt = lt;
-			lp = p->exprblock.leftp;
-			lt = lp->headblock.vtype;
-		} /* while */
-		if(p->tag==TEXPR && p->exprblock.opcode==OPCONV)
-			break;
- retputx:
-		return putx(p);
-
-	case OPADDR:
-		comma = NO;
-		lp = p->exprblock.leftp;
-		free( (charptr) p );
-		if(lp->tag != TADDR)
-		{
-			tp = (expptr)
-			    mktmp(lp->headblock.vtype,lp->headblock.vleng);
-			p = putx( mkexpr(OPASSIGN, cpexpr(tp), lp) );
-			lp = tp;
-			comma = YES;
-		}
-		if(comma)
-			p = mkexpr(OPCOMMA, p, putaddr(lp));
-		else
-			p = (expptr)putaddr(lp);
-		return p;
-
-	case OPASSIGN:
-	case OPASSIGNI:
-	case OPLT:
-	case OPLE:
-	case OPGT:
-	case OPGE:
-	case OPEQ:
-	case OPNE:
-	    ;
-	}
-
-	if( ops2[p->exprblock.opcode] <= 0)
-		badop("putop", p->exprblock.opcode);
-	lp = p->exprblock.leftp = putx(p->exprblock.leftp);
-	if (p -> exprblock.rightp) {
-		tp = p->exprblock.rightp = putx(p->exprblock.rightp);
-		if (ISCONST(tp) && ISCONST(lp))
-			p = fold(p);
-		}
-	return p;
-}
-
- LOCAL expptr
-#ifdef KR_headers
-putpower(p)
-	expptr p;
-#else
-putpower(expptr p)
-#endif
-{
-	expptr base;
-	Addrp t1, t2;
-	ftnint k;
-	int type;
-	char buf[80];			/* buffer for text of comment */
-
-	if(!ISICON(p->exprblock.rightp) ||
-	    (k = p->exprblock.rightp->constblock.Const.ci)<2)
-		Fatal("putpower: bad call");
-	base = p->exprblock.leftp;
-	type = base->headblock.vtype;
-	t1 = mktmp(type, ENULL);
-	t2 = NULL;
-
-	free ((charptr) p);
-	p = putassign (cpexpr((expptr) t1), base);
-
-	sprintf (buf, "Computing %ld%s power", k,
-		k == 2 ? "nd" : k == 3 ? "rd" : "th");
-	p1_comment (buf);
-
-	for( ; (k&1)==0 && k>2 ; k>>=1 )
-	{
-		p = mkexpr (OPCOMMA, p, putsteq(t1, t1));
-	}
-
-	if(k == 2) {
-
-/* Write the power computation out immediately */
-		putout (p);
-		p = putx( mkexpr(OPSTAR, cpexpr((expptr)t1), cpexpr((expptr)t1)));
-	} else if (k == 3) {
-		putout(p);
-		p = putx( mkexpr(OPSTAR, cpexpr((expptr)t1),
-		    mkexpr(OPSTAR, cpexpr((expptr)t1), cpexpr((expptr)t1))));
-	} else {
-		t2 = mktmp(type, ENULL);
-		p = mkexpr (OPCOMMA, p, putassign(cpexpr((expptr)t2),
-						cpexpr((expptr)t1)));
-
-		for(k>>=1 ; k>1 ; k>>=1)
-		{
-			p = mkexpr (OPCOMMA, p, putsteq(t1, t1));
-			if(k & 1)
-			{
-				p = mkexpr (OPCOMMA, p, putsteq(t2, t1));
-			}
-		}
-/* Write the power computation out immediately */
-		putout (p);
-		p = putx( mkexpr(OPSTAR, cpexpr((expptr)t2),
-		    mkexpr(OPSTAR, cpexpr((expptr)t1), cpexpr((expptr)t1))));
-	}
-	frexpr((expptr)t1);
-	if(t2)
-		frexpr((expptr)t2);
-	return p;
-}
-
-
-
-
- LOCAL Addrp
-#ifdef KR_headers
-intdouble(p)
-	Addrp p;
-#else
-intdouble(Addrp p)
-#endif
-{
-	register Addrp t;
-
-	t = mktmp(TYDREAL, ENULL);
-	putout (putassign(cpexpr((expptr)t), (expptr)p));
-	return(t);
-}
-
-
-
-
-
-/* Complex-type variable assignment */
-
- LOCAL Addrp
-#ifdef KR_headers
-putcxeq(p)
-	register expptr p;
-#else
-putcxeq(register expptr p)
-#endif
-{
-	register Addrp lp, rp;
-	expptr code;
-
-	if(p->tag != TEXPR)
-		badtag("putcxeq", p->tag);
-
-	lp = putcx1(p->exprblock.leftp);
-	rp = putcx1(p->exprblock.rightp);
-	code = putassign ( (expptr)realpart(lp), (expptr)realpart(rp));
-
-	if( ISCOMPLEX(p->exprblock.vtype) )
-	{
-		code = mkexpr (OPCOMMA, code, putassign
-			(imagpart(lp), imagpart(rp)));
-	}
-	putout (code);
-	frexpr((expptr)rp);
-	free ((charptr) p);
-	return lp;
-}
-
-
-
-/* putcxop -- used to write out embedded calls to complex functions, and
-   complex arguments to procedures */
-
- expptr
-#ifdef KR_headers
-putcxop(p)
-	expptr p;
-#else
-putcxop(expptr p)
-#endif
-{
-	return (expptr)putaddr((expptr)putcx1(p));
-}
-
-#define PAIR(x,y) mkexpr (OPCOMMA, (x), (y))
-
- LOCAL Addrp
-#ifdef KR_headers
-putcx1(p)
-	register expptr p;
-#else
-putcx1(register expptr p)
-#endif
-{
-	expptr q;
-	Addrp lp, rp;
-	register Addrp resp;
-	int opcode;
-	int ltype, rtype;
-	long ts, tskludge;
-
-	if(p == NULL)
-		return(NULL);
-
-	switch(p->tag)
-	{
-	case TCONST:
-		if( ISCOMPLEX(p->constblock.vtype) )
-			p = (expptr) putconst((Constp)p);
-		return( (Addrp) p );
-
-	case TADDR:
-		resp = &p->addrblock;
-		if (addressable(p))
-			return (Addrp) p;
-		ts = tskludge = 0;
-		if (q = resp->memoffset) {
-			if (resp->uname_tag == UNAM_REF) {
-				q = cpexpr((tagptr)resp);
-				q->addrblock.vtype = tyint;
-				q->addrblock.cmplx_sub = 1;
-				p->addrblock.skip_offset = 1;
-				resp->user.name->vsubscrused = 1;
-				resp->uname_tag = UNAM_NAME;
-				tskludge = typesize[resp->vtype]
-					* (resp->Field ? 2 : 1);
-				}
-			else if (resp->isarray
-					&& resp->vtype != TYCHAR) {
-				if (ONEOF(resp->vstg, M(STGCOMMON)|M(STGEQUIV))
-					  && resp->uname_tag == UNAM_NAME)
-					q = mkexpr(OPMINUS, q,
-					  mkintcon(resp->user.name->voffset));
-				ts = typesize[resp->vtype]
-					* (resp->Field ? 2 : 1);
-				q = resp->memoffset = mkexpr(OPSLASH, q,
-								ICON(ts));
-				}
-			}
-		resp = mktmp(tyint, ENULL);
-		putout(putassign(cpexpr((expptr)resp), q));
-		p->addrblock.memoffset = tskludge
-			? mkexpr(OPSTAR, (expptr)resp, ICON(tskludge))
-			: (expptr)resp;
-		if (ts) {
-			resp = &p->addrblock;
-			q = mkexpr(OPSTAR, resp->memoffset, ICON(ts));
-			if (ONEOF(resp->vstg, M(STGCOMMON)|M(STGEQUIV))
-				&& resp->uname_tag == UNAM_NAME)
-				q = mkexpr(OPPLUS, q,
-				    mkintcon(resp->user.name->voffset));
-			resp->memoffset = q;
-			}
-		return (Addrp) p;
-
-	case TEXPR:
-		if( ISCOMPLEX(p->exprblock.vtype) )
-			break;
-		resp = mktmp(p->exprblock.vtype, ENULL);
-		/*first arg of above mktmp call was TYDREAL before 19950102 */
-		putout (putassign( cpexpr((expptr)resp), p));
-		return(resp);
-
-	case TERROR:
-		return NULL;
-
-	default:
-		badtag("putcx1", p->tag);
-	}
-
-	opcode = p->exprblock.opcode;
-	if(opcode==OPCALL || opcode==OPCCALL)
-	{
-		Addrp t;
-		p = putcall(p, &t);
-		putout(p);
-		return t;
-	}
-	else if(opcode == OPASSIGN)
-	{
-		return putcxeq (p);
-	}
-
-/* BUG  (inefficient)  Generates too many temporary variables */
-
-	resp = mktmp(p->exprblock.vtype, ENULL);
-	if(lp = putcx1(p->exprblock.leftp) )
-		ltype = lp->vtype;
-	if(rp = putcx1(p->exprblock.rightp) )
-		rtype = rp->vtype;
-
-	switch(opcode)
-	{
-	case OPCOMMA:
-		frexpr((expptr)resp);
-		resp = rp;
-		rp = NULL;
-		break;
-
-	case OPNEG:
-	case OPNEG1:
-		putout (PAIR (
-			putassign( (expptr)realpart(resp),
-				mkexpr(OPNEG, (expptr)realpart(lp), ENULL)),
-			putassign( imagpart(resp),
-				mkexpr(OPNEG, imagpart(lp), ENULL))));
-		break;
-
-	case OPPLUS:
-	case OPMINUS: { expptr r;
-		r = putassign( (expptr)realpart(resp),
-		    mkexpr(opcode, (expptr)realpart(lp), (expptr)realpart(rp) ));
-		if(rtype < TYCOMPLEX)
-			q = putassign( imagpart(resp), imagpart(lp) );
-		else if(ltype < TYCOMPLEX)
-		{
-			if(opcode == OPPLUS)
-				q = putassign( imagpart(resp), imagpart(rp) );
-			else
-				q = putassign( imagpart(resp),
-				    mkexpr(OPNEG, imagpart(rp), ENULL) );
-		}
-		else
-			q = putassign( imagpart(resp),
-			    mkexpr(opcode, imagpart(lp), imagpart(rp) ));
-		r = PAIR (r, q);
-		putout (r);
-		break;
-	    } /* case OPPLUS, OPMINUS: */
-	case OPSTAR:
-		if(ltype < TYCOMPLEX)
-		{
-			if( ISINT(ltype) )
-				lp = intdouble(lp);
-			putout (PAIR (
-				putassign( (expptr)realpart(resp),
-				    mkexpr(OPSTAR, cpexpr((expptr)lp),
-					(expptr)realpart(rp))),
-				putassign( imagpart(resp),
-				    mkexpr(OPSTAR, cpexpr((expptr)lp), imagpart(rp)))));
-		}
-		else if(rtype < TYCOMPLEX)
-		{
-			if( ISINT(rtype) )
-				rp = intdouble(rp);
-			putout (PAIR (
-				putassign( (expptr)realpart(resp),
-				    mkexpr(OPSTAR, cpexpr((expptr)rp),
-					(expptr)realpart(lp))),
-				putassign( imagpart(resp),
-				    mkexpr(OPSTAR, cpexpr((expptr)rp), imagpart(lp)))));
-		}
-		else	{
-			putout (PAIR (
-				putassign( (expptr)realpart(resp), mkexpr(OPMINUS,
-				    mkexpr(OPSTAR, (expptr)realpart(lp),
-					(expptr)realpart(rp)),
-				    mkexpr(OPSTAR, imagpart(lp), imagpart(rp)))),
-				putassign( imagpart(resp), mkexpr(OPPLUS,
-				    mkexpr(OPSTAR, (expptr)realpart(lp), imagpart(rp)),
-				    mkexpr(OPSTAR, imagpart(lp),
-					(expptr)realpart(rp))))));
-		}
-		break;
-
-	case OPSLASH:
-		/* fixexpr has already replaced all divisions
-		 * by a complex by a function call
-		 */
-		if( ISINT(rtype) )
-			rp = intdouble(rp);
-		putout (PAIR (
-			putassign( (expptr)realpart(resp),
-			    mkexpr(OPSLASH, (expptr)realpart(lp), cpexpr((expptr)rp))),
-			putassign( imagpart(resp),
-			    mkexpr(OPSLASH, imagpart(lp), cpexpr((expptr)rp)))));
-		break;
-
-	case OPCONV:
-		if (!lp)
-			break;
-		if(ISCOMPLEX(lp->vtype) )
-			q = imagpart(lp);
-		else if(rp != NULL)
-			q = (expptr) realpart(rp);
-		else
-			q = mkrealcon(TYDREAL, "0");
-		putout (PAIR (
-			putassign( (expptr)realpart(resp), (expptr)realpart(lp)),
-			putassign( imagpart(resp), q)));
-		break;
-
-	default:
-		badop("putcx1", opcode);
-	}
-
-	frexpr((expptr)lp);
-	frexpr((expptr)rp);
-	free( (charptr) p );
-	return(resp);
-}
-
-
-
-
-/* Only .EQ. and .NE. may be performed on COMPLEX data, other relations
-   are not defined */
-
- LOCAL expptr
-#ifdef KR_headers
-putcxcmp(p)
-	register expptr p;
-#else
-putcxcmp(register expptr p)
-#endif
-{
-	int opcode;
-	register Addrp lp, rp;
-	expptr q;
-
-	if(p->tag != TEXPR)
-		badtag("putcxcmp", p->tag);
-
-	opcode = p->exprblock.opcode;
-	lp = putcx1(p->exprblock.leftp);
-	rp = putcx1(p->exprblock.rightp);
-
-	q = mkexpr( opcode==OPEQ ? OPAND : OPOR ,
-	    mkexpr(opcode, (expptr)realpart(lp), (expptr)realpart(rp)),
-	    mkexpr(opcode, imagpart(lp), imagpart(rp)) );
-
-	free( (charptr) lp);
-	free( (charptr) rp);
-	free( (charptr) p );
-	if (ISCONST(q))
-		return q;
-	return 	putx( fixexpr((Exprp)q) );
-}
-
-/* putch1 -- Forces constants into the literal pool, among other things */
-
- LOCAL Addrp
-#ifdef KR_headers
-putch1(p)
-	register expptr p;
-#else
-putch1(register expptr p)
-#endif
-{
-	Addrp t;
-	expptr e;
-
-	switch(p->tag)
-	{
-	case TCONST:
-		return( putconst((Constp)p) );
-
-	case TADDR:
-		return( (Addrp) p );
-
-	case TEXPR:
-		switch(p->exprblock.opcode)
-		{
-			expptr q;
-
-		case OPCALL:
-		case OPCCALL:
-
-			p = putcall(p, &t);
-			putout (p);
-			break;
-
-		case OPCONCAT:
-			t = mktmp(TYCHAR, ICON(lencat(p)));
-			q = (expptr) cpexpr(p->headblock.vleng);
-			p = putcat( cpexpr((expptr)t), p );
-			/* put the correct length on the block */
-			frexpr(t->vleng);
-			t->vleng = q;
-			putout (p);
-			break;
-
-		case OPCONV:
-			if(!ISICON(p->exprblock.vleng)
-			    || p->exprblock.vleng->constblock.Const.ci!=1
-			    || ! INT(p->exprblock.leftp->headblock.vtype) )
-				Fatal("putch1: bad character conversion");
-			t = mktmp(TYCHAR, ICON(1));
-			e = mkexpr(OPCONV, (expptr)t, ENULL);
-			e->headblock.vtype = TYCHAR;
-			p = putop( mkexpr(OPASSIGN, cpexpr(e), p));
-			putout (p);
-			break;
-		default:
-			badop("putch1", p->exprblock.opcode);
-		}
-		return(t);
-
-	default:
-		badtag("putch1", p->tag);
-	}
-	/* NOT REACHED */ return 0;
-}
-
-
-/* putchop -- Write out a character actual parameter; that is, this is
-   part of a procedure invocation */
-
- Addrp
-#ifdef KR_headers
-putchop(p)
-	expptr p;
-#else
-putchop(expptr p)
-#endif
-{
-	p = putaddr((expptr)putch1(p));
-	return (Addrp)p;
-}
-
-
-
-
- LOCAL expptr
-#ifdef KR_headers
-putcheq(p)
-	register expptr p;
-#else
-putcheq(register expptr p)
-#endif
-{
-	expptr lp, rp;
-	int nbad;
-
-	if(p->tag != TEXPR)
-		badtag("putcheq", p->tag);
-
-	lp = p->exprblock.leftp;
-	rp = p->exprblock.rightp;
-	frexpr(p->exprblock.vleng);
-	free( (charptr) p );
-
-/* If s = t // u, don't bother copying the result, write it directly into
-   this buffer */
-
-	nbad = badchleng(lp) + badchleng(rp);
-	if( rp->tag==TEXPR && rp->exprblock.opcode==OPCONCAT )
-		p = putcat(lp, rp);
-	else if( !nbad
-		&& ISONE(lp->headblock.vleng)
-		&& ISONE(rp->headblock.vleng) ) {
-		lp = mkexpr(OPCONV, lp, ENULL);
-		rp = mkexpr(OPCONV, rp, ENULL);
-		lp->headblock.vtype = rp->headblock.vtype = TYCHAR;
-		p = putop(mkexpr(OPASSIGN, lp, rp));
-		}
-	else
-		p = putx( call2(TYSUBR, "s_copy", lp, rp) );
-	return p;
-}
-
-
-
-
- LOCAL expptr
-#ifdef KR_headers
-putchcmp(p)
-	register expptr p;
-#else
-putchcmp(register expptr p)
-#endif
-{
-	expptr lp, rp;
-
-	if(p->tag != TEXPR)
-		badtag("putchcmp", p->tag);
-
-	lp = p->exprblock.leftp;
-	rp = p->exprblock.rightp;
-
-	if(ISONE(lp->headblock.vleng) && ISONE(rp->headblock.vleng) ) {
-		lp = mkexpr(OPCONV, lp, ENULL);
-		rp = mkexpr(OPCONV, rp, ENULL);
-		lp->headblock.vtype = rp->headblock.vtype = TYCHAR;
-		}
-	else {
-		lp = call2(TYINT,"s_cmp", lp, rp);
-		rp = ICON(0);
-		}
-	p->exprblock.leftp = lp;
-	p->exprblock.rightp = rp;
-	p = putop(p);
-	return p;
-}
-
-
-
-
-
-/* putcat -- Writes out a concatenation operation.  Two temporary arrays
-   are allocated,   putct1()   is called to initialize them, and then a
-   call to runtime library routine   s_cat()   is inserted.
-
-	This routine generates code which will perform an  (nconc lhs rhs)
-   at runtime.  The runtime funciton does not return a value, the routine
-   that calls this   putcat   must remember the name of   lhs.
-*/
-
-
- LOCAL expptr
-#ifdef KR_headers
-putcat(lhs0, rhs)
-	expptr lhs0;
-	register expptr rhs;
-#else
-putcat(expptr lhs0, register expptr rhs)
-#endif
-{
-	register Addrp lhs = (Addrp)lhs0;
-	int n, tyi;
-	Addrp length_var, string_var;
-	expptr p;
-	static char Writing_concatenation[] = "Writing concatenation";
-
-/* Create the temporary arrays */
-
-	n = ncat(rhs);
-	length_var = mktmpn(n, tyioint, ENULL);
-	string_var = mktmpn(n, TYADDR, ENULL);
-	frtemp((Addrp)cpexpr((expptr)length_var));
-	frtemp((Addrp)cpexpr((expptr)string_var));
-
-/* Initialize the arrays */
-
-	n = 0;
-	/* p1_comment scribbles on its argument, so we
-	 * cannot safely pass a string literal here. */
-	p1_comment(Writing_concatenation);
-	putct1(rhs, length_var, string_var, &n);
-
-/* Create the invocation */
-
-	tyi = tyint;
-	tyint = tyioint;	/* for -I2 */
-	p = putx (call4 (TYSUBR, "s_cat",
-				(expptr)lhs,
-				(expptr)string_var,
-				(expptr)length_var,
-				(expptr)putconst((Constp)ICON(n))));
-	tyint = tyi;
-
-	return p;
-}
-
-
-
-
-
- LOCAL void
-#ifdef KR_headers
-putct1(q, length_var, string_var, ip)
-	register expptr q;
-	register Addrp length_var;
-	register Addrp string_var;
-	int *ip;
-#else
-putct1(register expptr q, register Addrp length_var, register Addrp string_var, int *ip)
-#endif
-{
-	int i;
-	Addrp length_copy, string_copy;
-	expptr e;
-	extern int szleng;
-
-	if(q->tag==TEXPR && q->exprblock.opcode==OPCONCAT)
-	{
-		putct1(q->exprblock.leftp, length_var, string_var,
-		    ip);
-		putct1(q->exprblock.rightp, length_var, string_var,
-		    ip);
-		frexpr (q -> exprblock.vleng);
-		free ((charptr) q);
-	}
-	else
-	{
-		i = (*ip)++;
-		e = cpexpr(q->headblock.vleng);
-		if (!e)
-			return; /* error -- character*(*) */
-		length_copy = (Addrp) cpexpr((expptr)length_var);
-		length_copy->memoffset =
-		    mkexpr(OPPLUS,length_copy->memoffset, ICON(i*szleng));
-		string_copy = (Addrp) cpexpr((expptr)string_var);
-		string_copy->memoffset =
-		    mkexpr(OPPLUS, string_copy->memoffset,
-			ICON(i*typesize[TYADDR]));
-		putout (PAIR (putassign((expptr)length_copy, e),
-			putassign((expptr)string_copy, addrof((expptr)putch1(q)))));
-	}
-}
-
-/* putaddr -- seems to write out function invocation actual parameters */
-
-	LOCAL expptr
-#ifdef KR_headers
-putaddr(p0)
-	expptr p0;
-#else
-putaddr(expptr p0)
-#endif
-{
-	register Addrp p;
-	chainp cp;
-
-	if (!(p = (Addrp)p0))
-		return ENULL;
-
-	if( p->tag==TERROR || (p->memoffset!=NULL && ISERROR(p->memoffset)) )
-	{
-		frexpr((expptr)p);
-		return ENULL;
-	}
-	if (p->isarray && p->memoffset)
-		if (p->uname_tag == UNAM_REF) {
-			cp = p->memoffset->listblock.listp;
-			for(; cp; cp = cp->nextp)
-				cp->datap = (char *)fixtype((tagptr)cp->datap);
-			}
-		else
-			p->memoffset = putx(p->memoffset);
-	return (expptr) p;
-}
-
- LOCAL expptr
-#ifdef KR_headers
-addrfix(e)
-	expptr e;
-#else
-addrfix(expptr e)
-#endif
-		/* fudge character string length if it's a TADDR */
-{
-	return e->tag == TADDR ? mkexpr(OPIDENTITY, e, ENULL) : e;
-	}
-
- LOCAL int
-#ifdef KR_headers
-typekludge(ccall, q, at, j)
-	int ccall;
-	register expptr q;
-	Atype *at;
-	int j;
-#else
-typekludge(int ccall, register expptr q, Atype *at, int j)
-#endif
- /* j = alternate type */
-{
-	register int i, k;
-	extern int iocalladdr;
-	register Namep np;
-
-	/* Return value classes:
-	 *	< 100 ==> Fortran arg (pointer to type)
-	 *	< 200 ==> C arg
-	 *	< 300 ==> procedure arg
-	 *	< 400 ==> external, no explicit type
-	 *	< 500 ==> arg that may turn out to be
-	 *		  either a variable or a procedure
-	 */
-
-	k = q->headblock.vtype;
-	if (ccall) {
-		if (k == TYREAL)
-			k = TYDREAL;	/* force double for library routines */
-		return k + 100;
-		}
-	if (k == TYADDR)
-		return iocalladdr;
-	i = q->tag;
-	if ((i == TEXPR && q->exprblock.opcode != OPCOMMA_ARG)
-	||  (i == TADDR && q->addrblock.charleng)
-	||   i == TCONST)
-		k = TYFTNLEN + 100;
-	else if (i == TADDR)
-	    switch(q->addrblock.vclass) {
-		case CLPROC:
-			if (q->addrblock.uname_tag != UNAM_NAME)
-				k += 200;
-			else if ((np = q->addrblock.user.name)->vprocclass
-					!= PTHISPROC) {
-				if (k && !np->vimpltype)
-					k += 200;
-				else {
-					if (j > 200 && infertypes && j < 300) {
-						k = j;
-						inferdcl(np, j-200);
-						}
-					else k = (np->vstg == STGEXT
-						? extsymtab[np->vardesc.varno].extype
-						: 0) + 200;
-					at->cp = mkchain((char *)np, at->cp);
-					}
-				}
-			else if (k == TYSUBR)
-				k += 200;
-			break;
-
-		case CLUNKNOWN:
-			if (q->addrblock.vstg == STGARG
-			 && q->addrblock.uname_tag == UNAM_NAME) {
-				k += 400;
-				at->cp = mkchain((char *)q->addrblock.user.name,
-						at->cp);
-				}
-		}
-	else if (i == TNAME && q->nameblock.vstg == STGARG) {
-		np = &q->nameblock;
-		switch(np->vclass) {
-		    case CLPROC:
-			if (!np->vimpltype)
-				k += 200;
-			else if (j <= 200 || !infertypes || j >= 300)
-				k += 300;
-			else {
-				k = j;
-				inferdcl(np, j-200);
-				}
-			goto add2chain;
-
-		    case CLUNKNOWN:
-			/* argument may be a scalar variable or a function */
-			if (np->vimpltype && j && infertypes
-			&& j < 300) {
-				inferdcl(np, j % 100);
-				k = j;
-				}
-			else
-				k += 400;
-
-			/* to handle procedure args only so far known to be
-			 * external, save a pointer to the symbol table entry...
-		 	 */
- add2chain:
-			at->cp = mkchain((char *)np, at->cp);
-		    }
-		}
-	return k;
-	}
-
- char *
-#ifdef KR_headers
-Argtype(k, buf)
-	int k;
-	char *buf;
-#else
-Argtype(int k, char *buf)
-#endif
-{
-	if (k < 100) {
-		sprintf(buf, "%s variable", ftn_types[k]);
-		return buf;
-		}
-	if (k < 200) {
-		k -= 100;
-		return ftn_types[k];
-		}
-	if (k < 300) {
-		k -= 200;
-		if (k == TYSUBR)
-			return ftn_types[TYSUBR];
-		sprintf(buf, "%s function", ftn_types[k]);
-		return buf;
-		}
-	if (k < 400)
-		return "external argument";
-	k -= 400;
-	sprintf(buf, "%s argument", ftn_types[k]);
-	return buf;
-	}
-
- static void
-#ifdef KR_headers
-atype_squawk(at, msg)
-	Argtypes *at;
-	char *msg;
-#else
-atype_squawk(Argtypes *at, char *msg)
-#endif
-{
-	register Atype *a, *ae;
-	warn(msg);
-	for(a = at->atypes, ae = a + at->nargs; a < ae; a++)
-		frchain(&a->cp);
-	at->nargs = -1;
-	if (at->changes & 2 && !at->defined)
-		proc_protochanges++;
-	}
-
- static char inconsist[] = "inconsistent calling sequences for ";
-
- void
-#ifdef KR_headers
-bad_atypes(at, fname, i, j, k, here, prev)
-	Argtypes *at;
-	char *fname;
-	int i;
-	int j;
-	int k;
-	char *here;
-	char *prev;
-#else
-bad_atypes(Argtypes *at, char *fname, int i, int j, int k, char *here, char *prev)
-#endif
-{
-	char buf[208], buf1[32], buf2[32];
-
-	sprintf(buf, "%s%.90s,\n\targ %d: %s%s%s %s.",
-		inconsist, fname, i, here, Argtype(k, buf1),
-		prev, Argtype(j, buf2));
-	atype_squawk(at, buf);
-	}
-
- int
-#ifdef KR_headers
-type_fixup(at, a, k)
-	Argtypes *at;
-	Atype *a;
-	int k;
-#else
-type_fixup(Argtypes *at,  Atype *a,  int k)
-#endif
-{
-	register struct Entrypoint *ep;
-	if (!infertypes)
-		return 0;
-	for(ep = entries; ep; ep = ep->entnextp)
-		if (ep->entryname && at == ep->entryname->arginfo) {
-			a->type = k % 100;
-			return proc_argchanges = 1;
-			}
-	return 0;
-	}
-
-
- void
-#ifdef KR_headers
-save_argtypes(arglist, at0, at1, ccall, fname, stg, nchargs, type, zap)
-	chainp arglist;
-	Argtypes **at0;
-	Argtypes **at1;
-	int ccall;
-	char *fname;
-	int stg;
-	int nchargs;
-	int type;
-	int zap;
-#else
-save_argtypes(chainp arglist, Argtypes **at0, Argtypes **at1, int ccall, char *fname, int stg, int nchargs, int type, int zap)
-#endif
-{
-	Argtypes *at;
-	chainp cp;
-	int i, i0, j, k, nargs, nbad, *t, *te;
-	Atype *atypes;
-	expptr q;
-	char buf[208], buf1[32], buf2[32];
-	static int initargs[4] = {TYCOMPLEX, TYDCOMPLEX, TYCHAR, TYFTNLEN+100};
-	static int *init_ap[TYSUBR+1] = {0,0,0,0,0,0,0,
-#ifdef TYQUAD
-							0,
-#endif
-				initargs, initargs+1,0,0,0,initargs+2};
-
-	i0 = init_ac[type];
-	t = init_ap[type];
-	te = t + i0;
-	if (at = *at0) {
-		*at1 = at;
-		nargs = at->nargs;
-		if (nargs < 0 && type && at->changes & 2 && !at->defined)
-			--proc_protochanges;
-		if (at->dnargs >= 0 && zap != 2)
-			type = 0;
-		if (nargs < 0) { /* inconsistent usage seen */
-			if (type)
-				goto newlist;
-			return;
-			}
-		atypes = at->atypes;
-		i = nchargs;
-		for(nbad = 0; t < te; atypes++) {
-			if (++i > nargs) {
- toomany:
-				i = nchargs + i0;
-				for(cp = arglist; cp; cp = cp->nextp)
-					i++;
- toofew:
-				switch(zap) {
-					case 2:	zap = 6; break;
-					case 1:	if (at->defined & 4)
-							return;
-					}
-				sprintf(buf,
-		"%s%.90s:\n\there %d, previously %d args and string lengths.",
-					inconsist, fname, i, nargs);
-				atype_squawk(at, buf);
-				if (type) {
-					t = init_ap[type];
-					goto newlist;
-					}
-				return;
-				}
-			j = atypes->type;
-			k = *t++;
-			if (j != k && j-400 != k) {
-				cp = 0;
-				goto badtypes;
-				}
-			}
-		for(cp = arglist; cp; atypes++, cp = cp->nextp) {
-			if (++i > nargs)
-				goto toomany;
-			j = atypes->type;
-			if (!(q = (expptr)cp->datap))
-				continue;
-			k = typekludge(ccall, q, atypes, j);
-			if (k >= 300 || k == j)
-				continue;
-			if (j >= 300) {
-				if (k >= 200) {
-					if (k == TYUNKNOWN + 200)
-						continue;
-					if (j % 100 != k - 200
-					 && k != TYSUBR + 200
-					 && j != TYUNKNOWN + 300
-					 && !type_fixup(at,atypes,k))
-						goto badtypes;
-					}
-				else if (j % 100 % TYSUBR != k % TYSUBR
-						&& !type_fixup(at,atypes,k))
-					goto badtypes;
-				}
-			else if (k < 200 || j < 200)
-				if (j) {
-					if (k == TYUNKNOWN
-					 && q->tag == TNAME
-					 && q->nameblock.vinfproc) {
-						q->nameblock.vdcldone = 0;
-						impldcl((Namep)q);
-						}
-					goto badtypes;
-					}
-				else ; /* fall through to update */
-			else if (k == TYUNKNOWN+200)
-				continue;
-			else if (j != TYUNKNOWN+200)
-				{
- badtypes:
-				if (++nbad == 1)
-					bad_atypes(at, fname, i - nchargs,
-						j, k, "here ", ", previously");
-				else
-					fprintf(stderr,
-					 "\targ %d: here %s, previously %s.\n",
-						i - nchargs, Argtype(k,buf1),
-						Argtype(j,buf2));
-				if (!cp)
-					break;
-				continue;
-				}
-			/* We've subsequently learned the right type,
-			   as in the call on zoo below...
-
-				subroutine foo(x, zap)
-				external zap
-				call goo(zap)
-				x = zap(3)
-				call zoo(zap)
-				end
-			 */
-			if (!nbad) {
-				atypes->type = k;
-				at->changes |= 1;
-				}
-			}
-		if (i < nargs)
-			goto toofew;
-		if (nbad) {
-			if (type) {
-				/* we're defining the procedure */
-				t = init_ap[type];
-				te = t + i0;
-				proc_argchanges = 1;
-				goto newlist;
-				}
-			return;
-			}
-		if (zap == 1 && (at->changes & 5) != 5)
-			at->changes = 0;
-		return;
-		}
- newlist:
-	i = i0 + nchargs;
-	for(cp = arglist; cp; cp = cp->nextp)
-		i++;
-	k = sizeof(Argtypes) + (i-1)*sizeof(Atype);
-	*at0 = *at1 = at = stg == STGEXT ? (Argtypes *)gmem(k,1)
-					 : (Argtypes *) mem(k,1);
-	at->dnargs = at->nargs = i;
-	at->defined = zap & 6;
-	at->changes = type ? 0 : 4;
-	atypes = at->atypes;
-	for(; t < te; atypes++) {
-		atypes->type = *t++;
-		atypes->cp = 0;
-		}
-	for(cp = arglist; cp; atypes++, cp = cp->nextp) {
-		atypes->cp = 0;
-		atypes->type = (q = (expptr)cp->datap)
-			? typekludge(ccall, q, atypes, 0)
-			: 0;
-		}
-	for(; --nchargs >= 0; atypes++) {
-		atypes->type = TYFTNLEN + 100;
-		atypes->cp = 0;
-		}
-	}
-
- static char*
-#ifdef KR_headers
-get_argtypes(p, pat0, pat1) Exprp p; Argtypes ***pat0, ***pat1;
-#else
-get_argtypes(Exprp p, Argtypes ***pat0, Argtypes ***pat1)
-#endif
-{
-	Addrp a;
-	Argtypes **at0, **at1;
-	Namep np;
-	expptr rp;
-	Extsym *e;
-	char *fname;
-
-	a = (Addrp)p->leftp;
-	switch(a->vstg) {
-		case STGEXT:
-			switch(a->uname_tag) {
-				case UNAM_EXTERN:	/* e.g., sqrt() */
-					e = extsymtab + a->memno;
-					at0 = at1 = &e->arginfo;
-					fname = e->fextname;
-					break;
-				case UNAM_NAME:
-					np = a->user.name;
-					at0 = &extsymtab[np->vardesc.varno].arginfo;
-					at1 = &np->arginfo;
-					fname = np->fvarname;
-					break;
-				default:
-					goto bug;
-				}
-			break;
-		case STGARG:
-			if (a->uname_tag != UNAM_NAME)
-				goto bug;
-			np = a->user.name;
-			at0 = at1 = &np->arginfo;
-			fname = np->fvarname;
-			break;
-		default:
-	 bug:
-			Fatal("Confusion in saveargtypes");
-		}
-	*pat0 = at0;
-	*pat1 = at1;
-	return fname;
-	}
-
- void
-#ifdef KR_headers
-saveargtypes(p)
-	register Exprp p;
-#else
-saveargtypes(register Exprp p)
-#endif
-				/* for writing prototypes */
-{
-	Argtypes **at0, **at1;
-	chainp arglist;
-	expptr rp;
-	char *fname;
-
-	fname = get_argtypes(p, &at0, &at1);
-	rp = p->rightp;
-	arglist = rp && rp->tag == TLIST ? rp->listblock.listp : 0;
-	save_argtypes(arglist, at0, at1, p->opcode == OPCCALL,
-		fname, p->leftp->addrblock.vstg, 0, 0, 0);
-	}
-
-/* putcall - fix up the argument list, and write out the invocation.   p
-   is expected to be initialized and point to an OPCALL or OPCCALL
-   expression.  The return value is a pointer to a temporary holding the
-   result of a COMPLEX or CHARACTER operation, or NULL. */
-
- LOCAL expptr
-#ifdef KR_headers
-putcall(p0, temp)
-	expptr p0;
-	Addrp *temp;
-#else
-putcall(expptr p0, Addrp *temp)
-#endif
-{
-    register Exprp p = (Exprp)p0;
-    chainp arglist;		/* Pointer to actual arguments, if any */
-    chainp charsp;		/* List of copies of the variables which
-				   hold the lengths of character
-				   parameters (other than procedure
-				   parameters) */
-    chainp cp;			/* Iterator over argument lists */
-    register expptr q;		/* Pointer to the current argument */
-    Addrp fval;			/* Function return value */
-    int type;			/* type of the call - presumably this was
-				   set elsewhere */
-    int byvalue;		/* True iff we don't want to massage the
-				   parameter list, since we're calling a C
-				   library routine */
-    char *s;
-    Argtypes *at, **at0, **at1;
-    Atype *At, *Ate;
-
-    type = p -> vtype;
-    charsp = NULL;
-    byvalue =  (p->opcode == OPCCALL);
-
-/* Verify the actual parameters */
-
-    if (p == (Exprp) NULL)
-	err ("putcall:  NULL call expression");
-    else if (p -> tag != TEXPR)
-	erri ("putcall:  expected TEXPR, got '%d'", p -> tag);
-
-/* Find the argument list */
-
-    if(p->rightp && p -> rightp -> tag == TLIST)
-	arglist = p->rightp->listblock.listp;
-    else
-	arglist = NULL;
-
-/* Count the number of explicit arguments, including lengths of character
-   variables */
-
-    if (!byvalue) {
-	get_argtypes(p, &at0, &at1);
-	At = Ate = 0;
-	if ((at = *at0) && at->nargs >= 0) {
-		At = at->atypes;
-		Ate = At + at->nargs;
-		At += init_ac[type];
-		}
-        for(cp = arglist ; cp ; cp = cp->nextp) {
-	    q = (expptr) cp->datap;
-	    if( ISCONST(q) ) {
-
-/* Even constants are passed by reference, so we need to put them in the
-   literal table */
-
-		q = (expptr) putconst((Constp)q);
-		cp->datap = (char *) q;
-		}
-
-/* Save the length expression of character variables (NOT character
-   procedures) for the end of the argument list */
-
-	    if( ISCHAR(q) &&
-		(q->headblock.vclass != CLPROC
-		|| q->headblock.vstg == STGARG
-			&& q->tag == TADDR
-			&& q->addrblock.uname_tag == UNAM_NAME
-			&& q->addrblock.user.name->vprocclass == PTHISPROC)
-		&& (!At || At->type % 100 % TYSUBR == TYCHAR))
-		{
-		p0 = cpexpr(q->headblock.vleng);
-		charsp = mkchain((char *)p0, charsp);
-		if (q->headblock.vclass == CLUNKNOWN
-		 && q->headblock.vstg == STGARG)
-			q->addrblock.user.name->vpassed = 1;
-		else if (q->tag == TADDR
-				&& q->addrblock.uname_tag == UNAM_CONST)
-			p0->constblock.Const.ci
-				+= q->addrblock.user.Const.ccp1.blanks;
-		}
-	    if (At && ++At == Ate)
-		At = 0;
-	    }
-	}
-    charsp = revchain(charsp);
-
-/* If the routine is a CHARACTER function ... */
-
-    if(type == TYCHAR)
-    {
-	if( ISICON(p->vleng) )
-	{
-
-/* Allocate a temporary to hold the return value of the function */
-
-	    fval = mktmp(TYCHAR, p->vleng);
-	}
-	else    {
-		err("adjustable character function");
-		if (temp)
-			*temp = 0;
-		return 0;
-		}
-    }
-
-/* If the routine is a COMPLEX function ... */
-
-    else if( ISCOMPLEX(type) )
-	fval = mktmp(type, ENULL);
-    else
-	fval = NULL;
-
-/* Write the function name, without taking its address */
-
-    p -> leftp = putx(fixtype(putaddr(p->leftp)));
-
-    if(fval)
-    {
-	chainp prepend;
-
-/* Prepend a copy of the function return value buffer out as the first
-   argument. */
-
-	prepend = mkchain((char *)putx(putaddr(cpexpr((expptr)fval))), arglist);
-
-/* If it's a character function, also prepend the length of the result */
-
-	if(type==TYCHAR)
-	{
-
-	    prepend->nextp = mkchain((char *)putx(mkconv(TYLENG,
-					p->vleng)), arglist);
-	}
-	if (!(q = p->rightp))
-		p->rightp = q = (expptr)mklist(CHNULL);
-	q->listblock.listp = prepend;
-    }
-
-/* Scan through the fortran argument list */
-
-    for(cp = arglist ; cp ; cp = cp->nextp)
-    {
-	q = (expptr) (cp->datap);
-	if (q == ENULL)
-	    err ("putcall:  NULL argument");
-
-/* call putaddr only when we've got a parameter for a C routine or a
-   memory resident parameter */
-
-	if (q -> tag == TCONST && !byvalue)
-	    q = (expptr) putconst ((Constp)q);
-
-	if(q->tag==TADDR && (byvalue || q->addrblock.vstg!=STGREG) ) {
-		if (q->addrblock.parenused
-		 && !byvalue && q->headblock.vtype != TYCHAR)
-			goto make_copy;
-		cp->datap = (char *)putaddr(q);
-		}
-	else if( ISCOMPLEX(q->headblock.vtype) )
-	    cp -> datap = (char *) putx (fixtype(putcxop(q)));
-	else if (ISCHAR(q) )
-	    cp -> datap = (char *) putx (fixtype((expptr)putchop(q)));
-	else if( ! ISERROR(q) )
-	{
-	    if(byvalue) {
-		if (q->tag == TEXPR && q->exprblock.opcode == OPCONV) {
-			if (ISCOMPLEX(q->exprblock.leftp->headblock.vtype)
-			 && q->exprblock.leftp->tag == TEXPR)
-				q->exprblock.leftp = putcxop(q->exprblock.leftp);
-			else
-				q->exprblock.leftp = putx(q->exprblock.leftp);
-			}
-		else
-			cp -> datap = (char *) putx(q);
-		}
-	    else if (q->tag == TEXPR && q->exprblock.opcode == OPCHARCAST)
-		cp -> datap = (char *) putx(q);
-	    else {
-		expptr t, t1;
-
-/* If we've got a register parameter, or (maybe?) a constant, save it in a
-   temporary first */
- make_copy:
-		t = (expptr) mktmp(q->headblock.vtype, q->headblock.vleng);
-
-/* Assign to temporary variables before invoking the subroutine or
-   function */
-
-		t1 = putassign( cpexpr(t), q );
-		if (doin_setbound)
-			t = mkexpr(OPCOMMA_ARG, t1, t);
-		else
-			putout(t1);
-		cp -> datap = (char *) t;
-	    } /* else */
-	} /* if !ISERROR(q) */
-    }
-
-/* Now adjust the lengths of the CHARACTER parameters */
-
-    for(cp = charsp ; cp ; cp = cp->nextp)
-	cp->datap = (char *)addrfix(putx(
-			/* in case MAIN has a character*(*)... */
-			(s = cp->datap) ? mkconv(TYLENG,(expptr)s)
-					 : ICON(0)));
-
-/* ... and add them to the end of the argument list */
-
-    hookup (arglist, charsp);
-
-/* Return the name of the temporary used to hold the results, if any was
-   necessary. */
-
-    if (temp) *temp = fval;
-    else frexpr ((expptr)fval);
-
-    saveargtypes(p);
-
-    return (expptr) p;
-}
-
-
-
-/* putmnmx -- Put min or max.   p   must point to an EXPR, not just a
-   CONST */
-
- LOCAL expptr
-#ifdef KR_headers
-putmnmx(p)
-	register expptr p;
-#else
-putmnmx(register expptr p)
-#endif
-{
-	int op, op2, type;
-	expptr arg, qp, temp;
-	chainp p0, p1;
-	Addrp sp, tp;
-	char comment_buf[80];
-	char *what;
-
-	if(p->tag != TEXPR)
-		badtag("putmnmx", p->tag);
-
-	type = p->exprblock.vtype;
-	op = p->exprblock.opcode;
-	op2 = op == OPMIN ? OPMIN2 : OPMAX2;
-	p0 = p->exprblock.leftp->listblock.listp;
-	free( (charptr) (p->exprblock.leftp) );
-	free( (charptr) p );
-
-	/* special case for two addressable operands */
-
-	if (addressable((expptr)p0->datap)
-	 && (p1 = p0->nextp)
-	 && addressable((expptr)p1->datap)
-	 && !p1->nextp) {
-		if (type == TYREAL && forcedouble)
-			op2 = op == OPMIN ? OPDMIN : OPDMAX;
-		p = mkexpr(op2, mkconv(type, cpexpr((expptr)p0->datap)),
-				mkconv(type, cpexpr((expptr)p1->datap)));
-		frchain(&p0);
-		return p;
-		}
-
-	/* general case */
-
-	sp = mktmp(type, ENULL);
-
-/* We only need a second temporary if the arg list has an unaddressable
-   value */
-
-	tp = (Addrp) NULL;
-	qp = ENULL;
-	for (p1 = p0 -> nextp; p1; p1 = p1 -> nextp)
-		if (!addressable ((expptr) p1 -> datap)) {
-			tp = mktmp(type, ENULL);
-			qp = mkexpr(op2, cpexpr((expptr)sp), cpexpr((expptr)tp));
-			qp = fixexpr((Exprp)qp);
-			break;
-		} /* if */
-
-/* Now output the appropriate number of assignments and comparisons.  Min
-   and max are implemented by the simple O(n) algorithm:
-
-	min (a, b, c, d) ==>
-	{ <type> t1, t2;
-
-	    t1 = a;
-	    t2 = b; t1 = (t1 < t2) ? t1 : t2;
-	    t2 = c; t1 = (t1 < t2) ? t1 : t2;
-	    t2 = d; t1 = (t1 < t2) ? t1 : t2;
-	}
-*/
-
-	if (!doin_setbound) {
-		switch(op) {
-			case OPLT:
-			case OPMIN:
-			case OPDMIN:
-			case OPMIN2:
-				what = "IN";
-				break;
-			default:
-				what = "AX";
-			}
-		sprintf (comment_buf, "Computing M%s", what);
-		p1_comment (comment_buf);
-		}
-
-	p1 = p0->nextp;
-	temp = (expptr)p0->datap;
-	if (addressable(temp) && addressable((expptr)p1->datap)) {
-		p = mkconv(type, cpexpr(temp));
-		arg = mkconv(type, cpexpr((expptr)p1->datap));
-		temp = mkexpr(op2, p, arg);
-		if (!ISCONST(temp))
-			temp = fixexpr((Exprp)temp);
-		p1 = p1->nextp;
-		}
-	p = putassign (cpexpr((expptr)sp), temp);
-
-	for(; p1 ; p1 = p1->nextp)
-	{
-		if (addressable ((expptr) p1 -> datap)) {
-			arg = mkconv(type, cpexpr((expptr)p1->datap));
-			temp = mkexpr(op2, cpexpr((expptr)sp), arg);
-			temp = fixexpr((Exprp)temp);
-		} else {
-			temp = (expptr) cpexpr (qp);
-			p = mkexpr(OPCOMMA, p,
-				putassign(cpexpr((expptr)tp), (expptr)p1->datap));
-		} /* else */
-
-		if(p1->nextp)
-			p = mkexpr(OPCOMMA, p,
-				putassign(cpexpr((expptr)sp), temp));
-		else {
-			if (type == TYREAL && forcedouble)
-				temp->exprblock.opcode =
-					op == OPMIN ? OPDMIN : OPDMAX;
-			if (doin_setbound)
-				p = mkexpr(OPCOMMA, p, temp);
-			else {
-				putout (p);
-				p = putx(temp);
-				}
-			if (qp)
-				frexpr (qp);
-		} /* else */
-	} /* for */
-
-	frchain( &p0 );
-	return p;
-}
-
-
- void
-#ifdef KR_headers
-putwhile(p)
-	expptr p;
-#else
-putwhile(expptr p)
-#endif
-{
-	long where;
-	int k, n;
-
-	if (wh_next >= wh_last)
-		{
-		k = wh_last - wh_first;
-		n = k + 100;
-		wh_next = mem(n,0);
-		wh_last = wh_first + n;
-		if (k)
-			memcpy(wh_next, wh_first, k);
-		wh_first =  wh_next;
-		wh_next += k;
-		wh_last = wh_first + n;
-		}
-	p1put(P1_WHILE1START);
-	where = ftell(pass1_file);
-	if( !ISLOGICAL((k = (p = fixtype(p))->headblock.vtype)))
-		{
-		if(k != TYERROR)
-			err("non-logical expression in DO WHILE statement");
-		}
-	else	{
-		p = putx(p);
-		*wh_next++ = ftell(pass1_file) > where;
-		p1put(P1_WHILE2START);
-		p1_expr(p);
-		}
-	}
diff --git a/usr.bin/f2c/sysdep.c b/usr.bin/f2c/sysdep.c
deleted file mode 100644
index 5469034..0000000
--- a/usr.bin/f2c/sysdep.c
+++ /dev/null
@@ -1,519 +0,0 @@
-/****************************************************************
-Copyright 1990 - 1994 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-#include "defs.h"
-#include "usignal.h"
-
-char binread[] = "rb", textread[] = "r";
-char binwrite[] = "wb", textwrite[] = "w";
-char *c_functions	= "c_functions";
-char *coutput		= "c_output";
-char *initfname		= "raw_data";
-char *initbname		= "raw_data.b";
-char *blkdfname		= "block_data";
-char *p1_file		= "p1_file";
-char *p1_bakfile	= "p1_file.BAK";
-char *sortfname		= "init_file";
-char *proto_fname	= "proto_file";
-
-char link_msg[]		= "-lf2c -lm"; /* was "-lF77 -lI77 -lm -lc"; */
-
-char *outbuf = "", *outbtail;
-
-#ifndef TMPDIR
-#ifdef MSDOS
-#define TMPDIR ""
-#else
-#define TMPDIR "/tmp"
-#endif
-#endif
-
-char *tmpdir = TMPDIR;
-#ifndef MSDOS
-#ifndef KR_headers
-extern int getpid(void);
-#endif
-#endif
-
- void
-#ifdef KR_headers
-Un_link_all(cdelete)
-	int cdelete;
-#else
-Un_link_all(int cdelete)
-#endif
-{
-#ifndef KR_headers
-	extern int unlink(const char *);
-#endif
-	if (!debugflag) {
-		unlink(c_functions);
-		unlink(initfname);
-		unlink(p1_file);
-		unlink(sortfname);
-		unlink(blkdfname);
-		if (cdelete && coutput)
-			unlink(coutput);
-		}
-	}
-
- void
-set_tmp_names(Void)
-{
-	int k;
-	if (debugflag == 1)
-		return;
-	k = strlen(tmpdir) + 24;
-	c_functions = (char *)ckalloc(7*k);
-	initfname = c_functions + k;
-	initbname = initfname + k;
-	blkdfname = initbname + k;
-	p1_file = blkdfname + k;
-	p1_bakfile = p1_file + k;
-	sortfname = p1_bakfile + k;
-	{
-#ifdef MSDOS
-	char buf[64], *s, *t;
-	if (!*tmpdir || *tmpdir == '.' && !tmpdir[1])
-		t = "";
-	else {
-		/* substitute \ for / to avoid confusion with a
-		 * switch indicator in the system("sort ...")
-		 * call in formatdata.c
-		 */
-		for(s = tmpdir, t = buf; *s; s++, t++)
-			if ((*t = *s) == '/')
-				*t = '\\';
-		if (t[-1] != '\\')
-			*t++ = '\\';
-		*t = 0;
-		t = buf;
-		}
-	sprintf(c_functions, "%sf2c_func", t);
-	sprintf(initfname, "%sf2c_rd", t);
-	sprintf(blkdfname, "%sf2c_blkd", t);
-	sprintf(p1_file, "%sf2c_p1f", t);
-	sprintf(p1_bakfile, "%sf2c_p1fb", t);
-	sprintf(sortfname, "%sf2c_sort", t);
-#else
-	long pid = getpid();
-	sprintf(c_functions, "%s/f2c%ld_func", tmpdir, pid);
-	sprintf(initfname, "%s/f2c%ld_rd", tmpdir, pid);
-	sprintf(blkdfname, "%s/f2c%ld_blkd", tmpdir, pid);
-	sprintf(p1_file, "%s/f2c%ld_p1f", tmpdir, pid);
-	sprintf(p1_bakfile, "%s/f2c%ld_p1fb", tmpdir, pid);
-	sprintf(sortfname, "%s/f2c%ld_sort", tmpdir, pid);
-#endif
-	sprintf(initbname, "%s.b", initfname);
-	}
-	if (debugflag)
-		fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions,
-			initfname, blkdfname, p1_file, p1_bakfile, sortfname);
-	}
-
- char *
-#ifdef KR_headers
-c_name(s, ft)
-	char *s;
-	int ft;
-#else
-c_name(char *s, int ft)
-#endif
-{
-	char *b, *s0;
-	int c;
-
-	b = s0 = s;
-	while(c = *s++)
-		if (c == '/')
-			b = s;
-	if (--s < s0 + 3 || s[-2] != '.'
-			 || ((c = *--s) != 'f' && c != 'F')) {
-		infname = s0;
-		Fatal("file name must end in .f or .F");
-		}
-	strcpy(outbtail, b);
-	outbtail[s-b] = ft;
-	b = copys(outbuf);
-	return b;
-	}
-
- static void
-#ifdef KR_headers
-killed(sig)
-	int sig;
-#else
-killed(int sig)
-#endif
-{
-	sig = sig;	/* shut up warning */
-	signal(SIGINT, SIG_IGN);
-#ifdef SIGQUIT
-	signal(SIGQUIT, SIG_IGN);
-#endif
-#ifdef SIGHUP
-	signal(SIGHUP, SIG_IGN);
-#endif
-	signal(SIGTERM, SIG_IGN);
-	Un_link_all(1);
-	exit(126);
-	}
-
- static void
-#ifdef KR_headers
-sig1catch(sig)
-	int sig;
-#else
-sig1catch(int sig)
-#endif
-{
-	sig = sig;	/* shut up warning */
-	if (signal(sig, SIG_IGN) != SIG_IGN)
-		signal(sig, killed);
-	}
-
- static void
-#ifdef KR_headers
-flovflo(sig)
-	int sig;
-#else
-flovflo(int sig)
-#endif
-{
-	sig = sig;	/* shut up warning */
-	Fatal("floating exception during constant evaluation; cannot recover");
-	/* vax returns a reserved operand that generates
-	   an illegal operand fault on next instruction,
-	   which if ignored causes an infinite loop.
-	*/
-	signal(SIGFPE, flovflo);
-}
-
- void
-#ifdef KR_headers
-sigcatch(sig)
-	int sig;
-#else
-sigcatch(int sig)
-#endif
-{
-	sig = sig;	/* shut up warning */
-	sig1catch(SIGINT);
-#ifdef SIGQUIT
-	sig1catch(SIGQUIT);
-#endif
-#ifdef SIGHUP
-	sig1catch(SIGHUP);
-#endif
-	sig1catch(SIGTERM);
-	signal(SIGFPE, flovflo);  /* catch overflows */
-	}
-
-
-dofork(Void)
-{
-#ifdef MSDOS
-	Fatal("Only one Fortran input file allowed under MS-DOS");
-#else
-#ifndef KR_headers
-	extern int fork(void), wait(int*);
-#endif
-	int pid, status, w;
-	extern int retcode;
-
-	if (!(pid = fork()))
-		return 1;
-	if (pid == -1)
-		Fatal("bad fork");
-	while((w = wait(&status)) != pid)
-		if (w == -1)
-			Fatal("bad wait code");
-	retcode |= status >> 8;
-#endif
-	return 0;
-	}
-
-/* Initialization of tables that change with the character set... */
-
-char escapes[Table_size];
-
-#ifdef non_ASCII
-char *str_fmt[Table_size];
-static char *str0fmt[127] = { /*}*/
-#else
-char *str_fmt[Table_size] = {
-#endif
- "\\000", "\\001", "\\002", "\\003", "\\004", "\\005", "\\006", "\\007",
-   "\\b",   "\\t",   "\\n", "\\013",   "\\f",   "\\r", "\\016", "\\017",
- "\\020", "\\021", "\\022", "\\023", "\\024", "\\025", "\\026", "\\027",
- "\\030", "\\031", "\\032", "\\033", "\\034", "\\035", "\\036", "\\037",
-     " ",     "!",  "\\\"",     "#",     "$",     "%%",    "&",     "'",
-     "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
-     "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
-     "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
-     "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
-     "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
-     "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
-     "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
-     "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
-     "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
-     "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
-     "x",     "y",     "z",     "{",     "|",     "}",     "~"
-     };
-
-#ifdef non_ASCII
-char *chr_fmt[Table_size];
-static char *chr0fmt[127] = {	/*}*/
-#else
-char *chr_fmt[Table_size] = {
-#endif
-   "\\0",   "\\1",   "\\2",   "\\3",   "\\4",   "\\5",   "\\6",   "\\7",
-   "\\b",   "\\t",   "\\n",  "\\13",   "\\f",   "\\r",  "\\16",  "\\17",
-  "\\20",  "\\21",  "\\22",  "\\23",  "\\24",  "\\25",  "\\26",  "\\27",
-  "\\30",  "\\31",  "\\32",  "\\33",  "\\34",  "\\35",  "\\36",  "\\37",
-     " ",     "!",    "\"",     "#",     "$",     "%%",    "&",   "\\'",
-     "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
-     "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
-     "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
-     "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
-     "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
-     "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
-     "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
-     "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
-     "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
-     "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
-     "x",     "y",     "z",     "{",     "|",     "}",     "~"
-     };
-
- void
-fmt_init(Void)
-{
-	static char *str1fmt[6] =
-		{ "\\b", "\\t", "\\n", "\\f", "\\r", "\\%03o" };
-	register int i, j;
-	register char *s;
-
-	/* str_fmt */
-
-#ifdef non_ASCII
-	i = 0;
-#else
-	i = 127;
-#endif
-	for(; i < Table_size; i++)
-		str_fmt[i] = "\\%03o";
-#ifdef non_ASCII
-	for(i = 32; i < 127; i++) {
-		s = str0fmt[i];
-		str_fmt[*(unsigned char *)s] = s;
-		}
-	str_fmt['"'] = "\\\"";
-#else
-	if (Ansi == 1)
-		str_fmt[7] = chr_fmt[7] = "\\a";
-#endif
-
-	/* chr_fmt */
-
-#ifdef non_ASCII
-	for(i = 0; i < 32; i++)
-		chr_fmt[i] = chr0fmt[i];
-#else
-	i = 127;
-#endif
-	for(; i < Table_size; i++)
-		chr_fmt[i] = "\\%o";
-#ifdef non_ASCII
-	for(i = 32; i < 127; i++) {
-		s = chr0fmt[i];
-		j = *(unsigned char *)s;
-		if (j == '\\')
-			j = *(unsigned char *)(s+1);
-		chr_fmt[j] = s;
-		}
-#endif
-
-	/* escapes (used in lex.c) */
-
-	for(i = 0; i < Table_size; i++)
-		escapes[i] = i;
-	for(s = "btnfr0", i = 0; i < 6; i++)
-		escapes[*(unsigned char *)s++] = "\b\t\n\f\r"[i];
-	/* finish str_fmt and chr_fmt */
-
-	if (Ansi)
-		str1fmt[5] = "\\v";
-	if ('\v' == 'v') { /* ancient C compiler */
-		str1fmt[5] = "v";
-#ifndef non_ASCII
-		escapes['v'] = 11;
-#endif
-		}
-	else
-		escapes['v'] = '\v';
-	for(s = "\b\t\n\f\r\v", i = 0; j = *(unsigned char *)s++;)
-		str_fmt[j] = chr_fmt[j] = str1fmt[i++];
-	/* '\v' = 11 for both EBCDIC and ASCII... */
-	chr_fmt[11] = Ansi ? "\\v" : "\\13";
-	}
-
- void
-outbuf_adjust(Void)
-{
-	int n, n1;
-	char *s;
-
-	n = n1 = strlen(outbuf);
-	if (*outbuf && outbuf[n-1] != '/')
-		n1++;
-	s = Alloc(n+64);
-	outbtail = s + n1;
-	strcpy(s, outbuf);
-	if (n != n1)
-		strcpy(s+n, "/");
-	outbuf = s;
-	}
-
-
-/* Unless SYSTEM_SORT is defined, the following gives a simple
- * in-core version of dsort().  On Fortran source with huge DATA
- * statements, the in-core version may exhaust the available memory,
- * in which case you might either recompile this source file with
- * SYSTEM_SORT defined (if that's reasonable on your system), or
- * replace the dsort below with a more elaborate version that
- * does a merging sort with the help of auxiliary files.
- */
-
-#ifdef SYSTEM_SORT
-
- int
-#ifdef KR_headers
-dsort(from, to)
-	char *from;
-	char *to;
-#else
-dsort(char *from, char *to)
-#endif
-{
-	char buf[200];
-	sprintf(buf, "sort <%s >%s", from, to);
-	return system(buf) >> 8;
-	}
-#else
-
- static int
-#ifdef KR_headers
- compare(a,b)
-  char *a, *b;
-#else
- compare(const void *a, const void *b)
-#endif
-{ return strcmp(*(char **)a, *(char **)b); }
-
-#ifdef KR_headers
-dsort(from, to)
-	char *from;
-	char *to;
-#else
-dsort(char *from, char *to)
-#endif
-{
-	struct Memb {
-		struct Memb *next;
-		int n;
-		char buf[32000];
-		};
-	typedef struct Memb memb;
-	memb *mb, *mb1;
-	register char *x, *x0, *xe;
-	register int c, n;
-	FILE *f;
-	char **z, **z0;
-	int nn = 0;
-
-	f = opf(from, textread);
-	mb = (memb *)Alloc(sizeof(memb));
-	mb->next = 0;
-	x0 = x = mb->buf;
-	xe = x + sizeof(mb->buf);
-	n = 0;
-	for(;;) {
-		c = getc(f);
-		if (x >= xe && (c != EOF || x != x0)) {
-			if (!n)
-				return 126;
-			nn += n;
-			mb->n = n;
-			mb1 = (memb *)Alloc(sizeof(memb));
-			mb1->next = mb;
-			mb = mb1;
-			memcpy(mb->buf, x0, n = x-x0);
-			x0 = mb->buf;
-			x = x0 + n;
-			xe = x0 + sizeof(mb->buf);
-			n = 0;
-			}
-		if (c == EOF)
-			break;
-		if (c == '\n') {
-			++n;
-			*x++ = 0;
-			x0 = x;
-			}
-		else
-			*x++ = c;
-		}
-	clf(&f, from, 1);
-	f = opf(to, textwrite);
-	if (x > x0) { /* shouldn't happen */
-		*x = 0;
-		++n;
-		}
-	mb->n = n;
-	nn += n;
-	if (!nn) /* shouldn't happen */
-		goto done;
-	z = z0 = (char **)Alloc(nn*sizeof(char *));
-	for(mb1 = mb; mb1; mb1 = mb1->next) {
-		x = mb1->buf;
-		n = mb1->n;
-		for(;;) {
-			*z++ = x;
-			if (--n <= 0)
-				break;
-			while(*x++);
-			}
-		}
-	qsort((char *)z0, nn, sizeof(char *), compare);
-	for(n = nn, z = z0; n > 0; n--)
-		fprintf(f, "%s\n", *z++);
-	free((char *)z0);
- done:
-	clf(&f, to, 1);
-	do {
-		mb1 = mb->next;
-		free((char *)mb);
-		}
-		while(mb = mb1);
-	return 0;
-	}
-#endif
diff --git a/usr.bin/f2c/sysdep.h b/usr.bin/f2c/sysdep.h
deleted file mode 100644
index e3a68ef..0000000
--- a/usr.bin/f2c/sysdep.h
+++ /dev/null
@@ -1,98 +0,0 @@
-/****************************************************************
-Copyright 1990, 1991, 1994 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-/* This file is included at the start of defs.h; this file
- * is an initial attempt to gather in one place some declarations
- * that may need to be tweaked on some systems.
- */
-
-#ifdef __STDC__
-#undef KR_headers
-#endif
-
-#ifndef KR_headers
-#ifndef ANSI_Libraries
-#define ANSI_Libraries
-#endif
-#ifndef ANSI_Prototypes
-#define ANSI_Prototypes
-#endif
-#endif
-
-#ifdef __BORLANDC__
-#define MSDOS
-#endif
-
-#ifdef __ZTC__	/* Zortech */
-#define MSDOS
-#endif
-
-#ifdef MSDOS
-#define ANSI_Libraries
-#define ANSI_Prototypes
-#define LONG_CAST (long)
-#else
-#define LONG_CAST
-#endif
-
-#include <stdio.h>
-
-#ifdef ANSI_Libraries
-#include <stddef.h>
-#include <stdlib.h>
-#else
-char *calloc(), *malloc(), *memcpy(), *memset(), *realloc();
-typedef int size_t;
-#ifndef atol
-    long atol();
-#endif
-
-#ifdef ANSI_Prototypes
-extern double atof(const char *);
-extern double strtod(const char*, char**);
-#else
-extern double atof(), strtod();
-#endif
-#endif
-
-/* On systems like VMS where fopen might otherwise create
- * multiple versions of intermediate files, you may wish to
- * #define scrub(x) unlink(x)
- */
-#ifndef scrub
-#define scrub(x) /* do nothing */
-#endif
-
-/* On systems that severely limit the total size of statically
- * allocated arrays, you may need to change the following to
- *	extern char **chr_fmt, *escapes, **str_fmt;
- * and to modify sysdep.c appropriately
- */
-extern char *chr_fmt[], escapes[], *str_fmt[];
-
-#include <string.h>
-
-#include "ctype.h"
-
-#define Bits_per_Byte 8
-#define Table_size (1 << Bits_per_Byte)
diff --git a/usr.bin/f2c/tokens b/usr.bin/f2c/tokens
deleted file mode 100644
index 07b1881..0000000
--- a/usr.bin/f2c/tokens
+++ /dev/null
@@ -1,100 +0,0 @@
-SEOS
-SCOMMENT
-SLABEL
-SUNKNOWN
-SHOLLERITH
-SICON
-SRCON
-SDCON
-SBITCON
-SOCTCON
-SHEXCON
-STRUE
-SFALSE
-SNAME
-SNAMEEQ
-SFIELD
-SSCALE
-SINCLUDE
-SLET
-SASSIGN
-SAUTOMATIC
-SBACKSPACE
-SBLOCK
-SCALL
-SCHARACTER
-SCLOSE
-SCOMMON
-SCOMPLEX
-SCONTINUE
-SDATA
-SDCOMPLEX
-SDIMENSION
-SDO
-SDOUBLE
-SELSE
-SELSEIF
-SEND
-SENDFILE
-SENDIF
-SENTRY
-SEQUIV
-SEXTERNAL
-SFORMAT
-SFUNCTION
-SGOTO
-SASGOTO
-SCOMPGOTO
-SARITHIF
-SLOGIF
-SIMPLICIT
-SINQUIRE
-SINTEGER
-SINTRINSIC
-SLOGICAL
-SNAMELIST
-SOPEN
-SPARAM
-SPAUSE
-SPRINT
-SPROGRAM
-SPUNCH
-SREAD
-SREAL
-SRETURN
-SREWIND
-SSAVE
-SSTATIC
-SSTOP
-SSUBROUTINE
-STHEN
-STO
-SUNDEFINED
-SWRITE
-SLPAR
-SRPAR
-SEQUALS
-SCOLON
-SCOMMA
-SCURRENCY
-SPLUS
-SMINUS
-SSTAR
-SSLASH
-SPOWER
-SCONCAT
-SAND
-SOR
-SNEQV
-SEQV
-SNOT
-SEQ
-SLT
-SGT
-SLE
-SGE
-SNE
-SENDDO
-SWHILE
-SSLASHD
-SBYTE
diff --git a/usr.bin/f2c/usignal.h b/usr.bin/f2c/usignal.h
deleted file mode 100644
index ba4ee6a..0000000
--- a/usr.bin/f2c/usignal.h
+++ /dev/null
@@ -1,7 +0,0 @@
-#include <signal.h>
-#ifndef SIGHUP
-#define	SIGHUP	1	/* hangup */
-#endif
-#ifndef SIGQUIT
-#define	SIGQUIT	3	/* quit */
-#endif
diff --git a/usr.bin/f2c/vax.c b/usr.bin/f2c/vax.c
deleted file mode 100644
index fa78805..0000000
--- a/usr.bin/f2c/vax.c
+++ /dev/null
@@ -1,570 +0,0 @@
-/****************************************************************
-Copyright 1990, 1992, 1993, 1994 by AT&T, Lucent Technologies and Bellcore.
-
-Permission to use, copy, modify, and distribute this software
-and its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the names of AT&T, Bell Laboratories,
-Lucent or Bellcore or any of their entities not be used in
-advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-AT&T, Lucent and Bellcore disclaim all warranties with regard to
-this software, including all implied warranties of
-merchantability and fitness.  In no event shall AT&T, Lucent or
-Bellcore be liable for any special, indirect or consequential
-damages or any damages whatsoever resulting from loss of use,
-data or profits, whether in an action of contract, negligence or
-other tortious action, arising out of or in connection with the
-use or performance of this software.
-****************************************************************/
-
-#include "defs.h"
-#include "pccdefs.h"
-#include "output.h"
-
-int regnum[] =  {
-	11, 10, 9, 8, 7, 6 };
-
-/* Put out a constant integer */
-
- void
-#ifdef KR_headers
-prconi(fp, n)
-	FILEP fp;
-	ftnint n;
-#else
-prconi(FILEP fp, ftnint n)
-#endif
-{
-	fprintf(fp, "\t%ld\n", n);
-}
-
-
-
-/* Put out a constant address */
-
- void
-#ifdef KR_headers
-prcona(fp, a)
-	FILEP fp;
-	ftnint a;
-#else
-prcona(FILEP fp, ftnint a)
-#endif
-{
-	fprintf(fp, "\tL%ld\n", a);
-}
-
-
- void
-#ifdef KR_headers
-prconr(fp, x, k)
-	FILEP fp;
-	Constp x;
-	int k;
-#else
-prconr(FILEP fp, Constp x, int k)
-#endif
-{
-	char *x0, *x1;
-	char cdsbuf0[64], cdsbuf1[64];
-
-	if (k > 1) {
-		if (x->vstg) {
-			x0 = x->Const.cds[0];
-			x1 = x->Const.cds[1];
-			}
-		else {
-			x0 = cds(dtos(x->Const.cd[0]), cdsbuf0);
-			x1 = cds(dtos(x->Const.cd[1]), cdsbuf1);
-			}
-		fprintf(fp, "\t%s %s\n", x0, x1);
-		}
-	else
-		fprintf(fp, "\t%s\n", x->vstg ? x->Const.cds[0]
-				: cds(dtos(x->Const.cd[0]), cdsbuf0));
-}
-
-
- char *
-#ifdef KR_headers
-memname(stg, mem)
-	int stg;
-	long mem;
-#else
-memname(int stg, long mem)
-#endif
-{
-	static char s[20];
-
-	switch(stg)
-	{
-	case STGCOMMON:
-	case STGEXT:
-		sprintf(s, "_%s", extsymtab[mem].cextname);
-		break;
-
-	case STGBSS:
-	case STGINIT:
-		sprintf(s, "v.%ld", mem);
-		break;
-
-	case STGCONST:
-		sprintf(s, "L%ld", mem);
-		break;
-
-	case STGEQUIV:
-		sprintf(s, "q.%ld", mem+eqvstart);
-		break;
-
-	default:
-		badstg("memname", stg);
-	}
-	return(s);
-}
-
-extern void addrlit Argdcl((Addrp));
-
-/* make_int_expr -- takes an arbitrary expression, and replaces all
-   occurrences of arguments with indirection */
-
- expptr
-#ifdef KR_headers
-make_int_expr(e)
-	expptr e;
-#else
-make_int_expr(expptr e)
-#endif
-{
-    chainp listp;
-    Addrp ap;
-    expptr e1;
-
-    if (e != ENULL)
-	switch (e -> tag) {
-	    case TADDR:
-		if (e->addrblock.isarray) {
-			if (e1 = e->addrblock.memoffset)
-				e->addrblock.memoffset = make_int_expr(e1);
-			}
-		else if (e->addrblock.vstg == STGARG)
-			e = mkexpr(OPWHATSIN, e, ENULL);
-	        break;
-	    case TEXPR:
-	        e -> exprblock.leftp = make_int_expr (e -> exprblock.leftp);
-	        e -> exprblock.rightp = make_int_expr (e -> exprblock.rightp);
-	        break;
-	    case TLIST:
-		for(listp = e->listblock.listp; listp; listp = listp->nextp)
-			if ((ap = (Addrp)listp->datap)
-			 && ap->tag == TADDR
-			 && ap->uname_tag == UNAM_CONST)
-				addrlit(ap);
-		break;
-	    default:
-	        break;
-	} /* switch */
-
-    return e;
-} /* make_int_expr */
-
-
-
-/* prune_left_conv -- used in prolog() to strip type cast away from
-   left-hand side of parameter adjustments.  This is necessary to avoid
-   error messages from cktype() */
-
- expptr
-#ifdef KR_headers
-prune_left_conv(e)
-	expptr e;
-#else
-prune_left_conv(expptr e)
-#endif
-{
-    struct Exprblock *leftp;
-
-    if (e && e -> tag == TEXPR && e -> exprblock.leftp &&
-	    e -> exprblock.leftp -> tag == TEXPR) {
-	leftp = &(e -> exprblock.leftp -> exprblock);
-	if (leftp -> opcode == OPCONV) {
-	    e -> exprblock.leftp = leftp -> leftp;
-	    free ((charptr) leftp);
-	}
-    }
-
-    return e;
-} /* prune_left_conv */
-
-
- static int wrote_comment;
- static FILE *comment_file;
-
- static void
-write_comment(Void)
-{
-	if (!wrote_comment) {
-		wrote_comment = 1;
-		nice_printf (comment_file, "/* Parameter adjustments */\n");
-		}
-	}
-
- static int *
-count_args(Void)
-{
-	register int *ac;
-	register chainp cp;
-	register struct Entrypoint *ep;
-	register Namep q;
-
-	ac = (int *)ckalloc(nallargs*sizeof(int));
-
-	for(ep = entries; ep; ep = ep->entnextp)
-		for(cp = ep->arglist; cp; cp = cp->nextp)
-			if (q = (Namep)cp->datap)
-				ac[q->argno]++;
-	return ac;
-	}
-
- static int nu, *refs, *used;
- static void awalk Argdcl((expptr));
-
- static void
-#ifdef KR_headers
-aawalk(P)
-	struct Primblock *P;
-#else
-aawalk(struct Primblock *P)
-#endif
-{
-	chainp p;
-	expptr q;
-
-	if (P->argsp)
-		for(p = P->argsp->listp; p; p = p->nextp) {
-			q = (expptr)p->datap;
-			if (q->tag != TCONST)
-				awalk(q);
-			}
-	if (P->namep->vtype == TYCHAR) {
-		if (q = P->fcharp)
-			awalk(q);
-		if (q = P->lcharp)
-			awalk(q);
-		}
-	}
-
- static void
-#ifdef KR_headers
-afwalk(P)
-	struct Primblock *P;
-#else
-afwalk(struct Primblock *P)
-#endif
-{
-	chainp p;
-	expptr q;
-	Namep np;
-
-	for(p = P->argsp->listp; p; p = p->nextp) {
-		q = (expptr)p->datap;
-		switch(q->tag) {
-		  case TPRIM:
-			np = q->primblock.namep;
-			if (np->vknownarg)
-				if (!refs[np->argno]++)
-					used[nu++] = np->argno;
-			if (q->primblock.argsp == 0) {
-				if (q->primblock.namep->vclass == CLPROC
-				 && q->primblock.namep->vprocclass
-						!= PTHISPROC
-				 || q->primblock.namep->vdim != NULL)
-					continue;
-				}
-		  default:
-			awalk(q);
-			/* no break */
-		  case TCONST:
-			continue;
-		  }
-		}
-	}
-
- static void
-#ifdef KR_headers
-awalk(e)
-	expptr e;
-#else
-awalk(expptr e)
-#endif
-{
-	Namep np;
- top:
-	if (!e)
-		return;
-	switch(e->tag) {
-	  default:
-		badtag("awalk", e->tag);
-	  case TCONST:
-	  case TERROR:
-	  case TLIST:
-		return;
-	  case TADDR:
-		if (e->addrblock.uname_tag == UNAM_NAME) {
-			np = e->addrblock.user.name;
-			if (np->vknownarg && !refs[np->argno]++)
-				used[nu++] = np->argno;
-			}
-		e = e->addrblock.memoffset;
-		goto top;
-	  case TPRIM:
-		np = e->primblock.namep;
-		if (np->vknownarg && !refs[np->argno]++)
-			used[nu++] = np->argno;
-		if (e->primblock.argsp && np->vclass != CLVAR)
-			afwalk((struct Primblock *)e);
-		else
-			aawalk((struct Primblock *)e);
-		return;
-	  case TEXPR:
-		awalk(e->exprblock.rightp);
-		e = e->exprblock.leftp;
-		goto top;
-	  }
-	}
-
- static chainp
-#ifdef KR_headers
-argsort(p0)
-	chainp p0;
-#else
-argsort(chainp p0)
-#endif
-{
-	Namep *args, q, *stack;
-	int i, nargs, nout, nst;
-	chainp *d, *da, p, rv, *rvp;
-	struct Dimblock *dp;
-
-	if (!p0)
-		return p0;
-	for(nargs = 0, p = p0; p; p = p->nextp)
-		nargs++;
-	args = (Namep *)ckalloc(i = nargs*(sizeof(Namep) + 2*sizeof(chainp)
-			+ 2*sizeof(int)));
-	memset((char *)args, 0, i);
-	stack = args + nargs;
-	d = (chainp *)(stack + nargs);
-	refs = (int *)(d + nargs);
-	used = refs + nargs;
-
-	for(p = p0; p; p = p->nextp) {
-		q = (Namep) p->datap;
-		args[q->argno] = q;
-		}
-	for(p = p0; p; p = p->nextp) {
-		q = (Namep) p->datap;
-		if (!(dp = q->vdim))
-			continue;
-		i = dp->ndim;
-		while(--i >= 0)
-			awalk(dp->dims[i].dimexpr);
-		awalk(dp->basexpr);
-		while(nu > 0) {
-			refs[i = used[--nu]] = 0;
-			d[i] = mkchain((char *)q, d[i]);
-			}
-		}
-	for(i = nst = 0; i < nargs; i++)
-		for(p = d[i]; p; p = p->nextp)
-			refs[((Namep)p->datap)->argno]++;
-	while(--i >= 0)
-		if (!refs[i])
-			stack[nst++] = args[i];
-	if (nst == nargs) {
-		rv = p0;
-		goto done;
-		}
-	nout = 0;
-	rv = 0;
-	rvp = &rv;
-	while(nst > 0) {
-		nout++;
-		q = stack[--nst];
-		*rvp = p = mkchain((char *)q, CHNULL);
-		rvp = &p->nextp;
-		da = d + q->argno;
-		for(p = *da; p; p = p->nextp)
-			if (!--refs[(q = (Namep)p->datap)->argno])
-				stack[nst++] = q;
-		frchain(da);
-		}
-	if (nout < nargs)
-		for(i = 0; i < nargs; i++)
-			if (refs[i]) {
-				q = args[i];
-				errstr("Can't adjust %.38s correctly\n\
-	due to dependencies among arguments.",
-					q->fvarname);
-				*rvp = p = mkchain((char *)q, CHNULL);
-				rvp = &p->nextp;
-				frchain(d+i);
-				}
- done:
-	free((char *)args);
-	return rv;
-	}
-
- void
-#ifdef KR_headers
-prolog(outfile, p)
-	FILE *outfile;
-	register chainp p;
-#else
-prolog(FILE *outfile, register chainp p)
-#endif
-{
-	int addif, addif0, i, nd, size;
-	int *ac;
-	register Namep q;
-	register struct Dimblock *dp;
-	chainp p0, p1;
-
-	if(procclass == CLBLOCK)
-		return;
-	p0 = p;
-	p1 = p = argsort(p);
-	wrote_comment = 0;
-	comment_file = outfile;
-	ac = 0;
-
-/* Compute the base addresses and offsets for the array parameters, and
-   assign these values to local variables */
-
-	addif = addif0 = nentry > 1;
-	for(; p ; p = p->nextp)
-	{
-	    q = (Namep) p->datap;
-	    if(dp = q->vdim)	/* if this param is an array ... */
-	    {
-		expptr Q, expr;
-
-		/* See whether to protect the following with an if. */
-		/* This only happens when there are multiple entries. */
-
-		nd = dp->ndim - 1;
-		if (addif0) {
-			if (!ac)
-				ac = count_args();
-			if (ac[q->argno] == nentry)
-				addif = 0;
-			else if (dp->basexpr
-				    || dp->baseoffset->constblock.Const.ci)
-				addif = 1;
-			else for(addif = i = 0; i <= nd; i++)
-				if (dp->dims[i].dimexpr
-				&& (i < nd || !q->vlastdim)) {
-					addif = 1;
-					break;
-					}
-			if (addif) {
-				write_comment();
-				nice_printf(outfile, "if (%s) {\n", /*}*/
-						q->cvarname);
-				next_tab(outfile);
-				}
-			}
-		for(i = 0 ; i <= nd; ++i)
-
-/* Store the variable length of each dimension (which is fixed upon
-   runtime procedure entry) into a local variable */
-
-		    if ((Q = dp->dims[i].dimexpr)
-			&& (i < nd || !q->vlastdim)) {
-			expr = (expptr)cpexpr(Q);
-			write_comment();
-			out_and_free_statement (outfile, mkexpr (OPASSIGN,
-				fixtype(cpexpr(dp->dims[i].dimsize)), expr));
-		    } /* if dp -> dims[i].dimexpr */
-
-/* size   will equal the size of a single element, or -1 if the type is
-   variable length character type */
-
-		size = typesize[ q->vtype ];
-		if(q->vtype == TYCHAR)
-		    if( ISICON(q->vleng) )
-			size *= q->vleng->constblock.Const.ci;
-		    else
-			size = -1;
-
-		/* Fudge the argument pointers for arrays so subscripts
-		 * are 0-based. Not done if array bounds are being checked.
-		 */
-		if(dp->basexpr) {
-
-/* Compute the base offset for this procedure */
-
-		    write_comment();
-		    out_and_free_statement (outfile, mkexpr (OPASSIGN,
-			    cpexpr(fixtype(dp->baseoffset)),
-			    cpexpr(fixtype(dp->basexpr))));
-		} /* if dp -> basexpr */
-
-		if(! checksubs) {
-		    if(dp->basexpr) {
-			expptr tp;
-
-/* If the base of this array has a variable adjustment ... */
-
-			tp = (expptr) cpexpr (dp -> baseoffset);
-			if(size < 0 || q -> vtype == TYCHAR)
-			    tp = mkexpr (OPSTAR, tp, cpexpr (q -> vleng));
-
-			write_comment();
-			tp = mkexpr (OPMINUSEQ,
-				mkconv (TYADDR, (expptr)p->datap),
-				mkconv(TYINT, fixtype
-				(fixtype (tp))));
-/* Avoid type clash by removing the type conversion */
-			tp = prune_left_conv (tp);
-			out_and_free_statement (outfile, tp);
-		    } else if(dp->baseoffset->constblock.Const.ci != 0) {
-
-/* if the base of this array has a nonzero constant adjustment ... */
-
-			expptr tp;
-
-			write_comment();
-			if(size > 0 && q -> vtype != TYCHAR) {
-			    tp = prune_left_conv (mkexpr (OPMINUSEQ,
-				    mkconv (TYADDR, (expptr)p->datap),
-				    mkconv (TYINT, fixtype
-				    (cpexpr (dp->baseoffset)))));
-			    out_and_free_statement (outfile, tp);
-			} else {
-			    tp = prune_left_conv (mkexpr (OPMINUSEQ,
-				    mkconv (TYADDR, (expptr)p->datap),
-				    mkconv (TYINT, fixtype
-				    (mkexpr (OPSTAR, cpexpr (dp -> baseoffset),
-				    cpexpr (q -> vleng))))));
-			    out_and_free_statement (outfile, tp);
-			} /* else */
-		    } /* if dp -> baseoffset -> const */
-		} /* if !checksubs */
-
-		if (addif) {
-			nice_printf(outfile, /*{*/ "}\n");
-			prev_tab(outfile);
-			}
-	    }
-	}
-	if (wrote_comment)
-	    nice_printf (outfile, "\n/* Function Body */\n");
-	if (ac)
-		free((char *)ac);
-	if (p0 != p1)
-		frchain(&p1);
-} /* prolog */
diff --git a/usr.bin/f2c/version.c b/usr.bin/f2c/version.c
deleted file mode 100644
index 90392f1..0000000
--- a/usr.bin/f2c/version.c
+++ /dev/null
@@ -1,2 +0,0 @@
-char F2C_version[] = "19980913";
-char xxxvers[] = "\n@(#) FORTRAN 77 to C Translator, VERSION 19980913\n";