Update to Netlib version of 1999-05-03

From-SVN: r26740

libf2c/ChangeLog

+Mon May  3 11:12:38 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Update to Netlib version of 1999-05-03:
+	* changes.netlib, libF77/Version.c, libF77/c_cos.c,
+	libF77/c_exp.c, libF77/c_sin.c, libF77/d_cnjg.c,
+	libF77/dtime_.c, libF77/etime_.c, libF77/getenv_.c,
+	libF77/r_cnjg.c, libF77/z_cos.c, libF77/z_exp.c,
+	libF77/z_log.c, libF77/z_sin.c, libI77/Version.c,
+	libI77/err.c, libI77/open.c, libI77/rdfmt.c, readme.netlib:
+	See changes.netlib for info.
+
 Mon May  3 10:52:53 1999  Craig Burley  <craig@jcb-sc.com>
 
 	* libF77/c_cos.c, libF77/c_div.c, libF77/c_exp.c, libF77/c_log.c,

libf2c/changes.netlib

@@ -2980,3 +2980,30 @@ Sat Feb 13 10:18:27 EST 1999
  libf2c: endfile.c, lread.c, signal1.h0: minor tweaks to make some
 (C++) compilers happier; f77_aloc.c: make exit_() visible to C++
 compilers.  Version strings not changed.
+
+Thu Mar 11 23:14:02 EST 1999
+  Modify f2c (exec.c, expr.c) to diagnose incorrect mixing of types
+when (f2c extended) intrinsic functions are involved, as in
+(not(17) .and. 4).  Catching this in the first executable statement
+is a bit tricky, as some checking must be postponed until all statement
+function declarations have been parsed.  Thus there is a chance of
+today's changes introducing bugs under (let us hope) unusual conditions.
+
+Sun Mar 28 13:17:44 EST 1999
+  lex.c: tweak to get the file name right in error messages caused
+by statements just after a # nnn "filename" line emitted by the C
+preprocessor.  (The trouble is that the line following the # nnn line
+must be read to see if it is a continuation of the stuff that preceded
+the # nnn line.)  When # nnn "filename" lines appear among the lines
+for a Fortran statement, the filename reported in an error message for
+the statement should now be the file that was current when the first
+line of the statement was read.
+
+Sun May  2 22:38:25 EDT 1999
+  libf77, libi77, libf2c.zip: make getenv_() more portable (call
+getenv() rather than knowing about char **environ); adjust some
+complex intrinsics to work with overlapping arguments (caused by
+illegal use of equivalence); open.c: get "external" versus "internal"
+right in the error message if a file cannot be opened; err.c: cast a
+pointer difference to (int) for %d; rdfmt.c: omit fixed-length buffer
+that could be overwritten by formats Inn or Lnn with nn > 83.

libf2c/libF77/Version.c

-static char junk[] = "\n@(#)LIBF77 VERSION 19970919\n";
+static char junk[] = "\n@(#)LIBF77 VERSION 19990502\n";
 
 /*
 */
@@ -55,6 +55,10 @@ char __G77_LIBF77_VERSION__[] = "0.5.24";
 			affect systems using gratuitous extra precision).
 	19 Sept. 1997: [de]time_.c (Unix systems only): change return
 			type to double.
+	2 May 1999:	getenv_.c: omit environ in favor of getenv().
+			c_cos.c, c_exp.c, c_sin.c, d_cnjg.c, r_cnjg.c,
+			z_cos.c, z_exp.c, z_log.c, z_sin.c: cope fully with
+			overlapping arguments caused by equivalence.
 */
 
 #include <stdio.h>

libf2c/libF77/c_cos.c

@@ -11,7 +11,7 @@ VOID c_cos(r, z) complex *r, *z;
 void c_cos(complex *r, complex *z)
 #endif
 {
-	double zr = z->r;
-	r->r =   cos(zr) * cosh(z->i);
-	r->i = - sin(zr) * sinh(z->i);
+	double zi = z->i, zr = z->r;
+	r->r =   cos(zr) * cosh(zi);
+	r->i = - sin(zr) * sinh(zi);
 	}

