mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-24 16:21:25 +08:00
Code Issues Packages Projects Releases Wiki Activity

Update to Netlib version of 1999-05-03

Browse Source 
From-SVN: r26740
This commit is contained in:
Craig Burley 1999-05-03 08:35:22 +00:00 committed by Craig Burley
parent 9cfd948e77
commit a152cad74a
20 changed files with 253 additions and 108 deletions

11
libf2c/ChangeLog

@ -1,3 +1,14 @@
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,

27
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.

6
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 <stdio.h>

6
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);
}

10
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);
}

6
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);
}

7
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;
}

1
libf2c/libF77/dtime_.c

@ -1,6 +1,7 @@
#include "time.h"
#ifdef MSDOS
#undef USE_CLOCK
#define USE_CLOCK
#endif

1
libf2c/libF77/etime_.c

@ -1,6 +1,7 @@
#include "time.h"
#ifdef MSDOS
#undef USE_CLOCK
#define USE_CLOCK
#endif

62
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 <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;
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++ = ' ';
}
}

7
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;
}

6
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);
}

10
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);
}

6
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 ) );
}

6
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);
}

7
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. */

3
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);
}

1
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];

135
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;
}

43
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