Update to Netlib version of 1999-05-03

git-svn-id: https://gcc.gnu.org/svn/gcc/branches/Netlib_branch@26738 138bc75d-0d04-0410-961f-82ee72b054a4

17 files changed, 183 insertions, 98 deletions

diff --git a/libf2c/libF77/Version.c b/libf2c/libF77/Version.c
index 64de577df1f..64d70fa91c2 100644
--- a/libf2c/libF77/Version.c
+++ b/libf2c/libF77/Version.c
@@ -1,4 +1,4 @@
-static char junk[] = "\n@(#)LIBF77 VERSION 19970919\n";
+static char junk[] = "\n@(#)LIBF77 VERSION 19990502\n";
 
 /*
 2.00	11 June 1980.  File version.c added to library.
@@ -50,4 +50,8 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19970919\n";
 			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.
 */
diff --git a/libf2c/libF77/c_cos.c b/libf2c/libF77/c_cos.c
index 4aea0c3cf69..549953dc656 100644
--- a/libf2c/libF77/c_cos.c
+++ b/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);
 	}
diff --git a/libf2c/libF77/c_exp.c b/libf2c/libF77/c_exp.c
index 8252c7f7012..52d0d2ffc95 100644
--- a/libf2c/libF77/c_exp.c
+++ b/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);
+	}
diff --git a/libf2c/libF77/c_sin.c b/libf2c/libF77/c_sin.c
index 15acccc59af..93a57660a90 100644
--- a/libf2c/libF77/c_sin.c
+++ b/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);
 	}
diff --git a/libf2c/libF77/d_cnjg.c b/libf2c/libF77/d_cnjg.c
index c778c38758c..c1970a56da9 100644
--- a/libf2c/libF77/d_cnjg.c
+++ b/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;
+	}
diff --git a/libf2c/libF77/dtime_.c b/libf2c/libF77/dtime_.c
index 09755fc586f..4b37320d43b 100644
--- a/libf2c/libF77/dtime_.c
+++ b/libf2c/libF77/dtime_.c
@@ -1,6 +1,7 @@
 #include "time.h"
 
 #ifdef MSDOS
+#undef USE_CLOCK
 #define USE_CLOCK
 #endif
 
diff --git a/libf2c/libF77/etime_.c b/libf2c/libF77/etime_.c
index 043bf6996f3..e88cfd88648 100644
--- a/libf2c/libF77/etime_.c
+++ b/libf2c/libF77/etime_.c
@@ -1,6 +1,7 @@
 #include "time.h"
 
 #ifdef MSDOS
+#undef USE_CLOCK
 #define USE_CLOCK
 #endif
 
diff --git a/libf2c/libF77/getenv_.c b/libf2c/libF77/getenv_.c
index 2a035ea9a6b..ad62615c27a 100644
--- a/libf2c/libF77/getenv_.c
+++ b/libf2c/libF77/getenv_.c
@@ -1,4 +1,12 @@
 #include "f2c.h"
+#undef abs
+#ifdef KR_headers
+extern char *F77_aloc(), *getenv();
+#else
+#include <stdlib.h>
+#include <string.h>
+extern char *F77_aloc(ftnlen, char*);
+#endif
 
 /*
  * getenv - f77 subroutine to return environment variables
@@ -13,39 +21,36 @@
  */
 
 #ifdef KR_headers
-VOID getenv_(fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen;
+ VOID
+getenv_(fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen;
 #else
-void getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen)
+ void
+getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen)
 #endif
 {
-extern char **environ;
-register char *ep, *fp, *flast;
-register char **env = environ;
+	char buf[256], *ep, *fp;
+	integer i;
 
-flast = fname + flen;
-for(fp = fname ; fp < flast ; ++fp)
-	if(*fp == ' ')
-		{
-		flast = fp;
-		break;
+	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++ = ' ';
-}
+	}
diff --git a/libf2c/libF77/r_cnjg.c b/libf2c/libF77/r_cnjg.c
index e127ca969c4..756c694ee7a 100644
--- a/libf2c/libF77/r_cnjg.c
+++ b/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;
+	}
diff --git a/libf2c/libF77/z_cos.c b/libf2c/libF77/z_cos.c
index fdd1510db48..2d4a24d2818 100644
--- a/libf2c/libF77/z_cos.c
+++ b/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);
 	}
diff --git a/libf2c/libF77/z_exp.c b/libf2c/libF77/z_exp.c
index 56138f3d34b..ecf84296d72 100644
--- a/libf2c/libF77/z_exp.c
+++ b/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);
+	}
diff --git a/libf2c/libF77/z_log.c b/libf2c/libF77/z_log.c
index 2d52b941d68..34c56d42a8c 100644
--- a/libf2c/libF77/z_log.c
+++ b/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 ) );
 	}
diff --git a/libf2c/libF77/z_sin.c b/libf2c/libF77/z_sin.c
index 577be1d85f9..e24caff927e 100644
--- a/libf2c/libF77/z_sin.c
+++ b/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);
 	}
diff --git a/libf2c/libI77/Version.c b/libf2c/libI77/Version.c
index 031c975708f..ea4c0fdb24e 100644
--- a/libf2c/libI77/Version.c
+++ b/libf2c/libI77/Version.c
@@ -1,4 +1,4 @@
-static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19980907\n";
+static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19990502\n";
 
 /*
 2.01	$ format added
@@ -290,3 +290,8 @@ 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. */
diff --git a/libf2c/libI77/err.c b/libf2c/libI77/err.c
index e25d19f20b3..de6f2cc892a 100644
--- a/libf2c/libI77/err.c
+++ b/libf2c/libI77/err.c
@@ -150,7 +150,8 @@ f__fatal(int n, char *s)
 	else
 		fprintf(stderr,"%s: %s\n",s,F_err[n-100]);
 	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);
 		}
diff --git a/libf2c/libI77/open.c b/libf2c/libI77/open.c
index 4ef58afbb4d..2e88c293096 100644
--- a/libf2c/libI77/open.c
+++ b/libf2c/libI77/open.c
@@ -136,6 +136,7 @@ integer f_open(olist *a)
 #ifndef NON_UNIX_STDIO
 	int n;
 #endif
+	f__external = 1;
 	if(a->ounit>=MXUNIT || a->ounit<0)
 		err(a->oerr,101,"open")
 	if (!f__init)
diff --git a/libf2c/libI77/rdfmt.c b/libf2c/libI77/rdfmt.c
index 3de3e494ca6..8679d0449a4 100644
--- a/libf2c/libI77/rdfmt.c
+++ b/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;
 }