#include "f2c.h"#include "fio.h"#include "lio.h"#include "stdlib.h"#include "string.h"Include dependency graph for rsne.c:
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 | |
| int | t_getc (Void) |
| int | ungetc (int, FILE *) |
| static Vardesc * | hash (hashtab *ht, register char *s) |
| hashtab * | mk_hashtab (Namelist *nl) |
| static VOID | nl_init (Void) |
| static int | getname (register char *s, int slen) |
| static int | getnum (int *chp, ftnlen *val) |
| static int | getdimen (int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1) |
| static Void | print_ne (cilist *a) |
| int | x_rsne (cilist *a) |
| integer | s_rsne (cilist *a) |
Variables | |
| static hashtab * | nl_cache |
| static int | n_nlcache |
| static hashentry ** | zot |
| static int | colonseen |
| ftnlen | f__typesize [] |
| flag | f__lquit |
| int | f__lcount |
| int | nml_read |
| static char | Alpha [256] |
| static char | Alphanum [256] |
| static char | where0 [] = "namelist read start " |
| #define MAX_NL_CACHE 3 |
| #define MAXDIM 20 |
Definition at line 241 of file rsne.c.
References colonseen, dimen::curval, dimen::delta, dimen::extent, getnum(), and dimen::stride.
Referenced by x_rsne().
00243 { 00244 register int k; 00245 ftnlen x2, x3; 00246 00247 if (k = getnum(chp, x1)) 00248 return k; 00249 x3 = 1; 00250 if (*chp == ':') { 00251 if (k = getnum(chp, &x2)) 00252 return k; 00253 x2 -= *x1; 00254 if (*chp == ':') { 00255 if (k = getnum(chp, &x3)) 00256 return k; 00257 if (!x3) 00258 return 123; 00259 x2 /= x3; 00260 colonseen = 1; 00261 } 00262 if (x2 < 0 || x2 >= extent) 00263 return 123; 00264 d->extent = x2 + 1; 00265 } 00266 else 00267 d->extent = 1; 00268 d->curval = 0; 00269 d->delta = delta; 00270 d->stride = x3; 00271 return 0; 00272 }
Here is the call graph for this function:
Here is the caller graph for this function:
Definition at line 180 of file rsne.c.
References cilist::cierr, err, errfl, f__cf, f__elist, GETC, and Ungetc.
Referenced by Pfile(), and x_rsne().
00182 { 00183 register char *se = s + slen - 1; 00184 register int ch; 00185 00186 GETC(ch); 00187 if (!(*s++ = Alpha[ch & 0xff])) { 00188 if (ch != EOF) 00189 ch = 115; 00190 errfl(f__elist->cierr, ch, "namelist read"); 00191 } 00192 while(*s = Alphanum[GETC(ch) & 0xff]) 00193 if (s < se) 00194 s++; 00195 if (ch == EOF) 00196 err(f__elist->cierr, EOF, "namelist read"); 00197 if (ch > ' ') 00198 Ungetc(ch,f__cf); 00199 return *s = 0; 00200 }
Here is the caller graph for this function:
Definition at line 206 of file rsne.c.
Referenced by getdimen().
00208 { 00209 register int ch, sign; 00210 register ftnlen x; 00211 00212 while(GETC(ch) <= ' ' && ch >= 0); 00213 if (ch == '-') { 00214 sign = 1; 00215 GETC(ch); 00216 } 00217 else { 00218 sign = 0; 00219 if (ch == '+') 00220 GETC(ch); 00221 } 00222 x = ch - '0'; 00223 if (x < 0 || x > 9) 00224 return 115; 00225 while(GETC(ch) >= '0' && ch <= '9') 00226 x = 10*x + ch - '0'; 00227 while(ch <= ' ' && ch >= 0) 00228 GETC(ch); 00229 if (ch == EOF) 00230 return EOF; 00231 *val = sign ? -x : x; 00232 *chp = ch; 00233 return 0; 00234 }
Here is the caller graph for this function:
Definition at line 83 of file rsne.c.
References h, hashtab::htsize, hashtab::tab, x, and zot.
Referenced by hashfromkey_string(), hashtable_change(), hashtable_insert(), hashtable_iterator_search(), hashtable_remove(), hashtable_search(), in_word_set(), mk_hashtab(), mkname(), setGetHashTableHash(), x_rsne(), and xcall_in_word_set().
00085 { 00086 register int c, x; 00087 register hashentry *h; 00088 char *s0 = s; 00089 00090 for(x = 0; c = *s++; x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1) 00091 x += c; 00092 for(h = *(zot = ht->tab + x % ht->htsize); h; h = h->next) 00093 if (!strcmp(s0, h->name)) 00094 return h->vd; 00095 return 0; 00096 }
Here is the caller graph for this function:
Definition at line 102 of file rsne.c.
References free(), hash(), hashtab::htsize, malloc(), MAX_NL_CACHE, memset(), n_nlcache, hashentry::name, hashentry::next, hashtab::next, hashtab::nl, nl, nl_cache, nv, hashtab::tab, v, hashentry::vd, x, y, and zot.
Referenced by x_rsne().
00104 { 00105 int nht, nv; 00106 hashtab *ht; 00107 Vardesc *v, **vd, **vde; 00108 hashentry *he; 00109 00110 hashtab **x, **x0, *y; 00111 for(x = &nl_cache; y = *x; x0 = x, x = &y->next) 00112 if (nl == y->nl) 00113 return y; 00114 if (n_nlcache >= MAX_NL_CACHE) { 00115 /* discard least recently used namelist hash table */ 00116 y = *x0; 00117 free((char *)y->next); 00118 y->next = 0; 00119 } 00120 else 00121 n_nlcache++; 00122 nv = nl->nvars; 00123 if (nv >= 0x4000) 00124 nht = 0x7fff; 00125 else { 00126 for(nht = 1; nht < nv; nht <<= 1); 00127 nht += nht - 1; 00128 } 00129 ht = (hashtab *)malloc(sizeof(hashtab) + (nht-1)*sizeof(hashentry *) 00130 + nv*sizeof(hashentry)); 00131 if (!ht) 00132 return 0; 00133 he = (hashentry *)&ht->tab[nht]; 00134 ht->nl = nl; 00135 ht->htsize = nht; 00136 ht->next = nl_cache; 00137 nl_cache = ht; 00138 memset((char *)ht->tab, 0, nht*sizeof(hashentry *)); 00139 vd = nl->vars; 00140 vde = vd + nv; 00141 while(vd < vde) { 00142 v = *vd++; 00143 if (!hash(ht, v->name)) { 00144 he->next = *zot; 00145 *zot = he; 00146 he->name = v->name; 00147 he->vd = v; 00148 he++; 00149 } 00150 } 00151 return ht; 00152 }
Here is the call graph for this function:
Here is the caller graph for this function:
| static VOID nl_init | ( | Void | ) | [static] |
Definition at line 157 of file rsne.c.
References f__init, and f_init().
Referenced by x_rsne().
00157 { 00158 register char *s; 00159 register int c; 00160 00161 if(!f__init) 00162 f_init(); 00163 for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; ) 00164 Alpha[c] 00165 = Alphanum[c] 00166 = Alpha[c + 'a' - 'A'] 00167 = Alphanum[c + 'a' - 'A'] 00168 = c; 00169 for(s = "0123456789_"; c = *s++; ) 00170 Alphanum[c] = c; 00171 }
Here is the call graph for this function:
Here is the caller graph for this function:
| static Void print_ne | ( | cilist * | a | ) | [static] |
Definition at line 279 of file rsne.c.
References a, f__cf, f__curunit, f__elist, f__external, f__reading, f__recpos, s_wsne(), and t.
Referenced by x_rsne().
00281 { 00282 flag intext = f__external; 00283 int rpsave = f__recpos; 00284 FILE *cfsave = f__cf; 00285 unit *usave = f__curunit; 00286 cilist t; 00287 t = *a; 00288 t.ciunit = 6; 00289 s_wsne(&t); 00290 fflush(f__cf); 00291 f__external = intext; 00292 f__reading = 1; 00293 f__recpos = rpsave; 00294 f__cf = cfsave; 00295 f__curunit = usave; 00296 f__elist = a; 00297 }
Here is the call graph for this function:
Here is the caller graph for this function:
Definition at line 603 of file rsne.c.
References a, c_le(), e_rsle(), err, errno, f__curunit, f__doend, f__external, f__nowreading(), l_eof, l_getc, l_ungetc, n, nml_read, t_getc(), un_getc, unit::uwrt, x_rsne(), and xrd_SL().
00605 { 00606 extern int l_eof; 00607 int n; 00608 00609 f__external=1; 00610 l_eof = 0; 00611 if(n = c_le(a)) 00612 return n; 00613 if(f__curunit->uwrt && f__nowreading(f__curunit)) 00614 err(a->cierr,errno,where0); 00615 l_getc = t_getc; 00616 l_ungetc = un_getc; 00617 f__doend = xrd_SL; 00618 n = x_rsne(a); 00619 nml_read = 0; 00620 if (n) 00621 return n; 00622 return e_rsle(); 00623 }
Here is the call graph for this function:
| int t_getc | ( | Void | ) |
Definition at line 87 of file lread.c.
References f__curunit, and unit::uend.
Referenced by e_rsle(), s_rsle(), and s_rsne().
00088 { int ch; 00089 if(f__curunit->uend) return(EOF); 00090 if((ch=getc(f__cf))!=EOF) return(ch); 00091 if(feof(f__cf)) 00092 f__curunit->uend = l_eof = 1; 00093 return(EOF); 00094 }
Here is the caller graph for this function:
Definition at line 306 of file rsne.c.
References a, b, buf, cilist::cierr, colonseen, dimen::delta, dims, e_rsle(), eof, err, errfl, dimen::extent, f__cf, f__elist, f__external, f__formatted, f__reading, f__typesize, GETC, getdimen(), getname(), hash(), int, MAXDIM, mk_hashtab(), n, nd, nl, nl_init(), print_ne(), quote, size, dimen::stride, top, TYCHAR, type, Ungetc, v, where, and z_rnew().
Referenced by s_rsne(), and s_rsni().
00308 { 00309 int ch, got1, k, n, nd, quote, readall; 00310 Namelist *nl; 00311 static char where[] = "namelist read"; 00312 char buf[64]; 00313 hashtab *ht; 00314 Vardesc *v; 00315 dimen *dn, *dn0, *dn1; 00316 ftnlen *dims, *dims1; 00317 ftnlen b, b0, b1, ex, no, nomax, size, span; 00318 ftnint no1, no2, type; 00319 char *vaddr; 00320 long iva, ivae; 00321 dimen dimens[MAXDIM], substr; 00322 00323 if (!Alpha['a']) 00324 nl_init(); 00325 f__reading=1; 00326 f__formatted=1; 00327 got1 = 0; 00328 top: 00329 for(;;) switch(GETC(ch)) { 00330 case EOF: 00331 eof: 00332 err(a->ciend,(EOF),where0); 00333 case '&': 00334 case '$': 00335 goto have_amp; 00336 #ifndef No_Namelist_Questions 00337 case '?': 00338 print_ne(a); 00339 continue; 00340 #endif 00341 default: 00342 if (ch <= ' ' && ch >= 0) 00343 continue; 00344 #ifndef No_Namelist_Comments 00345 while(GETC(ch) != '\n') 00346 if (ch == EOF) 00347 goto eof; 00348 #else 00349 errfl(a->cierr, 115, where0); 00350 #endif 00351 } 00352 have_amp: 00353 if (ch = getname(buf,sizeof(buf))) 00354 return ch; 00355 nl = (Namelist *)a->cifmt; 00356 if (strcmp(buf, nl->name)) 00357 #ifdef No_Bad_Namelist_Skip 00358 errfl(a->cierr, 118, where0); 00359 #else 00360 { 00361 fprintf(stderr, 00362 "Skipping namelist \"%s\": seeking namelist \"%s\".\n", 00363 buf, nl->name); 00364 fflush(stderr); 00365 for(;;) switch(GETC(ch)) { 00366 case EOF: 00367 err(a->ciend, EOF, where0); 00368 case '/': 00369 case '&': 00370 case '$': 00371 if (f__external) 00372 e_rsle(); 00373 else 00374 z_rnew(); 00375 goto top; 00376 case '"': 00377 case '\'': 00378 quote = ch; 00379 more_quoted: 00380 while(GETC(ch) != quote) 00381 if (ch == EOF) 00382 err(a->ciend, EOF, where0); 00383 if (GETC(ch) == quote) 00384 goto more_quoted; 00385 Ungetc(ch,f__cf); 00386 default: 00387 continue; 00388 } 00389 } 00390 #endif 00391 ht = mk_hashtab(nl); 00392 if (!ht) 00393 errfl(f__elist->cierr, 113, where0); 00394 for(;;) { 00395 for(;;) switch(GETC(ch)) { 00396 case EOF: 00397 if (got1) 00398 return 0; 00399 err(a->ciend, EOF, where0); 00400 case '/': 00401 case '$': 00402 case '&': 00403 return 0; 00404 default: 00405 if (ch <= ' ' && ch >= 0 || ch == ',') 00406 continue; 00407 Ungetc(ch,f__cf); 00408 if (ch = getname(buf,sizeof(buf))) 00409 return ch; 00410 goto havename; 00411 } 00412 havename: 00413 v = hash(ht,buf); 00414 if (!v) 00415 errfl(a->cierr, 119, where); 00416 while(GETC(ch) <= ' ' && ch >= 0); 00417 vaddr = v->addr; 00418 type = v->type; 00419 if (type < 0) { 00420 size = -type; 00421 type = TYCHAR; 00422 } 00423 else 00424 size = f__typesize[type]; 00425 ivae = size; 00426 iva = readall = 0; 00427 if (ch == '(' /*)*/ ) { 00428 dn = dimens; 00429 if (!(dims = v->dims)) { 00430 if (type != TYCHAR) 00431 errfl(a->cierr, 122, where); 00432 if (k = getdimen(&ch, dn, (ftnlen)size, 00433 (ftnlen)size, &b)) 00434 errfl(a->cierr, k, where); 00435 if (ch != ')') 00436 errfl(a->cierr, 115, where); 00437 b1 = dn->extent; 00438 if (--b < 0 || b + b1 > size) 00439 return 124; 00440 iva += b; 00441 size = b1; 00442 while(GETC(ch) <= ' ' && ch >= 0); 00443 goto scalar; 00444 } 00445 nd = (int)dims[0]; 00446 nomax = span = dims[1]; 00447 ivae = iva + size*nomax; 00448 colonseen = 0; 00449 if (k = getdimen(&ch, dn, size, nomax, &b)) 00450 errfl(a->cierr, k, where); 00451 no = dn->extent; 00452 b0 = dims[2]; 00453 dims1 = dims += 3; 00454 ex = 1; 00455 for(n = 1; n++ < nd; dims++) { 00456 if (ch != ',') 00457 errfl(a->cierr, 115, where); 00458 dn1 = dn + 1; 00459 span /= *dims; 00460 if (k = getdimen(&ch, dn1, dn->delta**dims, 00461 span, &b1)) 00462 errfl(a->cierr, k, where); 00463 ex *= *dims; 00464 b += b1*ex; 00465 no *= dn1->extent; 00466 dn = dn1; 00467 } 00468 if (ch != ')') 00469 errfl(a->cierr, 115, where); 00470 readall = 1 - colonseen; 00471 b -= b0; 00472 if (b < 0 || b >= nomax) 00473 errfl(a->cierr, 125, where); 00474 iva += size * b; 00475 dims = dims1; 00476 while(GETC(ch) <= ' ' && ch >= 0); 00477 no1 = 1; 00478 dn0 = dimens; 00479 if (type == TYCHAR && ch == '(' /*)*/) { 00480 if (k = getdimen(&ch, &substr, size, size, &b)) 00481 errfl(a->cierr, k, where); 00482 if (ch != ')') 00483 errfl(a->cierr, 115, where); 00484 b1 = substr.extent; 00485 if (--b < 0 || b + b1 > size) 00486 return 124; 00487 iva += b; 00488 b0 = size; 00489 size = b1; 00490 while(GETC(ch) <= ' ' && ch >= 0); 00491 if (b1 < b0) 00492 goto delta_adj; 00493 } 00494 if (readall) 00495 goto delta_adj; 00496 for(; dn0 < dn; dn0++) { 00497 if (dn0->extent != *dims++ || dn0->stride != 1) 00498 break; 00499 no1 *= dn0->extent; 00500 } 00501 if (dn0 == dimens && dimens[0].stride == 1) { 00502 no1 = dimens[0].extent; 00503 dn0++; 00504 } 00505 delta_adj: 00506 ex = 0; 00507 for(dn1 = dn0; dn1 <= dn; dn1++) 00508 ex += (dn1->extent-1) 00509 * (dn1->delta *= dn1->stride); 00510 for(dn1 = dn; dn1 > dn0; dn1--) { 00511 ex -= (dn1->extent - 1) * dn1->delta; 00512 dn1->delta -= ex; 00513 } 00514 } 00515 else if (dims = v->dims) { 00516 no = no1 = dims[1]; 00517 ivae = iva + no*size; 00518 } 00519 else 00520 scalar: 00521 no = no1 = 1; 00522 if (ch != '=') 00523 errfl(a->cierr, 115, where); 00524 got1 = nml_read = 1; 00525 f__lcount = 0; 00526 readloop: 00527 for(;;) { 00528 if (iva >= ivae || iva < 0) { 00529 f__lquit = 1; 00530 goto mustend; 00531 } 00532 else if (iva + no1*size > ivae) 00533 no1 = (ivae - iva)/size; 00534 f__lquit = 0; 00535 if (k = l_read(&no1, vaddr + iva, size, type)) 00536 return k; 00537 if (f__lquit == 1) 00538 return 0; 00539 if (readall) { 00540 iva += dn0->delta; 00541 if (f__lcount > 0) { 00542 no2 = (ivae - iva)/size; 00543 if (no2 > f__lcount) 00544 no2 = f__lcount; 00545 if (k = l_read(&no2, vaddr + iva, 00546 size, type)) 00547 return k; 00548 iva += no2 * dn0->delta; 00549 } 00550 } 00551 mustend: 00552 GETC(ch); 00553 if (readall) 00554 if (iva >= ivae) 00555 readall = 0; 00556 else for(;;) { 00557 switch(ch) { 00558 case ' ': 00559 case '\t': 00560 case '\n': 00561 GETC(ch); 00562 continue; 00563 } 00564 break; 00565 } 00566 if (ch == '/' || ch == '$' || ch == '&') { 00567 f__lquit = 1; 00568 return 0; 00569 } 00570 else if (f__lquit) { 00571 while(ch <= ' ' && ch >= 0) 00572 GETC(ch); 00573 Ungetc(ch,f__cf); 00574 if (!Alpha[ch & 0xff] && ch >= 0) 00575 errfl(a->cierr, 125, where); 00576 break; 00577 } 00578 Ungetc(ch,f__cf); 00579 if (readall && !Alpha[ch & 0xff]) 00580 goto readloop; 00581 if ((no -= no1) <= 0) 00582 break; 00583 for(dn1 = dn0; dn1 <= dn; dn1++) { 00584 if (++dn1->curval < dn1->extent) { 00585 iva += dn1->delta; 00586 goto readloop; 00587 } 00588 dn1->curval = 0; 00589 } 00590 break; 00591 } 00592 } 00593 }
Here is the call graph for this function:
Here is the caller graph for this function:
char Alpha[256] [static] |
Definition at line 154 of file rsne.c.
Referenced by axis_3ddraw(), DecreaseAlphaLevel(), IncreaseAlphaLevel(), and SetEch3d1().
1.5.1