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