![[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 [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libI77|
Return to wrtfmt.c CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / 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) unsint *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) unsint *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,j,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: i = 0;
202: j = dp;
203: if (j < 0)
204: j = -j;
205: while (j > 0) {
206: j /= 10;
207: i++;
208: }
209: if (i > e)
210: goto E_badfield; /* exponent specified too small */
211: delta = 3+e;
212: if(sign||cplus) delta++;
213: pad=w-(delta+d)-(scale>0? scale:0);
214: if(pad<0) {
215: E_badfield:
216: for(i=0;i<w;i++) PUT('*')
217: return(OK);
218: }
219: for(i=0;i<(pad-(scale<=0?1:0));i++) PUT(' ')
220: if(sign) PUT('-')
221: else if(cplus) PUT('+')
222: if(scale<=0 && pad) PUT('0')
223: if(scale<0 && scale > -d)
224: {
225: PUT('.')
226: for(i=0;i<-scale;i++)
227: PUT('0')
228: for(i=0;i<d+scale;i++)
229: PUT(*s++)
230: }
231: else
232: {
233: if(scale>0)
234: for(i=0;i<scale;i++)
235: PUT(*s++)
236: PUT('.')
237: for(i=0;i<d;i++)
238: PUT(*s++)
239: }
240: dp -= scale;
241: sprintf(ex,"%d",abs(dp));
242: if((pad=strlen(ex))>e)
243: { if(pad>(++e))
244: { PUT(expch)
245: for(i=0;i<e;i++) PUT('*')
246: return(OK);
247: }
248: }
249: else PUT(expch)
250: PUT(dp<0?'-':'+')
251: for(i=0;i<(e-pad);i++) PUT('0') /* was ' ' */
252: s= &ex[0];
253: while(*s) PUT(*s++)
254: return(OK);
255: }
256:
257: LOCAL
258: wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
259: { double uplim = 1.0, x;
260: int i,oldscale,n,j,ne;
261: x=(len==sizeof(float)?(double)p->pf:p->pd);
262: i=d;
263: if(x==0.0) goto zero;
264: x = abs(x);
265: if(x>=0.1)
266: {
267: for(i=0; i<=d; i++, uplim*=10.0)
268: { if(x>=uplim) continue;
269: zero: oldscale=scale;
270: scale=0;
271: ne = e+2;
272: if(n = wrt_F(p,w-ne,d-i,len)) return(n);
273: for(j=0; j<ne; j++) PUT(' ')
274: scale=oldscale;
275: return(OK);
276: }
277: /* falling off the bottom implies E format */
278: }
279: return(wrt_E(p,w,d,e,len,'E'));
280: }
281:
282: wrt_F(p,w,d,len) ufloat *p; ftnlen len;
283: { int i,delta,dp,sign,n,nf;
284: double x;
285: char *s,*fcvt();
286: x= (len==sizeof(float)?(double)p->pf:p->pd);
287: if(scale && x!=0.0)
288: { if(scale>0)
289: for(i=0;i<scale;i++) x*=10;
290: else for(i=0;i<-scale;i++) x/=10;
291: }
292: s=fcvt(x,d,&dp,&sign);
293: if(-dp>=d) sign=0;
294: delta=1;
295: if(sign || cplus) delta++;
296: nf = w - (d + delta + (dp>0?dp:0));
297: if(nf<0)
298: {
299: for(i=0;i<w;i++) PUT('*')
300: return(OK);
301: }
302: if(nf>0) for(i=0; i<(nf-(dp<=0?1:0)); i++) PUT(' ')
303: if(sign) PUT('-')
304: else if(cplus) PUT('+')
305: if(dp>0) for(i=0;i<dp;i++) PUT(*s++)
306: else if(nf>0) PUT('0')
307: PUT('.')
308: for(i=0; i< -dp && i<d; i++) PUT('0')
309: for(;i<d;i++)
310: { if(x==0.0 && !cblank) PUT(' ') /* exactly zero */
311: else if(*s) PUT(*s++)
312: else PUT('0')
313: }
314: return(OK);
315: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.