#include "f2c.h"#include "fio.h"#include "stdlib.h"#include "string.h"#include "fmt.h"#include "fp.h"#include "ctype.h"Include dependency graph for wref.c:
Go to the source code of this file.
Functions | |
| int | wrt_E (ufloat *p, int w, int d, int e, ftnlen len) |
| int | wrt_F (ufloat *p, int w, int d, ftnlen len) |
Definition at line 25 of file wref.c.
References buf, CRAY, EXPMAXDIGS, f__cplus, f__scale, FMAX, i, int, p, PUT, s, sign, and signbit_f2c().
Referenced by w_ed(), and wrt_G().
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.; /* avoid -0 */ 00064 } 00065 #endif 00066 } 00067 delta = w - (2 /* for the . and the d adjustment above */ 00068 + 2 /* for the E+ */ + 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 /* check for NaN, Infinity */ 00093 if (!isdigit(buf[0])) { 00094 switch(buf[0]) { 00095 case 'n': 00096 case 'N': 00097 signspace = 0; /* no sign for NaNs */ 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 /* When possible, exponent has 2 digits. */ 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 /* accommodate 3 significant digits in exponent */ 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 /* Pedantic gives the behavior that Fortran 77 specifies, */ 00134 /* i.e., requires that E be specified for exponent fields */ 00135 /* of more than 3 digits. With Pedantic undefined, we get */ 00136 /* the behavior that Cray displays -- you get a bigger */ 00137 /* exponent field if it fits. */ 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 }
Here is the call graph for this function:
Here is the caller graph for this function:
Definition at line 207 of file wref.c.
References b, buf, f__cplus, f__scale, MAXFRACDIGS, MAXINTDIGS, n, p, PUT, s, sign, signbit_f2c(), and x.
Referenced by w_ed(), and wrt_G().
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 /* check for all zeros */ 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 }
Here is the call graph for this function:
Here is the caller graph for this function:
1.5.1