diff options
62 files changed, 573 insertions, 781 deletions
diff --git a/lib/libF77/F77_aloc.c b/lib/libF77/F77_aloc.c index 18a345f..e8ba744 100644 --- a/lib/libF77/F77_aloc.c +++ b/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); diff --git a/lib/libF77/README b/lib/libF77/README index a575124..7668215 100644 --- a/lib/libF77/README +++ b/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 -for use with INTEGER*8. To use it, you must modify f2c.h to -declare longint appropriately; then add pow_qq.o to the POW = -line in the makefile. +The makefile does not attempt to compile pow_qq.c, qbitbits.c, +and qbitshft.c, which are meant for use with INTEGER*8. To use +INTEGER*8, you must modify f2c.h to declare longint and ulongint +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 diff --git a/lib/libF77/Version.c b/lib/libF77/Version.c index df2434a..eb4fa2d 100644 --- a/lib/libF77/Version.c +++ b/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.) */ diff --git a/lib/libF77/abort_.c b/lib/libF77/abort_.c index 96b960d..9d4a056 100644 --- a/lib/libF77/abort_.c +++ b/lib/libF77/abort_.c @@ -12,5 +12,7 @@ int abort_(void) #endif { sig_die("Fortran abort routine called", 1); +#ifdef __cplusplus return 0; +#endif } diff --git a/lib/libF77/c_cos.c b/lib/libF77/c_cos.c index d5fadd4..4aea0c3 100644 --- a/lib/libF77/c_cos.c +++ b/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); -r->i = - sin(z->r) * sinh(z->i); -} + double zr = z->r; + r->r = cos(zr) * cosh(z->i); + r->i = - sin(zr) * sinh(z->i); + } diff --git a/lib/libF77/c_div.c b/lib/libF77/c_div.c index 0bb56b4..57139a0 100644 --- a/lib/libF77/c_div.c +++ b/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 abr, abi; + double ratio, den; + double abr, abi; + double ai = a->i, ar = a->r, bi = b->i, br = b->r; -if( (abr = b->r) < 0.) - abr = - abr; -if( (abi = b->i) < 0.) - abi = - abi; -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); - c->r = (a->r*ratio + a->i) / den; - c->i = (a->i*ratio - a->r) / den; - } + if( (abr = br) < 0.) + abr = - abr; + if( (abi = bi) < 0.) + abi = - abi; + if( abr <= abi ) + { + if(abi == 0) + sig_die("complex division by zero", 1); + ratio = (double)br / bi ; + den = bi * (1 + ratio*ratio); + c->r = (ar*ratio + ai) / den; + c->i = (ai*ratio - ar) / den; + } -else - { - ratio = (double)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; + else + { + ratio = (double)bi / br ; + den = br * (1 + ratio*ratio); + c->r = (ar + ai*ratio) / den; + c->i = (ai - ar*ratio) / den; + } } -} diff --git a/lib/libF77/c_log.c b/lib/libF77/c_log.c index a77521a..6ac990c 100644 --- a/lib/libF77/c_log.c +++ b/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); -r->r = log( f__cabs(z->r, z->i) ); -} + double zi; + r->i = atan2(zi = z->i, z->r); + r->r = log( f__cabs(z->r, zi) ); + } diff --git a/lib/libF77/c_sin.c b/lib/libF77/c_sin.c index ffdef1d1..15acccc 100644 --- a/lib/libF77/c_sin.c +++ b/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); -r->i = cos(z->r) * sinh(z->i); -} + double zr = z->r; + r->r = sin(zr) * cosh(z->i); + r->i = cos(zr) * sinh(z->i); + } diff --git a/lib/libF77/c_sqrt.c b/lib/libF77/c_sqrt.c index 3b7342f..8481ee4 100644 --- a/lib/libF77/c_sqrt.c +++ b/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.) - r->r = r->i = 0.; -else if(z->r > 0) - { - r->r = t = sqrt(0.5 * (mag + z->r) ); - t = z->i / t; - r->i = 0.5 * t; + if( (mag = f__cabs(zr, zi)) == 0.) + r->r = r->i = 0.; + else if(zr > 0) + { + r->r = t = sqrt(0.5 * (mag + zr) ); + t = zi / 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; - } -} diff --git a/lib/libF77/ef1asc_.c b/lib/libF77/ef1asc_.c index 78993b8..b2b8d72 100644 --- a/lib/libF77/ef1asc_.c +++ b/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 } diff --git a/lib/libF77/exit.c b/lib/libF77/exit.c deleted file mode 100644 index da3ab5c..0000000 --- a/lib/libF77/exit.c +++ /dev/null @@ -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 diff --git a/lib/libF77/f2ch.add b/lib/libF77/f2ch.add index 4ab0d80..a2acc17 100644 --- a/lib/libF77/f2ch.add +++ b/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 *); diff --git a/lib/libF77/getenv_.c b/lib/libF77/getenv_.c index 7ba2de5..2a035ea 100644 --- a/lib/libF77/getenv_.c +++ b/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++) diff --git a/lib/libF77/lbitbits.c b/lib/libF77/lbitbits.c new file mode 100644 index 0000000..75e9f9c --- /dev/null +++ b/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)); + } diff --git a/lib/libF77/lbitshft.c b/lib/libF77/lbitshft.c new file mode 100644 index 0000000..81b0fdb --- /dev/null +++ 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); + } diff --git a/lib/libF77/libF77.xsum b/lib/libF77/libF77.xsum deleted file mode 100644 index fe3fbfc..0000000 --- a/lib/libF77/libF77.xsum +++ /dev/null @@ -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 diff --git a/lib/libF77/main.c b/lib/libF77/main.c index 7c1127c..d6ff84a 100644 --- a/lib/libF77/main.c +++ b/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) - signal(SIGQUIT, SIG_IGN); +if(signal1(SIGQUIT,sigqdie) == SIG_IGN) + signal1(SIGQUIT, SIG_IGN); #endif -if(signal(SIGINT, sigindie) == SIG_IGN) - signal(SIGINT, SIG_IGN); -signal(SIGTERM,sigtdie); +if(signal1(SIGINT, sigindie) == SIG_IGN) + signal1(SIGINT, SIG_IGN); +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 diff --git a/lib/libF77/makefile b/lib/libF77/makefile deleted file mode 100644 index 6e7cc68..0000000 --- a/lib/libF77/makefile +++ /dev/null @@ -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 diff --git a/lib/libF77/pow_zi.c b/lib/libF77/pow_zi.c index 167e6ac..abb3cb2 100644 --- a/lib/libF77/pow_zi.c +++ b/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; -unsigned long u; -double t; -doublecomplex x; -static doublecomplex one = {1.0, 0.0}; + integer n; + unsigned long u; + double t; + doublecomplex q, x; + static doublecomplex one = {1.0, 0.0}; -n = *b; -p->r = 1; -p->i = 0; + n = *b; + q.r = 1; + q.i = 0; -if(n == 0) - return; -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) + if(n == 0) + goto done; + if(n < 0) + { + n = -n; + z_div(&x, &one, a); + } + else { - t = p->r * x.r - p->i * x.i; - p->i = p->r * x.i + p->i * x.r; - p->r = t; + x.r = a->r; + x.i = a->i; } - if(u >>= 1) + + for(u = n; ; ) { - t = x.r * x.r - x.i * x.i; - x.i = 2 * x.r * x.i; - x.r = t; + 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; } - else - break; + done: + p->i = q.i; + p->r = q.r; } -} diff --git a/lib/libF77/s_cat.c b/lib/libF77/s_cat.c index 1d6fd24..038f0ec 100644 --- a/lib/libF77/s_cat.c +++ b/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; diff --git a/lib/libF77/s_paus.c b/lib/libF77/s_paus.c index 43bd322..2501cb5a 100644 --- a/lib/libF77/s_paus.c +++ b/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 diff --git a/lib/libF77/s_rnge.c b/lib/libF77/s_rnge.c index fc7f0b6..b200fce 100644 --- a/lib/libF77/s_rnge.c +++ b/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 } diff --git a/lib/libF77/signal1.h b/lib/libF77/signal1.h new file mode 100644 index 0000000..8800a18 --- /dev/null +++ b/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) diff --git a/lib/libF77/signal_.c b/lib/libF77/signal_.c index 8f06c91..9b31f5a 100644 --- a/lib/libF77/signal_.c +++ b/lib/libF77/signal_.c @@ -1,21 +1,19 @@ #include "f2c.h" #ifdef KR_headers -typedef VOID (*sig_type)(); -extern sig_type signal(); -typedef int (*sig_proc)(); +typedef VOID (*sig_pf)(); +extern sig_pf signal(); +#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" -typedef void (*sig_type)(int); -typedef int (*sig_proc)(int); +#include "signal1.h" -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); } diff --git a/lib/libF77/z_cos.c b/lib/libF77/z_cos.c index bc9e23e..fdd1510 100644 --- a/lib/libF77/z_cos.c +++ b/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); -r->i = - sin(z->r) * sinh(z->i); -} + double zr = z->r; + r->r = cos(zr) * cosh(z->i); + r->i = - sin(zr) * sinh(z->i); + } diff --git a/lib/libF77/z_div.c b/lib/libF77/z_div.c index fd53733..ed7ee66 100644 --- a/lib/libF77/z_div.c +++ b/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 abr, abi; + double ratio, den; + double abr, abi; + double ai = a->i, ar = a->r, bi = b->i, br = b->r; -if( (abr = b->r) < 0.) - abr = - abr; -if( (abi = b->i) < 0.) - abi = - abi; -if( abr <= abi ) - { - if(abi == 0) - sig_die("complex division by zero", 1); - ratio = b->r / b->i ; - den = b->i * (1 + ratio*ratio); - c->r = (a->r*ratio + a->i) / den; - c->i = (a->i*ratio - a->r) / den; - } + if( (abr = br) < 0.) + abr = - abr; + if( (abi = bi) < 0.) + abi = - abi; + if( abr <= abi ) + { + if(abi == 0) + sig_die("complex division by zero", 1); + ratio = br / bi ; + den = bi * (1 + ratio*ratio); + c->r = (ar*ratio + ai) / den; + c->i = (ai*ratio - ar) / 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; + else + { + ratio = bi / br ; + den = br * (1 + ratio*ratio); + c->r = (ar + ai*ratio) / den; + c->i = (ai - ar*ratio) / den; + } } - -} diff --git a/lib/libF77/z_log.c b/lib/libF77/z_log.c index fa1ac80..2d52b94 100644 --- a/lib/libF77/z_log.c +++ b/lib/libF77/z_log.c @@ -10,7 +10,7 @@ extern double f__cabs(double, double); void z_log(doublecomplex *r, doublecomplex *z) #endif { - -r->i = atan2(z->i, z->r); -r->r = log( f__cabs( z->r, z->i ) ); -} + double zi = z->i; + r->i = atan2(zi, z->r); + r->r = log( f__cabs( z->r, zi ) ); + } diff --git a/lib/libF77/z_sin.c b/lib/libF77/z_sin.c index bd90804..577be1d 100644 --- a/lib/libF77/z_sin.c +++ b/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); -r->i = cos(z->r) * sinh(z->i); -} + double zr = z->r; + r->r = sin(zr) * cosh(z->i); + r->i = cos(zr) * sinh(z->i); + } diff --git a/lib/libF77/z_sqrt.c b/lib/libF77/z_sqrt.c index eed38d0..c04e8f0 100644 --- a/lib/libF77/z_sqrt.c +++ b/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.) - r->r = r->i = 0.; -else if(z->r > 0) - { - r->r = sqrt(0.5 * (mag + z->r) ); - r->i = z->i / r->r / 2; + if( (mag = f__cabs(zr, zi)) == 0.) + r->r = r->i = 0.; + else if(zr > 0) + { + r->r = sqrt(0.5 * (mag + zr) ); + 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; - } -} diff --git a/lib/libI77/Notice b/lib/libI77/Notice index 9715a19..8db1d7b 100644 --- a/lib/libI77/Notice +++ b/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 diff --git a/lib/libI77/README b/lib/libI77/README index 6b0558d..30dd5b5 100644 --- a/lib/libI77/README +++ b/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. diff --git a/lib/libI77/Version.c b/lib/libI77/Version.c index ebd3f0b..b73ae67 100644 --- a/lib/libI77/Version.c +++ b/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. */ diff --git a/lib/libI77/dfe.c b/lib/libI77/dfe.c index 1135ffd..51023d5 100644 --- a/lib/libI77/dfe.c +++ b/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; diff --git a/lib/libI77/due.c b/lib/libI77/due.c index ff9ce55..670b0f1 100644 --- a/lib/libI77/due.c +++ b/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); diff --git a/lib/libI77/endfile.c b/lib/libI77/endfile.c index 8425a29..f5990e3 100644 --- a/lib/libI77/endfile.c +++ b/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)) { diff --git a/lib/libI77/err.c b/lib/libI77/err.c index 923a667..29747ff 100644 --- a/lib/libI77/err.c +++ b/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; diff --git a/lib/libI77/f2ch.add b/lib/libI77/f2ch.add index 4ab0d80..a2acc17 100644 --- a/lib/libI77/f2ch.add +++ b/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 *); diff --git a/lib/libI77/fio.h b/lib/libI77/fio.h index 17e5593..e8c693b 100644 --- a/lib/libI77/fio.h +++ b/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 errfl(f,m,s) return err__fl((int)(f),(m),(s)) +#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) /*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) diff --git a/lib/libI77/fmt.c b/lib/libI77/fmt.c index 8689ef5..12792fc 100644 --- a/lib/libI77/fmt.c +++ b/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)); diff --git a/lib/libI77/fmt.h b/lib/libI77/fmt.h index e94bc1c..509746e 100644 --- a/lib/libI77/fmt.h +++ b/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; diff --git a/lib/libI77/fmtlib.c b/lib/libI77/fmtlib.c index 1c6801e..91483fc 100644 --- a/lib/libI77/fmtlib.c +++ b/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'; - value /= base; + buf[--i] = (uvalue%base) + '0'; + uvalue /= base; } - while(value > 0); + while(uvalue > 0); *ndigit = MAXINTLENGTH - i; return &buf[i]; } diff --git a/lib/libI77/iio.c b/lib/libI77/iio.c index dff9e3f..4c8eb9d 100644 --- a/lib/libI77/iio.c +++ b/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; diff --git a/lib/libI77/inquire.c b/lib/libI77/inquire.c index c28e367..ec98b22 100644 --- a/lib/libI77/inquire.c +++ b/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) diff --git a/lib/libI77/libI77.xsum b/lib/libI77/libI77.xsum deleted file mode 100644 index c93a190..0000000 --- a/lib/libI77/libI77.xsum +++ /dev/null @@ -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 diff --git a/lib/libI77/lread.c b/lib/libI77/lread.c index 74f6f49..27f0269 100644 --- a/lib/libI77/lread.c +++ b/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 (feof(f__cf)) - err(f__elist->ciend,(EOF),"list in") - else if(ferror(f__cf)) { - clearerr(f__cf); - errfl(f__elist->cierr,errno,"list in"); - } + if(f__cf && 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; diff --git a/lib/libI77/lwrite.c b/lib/libI77/lwrite.c index 0d323ec..5da7dfb 100644 --- a/lib/libI77/lwrite.c +++ b/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) diff --git a/lib/libI77/makefile b/lib/libI77/makefile deleted file mode 100644 index db250d2..0000000 --- a/lib/libI77/makefile +++ /dev/null @@ -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 diff --git a/lib/libI77/open.c b/lib/libI77/open.c index beb525e..75386b9 100644 --- a/lib/libI77/open.c +++ b/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; diff --git a/lib/libI77/rawio.h b/lib/libI77/rawio.h index 3e2c750..4cbd847 100644 --- a/lib/libI77/rawio.h +++ b/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 +#endif /*KR_HEADERS*/ extern char *mktemp(char*); diff --git a/lib/libI77/rdfmt.c b/lib/libI77/rdfmt.c index 3878dd9..03b325e 100644 --- a/lib/libI77/rdfmt.c +++ b/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) diff --git a/lib/libI77/rsfe.c b/lib/libI77/rsfe.c index 24ecafc..41ff257 100644 --- a/lib/libI77/rsfe.c +++ b/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(); - return(0); + xrd_SL(); + 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; diff --git a/lib/libI77/rsli.c b/lib/libI77/rsli.c index 999b0d4..a081cd5 100644 --- a/lib/libI77/rsli.c +++ b/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++); } diff --git a/lib/libI77/rsne.c b/lib/libI77/rsne.c index 9378717..cc679c7 100644 --- a/lib/libI77/rsne.c +++ b/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, - (ftnlen)size, &b)) ) + if (k = getdimen(&ch, dn, (ftnlen)size, + (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, - span, &b1)) ) + if (k = getdimen(&ch, dn1, dn->delta**dims, + 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, - size, type)) ) + if (k = l_read(&no1, vaddr + iva, + 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); diff --git a/lib/libI77/sfe.c b/lib/libI77/sfe.c index 6fe9aa0..eea9078 100644 --- a/lib/libI77/sfe.c +++ b/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) diff --git a/lib/libI77/sue.c b/lib/libI77/sue.c index a179169..b1b8bc3 100644 --- a/lib/libI77/sue.c +++ b/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)) diff --git a/lib/libI77/uio.c b/lib/libI77/uio.c index 6bceb27..e40875e 100644 --- a/lib/libI77/uio.c +++ b/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; diff --git a/lib/libI77/wref.c b/lib/libI77/wref.c index 0adcccc..5e4871d 100644 --- a/lib/libI77/wref.c +++ b/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 @@ nogood: 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 @@ nogood: /* 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 @@ nogood: } #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'); diff --git a/lib/libI77/wrtfmt.c b/lib/libI77/wrtfmt.c index 077db71..f261ec3 100644 --- a/lib/libI77/wrtfmt.c +++ b/lib/libI77/wrtfmt.c @@ -2,87 +2,84 @@ #include "fio.h" #include "fmt.h" -extern int f__cursor; -int f__hiwater; -icilist *f__svic; -char *f__icptr; +extern icilist *f__svic; +extern 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__icptr += f__cursor; - f__cursor = 0; + f__recpos += cursor; + f__icptr += cursor; if(f__recpos < 0) err(f__elist->cierr, 110, "left off"); } - else if(f__cursor > 0) { - if(f__recpos + f__cursor >= f__svic->icirlen) + else if(cursor > 0) { + 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) { - f__cursor -= f__hiwater - f__recpos; + else if(f__hiwater <= f__recpos + cursor) { + 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__recpos += f__cursor; + f__icptr += 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)(' '); - else if(f__hiwater <= f__recpos + f__cursor) { + for(;cursor>0;cursor--) (*f__putn)(' '); + 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)) - f__cf->_ptr += f__cursor; + if(f__cf->_ptr + cursor < buf_end(f__cf)) + f__cf->_ptr += cursor; else #endif - (void) fseek(f__cf, (long)f__cursor, SEEK_CUR); - f__recpos += f__cursor; + (void) fseek(f__cf, (long)cursor, SEEK_CUR); + 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) - f__cf->_ptr += f__cursor; + if(f__cf->_ptr + cursor >= f__cf->_base) + 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__cursor=0; + f__recpos += cursor; } 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) diff --git a/lib/libI77/wsfe.c b/lib/libI77/wsfe.c index d69f9af..7c7f014 100644 --- a/lib/libI77/wsfe.c +++ b/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; diff --git a/lib/libI77/wsle.c b/lib/libI77/wsle.c index 1e47d5d..44b6972 100644 --- a/lib/libI77/wsle.c +++ b/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; diff --git a/lib/libI77/wsne.c b/lib/libI77/wsne.c index 9b7f9b6..0febd52 100644 --- a/lib/libI77/wsne.c +++ b/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; diff --git a/lib/libf2c/Makefile b/lib/libf2c/Makefile index 76451bf..5db8a42 100644 --- a/lib/libf2c/Makefile +++ b/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 \ |
