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