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