Update to the most recent version. Among other things, this also solves

the function naming problem for complex double function i've recently
aksed for in -committers.  (The recently committed rev 1.5 of proc.c
was actually also part of this update.)

Should the mailing lists come to an agreement that f2c better belongs
into the ports, this could be done nevertheless.  For the time being,
we've at least got a current version now.

Thanks, Steve!

Submitted by:	Steve Kargl <sgk@troutmask.apl.washington.edu>

12 files changed, 178 insertions, 66 deletions

diff --git a/usr.bin/f2c/Notice b/usr.bin/f2c/Notice
index 8db1d7b..261b719 100644
--- a/usr.bin/f2c/Notice
+++ b/usr.bin/f2c/Notice
@@ -1,23 +1,23 @@
 /****************************************************************
-Copyright 1990 - 1997 by AT&T Bell Laboratories and Bellcore.
+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 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.
+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 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.
+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
index 8267bea..6b0d2b2 100644
--- a/usr.bin/f2c/README
+++ b/usr.bin/f2c/README
@@ -32,16 +32,17 @@ 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 yours is such a
-system, you may either modify the makefile appropriately (remove
-"malloc.o" from the "OBJECTS =" assignment), or simply execute
-	cc -c -DCRAY malloc.c
-before typing "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.  In general, if f2c faults
-when you first try to run it, try compiling malloc.c with -DCRAY;
-this is necessary with at least one version of Linux (but not with
-others).
+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
@@ -157,6 +158,11 @@ 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:
diff --git a/usr.bin/f2c/format.c b/usr.bin/f2c/format.c
index bcd9b99..1e92d3b 100644
--- a/usr.bin/f2c/format.c
+++ b/usr.bin/f2c/format.c
@@ -328,7 +328,7 @@ do_p1_comment(infile, outfile)
 do_p1_comment(FILE *infile, FILE *outfile)
 #endif
 {
-    extern int c_output_line_length, in_comment;
+    extern int in_comment;
 
     char storage[COMMENT_BUFFER_SIZE + 1];
     int length;
@@ -340,10 +340,7 @@ do_p1_comment(FILE *infile, FILE *outfile)
 
     gflag1 = sharp_line = 0;
     in_comment = 1;
-    if (length > c_output_line_length - 6)
-	margin_printf(outfile, "/*%s*/\n", storage);
-    else
-	margin_printf(outfile, length ? "/* %s */\n" : "\n", storage);
+    margin_printf(outfile, length ? "/* %s */\n" : "\n", storage);
     in_comment = 0;
     gflag1 = sharp_line = gflag;
 } /* do_p1_comment */
@@ -2428,6 +2425,8 @@ proto(FILE *outfile,  Argtypes *at,  char *fname)
 			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]);
 			}
diff --git a/usr.bin/f2c/formatdata.c b/usr.bin/f2c/formatdata.c
index 501463a..56507be 100644
--- a/usr.bin/f2c/formatdata.c
+++ b/usr.bin/f2c/formatdata.c
@@ -927,6 +927,63 @@ Len(long L, int type)
 	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)
@@ -939,12 +996,13 @@ wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm)
 #endif
 {
 	struct Equivblock *eqv;
-	int btype, curtype, dtype, filltype, filltype1, j, k, wasblank, xtype;
+	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, L1, dL, dloc, loc, loc0;
+	ftnint L, L0, L1, L2, dL, dloc, loc, loc0;
 	union Constant Const;
 	char imag_buf[50], real_buf[50];
 	int szshort = typesize[TYSHORT];
@@ -978,8 +1036,10 @@ wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm)
 
 	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
@@ -1007,6 +1067,10 @@ wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm)
 			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)
@@ -1015,9 +1079,9 @@ wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm)
 			 && btype <= type_choice[loc/szshort % 4])
 				break;
 			dtype = (int)cp->nextp->datap;
