![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lwrite.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / usr.lib / libI77|
Return to lwrite.c CVS log | Up to [CSRG BSD Unix] / 43BSD / 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: * @(#)lwrite.c 5.2 7/30/85
7: */
8:
9: /*
10: * list directed write
11: */
12:
13: #include "fio.h"
14: #include "lio.h"
15:
16: int l_write(), t_putc();
17: LOCAL char lwrt[] = "list write";
18:
19: s_wsle(a) cilist *a;
20: {
21: int n;
22: reading = NO;
23: formatted = LISTDIRECTED;
24: fmtbuf = "ext list io";
25: if(n=c_le(a,WRITE)) return(n);
26: putn = t_putc;
27: lioproc = l_write;
28: line_len = LINE;
29: curunit->uend = NO;
30: leof = NO;
31: if(!curunit->uwrt && ! nowwriting(curunit)) err(errflag, errno, lwrt)
32: return(OK);
33: }
34:
35: LOCAL
36: t_putc(c) char c;
37: {
38: if(c=='\n') recpos=0;
39: else recpos++;
40: putc(c,cf);
41: return(OK);
42: }
43:
44: e_wsle()
45: { int n;
46: PUT('\n')
47: return(OK);
48: }
49:
50: l_write(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
51: {
52: int i,n;
53: ftnint x;
54: float y,z;
55: double yd,zd;
56: float *xx;
57: double *yy;
58: for(i=0;i< *number; i++)
59: {
60: if( formatted == NAMELIST && i != 0 ) PUT(',');
61: switch((int)type)
62: {
63: case TYSHORT:
64: x=ptr->flshort;
65: goto xint;
66: case TYLONG:
67: x=ptr->flint;
68: xint: ERRCHK(lwrt_I(x));
69: break;
70: case TYREAL:
71: ERRCHK(lwrt_F(ptr->flreal));
72: break;
73: case TYDREAL:
74: ERRCHK(lwrt_D(ptr->fldouble));
75: break;
76: case TYCOMPLEX:
77: xx= &(ptr->flreal);
78: y = *xx++;
79: z = *xx;
80: ERRCHK(lwrt_C(y,z));
81: break;
82: case TYDCOMPLEX:
83: yy = &(ptr->fldouble);
84: yd= *yy++;
85: zd = *yy;
86: ERRCHK(lwrt_DC(yd,zd));
87: break;
88: case TYLOGICAL:
89: if(len == sizeof(short))
90: x = ptr->flshort;
91: else
92: x = ptr->flint;
93: ERRCHK(lwrt_L(x));
94: break;
95: case TYCHAR:
96: ERRCHK(lwrt_A((char *)ptr,len));
97: break;
98: default:
99: fatal(F_ERSYS,"unknown type in lwrite");
100: }
101: ptr = (flex *)((char *)ptr + len);
102: }
103: return(OK);
104:
105: got_err:
106: err( n>0?errflag:endflag, n,
107: formatted==LISTDIRECTED?"list io":"name list io");
108: }
109:
110: LOCAL
111: lwrt_I(in) ftnint in;
112: { int n;
113: char buf[16],*p;
114: sprintf(buf," %ld",(long)in);
115: chk_len(LINTW);
116: for(p=buf;*p;) PUT(*p++)
117: return(OK);
118: }
119:
120: LOCAL
121: lwrt_L(ln) ftnint ln;
122: { int n;
123: chk_len(LLOGW);
124: return(wrt_L(&ln,LLOGW));
125: }
126:
127: LOCAL
128: lwrt_A(p,len) char *p; ftnlen len;
129: { int i,n;
130: chk_len(LSTRW);
131: if(formatted == LISTDIRECTED)
132: {
133: PUT(' ')
134: PUT(' ')
135: for(i=0;i<len;i++) PUT(*p++)
136: }
137: else
138: {
139: PUT('\'')
140: for(i=0;i<len;i++) PUT(*p++)
141: PUT('\'')
142: }
143: return(OK);
144: }
145:
146: LOCAL
147: lwrt_F(fn) float fn;
148: { int d,n; float x; ufloat f;
149: if(fn==0.0) return(lwrt_0());
150: f.pf = fn;
151: d = width(fn);
152: chk_len(d);
153: if(d==LFW)
154: {
155: scale = 0;
156: for(d=LFD,x=abs(fn);x>=1.0;x/=10.0,d--);
157: return(wrt_F(&f,LFW,d,(ftnlen)sizeof(float)));
158: }
159: else
160: {
161: scale = 1;
162: return(wrt_E(&f,LEW,LED-scale,LEE,(ftnlen)sizeof(float),'e'));
163: }
164: }
165:
166: LOCAL
167: lwrt_D(dn) double dn;
168: { int d,n; double x; ufloat f;
169: if(dn==0.0) return(lwrt_0());
170: f.pd = dn;
171: d = dwidth(dn);
172: chk_len(d);
173: if(d==LDFW)
174: {
175: scale = 0;
176: for(d=LDFD,x=abs(dn);x>=1.0;x/=10.0,d--);
177: return(wrt_F(&f,LDFW,d,(ftnlen)sizeof(double)));
178: }
179: else
180: {
181: scale = 1;
182: return(wrt_E(&f,LDEW,LDED-scale,LDEE,(ftnlen)sizeof(double),'d'));
183: }
184: }
185:
186: LOCAL
187: lwrt_C(a,b) float a,b;
188: { int n;
189: chk_len(LCW);
190: PUT(' ')
191: PUT(' ')
192: PUT('(')
193: if(n=lwrt_F(a)) return(n);
194: PUT(',')
195: if(n=lwrt_F(b)) return(n);
196: PUT(')')
197: return(OK);
198: }
199:
200: LOCAL
201: lwrt_DC(a,b) double a,b;
202: { int n;
203: chk_len(LDCW);
204: PUT(' ')
205: PUT(' ')
206: PUT('(')
207: if(n=lwrt_D(a)) return(n);
208: PUT(',')
209: if(n=lwrt_D(b)) return(n);
210: PUT(')')
211: return(OK);
212: }
213:
214: LOCAL
215: lwrt_0()
216: { int n; char *z = " 0.";
217: chk_len(4);
218: while(*z) PUT(*z++)
219: return(OK);
220: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.