+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: 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.
-static char junk[] = "\n@(#)LIBF77 VERSION 19970919\n";
+static char junk[] = "\n@(#)LIBF77 VERSION 19990502\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.
*/
#include <stdio.h>
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);
}
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);
+ }
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);
}
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;
+ }
#include "time.h"
#ifdef MSDOS
+#undef USE_CLOCK
#define USE_CLOCK
#endif
#include "time.h"
#ifdef MSDOS
+#undef USE_CLOCK
#define USE_CLOCK
#endif
#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
/*
*/
#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++ = ' ';
-}
+ }
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;
+ }
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);
}
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);
+ }
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 ) );
}
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);
}
-static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19980907\n";
+static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19990502\n";
/*
*/
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. */
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);
}
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];
#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;
}
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
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
projects / gcc.git / commitdiff