libf2c/libF77/c_exp.c

@@ -11,9 +11,9 @@ extern double exp(), cos(), sin();
 void c_exp(complex *r, complex *z)
 #endif
 {
-double expx;
+	double expx, zi = z->i;
 
-expx = exp(z->r);
-r->r = expx * cos(z->i);
-r->i = expx * sin(z->i);
-}
+	expx = exp(z->r);
+	r->r = expx * cos(zi);
+	r->i = expx * sin(zi);
+	}

libf2c/libF77/c_sin.c

@@ -11,7 +11,7 @@ VOID c_sin(r, z) complex *r, *z;
 void c_sin(complex *r, complex *z)
 #endif
 {
-	double zr = z->r;
-	r->r = sin(zr) * cosh(z->i);
-	r->i = cos(zr) * sinh(z->i);
+	double zi = z->i, zr = z->r;
+	r->r = sin(zr) * cosh(zi);
+	r->i = cos(zr) * sinh(zi);
 	}

libf2c/libF77/d_cnjg.c

@@ -7,6 +7,7 @@ d_cnjg(r, z) doublecomplex *r, *z;
 d_cnjg(doublecomplex *r, doublecomplex *z)
 #endif
 {
-r->r = z->r;
-r->i = - z->i;
-}
+	doublereal zi = z->i;
+	r->r = z->r;
+	r->i = -zi;
+	}

libf2c/libF77/dtime_.c

 #include "time.h"
 
 #ifdef MSDOS
+#undef USE_CLOCK
 #define USE_CLOCK
 #endif
 

libf2c/libF77/etime_.c

 #include "time.h"
 
 #ifdef MSDOS
+#undef USE_CLOCK
 #define USE_CLOCK
 #endif
 

libf2c/libF77/getenv_.c

 #include "f2c.h"
-
-#ifndef KR_headers
 #undef abs
+#ifdef KR_headers
+extern char *F77_aloc(), *getenv();
+#else
 #include <stdlib.h>
+#include <string.h>
+extern char *F77_aloc(ftnlen, char*);
 #endif
 
 /*
@@ -18,39 +21,36 @@
  */
 
 #ifdef KR_headers
-VOID G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen;
+ VOID
+G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen;
 #else
-void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen)
+ void
+G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen)
 #endif
 {
-extern char **environ;
-register char *ep, *fp, *flast;
-register char **env = environ;
-
-flast = fname + flen;
-for(fp = fname ; fp < flast ; ++fp)
-	if(*fp == ' ')
-		{
-		flast = fp;
-		break;
+	char buf[256], *ep, *fp;
+	integer i;
+
+	if (flen <= 0)
+		goto add_blanks;
+	for(i = 0; i < sizeof(buf); i++) {
+		if (i == flen || (buf[i] = fname[i]) == ' ') {
+			buf[i] = 0;
+			ep = getenv(buf);
+			goto have_ep;
+			}
 		}
-
-while (ep = *env++)
-	{
-	for(fp = fname; fp<flast ; )
-		if(*fp++ != *ep++)
-			goto endloop;
-
-	if(*ep++ == '=') {	/* copy right hand side */
-		while( *ep && --vlen>=0 )
+	while(i < flen && fname[i] != ' ')
+		i++;
+	strncpy(fp = F77_aloc(i+1, "getenv_"), fname, (int)i);
+	fp[i] = 0;
+	ep = getenv(fp);
+	free(fp);
+ have_ep:
+	if (ep)
+		while(*ep && vlen-- > 0)
 			*value++ = *ep++;
-
-		goto blank;
-		}
-endloop: ;
-	}
-
-blank:
-	while( --vlen >= 0 )
+ add_blanks:
+	while(vlen-- > 0)
 		*value++ = ' ';
-}
+	}

libf2c/libF77/r_cnjg.c

@@ -6,6 +6,7 @@ VOID r_cnjg(r, z) complex *r, *z;
 VOID r_cnjg(complex *r, complex *z)
 #endif
 {
-r->r = z->r;
-r->i = - z->i;
-}
+	real zi = z->i;
+	r->r = z->r;
+	r->i = -zi;
+	}

