configure.in: Define IEEE_COMPLEX_DIVIDE.

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

From-SVN: r32496
This commit is contained in:
Toon Moene 2000-03-12 19:20:47 +00:00 committed by Toon Moene
parent 66e86e32ab
commit 6973bf5482
9 changed files with 64 additions and 7 deletions

View File

@ -1,3 +1,17 @@
Sun Mar 12 20:12;30 2000 Toon Moene <toon@moene.indiv.nluug.nl>
Based on work done by David M. Gay (Bell Labs)
* 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.
Wed Feb 16 11:10:05 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* configure.in (gcc_version): When setting, narrow search to

View File

@ -1,4 +1,4 @@
static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
static char junk[] = "\n@(#)LIBF77 VERSION 19991115\n";
/*
*/
@ -61,6 +61,14 @@ char __G77_LIBF77_VERSION__[] = "0.5.25 20000312 (prerelease)";
overlapping arguments caused by equivalence.
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).
*/
#include <stdio.h>

View File

@ -18,8 +18,18 @@ void c_div(complex *c, complex *a, complex *b)
abi = - abi;
if( abr <= abi )
{
if(abi == 0)
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);
cr = (a->r*ratio + a->i) / den;

View File

@ -98,6 +98,7 @@ dnl Unfortunately, the message implies we're just checking for -lm...
AC_CHECK_LIB(m,drem,AC_DEFINE(IEEE_drem))
AC_DEFINE(Skip_f2c_Undefs)
AC_DEFINE(IEEE_COMPLEX_DIVIDE)
AC_OUTPUT(Makefile)

View File

@ -13,10 +13,12 @@ integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line)
{
register int i;
fprintf(stderr, "Subscript out of range on file line %ld, procedure ", line);
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 ", offset+1);
fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ",
(long)offset+1);
while((i = *varn) && i != ' ')
putc(*varn++, stderr);
sig_die(".", 1);

View File

@ -17,8 +17,16 @@ void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b)
abi = - abi;
if( abr <= abi )
{
if(abi == 0)
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);
cr = (a->r*ratio + a->i) / den;

View File

@ -1,4 +1,4 @@
static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19990627\n";
static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19991115\n";
/*
*/
@ -305,6 +305,15 @@ wrtfmt.c:
/* 27 June 1999: rsne.c: fix bug in namelist input: a misplaced increment */
/* 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. */

View File

@ -29,7 +29,7 @@ integer f_end(alist *a)
b = &f__units[a->aunit];
if(b->ufd==NULL) {
char nbuf[10];
sprintf(nbuf,"fort.%ld",a->aunit);
sprintf(nbuf,"fort.%ld",(long)a->aunit);
if (tf = fopen(nbuf, f__w_mode[0]))
fclose(tf);
return(0);
@ -103,6 +103,7 @@ t_runc(alist *a)
rewind(tf);
if (copy(tf, loc, bf))
goto bad1;
b->uwrt = 1;
b->urw = 2;
#ifdef NON_UNIX_STDIO
if (b->ufmt) {

View File

@ -30,5 +30,9 @@ integer e_wsfe(Void)
f__init = 1;
n = en_fio();
f__fmtbuf=NULL;
#ifdef ALWAYS_FLUSH
if (!n && fflush(f__cf))
err(f__elist->cierr, errno, "write end");
#endif
return n;
}