Upgrade to the 1997/02/26 version.

lib/libF77/F77_aloc.c

@@ -23,7 +23,7 @@ F77_aloc(integer Len, char *whence)
 	char *rv;
 	unsigned int uLen = (unsigned int) Len;	/* for K&R C */
 
-	if (!(rv = malloc(uLen))) {
+	if (!(rv = (char*)malloc(uLen))) {
 		fprintf(stderr, "malloc(%u) failure in %s\n",
 			uLen, whence);
 		exit_(&memfailure);

lib/libF77/README

@@ -31,7 +31,7 @@ To check for transmission errors, issue the command
 This assumes you have the xsum program whose source, xsum.c,
 is distributed as part of "all from f2c/src".  If you do not
 have xsum, you can obtain xsum.c by sending the following E-mail
-message to netlib@research.att.com
+message to netlib@netlib.bell-labs.com
 	send xsum.c from f2c/src
 
 The makefile assumes you have installed f2c.h in a standard
@@ -82,10 +82,11 @@ external Fortran routines.
 	cmd to the system's command processor (on systems where
 	this can be done).
 
-The makefile does not attempt to compile pow_qq.c, which is meant
+The makefile does not attempt to compile pow_qq.c, qbitbits.c,
-for use with INTEGER*8.  To use it, you must modify f2c.h to
+and qbitshft.c, which are meant for use with INTEGER*8.  To use
-declare longint appropriately; then add pow_qq.o to the POW =
+INTEGER*8, you must modify f2c.h to declare longint and ulongint
-line in the makefile.
+appropriately; then add pow_qq.o to the POW = line in the makefile,
+and add " qbitbits.o qbitshft.o" to the makefile's F90BIT = line.
 
 Following Fortran 90, s_cat.c and s_copy.c allow the target of a
 (character string) assignment to be appear on its right-hand, at
@@ -94,3 +95,14 @@ If you prefer the  extra efficiency that comes with the Fortran 77
 requirement that the left-hand side of a character assignment not
 be involved in the right-hand side, compile s_cat.c and s_copy.c
 with -DNO_OVERWRITE .
+
+If your system lacks a ranlib command, you don't need it.
+Either comment out the makefile's ranlib invocation, or install
+a harmless "ranlib" command somewhere in your PATH, such as the
+one-line shell script
+
+	exit 0
+
+or (on some systems)
+
+	exec /usr/bin/ar lts $1 >/dev/null

lib/libF77/Version.c

@@ -1,4 +1,4 @@
-static char junk[] = "\n@(#)LIBF77 VERSION 2.01 6 Sept. 1995\n";
+static char junk[] = "\n@(#)LIBF77 VERSION 19970226\n";
 
 /*
 2.00	11 June 1980.  File version.c added to library.
@@ -38,4 +38,12 @@ static char junk[] = "\n@(#)LIBF77 VERSION 2.01 6 Sept. 1995\n";
 	30 May 1995:  added subroutine exit(rc) integer rc. Version not changed.
 	29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c.
 	6 Sept. 1995: fix return type of system_ under -DKR_headers.
+	19 Dec. 1995: s_cat.c: fix bug when 2nd or later arg overlaps lhs.
+	19 Mar. 1996: s_cat.c: supply missing break after overlap detection.
+	13 May 1996:  add [lq]bitbits.c and [lq]bitshft.c (f90 bit intrinsics).
+	19 June 1996: add casts to unsigned in [lq]bitshft.c.
+	26 Feb. 1997: adjust functions with a complex output argument
+			to permit aliasing it with input arguments.
+			(For now, at least, this is just for possible
+			benefit of g77.)
 */

lib/libF77/abort_.c

@@ -12,5 +12,7 @@ int abort_(void)
 #endif
 {
 sig_die("Fortran abort routine called", 1);
+#ifdef __cplusplus
 return 0;
+#endif
 }

lib/libF77/c_cos.c

@@ -11,6 +11,7 @@ VOID c_cos(r, z) complex *r, *z;
 void c_cos(complex *r, complex *z)
 #endif
 {
-r->r = cos(z->r) * cosh(z->i);
+	double zr = z->r;
-r->i = - sin(z->r) * sinh(z->i);
+	r->r =   cos(zr) * cosh(z->i);
-}
+	r->i = - sin(zr) * sinh(z->i);
+	}

lib/libF77/c_div.c

@@ -9,28 +9,29 @@ extern void sig_die(char*,int);
 void c_div(complex *c, complex *a, complex *b)
 #endif
 {
-double ratio, den;
+	double ratio, den;
-double abr, abi;
+	double abr, abi;
+	double ai = a->i, ar = a->r, bi = b->i, br = b->r;
 
-if( (abr = b->r) < 0.)
+	if( (abr = br) < 0.)
-	abr = - abr;
+		abr = - abr;
-if( (abi = b->i) < 0.)
+	if( (abi = bi) < 0.)
-	abi = - abi;
+		abi = - abi;
-if( abr <= abi )
+	if( abr <= abi )
-	{
+		{
-	if(abi == 0)
+		if(abi == 0)
-		sig_die("complex division by zero", 1);
+			sig_die("complex division by zero", 1);
-	ratio = (double)b->r / b->i ;
+		ratio = (double)br / bi ;
-	den = b->i * (1 + ratio*ratio);
+		den = bi * (1 + ratio*ratio);
-	c->r = (a->r*ratio + a->i) / den;
+		c->r = (ar*ratio + ai) / den;
-	c->i = (a->i*ratio - a->r) / den;
+		c->i = (ai*ratio - ar) / den;
-	}
+		}
 
-else
+	else
-	{
+		{
-	ratio = (double)b->i / b->r ;
+		ratio = (double)bi / br ;
-	den = b->r * (1 + ratio*ratio);
+		den = br * (1 + ratio*ratio);
-	c->r = (a->r + a->i*ratio) / den;
+		c->r = (ar + ai*ratio) / den;
-	c->i = (a->i - a->r*ratio) / den;
+		c->i = (ai - ar*ratio) / den;
+		}
 	}
-}

lib/libF77/c_log.c

@@ -11,6 +11,7 @@ extern double f__cabs(double, double);
 void c_log(complex *r, complex *z)
 #endif
 {
-r->i = atan2(z->i, z->r);
+	double zi;
-r->r = log( f__cabs(z->r, z->i) );
+	r->i = atan2(zi = z->i, z->r);
-}
+	r->r = log( f__cabs(z->r, zi) );
+	}

lib/libF77/c_sin.c

@@ -11,6 +11,7 @@ VOID c_sin(r, z) complex *r, *z;
 void c_sin(complex *r, complex *z)
 #endif
 {
-r->r = sin(z->r) * cosh(z->i);
+	double zr = z->r;
-r->i = cos(z->r) * sinh(z->i);
+	r->r = sin(zr) * cosh(z->i);
-}
+	r->i = cos(zr) * sinh(z->i);
+	}

lib/libF77/c_sqrt.c

@@ -12,23 +12,24 @@ extern double f__cabs(double, double);
 void c_sqrt(complex *r, complex *z)
 #endif
 {
-double mag, t;
+	double mag, t;
+	double zi = z->i, zr = z->r;
 
-if( (mag = f__cabs(z->r, z->i)) == 0.)
+	if( (mag = f__cabs(zr, zi)) == 0.)
-	r->r = r->i = 0.;
+		r->r = r->i = 0.;
-else if(z->r > 0)
+	else if(zr > 0)
-	{
+		{
-	r->r = t = sqrt(0.5 * (mag + z->r) );
+		r->r = t = sqrt(0.5 * (mag + zr) );
-	t = z->i / t;
+		t = zi / t;
-	r->i = 0.5 * t;
+		r->i = 0.5 * t;
+		}
+	else
+		{
+		t = sqrt(0.5 * (mag - zr) );
+		if(zi < 0)
+			t = -t;
+		r->i = t;
+		t = zi / t;
+		r->r = 0.5 * t;
+		}
 	}
-else
-	{
-	t = sqrt(0.5 * (mag - z->r) );
-	if(z->i < 0)
-		t = -t;
-	r->i = t;
-	t = z->i / t;
-	r->r = 0.5 * t;
-	}
-}

lib/libF77/ef1asc_.c

@@ -8,12 +8,14 @@
 
 #ifdef KR_headers
 extern VOID s_copy();
-int ef1asc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb;
+ef1asc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb;
 #else
 extern void s_copy(char*,char*,ftnlen,ftnlen);
 int ef1asc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb)
 #endif
 {
 s_copy( (char *)a, (char *)b, EVEN(*la), *lb );
+#ifdef __cplusplus
 return 0;
+#endif
 }

lib/libF77/exit.c

@@ -1,37 +0,0 @@
-/* This gives the effect of
-
-	subroutine exit(rc)
-	integer*4 rc
-	stop
-	end
-
- * with the added side effect of supplying rc as the program's exit code.
- */
-
-#include "f2c.h"
-#undef abs
-#undef min
-#undef max
-#ifndef KR_headers
-#include "stdlib.h"
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern void f_exit(void);
-#endif
-
- void
-#ifdef KR_headers
-exit_(rc) integer *rc;
-#else
-exit_(integer *rc)
-#endif
-{
-#ifdef NO_ONEXIT
-	f_exit();
-#endif
-	exit(*rc);
-	}
-#ifdef __cplusplus
-}
-#endif

lib/libF77/f2ch.add

@@ -150,7 +150,7 @@ extern integer s_wsni(icilist *);
 extern integer s_wsue(cilist *);
 extern void sig_die(char *, int);
 extern integer signal_(integer *, void (*)(int));
-extern int system_(char *, ftnlen);
+extern integer system_(char *, ftnlen);
 extern double z_abs(doublecomplex *);
 extern void z_cos(doublecomplex *, doublecomplex *);
 extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *);

lib/libF77/getenv_.c

@@ -30,7 +30,7 @@ for(fp = fname ; fp < flast ; ++fp)
 		break;
 		}
 
