Doxygen Source Code Documentation
rsli.c File Reference
#include "f2c.h"#include "fio.h"#include "lio.h"#include "fmt.h"Go to the source code of this file.
Functions | |
| int | i_getc (Void) |
| int | i_ungetc (int ch, FILE *f) |
| void | c_lir (icilist *a) |
| integer | s_rsli (icilist *a) |
| integer | e_rsli (Void) |
| int | x_rsne (cilist *) |
| integer | s_rsni (icilist *a) |
Variables | |
| flag | f__lquit |
| int | f__lcount |
| char * | f__icptr |
| char * | f__icend |
| icilist * | f__svic |
| int | f__icnum |
| int | f__recpos |
Function Documentation
|
|
Definition at line 45 of file rsli.c. References a, f__icend, f__icnum, f__icptr, f__recpos, i_getc(), i_ungetc(), and l_eof. Referenced by s_rsli(), and s_rsni().
00047 {
00048 extern int l_eof;
00049 f__reading = 1;
00050 f__external = 0;
00051 f__formatted = 1;
00052 f__svic = a;
00053 L_len = a->icirlen;
00054 f__recpos = -1;
00055 f__icnum = f__recpos = 0;
00056 f__cursor = 0;
00057 l_getc = i_getc;
00058 l_ungetc = i_ungetc;
00059 l_eof = 0;
00060 f__icptr = a->iciunit;
00061 f__icend = f__icptr + a->icirlen*a->icirnum;
00062 f__cf = 0;
00063 f__curunit = 0;
00064 f__elist = (cilist *)a;
00065 }
|
|
|
Definition at line 82 of file rsli.c. Referenced by inumc_().
00083 { return 0; }
|
|
|
Definition at line 13 of file rsli.c. References f__icend, f__icptr, f__recpos, icilist::icirlen, and z_rnew(). Referenced by c_lir().
|
|
||||||||||||
|
Definition at line 30 of file rsli.c. References err, f__icptr, f__recpos, icilist::icierr, and icilist::icirlen. Referenced by c_lir().
|
|
|
Definition at line 71 of file rsli.c. References a, c_lir(), f__lcount, and f__lquit. Referenced by inumc_().
|
|
|
Definition at line 90 of file rsli.c. References a, c_lir(), cilist::ciend, cilist::cierr, cilist::cifmt, and x_rsne().
|
|
|
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 9 of file rsli.c. Referenced by c_lir(), c_si(), i_getc(), z_getc(), and z_putc(). |
|
|
Definition at line 11 of file rsli.c. Referenced by c_lir(), c_si(), e_wsfi(), z_rnew(), and z_wnew(). |
|
|
Definition at line 8 of file rsli.c. Referenced by c_lir(), i_getc(), and i_ungetc(). |
|
|
Definition at line 7 of file rsli.c. Referenced by s_rsli(). |
|
|
Definition at line 6 of file rsli.c. Referenced by s_rsli(). |
|
|
Definition at line 11 of file rsli.c. Referenced by c_lir(), i_getc(), and i_ungetc(). |
|
|
|
