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