-while ( (ep = *env++) )
+while (ep = *env++)
 	{
 	for(fp = fname; fp<flast ; )
 		if(*fp++ != *ep++)

lib/libF77/lbitbits.c

@@ -0,0 +1,62 @@
+#include "f2c.h"
+
+#ifndef LONGBITS
+#define LONGBITS 32
+#endif
+
+ integer
+#ifdef KR_headers
+lbit_bits(a, b, len) integer a, b, len;
+#else
+lbit_bits(integer a, integer b, integer len)
+#endif
+{
+	/* Assume 2's complement arithmetic */
+
+	unsigned long x, y;
+
+	x = (unsigned long) a;
+	y = (unsigned long)-1L;
+	x >>= b;
+	y <<= len;
+	return (integer)(x & ~y);
+	}
+
+ integer
+#ifdef KR_headers
+lbit_cshift(a, b, len) integer a, b, len;
+#else
+lbit_cshift(integer a, integer b, integer len)
+#endif
+{
+	unsigned long x, y, z;
+
+	x = (unsigned long)a;
+	if (len <= 0) {
+		if (len == 0)
+			return 0;
+		goto full_len;
+		}
+	if (len >= LONGBITS) {
+ full_len:
+		if (b >= 0) {
+			b %= LONGBITS;
+			return (integer)(x << b | x >> LONGBITS -b );
+			}
+		b = -b;
+		b %= LONGBITS;
+		return (integer)(x << LONGBITS - b | x >> b);
+		}
+	y = z = (unsigned long)-1;
+	y <<= len;
+	z &= ~y;
+	y &= x;
+	x &= z;
+	if (b >= 0) {
+		b %= len;
+		return (integer)(y | z & (x << b | x >> len - b));
+		}
+	b = -b;
+	b %= len;
+	return (integer)(y | z & (x >> b | x << len - b));
+	}

lib/libF77/lbitshft.c

@@ -0,0 +1,11 @@
+#include "f2c.h"
+
+ integer
+#ifdef KR_headers
+lbit_shift(a, b) integer a; integer b;
+#else
+lbit_shift(integer a, integer b)
+#endif
+{
+	return b >= 0 ? a << b : (integer)((uinteger)a >> -b);
+	}

lib/libF77/libF77.xsum

@@ -1,120 +0,0 @@
-F77_aloc.c	fc8e8844	536
-Notice	1211689a	1195
-README	1d306d9d	4130
-Version.c	f329c4b2	2060
-abort_.c	eaf90dc0	239
-c_abs.c	ecce7a47	205
-c_cos.c	f2338a46	260
-c_div.c	f780c50e	665
-c_exp.c	e1b005d5	270
-c_log.c	4050533	292
-c_sin.c	f19855c9	258
-c_sqrt.c	4e1ad71	505
-cabs.c	abac46c	427
-d_abs.c	ed70186c	151
-d_acos.c	e5d8cdee	178
-d_asin.c	f1c92f52	178
-d_atan.c	fe8cfd3f	178
-d_atn2.c	fa5f66a9	204
-d_cnjg.c	16aaf72f	165
-d_cos.c	f37be16	174
-d_cosh.c	a2f7dcf	178
-d_dim.c	1dfe4b39	165
-d_exp.c	fb0efb6d	174
-d_imag.c	ff9da248	134
-d_int.c	e10c5fc2	202
-d_lg10.c	1381342c	224
-d_log.c	ec2a8447	174
-d_mod.c	e30684f1	621
-d_nint.c	ffa7895c	214
-d_prod.c	e3b5d46a	140
-d_sign.c	1782063b	199
-d_sin.c	ef24638e	174
-d_sinh.c	e0ec938a	178
-d_sqrt.c	1ff988eb	178
-d_tan.c	ffc9a88e	174
-d_tanh.c	e5e0cbbd	178
-derf_.c	fdf1917c	172
-derfc_.c	4cb5ea3	186
-ef1asc_.c	f14b3469	453
-ef1cmc_.c	1e0b86e3	360
-erf_.c	7a407d	158
-erfc_.c	fb488e22	163
-exit.c	eaf1e4de	476
-f2ch.add	fed3bb7b	6056
-getarg_.c	edcf61f8	495
-getenv_.c	eaafcc11	975
-h_abs.c	8383aa6	151
-h_dim.c	9f9a693	163
-h_dnnt.c	d754cc8	218
-h_indx.c	145ff2e8	375
-h_len.c	e85aa13f	138
-h_mod.c	feacad2a	140
-h_nint.c	eb54a855	206
-h_sign.c	e7d69d03	199
-hl_ge.c	26bca46	279
-hl_gt.c	f5426c57	278
-hl_le.c	ff67a970	279
-hl_lt.c	f8842102	278
-i_abs.c	f6c3045e	147
-i_dim.c	ae23de2	158
-i_dnnt.c	e0c7e5e4	216
-i_indx.c	19177d0c	363
-i_len.c	e32e1f92	136
-i_mod.c	8bb577c	144
-i_nint.c	e0a366e8	204
-i_sign.c	1f26e421	193
-iargc_.c	324b252	129
-l_ge.c	5b7cb55	267
-l_gt.c	ad1b388	266
-l_le.c	f5407149	267
-l_lt.c	f81a93f8	266
-main.c	1144a505	2064
-makefile	e4156396	3063
-pow_ci.c	f593b0b9	345
-pow_dd.c	e451857d	209
-pow_di.c	11a1842e	381
-pow_hh.c	e0cb1b69	422
-pow_ii.c	17c60a01	421
-pow_qq.c	ffbbdec9	449
-pow_ri.c	eacf8350	369
-pow_zi.c	fe9073e4	715
-pow_zz.c	f0e5f141	482
-r_abs.c	1a4e3da	139
-r_acos.c	ca67f96	166
-r_asin.c	188a2306	166
-r_atan.c	fadda9d5	166
-r_atn2.c	e97a5392	186
-r_cnjg.c	f1c1fd80	151
-r_cos.c	f19d771e	162
-r_cosh.c	e20187a0	166
-r_dim.c	ef5e869	147
-r_exp.c	18979beb	162
-r_imag.c	e45086cf	122
-r_int.c	f2c2f39c	190
-r_lg10.c	1279226d	212
-r_log.c	2682a0d	162
-r_mod.c	f28ec59a	611
-r_nint.c	69d11bb	202
-r_sign.c	eddb76f9	181
-r_sin.c	10007227	162
-r_sinh.c	f21a38b8	166
-r_sqrt.c	f24b8aa4	166
-r_tan.c	e60b7778	162
-r_tanh.c	f22ec5c	166
-s_cat.c	151033e2	1304
-s_cmp.c	ff4f2982	655
-s_copy.c	e10dd76f	957
-s_paus.c	e726a719	1552
-s_rnge.c	1d6cada2	680
-s_stop.c	1f5aaac8	511
-sig_die.c	e934624a	634
-signal_.c	fde97f5f	395
-system_.c	e4ed54ab	579
-z_abs.c	f71a28c1	201
-z_cos.c	110bc444	269
-z_div.c	ff56b823	675
-z_exp.c	ced892b	278
-z_log.c	4ea97f4	305
-z_sin.c	1215f0b4	267
-z_sqrt.c	e8d24b0	492

lib/libF77/main.c

@@ -1,7 +1,7 @@
 /* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
 
 #include "stdio.h"
-#include "signal.h"
+#include "signal1.h"
 
 #ifndef SIGIOT
 #ifdef SIGABRT
@@ -90,7 +90,10 @@ sig_die("Trace trap", 1);
 int xargc;
 char **xargv;
 
-int
+#ifdef __cplusplus
+	}
+#endif
+
 #ifdef KR_headers
 main(argc, argv) int argc; char **argv;
 #else
@@ -99,20 +102,20 @@ main(int argc, char **argv)
 {
 xargc = argc;
 xargv = argv;
-signal(SIGFPE, sigfdie);	/* ignore underflow, enable overflow */
+signal1(SIGFPE, sigfdie);	/* ignore underflow, enable overflow */
 #ifdef SIGIOT
-signal(SIGIOT, sigidie);
+signal1(SIGIOT, sigidie);
 #endif
 #ifdef SIGTRAP
-signal(SIGTRAP, sigtrdie);
+signal1(SIGTRAP, sigtrdie);
 #endif
 #ifdef SIGQUIT
-if(signal(SIGQUIT,sigqdie) == SIG_IGN)
+if(signal1(SIGQUIT,sigqdie) == SIG_IGN)
-	signal(SIGQUIT, SIG_IGN);
+	signal1(SIGQUIT, SIG_IGN);
 #endif
-if(signal(SIGINT, sigindie) == SIG_IGN)
+if(signal1(SIGINT, sigindie) == SIG_IGN)
-	signal(SIGINT, SIG_IGN);
+	signal1(SIGINT, SIG_IGN);
-signal(SIGTERM,sigtdie);
+signal1(SIGTERM,sigtdie);
 
 #ifdef pdp11
 	ldfps(01200); /* detect overflow as an exception */
@@ -130,6 +133,3 @@ exit(0);	/* exit(0) rather than return(0) to bypass Cray bug */
 return 0;	/* For compilers that complain of missing return values; */
 		/* others will complain that this is unreachable code. */
 }
-#ifdef __cplusplus
-	}
-#endif

lib/libF77/makefile

@@ -1,78 +0,0 @@
-.SUFFIXES: .c .o
-CC = cc
-SHELL = /bin/sh
-CFLAGS = -O
-
-# If your system lacks onexit() and you are not using an
-# ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS,
-# e.g., by changing the above "CFLAGS =" line to
-# CFLAGS = -O -DNO_ONEXIT
-
-# On at least some Sun systems, it is more appropriate to change the
-# "CFLAGS =" line to
-# CFLAGS = -O -Donexit=on_exit
-
-# compile, then strip unnecessary symbols
-.c.o:
-	$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
-	ld -r -x -o $*.xxx $*.o
-	mv $*.xxx $*.o
-
-MISC =	F77_aloc.o Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o \
-	getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\
-	derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit.o
-POW =	pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o  pow_ri.o pow_zi.o pow_zz.o
-CX =	c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
-DCX =	z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
-REAL =	r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\
-	r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\
-	r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\
-	r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o
-DBL =	d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\
-	d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\
-	d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\
-	d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\
-	d_sqrt.o d_tan.o d_tanh.o
-INT =	i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o
-HALF =	h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o  h_nint.o h_sign.o
-CMP =	l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o
-EFL =	ef1asc_.o ef1cmc_.o
-CHAR =	s_cat.o s_cmp.o s_copy.o
-
-libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
-	$(HALF) $(CMP) $(EFL) $(CHAR)
-	ar r libF77.a $?
-	ranlib libF77.a
-
-Version.o: Version.c
-	$(CC) -c Version.c
-
-# To compile with C++, first "make f2c.h"
-f2c.h: f2ch.add
-	cat /usr/include/f2c.h f2ch.add >f2c.h
-
-install:	libF77.a
-	mv libF77.a /usr/lib
-
-clean:
-	rm -f libF77.a *.o
-
-check:
-	xsum Notice README F77_aloc.c Version.c abort_.c c_abs.c c_cos.c \
-	c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \
-	d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \
-	d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \
-	d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \
-	derf_.c derfc_.c ef1asc_.c ef1cmc_.c erf_.c erfc_.c exit.c f2ch.add \
-	getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \
-	h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \
-	i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \
-	i_sign.c iargc_.c l_ge.c l_gt.c l_le.c l_lt.c main.c makefile \
-	pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c pow_qq.c pow_ri.c \
-	pow_zi.c pow_zz.c r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \
-	r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \
-	r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \
-	r_tan.c r_tanh.c s_cat.c s_cmp.c s_copy.c \
-	s_paus.c s_rnge.c s_stop.c sig_die.c signal_.c system_.c \
-	z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >zap
-	cmp zap libF77.xsum && rm zap || diff libF77.xsum zap

lib/libF77/pow_zi.c

@@ -8,44 +8,47 @@ extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*);
 void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) 	/* p = a**b  */
 #endif
 {
-integer n;
+	integer n;
-unsigned long u;
+	unsigned long u;
-double t;
+	double t;
-doublecomplex x;
+	doublecomplex q, x;
-static doublecomplex one = {1.0, 0.0};
+	static doublecomplex one = {1.0, 0.0};
 
-n = *b;
+	n = *b;
-p->r = 1;
+	q.r = 1;
-p->i = 0;
+	q.i = 0;
 
-if(n == 0)
+	if(n == 0)
-	return;
+		goto done;
-if(n < 0)
+	if(n < 0)
-	{
-	n = -n;
-	z_div(&x, &one, a);
-	}
-else
-	{
-	x.r = a->r;
-	x.i = a->i;
-	}
-
-for(u = n; ; )
-	{
-	if(u & 01)
 		{
-		t = p->r * x.r - p->i * x.i;
+		n = -n;
-		p->i = p->r * x.i + p->i * x.r;
+		z_div(&x, &one, a);
-		p->r = t;
-		}
-	if(u >>= 1)
-		{
-		t = x.r * x.r - x.i * x.i;
-		x.i = 2 * x.r * x.i;
-		x.r = t;
 		}
 	else
-		break;
+		{
+		x.r = a->r;
+		x.i = a->i;
+		}
+
+	for(u = n; ; )
+		{
+		if(u & 01)
+			{
+			t = q.r * x.r - q.i * x.i;
+			q.i = q.r * x.i + q.i * x.r;
+			q.r = t;
+			}
+		if(u >>= 1)
+			{
+			t = x.r * x.r - x.i * x.i;
+			x.i = 2 * x.r * x.i;
+			x.r = t;
+			}
+		else
+			break;
+		}
+ done:
+	p->i = q.i;
+	p->r = q.r;
 	}
-}

