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