Go to the documentation of this file.00001 #include "f2c.h"
00002 #include "fio.h"
00003
00004 #ifndef KR_headers
00005 #undef abs
00006 #undef min
00007 #undef max
00008 #include "stdlib.h"
00009 #include "string.h"
00010 #endif
00011
00012 #include "fmt.h"
00013 #include "fp.h"
00014 #ifndef VAX
00015 #include "ctype.h"
00016 #ifdef __cplusplus
00017 extern "C" {
00018 #endif
00019 #endif
00020
00021 int
00022 #ifdef KR_headers
00023 wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
00024 #else
00025 wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
00026 #endif
00027 {
00028 char buf[FMAX+EXPMAXDIGS+4], *s, *se;
00029 int d1, delta, e1, i, sign, signspace;
00030 double dd;
00031 #ifdef WANT_LEAD_0
00032 int insert0 = 0;
00033 #endif
00034 #ifndef VAX
00035 int e0 = e;
00036 #endif
00037
00038 if(e <= 0)
00039 e = 2;
00040 if(f__scale) {
00041 if(f__scale >= d + 2 || f__scale <= -d)
00042 goto nogood;
00043 }
00044 if(f__scale <= 0)
00045 --d;
00046 if (len == sizeof(real))
00047 dd = p->pf;
00048 else
00049 dd = p->pd;
00050 if (dd < 0.) {
00051 signspace = sign = 1;
00052 dd = -dd;
00053 }
00054 else {
00055 sign = 0;
00056 signspace = (int)f__cplus;
00057 #ifndef VAX
00058 if (!dd) {
00059 #ifdef SIGNED_ZEROS
00060 if (signbit_f2c(&dd))
00061 signspace = sign = 1;
00062 #endif
00063 dd = 0.;
00064 }
00065 #endif
00066 }
00067 delta = w - (2
00068 + 2 + signspace + d + e);
00069 #ifdef WANT_LEAD_0
00070 if (f__scale <= 0 && delta > 0) {
00071 delta--;
00072 insert0 = 1;
00073 }
00074 else
00075 #endif
00076 if (delta < 0) {
00077 nogood:
00078 while(--w >= 0)
00079 PUT('*');
00080 return(0);
00081 }
00082 if (f__scale < 0)
00083 d += f__scale;
00084 if (d > FMAX) {
00085 d1 = d - FMAX;
00086 d = FMAX;
00087 }
00088 else
00089 d1 = 0;
00090 sprintf(buf,"%#.*E", d, dd);
00091 #ifndef VAX
00092
00093 if (!isdigit(buf[0])) {
00094 switch(buf[0]) {
00095 case 'n':
00096 case 'N':
00097 signspace = 0;
00098 }
00099 delta = w - strlen(buf) - signspace;
00100 if (delta < 0)
00101 goto nogood;
00102 while(--delta >= 0)
00103 PUT(' ');
00104 if (signspace)
00105 PUT(sign ? '-' : '+');
00106 for(s = buf; *s; s++)
00107 PUT(*s);
00108 return 0;
00109 }
00110 #endif
00111 se = buf + d + 3;
00112 #ifdef GOOD_SPRINTF_EXPONENT
00113 if (f__scale != 1 && dd)
00114 sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
00115 #else
00116 if (dd)
00117 sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
00118 else
00119 strcpy(se, "+00");
00120 #endif
00121 s = ++se;
00122 if (e < 2) {
00123 if (*s != '0')
00124 goto nogood;
00125 }
00126 #ifndef VAX
00127
00128 if (s[2]) {
00129 #ifdef Pedantic
00130 if (!e0 && !s[3])
00131 for(s -= 2, e1 = 2; s[0] = s[1]; s++);
00132
00133
00134
00135
00136
00137
00138 #else
00139 if (!e0) {
00140 for(s -= 2, e1 = 2; s[0] = s[1]; s++)
00141 #ifdef CRAY
00142 delta--;
00143 if ((delta += 4) < 0)
00144 goto nogood
00145 #endif
00146 ;
00147 }
00148 #endif
00149 else if (e0 >= 0)
00150 goto shift;
00151 else
00152 e1 = e;
00153 }
00154 else
00155 shift:
00156 #endif
00157 for(s += 2, e1 = 2; *s; ++e1, ++s)
00158 if (e1 >= e)
00159 goto nogood;
00160 while(--delta >= 0)
00161 PUT(' ');
00162 if (signspace)
00163 PUT(sign ? '-' : '+');
00164 s = buf;
00165 i = f__scale;
00166 if (f__scale <= 0) {
00167 #ifdef WANT_LEAD_0
00168 if (insert0)
00169 PUT('0');
00170 #endif
00171 PUT('.');
00172 for(; i < 0; ++i)
00173 PUT('0');
00174 PUT(*s);
00175 s += 2;
00176 }
00177 else if (f__scale > 1) {
00178 PUT(*s);
00179 s += 2;
00180 while(--i > 0)
00181 PUT(*s++);
00182 PUT('.');
00183 }
00184 if (d1) {
00185 se -= 2;
00186 while(s < se) PUT(*s++);
00187 se += 2;
00188 do PUT('0'); while(--d1 > 0);
00189 }
00190 while(s < se)
00191 PUT(*s++);
00192 if (e < 2)
00193 PUT(s[1]);
00194 else {
00195 while(++e1 <= e)
00196 PUT('0');
00197 while(*s)
00198 PUT(*s++);
00199 }
00200 return 0;
00201 }
00202
00203 int
00204 #ifdef KR_headers
00205 wrt_F(p,w,d,len) ufloat *p; ftnlen len;
00206 #else
00207 wrt_F(ufloat *p, int w, int d, ftnlen len)
00208 #endif
00209 {
00210 int d1, sign, n;
00211 double x;
00212 char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s;
00213
00214 x= (len==sizeof(real)?p->pf:p->pd);
00215 if (d < MAXFRACDIGS)
00216 d1 = 0;
00217 else {
00218 d1 = d - MAXFRACDIGS;
00219 d = MAXFRACDIGS;
00220 }
00221 if (x < 0.)
00222 { x = -x; sign = 1; }
00223 else {
00224 sign = 0;
00225 #ifndef VAX
00226 if (!x) {
00227 #ifdef SIGNED_ZEROS
00228 if (signbit_f2c(&x))
00229 sign = 2;
00230 #endif
00231 x = 0.;
00232 }
00233 #endif
00234 }
00235
00236 if (n = f__scale)
00237 if (n > 0)
00238 do x *= 10.; while(--n > 0);
00239 else
00240 do x *= 0.1; while(++n < 0);
00241
00242 #ifdef USE_STRLEN
00243 sprintf(b = buf, "%#.*f", d, x);
00244 n = strlen(b) + d1;
00245 #else
00246 n = sprintf(b = buf, "%#.*f", d, x) + d1;
00247 #endif
00248
00249 #ifndef WANT_LEAD_0
00250 if (buf[0] == '0' && d)
00251 { ++b; --n; }
00252 #endif
00253 if (sign == 1) {
00254
00255 for(s = b;;) {
00256 while(*s == '0') s++;
00257 switch(*s) {
00258 case '.':
00259 s++; continue;
00260 case 0:
00261 sign = 0;
00262 }
00263 break;
00264 }
00265 }
00266 if (sign || f__cplus)
00267 ++n;
00268 if (n > w) {
00269 #ifdef WANT_LEAD_0
00270 if (buf[0] == '0' && --n == w)
00271 ++b;
00272 else
00273 #endif
00274 {
00275 while(--w >= 0)
00276 PUT('*');
00277 return 0;
00278 }
00279 }
00280 for(w -= n; --w >= 0; )
00281 PUT(' ');
00282 if (sign)
00283 PUT('-');
00284 else if (f__cplus)
00285 PUT('+');
00286 while(n = *b++)
00287 PUT(n);
00288 while(--d1 >= 0)
00289 PUT('0');
00290 return 0;
00291 }
00292 #ifdef __cplusplus
00293 }
00294 #endif