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
w_ed(p,ptr,len)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
w_ned(p,ptr)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
wr_mvcur()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
wrt_IM(ui,w,m,len)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
wrt_AP(p)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
wrt_H(a,b)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
wrt_L(l,width,len)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
wrt_AW(p,w,len)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
wrt_E(p,w,d,e,len,expch)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
wrt_G(p,w,d,e,len)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
wrt_F(p,w,d,len)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