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