From: Craig Burley Date: Mon, 3 May 1999 08:35:22 +0000 (+0000) Subject: Update to Netlib version of 1999-05-03 X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a152cad74a458145a270781a312a0c2285dfdc4f;p=gcc.git Update to Netlib version of 1999-05-03 From-SVN: r26740 --- diff --git a/libf2c/ChangeLog b/libf2c/ChangeLog index 7d88fa40e3f..c74ab760ee4 100644 --- a/libf2c/ChangeLog +++ b/libf2c/ChangeLog @@ -1,3 +1,14 @@ +Mon May 3 11:12:38 1999 Craig Burley + + 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 * libF77/c_cos.c, libF77/c_div.c, libF77/c_exp.c, libF77/c_log.c, diff --git a/libf2c/changes.netlib b/libf2c/changes.netlib index 048ea942b99..cbb6ee36082 100644 --- a/libf2c/changes.netlib +++ b/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. diff --git a/libf2c/libF77/Version.c b/libf2c/libF77/Version.c index 3e46ce899d9..a31379f510b 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"; /* */ @@ -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 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 bc116feb38a..4d0b7cf7b04 100644 --- a/libf2c/libF77/getenv_.c +++ b/libf2c/libF77/getenv_.c @@ -1,8 +1,11 @@ #include "f2c.h" - -#ifndef KR_headers #undef abs +#ifdef KR_headers +extern char *F77_aloc(), *getenv(); +#else #include +#include +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 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 360b966a96f..a475702b9be 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"; /* */ @@ -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. */ diff --git a/libf2c/libI77/err.c b/libf2c/libI77/err.c index 56d82ac4b19..e7ac23a6cfe 100644 --- a/libf2c/libI77/err.c +++ b/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); } diff --git a/libf2c/libI77/open.c b/libf2c/libI77/open.c index 7c8f3ded7ac..dd47bddb9e1 100644 --- a/libf2c/libI77/open.c +++ b/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]; diff --git a/libf2c/libI77/rdfmt.c b/libf2c/libI77/rdfmt.c index b03bcc5dbf6..08ff0e827b4 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; } diff --git a/libf2c/readme.netlib b/libf2c/readme.netlib index f87aae431d2..e312984dc54 100644 --- a/libf2c/readme.netlib +++ b/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