|
|
1.1 root 1: /*
2: char id_wrtfmt[] = "@(#)wrtfmt.c 1.7";
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: if ((recpos + cursor) < 0) cursor = -recpos; /* ANSI req'd */
60: tab = YES;
61: return(OK);
62: case TR:
63: case X:
64: cursor += p->p1;
65: /* tab = (p->op == TR); this would implement destructive X */
66: tab = YES;
67: return(OK);
68: case APOS:
69: return(wrt_AP(p->p1));
70: case H:
71: return(wrt_H(p->p1,p->p2));
72: default:
73: return(errno=F_ERFMT);
74: }
75: }
76:
77: wr_mvcur()
78: { int n;
79: if(tab) return((*dotab)());
80: if (cursor < 0) return(errno=F_ERSEEK);
81: while(cursor--) PUT(' ')
82: return(cursor=0);
83: }
84:
85: wrt_IM(ui,w,m,len) uint *ui; ftnlen len;
86: { int ndigit,sign,spare,i,xsign,n;
87: long x;
88: char *ans;
89: if(sizeof(short)==len) x=ui->is;
90: /* else if(len == sizeof(char)) x = ui->ic; */
91: else x=ui->il;
92: if(x==0 && m==0)
93: { for(i=0;i<w;i++) PUT(' ')
94: return(OK);
95: }
96: ans=icvt(x,&ndigit,&sign);
97: if(sign || cplus) xsign=1;
98: else xsign=0;
99: if(ndigit+xsign>w || m+xsign>w)
100: { for(i=0;i<w;i++) PUT('*')
101: return(OK);
102: }
103: if(ndigit>=m)
104: spare=w-ndigit-xsign;
105: else
106: spare=w-m-xsign;
107: for(i=0;i<spare;i++) PUT(' ')
108: if(sign) PUT('-')
109: else if(cplus) PUT('+')
110: for(i=0;i<m-ndigit;i++) PUT('0')
111: for(i=0;i<ndigit;i++) PUT(*ans++)
112: return(OK);
113: }
114:
115: wrt_AP(p)
116: { char *s,quote;
117: int n;
118: if(cursor && (n=wr_mvcur())) return(n);
119: s=(char *)p;
120: quote = *s++;
121: for(; *s; s++)
122: { if(*s!=quote) PUT(*s)
123: else if(*++s==quote) PUT(*s)
124: else return(OK);
125: }
126: return(OK);
127: }
128:
129: wrt_H(a,b)
130: { char *s=(char *)b;
131: int n;
132: if(cursor && (n=wr_mvcur())) return(n);
133: while(a--) PUT(*s++)
134: return(OK);
135: }
136:
137: wrt_L(l,len) ftnint *l;
138: { int i,n;
139: for(i=0;i<len-1;i++) PUT(' ')
140: if(*l) PUT('t')
141: else PUT('f')
142: return(OK);
143: }
144:
145: wrt_AW(p,w,len) char * p; ftnlen len;
146: { int n;
147: while(w>len)
148: { w--;
149: PUT(' ')
150: }
151: while(w-- > 0)
152: PUT(*p++)
153: return(OK);
154: }
155:
156: wrt_E(p,w,d,e,len,expch) ufloat *p; ftnlen len; char expch;
157: { char *s,ex[4];
158: int dd,dp,sign,i,delta,pad,n;
159: char *ecvt();
160:
161: if((len==sizeof(float)?p->pf:p->pd)==0.0)
162: {
163: wrt_F(p,w-(e+2),d,len);
164: PUT(expch)
165: PUT('+')
166: /* for(i=0;i<(e-1);i++)PUT(' ')
167: deleted PUT('0')
168: */
169: /* added */ for(i=0;i<e;i++) PUT('0')
170: return(OK);
171: }
172: if (scale > 0) { /* insane ANSI requirement */
173: dd = d + 1;
174: d = dd - scale;
175: } else
176: dd = d + scale;
177: if (dd <= 0 || d < 0) goto E_badfield;
178: s=ecvt( (len==sizeof(float)?(double)p->pf:p->pd) ,dd,&dp,&sign);
179: delta = 3+e;
180: if(sign||cplus) delta++;
181: pad=w-(delta+d)-(scale>0? scale:0);
182: if(pad<0) {
183: E_badfield:
184: for(i=0;i<w;i++) PUT('*')
185: return(OK);
186: }
187: for(i=0;i<(pad-(scale<=0?1:0));i++) PUT(' ')
188: if(sign) PUT('-')
189: else if(cplus) PUT('+')
190: if(scale<=0 && pad) PUT('0')
191: if(scale<0 && scale > -d)
192: {
193: PUT('.')
194: for(i=0;i<-scale;i++)
195: PUT('0')
196: for(i=0;i<d+scale;i++)
197: PUT(*s++)
198: }
199: else
200: {
201: if(scale>0)
202: for(i=0;i<scale;i++)
203: PUT(*s++)
204: PUT('.')
205: for(i=0;i<d;i++)
206: PUT(*s++)
207: }
208: dp -= scale;
209: sprintf(ex,"%d",abs(dp));
210: if((pad=strlen(ex))>e)
211: { if(pad>(++e))
212: { PUT(expch)
213: for(i=0;i<e;i++) PUT('*')
214: return(OK);
215: }
216: }
217: else PUT(expch)
218: PUT(dp<0?'-':'+')
219: for(i=0;i<(e-pad);i++) PUT('0') /* was ' ' */
220: s= &ex[0];
221: while(*s) PUT(*s++)
222: return(OK);
223: }
224:
225: wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
226: { double uplim = 1.0, x;
227: int i,oldscale,n,j,ne;
228: x=(len==sizeof(float)?(double)p->pf:p->pd);
229: i=d;
230: if(x==0.0) goto zero;
231: x = abs(x);
232: if(x>=0.1)
233: {
234: for(i=0; i<=d; i++, uplim*=10.0)
235: { if(x>=uplim) continue;
236: zero: oldscale=scale;
237: scale=0;
238: ne = e+2;
239: if(n = wrt_F(p,w-ne,d-i,len)) return(n);
240: for(j=0; j<ne; j++) PUT(' ')
241: scale=oldscale;
242: return(OK);
243: }
244: /* falling off the bottom implies E format */
245: }
246: return(wrt_E(p,w,d,e,len,'e'));
247: }
248:
249: wrt_F(p,w,d,len) ufloat *p; ftnlen len;
250: { int i,delta,dp,sign,n,nf;
251: double x;
252: char *s,*fcvt();
253: x= (len==sizeof(float)?(double)p->pf:p->pd);
254: if(scale && x!=0.0)
255: { if(scale>0)
256: for(i=0;i<scale;i++) x*=10;
257: else for(i=0;i<-scale;i++) x/=10;
258: }
259: s=fcvt(x,d,&dp,&sign);
260: /* if(-dp>=d) sign=0; ?? */
261: delta=1;
262: if(sign || cplus) delta++;
263: nf = w - (d + delta + (dp>0?dp:0));
264: if(nf<0)
265: {
266: for(i=0;i<w;i++) PUT('*')
267: return(OK);
268: }
269: if(nf>0) for(i=0; i<(nf-(dp<=0?1:0)); i++) PUT(' ')
270: if(sign) PUT('-')
271: else if(cplus) PUT('+')
272: if(dp>0) for(i=0;i<dp;i++) PUT(*s++)
273: else if(nf>0) PUT('0')
274: PUT('.')
275: for(i=0; i< -dp && i<d; i++) PUT('0')
276: for(;i<d;i++)
277: { if(x==0.0 && !cblank) PUT(' ') /* exactly zero */
278: else if(*s) PUT(*s++)
279: else PUT('0')
280: }
281: return(OK);
282: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.