![[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] / 43BSDReno / lib / libI77|
Return to lwrite.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / 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.3 7/27/87
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: if(formatted == LISTDIRECTED)
131: {
132: chk_len(len);
133: for(i=0;i<len;i++) PUT(*p++)
134: }
135: else
136: {
137: chk_len(len+2);
138: PUT('\'')
139: for(i=0;i<len;i++) PUT(*p++)
140: PUT('\'')
141: }
142: return(OK);
143: }
144:
145: LOCAL
146: lwrt_F(fn) float fn;
147: { int d,n; float x; ufloat f;
148: if(fn==0.0) return(lwrt_0());
149: f.pf = fn;
150: d = width(fn);
151: chk_len(d);
152: if(d==LFW)
153: {
154: scale = 0;
155: for(d=LFD,x=abs(fn);x>=1.0;x/=10.0,d--);
156: return(wrt_F(&f,LFW,d,(ftnlen)sizeof(float)));
157: }
158: else
159: {
160: scale = 1;
161: return(wrt_E(&f,LEW,LED-scale,LEE,(ftnlen)sizeof(float),'e'));
162: }
163: }
164:
165: LOCAL
166: lwrt_D(dn) double dn;
167: { int d,n; double x; ufloat f;
168: if(dn==0.0) return(lwrt_0());
169: f.pd = dn;
170: d = dwidth(dn);
171: chk_len(d);
172: if(d==LDFW)
173: {
174: scale = 0;
175: for(d=LDFD,x=abs(dn);x>=1.0;x/=10.0,d--);
176: return(wrt_F(&f,LDFW,d,(ftnlen)sizeof(double)));
177: }
178: else
179: {
180: scale = 1;
181: return(wrt_E(&f,LDEW,LDED-scale,LDEE,(ftnlen)sizeof(double),'d'));
182: }
183: }
184:
185: LOCAL
186: lwrt_C(a,b) float a,b;
187: { int n;
188: chk_len(LCW);
189: PUT(' ')
190: PUT(' ')
191: PUT('(')
192: if(n=lwrt_F(a)) return(n);
193: PUT(',')
194: if(n=lwrt_F(b)) return(n);
195: PUT(')')
196: return(OK);
197: }
198:
199: LOCAL
200: lwrt_DC(a,b) double a,b;
201: { int n;
202: chk_len(LDCW);
203: PUT(' ')
204: PUT(' ')
205: PUT('(')
206: if(n=lwrt_D(a)) return(n);
207: PUT(',')
208: if(n=lwrt_D(b)) return(n);
209: PUT(')')
210: return(OK);
211: }
212:
213: LOCAL
214: lwrt_0()
215: { int n; char *z = " 0.";
216: chk_len(4);
217: while(*z) PUT(*z++)
218: return(OK);
219: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.