lib/libF77/s_cat.c

@@ -12,6 +12,8 @@
  extern void free();
  extern void exit_();
 #else
+#undef min
+#undef max
 #include "stdlib.h"
  extern char *F77_aloc(ftnlen, char*);
 #endif
@@ -49,7 +51,9 @@ s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll)
 			}
 		lp0 = lp;
 		lp = lp1 = F77_aloc(L = ll, "s_cat");
+		break;
 		}
+	lp1 = lp;
 #endif /* NO_OVERWRITE */
 	for(i = 0 ; i < n ; ++i) {
 		nc = ll;

lib/libF77/s_paus.c

@@ -12,7 +12,7 @@
 #undef min
 #undef max
 #include "stdlib.h"
-#include "signal.h"
+#include "signal1.h"
 #ifdef __cplusplus
 extern "C" {
 #endif
@@ -74,7 +74,7 @@ s_paus(char *s, ftnlen n)
 		fprintf(stderr,
 		"To resume execution, execute a   kill -%d %d   command\n",
 			PAUSESIG, getpid() );
-		signal(PAUSESIG, waitpause);
+		signal1(PAUSESIG, waitpause);
 		fflush(stderr);
 		pause();
 #endif

lib/libF77/s_rnge.c

@@ -20,5 +20,7 @@ fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1
 while((i = *varn) && i != ' ')
 	putc(*varn++, stderr);
 sig_die(".", 1);
+#ifdef __cplusplus
 return 0;
+#endif
 }

lib/libF77/signal1.h

@@ -0,0 +1,25 @@
+/* You may need to adjust the definition of signal1 to supply a */
+/* cast to the correct argument type.  This detail is system- and */
+/* compiler-dependent.   The #define below assumes signal.h declares */
+/* type SIG_PF for the signal function's second argument. */
+
+#include <signal.h>
+
+#ifndef Sigret_t
+#define Sigret_t void
+#endif
+#ifndef Sigarg_t
+#ifdef KR_headers
+#define Sigarg_t
+#else
+#define Sigarg_t int
+#endif
+#endif /*Sigarg_t*/
+
+#ifdef USE_SIG_PF	/* compile with -DUSE_SIG_PF under IRIX */
+#define sig_pf SIG_PF
+#else
+typedef Sigret_t (*sig_pf)(Sigarg_t);
+#endif
+
+#define signal1(a,b) signal(a,(sig_pf)b)

lib/libF77/signal_.c

@@ -1,21 +1,19 @@
 #include "f2c.h"
 
 #ifdef KR_headers
-typedef VOID (*sig_type)();
+typedef VOID (*sig_pf)();
-extern sig_type signal();
+extern sig_pf signal();
-typedef int (*sig_proc)();
+#define signal1 signal
 
-ftnint signal_(sigp, proc) integer *sigp; sig_type proc;
+ftnint signal_(sigp, proc) integer *sigp; sig_pf proc;
 #else
-#include "signal.h"
+#include "signal1.h"
-typedef void (*sig_type)(int);
-typedef int (*sig_proc)(int);
 
-ftnint signal_(integer *sigp, sig_proc proc)
+ftnint signal_(integer *sigp, sig_pf proc)
 #endif
 {
 	int sig;
 	sig = (int)*sigp;
 
-	return (ftnint)signal(sig, (sig_type)proc);
+	return (ftnint)signal(sig, proc);
 	}

lib/libF77/z_cos.c

@@ -9,6 +9,7 @@ VOID z_cos(r, z) doublecomplex *r, *z;
 void z_cos(doublecomplex *r, doublecomplex *z)
 #endif
 {
-r->r = cos(z->r) * cosh(z->i);
+	double zr = z->r;
-r->i = - sin(z->r) * sinh(z->i);
+	r->r =   cos(zr) * cosh(z->i);
-}
+	r->i = - sin(zr) * sinh(z->i);
+	}

lib/libF77/z_div.c

@@ -8,29 +8,29 @@ extern void sig_die(char*, int);
 void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b)
 #endif
 {
-double ratio, den;
+	double ratio, den;
-double abr, abi;
+	double abr, abi;
+	double ai = a->i, ar = a->r, bi = b->i, br = b->r;
 
-if( (abr = b->r) < 0.)
+	if( (abr = br) < 0.)
-	abr = - abr;
+		abr = - abr;
-if( (abi = b->i) < 0.)
+	if( (abi = bi) < 0.)
-	abi = - abi;
+		abi = - abi;
-if( abr <= abi )
+	if( abr <= abi )
-	{
+		{
-	if(abi == 0)
+		if(abi == 0)
-		sig_die("complex division by zero", 1);
+			sig_die("complex division by zero", 1);
-	ratio = b->r / b->i ;
+		ratio = br / bi ;
-	den = b->i * (1 + ratio*ratio);
+		den = bi * (1 + ratio*ratio);
-	c->r = (a->r*ratio + a->i) / den;
+		c->r = (ar*ratio + ai) / den;
-	c->i = (a->i*ratio - a->r) / den;
+		c->i = (ai*ratio - ar) / den;
+		}
+
+	else
+		{
+		ratio = bi / br ;
+		den = br * (1 + ratio*ratio);
+		c->r = (ar + ai*ratio) / den;
+		c->i = (ai - ar*ratio) / den;
+		}
 	}
-
-else
-	{
-	ratio = b->i / b->r ;
-	den = b->r * (1 + ratio*ratio);
-	c->r = (a->r + a->i*ratio) / den;
-	c->i = (a->i - a->r*ratio) / den;
-	}
-
-}

lib/libF77/z_log.c

@@ -10,7 +10,7 @@ extern double f__cabs(double, double);
 void z_log(doublecomplex *r, doublecomplex *z)
 #endif
 {
-
+	double zi = z->i;
-r->i = atan2(z->i, z->r);
+	r->i = atan2(zi, z->r);
-r->r = log( f__cabs( z->r, z->i ) );
+	r->r = log( f__cabs( z->r, zi ) );
-}
+	}

lib/libF77/z_sin.c

@@ -9,6 +9,7 @@ VOID z_sin(r, z) doublecomplex *r, *z;
 void z_sin(doublecomplex *r, doublecomplex *z)
 #endif
 {
-r->r = sin(z->r) * cosh(z->i);
+	double zr = z->r;
-r->i = cos(z->r) * sinh(z->i);
+	r->r = sin(zr) * cosh(z->i);
-}
+	r->i = cos(zr) * sinh(z->i);
+	}

lib/libF77/z_sqrt.c

@@ -10,20 +10,20 @@ extern double f__cabs(double, double);
 void z_sqrt(doublecomplex *r, doublecomplex *z)
 #endif
 {
-double mag;
+	double mag, zi = z->i, zr = z->r;
 
-if( (mag = f__cabs(z->r, z->i)) == 0.)
+	if( (mag = f__cabs(zr, zi)) == 0.)
-	r->r = r->i = 0.;
+		r->r = r->i = 0.;
-else if(z->r > 0)
+	else if(zr > 0)
-	{
+		{
-	r->r = sqrt(0.5 * (mag + z->r) );
+		r->r = sqrt(0.5 * (mag + zr) );
-	r->i = z->i / r->r / 2;
+		r->i = zi / r->r / 2;
+		}
+	else
+		{
+		r->i = sqrt(0.5 * (mag - zr) );
+		if(zi < 0)
+			r->i = - r->i;
+		r->r = zi / r->i / 2;
+		}
 	}
-else
-	{
-	r->i = sqrt(0.5 * (mag - z->r) );
-	if(z->i < 0)
-		r->i = - r->i;
-	r->r = z->i / r->i / 2;
-	}
-}

lib/libI77/Notice

@@ -1,5 +1,5 @@
 /****************************************************************
-Copyright 1990 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990 - 1997 by AT&T Bell Laboratories and Bellcore.
 
 Permission to use, copy, modify, and distribute this software
 and its documentation for any purpose and without fee is hereby

lib/libI77/README

@@ -32,6 +32,9 @@ number of characters transmitted -- then insert the line
 
 at the end of fmt.h .  This is necessary with
 at least some versions of Sun and DEC software.
+In particular, if you get a warning about an improper
+pointer/integer combination in compiling wref.c, then
+you need to compile with -DUSE_STRLEN .
 
 If your system's fopen does not like the ANSI binary
 reading and writing modes "rb" and "wb", then you should
@@ -117,7 +120,7 @@ To check for transmission errors, issue the command
 This assumes you have the xsum program whose source, xsum.c,
 is distributed as part of "all from f2c/src".  If you do not
 have xsum, you can obtain xsum.c by sending the following E-mail
-message to netlib@research.att.com
+message to netlib@netlib.bell-labs.com
 	send xsum.c from f2c/src
 
 The makefile assumes you have installed f2c.h in a standard
@@ -134,6 +137,10 @@ not specify a file name (and does not specify STATUS='SCRATCH')
 assumes FILE='fort.n' .  You can change this by editing open.c
 and endfile.c suitably.
 
+Unless you adjust the "#define MXUNIT" line in fio.h, Fortran units
+0, 1, ..., 99 are available, i.e., the highest allowed unit number
+is MXUNIT - 1.
+
 Lines protected from compilation by #ifdef Allow_TYQUAD
 are for a possible extension to 64-bit integers in which
 integer = int = 32 bits and longint = long = 64 bits.
@@ -188,3 +195,31 @@ formatted writes of floating-point numbers of absolute value < 1 have
 a zero before the decimal point.  By default, libI77 omits such
 superfluous zeros, but you can cause them to appear by compiling
 lwrite.c, wref.c, and wrtfmt.c with -DWANT_LEAD_0 .
+
+If your system lacks a ranlib command, you don't need it.
+Either comment out the makefile's ranlib invocation, or install
+a harmless "ranlib" command somewhere in your PATH, such as the
+one-line shell script
+
+	exit 0
+
+or (on some systems)
+
+	exec /usr/bin/ar lts $1 >/dev/null
+
+Most of the routines in libI77 are support routines for Fortran
+I/O.  There are a few exceptions, summarized below -- I/O related
+functions and subroutines that appear to your program as ordinary
+external Fortran routines.
+
+1.	CALL FLUSH flushes all buffers.
+
+2.	FTELL(i) is an INTEGER function that returns the current
+	offset of Fortran unit i (or -1 if unit i is not open).
+
+3.	CALL FSEEK(i, offset, whence, *errlab) attemps to move
+	Fortran unit i to the specified offset: absolute offset
+	if whence = 0; relative to the current offset if whence = 1;
+	relative to the end of the file if whence = 2.  It branches
+	to label errlab if unit i is not open or if the call
+	otherwise fails.

lib/libI77/Version.c

@@ -1,4 +1,4 @@
-static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19950907\n";
+static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19970226\n";
 
 /*
 2.01	$ format added
@@ -95,7 +95,7 @@ wrtfmt.c:
 /* 17 Oct. 1991: change type of length field in sequential unformatted
 		 records from int to long (for systems where sizeof(int)
 		 can vary, depending on the compiler or compiler options). */
