Doxygen Source Code Documentation
rsne.c File Reference
#include "stdlib.h"#include "f2c.h"#include "fio.h"#include "lio.h"#include "string.h"Go to the source code of this file.
Data Structures | |
| struct | dimen |
| struct | hashentry |
| struct | hashtab |
Defines | |
| #define | MAX_NL_CACHE 3 |
| #define | MAXDIM 20 |
| #define | un_getc ungetc |
| #define | GETC(x) (x=(*l_getc)()) |
| #define | Ungetc(x, y) (*l_ungetc)(x,y) |
Typedefs | |
| typedef dimen | dimen |
| typedef hashentry | hashentry |
| typedef hashtab | hashtab |
Functions | |
| t_getc (Void) | |
| int | ungetc (int, FILE *) |
| Vardesc * | hash (hashtab *ht, register char *s) |
| hashtab * | mk_hashtab (Namelist *nl) |
| VOID | nl_init (Void) |
| int | getname (register char *s, int slen) |
| int | getnum (int *chp, ftnlen *val) |
| int | getdimen (int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1) |
| Void | print_ne (cilist *a) |
| x_rsne (cilist *a) | |
| integer | s_rsne (cilist *a) |
Variables | |
| hashtab * | nl_cache |
| n_nlcache | |
| hashentry ** | zot |
| int | colonseen |
| ftnlen | f__typesize [] |
| flag | f__lquit |
| int | f__lcount |
| int | nml_read |
| char | Alpha [256] |
| char | Alphanum [256] |
| char | where0 [] = "namelist read start " |
Define Documentation
|
|
|
|
|
Definition at line 6 of file rsne.c. Referenced by mk_hashtab(). |
|
|
Definition at line 7 of file rsne.c. Referenced by x_rsne(). |
|
|
Definition at line 66 of file rsne.c. Referenced by s_rsne(). |
|
|
|
Typedef Documentation
|
|
|
|
|
|
|
|
|
Function Documentation
|
||||||||||||||||||||||||
|
Definition at line 233 of file rsne.c. References colonseen, dimen::curval, dimen::delta, dimen::extent, getnum(), dimen::stride, and x2. Referenced by x_rsne().
00235 {
00236 register int k;
00237 ftnlen x2, x3;
00238
00239 if (k = getnum(chp, x1))
00240 return k;
00241 x3 = 1;
00242 if (*chp == ':') {
00243 if (k = getnum(chp, &x2))
00244 return k;
00245 x2 -= *x1;
00246 if (*chp == ':') {
00247 if (k = getnum(chp, &x3))
00248 return k;
00249 if (!x3)
00250 return 123;
00251 x2 /= x3;
00252 colonseen = 1;
00253 }
00254 if (x2 < 0 || x2 >= extent)
00255 return 123;
00256 d->extent = x2 + 1;
00257 }
00258 else
00259 d->extent = 1;
00260 d->curval = 0;
00261 d->delta = delta;
00262 d->stride = x3;
00263 return 0;
00264 }
|
|
||||||||||||
|
Definition at line 172 of file rsne.c. References Alpha, Alphanum, err, errfl, GETC, and Ungetc. Referenced by x_rsne().
00174 {
00175 register char *se = s + slen - 1;
00176 register int ch;
00177
00178 GETC(ch);
00179 if (!(*s++ = Alpha[ch & 0xff])) {
00180 if (ch != EOF)
00181 ch = 115;
00182 errfl(f__elist->cierr, ch, "namelist read");
00183 }
00184 while(*s = Alphanum[GETC(ch) & 0xff])
00185 if (s < se)
00186 s++;
00187 if (ch == EOF)
00188 err(f__elist->cierr, EOF, "namelist read");
00189 if (ch > ' ')
00190 Ungetc(ch,f__cf);
00191 return *s = 0;
00192 }
|
|
||||||||||||
|
Definition at line 198 of file rsne.c. References GETC. Referenced by getdimen().
00200 {
00201 register int ch, sign;
00202 register ftnlen x;
00203
00204 while(GETC(ch) <= ' ' && ch >= 0);
00205 if (ch == '-') {
00206 sign = 1;
00207 GETC(ch);
00208 }
00209 else {
00210 sign = 0;
00211 if (ch == '+')
00212 GETC(ch);
00213 }
00214 x = ch - '0';
00215 if (x < 0 || x > 9)
00216 return 115;
00217 while(GETC(ch) >= '0' && ch <= '9')
00218 x = 10*x + ch - '0';
00219 while(ch <= ' ' && ch >= 0)
00220 GETC(ch);
00221 if (ch == EOF)
00222 return EOF;
00223 *val = sign ? -x : x;
00224 *chp = ch;
00225 return 0;
00226 }
|
|
||||||||||||
|
Definition at line 75 of file rsne.c. References c, hashentry::name, hashentry::next, and hashentry::vd.
00077 {
00078 register int c, x;
00079 register hashentry *h;
00080 char *s0 = s;
00081
00082 for(x = 0; c = *s++; x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1)
00083 x += c;
00084 for(h = *(zot = ht->tab + x % ht->htsize); h; h = h->next)
00085 if (!strcmp(s0, h->name))
00086 return h->vd;
00087 return 0;
00088 }
|
|
|
Definition at line 94 of file rsne.c. References free, hash(), hashtab::htsize, malloc, MAX_NL_CACHE, n_nlcache, hashentry::name, Vardesc::name, hashentry::next, hashtab::next, hashtab::nl, nl_cache, hashtab::tab, v, hashentry::vd, and x0. Referenced by x_rsne().
00096 {
00097 int nht, nv;
00098 hashtab *ht;
00099 Vardesc *v, **vd, **vde;
00100 hashentry *he;
00101
00102 hashtab **x, **x0, *y;
00103 for(x = &nl_cache; y = *x; x0 = x, x = &y->next)
00104 if (nl == y->nl)
00105 return y;
00106 if (n_nlcache >= MAX_NL_CACHE) {
00107 /* discard least recently used namelist hash table */
00108 y = *x0;
00109 free((char *)y->next);
00110 y->next = 0;
00111 }
00112 else
00113 n_nlcache++;
00114 nv = nl->nvars;
00115 if (nv >= 0x4000)
00116 nht = 0x7fff;
00117 else {
00118 for(nht = 1; nht < nv; nht <<= 1);
00119 nht += nht - 1;
00120 }
00121 ht = (hashtab *)malloc(sizeof(hashtab) + (nht-1)*sizeof(hashentry *)
00122 + nv*sizeof(hashentry));
00123 if (!ht)
00124 return 0;
00125 he = (hashentry *)&ht->tab[nht];
00126 ht->nl = nl;
00127 ht->htsize = nht;
00128 ht->next = nl_cache;
00129 nl_cache = ht;
00130 memset((char *)ht->tab, 0, nht*sizeof(hashentry *));
00131 vd = nl->vars;
00132 vde = vd + nv;
00133 while(vd < vde) {
00134 v = *vd++;
00135 if (!hash(ht, v->name)) {
00136 he->next = *zot;
00137 *zot = he;
00138 he->name = v->name;
00139 he->vd = v;
00140 he++;
00141 }
00142 }
00143 return ht;
00144 }
|
|
|
Definition at line 149 of file rsne.c. References Alpha, Alphanum, c, and f_init(). Referenced by x_rsne().
00149 {
00150 register char *s;
00151 register int c;
00152
00153 if(!f__init)
00154 f_init();
00155 for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; )
00156 Alpha[c]
00157 = Alphanum[c]
00158 = Alpha[c + 'a' - 'A']
00159 = Alphanum[c + 'a' - 'A']
00160 = c;
00161 for(s = "0123456789_"; c = *s++; )
00162 Alphanum[c] = c;
00163 }
|
|
|
Definition at line 271 of file rsne.c. References a, cilist::ciunit, and s_wsne(). Referenced by x_rsne().
00273 {
00274 flag intext = f__external;
00275 int rpsave = f__recpos;
00276 FILE *cfsave = f__cf;
00277 unit *usave = f__curunit;
00278 cilist t;
00279 t = *a;
00280 t.ciunit = 6;
00281 s_wsne(&t);
00282 fflush(f__cf);
00283 f__external = intext;
00284 f__reading = 1;
00285 f__recpos = rpsave;
00286 f__cf = cfsave;
00287 f__curunit = usave;
00288 f__elist = a;
00289 }
|
|
|
Definition at line 590 of file rsne.c. References c_le(), cilist::cierr, e_rsle(), err, f__nowreading(), l_eof, nml_read, un_getc, where0, and x_rsne().
00592 {
00593 extern int l_eof;
00594 int n;
00595
00596 f__external=1;
00597 l_eof = 0;
00598 if(n = c_le(a))
00599 return n;
00600 if(f__curunit->uwrt && f__nowreading(f__curunit))
00601 err(a->cierr,errno,where0);
00602 l_getc = t_getc;
00603 l_ungetc = un_getc;
00604 f__doend = xrd_SL;
00605 n = x_rsne(a);
00606 nml_read = 0;
00607 if (n)
00608 return n;
00609 return e_rsle();
00610 }
|
|
|
Definition at line 71 of file lread.c. References l_eof. Referenced by e_rsle(), and s_rsle().
00072 { int ch;
00073 if(f__curunit->uend) return(EOF);
00074 if((ch=getc(f__cf))!=EOF) return(ch);
00075 if(feof(f__cf))
00076 f__curunit->uend = l_eof = 1;
00077 return(EOF);
00078 }
|
|
||||||||||||
|
Referenced by comlen(), getcd(), getRLEpair(), input_stream(), Ptoken(), Ptype(), read_colormap_file(), read_scan_integer(), REORDER_parseMap(), and x_getc(). |
|
|
Definition at line 297 of file rsne.c. References Vardesc::addr, Alpha, cilist::ciend, cilist::cierr, cilist::cifmt, colonseen, dimen::curval, dimen::delta, Vardesc::dims, e_rsle(), err, errfl, dimen::extent, f__lcount, f__lquit, f__typesize, GETC, getdimen(), getname(), hash(), l_read(), MAXDIM, mk_hashtab(), Namelist::name, nl_init(), nml_read, print_ne(), dimen::stride, top, Vardesc::type, Ungetc, v, where0, and z_rnew(). Referenced by s_rsne(), and s_rsni().
00299 {
00300 int ch, got1, k, n, nd, quote, readall;
00301 Namelist *nl;
00302 static char where[] = "namelist read";
00303 char buf[64];
00304 hashtab *ht;
00305 Vardesc *v;
00306 dimen *dn, *dn0, *dn1;
00307 ftnlen *dims, *dims1;
00308 ftnlen b, b0, b1, ex, no, no1, nomax, size, span;
00309 ftnint type;
00310 char *vaddr;
00311 long iva, ivae;
00312 dimen dimens[MAXDIM], substr;
00313
00314 if (!Alpha['a'])
00315 nl_init();
00316 f__reading=1;
00317 f__formatted=1;
00318 got1 = 0;
00319 top:
00320 for(;;) switch(GETC(ch)) {
00321 case EOF:
00322 eof:
00323 err(a->ciend,(EOF),where0);
00324 case '&':
00325 case '$':
00326 goto have_amp;
00327 #ifndef No_Namelist_Questions
00328 case '?':
00329 print_ne(a);
00330 continue;
00331 #endif
00332 default:
00333 if (ch <= ' ' && ch >= 0)
00334 continue;
00335 #ifndef No_Namelist_Comments
00336 while(GETC(ch) != '\n')
00337 if (ch == EOF)
00338 goto eof;
00339 #else
00340 errfl(a->cierr, 115, where0);
00341 #endif
00342 }
00343 have_amp:
00344 if (ch = getname(buf,sizeof(buf)))
00345 return ch;
00346 nl = (Namelist *)a->cifmt;
00347 if (strcmp(buf, nl->name))
00348 #ifdef No_Bad_Namelist_Skip
00349 errfl(a->cierr, 118, where0);
00350 #else
00351 {
00352 fprintf(stderr,
00353 "Skipping namelist \"%s\": seeking namelist \"%s\".\n",
00354 buf, nl->name);
00355 fflush(stderr);
00356 for(;;) switch(GETC(ch)) {
00357 case EOF:
00358 err(a->ciend, EOF, where0);
00359 case '/':
00360 case '&':
00361 case '$':
00362 if (f__external)
00363 e_rsle();
00364 else
00365 z_rnew();
00366 goto top;
00367 case '"':
00368 case '\'':
00369 quote = ch;
00370 more_quoted:
00371 while(GETC(ch) != quote)
00372 if (ch == EOF)
00373 err(a->ciend, EOF, where0);
00374 if (GETC(ch) == quote)
00375 goto more_quoted;
00376 Ungetc(ch,f__cf);
00377 default:
00378 continue;
00379 }
00380 }
00381 #endif
00382 ht = mk_hashtab(nl);
00383 if (!ht)
00384 errfl(f__elist->cierr, 113, where0);
00385 for(;;) {
00386 for(;;) switch(GETC(ch)) {
00387 case EOF:
00388 if (got1)
00389 return 0;
00390 err(a->ciend, EOF, where0);
00391 case '/':
00392 case '$':
00393 case '&':
00394 return 0;
00395 default:
00396 if (ch <= ' ' && ch >= 0 || ch == ',')
00397 continue;
00398 Ungetc(ch,f__cf);
00399 if (ch = getname(buf,sizeof(buf)))
00400 return ch;
00401 goto havename;
00402 }
00403 havename:
00404 v = hash(ht,buf);
00405 if (!v)
00406 errfl(a->cierr, 119, where);
00407 while(GETC(ch) <= ' ' && ch >= 0);
00408 vaddr = v->addr;
00409 type = v->type;
00410 if (type < 0) {
00411 size = -type;
00412 type = TYCHAR;
00413 }
00414 else
00415 size = f__typesize[type];
00416 ivae = size;
00417 iva = readall = 0;
00418 if (ch == '(' /*)*/ ) {
00419 dn = dimens;
00420 if (!(dims = v->dims)) {
00421 if (type != TYCHAR)
00422 errfl(a->cierr, 122, where);
00423 if (k = getdimen(&ch, dn, (ftnlen)size,
00424 (ftnlen)size, &b))
00425 errfl(a->cierr, k, where);
00426 if (ch != ')')
00427 errfl(a->cierr, 115, where);
00428 b1 = dn->extent;
00429 if (--b < 0 || b + b1 > size)
00430 return 124;
00431 iva += b;
00432 size = b1;
00433 while(GETC(ch) <= ' ' && ch >= 0);
00434 goto scalar;
00435 }
00436 nd = (int)dims[0];
00437 nomax = span = dims[1];
00438 ivae = iva + size*nomax;
00439 colonseen = 0;
00440 if (k = getdimen(&ch, dn, size, nomax, &b))
00441 errfl(a->cierr, k, where);
00442 no = dn->extent;
00443 b0 = dims[2];
00444 dims1 = dims += 3;
00445 ex = 1;
00446 for(n = 1; n++ < nd; dims++) {
00447 if (ch != ',')
00448 errfl(a->cierr, 115, where);
00449 dn1 = dn + 1;
00450 span /= *dims;
00451 if (k = getdimen(&ch, dn1, dn->delta**dims,
00452 span, &b1))
00453 errfl(a->cierr, k, where);
00454 ex *= *dims;
00455 b += b1*ex;
00456 no *= dn1->extent;
00457 dn = dn1;
00458 }
00459 if (ch != ')')
00460 errfl(a->cierr, 115, where);
00461 readall = 1 - colonseen;
00462 b -= b0;
00463 if (b < 0 || b >= nomax)
00464 errfl(a->cierr, 125, where);
00465 iva += size * b;
00466 dims = dims1;
00467 while(GETC(ch) <= ' ' && ch >= 0);
00468 no1 = 1;
00469 dn0 = dimens;
00470 if (type == TYCHAR && ch == '(' /*)*/) {
00471 if (k = getdimen(&ch, &substr, size, size, &b))
00472 errfl(a->cierr, k, where);
00473 if (ch != ')')
00474 errfl(a->cierr, 115, where);
00475 b1 = substr.extent;
00476 if (--b < 0 || b + b1 > size)
00477 return 124;
00478 iva += b;
00479 b0 = size;
00480 size = b1;
00481 while(GETC(ch) <= ' ' && ch >= 0);
00482 if (b1 < b0)
00483 goto delta_adj;
00484 }
00485 if (readall)
00486 goto delta_adj;
00487 for(; dn0 < dn; dn0++) {
00488 if (dn0->extent != *dims++ || dn0->stride != 1)
00489 break;
00490 no1 *= dn0->extent;
00491 }
00492 if (dn0 == dimens && dimens[0].stride == 1) {
00493 no1 = dimens[0].extent;
00494 dn0++;
00495 }
00496 delta_adj:
00497 ex = 0;
00498 for(dn1 = dn0; dn1 <= dn; dn1++)
00499 ex += (dn1->extent-1)
00500 * (dn1->delta *= dn1->stride);
00501 for(dn1 = dn; dn1 > dn0; dn1--) {
00502 ex -= (dn1->extent - 1) * dn1->delta;
00503 dn1->delta -= ex;
00504 }
00505 }
00506 else if (dims = v->dims) {
00507 no = no1 = dims[1];
00508 ivae = iva + no*size;
00509 }
00510 else
00511 scalar:
00512 no = no1 = 1;
00513 if (ch != '=')
00514 errfl(a->cierr, 115, where);
00515 got1 = nml_read = 1;
00516 f__lcount = 0;
00517 readloop:
00518 for(;;) {
00519 if (iva >= ivae || iva < 0) {
00520 f__lquit = 1;
00521 goto mustend;
00522 }
00523 else if (iva + no1*size > ivae)
00524 no1 = (ivae - iva)/size;
00525 f__lquit = 0;
00526 if (k = l_read(&no1, vaddr + iva, size, type))
00527 return k;
00528 if (f__lquit == 1)
00529 return 0;
00530 if (readall) {
00531 iva += dn0->delta;
00532 if (f__lcount > 0) {
00533 no1 = (ivae - iva)/size;
00534 if (no1 > f__lcount)
00535 no1 = f__lcount;
00536 iva += no1 * dn0->delta;
00537 if (k = l_read(&no1, vaddr + iva,
00538 size, type))
00539 return k;
00540 }
00541 }
00542 mustend:
00543 GETC(ch);
00544 if (readall)
00545 if (iva >= ivae)
00546 readall = 0;
00547 else for(;;) {
00548 switch(ch) {
00549 case ' ':
00550 case '\t':
00551 case '\n':
00552 GETC(ch);
00553 continue;
00554 }
00555 break;
00556 }
00557 if (ch == '/' || ch == '$' || ch == '&') {
00558 f__lquit = 1;
00559 return 0;
00560 }
00561 else if (f__lquit) {
00562 while(ch <= ' ' && ch >= 0)
00563 GETC(ch);
00564 Ungetc(ch,f__cf);
00565 if (!Alpha[ch & 0xff] && ch >= 0)
00566 errfl(a->cierr, 125, where);
00567 break;
00568 }
00569 Ungetc(ch,f__cf);
00570 if (readall && !Alpha[ch & 0xff])
00571 goto readloop;
00572 if ((no -= no1) <= 0)
00573 break;
00574 for(dn1 = dn0; dn1 <= dn; dn1++) {
00575 if (++dn1->curval < dn1->extent) {
00576 iva += dn1->delta;
00577 goto readloop;
00578 }
00579 dn1->curval = 0;
00580 }
00581 break;
00582 }
00583 }
00584 }
|
Variable Documentation
|
|
|
|
|
|
|
|
Definition at line 35 of file rsne.c. Referenced by getdimen(), and x_rsne(). |
|
|
Definition at line 39 of file rsne.c. Referenced by l_C(), l_CHAR(), l_L(), l_R(), l_read(), rd_count(), s_rsle(), and x_rsne(). |
|
|
Definition at line 38 of file rsne.c. Referenced by l_C(), l_L(), l_R(), l_read(), s_rsle(), and x_rsne(). |
|
|
Definition at line 36 of file rsne.c. Referenced by x_rsne(). |
|
|
Definition at line 33 of file rsne.c. Referenced by mk_hashtab(). |
|
|
Definition at line 32 of file rsne.c. Referenced by mk_hashtab(). |
|
|
Definition at line 39 of file rsne.c. Referenced by l_C(), l_L(), l_R(), l_read(), s_rsne(), and x_rsne(). |
|
|
|
|
|
|
