summaryrefslogtreecommitdiffstats
path: root/contrib/libf2c/libI77/wref.c
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/libf2c/libI77/wref.c')
-rw-r--r--contrib/libf2c/libI77/wref.c472
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;
+}
OpenPOWER on IntegriCloud