Committed the following to egcs/libf2c ...
toon@moene.indiv.nluug.nl
toon@moene.indiv.nluug.nl
Sun Mar 12 11:21:00 GMT 2000
Sat Jan 29 15:07:19 CET 2000 Toon Moene <toon@moene.indiv.nluug.nl>
Based on work by David M. Gay <dmg@bell-labs.com>
* libF77/configure.in: Define IEEE_COMPLEX_DIVIDE.
* libF77/[cz]_div.c: Arrange for compilation under
-DIEEE_COMPLEX_DIVIDE to make these routines
avoid calling sig_die when the denominator vanishes.
* libF77/s_rnge.c: Add casts for the case of
sizeof(ftnint) == sizeof(int) < sizeof(long).
* libI77/endfile.c: Set state to writing (b->uwrt = 1) when an
endfile statement requires copying the file
Also, supply a missing (long) cast in the sprintf call.
* libI77/sfe.c: Add #ifdef ALWAYS_FLUSH logic, for formatted I/O.
*** libf2c/libF77/Version.c.orig Fri Jan 28 12:38:08 2000
--- libf2c/libF77/Version.c Fri Jan 28 12:40:48 2000
***************
*** 1,3 ****
! static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
/*
--- 1,3 ----
! static char junk[] = "\n@(#)LIBF77 VERSION 19991115\n";
/*
*************** char __G77_LIBF77_VERSION__[] = "0.5.25
*** 62,65 ****
--- 62,73 ----
3 May 1999: "invisible" tweaks to omit compiler warnings in
abort_.c, ef1asc_.c, s_rnge.c, s_stop.c.
+ 7 Sept. 1999: [cz]_div.c: arrange for compilation under
+ -DIEEE_COMPLEX_DIVIDE to make these routines
+ avoid calling sig_die when the denominator
+ vanishes; instead, they return pairs of NaNs
+ or Infinities, depending whether the numerator
+ also vanishes or not. VERSION not changed.
+ 15 Nov. 1999: s_rnge.c: add casts for the case of
+ sizeof(ftnint) == sizeof(int) < sizeof(long).
*/
*** libf2c/libF77/c_div.c.orig Mon May 3 10:33:08 1999
--- libf2c/libF77/c_div.c Fri Jan 28 12:22:10 2000
*************** void c_div(complex *c, complex *a, compl
*** 19,24 ****
if( abr <= abi )
{
! if(abi == 0)
sig_die("complex division by zero", 1);
ratio = (double)b->r / b->i ;
den = b->i * (1 + ratio*ratio);
--- 19,34 ----
if( abr <= abi )
{
! if(abi == 0) {
! #ifdef IEEE_COMPLEX_DIVIDE
! float af, bf;
! af = bf = abr;
! if (a->i != 0 || a->r != 0)
! af = 1.;
! c->i = c->r = af / bf;
! return;
! #else
sig_die("complex division by zero", 1);
+ #endif
+ }
ratio = (double)b->r / b->i ;
den = b->i * (1 + ratio*ratio);
*** libf2c/libF77/configure.in.orig Fri Jan 28 13:05:56 2000
--- libf2c/libF77/configure.in Fri Jan 28 13:06:22 2000
*************** AC_CHECK_LIB(m,drem,AC_DEFINE(IEEE_drem)
*** 99,102 ****
--- 99,103 ----
AC_DEFINE(Skip_f2c_Undefs)
+ AC_DEFINE(IEEE_COMPLEX_DIVIDE)
AC_OUTPUT(Makefile)
*** libf2c/libF77/s_rnge.c.orig Fri Jan 28 12:20:27 2000
--- libf2c/libF77/s_rnge.c Fri Jan 28 12:25:52 2000
*************** integer s_rnge(char *varn, ftnint offset
*** 14,21 ****
register int i;
! fprintf(stderr, "Subscript out of range on file line %ld, procedure ", line);
while((i = *procn) && i != '_' && i != ' ')
putc(*procn++, stderr);
! fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1);
while((i = *varn) && i != ' ')
putc(*varn++, stderr);
--- 14,23 ----
register int i;
! fprintf(stderr, "Subscript out of range on file line %ld, procedure ",
! (long)line);
while((i = *procn) && i != '_' && i != ' ')
putc(*procn++, stderr);
! fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ",
! (long)offset+1);
while((i = *varn) && i != ' ')
putc(*varn++, stderr);
*** libf2c/libF77/z_div.c.orig Mon May 3 10:33:17 1999
--- libf2c/libF77/z_div.c Fri Jan 28 12:23:00 2000
*************** void z_div(doublecomplex *c, doublecompl
*** 18,23 ****
if( abr <= abi )
{
! if(abi == 0)
sig_die("complex division by zero", 1);
ratio = b->r / b->i ;
den = b->i * (1 + ratio*ratio);
--- 18,31 ----
if( abr <= abi )
{
! if(abi == 0) {
! #ifdef IEEE_COMPLEX_DIVIDE
! if (a->i != 0 || a->r != 0)
! abi = 1.;
! c->i = c->r = abi / abr;
! return;
! #else
sig_die("complex division by zero", 1);
+ #endif
+ }
ratio = b->r / b->i ;
den = b->i * (1 + ratio*ratio);
*** libf2c/libI77/Version.c.orig Fri Jan 28 12:48:26 2000
--- libf2c/libI77/Version.c Fri Jan 28 12:51:38 2000
***************
*** 1,3 ****
! static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19990627\n";
/*
--- 1,3 ----
! static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19991115\n";
/*
*************** wrtfmt.c:
*** 306,309 ****
--- 306,318 ----
/* could cause wrong array elements to be assigned; e.g., */
/* "&input k(5)=10*1 &end" assigned k(5) and k(15..23) */
+ /* 15 Nov. 1999: endfile.c: set state to writing (b->uwrt = 1) when an */
+ /* endfile statement requires copying the file. */
+ /* (Otherwise an immediately following rewind statement */
+ /* could make the file appear empty.) Also, supply a */
+ /* missing (long) cast in the sprintf call. */
+ /* sfe.c: add #ifdef ALWAYS_FLUSH logic, for formatted I/O: */
+ /* Compiling libf2c with -DALWAYS_FLUSH should prevent losing */
+ /* any data in buffers should the program fault. It also */
+ /* makes the program run more slowly. */
*** libf2c/libI77/endfile.c.orig Fri Jan 28 12:54:26 2000
--- libf2c/libI77/endfile.c Fri Jan 28 12:55:48 2000
*************** integer f_end(alist *a)
*** 30,34 ****
if(b->ufd==NULL) {
char nbuf[10];
! sprintf(nbuf,"fort.%ld",a->aunit);
if (tf = fopen(nbuf, f__w_mode[0]))
fclose(tf);
--- 30,34 ----
if(b->ufd==NULL) {
char nbuf[10];
! sprintf(nbuf,"fort.%ld",(long)a->aunit);
if (tf = fopen(nbuf, f__w_mode[0]))
fclose(tf);
*************** t_runc(alist *a)
*** 104,107 ****
--- 104,108 ----
if (copy(tf, loc, bf))
goto bad1;
+ b->uwrt = 1;
b->urw = 2;
#ifdef NON_UNIX_STDIO
*** libf2c/libI77/sfe.c.orig Fri Jan 28 12:54:33 2000
--- libf2c/libI77/sfe.c Fri Jan 28 12:57:41 2000
*************** integer e_wsfe(Void)
*** 31,34 ****
--- 31,38 ----
n = en_fio();
f__fmtbuf=NULL;
+ #ifdef ALWAYS_FLUSH
+ if (!n && fflush(f__cf))
+ err(f__elist->cierr, errno, "write end");
+ #endif
return n;
}
More information about the Gcc-patches
mailing list