Doxygen Source Code Documentation
lread.c File Reference
#include "stdlib.h"
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
#include "lio.h"
#include "ctype.h"
#include "fp.h"
Go to the source code of this file.
Defines | |
#define | isblnk(x) (f__ltab[x+1]&B) |
#define | issep(x) (f__ltab[x+1]&SX) |
#define | isapos(x) (f__ltab[x+1]&AX) |
#define | isexp(x) (f__ltab[x+1]&EX) |
#define | issign(x) (f__ltab[x+1]&SG) |
#define | iswhit(x) (f__ltab[x+1]&WH) |
#define | SX 1 |
#define | B 2 |
#define | AX 4 |
#define | EX 8 |
#define | SG 16 |
#define | WH 32 |
#define | un_getc ungetc |
#define | ERR(x) if(n=(x)) return(n) |
#define | GETC(x) (x=(*l_getc)()) |
#define | Ungetc(x, y) (*l_ungetc)(x,y) |
#define | BUFSIZE 128 |
#define | Ptr ((flex *)ptr) |
Functions | |
int(*)(*) | l_getc (void) |
int | ungetc (int, FILE *) |
t_getc (Void) | |
integer | e_rsle (Void) |
l_R (int poststar) | |
int | rd_count (register int ch) |
l_C (Void) | |
l_L (Void) | |
l_CHAR (Void) | |
c_le (cilist *a) | |
l_read (ftnint *number, char *ptr, ftnlen len, ftnint type) | |
integer | s_rsle (cilist *a) |
Variables | |
char * | f__fmtbuf |
int(* | f__lioproc )(ftnint *, char *, ftnlen, ftnint) |
int(*)(*)(*) | l_ungetc (int, FILE *) |
int | l_eof |
char | f__ltab [128+1] |
flag | f__lquit |
int | f__lcount |
int | f__ltype |
int | nml_read |
char * | f__lchar |
double | f__lx |
double | f__ly |
Define Documentation
|
|
|
|
|
Definition at line 365 of file lread.c. Referenced by l_CHAR(). |
|
|
|
|
|
Definition at line 97 of file lread.c. Referenced by getname(), getnum(), l_C(), l_CHAR(), l_L(), l_R(), l_read(), rd_count(), and x_rsne(). |
|
|
|
|
|
Definition at line 33 of file lread.c. Referenced by l_R(). |
|
|
|
Definition at line 34 of file lread.c. Referenced by l_R(). |
|
Definition at line 35 of file lread.c. Referenced by l_C(). |
|
|
|
|
|
|
|
Definition at line 63 of file lread.c. Referenced by s_rsle(). |
|
Definition at line 98 of file lread.c. Referenced by getname(), l_C(), l_CHAR(), l_L(), l_R(), l_read(), rd_count(), and x_rsne(). |
|
|
Function Documentation
|
Definition at line 490 of file lread.c. References cilist::cierr, cilist::ciunit, err, f__fmtbuf, f_init(), fk_open(), FMT, and MXUNIT. Referenced by s_rsle(), s_rsne(), s_wsle(), and s_wsne().
00492 { 00493 if(!f__init) 00494 f_init(); 00495 f__fmtbuf="list io"; 00496 if(a->ciunit>=MXUNIT || a->ciunit<0) 00497 err(a->cierr,101,"stler"); 00498 f__scale=f__recpos=0; 00499 f__elist=a; 00500 f__curunit = &f__units[a->ciunit]; 00501 if(f__curunit->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) 00502 err(a->cierr,102,"lio"); 00503 f__cf=f__curunit->ufd; 00504 if(!f__curunit->ufmt) err(a->cierr,103,"lio") 00505 return(0); 00506 } |
|
Definition at line 79 of file lread.c. References l_eof, and t_getc().
|
|
Definition at line 258 of file lread.c. References err, errfl, f__lcount, f__lquit, f__ltype, f__lx, f__ly, GETC, iswhit, l_R(), nml_read, rd_count(), and Ungetc. Referenced by l_read().
00259 { int ch, nml_save; 00260 double lz; 00261 if(f__lcount>0) return(0); 00262 f__ltype=0; 00263 GETC(ch); 00264 if(ch!='(') 00265 { 00266 if (nml_read > 1 && (ch < '0' || ch > '9')) { 00267 Ungetc(ch,f__cf); 00268 f__lquit = 2; 00269 return 0; 00270 } 00271 if (rd_count(ch)) 00272 if(!f__cf || !feof(f__cf)) 00273 errfl(f__elist->cierr,112,"complex format"); 00274 else 00275 err(f__elist->cierr,(EOF),"lread"); 00276 if(GETC(ch)!='*') 00277 { 00278 if(!f__cf || !feof(f__cf)) 00279 errfl(f__elist->cierr,112,"no star"); 00280 else 00281 err(f__elist->cierr,(EOF),"lread"); 00282 } 00283 if(GETC(ch)!='(') 00284 { Ungetc(ch,f__cf); 00285 return(0); 00286 } 00287 } 00288 else 00289 f__lcount = 1; 00290 while(iswhit(GETC(ch))); 00291 Ungetc(ch,f__cf); 00292 nml_save = nml_read; 00293 nml_read = 0; 00294 if (ch = l_R(1)) 00295 return ch; 00296 if (!f__ltype) 00297 errfl(f__elist->cierr,112,"no real part"); 00298 lz = f__lx; 00299 while(iswhit(GETC(ch))); 00300 if(ch!=',') 00301 { (void) Ungetc(ch,f__cf); 00302 errfl(f__elist->cierr,112,"no comma"); 00303 } 00304 while(iswhit(GETC(ch))); 00305 (void) Ungetc(ch,f__cf); 00306 if (ch = l_R(1)) 00307 return ch; 00308 if (!f__ltype) 00309 errfl(f__elist->cierr,112,"no imaginary part"); 00310 while(iswhit(GETC(ch))); 00311 if(ch!=')') errfl(f__elist->cierr,112,"no )"); 00312 f__ly = f__lx; 00313 f__lx = lz; 00314 #ifdef Allow_TYQUAD 00315 f__llx = 0; 00316 #endif 00317 nml_read = nml_save; 00318 return(0); 00319 } |
|
Definition at line 366 of file lread.c. References BUFSIZE, errfl, f__lchar, f__lcount, f__ltype, free, GETC, i, isblnk, issep, malloc, p, realloc, and Ungetc. Referenced by l_read().
00367 { int ch,size,i; 00368 static char rafail[] = "realloc failure"; 00369 char quote,*p; 00370 if(f__lcount>0) return(0); 00371 f__ltype=0; 00372 if(f__lchar!=NULL) free(f__lchar); 00373 size=BUFSIZE; 00374 p=f__lchar = (char *)malloc((unsigned int)size); 00375 if(f__lchar == NULL) 00376 errfl(f__elist->cierr,113,"no space"); 00377 00378 GETC(ch); 00379 if(isdigit(ch)) { 00380 /* allow Fortran 8x-style unquoted string... */ 00381 /* either find a repetition count or the string */ 00382 f__lcount = ch - '0'; 00383 *p++ = ch; 00384 for(i = 1;;) { 00385 switch(GETC(ch)) { 00386 case '*': 00387 if (f__lcount == 0) { 00388 f__lcount = 1; 00389 goto noquote; 00390 } 00391 p = f__lchar; 00392 goto have_lcount; 00393 case ',': 00394 case ' ': 00395 case '\t': 00396 case '\n': 00397 case '/': 00398 Ungetc(ch,f__cf); 00399 /* no break */ 00400 case EOF: 00401 f__lcount = 1; 00402 f__ltype = TYCHAR; 00403 return *p = 0; 00404 } 00405 if (!isdigit(ch)) { 00406 f__lcount = 1; 00407 goto noquote; 00408 } 00409 *p++ = ch; 00410 f__lcount = 10*f__lcount + ch - '0'; 00411 if (++i == size) { 00412 f__lchar = (char *)realloc(f__lchar, 00413 (unsigned int)(size += BUFSIZE)); 00414 if(f__lchar == NULL) 00415 errfl(f__elist->cierr,113,rafail); 00416 p = f__lchar + i; 00417 } 00418 } 00419 } 00420 else (void) Ungetc(ch,f__cf); 00421 have_lcount: 00422 if(GETC(ch)=='\'' || ch=='"') quote=ch; 00423 else if(isblnk(ch) || (issep(ch) && ch != '\n') || ch==EOF) 00424 { (void) Ungetc(ch,f__cf); 00425 return(0); 00426 } 00427 else { 00428 /* Fortran 8x-style unquoted string */ 00429 *p++ = ch; 00430 for(i = 1;;) { 00431 switch(GETC(ch)) { 00432 case ',': 00433 case ' ': 00434 case '\t': 00435 case '\n': 00436 case '/': 00437 Ungetc(ch,f__cf); 00438 /* no break */ 00439 case EOF: 00440 f__ltype = TYCHAR; 00441 return *p = 0; 00442 } 00443 noquote: 00444 *p++ = ch; 00445 if (++i == size) { 00446 f__lchar = (char *)realloc(f__lchar, 00447 (unsigned int)(size += BUFSIZE)); 00448 if(f__lchar == NULL) 00449 errfl(f__elist->cierr,113,rafail); 00450 p = f__lchar + i; 00451 } 00452 } 00453 } 00454 f__ltype=TYCHAR; 00455 for(i=0;;) 00456 { while(GETC(ch)!=quote && ch!='\n' 00457 && ch!=EOF && ++i<size) *p++ = ch; 00458 if(i==size) 00459 { 00460 newone: 00461 f__lchar= (char *)realloc(f__lchar, 00462 (unsigned int)(size += BUFSIZE)); 00463 if(f__lchar == NULL) 00464 errfl(f__elist->cierr,113,rafail); 00465 p=f__lchar+i-1; 00466 *p++ = ch; 00467 } 00468 else if(ch==EOF) return(EOF); 00469 else if(ch=='\n') 00470 { if(*(p-1) != '\\') continue; 00471 i--; 00472 p--; 00473 if(++i<size) *p++ = ch; 00474 else goto newone; 00475 } 00476 else if(GETC(ch)==quote) 00477 { if(++i<size) *p++ = ch; 00478 else goto newone; 00479 } 00480 else 00481 { (void) Ungetc(ch,f__cf); 00482 *p = 0; 00483 return(0); 00484 } 00485 } 00486 } |
|
Referenced by s_rsle(). |
|
Definition at line 320 of file lread.c. References err, errfl, f__lcount, f__lquit, f__ltype, f__lx, GETC, isblnk, issep, nml_read, rd_count(), and Ungetc. Referenced by l_read().
00321 { 00322 int ch; 00323 if(f__lcount>0) return(0); 00324 f__lcount = 1; 00325 f__ltype=0; 00326 GETC(ch); 00327 if(isdigit(ch)) 00328 { 00329 rd_count(ch); 00330 if(GETC(ch)!='*') 00331 if(!f__cf || !feof(f__cf)) 00332 errfl(f__elist->cierr,112,"no star"); 00333 else 00334 err(f__elist->cierr,(EOF),"lread"); 00335 GETC(ch); 00336 } 00337 if(ch == '.') GETC(ch); 00338 switch(ch) 00339 { 00340 case 't': 00341 case 'T': 00342 f__lx=1; 00343 break; 00344 case 'f': 00345 case 'F': 00346 f__lx=0; 00347 break; 00348 default: 00349 if(isblnk(ch) || issep(ch) || ch==EOF) 00350 { (void) Ungetc(ch,f__cf); 00351 return(0); 00352 } 00353 if (nml_read > 1) { 00354 Ungetc(ch,f__cf); 00355 f__lquit = 2; 00356 return 0; 00357 } 00358 errfl(f__elist->cierr,112,"logical"); 00359 } 00360 f__ltype=TYLONG; 00361 while(!issep(GETC(ch)) && ch!=EOF); 00362 (void) Ungetc(ch, f__cf); 00363 return(0); 00364 } |
|
Definition at line 103 of file lread.c. References errfl, EXPMAX, EXPMAXDIGS, f__lcount, f__lquit, f__ltype, f__lx, FMAX, GETC, isexp, issign, nml_read, and Ungetc. Referenced by l_C(), and l_read().
00105 { 00106 char s[FMAX+EXPMAXDIGS+4]; 00107 register int ch; 00108 register char *sp, *spe, *sp1; 00109 long e, exp; 00110 int havenum, havestar, se; 00111 00112 if (!poststar) { 00113 if (f__lcount > 0) 00114 return(0); 00115 f__lcount = 1; 00116 } 00117 #ifdef Allow_TYQUAD 00118 f__llx = 0; 00119 #endif 00120 f__ltype = 0; 00121 exp = 0; 00122 havestar = 0; 00123 retry: 00124 sp1 = sp = s; 00125 spe = sp + FMAX; 00126 havenum = 0; 00127 00128 switch(GETC(ch)) { 00129 case '-': *sp++ = ch; sp1++; spe++; 00130 case '+': 00131 GETC(ch); 00132 } 00133 while(ch == '0') { 00134 ++havenum; 00135 GETC(ch); 00136 } 00137 while(isdigit(ch)) { 00138 if (sp < spe) *sp++ = ch; 00139 else ++exp; 00140 GETC(ch); 00141 } 00142 if (ch == '*' && !poststar) { 00143 if (sp == sp1 || exp || *s == '-') { 00144 errfl(f__elist->cierr,112,"bad repetition count"); 00145 } 00146 poststar = havestar = 1; 00147 *sp = 0; 00148 f__lcount = atoi(s); 00149 goto retry; 00150 } 00151 if (ch == '.') { 00152 GETC(ch); 00153 if (sp == sp1) 00154 while(ch == '0') { 00155 ++havenum; 00156 --exp; 00157 GETC(ch); 00158 } 00159 while(isdigit(ch)) { 00160 if (sp < spe) 00161 { *sp++ = ch; --exp; } 00162 GETC(ch); 00163 } 00164 } 00165 havenum += sp - sp1; 00166 se = 0; 00167 if (issign(ch)) 00168 goto signonly; 00169 if (havenum && isexp(ch)) { 00170 GETC(ch); 00171 if (issign(ch)) { 00172 signonly: 00173 if (ch == '-') se = 1; 00174 GETC(ch); 00175 } 00176 if (!isdigit(ch)) { 00177 bad: 00178 errfl(f__elist->cierr,112,"exponent field"); 00179 } 00180 00181 e = ch - '0'; 00182 while(isdigit(GETC(ch))) { 00183 e = 10*e + ch - '0'; 00184 if (e > EXPMAX) 00185 goto bad; 00186 } 00187 if (se) 00188 exp -= e; 00189 else 00190 exp += e; 00191 } 00192 (void) Ungetc(ch, f__cf); 00193 if (sp > sp1) { 00194 ++havenum; 00195 while(*--sp == '0') 00196 ++exp; 00197 if (exp) 00198 sprintf(sp+1, "e%ld", exp); 00199 else 00200 sp[1] = 0; 00201 f__lx = atof(s); 00202 #ifdef Allow_TYQUAD 00203 if (quad_read && (se = sp - sp1 + exp) > 14 && se < 20) { 00204 /* Assuming 64-bit longint and 32-bit long. */ 00205 if (exp < 0) 00206 sp += exp; 00207 if (sp1 <= sp) { 00208 f__llx = *sp1 - '0'; 00209 while(++sp1 <= sp) 00210 f__llx = 10*f__llx + (*sp1 - '0'); 00211 } 00212 while(--exp >= 0) 00213 f__llx *= 10; 00214 if (*s == '-') 00215 f__llx = -f__llx; 00216 } 00217 #endif 00218 } 00219 else 00220 f__lx = 0.; 00221 if (havenum) 00222 f__ltype = TYLONG; 00223 else 00224 switch(ch) { 00225 case ',': 00226 case '/': 00227 break; 00228 default: 00229 if (havestar && ( ch == ' ' 00230 ||ch == '\t' 00231 ||ch == '\n')) 00232 break; 00233 if (nml_read > 1) { 00234 f__lquit = 2; 00235 return 0; 00236 } 00237 errfl(f__elist->cierr,112,"invalid number"); 00238 } 00239 return 0; 00240 } |
|
Definition at line 510 of file lread.c. References b_char(), ERR, err, errfl, f__lchar, f__lcount, f__lquit, f__ltype, f__lx, f__ly, GETC, i, l_C(), l_CHAR(), l_L(), l_R(), nml_read, TYQUAD, and Ungetc. Referenced by s_rsle(), and x_rsne().
00512 { 00513 #define Ptr ((flex *)ptr) 00514 int i,n,ch; 00515 doublereal *yy; 00516 real *xx; 00517 for(i=0;i<*number;i++) 00518 { 00519 if(f__lquit) return(0); 00520 if(l_eof) 00521 err(f__elist->ciend, EOF, "list in") 00522 if(f__lcount == 0) { 00523 f__ltype = 0; 00524 for(;;) { 00525 GETC(ch); 00526 switch(ch) { 00527 case EOF: 00528 err(f__elist->ciend,(EOF),"list in") 00529 case ' ': 00530 case '\t': 00531 case '\n': 00532 continue; 00533 case '/': 00534 f__lquit = 1; 00535 goto loopend; 00536 case ',': 00537 f__lcount = 1; 00538 goto loopend; 00539 default: 00540 (void) Ungetc(ch, f__cf); 00541 goto rddata; 00542 } 00543 } 00544 } 00545 rddata: 00546 switch((int)type) 00547 { 00548 case TYINT1: 00549 case TYSHORT: 00550 case TYLONG: 00551 case TYREAL: 00552 case TYDREAL: 00553 ERR(l_R(0)); 00554 break; 00555 #ifdef TYQUAD 00556 case TYQUAD: 00557 quad_read = 1; 00558 n = l_R(0); 00559 quad_read = 0; 00560 if (n) 00561 return n; 00562 break; 00563 #endif 00564 case TYCOMPLEX: 00565 case TYDCOMPLEX: 00566 ERR(l_C()); 00567 break; 00568 case TYLOGICAL1: 00569 case TYLOGICAL2: 00570 case TYLOGICAL: 00571 ERR(l_L()); 00572 break; 00573 case TYCHAR: 00574 ERR(l_CHAR()); 00575 break; 00576 } 00577 while (GETC(ch) == ' ' || ch == '\t'); 00578 if (ch != ',' || f__lcount > 1) 00579 Ungetc(ch,f__cf); 00580 loopend: 00581 if(f__lquit) return(0); 00582 if(f__cf && ferror(f__cf)) { 00583 clearerr(f__cf); 00584 errfl(f__elist->cierr,errno,"list in"); 00585 } 00586 if(f__ltype==0) goto bump; 00587 switch((int)type) 00588 { 00589 case TYINT1: 00590 case TYLOGICAL1: 00591 Ptr->flchar = (char)f__lx; 00592 break; 00593 case TYLOGICAL2: 00594 case TYSHORT: 00595 Ptr->flshort = (short)f__lx; 00596 break; 00597 case TYLOGICAL: 00598 case TYLONG: 00599 Ptr->flint=f__lx; 00600 break; 00601 #ifdef Allow_TYQUAD 00602 case TYQUAD: 00603 if (!(Ptr->fllongint = f__llx)) 00604 Ptr->fllongint = f__lx; 00605 break; 00606 #endif 00607 case TYREAL: 00608 Ptr->flreal=f__lx; 00609 break; 00610 case TYDREAL: 00611 Ptr->fldouble=f__lx; 00612 break; 00613 case TYCOMPLEX: 00614 xx=(real *)ptr; 00615 *xx++ = f__lx; 00616 *xx = f__ly; 00617 break; 00618 case TYDCOMPLEX: 00619 yy=(doublereal *)ptr; 00620 *yy++ = f__lx; 00621 *yy = f__ly; 00622 break; 00623 case TYCHAR: 00624 b_char(f__lchar,ptr,len); 00625 break; 00626 } 00627 bump: 00628 if(f__lcount>0) f__lcount--; 00629 ptr += len; 00630 if (nml_read) 00631 nml_read++; 00632 } 00633 return(0); 00634 #undef Ptr 00635 } |
|
Definition at line 246 of file lread.c. References f__lcount, GETC, and Ungetc. Referenced by l_C(), and l_L().
|
|
Definition at line 639 of file lread.c. References c_le(), cilist::cierr, err, f__lcount, f__lquit, f__nowreading(), l_eof, l_getc(), l_read(), l_ungetc, t_getc(), and un_getc. Referenced by MAIN__().
00641 { 00642 int n; 00643 00644 if(n=c_le(a)) return(n); 00645 f__reading=1; 00646 f__external=1; 00647 f__formatted=1; 00648 f__lioproc = l_read; 00649 f__lquit = 0; 00650 f__lcount = 0; 00651 l_eof = 0; 00652 if(f__curunit->uwrt && f__nowreading(f__curunit)) 00653 err(a->cierr,errno,"read start"); 00654 if(f__curunit->uend) 00655 err(f__elist->ciend,(EOF),"read start"); 00656 l_getc = t_getc; 00657 l_ungetc = un_getc; 00658 f__doend = xrd_SL; 00659 return(0); 00660 } |
|
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 } |
|
|
Variable Documentation
|
Definition at line 9 of file lread.c. Referenced by c_le(). |
|
|
|
Definition at line 93 of file lread.c. Referenced by l_C(), l_CHAR(), l_L(), l_R(), l_read(), rd_count(), s_rsle(), and x_rsne(). |
|
|
|
Definition at line 92 of file lread.c. Referenced by l_C(), l_L(), l_R(), l_read(), s_rsle(), and x_rsne(). |
|
Initial value: |
|
|
|
|
|
|
|
Definition at line 28 of file lread.c. Referenced by c_lir(), e_rsle(), s_rsle(), s_rsne(), and t_getc(). |
|
Definition at line 26 of file lread.c. Referenced by s_rsle(). |
|
Definition at line 93 of file lread.c. Referenced by l_C(), l_L(), l_R(), l_read(), s_rsne(), and x_rsne(). |