diff options
author | Dave Love <d.love@dl.ac.uk> | 1998-07-05 10:03:25 +0000 |
---|---|---|
committer | Dave Love <d.love@dl.ac.uk> | 1998-07-05 10:03:25 +0000 |
commit | 46b89311362af18a08de64699362144584df6d08 (patch) | |
tree | 19e55d40b38d49233a57b77ee9c21521096a494a | |
parent | 58433218ecb4064bc1ec1dcf4c7d10d945a82956 (diff) |
Netlib version of 1998-06-18.
git-svn-id: https://gcc.gnu.org/svn/gcc/branches/Netlib_branch@20931 138bc75d-0d04-0410-961f-82ee72b054a4
107 files changed, 497 insertions, 642 deletions
diff --git a/libf2c/libF77/F77_aloc.c b/libf2c/libF77/F77_aloc.c index 8754fe2ef70..e8ba7442f68 100644 --- a/libf2c/libF77/F77_aloc.c +++ b/libf2c/libF77/F77_aloc.c @@ -2,19 +2,19 @@ #undef abs #undef min #undef max -#include <stdio.h> +#include "stdio.h" static integer memfailure = 3; #ifdef KR_headers extern char *malloc(); -extern void G77_exit_0 (); +extern void exit_(); char * F77_aloc(Len, whence) integer Len; char *whence; #else -#include <stdlib.h> -extern void G77_exit_0 (integer*); +#include "stdlib.h" +extern void exit_(integer*); char * F77_aloc(integer Len, char *whence) @@ -26,7 +26,7 @@ F77_aloc(integer Len, char *whence) if (!(rv = (char*)malloc(uLen))) { fprintf(stderr, "malloc(%u) failure in %s\n", uLen, whence); - G77_exit_0 (&memfailure); + exit_(&memfailure); } return rv; } diff --git a/libf2c/libF77/Version.c b/libf2c/libF77/Version.c index 4ccfd3a0d45..64de577df1f 100644 --- a/libf2c/libF77/Version.c +++ b/libf2c/libF77/Version.c @@ -1,11 +1,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19970919\n"; /* -*/ - -char __G77_LIBF77_VERSION__[] = "0.5.23"; - -/* 2.00 11 June 1980. File version.c added to library. 2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed [ d]erf[c ] added @@ -56,12 +51,3 @@ char __G77_LIBF77_VERSION__[] = "0.5.23"; 19 Sept. 1997: [de]time_.c (Unix systems only): change return type to double. */ - -#include <stdio.h> - -void -g77__fvers__ () -{ - fprintf (stderr, "__G77_LIBF77_VERSION__: %s", __G77_LIBF77_VERSION__); - fputs (junk, stderr); -} diff --git a/libf2c/libF77/abort_.c b/libf2c/libF77/abort_.c index 8efdc42f970..9d4a0568ec7 100644 --- a/libf2c/libF77/abort_.c +++ b/libf2c/libF77/abort_.c @@ -1,14 +1,14 @@ -#include <stdio.h> +#include "stdio.h" #include "f2c.h" #ifdef KR_headers extern VOID sig_die(); -int G77_abort_0 () +int abort_() #else extern void sig_die(char*,int); -int G77_abort_0 (void) +int abort_(void) #endif { sig_die("Fortran abort routine called", 1); diff --git a/libf2c/libF77/c_cos.c b/libf2c/libF77/c_cos.c index 9e833c168b3..4aea0c3cf69 100644 --- a/libf2c/libF77/c_cos.c +++ b/libf2c/libF77/c_cos.c @@ -3,19 +3,15 @@ #ifdef KR_headers extern double sin(), cos(), sinh(), cosh(); -VOID c_cos(resx, z) complex *resx, *z; +VOID c_cos(r, z) complex *r, *z; #else #undef abs -#include <math.h> +#include "math.h" -void c_cos(complex *resx, complex *z) +void c_cos(complex *r, complex *z) #endif { -complex res; - -res.r = cos(z->r) * cosh(z->i); -res.i = - sin(z->r) * sinh(z->i); - -resx->r = res.r; -resx->i = res.i; -} + double zr = z->r; + r->r = cos(zr) * cosh(z->i); + r->i = - sin(zr) * sinh(z->i); + } diff --git a/libf2c/libF77/c_div.c b/libf2c/libF77/c_div.c index 9568354bd53..ac963079ba2 100644 --- a/libf2c/libF77/c_div.c +++ b/libf2c/libF77/c_div.c @@ -2,39 +2,36 @@ #ifdef KR_headers extern VOID sig_die(); -VOID c_div(resx, a, b) -complex *a, *b, *resx; +VOID c_div(c, a, b) +complex *a, *b, *c; #else extern void sig_die(char*,int); -void c_div(complex *resx, complex *a, complex *b) +void c_div(complex *c, complex *a, complex *b) #endif { -double ratio, den; -double abr, abi; -complex res; + double ratio, den; + double abr, abi, cr; -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); - res.r = (a->r*ratio + a->i) / den; - res.i = (a->i*ratio - a->r) / den; - } + 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); + cr = (a->r*ratio + a->i) / den; + c->i = (a->i*ratio - a->r) / den; + } -else - { - ratio = (double)b->i / b->r ; - den = b->r * (1 + ratio*ratio); - res.r = (a->r + a->i*ratio) / den; - res.i = (a->i - a->r*ratio) / den; + else + { + ratio = (double)b->i / b->r ; + den = b->r * (1 + ratio*ratio); + cr = (a->r + a->i*ratio) / den; + c->i = (a->i - a->r*ratio) / den; + } + c->r = cr; } - -resx->r = res.r; -resx->i = res.i; -} diff --git a/libf2c/libF77/c_exp.c b/libf2c/libF77/c_exp.c index 8d3d33d0fe3..8252c7f7012 100644 --- a/libf2c/libF77/c_exp.c +++ b/libf2c/libF77/c_exp.c @@ -3,21 +3,17 @@ #ifdef KR_headers extern double exp(), cos(), sin(); - VOID c_exp(resx, z) complex *resx, *z; + VOID c_exp(r, z) complex *r, *z; #else #undef abs -#include <math.h> +#include "math.h" -void c_exp(complex *resx, complex *z) +void c_exp(complex *r, complex *z) #endif { double expx; -complex res; expx = exp(z->r); -res.r = expx * cos(z->i); -res.i = expx * sin(z->i); - -resx->r = res.r; -resx->i = res.i; +r->r = expx * cos(z->i); +r->i = expx * sin(z->i); } diff --git a/libf2c/libF77/c_log.c b/libf2c/libF77/c_log.c index 6715131ad1d..6ac990ca267 100644 --- a/libf2c/libF77/c_log.c +++ b/libf2c/libF77/c_log.c @@ -2,20 +2,16 @@ #ifdef KR_headers extern double log(), f__cabs(), atan2(); -VOID c_log(resx, z) complex *resx, *z; +VOID c_log(r, z) complex *r, *z; #else #undef abs -#include <math.h> +#include "math.h" extern double f__cabs(double, double); -void c_log(complex *resx, complex *z) +void c_log(complex *r, complex *z) #endif { -complex res; - -res.i = atan2(z->i, z->r); -res.r = log( f__cabs(z->r, z->i) ); - -resx->r = res.r; -resx->i = res.i; -} + double zi; + r->i = atan2(zi = z->i, z->r); + r->r = log( f__cabs(z->r, zi) ); + } diff --git a/libf2c/libF77/c_sin.c b/libf2c/libF77/c_sin.c index 7bf3e392bed..15acccc59af 100644 --- a/libf2c/libF77/c_sin.c +++ b/libf2c/libF77/c_sin.c @@ -3,19 +3,15 @@ #ifdef KR_headers extern double sin(), cos(), sinh(), cosh(); -VOID c_sin(resx, z) complex *resx, *z; +VOID c_sin(r, z) complex *r, *z; #else #undef abs -#include <math.h> +#include "math.h" -void c_sin(complex *resx, complex *z) +void c_sin(complex *r, complex *z) #endif { -complex res; - -res.r = sin(z->r) * cosh(z->i); -res.i = cos(z->r) * sinh(z->i); - -resx->r = res.r; -resx->i = res.i; -} + double zr = z->r; + r->r = sin(zr) * cosh(z->i); + r->i = cos(zr) * sinh(z->i); + } diff --git a/libf2c/libF77/c_sqrt.c b/libf2c/libF77/c_sqrt.c index 775977a87f7..8481ee4857e 100644 --- a/libf2c/libF77/c_sqrt.c +++ b/libf2c/libF77/c_sqrt.c @@ -3,36 +3,33 @@ #ifdef KR_headers extern double sqrt(), f__cabs(); -VOID c_sqrt(resx, z) complex *resx, *z; +VOID c_sqrt(r, z) complex *r, *z; #else #undef abs -#include <math.h> +#include "math.h" extern double f__cabs(double, double); -void c_sqrt(complex *resx, complex *z) +void c_sqrt(complex *r, complex *z) #endif { -double mag, t; -complex res; + double mag, t; + double zi = z->i, zr = z->r; -if( (mag = f__cabs(z->r, z->i)) == 0.) - res.r = res.i = 0.; -else if(z->r > 0) - { - res.r = t = sqrt(0.5 * (mag + z->r) ); - t = z->i / t; - res.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; - res.i = t; - t = z->i / t; - res.r = 0.5 * t; - } - -resx->r = res.r; -resx->i = res.i; -} diff --git a/libf2c/libF77/cabs.c b/libf2c/libF77/cabs.c index 2fad044e884..09e90af8639 100644 --- a/libf2c/libF77/cabs.c +++ b/libf2c/libF77/cabs.c @@ -3,7 +3,7 @@ extern double sqrt(); double f__cabs(real, imag) double real, imag; #else #undef abs -#include <math.h> +#include "math.h" double f__cabs(double real, double imag) #endif { diff --git a/libf2c/libF77/d_acos.c b/libf2c/libF77/d_acos.c index 33da5369db2..ecb56e87f54 100644 --- a/libf2c/libF77/d_acos.c +++ b/libf2c/libF77/d_acos.c @@ -5,7 +5,7 @@ double acos(); double d_acos(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_acos(doublereal *x) #endif { diff --git a/libf2c/libF77/d_asin.c b/libf2c/libF77/d_asin.c index 79b33ca1bd6..045e73301c8 100644 --- a/libf2c/libF77/d_asin.c +++ b/libf2c/libF77/d_asin.c @@ -5,7 +5,7 @@ double asin(); double d_asin(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_asin(doublereal *x) #endif { diff --git a/libf2c/libF77/d_atan.c b/libf2c/libF77/d_atan.c index caea4a406e0..03530a1857c 100644 --- a/libf2c/libF77/d_atan.c +++ b/libf2c/libF77/d_atan.c @@ -5,7 +5,7 @@ double atan(); double d_atan(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_atan(doublereal *x) #endif { diff --git a/libf2c/libF77/d_atn2.c b/libf2c/libF77/d_atn2.c index 6748a55d56f..7c25ac04608 100644 --- a/libf2c/libF77/d_atn2.c +++ b/libf2c/libF77/d_atn2.c @@ -5,7 +5,7 @@ double atan2(); double d_atn2(x,y) doublereal *x, *y; #else #undef abs -#include <math.h> +#include "math.h" double d_atn2(doublereal *x, doublereal *y) #endif { diff --git a/libf2c/libF77/d_cnjg.c b/libf2c/libF77/d_cnjg.c index 1afa3bc4061..c778c38758c 100644 --- a/libf2c/libF77/d_cnjg.c +++ b/libf2c/libF77/d_cnjg.c @@ -2,16 +2,11 @@ VOID #ifdef KR_headers -d_cnjg(resx, z) doublecomplex *resx, *z; +d_cnjg(r, z) doublecomplex *r, *z; #else -d_cnjg(doublecomplex *resx, doublecomplex *z) +d_cnjg(doublecomplex *r, doublecomplex *z) #endif { -doublecomplex res; - -res.r = z->r; -res.i = - z->i; - -resx->r = res.r; -resx->i = res.i; +r->r = z->r; +r->i = - z->i; } diff --git a/libf2c/libF77/d_cos.c b/libf2c/libF77/d_cos.c index fa4d6ca406f..45c4838baee 100644 --- a/libf2c/libF77/d_cos.c +++ b/libf2c/libF77/d_cos.c @@ -5,7 +5,7 @@ double cos(); double d_cos(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_cos(doublereal *x) #endif { diff --git a/libf2c/libF77/d_cosh.c b/libf2c/libF77/d_cosh.c index edc0ebc1092..1181833cc1f 100644 --- a/libf2c/libF77/d_cosh.c +++ b/libf2c/libF77/d_cosh.c @@ -5,7 +5,7 @@ double cosh(); double d_cosh(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_cosh(doublereal *x) #endif { diff --git a/libf2c/libF77/d_exp.c b/libf2c/libF77/d_exp.c index be12fd70551..3f2b6ffcc45 100644 --- a/libf2c/libF77/d_exp.c +++ b/libf2c/libF77/d_exp.c @@ -5,7 +5,7 @@ double exp(); double d_exp(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_exp(doublereal *x) #endif { diff --git a/libf2c/libF77/d_int.c b/libf2c/libF77/d_int.c index beff1e7d378..6c0e64215d8 100644 --- a/libf2c/libF77/d_int.c +++ b/libf2c/libF77/d_int.c @@ -5,7 +5,7 @@ double floor(); double d_int(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_int(doublereal *x) #endif { diff --git a/libf2c/libF77/d_lg10.c b/libf2c/libF77/d_lg10.c index c0892bd512a..f03ff0043f8 100644 --- a/libf2c/libF77/d_lg10.c +++ b/libf2c/libF77/d_lg10.c @@ -7,7 +7,7 @@ double log(); double d_lg10(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_lg10(doublereal *x) #endif { diff --git a/libf2c/libF77/d_log.c b/libf2c/libF77/d_log.c index 592015b2821..d7a1941d56a 100644 --- a/libf2c/libF77/d_log.c +++ b/libf2c/libF77/d_log.c @@ -5,7 +5,7 @@ double log(); double d_log(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_log(doublereal *x) #endif { diff --git a/libf2c/libF77/d_mod.c b/libf2c/libF77/d_mod.c index 23f19299168..0d3ffbff9eb 100644 --- a/libf2c/libF77/d_mod.c +++ b/libf2c/libF77/d_mod.c @@ -12,7 +12,7 @@ double d_mod(x,y) doublereal *x, *y; double drem(double, double); #else #undef abs -#include <math.h> +#include "math.h" #endif double d_mod(doublereal *x, doublereal *y) #endif diff --git a/libf2c/libF77/d_nint.c b/libf2c/libF77/d_nint.c index 064beff669c..2ead3df200a 100644 --- a/libf2c/libF77/d_nint.c +++ b/libf2c/libF77/d_nint.c @@ -5,7 +5,7 @@ double floor(); double d_nint(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_nint(doublereal *x) #endif { diff --git a/libf2c/libF77/d_sin.c b/libf2c/libF77/d_sin.c index fdd699eede5..0013af03496 100644 --- a/libf2c/libF77/d_sin.c +++ b/libf2c/libF77/d_sin.c @@ -5,7 +5,7 @@ double sin(); double d_sin(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_sin(doublereal *x) #endif { diff --git a/libf2c/libF77/d_sinh.c b/libf2c/libF77/d_sinh.c index 77f36904f8e..1ccd02ead97 100644 --- a/libf2c/libF77/d_sinh.c +++ b/libf2c/libF77/d_sinh.c @@ -5,7 +5,7 @@ double sinh(); double d_sinh(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_sinh(doublereal *x) #endif { diff --git a/libf2c/libF77/d_sqrt.c b/libf2c/libF77/d_sqrt.c index b5cf83b946f..bee10a3a551 100644 --- a/libf2c/libF77/d_sqrt.c +++ b/libf2c/libF77/d_sqrt.c @@ -5,7 +5,7 @@ double sqrt(); double d_sqrt(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_sqrt(doublereal *x) #endif { diff --git a/libf2c/libF77/d_tan.c b/libf2c/libF77/d_tan.c index af94a053223..23fa423188e 100644 --- a/libf2c/libF77/d_tan.c +++ b/libf2c/libF77/d_tan.c @@ -5,7 +5,7 @@ double tan(); double d_tan(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_tan(doublereal *x) #endif { diff --git a/libf2c/libF77/d_tanh.c b/libf2c/libF77/d_tanh.c index 92a02d4fd6b..0363a49b1be 100644 --- a/libf2c/libF77/d_tanh.c +++ b/libf2c/libF77/d_tanh.c @@ -5,7 +5,7 @@ double tanh(); double d_tanh(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" double d_tanh(doublereal *x) #endif { diff --git a/libf2c/libF77/derf_.c b/libf2c/libF77/derf_.c index fba6b6b11f3..6afaccdaa3e 100644 --- a/libf2c/libF77/derf_.c +++ b/libf2c/libF77/derf_.c @@ -2,10 +2,10 @@ #ifdef KR_headers double erf(); -double G77_derf_0 (x) doublereal *x; +double derf_(x) doublereal *x; #else extern double erf(double); -double G77_derf_0 (doublereal *x) +double derf_(doublereal *x) #endif { return( erf(*x) ); diff --git a/libf2c/libF77/derfc_.c b/libf2c/libF77/derfc_.c index ae1ac740302..e199f916058 100644 --- a/libf2c/libF77/derfc_.c +++ b/libf2c/libF77/derfc_.c @@ -3,11 +3,11 @@ #ifdef KR_headers extern double erfc(); -double G77_derfc_0 (x) doublereal *x; +double derfc_(x) doublereal *x; #else extern double erfc(double); -double G77_derfc_0 (doublereal *x) +double derfc_(doublereal *x) #endif { return( erfc(*x) ); diff --git a/libf2c/libF77/ef1asc_.c b/libf2c/libF77/ef1asc_.c index a922a1d9ba9..b2b8d72a781 100644 --- a/libf2c/libF77/ef1asc_.c +++ b/libf2c/libF77/ef1asc_.c @@ -8,10 +8,10 @@ #ifdef KR_headers extern VOID s_copy(); -G77_ef1asc_0 (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 G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) +int ef1asc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) #endif { s_copy( (char *)a, (char *)b, EVEN(*la), *lb ); diff --git a/libf2c/libF77/ef1cmc_.c b/libf2c/libF77/ef1cmc_.c index f471172935f..8239a6ba2e1 100644 --- a/libf2c/libF77/ef1cmc_.c +++ b/libf2c/libF77/ef1cmc_.c @@ -4,10 +4,10 @@ #ifdef KR_headers extern integer s_cmp(); -integer G77_ef1cmc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; +integer ef1cmc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; #else extern integer s_cmp(char*,char*,ftnlen,ftnlen); -integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) +integer ef1cmc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) #endif { return( s_cmp( (char *)a, (char *)b, *la, *lb) ); diff --git a/libf2c/libF77/erf_.c b/libf2c/libF77/erf_.c index 1ba4350ad05..f7565ae6ae3 100644 --- a/libf2c/libF77/erf_.c +++ b/libf2c/libF77/erf_.c @@ -2,10 +2,10 @@ #ifdef KR_headers double erf(); -double G77_erf_0 (x) real *x; +double erf_(x) real *x; #else extern double erf(double); -double G77_erf_0 (real *x) +double erf_(real *x) #endif { return( erf(*x) ); diff --git a/libf2c/libF77/erfc_.c b/libf2c/libF77/erfc_.c index f44b1d49d84..56adb2f910b 100644 --- a/libf2c/libF77/erfc_.c +++ b/libf2c/libF77/erfc_.c @@ -2,10 +2,10 @@ #ifdef KR_headers double erfc(); -double G77_erfc_0 (x) real *x; +double erfc_(x) real *x; #else extern double erfc(double); -double G77_erfc_0 (real *x) +double erfc_(real *x) #endif { return( erfc(*x) ); diff --git a/libf2c/libF77/exit_.c b/libf2c/libF77/exit_.c index 4c0582add12..da3ab5c10ec 100644 --- a/libf2c/libF77/exit_.c +++ b/libf2c/libF77/exit_.c @@ -13,7 +13,7 @@ #undef min #undef max #ifndef KR_headers -#include <stdlib.h> +#include "stdlib.h" #ifdef __cplusplus extern "C" { #endif @@ -22,9 +22,9 @@ extern void f_exit(void); void #ifdef KR_headers -G77_exit_0 (rc) integer *rc; +exit_(rc) integer *rc; #else -G77_exit_0 (integer *rc) +exit_(integer *rc) #endif { #ifdef NO_ONEXIT diff --git a/libf2c/libF77/getarg_.c b/libf2c/libF77/getarg_.c index 5cf3ffb8599..fef0da7b1d5 100644 --- a/libf2c/libF77/getarg_.c +++ b/libf2c/libF77/getarg_.c @@ -7,18 +7,18 @@ */ #ifdef KR_headers -VOID G77_getarg_0 (n, s, ls) ftnint *n; register char *s; ftnlen ls; +VOID getarg_(n, s, ls) ftnint *n; register char *s; ftnlen ls; #else -void G77_getarg_0 (ftnint *n, register char *s, ftnlen ls) +void getarg_(ftnint *n, register char *s, ftnlen ls) #endif { -extern int f__xargc; -extern char **f__xargv; +extern int xargc; +extern char **xargv; register char *t; register int i; -if(*n>=0 && *n<f__xargc) - t = f__xargv[*n]; +if(*n>=0 && *n<xargc) + t = xargv[*n]; else t = ""; for(i = 0; i<ls && *t!='\0' ; ++i) diff --git a/libf2c/libF77/getenv_.c b/libf2c/libF77/getenv_.c index b9916e6065e..2a035ea9a6b 100644 --- a/libf2c/libF77/getenv_.c +++ b/libf2c/libF77/getenv_.c @@ -13,9 +13,9 @@ */ #ifdef KR_headers -VOID G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; +VOID getenv_(fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; #else -void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen) +void getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen) #endif { extern char **environ; diff --git a/libf2c/libF77/h_dnnt.c b/libf2c/libF77/h_dnnt.c index 005ac6fc412..6ffae9877bb 100644 --- a/libf2c/libF77/h_dnnt.c +++ b/libf2c/libF77/h_dnnt.c @@ -5,7 +5,7 @@ double floor(); shortint h_dnnt(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" shortint h_dnnt(doublereal *x) #endif { diff --git a/libf2c/libF77/h_nint.c b/libf2c/libF77/h_nint.c index 6b8dc29b154..1cd87df34f0 100644 --- a/libf2c/libF77/h_nint.c +++ b/libf2c/libF77/h_nint.c @@ -5,7 +5,7 @@ double floor(); shortint h_nint(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" shortint h_nint(real *x) #endif { diff --git a/libf2c/libF77/i_dnnt.c b/libf2c/libF77/i_dnnt.c index 4ede56ac355..b5d5006f662 100644 --- a/libf2c/libF77/i_dnnt.c +++ b/libf2c/libF77/i_dnnt.c @@ -5,7 +5,7 @@ double floor(); integer i_dnnt(x) doublereal *x; #else #undef abs -#include <math.h> +#include "math.h" integer i_dnnt(doublereal *x) #endif { diff --git a/libf2c/libF77/i_nint.c b/libf2c/libF77/i_nint.c index 411ce32821e..676f9b34744 100644 --- a/libf2c/libF77/i_nint.c +++ b/libf2c/libF77/i_nint.c @@ -5,7 +5,7 @@ double floor(); integer i_nint(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" integer i_nint(real *x) #endif { diff --git a/libf2c/libF77/iargc_.c b/libf2c/libF77/iargc_.c index 1e04c7744b3..29614ec6595 100644 --- a/libf2c/libF77/iargc_.c +++ b/libf2c/libF77/iargc_.c @@ -1,11 +1,11 @@ #include "f2c.h" #ifdef KR_headers -ftnint G77_iargc_0 () +ftnint iargc_() #else -ftnint G77_iargc_0 (void) +ftnint iargc_(void) #endif { -extern int f__xargc; -return ( f__xargc - 1 ); +extern int xargc; +return ( xargc - 1 ); } diff --git a/libf2c/libF77/main.c b/libf2c/libF77/main.c index 17bf449e402..965480531af 100644 --- a/libf2c/libF77/main.c +++ b/libf2c/libF77/main.c @@ -1,11 +1,17 @@ /* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */ -#include <stdio.h> +#include "stdio.h" #include "signal1.h" +#ifndef SIGIOT +#ifdef SIGABRT +#define SIGIOT SIGABRT +#endif +#endif + #ifndef KR_headers #undef VOID -#include <stdlib.h> +#include "stdlib.h" #endif #ifndef VOID @@ -35,13 +41,61 @@ extern VOID f_exit(); #endif #ifdef KR_headers -extern VOID f_init(); +extern VOID f_init(), sig_die(); extern int MAIN__(); +#define Int /* int */ #else -extern void f_init(void); +extern void f_init(void), sig_die(char*, int); extern int MAIN__(void); +#define Int int #endif +static VOID sigfdie(Sigarg) +{ +Use_Sigarg; +sig_die("Floating Exception", 1); +} + + +static VOID sigidie(Sigarg) +{ +Use_Sigarg; +sig_die("IOT Trap", 1); +} + +#ifdef SIGQUIT +static VOID sigqdie(Sigarg) +{ +Use_Sigarg; +sig_die("Quit signal", 1); +} +#endif + + +static VOID sigindie(Sigarg) +{ +Use_Sigarg; +sig_die("Interrupt", 0); +} + +static VOID sigtdie(Sigarg) +{ +Use_Sigarg; +sig_die("Killed", 0); +} + +#ifdef SIGTRAP +static VOID sigtrdie(Sigarg) +{ +Use_Sigarg; +sig_die("Trace trap", 1); +} +#endif + + +int xargc; +char **xargv; + #ifdef __cplusplus } #endif @@ -52,8 +106,27 @@ main(argc, argv) int argc; char **argv; main(int argc, char **argv) #endif { -f_setarg(argc, argv); -f_setsig(); +xargc = argc; +xargv = argv; +signal1(SIGFPE, sigfdie); /* ignore underflow, enable overflow */ +#ifdef SIGIOT +signal1(SIGIOT, sigidie); +#endif +#ifdef SIGTRAP +signal1(SIGTRAP, sigtrdie); +#endif +#ifdef SIGQUIT +if(signal1(SIGQUIT,sigqdie) == SIG_IGN) + signal1(SIGQUIT, SIG_IGN); +#endif +if(signal1(SIGINT, sigindie) == SIG_IGN) + signal1(SIGINT, SIG_IGN); +signal1(SIGTERM,sigtdie); + +#ifdef pdp11 + ldfps(01200); /* detect overflow as an exception */ +#endif + f_init(); #ifndef NO_ONEXIT ONEXIT(f_exit); diff --git a/libf2c/libF77/pow_dd.c b/libf2c/libF77/pow_dd.c index d0dd0ff2744..d2bb0e39bfd 100644 --- a/libf2c/libF77/pow_dd.c +++ b/libf2c/libF77/pow_dd.c @@ -5,7 +5,7 @@ double pow(); double pow_dd(ap, bp) doublereal *ap, *bp; #else #undef abs -#include <math.h> +#include "math.h" double pow_dd(doublereal *ap, doublereal *bp) #endif { diff --git a/libf2c/libF77/pow_zi.c b/libf2c/libF77/pow_zi.c index 898ea6be917..abb3cb2b530 100644 --- a/libf2c/libF77/pow_zi.c +++ b/libf2c/libF77/pow_zi.c @@ -1,61 +1,54 @@ #include "f2c.h" #ifdef KR_headers -VOID pow_zi(resx, a, b) /* p = a**b */ - doublecomplex *resx, *a; integer *b; +VOID pow_zi(p, a, b) /* p = a**b */ + doublecomplex *p, *a; integer *b; #else extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*); -void pow_zi(doublecomplex *resx, doublecomplex *a, integer *b) /* p = a**b */ +void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) /* p = a**b */ #endif { -integer n; -unsigned long u; -double t; -doublecomplex x; -doublecomplex res; -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; + n = *b; + q.r = 1; + q.i = 0; -if(n == 0) - { - resx->r = 1; - resx->i = 0; - return; - } - -res.r = 1; -res.i = 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) + if(n == 0) + goto done; + if(n < 0) { - t = res.r * x.r - res.i * x.i; - res.i = res.r * x.i + res.i * x.r; - res.r = t; + n = -n; + z_div(&x, &one, a); } - if(u >>= 1) + else { - t = x.r * x.r - x.i * x.i; - x.i = 2 * x.r * x.i; - x.r = t; + x.r = a->r; + x.i = a->i; } - else - break; - } -resx->r = res.r; -resx->i = res.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; + } diff --git a/libf2c/libF77/pow_zz.c b/libf2c/libF77/pow_zz.c index 20faf29cfb8..55785dffbe6 100644 --- a/libf2c/libF77/pow_zz.c +++ b/libf2c/libF77/pow_zz.c @@ -5,7 +5,7 @@ double log(), exp(), cos(), sin(), atan2(), f__cabs(); VOID pow_zz(r,a,b) doublecomplex *r, *a, *b; #else #undef abs -#include <math.h> +#include "math.h" extern double f__cabs(double,double); void pow_zz(doublecomplex *r, doublecomplex *a, doublecomplex *b) #endif diff --git a/libf2c/libF77/r_acos.c b/libf2c/libF77/r_acos.c index 330f88a3092..328812ab6aa 100644 --- a/libf2c/libF77/r_acos.c +++ b/libf2c/libF77/r_acos.c @@ -5,7 +5,7 @@ double acos(); double r_acos(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_acos(real *x) #endif { diff --git a/libf2c/libF77/r_asin.c b/libf2c/libF77/r_asin.c index 45ece4b749e..a30c6706b06 100644 --- a/libf2c/libF77/r_asin.c +++ b/libf2c/libF77/r_asin.c @@ -5,7 +5,7 @@ double asin(); double r_asin(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_asin(real *x) #endif { diff --git a/libf2c/libF77/r_atan.c b/libf2c/libF77/r_atan.c index 36479c915b0..1e3817bdf66 100644 --- a/libf2c/libF77/r_atan.c +++ b/libf2c/libF77/r_atan.c @@ -5,7 +5,7 @@ double atan(); double r_atan(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_atan(real *x) #endif { diff --git a/libf2c/libF77/r_atn2.c b/libf2c/libF77/r_atn2.c index 9347e1f13a9..3832a27f3e3 100644 --- a/libf2c/libF77/r_atn2.c +++ b/libf2c/libF77/r_atn2.c @@ -5,7 +5,7 @@ double atan2(); double r_atn2(x,y) real *x, *y; #else #undef abs -#include <math.h> +#include "math.h" double r_atn2(real *x, real *y) #endif { diff --git a/libf2c/libF77/r_cnjg.c b/libf2c/libF77/r_cnjg.c index b6175eedfd7..e127ca969c4 100644 --- a/libf2c/libF77/r_cnjg.c +++ b/libf2c/libF77/r_cnjg.c @@ -1,16 +1,11 @@ #include "f2c.h" #ifdef KR_headers -VOID r_cnjg(resx, z) complex *resx, *z; +VOID r_cnjg(r, z) complex *r, *z; #else -VOID r_cnjg(complex *resx, complex *z) +VOID r_cnjg(complex *r, complex *z) #endif { -complex res; - -res.r = z->r; -res.i = - z->i; - -resx->r = res.r; -resx->i = res.i; +r->r = z->r; +r->i = - z->i; } diff --git a/libf2c/libF77/r_cos.c b/libf2c/libF77/r_cos.c index 5bda158cee9..cf5c8eb4af2 100644 --- a/libf2c/libF77/r_cos.c +++ b/libf2c/libF77/r_cos.c @@ -5,7 +5,7 @@ double cos(); double r_cos(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_cos(real *x) #endif { diff --git a/libf2c/libF77/r_cosh.c b/libf2c/libF77/r_cosh.c index 7ae72cc0cef..5756c172427 100644 --- a/libf2c/libF77/r_cosh.c +++ b/libf2c/libF77/r_cosh.c @@ -5,7 +5,7 @@ double cosh(); double r_cosh(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_cosh(real *x) #endif { diff --git a/libf2c/libF77/r_exp.c b/libf2c/libF77/r_exp.c index d1dea75563f..a95f4bc7f2b 100644 --- a/libf2c/libF77/r_exp.c +++ b/libf2c/libF77/r_exp.c @@ -5,7 +5,7 @@ double exp(); double r_exp(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_exp(real *x) #endif { diff --git a/libf2c/libF77/r_int.c b/libf2c/libF77/r_int.c index 8378e775726..11264bf1924 100644 --- a/libf2c/libF77/r_int.c +++ b/libf2c/libF77/r_int.c @@ -5,7 +5,7 @@ double floor(); double r_int(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_int(real *x) #endif { diff --git a/libf2c/libF77/r_lg10.c b/libf2c/libF77/r_lg10.c index 51f84201711..4ea02f45100 100644 --- a/libf2c/libF77/r_lg10.c +++ b/libf2c/libF77/r_lg10.c @@ -7,7 +7,7 @@ double log(); double r_lg10(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_lg10(real *x) #endif { diff --git a/libf2c/libF77/r_log.c b/libf2c/libF77/r_log.c index 4873fb418e8..aec6726ef5b 100644 --- a/libf2c/libF77/r_log.c +++ b/libf2c/libF77/r_log.c @@ -5,7 +5,7 @@ double log(); double r_log(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_log(real *x) #endif { diff --git a/libf2c/libF77/r_mod.c b/libf2c/libF77/r_mod.c index faea344a7b7..7adb44cdbec 100644 --- a/libf2c/libF77/r_mod.c +++ b/libf2c/libF77/r_mod.c @@ -12,7 +12,7 @@ double r_mod(x,y) real *x, *y; double drem(double, double); #else #undef abs -#include <math.h> +#include "math.h" #endif double r_mod(real *x, real *y) #endif diff --git a/libf2c/libF77/r_nint.c b/libf2c/libF77/r_nint.c index f5382af660a..c45bac6458f 100644 --- a/libf2c/libF77/r_nint.c +++ b/libf2c/libF77/r_nint.c @@ -5,7 +5,7 @@ double floor(); double r_nint(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_nint(real *x) #endif { diff --git a/libf2c/libF77/r_sin.c b/libf2c/libF77/r_sin.c index 095b9510de9..d2a3dac8581 100644 --- a/libf2c/libF77/r_sin.c +++ b/libf2c/libF77/r_sin.c @@ -5,7 +5,7 @@ double sin(); double r_sin(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_sin(real *x) #endif { diff --git a/libf2c/libF77/r_sinh.c b/libf2c/libF77/r_sinh.c index 3bf4bb138be..00cba0cb07f 100644 --- a/libf2c/libF77/r_sinh.c +++ b/libf2c/libF77/r_sinh.c @@ -5,7 +5,7 @@ double sinh(); double r_sinh(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_sinh(real *x) #endif { diff --git a/libf2c/libF77/r_sqrt.c b/libf2c/libF77/r_sqrt.c index d0203d3d19b..26b45458aac 100644 --- a/libf2c/libF77/r_sqrt.c +++ b/libf2c/libF77/r_sqrt.c @@ -5,7 +5,7 @@ double sqrt(); double r_sqrt(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_sqrt(real *x) #endif { diff --git a/libf2c/libF77/r_tan.c b/libf2c/libF77/r_tan.c index fc0009e4774..736b37893c4 100644 --- a/libf2c/libF77/r_tan.c +++ b/libf2c/libF77/r_tan.c @@ -5,7 +5,7 @@ double tan(); double r_tan(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_tan(real *x) #endif { diff --git a/libf2c/libF77/r_tanh.c b/libf2c/libF77/r_tanh.c index 818c6a8451b..044255a08cc 100644 --- a/libf2c/libF77/r_tanh.c +++ b/libf2c/libF77/r_tanh.c @@ -5,7 +5,7 @@ double tanh(); double r_tanh(x) real *x; #else #undef abs -#include <math.h> +#include "math.h" double r_tanh(real *x) #endif { diff --git a/libf2c/libF77/s_cat.c b/libf2c/libF77/s_cat.c index f462fd24945..038f0ecfbee 100644 --- a/libf2c/libF77/s_cat.c +++ b/libf2c/libF77/s_cat.c @@ -5,19 +5,19 @@ #include "f2c.h" #ifndef NO_OVERWRITE -#include <stdio.h> +#include "stdio.h" #undef abs #ifdef KR_headers extern char *F77_aloc(); extern void free(); - extern void G77_exit_0 (); + extern void exit_(); #else #undef min #undef max -#include <stdlib.h> +#include "stdlib.h" extern char *F77_aloc(ftnlen, char*); #endif -#include <string.h> +#include "string.h" #endif /* NO_OVERWRITE */ VOID diff --git a/libf2c/libF77/s_paus.c b/libf2c/libF77/s_paus.c index a7733a53362..796300bf7cd 100644 --- a/libf2c/libF77/s_paus.c +++ b/libf2c/libF77/s_paus.c @@ -1,4 +1,4 @@ -#include <stdio.h> +#include "stdio.h" #include "f2c.h" #define PAUSESIG 15 @@ -12,7 +12,7 @@ #undef abs #undef min #undef max -#include <stdlib.h> +#include "stdlib.h" #ifdef __cplusplus extern "C" { #endif @@ -60,7 +60,7 @@ s_paus(char *s, ftnlen n) if( isatty(fileno(stdin)) ) s_1paus(stdin); else { -#if (defined (MSDOS) && !defined (GO32)) || defined (_WIN32) +#ifdef MSDOS FILE *fin; fin = fopen("con", "r"); if (!fin) { diff --git a/libf2c/libF77/s_rnge.c b/libf2c/libF77/s_rnge.c index 189b5247ced..b200fce1bf3 100644 --- a/libf2c/libF77/s_rnge.c +++ b/libf2c/libF77/s_rnge.c @@ -1,4 +1,4 @@ -#include <stdio.h> +#include "stdio.h" #include "f2c.h" /* called when a subscript is out of range */ diff --git a/libf2c/libF77/s_stop.c b/libf2c/libF77/s_stop.c index 2e3f1035b30..be3c28ba5e5 100644 --- a/libf2c/libF77/s_stop.c +++ b/libf2c/libF77/s_stop.c @@ -1,4 +1,4 @@ -#include <stdio.h> +#include "stdio.h" #include "f2c.h" #ifdef KR_headers @@ -8,7 +8,7 @@ VOID s_stop(s, n) char *s; ftnlen n; #undef abs #undef min #undef max -#include <stdlib.h> +#include "stdlib.h" #ifdef __cplusplus extern "C" { #endif diff --git a/libf2c/libF77/sig_die.c b/libf2c/libF77/sig_die.c index bebb1e7b8f7..dba1521f81a 100644 --- a/libf2c/libF77/sig_die.c +++ b/libf2c/libF77/sig_die.c @@ -1,5 +1,5 @@ -#include <stdio.h> -#include <signal.h> +#include "stdio.h" +#include "signal.h" #ifndef SIGIOT #ifdef SIGABRT @@ -10,7 +10,7 @@ #ifdef KR_headers void sig_die(s, kill) register char *s; int kill; #else -#include <stdlib.h> +#include "stdlib.h" #ifdef __cplusplus extern "C" { #endif diff --git a/libf2c/libF77/signal_.c b/libf2c/libF77/signal_.c index b0d7ce6a69b..9f243d86e60 100644 --- a/libf2c/libF77/signal_.c +++ b/libf2c/libF77/signal_.c @@ -1,16 +1,15 @@ #include "f2c.h" #include "signal1.h" + ftnint #ifdef KR_headers -void * -G77_signal_0 (sigp, proc) integer *sigp; sig_pf proc; +signal_(sigp, proc) integer *sigp; sig_pf proc; #else -void * -G77_signal_0 (integer *sigp, sig_pf proc) +signal_(integer *sigp, sig_pf proc) #endif { int sig; sig = (int)*sigp; - return (void *) signal(sig, proc); + return (ftnint)signal(sig, proc); } diff --git a/libf2c/libF77/system_.c b/libf2c/libF77/system_.c index ed024a14ded..e6b3a02d527 100644 --- a/libf2c/libF77/system_.c +++ b/libf2c/libF77/system_.c @@ -6,16 +6,16 @@ extern char *F77_aloc(); integer -G77_system_0 (s, n) register char *s; ftnlen n; +system_(s, n) register char *s; ftnlen n; #else #undef abs #undef min #undef max -#include <stdlib.h> +#include "stdlib.h" extern char *F77_aloc(ftnlen, char*); integer -G77_system_0 (register char *s, ftnlen n) +system_(register char *s, ftnlen n) #endif { char buff0[256], *buff; diff --git a/libf2c/libF77/z_cos.c b/libf2c/libF77/z_cos.c index a811bbecc65..fdd1510db48 100644 --- a/libf2c/libF77/z_cos.c +++ b/libf2c/libF77/z_cos.c @@ -2,18 +2,14 @@ #ifdef KR_headers double sin(), cos(), sinh(), cosh(); -VOID z_cos(resx, z) doublecomplex *resx, *z; +VOID z_cos(r, z) doublecomplex *r, *z; #else #undef abs -#include <math.h> -void z_cos(doublecomplex *resx, doublecomplex *z) +#include "math.h" +void z_cos(doublecomplex *r, doublecomplex *z) #endif { -doublecomplex res; - -res.r = cos(z->r) * cosh(z->i); -res.i = - sin(z->r) * sinh(z->i); - -resx->r = res.r; -resx->i = res.i; -} + double zr = z->r; + r->r = cos(zr) * cosh(z->i); + r->i = - sin(zr) * sinh(z->i); + } diff --git a/libf2c/libF77/z_div.c b/libf2c/libF77/z_div.c index 4a987ab255a..22153fa4514 100644 --- a/libf2c/libF77/z_div.c +++ b/libf2c/libF77/z_div.c @@ -2,38 +2,35 @@ #ifdef KR_headers extern VOID sig_die(); -VOID z_div(resx, a, b) doublecomplex *a, *b, *resx; +VOID z_div(c, a, b) doublecomplex *a, *b, *c; #else extern void sig_die(char*, int); -void z_div(doublecomplex *resx, doublecomplex *a, doublecomplex *b) +void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b) #endif { -double ratio, den; -double abr, abi; -doublecomplex res; + double ratio, den; + double abr, abi, cr; -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); - res.r = (a->r*ratio + a->i) / den; - res.i = (a->i*ratio - a->r) / den; - } + 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); + cr = (a->r*ratio + a->i) / den; + c->i = (a->i*ratio - a->r) / den; + } -else - { - ratio = b->i / b->r ; - den = b->r * (1 + ratio*ratio); - res.r = (a->r + a->i*ratio) / den; - res.i = (a->i - a->r*ratio) / den; + else + { + ratio = b->i / b->r ; + den = b->r * (1 + ratio*ratio); + cr = (a->r + a->i*ratio) / den; + c->i = (a->i - a->r*ratio) / den; + } + c->r = cr; } - -resx->r = res.r; -resx->i = res.i; -} diff --git a/libf2c/libF77/z_exp.c b/libf2c/libF77/z_exp.c index 85fb63e4209..56138f3d34b 100644 --- a/libf2c/libF77/z_exp.c +++ b/libf2c/libF77/z_exp.c @@ -2,20 +2,16 @@ #ifdef KR_headers double exp(), cos(), sin(); -VOID z_exp(resx, z) doublecomplex *resx, *z; +VOID z_exp(r, z) doublecomplex *r, *z; #else #undef abs -#include <math.h> -void z_exp(doublecomplex *resx, doublecomplex *z) +#include "math.h" +void z_exp(doublecomplex *r, doublecomplex *z) #endif { double expx; -doublecomplex res; expx = exp(z->r); -res.r = expx * cos(z->i); -res.i = expx * sin(z->i); - -resx->r = res.r; -resx->i = res.i; +r->r = expx * cos(z->i); +r->i = expx * sin(z->i); } diff --git a/libf2c/libF77/z_log.c b/libf2c/libF77/z_log.c index 48afca63d6d..2d52b941d68 100644 --- a/libf2c/libF77/z_log.c +++ b/libf2c/libF77/z_log.c @@ -2,19 +2,15 @@ #ifdef KR_headers double log(), f__cabs(), atan2(); -VOID z_log(resx, z) doublecomplex *resx, *z; +VOID z_log(r, z) doublecomplex *r, *z; #else #undef abs -#include <math.h> +#include "math.h" extern double f__cabs(double, double); -void z_log(doublecomplex *resx, doublecomplex *z) +void z_log(doublecomplex *r, doublecomplex *z) #endif { -doublecomplex res; - -res.i = atan2(z->i, z->r); -res.r = log( f__cabs( z->r, z->i ) ); - -resx->r = res.r; -resx->i = res.i; -} + double zi = z->i; + r->i = atan2(zi, z->r); + r->r = log( f__cabs( z->r, zi ) ); + } diff --git a/libf2c/libF77/z_sin.c b/libf2c/libF77/z_sin.c index 94456c9c30a..577be1d85f9 100644 --- a/libf2c/libF77/z_sin.c +++ b/libf2c/libF77/z_sin.c @@ -2,18 +2,14 @@ #ifdef KR_headers double sin(), cos(), sinh(), cosh(); -VOID z_sin(resx, z) doublecomplex *resx, *z; +VOID z_sin(r, z) doublecomplex *r, *z; #else #undef abs -#include <math.h> -void z_sin(doublecomplex *resx, doublecomplex *z) +#include "math.h" +void z_sin(doublecomplex *r, doublecomplex *z) #endif { -doublecomplex res; - -res.r = sin(z->r) * cosh(z->i); -res.i = cos(z->r) * sinh(z->i); - -resx->r = res.r; -resx->i = res.i; -} + double zr = z->r; + r->r = sin(zr) * cosh(z->i); + r->i = cos(zr) * sinh(z->i); + } diff --git a/libf2c/libF77/z_sqrt.c b/libf2c/libF77/z_sqrt.c index f5db5651991..c04e8f0a1a7 100644 --- a/libf2c/libF77/z_sqrt.c +++ b/libf2c/libF77/z_sqrt.c @@ -2,32 +2,28 @@ #ifdef KR_headers double sqrt(), f__cabs(); -VOID z_sqrt(resx, z) doublecomplex *resx, *z; +VOID z_sqrt(r, z) doublecomplex *r, *z; #else #undef abs -#include <math.h> +#include "math.h" extern double f__cabs(double, double); -void z_sqrt(doublecomplex *resx, doublecomplex *z) +void z_sqrt(doublecomplex *r, doublecomplex *z) #endif { -double mag; -doublecomplex res; + double mag, zi = z->i, zr = z->r; -if( (mag = f__cabs(z->r, z->i)) == 0.) - res.r = res.i = 0.; -else if(z->r > 0) - { - res.r = sqrt(0.5 * (mag + z->r) ); - res.i = z->i / res.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 - { - res.i = sqrt(0.5 * (mag - z->r) ); - if(z->i < 0) - res.i = - res.i; - res.r = z->i / res.i / 2; - } - -resx->r = res.r; -resx->i = res.i; -} diff --git a/libf2c/libI77/Version.c b/libf2c/libI77/Version.c index 4bd5897ce6b..cce58d5b04e 100644 --- a/libf2c/libI77/Version.c +++ b/libf2c/libI77/Version.c @@ -1,9 +1,4 @@ -static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19980405\n"; - -/* -*/ - -char __G77_LIBI77_VERSION__[] = "0.5.23"; +static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19980617\n"; /* 2.01 $ format added @@ -285,18 +280,11 @@ wrtfmt.c: where trial fopen calls are used. */ /* 5 April 1998: wsfe.c: make $ format item work: this was lost in the changes of 17 March 1998. */ - - - -/* Changes for GNU Fortran (g77) version of libf2c: */ - -/* 17 June 1997: detect recursive I/O and call f__fatal explaining it. */ - -#include <stdio.h> - -void -g77__ivers__ () -{ - fprintf (stderr, "__G77_LIBI77_VERSION__: %s", __G77_LIBI77_VERSION__); - fputs (junk, stderr); -} +/* 28 May 1998: backspace.c dfe.c due.c iio.c lread.c rsfe.c sue.c wsfe.c: + set f__curunit sooner so various error messages will + correctly identify the I/O unit involved. */ +/* 17 June 1998: lread.c: unless compiled with + ALLOW_FLOAT_IN_INTEGER_LIST_INPUT #defined, treat + floating-point numbers (containing either a decimal point + or an exponent field) as errors when they appear as list + input for integer data. */ diff --git a/libf2c/libI77/backspace.c b/libf2c/libI77/backspace.c index 1da686dbb48..c3fa545df2e 100644 --- a/libf2c/libI77/backspace.c +++ b/libf2c/libI77/backspace.c @@ -1,4 +1,3 @@ -#include <sys/types.h> #include "f2c.h" #include "fio.h" #ifdef KR_headers @@ -12,11 +11,9 @@ integer f_back(alist *a) FILE *f; f__curunit = b = &f__units[a->aunit]; /* curunit for error messages */ - if (f__init & 2) - f__fatal (131, "I/O recursion"); if(a->aunit >= MXUNIT || a->aunit < 0) - err(a->aerr,101,"backspace"); - if(b->useek==0) err(a->aerr,106,"backspace"); + err(a->aerr,101,"backspace") + if(b->useek==0) err(a->aerr,106,"backspace") if((f = b->ufd) == NULL) { fk_open(1, 1, a->aunit); return(0); @@ -28,7 +25,7 @@ integer f_back(alist *a) if(b->uwrt) { (void) t_runc(a); if (f__nowreading(b)) - err(a->aerr,errno,"backspace"); + err(a->aerr,errno,"backspace") } if(b->url>0) { @@ -64,7 +61,7 @@ integer f_back(alist *a) } z = v; } - err(a->aerr,(EOF),"backspace"); + err(a->aerr,(EOF),"backspace") } break2: fseek(f, z, SEEK_SET); diff --git a/libf2c/libI77/close.c b/libf2c/libI77/close.c index bbc5bacb821..58100593f75 100644 --- a/libf2c/libI77/close.c +++ b/libf2c/libI77/close.c @@ -6,13 +6,13 @@ integer f_clos(a) cllist *a; #undef abs #undef min #undef max -#include <stdlib.h> +#include "stdlib.h" #ifdef NON_UNIX_STDIO #ifndef unlink #define unlink remove #endif #else -#if defined (MSDOS) && !defined (GO32) +#ifdef MSDOS #include "io.h" #else #ifdef __cplusplus @@ -27,8 +27,6 @@ integer f_clos(cllist *a) #endif { unit *b; - if (f__init & 2) - f__fatal (131, "I/O recursion"); if(a->cunit >= MXUNIT) return(0); b= &f__units[a->cunit]; if(b->ufd==NULL) @@ -72,15 +70,6 @@ f_exit(void) #endif { int i; static cllist xx; - if (! (f__init & 1)) - return; /* Not initialized, so no open units. */ - /* I/O no longer in progress. If, during an I/O operation (such - as waiting for the user to enter a line), there is an - interrupt (such as ^C to stop the program on a UNIX system), - f_exit() is called, but there is no longer any I/O in - progress. Without turning off this flag, f_clos() would - think that there is an I/O recursion in this circumstance. */ - f__init &= ~2; if (!xx.cerr) { xx.cerr=1; xx.csta=NULL; @@ -93,9 +82,9 @@ f_exit(void) } int #ifdef KR_headers -G77_flush_0 () +flush_() #else -G77_flush_0 (void) +flush_(void) #endif { int i; for(i=0;i<MXUNIT;i++) diff --git a/libf2c/libI77/dfe.c b/libf2c/libI77/dfe.c index f8c1fc14675..0199e1ae1a4 100644 --- a/libf2c/libI77/dfe.c +++ b/libf2c/libI77/dfe.c @@ -76,11 +76,11 @@ c_dfe(cilist *a) if(f__curunit->ufd==NULL && fk_open(DIR,FMT,a->ciunit)) err(a->cierr,104,"dfe"); f__cf=f__curunit->ufd; - if(!f__curunit->ufmt) err(a->cierr,102,"dfe"); - if(!f__curunit->useek) err(a->cierr,104,"dfe"); + if(!f__curunit->ufmt) err(a->cierr,102,"dfe") + if(!f__curunit->useek) err(a->cierr,104,"dfe") f__fmtbuf=a->cifmt; if(a->cirec <= 0) - err(a->cierr,130,"dfe"); + err(a->cierr,130,"dfe") fseek(f__cf,(long)f__curunit->url * (a->cirec-1),SEEK_SET); f__curunit->uend = 0; return(0); @@ -92,8 +92,7 @@ integer s_rdfe(cilist *a) #endif { int n; - if(f__init != 1) f_init(); - f__init = 3; + if(!f__init) f_init(); f__reading=1; if(n=c_dfe(a))return(n); if(f__curunit->uwrt && f__nowreading(f__curunit)) @@ -115,8 +114,7 @@ integer s_wdfe(cilist *a) #endif { int n; - if(f__init != 1) f_init(); - f__init = 3; + if(!f__init) f_init(); f__reading=0; if(n=c_dfe(a)) return(n); if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit)) @@ -134,7 +132,6 @@ integer s_wdfe(cilist *a) } integer e_rdfe(Void) { - f__init = 1; en_fio(); - return(0); + return 0; } diff --git a/libf2c/libI77/due.c b/libf2c/libI77/due.c index cb80a39b44d..83f4dc00a4e 100644 --- a/libf2c/libI77/due.c +++ b/libf2c/libI77/due.c @@ -7,10 +7,7 @@ c_due(a) cilist *a; c_due(cilist *a) #endif { - if(f__init != 1) f_init(); - f__init = 3; - if(a->ciunit>=MXUNIT || a->ciunit<0) - err(a->cierr,101,"startio"); + if(!f__init) f_init(); f__sequential=f__formatted=f__recpos=0; f__external=1; f__curunit = &f__units[a->ciunit]; @@ -19,11 +16,11 @@ c_due(cilist *a) f__elist=a; if(f__curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due"); f__cf=f__curunit->ufd; - 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"); + 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") if(a->cirec <= 0) - err(a->cierr,130,"due"); + err(a->cierr,130,"due") fseek(f__cf,(long)(a->cirec-1)*f__curunit->url,SEEK_SET); f__curunit->uend = 0; return(0); @@ -56,7 +53,6 @@ integer s_wdue(cilist *a) } integer e_rdue(Void) { - f__init = 1; if(f__curunit->url==1 || f__recpos==f__curunit->url) return(0); fseek(f__cf,(long)(f__curunit->url-f__recpos),SEEK_CUR); @@ -66,7 +62,6 @@ integer e_rdue(Void) } integer e_wdue(Void) { - f__init = 1; #ifdef ALWAYS_FLUSH if (fflush(f__cf)) err(f__elist->cierr,errno,"write end"); diff --git a/libf2c/libI77/endfile.c b/libf2c/libI77/endfile.c index 0b785a95165..d28b6c411d8 100644 --- a/libf2c/libI77/endfile.c +++ b/libf2c/libI77/endfile.c @@ -8,8 +8,8 @@ extern FILE *tmpfile(); #undef abs #undef min #undef max -#include <stdlib.h> -#include <string.h> +#include "stdlib.h" +#include "string.h" #endif extern char *f__r_mode[], *f__w_mode[]; @@ -23,8 +23,6 @@ integer f_end(alist *a) unit *b; FILE *tf; - if (f__init & 2) - f__fatal (131, "I/O recursion"); if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile"); b = &f__units[a->aunit]; if(b->ufd==NULL) { diff --git a/libf2c/libI77/err.c b/libf2c/libI77/err.c index 56d82ac4b19..e25d19f20b3 100644 --- a/libf2c/libI77/err.c +++ b/libf2c/libI77/err.c @@ -1,8 +1,8 @@ #ifndef NON_UNIX_STDIO #define _INCLUDE_POSIX_SOURCE /* for HP-UX */ #define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ -#include <sys/types.h> -#include <sys/stat.h> +#include "sys/types.h" +#include "sys/stat.h" #endif #include "f2c.h" #ifdef KR_headers @@ -11,22 +11,19 @@ extern char *malloc(); #undef abs #undef min #undef max -#include <stdlib.h> +#include "stdlib.h" #endif #include "fio.h" #include "fmt.h" /* for struct syl */ /*global definitions*/ unit f__units[MXUNIT]; /*unit table*/ -int f__init; /*bit 0: set after initializations; - bit 1: set during I/O involving returns to - caller of library (or calls to user code)*/ +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; -int f__fmtlen; flag f__external; /*1 if external io, 0 if internal */ #ifdef KR_headers int (*f__doed)(),(*f__doned)(); @@ -80,9 +77,7 @@ char *F_err[] = "can't write file", /* 127 */ "'new' file exists", /* 128 */ "can't append to file", /* 129 */ - "non-positive record number", /* 130 */ - "I/O started while already doing I/O", /* 131 */ - "Temporary file name (TMPDIR?) too long" /* 132 */ + "non-positive record number" /* 130 */ }; #define MAXERR (sizeof(F_err)/sizeof(char *)+100) @@ -147,8 +142,6 @@ f__fatal(n,s) char *s; f__fatal(int n, char *s) #endif { - static int dead = 0; - if(n<100 && n>=0) perror(s); /*SYSDEP*/ else if(n >= (int)MAXERR || n < -1) { fprintf(stderr,"%s: illegal error number %d\n",s,n); @@ -156,26 +149,18 @@ f__fatal(int n, char *s) else if(n == -1) fprintf(stderr,"%s: end of file\n",s); else fprintf(stderr,"%s: %s\n",s,F_err[n-100]); - if (dead) { - fprintf (stderr, "(libf2c f__fatal already called, aborting.)"); - abort(); - } - dead = 1; - if (f__init & 1) { - if (f__curunit) { - fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units); - fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", - f__curunit->ufnm); - } - else - fprintf(stderr,"apparent state: internal I/O\n"); - if (f__fmtbuf) - fprintf(stderr,"last format: %.*s\n",f__fmtlen,f__fmtbuf); - fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing", - f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted", - f__external?"external":"internal"); - } - f__init &= ~2; /* No longer doing I/O (no more user code to be called). */ + if (f__curunit) { + fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units); + fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", + f__curunit->ufnm); + } + else + fprintf(stderr,"apparent state: internal I/O\n"); + if (f__fmtbuf) + fprintf(stderr,"last format: %s\n",f__fmtbuf); + fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing", + f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted", + f__external?"external":"internal"); sig_die(" IO", 1); } /*initialization routine*/ @@ -183,9 +168,7 @@ f__fatal(int n, char *s) f_init(Void) { unit *p; - if (f__init & 2) - f__fatal (131, "I/O recursion"); - f__init = 1; + f__init=1; p= &f__units[0]; p->ufd=stderr; p->useek=f__canseek(stderr); @@ -283,6 +266,5 @@ err__fl(int f, int m, char *s) f__fatal(m, s); if (f__doend) (*f__doend)(); - f__init &= ~2; return errno = m; } diff --git a/libf2c/libI77/fio.h b/libf2c/libI77/fio.h index 846351d5413..bb20dd2ca04 100644 --- a/libf2c/libI77/fio.h +++ b/libf2c/libI77/fio.h @@ -1,11 +1,8 @@ -#include <stdio.h> -#include <errno.h> +#include "stdio.h" +#include "errno.h" #ifndef NULL /* ANSI C */ -#include <stddef.h> -#endif -#ifdef STDC_HEADERS -#include <string.h> +#include "stddef.h" #endif #ifndef SEEK_SET @@ -14,7 +11,7 @@ #define SEEK_END 2 #endif -#if defined (MSDOS) && !defined (GO32) +#ifdef MSDOS #ifndef NON_UNIX_STDIO #define NON_UNIX_STDIO #endif @@ -30,7 +27,7 @@ typedef long uiolen; typedef struct { FILE *ufd; /*0=unconnected*/ char *ufnm; -#if !(defined (MSDOS) && !defined (GO32)) +#ifndef MSDOS long uinode; int udev; #endif @@ -44,7 +41,7 @@ typedef struct flag uscrtch; } unit; -extern int f__init; +extern flag f__init; extern cilist *f__elist; /*active external io list*/ extern flag f__reading,f__external,f__sequential,f__formatted; #undef Void @@ -88,8 +85,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) do {if(f) {f__init &= ~2; errno= m;} else f__fatal(m,s); return(m);} while(0) -#define errfl(f,m,s) do {return err__fl((int)f,m,s);} while(0) +#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 diff --git a/libf2c/libI77/fmt.c b/libf2c/libI77/fmt.c index 8f08952ed45..364210c2624 100644 --- a/libf2c/libI77/fmt.c +++ b/libf2c/libI77/fmt.c @@ -103,6 +103,7 @@ char *f_s(char *s, int curloc) { return(NULL); } + skip(s); return(s); } @@ -364,39 +365,11 @@ pars_f(s) char *s; pars_f(char *s) #endif { - char *e; - f__parenlvl=f__revloc=f__pc=0; - if((e=f_s(s,0)) == NULL) + if(f_s(s,0) == NULL) { - /* Try and delimit the format string. Parens within - hollerith and quoted strings have to match for this - to work, but it's probably adequate for most needs. - Note that this is needed because a valid CHARACTER - variable passed for FMT= can contain '(I)garbage', - where `garbage' is billions and billions of junk - characters, and it's up to the run-time library to - know where the format string ends by counting parens. - Meanwhile, still treat NUL byte as "hard stop", since - f2c still appends that at end of FORMAT-statement - strings. */ - - int level=0; - - for (f__fmtlen=0; - ((*s!=')') || (--level > 0)) - && (*s!='\0') - && (f__fmtlen<80); - ++s, ++f__fmtlen) - { - if (*s=='(') - ++level; - } - if (*s==')') - ++f__fmtlen; return(-1); } - f__fmtlen = e - s; return(0); } #define STKSZ 10 @@ -448,8 +421,8 @@ integer do_fio(ftnint *number, char *ptr, ftnlen len) loop: switch(type_f((p= &f__syl[f__pc])->op)) { default: - fprintf(stderr,"unknown code in do_fio: %d\n%.*s\n", - p->op,f__fmtlen,f__fmtbuf); + fprintf(stderr,"unknown code in do_fio: %d\n%s\n", + p->op,f__fmtbuf); err(f__elist->cierr,100,"do_fio"); case NED: if((*f__doned)(p)) diff --git a/libf2c/libI77/fmt.h b/libf2c/libI77/fmt.h index 6197e76ed5a..19065a2f045 100644 --- a/libf2c/libI77/fmt.h +++ b/libf2c/libI77/fmt.h @@ -79,7 +79,6 @@ extern int wrt_L(Uint*, int, ftnlen); #endif extern flag f__cblank,f__cplus,f__workdone, f__nonl; extern char *f__fmtbuf; -extern int f__fmtlen; extern int f__scale; #define GET(x) if((x=(*f__getn)())<0) return(x) #define VAL(x) (x!='\n'?x:' ') diff --git a/libf2c/libI77/ftell_.c b/libf2c/libI77/ftell_.c index 1bd03be325a..2d3aad999af 100644 --- a/libf2c/libI77/ftell_.c +++ b/libf2c/libI77/ftell_.c @@ -15,24 +15,24 @@ unit_chk(integer Unit, char *who) integer #ifdef KR_headers -G77_ftell_0 (Unit) integer *Unit; +ftell_(Unit) integer *Unit; #else -G77_ftell_0 (integer *Unit) +ftell_(integer *Unit) #endif { FILE *f; return (f = unit_chk(*Unit, "ftell")) ? ftell(f) : -1L; } - integer + int #ifdef KR_headers -G77_fseek_0 (Unit, offset, xwhence) integer *Unit, *offset, *xwhence; +fseek_(Unit, offset, whence) integer *Unit, *offset, *whence; #else -G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence) +fseek_(integer *Unit, integer *offset, integer *whence) #endif { FILE *f; - int w = (int)*xwhence; + int w = (int)*whence; #ifdef SEEK_SET static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END }; #endif diff --git a/libf2c/libI77/iio.c b/libf2c/libI77/iio.c index 931f15aab63..58b2a75cddd 100644 --- a/libf2c/libI77/iio.c +++ b/libf2c/libI77/iio.c @@ -47,9 +47,6 @@ c_si(a) icilist *a; c_si(icilist *a) #endif { - if (f__init & 2) - f__fatal (131, "I/O recursion"); - f__init |= 2; f__elist = (cilist *)a; f__fmtbuf=a->icifmt; f__curunit = 0; @@ -126,16 +123,13 @@ integer s_wsfi(icilist *a) return(0); } integer e_rsfi(Void) -{ int n; - f__init &= ~2; - n = en_fio(); +{ int n = en_fio(); f__fmtbuf = NULL; return(n); } integer e_wsfi(Void) { int n; - f__init &= ~2; n = en_fio(); f__fmtbuf = NULL; if(f__svic->icirnum != 1 diff --git a/libf2c/libI77/ilnw.c b/libf2c/libI77/ilnw.c index abc64099d31..aff38315344 100644 --- a/libf2c/libI77/ilnw.c +++ b/libf2c/libI77/ilnw.c @@ -51,8 +51,6 @@ s_wsni(icilist *a) { cilist ca; - if(f__init != 1) f_init(); - f__init = 3; c_liw(a); ca.cifmt = a->icifmt; x_wsne(&ca); @@ -67,8 +65,6 @@ s_wsli(a) icilist *a; s_wsli(icilist *a) #endif { - if(f__init != 1) f_init(); - f__init = 3; f__lioproc = l_write; c_liw(a); return(0); @@ -76,7 +72,6 @@ s_wsli(icilist *a) integer e_wsli(Void) { - f__init = 1; z_wSL(); return(0); } diff --git a/libf2c/libI77/inquire.c b/libf2c/libI77/inquire.c index 963d4c3e5e8..29491659a67 100644 --- a/libf2c/libI77/inquire.c +++ b/libf2c/libI77/inquire.c @@ -1,10 +1,10 @@ #include "f2c.h" #include "fio.h" -#include <string.h> +#include "string.h" #ifdef KR_headers integer f_inqu(a) inlist *a; #else -#if defined (MSDOS) && !defined (GO32) +#ifdef MSDOS #undef abs #undef min #undef max @@ -17,8 +17,6 @@ integer f_inqu(inlist *a) unit *p; char buf[256]; long x; - if (f__init & 2) - f__fatal (131, "I/O recursion"); if(a->infile!=NULL) { byfile=1; g_char(a->infile,a->infilen,buf); diff --git a/libf2c/libI77/lread.c b/libf2c/libI77/lread.c index 24b621db15b..6f537a7ebff 100644 --- a/libf2c/libI77/lread.c +++ b/libf2c/libI77/lread.c @@ -1,4 +1,3 @@ -#include <ctype.h> #include "f2c.h" #include "fio.h" @@ -8,11 +7,9 @@ extern char *f__fmtbuf; -extern int f__fmtlen; #ifdef Allow_TYQUAD static longint f__llx; -static int quad_read; #endif #ifdef KR_headers @@ -23,13 +20,14 @@ int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)(); #undef abs #undef min #undef max -#include <stdlib.h> +#include "stdlib.h" int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void), (*l_ungetc)(int,FILE*); #endif #include "fmt.h" #include "lio.h" +#include "ctype.h" #include "fp.h" int l_eof; @@ -86,7 +84,6 @@ t_getc(Void) integer e_rsle(Void) { int ch; - f__init = 1; if(f__curunit->uend) return(0); while((ch=t_getc())!='\n') if (ch == EOF) { @@ -101,7 +98,7 @@ flag f__lquit; int f__lcount,f__ltype,nml_read; char *f__lchar; double f__lx,f__ly; -#define ERR(x) if(n=(x)) {f__init &= ~2; return(n);} +#define ERR(x) if(n=(x)) return(n) #define GETC(x) (x=(*l_getc)()) #define Ungetc(x,y) (*l_ungetc)(x,y) @@ -531,11 +528,10 @@ c_le(a) cilist *a; c_le(cilist *a) #endif { - if(f__init != 1) f_init(); - f__init = 3; + if(!f__init) + f_init(); f__fmtbuf="list io"; f__curunit = &f__units[a->ciunit]; - f__fmtlen=7; if(a->ciunit>=MXUNIT || a->ciunit<0) err(a->cierr,101,"stler"); f__scale=f__recpos=0; @@ -543,7 +539,7 @@ c_le(cilist *a) if(f__curunit->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) err(a->cierr,102,"lio"); f__cf=f__curunit->ufd; - if(!f__curunit->ufmt) err(a->cierr,103,"lio"); + if(!f__curunit->ufmt) err(a->cierr,103,"lio") return(0); } #ifdef KR_headers @@ -560,14 +556,14 @@ l_read(ftnint *number, char *ptr, ftnlen len, ftnint type) { if(f__lquit) return(0); if(l_eof) - err(f__elist->ciend, EOF, "list in"); + err(f__elist->ciend, EOF, "list in") if(f__lcount == 0) { f__ltype = 0; for(;;) { GETC(ch); switch(ch) { case EOF: - err(f__elist->ciend,(EOF),"list in"); + err(f__elist->ciend,(EOF),"list in") case ' ': case '\t': case '\n': diff --git a/libf2c/libI77/open.c b/libf2c/libI77/open.c index 29b7662b106..4ef58afbb4d 100644 --- a/libf2c/libI77/open.c +++ b/libf2c/libI77/open.c @@ -1,6 +1,6 @@ #include "f2c.h" #include "fio.h" -#include <string.h> +#include "string.h" #ifndef NON_POSIX_STDIO #ifdef MSDOS #include "io.h" @@ -19,7 +19,7 @@ extern integer f_clos(); #undef abs #undef min #undef max -#include <stdlib.h> +#include "stdlib.h" extern int f__canseek(FILE*); extern integer f_clos(cllist*); #endif @@ -104,8 +104,7 @@ x_putc(int c) f__buf[f__recpos++] = c; } -#define opnerr(f,m,s) \ - do {if(f) {f__init &= ~2; errno= m;} else opn_err(m,s,a); return(m);} while(0) +#define opnerr(f,m,s) {if(f) errno= m; else opn_err(m,s,a); return(m);} static void #ifdef KR_headers @@ -137,9 +136,10 @@ integer f_open(olist *a) #ifndef NON_UNIX_STDIO int n; #endif - if(f__init != 1) f_init(); if(a->ounit>=MXUNIT || a->ounit<0) - err(a->oerr,101,"open"); + err(a->oerr,101,"open") + if (!f__init) + f_init(); f__curunit = b = &f__units[a->ounit]; if(b->ufd) { if(a->ofnm==0) @@ -180,7 +180,7 @@ integer f_open(olist *a) if (a->ofnm) { g_char(a->ofnm,a->ofnmlen,buf); if (!buf[0]) - opnerr(a->oerr,107,"open"); + opnerr(a->oerr,107,"open") } else sprintf(buf, "fort.%ld", a->ounit); @@ -195,35 +195,23 @@ integer f_open(olist *a) case 'O': #ifdef NON_POSIX_STDIO if (!(tf = fopen(buf,"r"))) - opnerr(a->oerr,errno,"open"); + opnerr(a->oerr,errno,"open") fclose(tf); #else if (access(buf,0)) - opnerr(a->oerr,errno,"open"); + opnerr(a->oerr,errno,"open") #endif break; case 's': case 'S': b->uscrtch=1; #ifdef NON_ANSI_STDIO -#ifdef HAVE_TEMPNAM /* Allow use of TMPDIR preferentially. */ - s = tempnam (0, buf); - if (strlen (s) >= sizeof (buf)) - err (a->oerr, 132, "open"); - (void) strcpy (buf, s); - free (s); -#else /* ! defined (HAVE_TEMPNAM) */ -#ifdef _POSIX_SOURCE - tmpnam(buf); -#else (void) strcpy(buf,"tmp.FXXXXXX"); (void) mktemp(buf); -#endif -#endif /* ! defined (HAVE_TEMPNAM) */ goto replace; #else if (!(b->ufd = tmpfile())) - opnerr(a->oerr,errno,"open"); + opnerr(a->oerr,errno,"open") b->ufnm = 0; #ifndef NON_UNIX_STDIO b->uinode = b->udev = -1; @@ -237,11 +225,11 @@ integer f_open(olist *a) #ifdef NON_POSIX_STDIO if ((tf = fopen(buf,"r")) || (tf = fopen(buf,"a"))) { fclose(tf); - opnerr(a->oerr,128,"open"); + opnerr(a->oerr,128,"open") } #else if (!access(buf,0)) - opnerr(a->oerr,128,"open"); + opnerr(a->oerr,128,"open") #endif /* no break */ case 'r': /* Fortran 90 replace option */ @@ -271,7 +259,7 @@ integer f_open(olist *a) b->useek = f__canseek(b->ufd = tf); #ifndef NON_UNIX_STDIO if((b->uinode = f__inode(buf,&b->udev)) == -1) - opnerr(a->oerr,108,"open"); + opnerr(a->oerr,108,"open") #endif if(b->useek) if (a->orl) @@ -288,9 +276,6 @@ fk_open(int seq, int fmt, ftnint n) #endif { char nbuf[10]; olist a; - int rtn; - int save_init; - (void) sprintf(nbuf,"fort.%ld",n); a.oerr=1; a.ounit=n; @@ -301,9 +286,5 @@ fk_open(int seq, int fmt, ftnint n) a.ofm = fmt==FMT?"f":"u"; a.orl = seq==DIR?1:0; a.oblnk=NULL; - save_init = f__init; - f__init &= ~2; - rtn = f_open(&a); - f__init = save_init | 1; - return rtn; + return(f_open(&a)); } diff --git a/libf2c/libI77/rawio.h b/libf2c/libI77/rawio.h index f3a59fdab4d..fd36a482602 100644 --- a/libf2c/libI77/rawio.h +++ b/libf2c/libI77/rawio.h @@ -1,5 +1,5 @@ #ifndef KR_headers -#if defined (MSDOS) && !defined (GO32) +#ifdef MSDOS #include "io.h" #ifndef WATCOM #define close _close @@ -12,14 +12,12 @@ #ifdef __cplusplus extern "C" { #endif -#if !(defined (MSDOS) && !defined (GO32)) +#ifndef MSDOS #ifdef OPEN_DECL extern int creat(const char*,int), open(const char*,int); #endif extern int close(int); -#if !(defined(_WIN32) && !defined(__CYGWIN32__)) extern int read(int,void*,size_t), write(int,void*,size_t); -#endif extern int unlink(const char*); #ifndef _POSIX_SOURCE #ifndef NON_UNIX_STDIO @@ -35,9 +33,7 @@ extern char *mktemp(char*); #endif #endif -#ifndef NO_FCNTL -#include <fcntl.h> -#endif +#include "fcntl.h" #ifndef O_WRONLY #define O_RDONLY 0 diff --git a/libf2c/libI77/rdfmt.c b/libf2c/libI77/rdfmt.c index b03bcc5dbf6..3de3e494ca6 100644 --- a/libf2c/libI77/rdfmt.c +++ b/libf2c/libI77/rdfmt.c @@ -1,4 +1,3 @@ -#include <ctype.h> #include "f2c.h" #include "fio.h" @@ -9,11 +8,12 @@ extern double atof(); #undef abs #undef min #undef max -#include <stdlib.h> +#include "stdlib.h" #endif #include "fmt.h" #include "fp.h" +#include "ctype.h" static int #ifdef KR_headers diff --git a/libf2c/libI77/rewind.c b/libf2c/libI77/rewind.c index 9ba4b239f32..e58daad7b8a 100644 --- a/libf2c/libI77/rewind.c +++ b/libf2c/libI77/rewind.c @@ -7,15 +7,13 @@ integer f_rew(alist *a) #endif { unit *b; - if (f__init & 2) - f__fatal (131, "I/O recursion"); if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"rewind"); b = &f__units[a->aunit]; if(b->ufd == NULL || b->uwrt == 3) return(0); if(!b->useek) - err(a->aerr,106,"rewind"); + err(a->aerr,106,"rewind") if(b->uwrt) { (void) t_runc(a); b->uwrt = 3; diff --git a/libf2c/libI77/rsfe.c b/libf2c/libI77/rsfe.c index a79cd79f03c..c6e7f954a94 100644 --- a/libf2c/libI77/rsfe.c +++ b/libf2c/libI77/rsfe.c @@ -49,8 +49,7 @@ integer s_rsfe(a) cilist *a; /* start */ integer s_rsfe(cilist *a) /* start */ #endif { int n; - if(f__init != 1) f_init(); - f__init = 3; + if(!f__init) f_init(); f__reading=1; f__sequential=1; f__formatted=1; @@ -60,7 +59,6 @@ integer s_rsfe(cilist *a) /* start */ f__cursor=f__recpos=0; f__scale=0; f__fmtbuf=a->cifmt; - f__curunit= &f__units[a->ciunit]; f__cf=f__curunit->ufd; if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio"); f__getn= x_getc; diff --git a/libf2c/libI77/rsli.c b/libf2c/libI77/rsli.c index baf2ba54873..a081cd589aa 100644 --- a/libf2c/libI77/rsli.c +++ b/libf2c/libI77/rsli.c @@ -46,8 +46,6 @@ c_lir(icilist *a) #endif { extern int l_eof; - if(f__init != 1) f_init(); - f__init = 3; f__reading = 1; f__external = 0; f__formatted = 1; @@ -82,7 +80,7 @@ integer s_rsli(icilist *a) } integer e_rsli(Void) -{ f__init = 1; return 0; } +{ return 0; } #ifdef KR_headers integer s_rsni(a) icilist *a; diff --git a/libf2c/libI77/rsne.c b/libf2c/libI77/rsne.c index 86bb2164f12..cc679c76086 100644 --- a/libf2c/libI77/rsne.c +++ b/libf2c/libI77/rsne.c @@ -54,8 +54,8 @@ un_getc(x,f__cf) int x; FILE *f__cf; #undef abs #undef min #undef max -#include <stdlib.h> -#include <string.h> +#include "stdlib.h" +#include "string.h" #ifdef ungetc static int @@ -149,6 +149,8 @@ nl_init(Void) { register char *s; register int c; + if(!f__init) + f_init(); for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; ) Alpha[c] = Alphanum[c] @@ -338,7 +340,7 @@ x_rsne(cilist *a) #endif } have_amp: - if (ch = getname(buf,(int) sizeof(buf))) + if (ch = getname(buf,sizeof(buf))) return ch; nl = (Namelist *)a->cifmt; if (strcmp(buf, nl->name)) @@ -393,7 +395,7 @@ x_rsne(cilist *a) if (ch <= ' ' && ch >= 0 || ch == ',') continue; Ungetc(ch,f__cf); - if (ch = getname(buf,(int) sizeof(buf))) + if (ch = getname(buf,sizeof(buf))) return ch; goto havename; } diff --git a/libf2c/libI77/sfe.c b/libf2c/libI77/sfe.c index c7d891804b3..5656aa169bf 100644 --- a/libf2c/libI77/sfe.c +++ b/libf2c/libI77/sfe.c @@ -6,7 +6,6 @@ extern char *f__fmtbuf; integer e_rsfe(Void) { int n; - f__init = 1; n=en_fio(); f__fmtbuf=NULL; return(n); @@ -17,19 +16,17 @@ c_sfe(a) cilist *a; /* check */ c_sfe(cilist *a) /* check */ #endif { unit *p; + f__curunit = p = &f__units[a->ciunit]; if(a->ciunit >= MXUNIT || a->ciunit<0) err(a->cierr,101,"startio"); - p = &f__units[a->ciunit]; - if(p->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) err(a->cierr,114,"sfe"); - if(!p->ufmt) err(a->cierr,102,"sfe"); + if(p->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) err(a->cierr,114,"sfe") + if(!p->ufmt) err(a->cierr,102,"sfe") return(0); } integer e_wsfe(Void) { - int n; - f__init = 1; - n = en_fio(); - f__fmtbuf=NULL; + int n = en_fio(); + f__fmtbuf = NULL; return n; } diff --git a/libf2c/libI77/sue.c b/libf2c/libI77/sue.c index eacb1d69b01..d2a7c34f12e 100644 --- a/libf2c/libI77/sue.c +++ b/libf2c/libI77/sue.c @@ -18,8 +18,8 @@ c_sue(cilist *a) if(f__curunit->ufd==NULL && fk_open(SEQ,UNF,a->ciunit)) err(a->cierr,114,"sue"); f__cf=f__curunit->ufd; - if(f__curunit->ufmt) err(a->cierr,103,"sue"); - if(!f__curunit->useek) err(a->cierr,103,"sue"); + if(f__curunit->ufmt) err(a->cierr,103,"sue") + if(!f__curunit->useek) err(a->cierr,103,"sue") return(0); } #ifdef KR_headers @@ -29,8 +29,7 @@ integer s_rsue(cilist *a) #endif { int n; - if(f__init != 1) f_init(); - f__init = 3; + if(!f__init) f_init(); f__reading=1; if(n=c_sue(a)) return(n); f__recpos=0; @@ -54,8 +53,7 @@ integer s_wsue(cilist *a) #endif { int n; - if(f__init != 1) f_init(); - f__init = 3; + if(!f__init) f_init(); if(n=c_sue(a)) return(n); f__reading=0; f__reclen=0; @@ -67,7 +65,6 @@ integer s_wsue(cilist *a) } integer e_wsue(Void) { long loc; - f__init = 1; fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); #ifdef ALWAYS_FLUSH if (fflush(f__cf)) @@ -81,7 +78,6 @@ integer e_wsue(Void) } integer e_rsue(Void) { - f__init = 1; (void) fseek(f__cf,(long)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR); return(0); } diff --git a/libf2c/libI77/uio.c b/libf2c/libI77/uio.c index ea733cec06c..e40875e0f7b 100644 --- a/libf2c/libI77/uio.c +++ b/libf2c/libI77/uio.c @@ -1,6 +1,5 @@ #include "f2c.h" #include "fio.h" -#include <sys/types.h> uiolen f__reclen; #ifdef KR_headers @@ -14,14 +13,14 @@ do_us(ftnint *number, char *ptr, ftnlen len) f__recpos += (int)(*number * len); if(f__recpos>f__reclen) err(f__elist->cierr, 110, "do_us"); - if (fread(ptr,(size_t)len,(size_t)(*number),f__cf) != *number) + if (fread(ptr,(int)len,(int)(*number),f__cf) != *number) err(f__elist->ciend, EOF, "do_us"); return(0); } else { f__reclen += *number * len; - (void) fwrite(ptr,(size_t)len,(size_t)(*number),f__cf); + (void) fwrite(ptr,(int)len,(int)(*number),f__cf); return(0); } } @@ -42,19 +41,19 @@ integer do_ud(ftnint *number, char *ptr, ftnlen len) #else size_t i; #endif - if (!(i = fread(ptr,(size_t)len,(size_t)(*number),f__cf)) + if (!(i = fread(ptr,(int)len,(int)(*number),f__cf)) && !(f__recpos - *number*len)) - err(f__elist->cierr,EOF,"do_ud"); + err(f__elist->cierr,EOF,"do_ud") if (i < *number) memset(ptr + i*len, 0, (*number - i)*len); return 0; #else - if(fread(ptr,(size_t)len,(size_t)(*number),f__cf) != *number) - err(f__elist->cierr,EOF,"do_ud"); + if(fread(ptr,(int)len,(int)(*number),f__cf) != *number) + err(f__elist->cierr,EOF,"do_ud") else return(0); #endif } - (void) fwrite(ptr,(size_t)len,(size_t)(*number),f__cf); + (void) fwrite(ptr,(int)len,(int)(*number),f__cf); return(0); } #ifdef KR_headers diff --git a/libf2c/libI77/util.c b/libf2c/libI77/util.c index ccaad2d3b6f..6468db0cd2a 100644 --- a/libf2c/libI77/util.c +++ b/libf2c/libI77/util.c @@ -1,8 +1,8 @@ #ifndef NON_UNIX_STDIO #define _INCLUDE_POSIX_SOURCE /* for HP-UX */ #define _INCLUDE_XOPEN_SOURCE /* for HP-UX */ -#include <sys/types.h> -#include <sys/stat.h> +#include "sys/types.h" +#include "sys/stat.h" #endif #include "f2c.h" #include "fio.h" diff --git a/libf2c/libI77/wref.c b/libf2c/libI77/wref.c index a10bcaa1236..2f3fce89dd3 100644 --- a/libf2c/libI77/wref.c +++ b/libf2c/libI77/wref.c @@ -1,19 +1,19 @@ #include "f2c.h" #include "fio.h" -#ifndef VAX -#include <ctype.h> -#endif #ifndef KR_headers #undef abs #undef min #undef max -#include <stdlib.h> -#include <string.h> +#include "stdlib.h" +#include "string.h" #endif #include "fmt.h" #include "fp.h" +#ifndef VAX +#include "ctype.h" +#endif #ifdef KR_headers wrt_E(p,w,d,e,len) ufloat *p; ftnlen len; diff --git a/libf2c/libI77/wsfe.c b/libf2c/libI77/wsfe.c index babfb3479d9..a74e2d5c2aa 100644 --- a/libf2c/libI77/wsfe.c +++ b/libf2c/libI77/wsfe.c @@ -45,8 +45,7 @@ integer s_wsfe(a) cilist *a; /*start*/ integer s_wsfe(cilist *a) /*start*/ #endif { int n; - if(f__init != 1) f_init(); - f__init = 3; + if(!f__init) f_init(); f__reading=0; f__sequential=1; f__formatted=1; @@ -57,7 +56,6 @@ integer s_wsfe(cilist *a) /*start*/ f__nonl = 0; f__scale=0; f__fmtbuf=a->cifmt; - f__curunit = &f__units[a->ciunit]; f__cf=f__curunit->ufd; if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio"); f__putn= x_putc; diff --git a/libf2c/libI77/wsle.c b/libf2c/libI77/wsle.c index f8555d79c45..4bb862f43de 100644 --- a/libf2c/libI77/wsle.c +++ b/libf2c/libI77/wsle.c @@ -26,9 +26,7 @@ integer s_wsle(cilist *a) integer e_wsle(Void) { - int n; - f__init = 1; - n = f__putbuf('\n'); + int n = f__putbuf('\n'); f__recpos=0; #ifdef ALWAYS_FLUSH if (!n && fflush(f__cf)) diff --git a/libf2c/libI77/xwsne.c b/libf2c/libI77/xwsne.c index 71f6f1d5da5..41c929b0796 100644 --- a/libf2c/libI77/xwsne.c +++ b/libf2c/libI77/xwsne.c @@ -15,7 +15,7 @@ nl_donewrec(Void) #ifdef KR_headers x_wsne(a) cilist *a; #else -#include <string.h> +#include "string.h" VOID x_wsne(cilist *a) |