contrib/libf2c/libI77/lread.c

   1 #include "config.h"
   2 #include <ctype.h>
   3 #include "f2c.h"
   4 #include "fio.h"
   5
   6 /* Compile with -DF8X_NML_ELIDE_QUOTES to permit eliding quotation */
   7 /* marks in namelist input a la the Fortran 8X Draft published in  */
   8 /* the May 1989 issue of Fortran Forum. */
   9
  10
  11 extern char *f__fmtbuf;
  12 extern int f__fmtlen;
  13
  14 #ifdef Allow_TYQUAD
  15 static longint f__llx;
  16 #endif
  17
  18 #undef abs
  19 #undef min
  20 #undef max
  21 #include <stdlib.h>
  22
  23 #include "fmt.h"
  24 #include "lio.h"
  25 #include "fp.h"
  26
  27 int (*f__lioproc) (ftnint *, char *, ftnlen, ftnint), (*l_getc) (void),
  28   (*l_ungetc) (int, FILE *);
  29
  30 int l_eof;
  31
  32 #define isblnk(x) (f__ltab[x+1]&B)
  33 #define issep(x) (f__ltab[x+1]&SX)
  34 #define isapos(x) (f__ltab[x+1]&AX)
  35 #define isexp(x) (f__ltab[x+1]&EX)
  36 #define issign(x) (f__ltab[x+1]&SG)
  37 #define iswhit(x) (f__ltab[x+1]&WH)
  38 #define SX 1
  39 #define B 2
  40 #define AX 4
  41 #define EX 8
  42 #define SG 16
  43 #define WH 32
  44 char f__ltab[128 + 1] = {       /* offset one for EOF */
  45   0,
  46   0, 0, AX, 0, 0, 0, 0, 0, 0, WH | B, SX | WH, 0, 0, 0, 0, 0,
  47   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  48   SX | B | WH, 0, AX, 0, 0, 0, 0, AX, 0, 0, 0, SG, SX, SG, 0, SX,
  49   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  50   0, 0, 0, 0, EX, EX, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  51   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  52   AX, 0, 0, 0, EX, EX, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  53   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  54 };
  55
  56 #ifdef ungetc
  57 static int
  58 un_getc (int x, FILE * f__cf)
  59 {
  60   return ungetc (x, f__cf);
  61 }
  62 #else
  63 #define un_getc ungetc
  64 extern int ungetc (int, FILE *);        /* for systems with a buggy stdio.h */
  65 #endif
  66
  67 int
  68 t_getc (void)
  69 {
  70   int ch;
  71   if (f__curunit->uend)
  72     return (EOF);
  73   if ((ch = getc (f__cf)) != EOF)
  74     return (ch);
  75   if (feof (f__cf))
  76     f__curunit->uend = l_eof = 1;
  77   return (EOF);
  78 }
  79
  80 integer
  81 e_rsle (void)
  82 {
  83   int ch;
  84   f__init = 1;
  85   if (f__curunit->uend)
  86     return (0);
  87   while ((ch = t_getc ()) != '\n')
  88     if (ch == EOF)
  89       {
  90         if (feof (f__cf))
  91           f__curunit->uend = l_eof = 1;
  92         return EOF;
  93       }
  94   return (0);
  95 }
  96
  97 flag f__lquit;
  98 int f__lcount, f__ltype, nml_read;
  99 char *f__lchar;
 100 double f__lx, f__ly;
 101 #define ERR(x) if((n=(x))) {f__init &= ~2; return(n);}
 102 #define GETC(x) (x=(*l_getc)())
 103 #define Ungetc(x,y) (*l_ungetc)(x,y)
 104
 105 static int
 106 l_R (int poststar, int reqint)
 107 {
 108   char s[FMAX + EXPMAXDIGS + 4];
 109   register int ch;
 110   register char *sp, *spe, *sp1;
 111   long e, exp;
 112   int havenum, havestar, se;
 113
 114   if (!poststar)
 115     {
 116       if (f__lcount > 0)
 117         return (0);
 118       f__lcount = 1;
 119     }
 120 #ifdef Allow_TYQUAD
 121   f__llx = 0;
 122 #endif
 123   f__ltype = 0;
 124   exp = 0;
 125   havestar = 0;
 126 retry:
 127   sp1 = sp = s;
 128   spe = sp + FMAX;
 129   havenum = 0;
 130
 131   switch (GETC (ch))
 132     {
 133     case '-':
 134       *sp++ = ch;
 135       sp1++;
 136       spe++;
 137     case '+':
 138       GETC (ch);
 139     }
 140   while (ch == '0')
 141     {
 142       ++havenum;
 143       GETC (ch);
 144     }
 145   while (isdigit (ch))
 146     {
 147       if (sp < spe)
 148         *sp++ = ch;
 149       else
 150         ++exp;
 151       GETC (ch);
 152     }
 153   if (ch == '*' && !poststar)
 154     {
 155       if (sp == sp1 || exp || *s == '-')
 156         {
 157           errfl (f__elist->cierr, 112, "bad repetition count");
 158         }
 159       poststar = havestar = 1;
 160       *sp = 0;
 161       f__lcount = atoi (s);
 162       goto retry;
 163     }
 164   if (ch == '.')
 165     {
 166 #ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
 167       if (reqint)
 168         errfl (f__elist->cierr, 115, "invalid integer");
 169 #endif
 170       GETC (ch);
 171       if (sp == sp1)
 172         while (ch == '0')
 173           {
 174             ++havenum;
 175             --exp;
 176             GETC (ch);
 177           }
 178       while (isdigit (ch))
 179         {
 180           if (sp < spe)
 181             {
 182               *sp++ = ch;
 183               --exp;
 184             }
 185           GETC (ch);
 186         }
 187     }
 188   havenum += sp - sp1;
 189   se = 0;
 190   if (issign (ch))
 191     goto signonly;
 192   if (havenum && isexp (ch))
 193     {
 194 #ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
 195       if (reqint)
 196         errfl (f__elist->cierr, 115, "invalid integer");
 197 #endif
 198       GETC (ch);
 199       if (issign (ch))
 200         {
 201         signonly:
 202           if (ch == '-')
 203             se = 1;
 204           GETC (ch);
 205         }
 206       if (!isdigit (ch))
 207         {
 208         bad:
 209           errfl (f__elist->cierr, 112, "exponent field");
 210         }
 211
 212       e = ch - '0';
 213       while (isdigit (GETC (ch)))
 214         {
 215           e = 10 * e + ch - '0';
 216           if (e > EXPMAX)
 217             goto bad;
 218         }
 219       if (se)
 220         exp -= e;
 221       else
 222         exp += e;
 223     }
 224   (void) Ungetc (ch, f__cf);
 225   if (sp > sp1)
 226     {
 227       ++havenum;
 228       while (*--sp == '0')
 229         ++exp;
 230       if (exp)
 231         sprintf (sp + 1, "e%ld", exp);
 232       else
 233         sp[1] = 0;
 234       f__lx = atof (s);
 235 #ifdef Allow_TYQUAD
 236       if (reqint & 2 && (se = sp - sp1 + exp) > 14 && se < 20)
 237         {
 238           /* Assuming 64-bit longint and 32-bit long. */
 239           if (exp < 0)
 240             sp += exp;
 241           if (sp1 <= sp)
 242             {
 243               f__llx = *sp1 - '0';
 244               while (++sp1 <= sp)
 245                 f__llx = 10 * f__llx + (*sp1 - '0');
 246             }
 247           while (--exp >= 0)
 248             f__llx *= 10;
 249           if (*s == '-')
 250             f__llx = -f__llx;
 251         }
 252 #endif
 253     }
 254   else
 255     f__lx = 0.;
 256   if (havenum)
 257     f__ltype = TYLONG;
 258   else
 259     switch (ch)
 260       {
 261       case ',':
 262       case '/':
 263         break;
 264       default:
 265         if (havestar && (ch == ' ' || ch == '\t' || ch == '\n'))
 266           break;
 267         if (nml_read > 1)
 268           {
 269             f__lquit = 2;
 270             return 0;
 271           }
 272         errfl (f__elist->cierr, 112, "invalid number");
 273       }
 274   return 0;
 275 }
 276
 277 static int
 278 rd_count (register int ch)
 279 {
 280   if (ch < '0' || ch > '9')
 281     return 1;
 282   f__lcount = ch - '0';
 283   while (GETC (ch) >= '0' && ch <= '9')
 284     f__lcount = 10 * f__lcount + ch - '0';
 285   Ungetc (ch, f__cf);
 286   return f__lcount <= 0;
 287 }
 288
 289 static int
 290 l_C (void)
 291 {
 292   int ch, nml_save;
 293   double lz;
 294   if (f__lcount > 0)
 295     return (0);
 296   f__ltype = 0;
 297   GETC (ch);
 298   if (ch != '(')
 299     {
 300       if (nml_read > 1 && (ch < '0' || ch > '9'))
 301         {
 302           Ungetc (ch, f__cf);
 303           f__lquit = 2;
 304           return 0;
 305         }
 306       if (rd_count (ch))
 307         {
 308           if (!f__cf || !feof (f__cf))
 309             errfl (f__elist->cierr, 112, "complex format");
 310           else
 311             err (f__elist->cierr, (EOF), "lread");
 312         }
 313       if (GETC (ch) != '*')
 314         {
 315           if (!f__cf || !feof (f__cf))
 316             errfl (f__elist->cierr, 112, "no star");
 317           else
 318             err (f__elist->cierr, (EOF), "lread");
 319         }
 320       if (GETC (ch) != '(')
 321         {
 322           Ungetc (ch, f__cf);
 323           return (0);
 324         }
 325     }
 326   else
 327     f__lcount = 1;
 328   while (iswhit (GETC (ch)));
 329   Ungetc (ch, f__cf);
 330   nml_save = nml_read;
 331   nml_read = 0;
 332   if ((ch = l_R (1, 0)))
 333     return ch;
 334   if (!f__ltype)
 335     errfl (f__elist->cierr, 112, "no real part");
 336   lz = f__lx;
 337   while (iswhit (GETC (ch)));
 338   if (ch != ',')
 339     {
 340       (void) Ungetc (ch, f__cf);
 341       errfl (f__elist->cierr, 112, "no comma");
 342     }
 343   while (iswhit (GETC (ch)));
 344   (void) Ungetc (ch, f__cf);
 345   if ((ch = l_R (1, 0)))
 346     return ch;
 347   if (!f__ltype)
 348     errfl (f__elist->cierr, 112, "no imaginary part");
 349   while (iswhit (GETC (ch)));
 350   if (ch != ')')
 351     errfl (f__elist->cierr, 112, "no )");
 352   f__ly = f__lx;
 353   f__lx = lz;
 354 #ifdef Allow_TYQUAD
 355   f__llx = 0;
 356 #endif
 357   nml_read = nml_save;
 358   return (0);
 359 }
 360
 361 static char nmLbuf[256], *nmL_next;
 362 static int (*nmL_getc_save) (void);
 363 static int (*nmL_ungetc_save) (int, FILE *);
 364
 365 static int
 366 nmL_getc (void)
 367 {
 368   int rv;
 369   if ((rv = *nmL_next++))
 370     return rv;
 371   l_getc = nmL_getc_save;
 372   l_ungetc = nmL_ungetc_save;
 373   return (*l_getc) ();
 374 }
 375
 376 static int
 377 nmL_ungetc (int x, FILE * f)
 378 {
 379   f = f;                        /* banish non-use warning */
 380   return *--nmL_next = x;
 381 }
 382
 383 static int
 384 Lfinish (int ch, int dot, int *rvp)
 385 {
 386   char *s, *se;
 387   static char what[] = "namelist input";
 388
 389   s = nmLbuf + 2;
 390   se = nmLbuf + sizeof (nmLbuf) - 1;
 391   *s++ = ch;
 392   while (!issep (GETC (ch)) && ch != EOF)
 393     {
 394       if (s >= se)
 395         {
 396         nmLbuf_ovfl:
 397           return *rvp = err__fl (f__elist->cierr, 131, what);
 398         }
 399       *s++ = ch;
 400       if (ch != '=')
 401         continue;
 402       if (dot)
 403         return *rvp = err__fl (f__elist->cierr, 112, what);
 404     got_eq:
 405       *s = 0;
 406       nmL_getc_save = l_getc;
 407       l_getc = nmL_getc;
 408       nmL_ungetc_save = l_ungetc;
 409       l_ungetc = nmL_ungetc;
 410       nmLbuf[1] = *(nmL_next = nmLbuf) = ',';
 411       *rvp = f__lcount = 0;
 412       return 1;
 413     }
 414   if (dot)
 415     goto done;
 416   for (;;)
 417     {
 418       if (s >= se)
 419         goto nmLbuf_ovfl;
 420       *s++ = ch;
 421       if (!isblnk (ch))
 422         break;
 423       if (GETC (ch) == EOF)
 424         goto done;
 425     }
 426   if (ch == '=')
 427     goto got_eq;
 428 done:
 429   Ungetc (ch, f__cf);
 430   return 0;
 431 }
 432
 433 static int
 434 l_L (void)
 435 {
 436   int ch, rv, sawdot;
 437   if (f__lcount > 0)
 438     return (0);
 439   f__lcount = 1;
 440   f__ltype = 0;
 441   GETC (ch);
 442   if (isdigit (ch))
 443     {
 444       rd_count (ch);
 445       if (GETC (ch) != '*')
 446         {
 447           if (!f__cf || !feof (f__cf))
 448             errfl (f__elist->cierr, 112, "no star");
 449           else
 450             err (f__elist->cierr, (EOF), "lread");
 451         }
 452       GETC (ch);
 453     }
 454   sawdot = 0;
 455   if (ch == '.')
 456     {
 457       sawdot = 1;
 458       GETC (ch);
 459     }
 460   switch (ch)
 461     {
 462     case 't':
 463     case 'T':
 464       if (nml_read && Lfinish (ch, sawdot, &rv))
 465         return rv;
 466       f__lx = 1;
 467       break;
 468     case 'f':
 469     case 'F':
 470       if (nml_read && Lfinish (ch, sawdot, &rv))
 471         return rv;
 472       f__lx = 0;
 473       break;
 474     default:
 475       if (isblnk (ch) || issep (ch) || ch == EOF)
 476         {
 477           (void) Ungetc (ch, f__cf);
 478           return (0);
 479         }
 480       if (nml_read > 1)
 481         {
 482           Ungetc (ch, f__cf);
 483           f__lquit = 2;
 484           return 0;
 485         }
 486       errfl (f__elist->cierr, 112, "logical");
 487     }
 488   f__ltype = TYLONG;
 489   while (!issep (GETC (ch)) && ch != EOF);
 490   (void) Ungetc (ch, f__cf);
 491   return (0);
 492 }
 493
 494 #define BUFSIZE 128
 495
 496 static int
 497 l_CHAR (void)
 498 {
 499   int ch, size, i;
 500   static char rafail[] = "realloc failure";
 501   char quote, *p;
 502   if (f__lcount > 0)
 503     return (0);
 504   f__ltype = 0;
 505   if (f__lchar != NULL)
 506     free (f__lchar);
 507   size = BUFSIZE;
 508   p = f__lchar = (char *) malloc ((unsigned int) size);
 509   if (f__lchar == NULL)
 510     errfl (f__elist->cierr, 113, "no space");
 511
 512   GETC (ch);
 513   if (isdigit (ch))
 514     {
 515       /* allow Fortran 8x-style unquoted string...    */
 516       /* either find a repetition count or the string */
 517       f__lcount = ch - '0';
 518       *p++ = ch;
 519       for (i = 1;;)
 520         {
 521           switch (GETC (ch))
 522             {
 523             case '*':
 524               if (f__lcount == 0)
 525                 {
 526                   f__lcount = 1;
 527 #ifndef F8X_NML_ELIDE_QUOTES
 528                   if (nml_read)
 529                     goto no_quote;
 530 #endif
 531                   goto noquote;
 532                 }
 533               p = f__lchar;
 534               goto have_lcount;
 535             case ',':
 536             case ' ':
 537             case '\t':
 538             case '\n':
 539             case '/':
 540               Ungetc (ch, f__cf);
 541               /* no break */
 542             case EOF:
 543               f__lcount = 1;
 544               f__ltype = TYCHAR;
 545               return *p = 0;
 546             }
 547           if (!isdigit (ch))
 548             {
 549               f__lcount = 1;
 550 #ifndef F8X_NML_ELIDE_QUOTES
 551               if (nml_read)
 552                 {
 553                 no_quote:
 554                   errfl (f__elist->cierr, 112,
 555                          "undelimited character string");
 556                 }
 557 #endif
 558               goto noquote;
 559             }
 560           *p++ = ch;
 561           f__lcount = 10 * f__lcount + ch - '0';
 562           if (++i == size)
 563             {
 564               f__lchar = (char *) realloc (f__lchar,
 565                                            (unsigned int) (size += BUFSIZE));
 566               if (f__lchar == NULL)
 567                 errfl (f__elist->cierr, 113, rafail);
 568               p = f__lchar + i;
 569             }
 570         }
 571     }
 572   else
 573     (void) Ungetc (ch, f__cf);
 574 have_lcount:
 575   if (GETC (ch) == '\'' || ch == '"')
 576     quote = ch;
 577   else if (isblnk (ch) || (issep (ch) && ch != '\n') || ch == EOF)
 578     {
 579       Ungetc (ch, f__cf);
 580       return 0;
 581     }
 582 #ifndef F8X_NML_ELIDE_QUOTES
 583   else if (nml_read > 1)
 584     {
 585       Ungetc (ch, f__cf);
 586       f__lquit = 2;
 587       return 0;
 588     }
 589 #endif
 590   else
 591     {
 592       /* Fortran 8x-style unquoted string */
 593       *p++ = ch;
 594       for (i = 1;;)
 595         {
 596           switch (GETC (ch))
 597             {
 598             case ',':
 599             case ' ':
 600             case '\t':
 601             case '\n':
 602             case '/':
 603               Ungetc (ch, f__cf);
 604               /* no break */
 605             case EOF:
 606               f__ltype = TYCHAR;
 607               return *p = 0;
 608             }
 609         noquote:
 610           *p++ = ch;
 611           if (++i == size)
 612             {
 613               f__lchar = (char *) realloc (f__lchar,
 614                                            (unsigned int) (size += BUFSIZE));
 615               if (f__lchar == NULL)
 616                 errfl (f__elist->cierr, 113, rafail);
 617               p = f__lchar + i;
 618             }
 619         }
 620     }
 621   f__ltype = TYCHAR;
 622   for (i = 0;;)
 623     {
 624       while (GETC (ch) != quote && ch != '\n' && ch != EOF && ++i < size)
 625         *p++ = ch;
 626       if (i == size)
 627         {
 628         newone:
 629           f__lchar = (char *) realloc (f__lchar,
 630                                        (unsigned int) (size += BUFSIZE));
 631           if (f__lchar == NULL)
 632             errfl (f__elist->cierr, 113, rafail);
 633           p = f__lchar + i - 1;
 634           *p++ = ch;
 635         }
 636       else if (ch == EOF)
 637         return (EOF);
 638       else if (ch == '\n')
 639         {
 640           if (*(p - 1) != '\\')
 641             continue;
 642           i--;
 643           p--;
 644           if (++i < size)
 645             *p++ = ch;
 646           else
 647             goto newone;
 648         }
 649       else if (GETC (ch) == quote)
 650         {
 651           if (++i < size)
 652             *p++ = ch;
 653           else
 654             goto newone;
 655         }
 656       else
 657         {
 658           (void) Ungetc (ch, f__cf);
 659           *p = 0;
 660           return (0);
 661         }
 662     }
 663 }
 664
 665 int
 666 c_le (cilist * a)
 667 {
 668   if (f__init != 1)
 669     f_init ();
 670   f__init = 3;
 671   f__fmtbuf = "list io";
 672   f__curunit = &f__units[a->ciunit];
 673   f__fmtlen = 7;
 674   if (a->ciunit >= MXUNIT || a->ciunit < 0)
 675     err (a->cierr, 101, "stler");
 676   f__scale = f__recpos = 0;
 677   f__elist = a;
 678   if (f__curunit->ufd == NULL && fk_open (SEQ, FMT, a->ciunit))
 679     err (a->cierr, 102, "lio");
 680   f__cf = f__curunit->ufd;
 681   if (!f__curunit->ufmt)
 682     err (a->cierr, 103, "lio");
 683   return (0);
 684 }
 685
 686 int
 687 l_read (ftnint * number, char *ptr, ftnlen len, ftnint type)
 688 {
 689 #define Ptr ((flex *)ptr)
 690   int i, n, ch;
 691   doublereal *yy;
 692   real *xx;
 693   for (i = 0; i < *number; i++)
 694     {
 695       if (f__lquit)
 696         return (0);
 697       if (l_eof)
 698         err (f__elist->ciend, EOF, "list in");
 699       if (f__lcount == 0)
 700         {
 701           f__ltype = 0;
 702           for (;;)
 703             {
 704               GETC (ch);
 705               switch (ch)
 706                 {
 707                 case EOF:
 708                   err (f__elist->ciend, (EOF), "list in");
 709                 case ' ':
 710                 case '\t':
 711                 case '\n':
 712                   continue;
 713                 case '/':
 714                   f__lquit = 1;
 715                   goto loopend;
 716                 case ',':
 717                   f__lcount = 1;
 718                   goto loopend;
 719                 default:
 720                   (void) Ungetc (ch, f__cf);
 721                   goto rddata;
 722                 }
 723             }
 724         }
 725     rddata:
 726       switch ((int) type)
 727         {
 728         case TYINT1:
 729         case TYSHORT:
 730         case TYLONG:
 731 #ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
 732           ERR (l_R (0, 1));
 733           break;
 734 #endif
 735         case TYREAL:
 736         case TYDREAL:
 737           ERR (l_R (0, 0));
 738           break;
 739 #ifdef TYQUAD
 740         case TYQUAD:
 741           n = l_R (0, 2);
 742           if (n)
 743             return n;
 744           break;
 745 #endif
 746         case TYCOMPLEX:
 747         case TYDCOMPLEX:
 748           ERR (l_C ());
 749           break;
 750         case TYLOGICAL1:
 751         case TYLOGICAL2:
 752         case TYLOGICAL:
 753           ERR (l_L ());
 754           break;
 755         case TYCHAR:
 756           ERR (l_CHAR ());
 757           break;
 758         }
 759       while (GETC (ch) == ' ' || ch == '\t');
 760       if (ch != ',' || f__lcount > 1)
 761         Ungetc (ch, f__cf);
 762     loopend:
 763       if (f__lquit)
 764         return (0);
 765       if (f__cf && ferror (f__cf))
 766         {
 767           clearerr (f__cf);
 768           errfl (f__elist->cierr, errno, "list in");
 769         }
 770       if (f__ltype == 0)
 771         goto bump;
 772       switch ((int) type)
 773         {
 774         case TYINT1:
 775         case TYLOGICAL1:
 776           Ptr->flchar = (char) f__lx;
 777           break;
 778         case TYLOGICAL2:
 779         case TYSHORT:
 780           Ptr->flshort = (short) f__lx;
 781           break;
 782         case TYLOGICAL:
 783         case TYLONG:
 784           Ptr->flint = (ftnint) f__lx;
 785           break;
 786 #ifdef Allow_TYQUAD
 787         case TYQUAD:
 788           if (!(Ptr->fllongint = f__llx))
 789             Ptr->fllongint = f__lx;
 790           break;
 791 #endif
 792         case TYREAL:
 793           Ptr->flreal = f__lx;
 794           break;
 795         case TYDREAL:
 796           Ptr->fldouble = f__lx;
 797           break;
 798         case TYCOMPLEX:
 799           xx = (real *) ptr;
 800           *xx++ = f__lx;
 801           *xx = f__ly;
 802           break;
 803         case TYDCOMPLEX:
 804           yy = (doublereal *) ptr;
 805           *yy++ = f__lx;
 806           *yy = f__ly;
 807           break;
 808         case TYCHAR:
 809           b_char (f__lchar, ptr, len);
 810           break;
 811         }
 812     bump:
 813       if (f__lcount > 0)
 814         f__lcount--;
 815       ptr += len;
 816       if (nml_read)
 817         nml_read++;
 818     }
 819   return (0);
 820 #undef Ptr
 821 }
 822
 823 integer
 824 s_rsle (cilist * a)
 825 {
 826   int n;
 827
 828   f__reading = 1;
 829   f__external = 1;
 830   f__formatted = 1;
 831   if ((n = c_le (a)))
 832     return (n);
 833   f__lioproc = l_read;
 834   f__lquit = 0;
 835   f__lcount = 0;
 836   l_eof = 0;
 837   if (f__curunit->uwrt && f__nowreading (f__curunit))
 838     err (a->cierr, errno, "read start");
 839   if (f__curunit->uend)
 840     err (f__elist->ciend, (EOF), "read start");
 841   l_getc = t_getc;
 842   l_ungetc = un_getc;
 843   f__doend = xrd_SL;
 844   return (0);
 845 }