1 /* 2 char id_wrtfmt[] = "@(#)wrtfmt.c 1.5"; 3 * 4 * formatted write routines 5 */ 6 7 #include "fio.h" 8 #include "format.h" 9 10 extern char *icvt(); 11 12 #define abs(x) (x<0?-x:x) 13 14 w_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len; 15 { int n; 16 if(cursor && (n=wr_mvcur())) return(n); 17 switch(p->op) 18 { 19 case I: 20 case IM: 21 return(wrt_IM(ptr,p->p1,p->p2,len)); 22 case L: 23 return(wrt_L(ptr,p->p1)); 24 case A: 25 p->p1 = len; /* cheap trick */ 26 case AW: 27 return(wrt_AW(ptr,p->p1,len)); 28 case D: 29 case DE: 30 return(wrt_E(ptr,p->p1,p->p2,p->p3,len,'d')); 31 case E: 32 case EE: 33 return(wrt_E(ptr,p->p1,p->p2,p->p3,len,'e')); 34 case G: 35 case GE: 36 return(wrt_G(ptr,p->p1,p->p2,p->p3,len)); 37 case F: 38 return(wrt_F(ptr,p->p1,p->p2,len)); 39 default: 40 return(errno=F_ERFMT); 41 } 42 } 43 44 w_ned(p,ptr) char *ptr; struct syl *p; 45 { 46 switch(p->op) 47 { 48 case SLASH: 49 return((*donewrec)()); 50 case T: 51 if(p->p1) cursor = p->p1 - recpos - 1; 52 #ifndef KOSHER 53 else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */ 54 #endif 55 tab = YES; 56 return(OK); 57 case TL: 58 cursor -= p->p1; 59 tab = YES; 60 return(OK); 61 case TR: 62 case X: 63 cursor += p->p1; 64 tab = (p->op == TR); 65 return(OK); 66 case APOS: 67 return(wrt_AP(p->p1)); 68 case H: 69 return(wrt_H(p->p1,p->p2)); 70 default: 71 return(errno=F_ERFMT); 72 } 73 } 74 75 wr_mvcur() 76 { int n; 77 if(tab) return((*dotab)()); 78 while(cursor--) PUT(' ') 79 return(cursor=0); 80 } 81 82 wrt_IM(ui,w,m,len) uint *ui; ftnlen len; 83 { int ndigit,sign,spare,i,xsign,n; 84 long x; 85 char *ans; 86 if(sizeof(short)==len) x=ui->is; 87 /* else if(len == sizeof(char)) x = ui->ic; */ 88 else x=ui->il; 89 if(x==0 && m==0) 90 { for(i=0;i<w;i++) PUT(' ') 91 return(OK); 92 } 93 ans=icvt(x,&ndigit,&sign); 94 if(sign || cplus) xsign=1; 95 else xsign=0; 96 if(ndigit+xsign>w || m+xsign>w) 97 { for(i=0;i<w;i++) PUT('*') 98 return(OK); 99 } 100 if(ndigit>=m) 101 spare=w-ndigit-xsign; 102 else 103 spare=w-m-xsign; 104 for(i=0;i<spare;i++) PUT(' ') 105 if(sign) PUT('-') 106 else if(cplus) PUT('+') 107 for(i=0;i<m-ndigit;i++) PUT('0') 108 for(i=0;i<ndigit;i++) PUT(*ans++) 109 return(OK); 110 } 111 112 wrt_AP(p) 113 { char *s,quote; 114 int n; 115 if(cursor && (n=wr_mvcur())) return(n); 116 s=(char *)p; 117 quote = *s++; 118 for(; *s; s++) 119 { if(*s!=quote) PUT(*s) 120 else if(*++s==quote) PUT(*s) 121 else return(OK); 122 } 123 return(OK); 124 } 125 126 wrt_H(a,b) 127 { char *s=(char *)b; 128 int n; 129 if(cursor && (n=wr_mvcur())) return(n); 130 while(a--) PUT(*s++) 131 return(OK); 132 } 133 134 wrt_L(l,len) ftnint *l; 135 { int i,n; 136 for(i=0;i<len-1;i++) PUT(' ') 137 if(*l) PUT('t') 138 else PUT('f') 139 return(OK); 140 } 141 142 wrt_AW(p,w,len) char * p; ftnlen len; 143 { int n; 144 while(w>len) 145 { w--; 146 PUT(' ') 147 } 148 while(w-- > 0) 149 PUT(*p++) 150 return(OK); 151 } 152 153 wrt_E(p,w,d,e,len,expch) ufloat *p; ftnlen len; char expch; 154 { char *s,ex[4]; 155 int dd,dp,sign,i,delta,pad,n; 156 char *ecvt(); 157 158 if((len==sizeof(float)?p->pf:p->pd)==0.0) 159 { 160 wrt_F(p,w-(e+2),d,len); 161 PUT(expch) 162 PUT('+') 163 /* for(i=0;i<(e-1);i++)PUT(' ') 164 deleted PUT('0') 165 */ 166 /* added */ for(i=0;i<e;i++) PUT('0') 167 return(OK); 168 } 169 dd = d + scale; 170 s=ecvt( (len==sizeof(float)?(double)p->pf:p->pd) ,dd,&dp,&sign); 171 delta = 3+e; 172 if(sign||cplus) delta++; 173 pad=w-(delta+d)-(scale>0? scale:0); 174 if(pad<0) 175 { for(i=0;i<w;i++) PUT('*') 176 return(OK); 177 } 178 for(i=0;i<(pad-(scale<=0?1:0));i++) PUT(' ') 179 if(sign) PUT('-') 180 else if(cplus) PUT('+') 181 if(scale<=0 && pad) PUT('0') 182 if(scale<0 && scale > -d) 183 { 184 PUT('.') 185 for(i=0;i<-scale;i++) 186 PUT('0') 187 for(i=0;i<d+scale;i++) 188 PUT(*s++) 189 } 190 else 191 { 192 if(scale>0) 193 for(i=0;i<scale;i++) 194 PUT(*s++) 195 PUT('.') 196 for(i=0;i<d;i++) 197 PUT(*s++) 198 } 199 dp -= scale; 200 sprintf(ex,"%d",abs(dp)); 201 if((pad=strlen(ex))>e) 202 { if(pad>(++e)) 203 { PUT(expch) 204 for(i=0;i<e;i++) PUT('*') 205 return(OK); 206 } 207 } 208 else PUT(expch) 209 PUT(dp<0?'-':'+') 210 for(i=0;i<(e-pad);i++) PUT('0') /* was ' ' */ 211 s= &ex[0]; 212 while(*s) PUT(*s++) 213 return(OK); 214 } 215 216 wrt_G(p,w,d,e,len) ufloat *p; ftnlen len; 217 { double uplim = 1.0, x; 218 int i,oldscale,n,j,ne; 219 x=(len==sizeof(float)?(double)p->pf:p->pd); 220 i=d; 221 if(x==0.0) goto zero; 222 x = abs(x); 223 if(x>=0.1) 224 { 225 for(i=0; i<=d; i++, uplim*=10.0) 226 { if(x>=uplim) continue; 227 zero: oldscale=scale; 228 scale=0; 229 ne = e+2; 230 if(n = wrt_F(p,w-ne,d-i,len)) return(n); 231 for(j=0; j<ne; j++) PUT(' ') 232 scale=oldscale; 233 return(OK); 234 } 235 /* falling off the bottom implies E format */ 236 } 237 return(wrt_E(p,w,d,e,len,'e')); 238 } 239 240 wrt_F(p,w,d,len) ufloat *p; ftnlen len; 241 { int i,delta,dp,sign,n,nf; 242 double x; 243 char *s,*fcvt(); 244 x= (len==sizeof(float)?(double)p->pf:p->pd); 245 if(scale && x!=0.0) 246 { if(scale>0) 247 for(i=0;i<scale;i++) x*=10; 248 else for(i=0;i<-scale;i++) x/=10; 249 } 250 s=fcvt(x,d,&dp,&sign); 251 /* if(-dp>=d) sign=0; ?? */ 252 delta=1; 253 if(sign || cplus) delta++; 254 nf = w - (d + delta + (dp>0?dp:0)); 255 if(nf<0) 256 { 257 for(i=0;i<w;i++) PUT('*') 258 return(OK); 259 } 260 if(nf>0) for(i=0; i<(nf-(dp<=0?1:0)); i++) PUT(' ') 261 if(sign) PUT('-') 262 else if(cplus) PUT('+') 263 if(dp>0) for(i=0;i<dp;i++) PUT(*s++) 264 else if(nf>0) PUT('0') 265 PUT('.') 266 for(i=0; i< -dp && i<d; i++) PUT('0') 267 for(;i<d;i++) 268 { if(x==0.0 && !cblank) PUT(' ') /* exactly zero */ 269 else if(*s) PUT(*s++) 270 else PUT('0') 271 } 272 return(OK); 273 } 274