diff options
Diffstat (limited to 'gnu/lib/libf2c/libI77/wref.c')
| -rw-r--r-- | gnu/lib/libf2c/libI77/wref.c | 306 |
1 files changed, 0 insertions, 306 deletions
diff --git a/gnu/lib/libf2c/libI77/wref.c b/gnu/lib/libf2c/libI77/wref.c deleted file mode 100644 index 0dc30919da4..00000000000 --- a/gnu/lib/libf2c/libI77/wref.c +++ /dev/null @@ -1,306 +0,0 @@ -#include "f2c.h" -#include "fio.h" -#ifndef VAX -#include <ctype.h> -#endif - -#undef abs -#undef min -#undef max -#include <stdlib.h> -#include <string.h> - -#include "fmt.h" -#include "fp.h" - -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; -#ifdef WANT_LEAD_0 - int insert0 = 0; -#endif -#ifndef VAX - 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; -#ifndef VAX - if (!dd) - dd = 0.; /* avoid -0 */ -#endif - } - 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 -#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); -#ifndef VAX - /* 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); -#else - 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; - } -#ifndef VAX - /* 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++); - - /* 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++) -#ifdef CRAY - delta--; - if ((delta += 4) < 0) - goto nogood -#endif - ; - } -#endif - 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) - { -#ifdef WANT_LEAD_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; -} - -int -wrt_F (ufloat * p, int w, int d, ftnlen len) -{ - 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; -#ifndef VAX - 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); - } - -#ifdef USE_STRLEN - sprintf (b = buf, "%#.*f", d, x); - n = strlen (b) + d1; -#else - n = sprintf (b = buf, "%#.*f", d, x) + d1; -#endif - -#ifndef WANT_LEAD_0 - 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) - { -#ifdef WANT_LEAD_0 - 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; -} |