libf2c/libF77/z_cos.c

@@ -9,7 +9,7 @@ VOID z_cos(r, z) doublecomplex *r, *z;
 void z_cos(doublecomplex *r, doublecomplex *z)
 #endif
 {
-	double zr = z->r;
-	r->r =   cos(zr) * cosh(z->i);
-	r->i = - sin(zr) * sinh(z->i);
+	double zi = z->i, zr = z->r;
+	r->r =   cos(zr) * cosh(zi);
+	r->i = - sin(zr) * sinh(zi);
 	}

libf2c/libF77/z_exp.c

@@ -9,9 +9,9 @@ VOID z_exp(r, z) doublecomplex *r, *z;
 void z_exp(doublecomplex *r, doublecomplex *z)
 #endif
 {
-double expx;
+	double expx, zi = z->i;
 
-expx = exp(z->r);
-r->r = expx * cos(z->i);
-r->i = expx * sin(z->i);
-}
+	expx = exp(z->r);
+	r->r = expx * cos(zi);
+	r->i = expx * sin(zi);
+	}

libf2c/libF77/z_log.c

@@ -10,7 +10,7 @@ extern double f__cabs(double, double);
 void z_log(doublecomplex *r, doublecomplex *z)
 #endif
 {
-	double zi = z->i;
-	r->i = atan2(zi, z->r);
-	r->r = log( f__cabs( z->r, zi ) );
+	double zi = z->i, zr = z->r;
+	r->i = atan2(zi, zr);
+	r->r = log( f__cabs( zr, zi ) );
 	}

libf2c/libF77/z_sin.c

@@ -9,7 +9,7 @@ VOID z_sin(r, z) doublecomplex *r, *z;
 void z_sin(doublecomplex *r, doublecomplex *z)
 #endif
 {
-	double zr = z->r;
-	r->r = sin(zr) * cosh(z->i);
-	r->i = cos(zr) * sinh(z->i);
+	double zi = z->i, zr = z->r;
+	r->r = sin(zr) * cosh(zi);
+	r->i = cos(zr) * sinh(zi);
 	}

libf2c/libI77/Version.c

-static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19980907\n";
+static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19990502\n";
 
 /*
 */
@@ -295,6 +295,11 @@ wrtfmt.c:
 		 input for integer data. */
 /* 7 Sept. 1998: move e_wdfe from sfe.c to dfe.c, where it was originally.
 		 Why did it ever move to sfe.c? */
+/* 2 May 1999:	 open.c: set f__external (to get "external" versus "internal"
+		 right in the error message if we cannot open the file).
+		 err.c: cast a pointer difference to (int) for %d.
+		 rdfmt.c: omit fixed-length buffer that could be overwritten
+		 by formats Inn or Lnn with nn > 83. */
 
 
 

libf2c/libI77/err.c

@@ -163,7 +163,8 @@ f__fatal(int n, char *s)
 	dead = 1;
 	if (f__init & 1) {
 		if (f__curunit) {
-			fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units);
+			fprintf(stderr,"apparent state: unit %d ",
+				(int)(f__curunit-f__units));
 			fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n",
 				f__curunit->ufnm);
 			}

libf2c/libI77/open.c

@@ -141,6 +141,7 @@ integer f_open(olist *a)
 	int n;
 #endif
 	if(f__init != 1) f_init();
+	f__external = 1;
 	if(a->ounit>=MXUNIT || a->ounit<0)
 		err(a->oerr,101,"open");
 	f__curunit = b = &f__units[a->ounit];

libf2c/libI77/rdfmt.c

@@ -99,60 +99,125 @@ rd_I(n,w,len, base) Uint *n; int w; ftnlen len; register int base;
 #else
 rd_I(Uint *n, int w, ftnlen len, register int base)
 #endif
