Fortran (patch): Bring libf2c up to date w.r.t. current f2c distribution

toon@moene.indiv.nluug.nl toon@moene.indiv.nluug.nl
Sat Jan 29 06:41:00 GMT 2000


L.S.,

As promised, here's the patch that will bring libf2c/libF77 and libf2c/libI77
in the trunk up to date with respect to the current f2c distribution
(dated 15th of November 1999).

These changes were tested by a bootstrap on m68k-next-nextstep3.  Unfortunately,
I cannot run the regression tests on that system because I never succeeded
in building dejagnu for m68k-next-nextstep3.  As test I have run our NWP
code test suite (which is not finished yet, but will within 24 hours).

Note that several changes depend on a define option at build time.
I chose to enable IEEE_COMPLEX_DIVIDE to have [cz]_div.c generate the
same computation as the inline one in optabs.c.

ALWAYS_FLUSH is not defined, as that slows down I/O too much for little
gain.

Please note that the changelog entries are meant for libf2c/ChangeLog

Sat Jan 29 15:07:19 CET 2000  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;
  }


Thanks in advance for reviewing.

-- 
Toon Moene (toon@moene.indiv.nluug.nl)
Saturnushof 14, 3738 XG  Maartensdijk, The Netherlands
Phone: +31 346 214290; Fax: +31 346 214286
GNU Fortran: http://gcc.gnu.org/onlinedocs/g77_news.html


More information about the Gcc-patches mailing list