Commit 6973bf54 by Toon Moene Committed by Toon Moene

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
parent 66e86e32
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> Wed Feb 16 11:10:05 2000 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* configure.in (gcc_version): When setting, narrow search to * configure.in (gcc_version): When setting, narrow search to
......
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)"; ...@@ -61,6 +61,14 @@ char __G77_LIBF77_VERSION__[] = "0.5.25 20000312 (prerelease)";
overlapping arguments caused by equivalence. overlapping arguments caused by equivalence.
3 May 1999: "invisible" tweaks to omit compiler warnings in 3 May 1999: "invisible" tweaks to omit compiler warnings in
abort_.c, ef1asc_.c, s_rnge.c, s_stop.c. 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> #include <stdio.h>
......
...@@ -18,8 +18,18 @@ void c_div(complex *c, complex *a, complex *b) ...@@ -18,8 +18,18 @@ void c_div(complex *c, complex *a, complex *b)
abi = - abi; abi = - abi;
if( abr <= 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); sig_die("complex division by zero", 1);
#endif
}
ratio = (double)b->r / b->i ; ratio = (double)b->r / b->i ;
den = b->i * (1 + ratio*ratio); den = b->i * (1 + ratio*ratio);
cr = (a->r*ratio + a->i) / den; cr = (a->r*ratio + a->i) / den;
......
...@@ -98,6 +98,7 @@ dnl Unfortunately, the message implies we're just checking for -lm... ...@@ -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_CHECK_LIB(m,drem,AC_DEFINE(IEEE_drem))
AC_DEFINE(Skip_f2c_Undefs) AC_DEFINE(Skip_f2c_Undefs)
AC_DEFINE(IEEE_COMPLEX_DIVIDE)
AC_OUTPUT(Makefile) AC_OUTPUT(Makefile)
......
...@@ -13,10 +13,12 @@ integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line) ...@@ -13,10 +13,12 @@ integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line)
{ {
register int i; 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 != ' ') while((i = *procn) && i != '_' && i != ' ')
putc(*procn++, stderr); 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 != ' ') while((i = *varn) && i != ' ')
putc(*varn++, stderr); putc(*varn++, stderr);
sig_die(".", 1); sig_die(".", 1);
......
...@@ -17,8 +17,16 @@ void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b) ...@@ -17,8 +17,16 @@ void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b)
abi = - abi; abi = - abi;
if( abr <= 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); sig_die("complex division by zero", 1);
#endif
}
ratio = b->r / b->i ; ratio = b->r / b->i ;
den = b->i * (1 + ratio*ratio); den = b->i * (1 + ratio*ratio);
cr = (a->r*ratio + a->i) / den; cr = (a->r*ratio + a->i) / den;
......
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: ...@@ -305,6 +305,15 @@ wrtfmt.c:
/* 27 June 1999: rsne.c: fix bug in namelist input: a misplaced increment */ /* 27 June 1999: rsne.c: fix bug in namelist input: a misplaced increment */
/* could cause wrong array elements to be assigned; e.g., */ /* could cause wrong array elements to be assigned; e.g., */
/* "&input k(5)=10*1 &end" assigned k(5) and k(15..23) */ /* "&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. */
......
...@@ -29,7 +29,7 @@ integer f_end(alist *a) ...@@ -29,7 +29,7 @@ integer f_end(alist *a)
b = &f__units[a->aunit]; b = &f__units[a->aunit];
if(b->ufd==NULL) { if(b->ufd==NULL) {
char nbuf[10]; char nbuf[10];
sprintf(nbuf,"fort.%ld",a->aunit); sprintf(nbuf,"fort.%ld",(long)a->aunit);
if (tf = fopen(nbuf, f__w_mode[0])) if (tf = fopen(nbuf, f__w_mode[0]))
fclose(tf); fclose(tf);
return(0); return(0);
...@@ -103,6 +103,7 @@ t_runc(alist *a) ...@@ -103,6 +103,7 @@ t_runc(alist *a)
rewind(tf); rewind(tf);
if (copy(tf, loc, bf)) if (copy(tf, loc, bf))
goto bad1; goto bad1;
b->uwrt = 1;
b->urw = 2; b->urw = 2;
#ifdef NON_UNIX_STDIO #ifdef NON_UNIX_STDIO
if (b->ufmt) { if (b->ufmt) {
......
...@@ -30,5 +30,9 @@ integer e_wsfe(Void) ...@@ -30,5 +30,9 @@ integer e_wsfe(Void)
f__init = 1; f__init = 1;
n = en_fio(); n = en_fio();
f__fmtbuf=NULL; f__fmtbuf=NULL;
#ifdef ALWAYS_FLUSH
if (!n && fflush(f__cf))
err(f__elist->cierr, errno, "write end");
#endif
return n; return n;
} }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment