home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sharew / f_2_c / libi77 / wref.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-06-10  |  3.8 KB  |  225 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "fmt.h"
  4. #include "fp.h"
  5. #ifndef VAX
  6. #include "ctype.h"
  7. #endif
  8.  
  9. wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
  10. {
  11.     char buf[FMAX+EXPMAXDIGS+4], *s, *se;
  12.     int d1, delta, e1, i, sign, signspace;
  13.     double dd;
  14. #ifndef VAX
  15.     int e0 = e;
  16. #endif
  17.  
  18.     if(e <= 0)
  19.         e = 2;
  20.     if(scale) {
  21.         if(scale >= d + 2 || scale <= -d)
  22.             goto nogood;
  23.         }
  24.     if(scale <= 0)
  25.         --d;
  26.     if (len == sizeof(real))
  27.         dd = p->pf;
  28.     else
  29.         dd = p->pd;
  30.     if (dd >= 0.) {
  31.         sign = 0;
  32.         signspace = cplus;
  33. #ifndef VAX
  34.         if (!dd)
  35.             dd = 0.;    /* avoid -0 */
  36. #endif
  37.         }
  38.     else {
  39.         signspace = sign = 1;
  40.         dd = -dd;
  41.         }
  42.     delta = w - (2 /* for the . and the d adjustment above */
  43.             + 2 /* for the E+ */ + signspace + d + e);
  44.     if (delta < 0) {
  45. nogood:
  46.         while(--w >= 0)
  47.             PUT('*');
  48.         return(0);
  49.         }
  50.     if (scale < 0)
  51.         d += scale;
  52.     if (d > FMAX) {
  53.         d1 = d - FMAX;
  54.         d = FMAX;
  55.         }
  56.     else
  57.         d1 = 0;
  58.     sprintf(buf,"%#.*E", d, dd);
  59. #ifndef VAX
  60.     /* check for NaN, Infinity */
  61.     if (!isdigit(buf[0])) {
  62.         delta = w - strlen(buf) - signspace;
  63.         if (delta < 0)
  64.             goto nogood;
  65.         while(--delta >= 0)
  66.             PUT(' ');
  67.         if (signspace)
  68.             PUT(sign ? '-' : '+');
  69.         for(s = buf; *s; s++)
  70.             PUT(*s);
  71.         return 0;
  72.         }
  73. #endif
  74.     se = buf + d + 3;
  75.     if (scale != 1 && dd)
  76.         sprintf(se, "%+.2d", atoi(se) + 1 - scale);
  77.     s = ++se;
  78.     if (e < 2) {
  79.         if (*s != '0')
  80.             goto nogood;
  81.         }
  82. #ifndef VAX
  83.     /* accommodate 3 significant digits in exponent */
  84.     if (s[2]) {
  85. #ifdef Pedantic
  86.         if (!e0 && !s[3])
  87.             for(s -= 2, e1 = 2; s[0] = s[1]; s++);
  88.  
  89.     /* Pedantic gives the behavior that Fortran 77 specifies,    */
  90.     /* i.e., requires that E be specified for exponent fields    */
  91.     /* of more than 3 digits.  With Pedantic undefined, we get    */
  92.     /* the behavior that Cray displays -- you get a bigger        */
  93.     /* exponent field if it fits.    */
  94. #else
  95.         if (!e0) {
  96.             for(s -= 2, e1 = 2; s[0] = s[1]; s++)
  97. #ifdef CRAY
  98.                 delta--;
  99.             if ((delta += 4) < 0)
  100.                 goto nogood
  101. #endif
  102.                 ;
  103.             }
  104. #endif
  105.         else if (e0 >= 0)
  106.             goto shift;
  107.         else
  108.             e1 = e;
  109.         }
  110.     else
  111.  shift:
  112. #endif
  113.         for(s += 2, e1 = 2; *s; ++e1, ++s)
  114.             if (e1 >= e)
  115.                 goto nogood;
  116.     while(--delta >= 0)
  117.         PUT(' ');
  118.     if (signspace)
  119.         PUT(sign ? '-' : '+');
  120.     s = buf;
  121.     i = scale;
  122.     if (scale <= 0) {
  123.         PUT('.');
  124.         for(; i < 0; ++i)
  125.             PUT('0');
  126.         PUT(*s);
  127.         s += 2;
  128.         }
  129.     else if (scale > 1) {
  130.         PUT(*s);
  131.         s += 2;
  132.         while(--i > 0)
  133.             PUT(*s++);
  134.         PUT('.');
  135.         }
  136.     if (d1) {
  137.         se -= 2;
  138.         while(s < se) PUT(*s++);
  139.         se += 2;
  140.         do PUT('0'); while(--d1 > 0);
  141.         }
  142.     while(s < se)
  143.         PUT(*s++);
  144.     if (e < 2)
  145.         PUT(s[1]);
  146.     else {
  147.         while(++e1 <= e)
  148.             PUT('0');
  149.         while(*s)
  150.             PUT(*s++);
  151.         }
  152.     return 0;
  153.     }
  154.  
  155. wrt_F(p,w,d,len) ufloat *p; ftnlen len;
  156. {
  157.     int d1, sign, n;
  158.     double x;
  159.     char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s;
  160.  
  161.     x= (len==sizeof(real)?p->pf:p->pd);
  162.     if (d < MAXFRACDIGS)
  163.         d1 = 0;
  164.     else {
  165.         d1 = d - MAXFRACDIGS;
  166.         d = MAXFRACDIGS;
  167.         }
  168.     if (x < 0.)
  169.         { x = -x; sign = 1; }
  170.     else {
  171.         sign = 0;
  172. #ifndef VAX
  173.         if (!x)
  174.             x = 0.;
  175. #endif
  176.         }
  177.  
  178.     if (n = scale)
  179.         if (n > 0)
  180.             do x *= 10.; while(--n > 0);
  181.         else
  182.             do x *= 0.1; while(++n < 0);
  183.  
  184. #ifdef USE_STRLEN
  185.     sprintf(b = buf, "%#.*f", d, x);
  186.     n = strlen(b) + d1;
  187. #else
  188.     n = sprintf(b = buf, "%#.*f", d, x) + d1;
  189. #endif
  190.  
  191.     if (buf[0] == '0' && d)
  192.         { ++b; --n; }
  193.     if (sign) {
  194.         /* check for all zeros */
  195.         for(s = b;;) {
  196.             while(*s == '0') s++;
  197.             switch(*s) {
  198.                 case '.':
  199.                     s++; continue;
  200.                 case 0:
  201.                     sign = 0;
  202.                 }
  203.             break;
  204.             }
  205.         }
  206.     if (sign || cplus)
  207.         ++n;
  208.     if (n > w) {
  209.         while(--w >= 0)
  210.             PUT('*');
  211.         return 0;
  212.         }
  213.     for(w -= n; --w >= 0; )
  214.         PUT(' ');
  215.     if (sign)
  216.         PUT('-');
  217.     else if (cplus)
  218.         PUT('+');
  219.     while(n = *b++)
  220.         PUT(n);
  221.     while(--d1 >= 0)
  222.         PUT('0');
  223.     return 0;
  224.     }
  225.