-			loc = dloc + dtype == TYBLANK
+			loc = dloc + (dtype == TYBLANK
 					? (ftnint)cp->nextp->nextp->datap
-					: typesize[dtype];
+					: typesize[dtype]);
 			}
 		}
 	sentinel = mkchain((char *)L, mkchain((char *)TYERROR,CHNULL));
@@ -1069,19 +1133,19 @@ wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm)
 			loc0 = dloc;
 			}
 		if (L > 0) {
-			if (xtype == TYCHAR)
-				filltype = TYCHAR;
-			else {
-				filltype = L % szshort ? TYCHAR
-						: type_choice[L/szshort % 4];
-				filltype1 = loc % szshort ? TYCHAR
-						: type_choice[loc/szshort % 4];
-				if (typesize[filltype] > typesize[filltype1])
-					filltype = filltype1;
-				}
+			filltype = fill_type(L, loc, xtype);
 			L1 = L / typesize[filltype];
-			nice_printf(outfile, "%s fill_%d[%ld];\n",
-				typename[filltype], ++k, L1);
+			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) {
@@ -1097,6 +1161,7 @@ wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm)
 		? extsymtab[memno].cextname
 		: equiv_name(eqvmemno, CNULL));
 	loc = 0;
+	xfilled &= 2;
 	for(v = values; ; v = v->nextp) {
 		cp = (chainp)v->datap;
 		if (!cp)
@@ -1106,8 +1171,19 @@ wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm)
 			break;
 		dloc = (ftnint)cp->datap;
 		if (dloc > loc) {
-			nice_printf(outfile, "%s{0}", comma);
-			comma = ", ";
+			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)
diff --git a/usr.bin/f2c/gram.dcl b/usr.bin/f2c/gram.dcl
index b30a45c..e5c5df0 100644
--- a/usr.bin/f2c/gram.dcl
+++ b/usr.bin/f2c/gram.dcl
@@ -243,7 +243,7 @@ datavar:	  lhs
 		  np = pp -> namep;
 		  vardcl(np);
 		  if ((pp->fcharp || pp->lcharp)
-		   && (np->vtype != TYCHAR || np->vdim))
+		   && (np->vtype != TYCHAR || np->vdim && !pp->argsp))
 			sserr(np);
 		  if(np->vstg == STGCOMMON)
 			extsymtab[np->vardesc.varno].extinit = YES;
diff --git a/usr.bin/f2c/intr.c b/usr.bin/f2c/intr.c
index c83325f..3fc177a 100644
--- a/usr.bin/f2c/intr.c
+++ b/usr.bin/f2c/intr.c
@@ -1,5 +1,5 @@
 /****************************************************************
-Copyright 1990, 1992, 1994-6 by AT&T, Lucent Technologies and Bellcore.
+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
@@ -52,6 +52,7 @@ LOCAL struct Intrblock
 "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 },
diff --git a/usr.bin/f2c/lex.c b/usr.bin/f2c/lex.c
index 6e779e1..900128e 100644
--- a/usr.bin/f2c/lex.c
+++ b/usr.bin/f2c/lex.c
@@ -1642,12 +1642,15 @@ store_comment(char *str)
 		}
 	len = strlen(str) + 1;
 	if (cbnext + len > cblast) {
-		if (!cbcur || !(ncb = cbcur->next)) {
+		ncb = 0;
+		if (cbcur) {
+			cbcur->last = cbnext;
+			ncb = cbcur->next;
+			}
+		if (!ncb) {
 			ncb = (comment_buf *) Alloc(sizeof(comment_buf));
-			if (cbcur) {
-				cbcur->last = cbnext;
+			if (cbcur)
 				cbcur->next = ncb;
-				}
 			else {
 				cbfirst = ncb;
 				cbinit = ncb->buf;
diff --git a/usr.bin/f2c/malloc.c b/usr.bin/f2c/malloc.c
index 3f5cb2a..7bd54bc 100644
--- a/usr.bin/f2c/malloc.c
+++ b/usr.bin/f2c/malloc.c
@@ -162,4 +162,21 @@ realloc(Char *f, Unsigned size)
 		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/niceprintf.c b/usr.bin/f2c/niceprintf.c
index 0d5f5cc..e2d3825 100644
--- a/usr.bin/f2c/niceprintf.c
+++ b/usr.bin/f2c/niceprintf.c
@@ -229,7 +229,7 @@ fwd_strcpy(register char *t, register char *s)
     extern FILEP c_file;
     extern char tr_tab[];	/* in output.c */
     register char *Tr = tr_tab;
