diff options
Diffstat (limited to 'contrib/libf2c/libI77/wref.c')
-rw-r--r-- | contrib/libf2c/libI77/wref.c | 472 |
1 files changed, 251 insertions, 221 deletions
diff --git a/contrib/libf2c/libI77/wref.c b/contrib/libf2c/libI77/wref.c index a10bcaa..0dc3091 100644 --- a/contrib/libf2c/libI77/wref.c +++ b/contrib/libf2c/libI77/wref.c @@ -4,273 +4,303 @@ #include <ctype.h> #endif -#ifndef KR_headers #undef abs #undef min #undef max #include <stdlib.h> #include <string.h> -#endif #include "fmt.h" #include "fp.h" -#ifdef KR_headers -wrt_E(p,w,d,e,len) ufloat *p; ftnlen len; -#else -wrt_E(ufloat *p, int w, int d, int e, ftnlen len) -#endif +int +wrt_E (ufloat * p, int w, int d, int e, ftnlen len) { - char buf[FMAX+EXPMAXDIGS+4], *s, *se; - int d1, delta, e1, i, sign, signspace; - double dd; + char buf[FMAX + EXPMAXDIGS + 4], *s, *se; + int d1, delta, e1, i, sign, signspace; + double dd; #ifdef WANT_LEAD_0 - int insert0 = 0; + int insert0 = 0; #endif #ifndef VAX - int e0 = e; + int e0 = e; #endif - if(e <= 0) - e = 2; - if(f__scale) { - if(f__scale >= d + 2 || f__scale <= -d) - goto nogood; - } - if(f__scale <= 0) - --d; - if (len == sizeof(real)) - dd = p->pf; - else - dd = p->pd; - if (dd < 0.) { - signspace = sign = 1; - dd = -dd; - } - else { - sign = 0; - signspace = (int)f__cplus; + if (e <= 0) + e = 2; + if (f__scale) + { + if (f__scale >= d + 2 || f__scale <= -d) + goto nogood; + } + if (f__scale <= 0) + --d; + if (len == sizeof (real)) + dd = p->pf; + else + dd = p->pd; + if (dd < 0.) + { + signspace = sign = 1; + dd = -dd; + } + else + { + sign = 0; + signspace = (int) f__cplus; #ifndef VAX - if (!dd) - dd = 0.; /* avoid -0 */ + if (!dd) + dd = 0.; /* avoid -0 */ #endif - } - delta = w - (2 /* for the . and the d adjustment above */ - + 2 /* for the E+ */ + signspace + d + e); + } + delta = w - (2 /* for the . and the d adjustment above */ + + 2 /* for the E+ */ + signspace + d + e); #ifdef WANT_LEAD_0 - if (f__scale <= 0 && delta > 0) { - delta--; - insert0 = 1; - } - else + if (f__scale <= 0 && delta > 0) + { + delta--; + insert0 = 1; + } + else #endif - if (delta < 0) { -nogood: - while(--w >= 0) - PUT('*'); - return(0); - } - if (f__scale < 0) - d += f__scale; - if (d > FMAX) { - d1 = d - FMAX; - d = FMAX; - } - else - d1 = 0; - sprintf(buf,"%#.*E", d, dd); + if (delta < 0) + { + nogood: + while (--w >= 0) + PUT ('*'); + return (0); + } + if (f__scale < 0) + d += f__scale; + if (d > FMAX) + { + d1 = d - FMAX; + d = FMAX; + } + else + d1 = 0; + sprintf (buf, "%#.*E", d, dd); #ifndef VAX - /* check for NaN, Infinity */ - if (!isdigit(buf[0])) { - switch(buf[0]) { - case 'n': - case 'N': - signspace = 0; /* no sign for NaNs */ - } - delta = w - strlen(buf) - signspace; - if (delta < 0) - goto nogood; - while(--delta >= 0) - PUT(' '); - if (signspace) - PUT(sign ? '-' : '+'); - for(s = buf; *s; s++) - PUT(*s); - return 0; - } + /* check for NaN, Infinity */ + if (!isdigit ((unsigned char) buf[0])) + { + switch (buf[0]) + { + case 'n': + case 'N': + signspace = 0; /* no sign for NaNs */ + } + delta = w - strlen (buf) - signspace; + if (delta < 0) + goto nogood; + while (--delta >= 0) + PUT (' '); + if (signspace) + PUT (sign ? '-' : '+'); + for (s = buf; *s; s++) + PUT (*s); + return 0; + } #endif - se = buf + d + 3; -#ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */ - if (f__scale != 1 && dd) - sprintf(se, "%+.2d", atoi(se) + 1 - f__scale); + se = buf + d + 3; +#ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */ + if (f__scale != 1 && dd) + sprintf (se, "%+.2d", atoi (se) + 1 - f__scale); #else - if (dd) - sprintf(se, "%+.2d", atoi(se) + 1 - f__scale); - else - strcpy(se, "+00"); + if (dd) + sprintf (se, "%+.2d", atoi (se) + 1 - f__scale); + else + strcpy (se, "+00"); #endif - s = ++se; - if (e < 2) { - if (*s != '0') - goto nogood; - } + s = ++se; + if (e < 2) + { + if (*s != '0') + goto nogood; + } #ifndef VAX - /* accommodate 3 significant digits in exponent */ - if (s[2]) { + /* accommodate 3 significant digits in exponent */ + if (s[2]) + { #ifdef Pedantic - if (!e0 && !s[3]) - for(s -= 2, e1 = 2; s[0] = s[1]; s++); + if (!e0 && !s[3]) + 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 */ - /* of more than 3 digits. With Pedantic undefined, we get */ - /* the behavior that Cray displays -- you get a bigger */ - /* exponent field if it fits. */ + /* Pedantic gives the behavior that Fortran 77 specifies, */ + /* i.e., requires that E be specified for exponent fields */ + /* of more than 3 digits. With Pedantic undefined, we get */ + /* the behavior that Cray displays -- you get a bigger */ + /* exponent field if it fits. */ #else - if (!e0) { - for(s -= 2, e1 = 2; s[0] = s[1]; s++) + if (!e0) + { + for (s -= 2, e1 = 2; (s[0] = s[1]); s++) #ifdef CRAY - delta--; - if ((delta += 4) < 0) - goto nogood + delta--; + if ((delta += 4) < 0) + goto nogood #endif - ; - } + ; + } #endif - else if (e0 >= 0) - goto shift; - else - e1 = e; - } - else - shift: + else if (e0 >= 0) + goto shift; + else + e1 = e; + } + else + shift: #endif - for(s += 2, e1 = 2; *s; ++e1, ++s) - if (e1 >= e) - goto nogood; - while(--delta >= 0) - PUT(' '); - if (signspace) - PUT(sign ? '-' : '+'); - s = buf; - i = f__scale; - if (f__scale <= 0) { + for (s += 2, e1 = 2; *s; ++e1, ++s) + if (e1 >= e) + goto nogood; + while (--delta >= 0) + PUT (' '); + if (signspace) + PUT (sign ? '-' : '+'); + s = buf; + i = f__scale; + if (f__scale <= 0) + { #ifdef WANT_LEAD_0 - if (insert0) - PUT('0'); + if (insert0) + PUT ('0'); #endif - PUT('.'); - for(; i < 0; ++i) - PUT('0'); - PUT(*s); - s += 2; - } - else if (f__scale > 1) { - PUT(*s); - s += 2; - while(--i > 0) - PUT(*s++); - PUT('.'); - } - if (d1) { - se -= 2; - while(s < se) PUT(*s++); - se += 2; - do PUT('0'); while(--d1 > 0); - } - while(s < se) - PUT(*s++); - if (e < 2) - PUT(s[1]); - else { - while(++e1 <= e) - PUT('0'); - while(*s) - PUT(*s++); - } - return 0; - } + PUT ('.'); + for (; i < 0; ++i) + PUT ('0'); + PUT (*s); + s += 2; + } + else if (f__scale > 1) + { + PUT (*s); + s += 2; + while (--i > 0) + PUT (*s++); + PUT ('.'); + } + if (d1) + { + se -= 2; + while (s < se) + PUT (*s++); + se += 2; + do + PUT ('0'); + while (--d1 > 0); + } + while (s < se) + PUT (*s++); + if (e < 2) + PUT (s[1]); + else + { + while (++e1 <= e) + PUT ('0'); + while (*s) + PUT (*s++); + } + return 0; +} -#ifdef KR_headers -wrt_F(p,w,d,len) ufloat *p; ftnlen len; -#else -wrt_F(ufloat *p, int w, int d, ftnlen len) -#endif +int +wrt_F (ufloat * p, int w, int d, ftnlen len) { - int d1, sign, n; - double x; - char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s; + int d1, sign, n; + double x; + char *b, buf[MAXINTDIGS + MAXFRACDIGS + 4], *s; - x= (len==sizeof(real)?p->pf:p->pd); - if (d < MAXFRACDIGS) - d1 = 0; - else { - d1 = d - MAXFRACDIGS; - d = MAXFRACDIGS; - } - if (x < 0.) - { x = -x; sign = 1; } - else { - sign = 0; + x = (len == sizeof (real) ? p->pf : p->pd); + if (d < MAXFRACDIGS) + d1 = 0; + else + { + d1 = d - MAXFRACDIGS; + d = MAXFRACDIGS; + } + if (x < 0.) + { + x = -x; + sign = 1; + } + else + { + sign = 0; #ifndef VAX - if (!x) - x = 0.; + if (!x) + x = 0.; #endif - } + } - if (n = f__scale) - if (n > 0) - do x *= 10.; while(--n > 0); - else - do x *= 0.1; while(++n < 0); + if ((n = f__scale)) + { + if (n > 0) + do + x *= 10.; + while (--n > 0); + else + do + x *= 0.1; + while (++n < 0); + } #ifdef USE_STRLEN - sprintf(b = buf, "%#.*f", d, x); - n = strlen(b) + d1; + sprintf (b = buf, "%#.*f", d, x); + n = strlen (b) + d1; #else - n = sprintf(b = buf, "%#.*f", d, x) + d1; + n = sprintf (b = buf, "%#.*f", d, x) + d1; #endif #ifndef WANT_LEAD_0 - if (buf[0] == '0' && d) - { ++b; --n; } + if (buf[0] == '0' && d) + { + ++b; + --n; + } #endif - if (sign) { - /* check for all zeros */ - for(s = b;;) { - while(*s == '0') s++; - switch(*s) { - case '.': - s++; continue; - case 0: - sign = 0; - } - break; - } - } - if (sign || f__cplus) - ++n; - if (n > w) { + if (sign) + { + /* check for all zeros */ + for (s = b;;) + { + while (*s == '0') + s++; + switch (*s) + { + case '.': + s++; + continue; + case 0: + sign = 0; + } + break; + } + } + if (sign || f__cplus) + ++n; + if (n > w) + { #ifdef WANT_LEAD_0 - if (buf[0] == '0' && --n == w) - ++b; - else + if (buf[0] == '0' && --n == w) + ++b; + else #endif - { - while(--w >= 0) - PUT('*'); - return 0; - } - } - for(w -= n; --w >= 0; ) - PUT(' '); - if (sign) - PUT('-'); - else if (f__cplus) - PUT('+'); - while(n = *b++) - PUT(n); - while(--d1 >= 0) - PUT('0'); - return 0; + { + while (--w >= 0) + PUT ('*'); + return 0; } + } + for (w -= n; --w >= 0;) + PUT (' '); + if (sign) + PUT ('-'); + else if (f__cplus) + PUT ('+'); + while ((n = *b++)) + PUT (n); + while (--d1 >= 0) + PUT ('0'); + return 0; +} |