![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to nio.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / libI77 / notused|
Return to nio.c CVS log | Up to [Research Unix] / researchv10dc / libI77 / notused |
1.1 root 1: /* @(#)nio.c 1.1 */
2: #include <stdio.h>
3: #include <ctype.h>
4: #include "fio.h"
5: #include "fmt.h"
6: #include "lio.h"
7:
8: /*
9: * namelist io
10: *
11: * see f77's proc.c at namelist() for description
12: */
13:
14: typedef struct {
15: int ndims; /* # of dimensions */
16: int nels; /* # of elements */
17: int baseoff; /* how to get to (0,...,0) element */
18: int span[7]; /* span of each dimension +1+ */
19: } Dims; /* dimension descriptor */
20:
21:
22: /* +1+ note: only # of dimensions
23: applies here, i.e. actual array
24: is between 0 and 7 elements based
25: on ndims */
26:
27: typedef union {
28: char *pchar;
29: short *pshort;
30: int *pint;
31: long *plong;
32: float *pfloat;
33: double *pdouble;
34: char **pptr;
35: } Pointer; /* pointer to all sorts of things */
36:
37:
38: typedef struct {
39: char varname[18]; /* name of variable */
40: Pointer varaddr; /* where it is */
41: int type; /* its type */
42: Dims *dimp; /* dimension descriptor */
43: } Nlentry; /* namelist entry: 1 for each var */
44:
45:
46: typedef struct {
47: char nlname[18]; /* name of namelist */
48: Nlentry nlvnames[1]; /* array of variable descriptors +2+*/
49: } Namelist;
50:
51: /* +2+ note: this array is not bounded
52: but is terminated by an entry with a
53: null varname */
54:
55: /*
56: * s_rsne - start read namelist external
57: *
58: * s_rsne
59: * if (file not initialized)
60: * intialize it
61: * if (file doesn't jive with namelist io)
62: * return error
63: * initialize some global variables
64: * if (not currently reading on file OR not capable of doing so)
65: * return error
66: * read namelist name
67: * if (not correct namelist name)
68: * error
69: * determine number of variables in namelist
70: * read variable name
71: * while (variable name is not "&end")
72: * if (variable is in namelist)
73: * read value(s) for it
74: * else
75: * error
76: * if (not correct number of variables read)
77: * error
78: * end s_rsne
79: */
80:
81: #define BSIZ 50
82:
83: static char nlrs[] = "namelist read";
84:
85: s_rsne(pnlarg)
86: cilist *pnlarg;
87: {
88: Namelist *pnl;
89: Nlentry *pnlent, *findit();
90: int nvars, n;
91: char buf[BSIZ], *getword();
92:
93: if (!init)
94: f_init();
95: if (n = c_nle(pnlarg))
96: return (n);
97: reading = external = sequential = 1;
98: formatted = 0;
99: if (curunit->uwrt && nowreading(curunit))
100: return (1);
101: pnl = (Namelist *) pnlarg->cifmt;
102: if (getc(cf) != ' ' || getc(cf) != '&')
103: err(pnlarg->cierr, 115, nlrs);
104: if (strcmp(pnl->nlname, getword(buf, strlen(pnl->nlname))))
105: err(pnlarg->cierr, 118, buf);
106: n = getc(cf);
107: if (!isspace(n))
108: err(pnlarg->cierr, 115, nlrs);
109: for (nvars=0, pnlent = pnl->nlvnames; strlen(pnlent->varname); ++pnlent)
110: ++nvars;
111: n = 0;
112: elist = pnlarg;
113: while (nvars--)
114: {
115: if (!getword(buf, BSIZ - 1))
116: err(pnlarg->cierr, 120, nlrs);
117: if (!strcmp(buf, "&end"))
118: err(pnlarg->cierr, 121, nlrs);
119: if (!(pnlent = findit(buf, pnl->nlvnames)))
120: err(pnlarg->cierr, 119, buf);
121: if (getvar(pnlent))
122: err(pnlarg->cierr, 120, nlrs);
123: }
124: if (!getword(buf, BSIZ - 1))
125: err(pnlarg->cierr, 120, nlrs);
126: if (strcmp(buf, "&end"))
127: err(pnlarg->cierr, 121, nlrs);
128: return (0);
129: }
130:
131: /* miscellaneous utility functions for namelist read */
132:
133: /* getword - get a "word" text string from current file */
134:
135: char *getword(s, n)
136: char *s;
137: int n;
138: {
139: int i;
140: char *p;
141:
142: p = s;
143: i = getc(cf);
144: while (isspace(i) || (ispunct(i) && i != '&'))
145: i = getc(cf);
146: while (n--)
147: {
148: if (i != EOF && i != '=' && !isspace(i))
149: if (isupper(i))
150: *p++ = tolower(i);
151: else
152: *p++ = i;
153: else
154: break;
155: i = getc(cf);
156: }
157: if (feof(cf) && p == s)
158: return (NULL);
159: *p = '\0';
160: return (s);
161: }
162:
163: /* findit - find key in list of Nlentrys */
164:
165: Nlentry *findit(key, list)
166: char *key;
167: Nlentry *list;
168: {
169: while (strlen(list->varname))
170: {
171: if (!strcmp(key, list->varname))
172: return (list);
173: else
174: ++list;
175: }
176: return (NULL);
177: }
178:
179: /* getvar - read values for namelist io
180: *
181: * getvar uses l_read of list io to do all the dirty work, therefore
182: * it should be inserted into the library before lread.c (on UNIX
183: * systems with barbaric topologically sorted libraries)
184: *
185: * It sets the cierr flag so that l_read (and its subordinates) will
186: * not report errors, but pass them back so that the diagnostic message
187: * will appear to come from "namelist read".
188: */
189:
190: getvar(pnlent)
191: Nlentry *pnlent;
192: {
193: int n, i, size;
194:
195: if (pnlent->dimp)
196: n = pnlent->dimp->nels;
197: else
198: n = 1;
199: elist->cierr = 1;
200: switch (pnlent->type)
201: {
202: case TYADDR:
203: size = sizeof(char *);
204: break;
205: case TYSHORT:
206: size = sizeof(short);
207: break;
208: case TYLOGICAL:
209: case TYLONG:
210: size = sizeof(long);
211: break;
212: case TYREAL:
213: case TYCOMPLEX:
214: size = sizeof(float);
215: break;
216: case TYDREAL:
217: case TYDCOMPLEX:
218: size = sizeof(double);
219: break;
220: default:
221: if (pnlent->type < 0)
222: {
223: if (n = l_read(&n, pnlent->varaddr,
224: -pnlent->type, TYCHAR))
225: err(elist->cierr = 0, n, nlrs);
226: return (0);
227: }
228: else
229: err(elist->cierr = 0, 117, nlrs);
230: }
231: if (n = l_read(&n, pnlent->varaddr, size, pnlent->type))
232: err(0, n, nlrs);
233: elist->cierr = 0;
234: return (0);
235: }
236:
237: /*
238: * s_wsne - start write namelist external
239: *
240: * s_wsne
241: * if (file not initialized)
242: * initialize it
243: * if (file doesn't jive with namelist io)
244: * return error
245: * initialize some global variables
246: * if (not currently writing on file OR not capable of doing so)
247: * return error
248: * set up namelist and entry pointers
249: * output namelist name in proper format
250: * do
251: * output variable name
252: * output value based on type
253: * point to next entry
254: * while (there are more to do AND sneakily output a comma separator
255: * output end line
256: * end s_wsne
257: */
258:
259: s_wsne(pnlarg)
260: cilist *pnlarg;
261: {
262: Namelist *pnl;
263: Nlentry *pnlent;
264: Pointer ptr;
265: int i, n, vtype;
266: char *pch, buf[BSIZ];
267:
268: if (!init)
269: f_init();
270: if (n = c_nle(pnlarg))
271: return(n);
272: reading = formatted = 0;
273: external = sequential = 1;
274: if (!curunit->uwrt && nowwriting(curunit))
275: return(1);
276: pnl = (Namelist *) pnlarg->cifmt;
277: (void) putc(' ', cf);
278: (void) putc('&', cf);
279: (void) fputs(pnl->nlname, cf);
280: (void) putc('\n', cf);
281: (void) putc(' ', cf);
282: pnlent = pnl->nlvnames;
283: do {
284: (void) fputs(pnlent->varname, cf);
285: (void) putc('=', cf);
286: if (pnlent->dimp)
287: n = pnlent->dimp->nels;
288: else
289: n = 1;
290: if ((vtype = pnlent->type) < 0 && (pch = pnlent->varaddr.pchar))
291: do {
292: (void) putc('\'', cf);
293: for (i = vtype; i; ++i)
294: (void) putc(*pch++, cf);
295: (void) putc('\'', cf);
296: } while (--n && !t_putc(','));
297: else
298: {
299: ptr.pchar = pnlent->varaddr.pchar;
300: do { switch (vtype)
301: {
302: case TYADDR:
303: (void) sprintf(buf,"0x%x", *ptr.pptr++);
304: break;
305: case TYSHORT:
306: (void) sprintf(buf,"%d", *ptr.pshort++);
307: break;
308: case TYLONG:
309: (void) sprintf(buf,"%ld", *ptr.plong++);
310: break;
311: case TYREAL:
312: (void)sprintf(buf,"%.8f",*ptr.pfloat++);
313: break;
314: case TYDREAL:
315: (void) sprintf(buf, "%.18e",
316: *ptr.pdouble++);
317: break;
318: case TYCOMPLEX:
319: (void) sprintf(buf, "(%.8f,%.8f)",
320: *ptr.pfloat, *(ptr.pfloat+1));
321: ptr.pfloat += 2;
322: break;
323: case TYDCOMPLEX:
324: (void) sprintf(buf, "(%.18e,%.18e)",
325: *ptr.pdouble, *(ptr.pdouble+1));
326: ptr.pdouble += 2;
327: break;
328: case TYCHAR:
329: (void) sprintf(buf, "%c", *ptr.pchar++);
330: break;
331: case TYLOGICAL:
332: (void) sprintf(buf, ".%s.",
333: (*ptr.plong ? "TRUE" : "FALSE"));
334: break;
335: default:
336: err(pnlarg->cierr, 117, "namelist io");
337: }
338: (void) fputs(buf, cf);
339: } while (--n && !t_putc(','));
340: }
341: ++pnlent;
342: } while (strlen(pnlent->varname) && !t_putc(','));
343: (void) fputs("\n &end\n", cf);
344: return (0);
345: }
346:
347: /*
348: * c_nle - check namelist external
349: *
350: * c_nle
351: * set up global variables
352: * if (bogus unit)
353: * fatal error
354: * if (unit is unitialized AND can't be)
355: * fatal error
356: * if (can't do unformatted io on unit)
357: * fatal error
358: * end c_nle
359: */
360:
361:
362: c_nle(pcl)
363: cilist *pcl;
364: {
365: fmtbuf = "namelist io";
366: if (0 > pcl->ciunit || pcl->ciunit >= MXUNIT)
367: err(pcl->cierr, 101, "start namelist io");
368: scale = recpos = 0;
369: curunit = &units[pcl->ciunit];
370: if (curunit->ufd == NULL && fk_open(SEQ, FMT, pcl->ciunit))
371: err(pcl->cierr, 102, "namelist io");
372: cf = curunit->ufd;
373: if (!curunit->ufmt)
374: err(pcl->cierr, 103, "namelist io");
375: return(0);
376: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.