-/* 14 Nov. 1991: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c.
+/* 14 Nov. 1991: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c. */
 /* 25 Nov. 1991: change uint to Uint in lwrite.c; change sizeof(int) to
 		 sizeof(uioint) in fseeks in sue.c (missed on 17 Oct.). */
 /* 1 Dec. 1991:  uio.c: add test for read failure (seq. unformatted reads);
@@ -222,3 +222,23 @@ wrtfmt.c:
 		 namelist read statements invoke f_init if needed. */
 /* 7 Sept. 1995: Fix some bugs with -DAllow_TYQUAD (for integer*8).
 		 Add -DNo_Namelist_Comments lines to rsne.c. */
+/* 5 Oct. 1995:  wrtfmt.c: fix bug with t editing (f__cursor was not
+		 always zeroed in mv_cur). */
+/* 11 Oct. 1995: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c
+		 to err.c */
+/* 15 Mar. 1996: lread.c, rsfe.c: honor END= in READ stmt with empty iolist */
+
+/* 13 May 1996:  add ftell_.c and fseek_.c */
+/* 9 June 1996:  Adjust rsli.c and lread.c so internal list input with
+		 too few items in the input string will honor end= . */
+/* 12 Sept. 1995:fmtlib.c: fix glitch in printing the most negative integer. */
+/* 25 Sept. 1995:fmt.h: for formatted writes of negative integer*1 values,
+		 make ic signed on ANSI systems.  If formatted writes of
+		 integer*1 values trouble you when using a K&R C compiler,
+		 switch to an ANSI compiler or use a compiler flag that
+		 makes characters signed. */
+/* 9 Dec. 1996:	 d[fu]e.c, err.c: complain about non-positive rec=
+		 in direct read and write statements.
+		 ftell_.c: change param "unit" to "Unit" for -DKR_headers. */
+/* 26 Feb. 1997: ftell_.c: on systems that define SEEK_SET, etc., use
+		 SEEK_SET, SEEK_CUR, SEEK_END for *whence = 0, 1, 2. */

lib/libI77/dfe.c

@@ -2,7 +2,6 @@
 #include "fio.h"
 #include "fmt.h"
 
-int
 y_rsk(Void)
 {
 	if(f__curunit->uend || f__curunit->url <= f__recpos
@@ -12,8 +11,6 @@ y_rsk(Void)
 	} while(++f__recpos < f__curunit->url);
 	return 0;
 }
-
-int
 y_getc(Void)
 {
 	int ch;
@@ -33,10 +30,7 @@ y_getc(Void)
 		return(-1);
 	}
 	err(f__elist->cierr,errno,"readingd");
-	return 0;
 }
-
-int
 #ifdef KR_headers
 y_putc(c)
 #else
@@ -50,8 +44,6 @@ y_putc(int c)
 		err(f__elist->cierr,110,"dout");
 	return(0);
 }
-
-int
 y_rev(Void)
 {	/*what about work done?*/
 	if(f__curunit->url==1 || f__recpos==f__curunit->url)
@@ -61,17 +53,11 @@ y_rev(Void)
 	f__recpos=0;
 	return(0);
 }
-
-int
 y_err(Void)
 {
 	err(f__elist->cierr, 110, "dfe");
-#ifdef __cplusplus
-	return 0;
-#endif
 }
 
-int
 y_newrec(Void)
 {
 	if(f__curunit->url == 1 || f__recpos == f__curunit->url) {
@@ -85,7 +71,6 @@ y_newrec(Void)
 	return(1);
 }
 
-int
 #ifdef KR_headers
 c_dfe(a) cilist *a;
 #else
@@ -105,7 +90,9 @@ c_dfe(cilist *a)
 	if(!f__curunit->ufmt) err(a->cierr,102,"dfe")
 	if(!f__curunit->useek) err(a->cierr,104,"dfe")
 	f__fmtbuf=a->cifmt;
-	(void) fseek(f__cf,(long)f__curunit->url * (a->cirec-1),SEEK_SET);
+	if(a->cirec <= 0)
+		err(a->cierr,130,"dfe")
+	fseek(f__cf,(long)f__curunit->url * (a->cirec-1),SEEK_SET);
 	f__curunit->uend = 0;
 	return(0);
 }
