|
|
1.1 root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.