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