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