-    int ch, inc, ind;
+    int ch, cmax, inc, ind;
     static int extra_indent, last_indent, set_cursor = 1;
 
     cursor_pos += indent - last_indent;
@@ -250,13 +250,17 @@ fwd_strcpy(register char *t, register char *s)
 		ind = indent <= MAX_INDENT
 			? indent
 			: MIN_INDENT + indent % (MAX_INDENT - MIN_INDENT);
-		cursor_pos = ind + extra_indent;
+		cursor_pos = extra_indent;
+		if (use_indent)
+			cursor_pos += ind;
 		set_cursor = 0;
 		}
-	if (in_comment)
+	if (in_comment) {
+		cmax = max_line_len + 32;	/* let comments be wider */
         	for (pointer = next_slot; *pointer && *pointer != '\n' &&
-				cursor_pos <= max_line_len; pointer++)
+				cursor_pos <= cmax; pointer++)
 			cursor_pos++;
+		}
 	else
           for (pointer = next_slot; *pointer && *pointer != '\n' &&
 		cursor_pos <= max_line_len; pointer++) {
diff --git a/usr.bin/f2c/output.c b/usr.bin/f2c/output.c
index 03d0ed0..5f650e7 100644
--- a/usr.bin/f2c/output.c
+++ b/usr.bin/f2c/output.c
@@ -443,8 +443,6 @@ out_name(FILE *fp, Namep namep)
 } /* out_name */
 
 
-static char *Longfmt = "%ld";
-
 #define cpd(n) cp->vstg ? cp->Const.cds[n] : dtos(cp->Const.cd[n])
 
  void
@@ -469,7 +467,7 @@ out_const(FILE *fp, register Constp cp)
 #ifdef TYQUAD
 	case TYQUAD:
 #endif
-	    nice_printf (fp, Longfmt, cp->Const.ci);	/* don't cast ci! */
+	    nice_printf (fp, "%ld", cp->Const.ci);	/* don't cast ci! */
 	    break;
 	case TYREAL:
 	    nice_printf(fp, "%s", flconst(real_buf, cpd(0)));
@@ -1315,10 +1313,11 @@ out_call(FILE *outfile, int op, int ftype, expptr len, expptr name, expptr args)
 /* Might be a Constant expression, e.g. string length, character constants */
 
 	else if (q -> tag == TCONST) {
-	    if (tyioint == TYLONG)
-	   	Longfmt = "%ldL";
-	    out_const(outfile, &q->constblock);
-	    Longfmt = "%ld";
+		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.
@@ -1329,7 +1328,10 @@ out_call(FILE *outfile, int op, int ftype, expptr len, expptr name, expptr args)
 	    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, ")");
diff --git a/usr.bin/f2c/putpcc.c b/usr.bin/f2c/putpcc.c
index c104098..87d4550 100644
--- a/usr.bin/f2c/putpcc.c
+++ b/usr.bin/f2c/putpcc.c
@@ -559,6 +559,10 @@ putpower(expptr p)
 /* 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),
diff --git a/usr.bin/f2c/version.c b/usr.bin/f2c/version.c
index 87a0922..90392f1 100644
--- a/usr.bin/f2c/version.c
+++ b/usr.bin/f2c/version.c
@@ -1,2 +1,2 @@
-char F2C_version[] = "19970219";
-char xxxvers[] = "\n@(#) FORTRAN 77 to C Translator, VERSION 19970219\n";
+char F2C_version[] = "19980913";
+char xxxvers[] = "\n@(#) FORTRAN 77 to C Translator, VERSION 19980913\n";