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(). |
|
|
|
|