@@ -117,8 +104,8 @@ integer s_rdfe(cilist *a)
 {
 	int n;
 	if(!f__init) f_init();
-	if( (n=c_dfe(a)) )return(n);
 	f__reading=1;
+	if(n=c_dfe(a))return(n);
 	if(f__curunit->uwrt && f__nowreading(f__curunit))
 		err(a->cierr,errno,"read start");
 	f__getn = y_getc;
@@ -139,8 +126,8 @@ integer s_wdfe(cilist *a)
 {
 	int n;
 	if(!f__init) f_init();
-	if( (n=c_dfe(a)) ) return(n);
 	f__reading=0;
+	if(n=c_dfe(a)) return(n);
 	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
 		err(a->cierr,errno,"startwrt");
 	f__putn = y_putc;

lib/libI77/due.c

@@ -1,7 +1,6 @@
 #include "f2c.h"
 #include "fio.h"
 
-int
 #ifdef KR_headers
 c_due(a) cilist *a;
 #else
@@ -20,7 +19,9 @@ c_due(cilist *a)
 	if(f__curunit->ufmt) err(a->cierr,102,"cdue")
 	if(!f__curunit->useek) err(a->cierr,104,"cdue")
 	if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue")
-	(void) fseek(f__cf,(long)(a->cirec-1)*f__curunit->url,SEEK_SET);
+	if(a->cirec <= 0)
+		err(a->cierr,130,"due")
+	fseek(f__cf,(long)(a->cirec-1)*f__curunit->url,SEEK_SET);
 	f__curunit->uend = 0;
 	return(0);
 }
@@ -31,8 +32,8 @@ integer s_rdue(cilist *a)
 #endif
 {
 	int n;
-	if( (n=c_due(a)) ) return(n);
 	f__reading=1;
+	if(n=c_due(a)) return(n);
 	if(f__curunit->uwrt && f__nowreading(f__curunit))
 		err(a->cierr,errno,"read start");
 	return(0);
@@ -44,8 +45,8 @@ integer s_wdue(cilist *a)
 #endif
 {
 	int n;
-	if( (n=c_due(a)) ) return(n);
 	f__reading=0;
+	if(n=c_due(a)) return(n);
 	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
 		err(a->cierr,errno,"write start");
 	return(0);
@@ -54,7 +55,7 @@ integer e_rdue(Void)
 {
 	if(f__curunit->url==1 || f__recpos==f__curunit->url)
 		return(0);
-	(void) fseek(f__cf,(long)(f__curunit->url-f__recpos),SEEK_CUR);
+	fseek(f__cf,(long)(f__curunit->url-f__recpos),SEEK_CUR);
 	if(ftell(f__cf)%f__curunit->url)
 		err(f__elist->cierr,200,"syserr");
 	return(0);

lib/libI77/endfile.c

@@ -43,7 +43,7 @@ integer f_end(alist *a)
 		(void) sprintf(nbuf,"fort.%ld",a->aunit);
 #ifdef NON_UNIX_STDIO
 		{ FILE *tf;
-			if ( (tf = fopen(nbuf, f__w_mode[0])) )
+			if (tf = fopen(nbuf, f__w_mode[0]))
 				fclose(tf);
 			}
 #else
@@ -63,7 +63,7 @@ copy(from, len, to) char *from, *to; register long len;
 copy(FILE *from, register long len, FILE *to)
 #endif
 {
-	int len1;
+	int k, len1;
 	char buf[BUFSIZ];
 
 	while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) {

lib/libI77/err.c

@@ -21,6 +21,7 @@ extern char *malloc();
 unit f__units[MXUNIT];	/*unit table*/
 flag f__init;	/*0 on entry, 1 after initializations*/
 cilist *f__elist;	/*active external io list*/
+icilist *f__svic;	/*active internal io list*/
 flag f__reading;	/*1 if reading, 0 if writing*/
 flag f__cplus,f__cblank;
 char *f__fmtbuf;
@@ -39,7 +40,8 @@ flag f__formatted;	/*1 if formatted io, 0 if unformatted*/
 FILE *f__cf;	/*current file*/
 unit *f__curunit;	/*current unit*/
 int f__recpos;	/*place in current record*/
-int f__cursor,f__scale;
+int f__cursor, f__hiwater, f__scale;
+char *f__icptr;
 
 /*error messages*/
 char *F_err[] =
@@ -73,14 +75,15 @@ char *F_err[] =
 	"can't read file",				/* 126 */
 	"can't write file",				/* 127 */
 	"'new' file exists",				/* 128 */
-	"can't append to file"				/* 129 */
+	"can't append to file",				/* 129 */
+	"non-positive record number"			/* 130 */
 };
 #define MAXERR (sizeof(F_err)/sizeof(char *)+100)
 
 #ifdef KR_headers
-int f__canseek(f) FILE *f; /*SYSDEP*/
+f__canseek(f) FILE *f; /*SYSDEP*/
 #else
-int f__canseek(FILE *f) /*SYSDEP*/
+f__canseek(FILE *f) /*SYSDEP*/
 #endif
 {
 #ifdef NON_UNIX_STDIO
@@ -187,9 +190,9 @@ f_init(Void)
 	p->uwrt=1;
 }
 #ifdef KR_headers
-int f__nowreading(x) unit *x;
+f__nowreading(x) unit *x;
 #else
-int f__nowreading(unit *x)
+f__nowreading(unit *x)
 #endif
 {
 	long loc;
@@ -210,9 +213,9 @@ int f__nowreading(unit *x)
 	return(0);
 }
 #ifdef KR_headers
-int f__nowwriting(x) unit *x;
+f__nowwriting(x) unit *x;
 #else
-int f__nowwriting(unit *x)
+f__nowwriting(unit *x)
 #endif
 {
 	long loc;

lib/libI77/f2ch.add

@@ -150,7 +150,7 @@ extern integer s_wsni(icilist *);
 extern integer s_wsue(cilist *);
 extern void sig_die(char *, int);
 extern integer signal_(integer *, void (*)(int));
-extern int system_(char *, ftnlen);
+extern integer system_(char *, ftnlen);
 extern double z_abs(doublecomplex *);
 extern void z_cos(doublecomplex *, doublecomplex *);
 extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *);

lib/libI77/fio.h

@@ -80,8 +80,8 @@ extern int (*f__doend)(Void);
 extern FILE *f__cf;	/*current file*/
 extern unit *f__curunit;	/*current unit*/
 extern unit f__units[];
-#define err(f,m,s) {if( (f) ) errno=(m); else f__fatal((m),(s)); return((m));}
+#define err(f,m,s) {if(f) errno= m; else f__fatal(m,s); return(m);}
-#define errfl(f,m,s) return err__fl((int)(f),(m),(s))
+#define errfl(f,m,s) return err__fl((int)f,m,s)
 
 /*Table sizes*/
 #define MXUNIT 100
@@ -99,4 +99,4 @@ extern int f__hiwater;	/* so TL doesn't confuse us */
 #define EXT	7
 #define INT	8
 
-#define buf_end(x) ((x)->_flag & _IONBF ? (x)->_ptr : (x)->_base + BUFSIZ)
+#define buf_end(x) (x->_flag & _IONBF ? x->_ptr : x->_base + BUFSIZ)

lib/libI77/fmt.c

@@ -40,9 +40,9 @@ char *ap_end(char *s)
 	/*NOTREACHED*/ return 0;
 }
 #ifdef KR_headers
-int op_gen(a,b,c,d)
+op_gen(a,b,c,d)
 #else
-int op_gen(int a, int b, int c, int d)
+op_gen(int a, int b, int c, int d)
 #endif
 {	struct syl *p= &f__syl[f__pc];
 	if(f__pc>=SYLMX)
@@ -99,9 +99,9 @@ char *f_s(char *s, int curloc)
 	return(s);
 }
 #ifdef KR_headers
-int ne_d(s,p) char *s,**p;
+ne_d(s,p) char *s,**p;
 #else
-int ne_d(char *s, char **p)
+ne_d(char *s, char **p)
 #endif
 {	int n,x,sign=0;
 	struct syl *sp;
@@ -185,9 +185,9 @@ int ne_d(char *s, char **p)
 	return(1);
 }
 #ifdef KR_headers
-int e_d(s,p) char *s,**p;
+e_d(s,p) char *s,**p;
 #else
-int e_d(char *s, char **p)
+e_d(char *s, char **p)
 #endif
 {	int i,im,n,w,d,e,found=0,x=0;
 	char *sv=s;
@@ -333,9 +333,9 @@ char *f_list(char *s)
 }
 
 #ifdef KR_headers
-int pars_f(s) char *s;
+pars_f(s) char *s;
 #else
-int pars_f(char *s)
+pars_f(char *s)
 #endif
 {
 	f__parenlvl=f__revloc=f__pc=0;
@@ -350,9 +350,9 @@ int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp;
 flag f__workdone, f__nonl;
 
 #ifdef KR_headers
-int type_f(n)
+type_f(n)
 #else
-int type_f(int n)
+type_f(int n)
 #endif
 {
 	switch(n)
@@ -476,8 +476,6 @@ loop:	switch(type_f((p= &f__syl[f__pc])->op))
 	}
 	return(0);
 }
-
-int
 en_fio(Void)
 {	ftnint one=1;
 	return(do_fio(&one,(char *)NULL,(ftnint)0));

lib/libI77/fmt.h

@@ -45,7 +45,10 @@ typedef union
 } ufloat;
 typedef union
 {	short is;
-	char ic;
+#ifndef KR_headers
+	signed
+#endif
+		char ic;
 	integer il;
 #ifdef Allow_TYQUAD
 	longint ili;

lib/libI77/fmtlib.c

@@ -5,6 +5,8 @@
 #ifndef Allow_TYQUAD
 #undef longint
 #define longint long
+#undef ulongint
+#define ulongint unsigned long
 #endif
 
 #ifdef KR_headers
@@ -13,13 +15,17 @@ char *f__icvt(value,ndigit,sign, base) longint value; int *ndigit,*sign;
 #else
 char *f__icvt(longint value, int *ndigit, int *sign, int base)
 #endif
-{	static char buf[MAXINTLENGTH+1];
+{
+	static char buf[MAXINTLENGTH+1];
 	register int i;
+	ulongint uvalue;
 
-	if(value > 0)
+	if(value > 0) {
+		uvalue = value;
 		*sign = 0;
+		}
 	else if (value < 0) {
-		value = -value;
+		uvalue = -value;
 		*sign = 1;
 		}
 	else {
@@ -30,10 +36,10 @@ char *f__icvt(longint value, int *ndigit, int *sign, int base)
 		}
 	i = MAXINTLENGTH;
 	do {
-		buf[--i] = (value%base) + '0';
+		buf[--i] = (uvalue%base) + '0';
-		value /= base;
+		uvalue /= base;
 		}
-		while(value > 0);
+		while(uvalue > 0);
 	*ndigit = MAXINTLENGTH - i;
 	return &buf[i];
 	}

lib/libI77/iio.c

@@ -6,8 +6,6 @@ char *f__icend;
 extern icilist *f__svic;
 int f__icnum;
 extern int f__hiwater;
-
-int
 z_getc(Void)
 {
 	if(f__recpos++ < f__svic->icirlen) {
@@ -17,9 +15,9 @@ z_getc(Void)
 	return '\n';
 }
 #ifdef KR_headers
-int z_putc(c)
+z_putc(c)
 #else
-int z_putc(int c)
+z_putc(int c)
 #endif
 {
 	if(f__icptr >= f__icend) err(f__svic->icierr,110,"inwrite");
@@ -28,8 +26,6 @@ int z_putc(int c)
 	else	err(f__svic->icierr,110,"recend");
 	return 0;
 }
-
-int
 z_rnew(Void)
 {
 	f__icptr = f__svic->iciunit + (++f__icnum)*f__svic->icirlen;
@@ -47,9 +43,9 @@ z_endp(Void)
 	}
 
 #ifdef KR_headers
-int c_si(a) icilist *a;
+c_si(a) icilist *a;
 #else
-int c_si(icilist *a)
+c_si(icilist *a)
 #endif
 {
 	f__elist = (cilist *)a;
@@ -86,7 +82,7 @@ integer s_rsfi(a) icilist *a;
 integer s_rsfi(icilist *a)
 #endif
 {	int n;
-	if( (n=c_si(a)) ) return(n);
+	if(n=c_si(a)) return(n);
 	f__reading=1;
 	f__doed=rd_ed;
 	f__doned=rd_ned;
@@ -97,7 +93,6 @@ integer s_rsfi(icilist *a)
 	return(0);
 }
 
-int
 z_wnew(Void)
 {
 	if (f__recpos < f__hiwater) {
@@ -118,7 +113,7 @@ integer s_wsfi(a) icilist *a;
 integer s_wsfi(icilist *a)
 #endif
 {	int n;
-	if( (n=c_si(a)) ) return(n);
+	if(n=c_si(a)) return(n);
 	f__reading=0;
 	f__doed=w_ed;
 	f__doned=w_ned;

lib/libI77/inquire.c

@@ -1,4 +1,3 @@
-#include <unistd.h>
 #include "f2c.h"
 #include "fio.h"
 #ifdef KR_headers
@@ -54,7 +53,7 @@ integer f_inqu(inlist *a)
 		}
 	}
 	if(a->inex!=NULL)
-		if((byfile && x != -1) || (!byfile && p!=NULL))
+		if(byfile && x != -1 || !byfile && p!=NULL)
 			*a->inex=1;
 		else *a->inex=0;
 	if(a->inopen!=NULL)
@@ -62,7 +61,7 @@ integer f_inqu(inlist *a)
 		else *a->inopen=(p!=NULL && p->ufd!=NULL);
 	if(a->innum!=NULL) *a->innum= p-f__units;
 	if(a->innamed!=NULL)
-		if(byfile || (p!=NULL && p->ufnm!=NULL))
+		if(byfile || p!=NULL && p->ufnm!=NULL)
 			*a->innamed=1;
 		else	*a->innamed=0;
 	if(a->inname!=NULL)

lib/libI77/libI77.xsum

@@ -1,41 +0,0 @@
-Notice	fd29c05f	1184
-README	ef678ce5	8578
-Version.c	367e2b0	11141
-backspace.c	e29c7ec1	1794
-close.c	175acd02	1336
-dfe.c	16facc04	2891
-dolio.c	17595b24	404
-due.c	f05f7fa6	1519
-endfile.c	12d875dc	3400
-err.c	fccb27de	6084
-f2ch.add	fed3bb7b	6056
-fio.h	e7e8a21c	2315
-fmt.c	e37e7c2a	7857
-fmt.h	7686340	1835
-fmtlib.c	f79c9df4	704
-fp.h	100fb355	665
-iio.c	fedbf0b5	2374
-ilnw.c	fa459169	1049
-inquire.c	e1059667	2536
-lio.h	a087b39	1564
-lread.c	4dfc73b	12130
-lwrite.c	19137b45	4565
-makefile	e8266f12	1972
-open.c	1ef408ec	4512
-rawio.h	b9d538d	688
-rdfmt.c	55975ac	8347
-rewind.c	87b080b	408
-rsfe.c	1d79e4a1	1415
-rsli.c	1259dfec	1748
-rsne.c	f2e2cad1	11466
-sfe.c	45a6968	793
-sue.c	ec169681	1803
-typesize.c	e5660590	319
-uio.c	fe44d524	1547
-util.c	f17978be	824
-wref.c	fbed7e10	4507
-wrtfmt.c	7a73318	8090
-wsfe.c	250d1ef	1658
-wsle.c	f74ea563	684
-wsne.c	ea4dac25	412
-xwsne.c	16641f3c	1135

lib/libI77/lread.c

@@ -67,7 +67,6 @@ extern int ungetc(int, FILE*);	/* for systems with a buggy stdio.h */
 #endif
 #endif
 
-int
 t_getc(Void)
 {	int ch;
 	if(f__curunit->uend) return(EOF);
@@ -80,7 +79,12 @@ integer e_rsle(Void)
 {
 	int ch;
 	if(f__curunit->uend) return(0);
-	while((ch=t_getc())!='\n' && ch!=EOF);
+	while((ch=t_getc())!='\n')
+		if (ch == EOF) {
+			if(feof(f__cf))
+				f__curunit->uend = l_eof = 1;
+			return EOF;
+			}
 	return(0);
 }
 
@@ -88,14 +92,14 @@ flag f__lquit;
 int f__lcount,f__ltype,nml_read;
 char *f__lchar;
 double f__lx,f__ly;
-#define ERR(x) if( (n=(x)) ) return(n)
+#define ERR(x) if(n=(x)) return(n)
 #define GETC(x) (x=(*l_getc)())
 #define Ungetc(x,y) (*l_ungetc)(x,y)
 
 #ifdef KR_headers
-int l_R(poststar) int poststar;
+l_R(poststar) int poststar;
 #else
-int l_R(int poststar)
+l_R(int poststar)
 #endif
 {
 	char s[FMAX+EXPMAXDIGS+4];
@@ -250,7 +254,6 @@ rd_count(register int ch)
 	return f__lcount <= 0;
 	}
 
-int
 l_C(Void)
 {	int ch, nml_save;
 	double lz;
@@ -287,7 +290,7 @@ l_C(Void)
 	Ungetc(ch,f__cf);
 	nml_save = nml_read;
 	nml_read = 0;
-	if ( (ch = l_R(1)) )
+	if (ch = l_R(1))
 		return ch;
 	if (!f__ltype)
 		errfl(f__elist->cierr,112,"no real part");
@@ -299,7 +302,7 @@ l_C(Void)
 	}
 	while(iswhit(GETC(ch)));
 	(void) Ungetc(ch,f__cf);
-	if ( (ch = l_R(1)) )
+	if (ch = l_R(1))
 		return ch;
 	if (!f__ltype)
 		errfl(f__elist->cierr,112,"no imaginary part");
@@ -313,8 +316,6 @@ l_C(Void)
 	nml_read = nml_save;
 	return(0);
 }
-
-int
 l_L(Void)
 {
 	int ch;
@@ -361,8 +362,6 @@ l_L(Void)
 	return(0);
 }
 #define BUFSIZE	128
-
-int
 l_CHAR(Void)
 {	int ch,size,i;
 	static char rafail[] = "realloc failure";
@@ -485,9 +484,9 @@ l_CHAR(Void)
 	}
 }
 #ifdef KR_headers
-int c_le(a) cilist *a;
+c_le(a) cilist *a;
 #else
-int c_le(cilist *a)
+c_le(cilist *a)
 #endif
 {
 	if(!f__init)
@@ -505,9 +504,9 @@ int c_le(cilist *a)
 	return(0);
 }
 #ifdef KR_headers
-int l_read(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len;
+l_read(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len;
 #else
-int l_read(ftnint *number, char *ptr, ftnlen len, ftnint type)
+l_read(ftnint *number, char *ptr, ftnlen len, ftnint type)
 #endif
 {
 #define Ptr ((flex *)ptr)
@@ -525,7 +524,7 @@ int l_read(ftnint *number, char *ptr, ftnlen len, ftnint type)
 				GETC(ch);
 				switch(ch) {
 				case EOF:
-					goto loopend;
+					err(f__elist->ciend,(EOF),"list in")
 				case ' ':
 				case '\t':
 				case '\n':
@@ -579,13 +578,9 @@ int l_read(ftnint *number, char *ptr, ftnlen len, ftnint type)
 		Ungetc(ch,f__cf);
 	loopend:
 		if(f__lquit) return(0);
-		if(f__cf) {
+		if(f__cf && ferror(f__cf)) {
-			if (feof(f__cf))
+			clearerr(f__cf);
-				err(f__elist->ciend,(EOF),"list in")
+			errfl(f__elist->cierr,errno,"list in");
-			else if(ferror(f__cf)) {
-				clearerr(f__cf);
-				errfl(f__elist->cierr,errno,"list in");
-				}
 			}
 		if(f__ltype==0) goto bump;
 		switch((int)type)
@@ -645,7 +640,7 @@ integer s_rsle(cilist *a)
 {
 	int n;
 
-	if( (n=c_le(a)) ) return(n);
+	if(n=c_le(a)) return(n);
 	f__reading=1;
 	f__external=1;
 	f__formatted=1;

lib/libI77/lwrite.c

@@ -14,9 +14,9 @@ donewrec(Void)
 	}
 
 #ifdef KR_headers
-int t_putc(c)
+t_putc(c)
 #else
-int t_putc(int c)
+t_putc(int c)
 #endif
 {
 	f__recpos++;
@@ -141,7 +141,7 @@ l_g(char *buf, double n)
 	switch(*b) {
 #ifndef WANT_LEAD_0
 		case '0':
-			while( (b[0] = b[1]) )
+			while(b[0] = b[1])
 				b++;
 			break;
 #endif
@@ -166,7 +166,7 @@ l_g(char *buf, double n)
 				while(*++b);
 				goto f__ret;
 			case 'E':
-				for(c1 = '.', c = 'E';  (*b = c1);
+				for(c1 = '.', c = 'E';  *b = c1;
 					c1 = c, c = *++b);
 				goto f__ret;
 			}
@@ -188,7 +188,7 @@ l_put(register char *s)
 #else
 	register int c, (*pn)(int) = f__putn;
 #endif
-	while( (c = *s++) )
+	while(c = *s++)
 		(*pn)(c);
 	}
 
@@ -240,9 +240,9 @@ lwrt_C(double a, double b)
 	PUT(')');
 }
 #ifdef KR_headers
-int l_write(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len;
+l_write(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len;
 #else
-int l_write(ftnint *number, char *ptr, ftnlen len, ftnint type)
+l_write(ftnint *number, char *ptr, ftnlen len, ftnint type)
 #endif
 {
 #define Ptr ((flex *)ptr)

lib/libI77/makefile

@@ -1,96 +0,0 @@
-.SUFFIXES: .c .o
-CC = cc
-CFLAGS = -O
-SHELL = /bin/sh
-
-# compile, then strip unnecessary symbols
-.c.o:
-	$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
-	ld -r -x -o $*.xxx $*.o
-	mv $*.xxx $*.o
-
-OBJ =	Version.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \
-	fmt.o fmtlib.o iio.o ilnw.o inquire.o lread.o lwrite.o open.o \
-	rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o uio.o \
-	util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o
-libI77.a:	$(OBJ)
-		ar r libI77.a $?
-		ranlib libI77.a
-install:	libI77.a
-	cp libI77.a /usr/lib/libI77.a
-	ranlib /usr/lib/libI77.a
-
-Version.o: Version.c
-	$(CC) -c Version.c
-
-# To compile with C++, first "make f2c.h"
-f2c.h: f2ch.add
-	cat /usr/include/f2c.h f2ch.add >f2c.h
-
-
-clean:
-	rm -f $(OBJ) libI77.a
-
-clobber:	clean
-	rm -f libI77.a
-
-backspace.o:	fio.h
-close.o:	fio.h
-dfe.o:		fio.h
-dfe.o:		fmt.h
-due.o:		fio.h
-endfile.o:	fio.h rawio.h
-err.o:		fio.h rawio.h
-fmt.o:		fio.h
-fmt.o:		fmt.h
-iio.o:		fio.h
-iio.o:		fmt.h
-ilnw.o:		fio.h
-ilnw.o:		lio.h
-inquire.o:	fio.h
-lread.o:	fio.h
-lread.o:	fmt.h
-lread.o:	lio.h
-lread.o:	fp.h
-lwrite.o:	fio.h
-lwrite.o:	fmt.h
-lwrite.o:	lio.h
-open.o:		fio.h rawio.h
-rdfmt.o:	fio.h
-rdfmt.o:	fmt.h
-rdfmt.o:	fp.h
-rewind.o:	fio.h
-rsfe.o:		fio.h
-rsfe.o:		fmt.h
-rsli.o:		fio.h
-rsli.o:		lio.h
-rsne.o:		fio.h
-rsne.o:		lio.h
-sfe.o:		fio.h
-sue.o:		fio.h
-uio.o:		fio.h
-util.o:		fio.h
-wref.o:		fio.h
-wref.o:		fmt.h
-wref.o:		fp.h
-wrtfmt.o:	fio.h
-wrtfmt.o:	fmt.h
-wsfe.o:		fio.h
-wsfe.o:		fmt.h
-wsle.o:		fio.h
-wsle.o:		fmt.h
-wsle.o:		lio.h
-wsne.o:		fio.h
-wsne.o:		lio.h
-xwsne.o:	fio.h
-xwsne.o:	lio.h
-xwsne.o:	fmt.h
-
-check:
-	xsum Notice README Version.c backspace.c close.c dfe.c dolio.c \
-	due.c endfile.c err.c f2ch.add fio.h fmt.c fmt.h fmtlib.c fp.h \
-	iio.c ilnw.c inquire.c lio.h lread.c lwrite.c makefile open.c \
-	rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c sfe.c sue.c \
-	typesize.c uio.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c \
-	xwsne.c >zap
-	cmp zap libI77.xsum && rm zap || diff libI77.xsum zap

lib/libI77/open.c

@@ -1,4 +1,3 @@
-#include <unistd.h>
 #ifndef NON_UNIX_STDIO
 #include "sys/types.h"
 #include "sys/stat.h"
@@ -29,9 +28,9 @@ char *f__w_mode[4] = {"wb", "w", "r+b", "r+"};
 #endif
 
 #ifdef KR_headers
-int f__isdev(s) char *s;
+f__isdev(s) char *s;
 #else
-int f__isdev(char *s)
+f__isdev(char *s)
 #endif
 {
 #ifdef NON_UNIX_STDIO
@@ -165,7 +164,7 @@ integer f_open(olist *a)
 	case 'R':
  replace:
 #ifdef NON_UNIX_STDIO
-		if ( (tf = fopen(buf,f__w_mode[0])) )
+		if (tf = fopen(buf,f__w_mode[0]))
 			fclose(tf);
 #else
 		(void) close(creat(buf, 0666));
@@ -188,9 +187,9 @@ integer f_open(olist *a)
 	else {
 		if(!(b->ufd = fopen(buf, f__r_mode[ufmt]))) {
 #ifdef NON_UNIX_STDIO
-			if ( (b->ufd = fopen(buf, f__w_mode[ufmt|2])) )
+			if (b->ufd = fopen(buf, f__w_mode[ufmt|2]))
 				b->uwrt = 2;
-			else if ( (b->ufd = fopen(buf, f__w_mode[ufmt])) )
+			else if (b->ufd = fopen(buf, f__w_mode[ufmt]))
 				b->uwrt = 1;
 			else
 #else
@@ -220,9 +219,9 @@ integer f_open(olist *a)
 	return(0);
 }
 #ifdef KR_headers
-int fk_open(seq,fmt,n) ftnint n;
+fk_open(seq,fmt,n) ftnint n;
 #else
-int fk_open(int seq, int fmt, ftnint n)
+fk_open(int seq, int fmt, ftnint n)
 #endif
 {	char nbuf[10];
 	olist a;

lib/libI77/rawio.h

@@ -1,38 +1,32 @@
 #ifdef KR_headers
-#ifndef __FreeBSD__
 extern FILE *fdopen();
-#endif
 #else
 #ifdef MSDOS
 #include "io.h"
+#ifndef WATCOM
 #define close _close
 #define creat _creat
 #define open _open
 #define read _read
 #define write _write
-#endif
+#endif /*WATCOM*/
+#endif /*MSDOS*/
 #ifdef __cplusplus
 extern "C" {
 #endif
 #ifndef MSDOS
 #ifdef OPEN_DECL
-#ifndef __FreeBSD__
 extern int creat(const char*,int), open(const char*,int);
 #endif
-#endif
-#ifndef __FreeBSD__
 extern int close(int);
 extern int read(int,void*,size_t), write(int,void*,size_t);
 extern int unlink(const char*);
-#endif
 #ifndef _POSIX_SOURCE
 #ifndef NON_UNIX_STDIO
-#ifndef __FreeBSD__
 extern FILE *fdopen(int, const char*);
 #endif
 #endif
-#endif
+#endif /*KR_HEADERS*/
-#endif
 
 extern char *mktemp(char*);
 

lib/libI77/rdfmt.c

@@ -2,6 +2,7 @@
 #include "fio.h"
 #include "fmt.h"
 #include "fp.h"
+#include "ctype.h"
 
 extern int f__cursor;
 #ifdef KR_headers
@@ -29,10 +30,10 @@ rd_Z(Uint *n, int w, ftnlen len)
 
 	if (!hex['0']) {
 		s = "0123456789";
-		while( (ch = *s++) )
+		while(ch = *s++)
 			hex[ch] = ch - '0' + 1;
 		s = "ABCDEF";
-		while( (ch = *s++) )
+		while(ch = *s++)
 			hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11;
 		}
 	s = s0 = (char *)x;
@@ -61,7 +62,7 @@ rd_Z(Uint *n, int w, ftnlen len)
 		return errno = 115;
 	w = (int)len;
 	w1 = s - s0;
-	w2 = (w1+1) >> 1;
+	w2 = w1+1 >> 1;
 	t = (char *)n;
 	if (*(char *)&one) {
 		/* little endian */
@@ -83,7 +84,7 @@ rd_Z(Uint *n, int w, ftnlen len)
 		t += i;
 		}
 	do {
-		*t = ((hex[*s0 & 0xff]-1) << 4) | (hex[s0[1] & 0xff]-1);
+		*t = hex[*s0 & 0xff]-1 << 4 | hex[s0[1] & 0xff]-1;
 		t += i;
 		s0 += 2;
 		}
@@ -154,8 +155,6 @@ rd_L(ftnint *n, int w, ftnlen len)
 	return 0;
 }
 
-#include "ctype.h"
-
  static int
 #ifdef KR_headers
 rd_F(p, w, d, len) ufloat *p; ftnlen len;
@@ -387,9 +386,9 @@ rd_POS(char *s)
 	return(1);
 }
 #ifdef KR_headers
-int rd_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
+rd_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
 #else
-int rd_ed(struct syl *p, char *ptr, ftnlen len)
+rd_ed(struct syl *p, char *ptr, ftnlen len)
 #endif
 {	int ch;
 	for(;f__cursor>0;f__cursor--) if((ch=(*f__getn)())<0) return(ch);
@@ -450,9 +449,9 @@ int rd_ed(struct syl *p, char *ptr, ftnlen len)
 	return(errno);
 }
 #ifdef KR_headers
-int rd_ned(p) struct syl *p;
+rd_ned(p) struct syl *p;
 #else
-int rd_ned(struct syl *p)
+rd_ned(struct syl *p)
 #endif
 {
 	switch(p->op)

lib/libI77/rsfe.c

@@ -3,7 +3,6 @@
 #include "fio.h"
 #include "fmt.h"
 
-int
 xrd_SL(Void)
 {	int ch;
 	if(!f__curunit->uend)
@@ -15,8 +14,6 @@ xrd_SL(Void)
 	f__cursor=f__recpos=0;
 	return(1);
 }
-
-int
 x_getc(Void)
 {	int ch;
 	if(f__curunit->uend) return(EOF);
@@ -36,15 +33,11 @@ x_getc(Void)
 	}
 	return(-1);
 }
-
-int
 x_endp(Void)
 {
-	(void) xrd_SL();
+	xrd_SL();
-	return(0);
+	return f__curunit->uend == 1 ? EOF : 0;
 }
-
-int
 x_rev(Void)
 {
 	(void) xrd_SL();
@@ -57,7 +50,7 @@ integer s_rsfe(cilist *a) /* start */
 #endif
 {	int n;
 	if(!f__init) f_init();
-	if( (n=c_sfe(a)) ) return(n);
+	if(n=c_sfe(a)) return(n);
 	f__reading=1;
 	f__sequential=1;
 	f__formatted=1;

lib/libI77/rsli.c

@@ -18,7 +18,8 @@ static int i_getc(Void)
 		z_rnew();
 		}
 	f__recpos++;
-	if(f__icptr >= f__icend) err(f__svic->iciend,(EOF),"internal read");
+	if(f__icptr >= f__icend)
+		return EOF;
 	return(*f__icptr++);
 	}
 

lib/libI77/rsne.c

@@ -29,7 +29,7 @@
  typedef struct hashtab hashtab;
 
  static hashtab *nl_cache;
- static n_nlcache;
+ static int n_nlcache;
  static hashentry **zot;
  static int colonseen;
  extern ftnlen f__typesize[];
@@ -78,7 +78,7 @@ hash(hashtab *ht, register char *s)
 	register hashentry *h;
 	char *s0 = s;
 
-	for(x = 0; (c = *s++); x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1)
+	for(x = 0; c = *s++; x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1)
 		x += c;
 	for(h = *(zot = ht->tab + x % ht->htsize); h; h = h->next)
 		if (!strcmp(s0, h->name))
@@ -99,7 +99,7 @@ mk_hashtab(Namelist *nl)
 	hashentry *he;
 
 	hashtab **x, **x0, *y;
-	for(x = &nl_cache; (y = *x); x0 = x, x = &y->next)
+	for(x = &nl_cache; y = *x; x0 = x, x = &y->next)
 		if (nl == y->nl)
 			return y;
 	if (n_nlcache >= MAX_NL_CACHE) {
@@ -151,13 +151,13 @@ nl_init(Void) {
 
 	if(!f__init)
 		f_init();
-	for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; (c = *s++); )
+	for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; )
 		Alpha[c]
 		= Alphanum[c]
 		= Alpha[c + 'a' - 'A']
 		= Alphanum[c + 'a' - 'A']
 		= c;
-	for(s = "0123456789_"; (c = *s++); )
+	for(s = "0123456789_"; c = *s++; )
 		Alphanum[c] = c;
 	}
 
@@ -180,7 +180,7 @@ getname(register char *s, int slen)
 			ch = 115;
 		errfl(f__elist->cierr, ch, "namelist read");
 		}
-	while( (*s = Alphanum[GETC(ch) & 0xff]) )
+	while(*s = Alphanum[GETC(ch) & 0xff])
 		if (s < se)
 			s++;
 	if (ch == EOF)
@@ -235,15 +235,15 @@ getdimen(int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1)
 	register int k;
 	ftnlen x2, x3;
 
-	if ( (k = getnum(chp, x1)) )
+	if (k = getnum(chp, x1))
 		return k;
 	x3 = 1;
 	if (*chp == ':') {
-		if ( (k = getnum(chp, &x2)) )
+		if (k = getnum(chp, &x2))
 			return k;
 		x2 -= *x1;
 		if (*chp == ':') {
-			if ( (k = getnum(chp, &x3)) )
+			if (k = getnum(chp, &x3))
 				return k;
 			if (!x3)
 				return 123;
@@ -291,9 +291,9 @@ print_ne(cilist *a)
  static char where0[] = "namelist read start ";
 
 #ifdef KR_headers
-int x_rsne(a) cilist *a;
+x_rsne(a) cilist *a;
 #else
-int x_rsne(cilist *a)
+x_rsne(cilist *a)
 #endif
 {
 	int ch, got1, k, n, nd, quote, readall;
@@ -340,7 +340,7 @@ int x_rsne(cilist *a)
 #endif
 		}
  have_amp:
-	if ( (ch = getname(buf,sizeof(buf))) )
+	if (ch = getname(buf,sizeof(buf)))
 		return ch;
 	nl = (Namelist *)a->cifmt;
 	if (strcmp(buf, nl->name))
@@ -392,10 +392,10 @@ int x_rsne(cilist *a)
 			case '&':
 				return 0;
 			default:
-				if ((ch <= ' ' && ch >= 0) || (ch == ','))
+				if (ch <= ' ' && ch >= 0 || ch == ',')
 					continue;
 				Ungetc(ch,f__cf);
-				if ( (ch = getname(buf,sizeof(buf))) )
+				if (ch = getname(buf,sizeof(buf)))
 					return ch;
 				goto havename;
 			}
@@ -419,8 +419,8 @@ int x_rsne(cilist *a)
 			if (!(dims = v->dims)) {
 				if (type != TYCHAR)
 					errfl(a->cierr, 122, where);
-				if ( (k = getdimen(&ch, dn, (ftnlen)size,
+				if (k = getdimen(&ch, dn, (ftnlen)size,
-						(ftnlen)size, &b)) )
+						(ftnlen)size, &b))
 					errfl(a->cierr, k, where);
 				if (ch != ')')
 					errfl(a->cierr, 115, where);
@@ -436,7 +436,7 @@ int x_rsne(cilist *a)
 			nomax = span = dims[1];
 			ivae = iva + size*nomax;
 			colonseen = 0;
-			if ( (k = getdimen(&ch, dn, size, nomax, &b)) )
+			if (k = getdimen(&ch, dn, size, nomax, &b))
 				errfl(a->cierr, k, where);
 			no = dn->extent;
 			b0 = dims[2];
@@ -447,8 +447,8 @@ int x_rsne(cilist *a)
 					errfl(a->cierr, 115, where);
 				dn1 = dn + 1;
 				span /= *dims;
-				if ( (k = getdimen(&ch, dn1, dn->delta**dims,
+				if (k = getdimen(&ch, dn1, dn->delta**dims,
-						span, &b1)) )
+						span, &b1))
 					errfl(a->cierr, k, where);
 				ex *= *dims;
 				b += b1*ex;
@@ -467,7 +467,7 @@ int x_rsne(cilist *a)
 			no1 = 1;
 			dn0 = dimens;
 			if (type == TYCHAR && ch == '(' /*)*/) {
-				if ( (k = getdimen(&ch, &substr, size, size, &b)) )
+				if (k = getdimen(&ch, &substr, size, size, &b))
 					errfl(a->cierr, k, where);
 				if (ch != ')')
 					errfl(a->cierr, 115, where);
@@ -502,7 +502,7 @@ int x_rsne(cilist *a)
 				dn1->delta -= ex;
 				}
 			}
-		else if ( (dims = v->dims) ) {
+		else if (dims = v->dims) {
 			no = no1 = dims[1];
 			ivae = iva + no*size;
 			}
@@ -522,7 +522,7 @@ int x_rsne(cilist *a)
 			else if (iva + no1*size > ivae)
 				no1 = (ivae - iva)/size;
 			f__lquit = 0;
-			if ( (k = l_read(&no1, vaddr + iva, size, type)) )
+			if (k = l_read(&no1, vaddr + iva, size, type))
 				return k;
 			if (f__lquit == 1)
 				return 0;
@@ -533,8 +533,8 @@ int x_rsne(cilist *a)
 					if (no1 > f__lcount)
 						no1 = f__lcount;
 					iva += no1 * dn0->delta;
-					if ( (k = l_read(&no1, vaddr + iva,
+					if (k = l_read(&no1, vaddr + iva,
-							size, type)) )
+							size, type))
 						return k;
 					}
 				}
@@ -594,7 +594,7 @@ s_rsne(cilist *a)
 
 	f__external=1;
 	l_eof = 0;
-	if( (n = c_le(a)) )
+	if(n = c_le(a))
 		return n;
 	if(f__curunit->uwrt && f__nowreading(f__curunit))
 		err(a->cierr,errno,where0);

lib/libI77/sfe.c

@@ -15,9 +15,9 @@ integer e_rsfe(Void)
 	return(n);
 }
 #ifdef KR_headers
-int c_sfe(a) cilist *a; /* check */
+c_sfe(a) cilist *a; /* check */
 #else
-int c_sfe(cilist *a) /* check */
+c_sfe(cilist *a) /* check */
 #endif
 {	unit *p;
 	if(a->ciunit >= MXUNIT || a->ciunit<0)

lib/libI77/sue.c

@@ -4,9 +4,9 @@ extern uiolen f__reclen;
 long f__recloc;
 
 #ifdef KR_headers
-int c_sue(a) cilist *a;
+c_sue(a) cilist *a;
 #else
-int c_sue(cilist *a)
+c_sue(cilist *a)
 #endif
 {
 	if(a->ciunit >= MXUNIT || a->ciunit < 0)
@@ -31,7 +31,7 @@ integer s_rsue(cilist *a)
 	int n;
 	if(!f__init) f_init();
 	f__reading=1;
-	if( (n=c_sue(a)) ) return(n);
+	if(n=c_sue(a)) return(n);
 	f__recpos=0;
 	if(f__curunit->uwrt && f__nowreading(f__curunit))
 		err(a->cierr, errno, "read start");
@@ -54,7 +54,7 @@ integer s_wsue(cilist *a)
 {
 	int n;
 	if(!f__init) f_init();
-	if( (n=c_sue(a)) ) return(n);
+	if(n=c_sue(a)) return(n);
 	f__reading=0;
 	f__reclen=0;
 	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))

lib/libI77/uio.c

@@ -3,9 +3,9 @@
 uiolen f__reclen;
 
 #ifdef KR_headers
-int do_us(number,ptr,len) ftnint *number; char *ptr; ftnlen len;
+do_us(number,ptr,len) ftnint *number; char *ptr; ftnlen len;
 #else
-int do_us(ftnint *number, char *ptr, ftnlen len)
+do_us(ftnint *number, char *ptr, ftnlen len)
 #endif
 {
 	if(f__reading)
@@ -23,7 +23,6 @@ int do_us(ftnint *number, char *ptr, ftnlen len)
 		(void) fwrite(ptr,(int)len,(int)(*number),f__cf);
 		return(0);
 	}
-	return (0);
 }
 #ifdef KR_headers
 integer do_ud(number,ptr,len) ftnint *number; char *ptr; ftnlen len;

lib/libI77/wref.c

@@ -15,9 +15,9 @@
 #endif
 
 #ifdef KR_headers
-int wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
+wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
 #else
-int wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
+wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
 #endif
 {
 	char buf[FMAX+EXPMAXDIGS+4], *s, *se;
@@ -118,7 +118,7 @@ int wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
 	if (s[2]) {
 #ifdef Pedantic
 		if (!e0 && !s[3]) 
-		        e1 = 2; /* for(s -= 2, e1 = 2; s[0] = s[1]; s++); */
+		    e1 = 2;/* for(s -= 2, e1 = 2; s[0] = s[1]; s++);
 
 	/* Pedantic gives the behavior that Fortran 77 specifies,	*/
 	/* i.e., requires that E be specified for exponent fields	*/
@@ -127,7 +127,7 @@ int wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
 	/* exponent field if it fits.	*/
 #else
 		if (!e0) {
-			for(s -= 2, e1 = 2; (s[0] = s[1]); s++)
+			for(s -= 2, e1 = 2; s[0] = s[1]; s++)
 #ifdef CRAY
 				delta--;
 			if ((delta += 4) < 0)
@@ -191,9 +191,9 @@ int wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
 	}
 
 #ifdef KR_headers
-int wrt_F(p,w,d,len) ufloat *p; ftnlen len;
+wrt_F(p,w,d,len) ufloat *p; ftnlen len;
 #else
-int wrt_F(ufloat *p, int w, int d, ftnlen len)
+wrt_F(ufloat *p, int w, int d, ftnlen len)
 #endif
 {
 	int d1, sign, n;
@@ -217,7 +217,7 @@ int wrt_F(ufloat *p, int w, int d, ftnlen len)
 #endif
 		}
 
-	if ( (n = f__scale) )
+	if (n = f__scale)
 		if (n > 0)
 			do x *= 10.; while(--n > 0);
 		else
@@ -267,7 +267,7 @@ int wrt_F(ufloat *p, int w, int d, ftnlen len)
 		PUT('-');
 	else if (f__cplus)
 		PUT('+');
-	while( (n = *b++) )
+	while(n = *b++)
 		PUT(n);
 	while(--d1 >= 0)
 		PUT('0');

lib/libI77/wrtfmt.c

@@ -2,87 +2,84 @@
 #include "fio.h"
 #include "fmt.h"
 
-extern int f__cursor;
+extern icilist *f__svic;
-int f__hiwater;
+extern char *f__icptr;
-icilist *f__svic;
-char *f__icptr;
 
-int
+ static int
 mv_cur(Void)	/* shouldn't use fseek because it insists on calling fflush */
 		/* instead we know too much about stdio */
 {
+	int cursor = f__cursor;
+	f__cursor = 0;
 	if(f__external == 0) {
-		if(f__cursor < 0) {
+		if(cursor < 0) {
 			if(f__hiwater < f__recpos)
 				f__hiwater = f__recpos;
-			f__recpos += f__cursor;
+			f__recpos += cursor;
-			f__icptr += f__cursor;
+			f__icptr += cursor;
-			f__cursor = 0;
 			if(f__recpos < 0)
 				err(f__elist->cierr, 110, "left off");
 		}
-		else if(f__cursor > 0) {
+		else if(cursor > 0) {
-			if(f__recpos + f__cursor >= f__svic->icirlen)
+			if(f__recpos + cursor >= f__svic->icirlen)
 				err(f__elist->cierr, 110, "recend");
 			if(f__hiwater <= f__recpos)
-				for(; f__cursor > 0; f__cursor--)
+				for(; cursor > 0; cursor--)
 					(*f__putn)(' ');
-			else if(f__hiwater <= f__recpos + f__cursor) {
+			else if(f__hiwater <= f__recpos + cursor) {
-				f__cursor -= f__hiwater - f__recpos;
+				cursor -= f__hiwater - f__recpos;
 				f__icptr += f__hiwater - f__recpos;
 				f__recpos = f__hiwater;
-				for(; f__cursor > 0; f__cursor--)
+				for(; cursor > 0; cursor--)
 					(*f__putn)(' ');
 			}
 			else {
-				f__icptr += f__cursor;
+				f__icptr += cursor;
-				f__recpos += f__cursor;
+				f__recpos += cursor;
 			}
-			f__cursor = 0;
 		}
 		return(0);
 	}
-	if(f__cursor > 0) {
+	if(cursor > 0) {
 		if(f__hiwater <= f__recpos)
-			for(;f__cursor>0;f__cursor--) (*f__putn)(' ');
+			for(;cursor>0;cursor--) (*f__putn)(' ');
-		else if(f__hiwater <= f__recpos + f__cursor) {
+		else if(f__hiwater <= f__recpos + cursor) {
 #ifndef NON_UNIX_STDIO
 			if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf))
 				f__cf->_ptr += f__hiwater - f__recpos;
 			else
 #endif
 				(void) fseek(f__cf, (long) (f__hiwater - f__recpos), SEEK_CUR);
-			f__cursor -= f__hiwater - f__recpos;
+			cursor -= f__hiwater - f__recpos;
 			f__recpos = f__hiwater;
-			for(; f__cursor > 0; f__cursor--)
+			for(; cursor > 0; cursor--)
 				(*f__putn)(' ');
 		}
 		else {
 #ifndef NON_UNIX_STDIO
-			if(f__cf->_ptr + f__cursor < buf_end(f__cf))
+			if(f__cf->_ptr + cursor < buf_end(f__cf))
-				f__cf->_ptr += f__cursor;
+				f__cf->_ptr += cursor;
 			else
 #endif
-				(void) fseek(f__cf, (long)f__cursor, SEEK_CUR);
+				(void) fseek(f__cf, (long)cursor, SEEK_CUR);
-			f__recpos += f__cursor;
+			f__recpos += cursor;
 		}
 	}
-	if(f__cursor<0)
+	if(cursor<0)
 	{
-		if(f__cursor+f__recpos<0) err(f__elist->cierr,110,"left off");
+		if(cursor+f__recpos<0) err(f__elist->cierr,110,"left off");
 #ifndef NON_UNIX_STDIO
-		if(f__cf->_ptr + f__cursor >= f__cf->_base)
+		if(f__cf->_ptr + cursor >= f__cf->_base)
-			f__cf->_ptr += f__cursor;
+			f__cf->_ptr += cursor;
 		else
 #endif
 		if(f__curunit && f__curunit->useek)
-			(void) fseek(f__cf,(long)f__cursor,SEEK_CUR);
+			(void) fseek(f__cf,(long)cursor,SEEK_CUR);
 		else
 			err(f__elist->cierr,106,"fmt");
 		if(f__hiwater < f__recpos)
 			f__hiwater = f__recpos;
-		f__recpos += f__cursor;
+		f__recpos += cursor;
-		f__cursor=0;
 	}
 	return(0);
 }
@@ -95,7 +92,7 @@ wrt_Z(Uint *n, int w, int minlen, ftnlen len)
 #endif
 {
 	register char *s, *se;
-	register i, w1;
+	register int i, w1;
 	static int one = 1;
 	static char hex[] = "0123456789ABCDEF";
 	s = (char *)n;
@@ -214,7 +211,10 @@ wrt_AP(s) char *s;
 wrt_AP(char *s)
 #endif
 {	char quote;
-	if(f__cursor && mv_cur()) return(mv_cur());
+	int i;
+
+	if(f__cursor && (i = mv_cur()))
+		return i;
 	quote = *s++;
 	for(;*s;s++)
 	{	if(*s!=quote) (*f__putn)(*s);
@@ -230,14 +230,17 @@ wrt_H(a,s) char *s;
 wrt_H(int a, char *s)
 #endif
 {
-	if(f__cursor && mv_cur()) return(mv_cur());
+	int i;
+
+	if(f__cursor && (i = mv_cur()))
+		return i;
 	while(a--) (*f__putn)(*s++);
 	return(1);
 }
 #ifdef KR_headers
-int wrt_L(n,len, sz) Uint *n; ftnlen sz;
+wrt_L(n,len, sz) Uint *n; ftnlen sz;
 #else
-int wrt_L(Uint *n, int len, ftnlen sz)
+wrt_L(Uint *n, int len, ftnlen sz)
 #endif
 {	int i;
 	long x;
@@ -309,12 +312,15 @@ wrt_G(ufloat *p, int w, int d, int e, ftnlen len)
 	return(wrt_E(p,w,d,e,len));
 }
 #ifdef KR_headers
-int w_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
+w_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
 #else
-int w_ed(struct syl *p, char *ptr, ftnlen len)
+w_ed(struct syl *p, char *ptr, ftnlen len)
 #endif
 {
-	if(f__cursor && mv_cur()) return(mv_cur());
+	int i;
+
+	if(f__cursor && (i = mv_cur()))
+		return i;
 	switch(p->op)
 	{
 	default:
@@ -352,9 +358,9 @@ int w_ed(struct syl *p, char *ptr, ftnlen len)
 	}
 }
 #ifdef KR_headers
-int w_ned(p) struct syl *p;
+w_ned(p) struct syl *p;
 #else
-int w_ned(struct syl *p)
+w_ned(struct syl *p)
 #endif
 {
 	switch(p->op)

lib/libI77/wsfe.c

@@ -5,9 +5,9 @@
 extern int f__hiwater;
 
 #ifdef KR_headers
-int x_putc(c)
+x_putc(c)
 #else
-int x_putc(int c)
+x_putc(int c)
 #endif
 {
 	/* this uses \n as an indicator of record-end */
@@ -27,8 +27,6 @@ int x_putc(int c)
 #endif
 	return putc(c,f__cf);
 }
-
-int
 x_wSL(Void)
 {
 	(*f__putn)('\n');
@@ -37,8 +35,6 @@ x_wSL(Void)
 	f__hiwater = 0;
 	return(1);
 }
-
-int
 xw_end(Void)
 {
 	if(f__nonl == 0)
@@ -46,8 +42,6 @@ xw_end(Void)
 	f__hiwater = f__recpos = f__cursor = 0;
 	return(0);
 }
-
-int
 xw_rev(Void)
 {
 	if(f__workdone) (*f__putn)('\n');
@@ -62,7 +56,7 @@ integer s_wsfe(cilist *a)	/*start*/
 #endif
 {	int n;
 	if(!f__init) f_init();
-	if( (n=c_sfe(a)) ) return(n);
+	if(n=c_sfe(a)) return(n);
 	f__reading=0;
 	f__sequential=1;
 	f__formatted=1;

lib/libI77/wsle.c

@@ -10,7 +10,7 @@ integer s_wsle(cilist *a)
 #endif
 {
 	int n;
-	if( (n=c_le(a)) ) return(n);
+	if(n=c_le(a)) return(n);
 	f__reading=0;
 	f__external=1;
 	f__formatted=1;

lib/libI77/wsne.c

@@ -11,7 +11,7 @@ s_wsne(cilist *a)
 {
 	int n;
 
-	if( (n=c_le(a)) )
+	if(n=c_le(a))
 		return(n);
 	f__reading=0;
 	f__external=1;

lib/libf2c/Makefile

@@ -5,7 +5,7 @@ CFLAGS+= -DIEEE_drem -DNON_ANSI_RW_MODES -DNON_UNIX_STDIO -DPedantic
 
 MISC =	Version.c main.c s_rnge.c abort_.c getarg_.c iargc_.c getenv_.c\
 	signal_.c s_stop.c s_paus.c system_.c cabs.c\
-	derf_.c derfc_.c erf_.c erfc_.c sig_die.c F77_aloc.c exit.c
+	derf_.c derfc_.c erf_.c erfc_.c sig_die.c F77_aloc.c
 POW =	pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c  pow_ri.c pow_zi.c pow_zz.c
 CX =	c_abs.c c_cos.c c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c
 DCX =	z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c
@@ -23,9 +23,10 @@ HALF =	h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c h_mod.c  h_nint.c h_sign.c
 CMP =	l_ge.c l_gt.c l_le.c l_lt.c hl_ge.c hl_gt.c hl_le.c hl_lt.c
 EFL =	ef1asc_.c ef1cmc_.c
 CHAR =	s_cat.c s_cmp.c s_copy.c
+F90BIT = lbitbits.c lbitshft.c
 
 F77SRCS= $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
-	$(HALF) $(CMP) $(EFL) $(CHAR)
+	$(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT)
 
 I77SRCS = Version.c backspace.c close.c dfe.c dolio.c due.c endfile.c err.c \
 	fmt.c fmtlib.c iio.c ilnw.c inquire.c lread.c lwrite.c open.c \