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