-{	longint x;
-	int sign,ch;
-	char s[84], *ps;
-	ps=s; x=0;
-	while (w)
-	{
+{
+	int bad, ch, sign;
+	longint x = 0;
+
+	if (w <= 0)
+		goto have_x;
+	for(;;) {
 		GET(ch);
-		if (ch==',' || ch=='\n') break;
-		*ps=ch; ps++; w--;
-	}
-	*ps='\0';
-	ps=s;
-	while (*ps==' ') ps++;
-	if (*ps=='-') { sign=1; ps++; }
-	else { sign=0; if (*ps=='+') ps++; }
-loop:	while (*ps>='0' && *ps<='9') { x=x*base+(*ps-'0'); ps++; }
-	if (*ps==' ') {if (f__cblank) x *= base; ps++; goto loop;}
-	if(sign) x = -x;
-	if(len==sizeof(integer)) n->il=x;
-	else if(len == sizeof(char)) n->ic = (char)x;
+		if (ch != ' ')
+			break;
+		if (!--w)
+			goto have_x;
+		}
+	sign = 0;
+	switch(ch) {
+	  case ',':
+	  case '\n':
+		w = 0;
+		goto have_x;
+	  case '-':
+		sign = 1;
+	  case '+':
+		break;
+	  default:
+		if (ch >= '0' && ch <= '9') {
+			x = ch - '0';
+			break;
+			}
+		goto have_x;
+		}
+	while(--w) {
+		GET(ch);
+		if (ch >= '0' && ch <= '9') {
+			x = x*base + ch - '0';
+			continue;
+			}
+		if (ch != ' ') {
+			if (ch == '\n' || ch == ',')
+				w = 0;
+			break;
+			}
+		if (f__cblank)
+			x *= base;
+		}
+	if (sign)
+		x = -x;
+ have_x:
+	if(len == sizeof(integer))
+		n->il=x;
+	else if(len == sizeof(char))
+		n->ic = (char)x;
 #ifdef Allow_TYQUAD
-	else if (len == sizeof(longint)) n->ili = x;
+	else if (len == sizeof(longint))
+		n->ili = x;
 #endif
-	else n->is = (short)x;
-	if (*ps) return(errno=115); else return(0);
+	else
+		n->is = (short)x;
+	if (w) {
+		while(--w)
+			GET(ch);
+		return errno = 115;
+		}
+	return 0;
 }
+
  static int
 #ifdef KR_headers
 rd_L(n,w,len) ftnint *n; ftnlen len;
 #else
 rd_L(ftnint *n, int w, ftnlen len)
 #endif
-{	int ch, lv;
-	char s[84], *ps;
-	ps=s;
-	while (w) {
+{	int ch, dot, lv;
+
+	if (w <= 0)
+		goto bad;
+	for(;;) {
 		GET(ch);
-		if (ch==','||ch=='\n') break;
-		*ps=ch;
-		ps++; w--;
+		--w;
+		if (ch != ' ')
+			break;
+		if (!w)
+			goto bad;
 		}
-	*ps='\0';
-	ps=s; while (*ps==' ') ps++;
-	if (*ps=='.') ps++;
-	if (*ps=='t' || *ps == 'T')
+	dot = 0;
+ retry:
+	switch(ch) {
+	  case '.':
+		if (dot++ || !w)
+			goto bad;
+		GET(ch);
+		--w;
+		goto retry;
+	  case 't':
+	  case 'T':
 		lv = 1;
-	else if (*ps == 'f' || *ps == 'F')
+		break;
+	  case 'f':
+	  case 'F':
 		lv = 0;
-	else return(errno=116);
+		break;
+	  default:
+ bad:
+		for(; w > 0; --w)
+			GET(ch);
+		/* no break */
+	  case ',':
+	  case '\n':
+		return errno = 116;
+		}
 	switch(len) {
 		case sizeof(char):	*(char *)n = (char)lv;	 break;
 		case sizeof(short):	*(short *)n = (short)lv; break;
 		default:		*n = lv;
 		}
+	while(w-- > 0) {
+		GET(ch);
+		if (ch == ',' || ch == '\n')
+			break;
+		}
 	return 0;
 }
 

libf2c/readme.netlib

@@ -672,20 +672,49 @@ matters under -g).
   fc: add -U option; recognize .so files.
 
 Sat Feb 13 10:18:27 EST 1999
- libf2c: endfile.c, lread.c, signal1.h0: minor tweaks to make some
+  libf2c: endfile.c, lread.c, signal1.h0: minor tweaks to make some
 (C++) compilers happier; f77_aloc.c: make exit_() visible to C++
 compilers.  Version strings not changed.
 
+Thu Mar 11 23:14:02 EST 1999
+  Modify f2c (exec.c, expr.c) to diagnose incorrect mixing of types
+when (f2c extended) intrinsic functions are involved, as in
+(not(17) .and. 4).  Catching this in the first executable statement
+is a bit tricky, as some checking must be postponed until all statement
+function declarations have been parsed.  Thus there is a chance of
+today's changes introducing bugs under (let us hope) unusual conditions.
+
+Sun Mar 28 13:17:44 EST 1999
+  lex.c: tweak to get the file name right in error messages caused
+by statements just after a # nnn "filename" line emitted by the C
+preprocessor.  (The trouble is that the line following the # nnn line
+must be read to see if it is a continuation of the stuff that preceded
+the # nnn line.)  When # nnn "filename" lines appear among the lines
+for a Fortran statement, the filename reported in an error message for
+the statement should now be the file that was current when the first
+line of the statement was read.
+
+Sun May  2 22:38:25 EDT 1999
+  libf77, libi77, libf2c.zip: make getenv_() more portable (call
+getenv() rather than knowing about char **environ); adjust some
+complex intrinsics to work with overlapping arguments (caused by
+illegal use of equivalence); open.c: get "external" versus "internal"
+right in the error message if a file cannot be opened; err.c: cast a
+pointer difference to (int) for %d; rdfmt.c: omit fixed-length buffer
+that could be overwritten by formats Inn or Lnn with nn > 83.
+
 Current timestamps of files in "all from f2c/src", sorted by time,
 appear below (mm/dd/year hh:mm:ss).  To bring your source up to date,
 obtain source files with a timestamp later than the time shown in your
 version.c.  Note that the time shown in the current version.c is the
 timestamp of the source module that immediately follows version.c below:
 
- 2/10/1999  22:07:05  version.c
- 2/10/1999  22:06:59  lex.c
+ 3/28/1999  13:16:27  xsum0.out
+ 3/26/1999  23:18:20  version.c
+ 3/26/1999  23:18:11  lex.c
+ 3/11/1999  16:44:17  expr.c
+ 3/11/1999  16:42:42  exec.c
  2/10/1999  17:43:01  defs.h
- 9/13/1998  22:23:35  xsum0.out
  9/13/1998  22:18:21  format.c
  9/08/1998  10:16:51  f2c.1
  9/08/1998  10:16:48  f2c.1t
@@ -705,21 +734,19 @@ timestamp of the source module that immediately follows version.c below:
 12/04/1996  13:07:53  gram.exec
 10/01/1996  14:36:18  init.c
 10/01/1996  14:36:17  data.c
- 9/17/1996  17:29:44  expr.c
  9/12/1996  12:12:46  equiv.c
  8/26/1996   9:41:13  sysdep.c
  7/09/1996  10:40:45  names.c
  7/04/1996   9:55:45  sysdep.h
  7/04/1996   9:55:43  put.c
  7/04/1996   9:55:41  pread.c
- 7/04/1996   9:55:40  p1output.c
  7/04/1996   9:55:40  parse_args.c
+ 7/04/1996   9:55:40  p1output.c
  7/04/1996   9:55:37  misc.c
- 7/04/1996   9:55:36  mem.c
  7/04/1996   9:55:36  memset.c
+ 7/04/1996   9:55:36  mem.c
  7/04/1996   9:55:35  main.c
  7/04/1996   9:55:33  io.c
- 7/04/1996   9:55:30  exec.c
  7/04/1996   9:55:29  error.c
  7/04/1996   9:55:27  cds.c
  7/03/1996  15:47:49  xsum.c