#include "f2c.h"#include "fio.h"#include "lio.h"#include "fmt.h"Include dependency graph for rsli.c:
Go to the source code of this file.
Functions | |
| static int | i_getc (Void) |
| static int | i_ungetc (int ch, FILE *f) |
| static 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 |
| static void c_lir | ( | icilist * | a | ) | [static] |
Definition at line 48 of file rsli.c.
References a, f__cf, f__cursor, f__curunit, f__elist, f__external, f__formatted, f__reading, f__svic, i_getc(), i_ungetc(), l_eof, l_getc, L_len, and l_ungetc.
Referenced by s_rsli(), and s_rsni().
00050 { 00051 extern int l_eof; 00052 f__reading = 1; 00053 f__external = 0; 00054 f__formatted = 1; 00055 f__svic = a; 00056 L_len = a->icirlen; 00057 f__recpos = -1; 00058 f__icnum = f__recpos = 0; 00059 f__cursor = 0; 00060 l_getc = i_getc; 00061 l_ungetc = i_ungetc; 00062 l_eof = 0; 00063 f__icptr = a->iciunit; 00064 f__icend = f__icptr + a->icirlen*a->icirnum; 00065 f__cf = 0; 00066 f__curunit = 0; 00067 f__elist = (cilist *)a; 00068 }
Here is the call graph for this function:
Here is the caller graph for this function:
| static int i_getc | ( | Void | ) | [static] |
Definition at line 16 of file rsli.c.
References f__svic, icilist::icirlen, and z_rnew().
Referenced by c_lir().
00017 { 00018 if(f__recpos >= f__svic->icirlen) { 00019 if (f__recpos++ == f__svic->icirlen) 00020 return '\n'; 00021 z_rnew(); 00022 } 00023 f__recpos++; 00024 if(f__icptr >= f__icend) 00025 return EOF; 00026 return(*f__icptr++); 00027 }
Here is the call graph for this function:
Here is the caller graph for this function:
Definition at line 33 of file rsli.c.
References err, f__svic, icilist::icierr, and icilist::icirlen.
Referenced by c_lir().
00035 { 00036 if (--f__recpos == f__svic->icirlen) 00037 return '\n'; 00038 if (f__recpos < -1) 00039 err(f__svic->icierr,110,"recend"); 00040 /* *--icptr == ch, and icptr may point to read-only memory */ 00041 return *--f__icptr /* = ch */; 00042 }
Here is the caller graph for this function:
Definition at line 93 of file rsli.c.
References a, c_lir(), cilist::ciend, cilist::cierr, cilist::cifmt, nml_read, and x_rsne().
00095 { 00096 extern int nml_read; 00097 integer rv; 00098 cilist ca; 00099 ca.ciend = a->iciend; 00100 ca.cierr = a->icierr; 00101 ca.cifmt = a->icifmt; 00102 c_lir(a); 00103 rv = x_rsne(&ca); 00104 nml_read = 0; 00105 return rv; 00106 }
Here is the call 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:
Definition at line 44 of file err.c.
Referenced by c_dfe(), c_due(), c_le(), c_liw(), c_si(), do_ud(), do_us(), donewrec(), e_rdue(), e_rsue(), e_wsfi(), e_wsle(), f__putbuf(), iw_rev(), lwrt_A(), lwrt_C(), lwrt_F(), lwrt_I(), lwrt_L(), mv_cur(), print_ne(), rd_ed(), rd_ned(), s_rsfe(), s_rsue(), s_wsfe(), w_ned(), x_getc(), x_putc(), x_wSL(), x_wsne(), xrd_SL(), xw_end(), xw_rev(), y_getc(), y_rev(), y_rsk(), z_getc(), z_putc(), z_rnew(), and z_wnew().
1.5.1
