diff options
Diffstat (limited to 'libf2c/libI77/rsne.c')
-rw-r--r-- | libf2c/libI77/rsne.c | 1019 |
1 files changed, 527 insertions, 492 deletions
diff --git a/libf2c/libI77/rsne.c b/libf2c/libI77/rsne.c index dbd1b397630..9dea2792bf1 100644 --- a/libf2c/libI77/rsne.c +++ b/libf2c/libI77/rsne.c @@ -3,41 +3,44 @@ #include "fio.h" #include "lio.h" -#define MAX_NL_CACHE 3 /* maximum number of namelist hash tables to cache */ -#define MAXDIM 20 /* maximum number of subscripts */ +#define MAX_NL_CACHE 3 /* maximum number of namelist hash tables to cache */ +#define MAXDIM 20 /* maximum number of subscripts */ - struct dimen { - ftnlen extent; - ftnlen curval; - ftnlen delta; - ftnlen stride; - }; - typedef struct dimen dimen; +struct dimen +{ + ftnlen extent; + ftnlen curval; + ftnlen delta; + ftnlen stride; +}; +typedef struct dimen dimen; - struct hashentry { - struct hashentry *next; - char *name; - Vardesc *vd; - }; - typedef struct hashentry hashentry; +struct hashentry +{ + struct hashentry *next; + char *name; + Vardesc *vd; +}; +typedef struct hashentry hashentry; - struct hashtab { - struct hashtab *next; - Namelist *nl; - int htsize; - hashentry *tab[1]; - }; - typedef struct hashtab hashtab; +struct hashtab +{ + struct hashtab *next; + Namelist *nl; + int htsize; + hashentry *tab[1]; +}; +typedef struct hashtab hashtab; - static hashtab *nl_cache; - static int n_nlcache; - static hashentry **zot; - static int colonseen; - extern ftnlen f__typesize[]; +static hashtab *nl_cache; +static int n_nlcache; +static hashentry **zot; +static int colonseen; +extern ftnlen f__typesize[]; - extern flag f__lquit; - extern int f__lcount, nml_read; - extern t_getc(void); +extern flag f__lquit; +extern int f__lcount, nml_read; +extern t_getc (void); #undef abs #undef min @@ -46,516 +49,548 @@ #include <string.h> #ifdef ungetc - static int -un_getc(int x, FILE *f__cf) -{ return ungetc(x,f__cf); } +static int +un_getc (int x, FILE * f__cf) +{ + return ungetc (x, f__cf); +} #else #define un_getc ungetc -extern int ungetc(int, FILE*); /* for systems with a buggy stdio.h */ +extern int ungetc (int, FILE *); /* for systems with a buggy stdio.h */ #endif - static Vardesc * -hash(hashtab *ht, register char *s) +static Vardesc * +hash (hashtab * ht, register char *s) { - register int c, x; - register hashentry *h; - char *s0 = s; + register int c, x; + register hashentry *h; + char *s0 = s; - for(x = 0; c = *s++; x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1) - x += c; - for(h = *(zot = ht->tab + x % ht->htsize); h; h = h->next) - if (!strcmp(s0, h->name)) - return h->vd; - return 0; - } + for (x = 0; c = *s++; x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1) + x += c; + for (h = *(zot = ht->tab + x % ht->htsize); h; h = h->next) + if (!strcmp (s0, h->name)) + return h->vd; + return 0; +} - hashtab * -mk_hashtab(Namelist *nl) +hashtab * +mk_hashtab (Namelist * nl) { - int nht, nv; - hashtab *ht; - Vardesc *v, **vd, **vde; - hashentry *he; + int nht, nv; + hashtab *ht; + Vardesc *v, **vd, **vde; + hashentry *he; - hashtab **x, **x0, *y; - for(x = &nl_cache; y = *x; x0 = x, x = &y->next) - if (nl == y->nl) - return y; - if (n_nlcache >= MAX_NL_CACHE) { - /* discard least recently used namelist hash table */ - y = *x0; - free((char *)y->next); - y->next = 0; - } - else - n_nlcache++; - nv = nl->nvars; - if (nv >= 0x4000) - nht = 0x7fff; - else { - for(nht = 1; nht < nv; nht <<= 1); - nht += nht - 1; - } - ht = (hashtab *)malloc(sizeof(hashtab) + (nht-1)*sizeof(hashentry *) - + nv*sizeof(hashentry)); - if (!ht) - return 0; - he = (hashentry *)&ht->tab[nht]; - ht->nl = nl; - ht->htsize = nht; - ht->next = nl_cache; - nl_cache = ht; - memset((char *)ht->tab, 0, nht*sizeof(hashentry *)); - vd = nl->vars; - vde = vd + nv; - while(vd < vde) { - v = *vd++; - if (!hash(ht, v->name)) { - he->next = *zot; - *zot = he; - he->name = v->name; - he->vd = v; - he++; - } - } - return ht; + hashtab **x, **x0, *y; + for (x = &nl_cache; y = *x; x0 = x, x = &y->next) + if (nl == y->nl) + return y; + if (n_nlcache >= MAX_NL_CACHE) + { + /* discard least recently used namelist hash table */ + y = *x0; + free ((char *) y->next); + y->next = 0; + } + else + n_nlcache++; + nv = nl->nvars; + if (nv >= 0x4000) + nht = 0x7fff; + else + { + for (nht = 1; nht < nv; nht <<= 1); + nht += nht - 1; + } + ht = (hashtab *) malloc (sizeof (hashtab) + (nht - 1) * sizeof (hashentry *) + + nv * sizeof (hashentry)); + if (!ht) + return 0; + he = (hashentry *) & ht->tab[nht]; + ht->nl = nl; + ht->htsize = nht; + ht->next = nl_cache; + nl_cache = ht; + memset ((char *) ht->tab, 0, nht * sizeof (hashentry *)); + vd = nl->vars; + vde = vd + nv; + while (vd < vde) + { + v = *vd++; + if (!hash (ht, v->name)) + { + he->next = *zot; + *zot = he; + he->name = v->name; + he->vd = v; + he++; } + } + return ht; +} static char Alpha[256], Alphanum[256]; static void -nl_init(void) { - register char *s; - register int c; +nl_init (void) +{ + register char *s; + register int c; - for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; ) - Alpha[c] - = Alphanum[c] - = Alpha[c + 'a' - 'A'] - = Alphanum[c + 'a' - 'A'] - = c; - for(s = "0123456789_"; c = *s++; ) - Alphanum[c] = c; - } + for (s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++;) + Alpha[c] + = Alphanum[c] = Alpha[c + 'a' - 'A'] = Alphanum[c + 'a' - 'A'] = c; + for (s = "0123456789_"; c = *s++;) + Alphanum[c] = c; +} #define GETC(x) (x=(*l_getc)()) #define Ungetc(x,y) (*l_ungetc)(x,y) - static int -getname(register char *s, int slen) +static int +getname (register char *s, int slen) { - register char *se = s + slen - 1; - register int ch; + register char *se = s + slen - 1; + register int ch; - GETC(ch); - if (!(*s++ = Alpha[ch & 0xff])) { - if (ch != EOF) - ch = 115; - errfl(f__elist->cierr, ch, "namelist read"); - } - while(*s = Alphanum[GETC(ch) & 0xff]) - if (s < se) - s++; - if (ch == EOF) - err(f__elist->cierr, EOF, "namelist read"); - if (ch > ' ') - Ungetc(ch,f__cf); - return *s = 0; - } + GETC (ch); + if (!(*s++ = Alpha[ch & 0xff])) + { + if (ch != EOF) + ch = 115; + errfl (f__elist->cierr, ch, "namelist read"); + } + while (*s = Alphanum[GETC (ch) & 0xff]) + if (s < se) + s++; + if (ch == EOF) + err (f__elist->cierr, EOF, "namelist read"); + if (ch > ' ') + Ungetc (ch, f__cf); + return *s = 0; +} - static int -getnum(int *chp, ftnlen *val) +static int +getnum (int *chp, ftnlen * val) { - register int ch, sign; - register ftnlen x; + register int ch, sign; + register ftnlen x; - while(GETC(ch) <= ' ' && ch >= 0); - if (ch == '-') { - sign = 1; - GETC(ch); - } - else { - sign = 0; - if (ch == '+') - GETC(ch); - } - x = ch - '0'; - if (x < 0 || x > 9) - return 115; - while(GETC(ch) >= '0' && ch <= '9') - x = 10*x + ch - '0'; - while(ch <= ' ' && ch >= 0) - GETC(ch); - if (ch == EOF) - return EOF; - *val = sign ? -x : x; - *chp = ch; - return 0; - } + while (GETC (ch) <= ' ' && ch >= 0); + if (ch == '-') + { + sign = 1; + GETC (ch); + } + else + { + sign = 0; + if (ch == '+') + GETC (ch); + } + x = ch - '0'; + if (x < 0 || x > 9) + return 115; + while (GETC (ch) >= '0' && ch <= '9') + x = 10 * x + ch - '0'; + while (ch <= ' ' && ch >= 0) + GETC (ch); + if (ch == EOF) + return EOF; + *val = sign ? -x : x; + *chp = ch; + return 0; +} - static int -getdimen(int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1) +static int +getdimen (int *chp, dimen * d, ftnlen delta, ftnlen extent, ftnlen * x1) { - register int k; - ftnlen x2, x3; + register int k; + ftnlen x2, x3; - if (k = getnum(chp, x1)) - return k; - x3 = 1; - if (*chp == ':') { - if (k = getnum(chp, &x2)) - return k; - x2 -= *x1; - if (*chp == ':') { - if (k = getnum(chp, &x3)) - return k; - if (!x3) - return 123; - x2 /= x3; - colonseen = 1; - } - if (x2 < 0 || x2 >= extent) - return 123; - d->extent = x2 + 1; - } - else - d->extent = 1; - d->curval = 0; - d->delta = delta; - d->stride = x3; - return 0; + if (k = getnum (chp, x1)) + return k; + x3 = 1; + if (*chp == ':') + { + if (k = getnum (chp, &x2)) + return k; + x2 -= *x1; + if (*chp == ':') + { + if (k = getnum (chp, &x3)) + return k; + if (!x3) + return 123; + x2 /= x3; + colonseen = 1; } + if (x2 < 0 || x2 >= extent) + return 123; + d->extent = x2 + 1; + } + else + d->extent = 1; + d->curval = 0; + d->delta = delta; + d->stride = x3; + return 0; +} #ifndef No_Namelist_Questions static void -print_ne(cilist *a) +print_ne (cilist * a) { - flag intext = f__external; - int rpsave = f__recpos; - FILE *cfsave = f__cf; - unit *usave = f__curunit; - cilist t; - t = *a; - t.ciunit = 6; - s_wsne(&t); - fflush(f__cf); - f__external = intext; - f__reading = 1; - f__recpos = rpsave; - f__cf = cfsave; - f__curunit = usave; - f__elist = a; - } + flag intext = f__external; + int rpsave = f__recpos; + FILE *cfsave = f__cf; + unit *usave = f__curunit; + cilist t; + t = *a; + t.ciunit = 6; + s_wsne (&t); + fflush (f__cf); + f__external = intext; + f__reading = 1; + f__recpos = rpsave; + f__cf = cfsave; + f__curunit = usave; + f__elist = a; +} #endif - static char where0[] = "namelist read start "; +static char where0[] = "namelist read start "; -x_rsne(cilist *a) +x_rsne (cilist * a) { - int ch, got1, k, n, nd, quote, readall; - Namelist *nl; - static char where[] = "namelist read"; - char buf[64]; - hashtab *ht; - Vardesc *v; - dimen *dn, *dn0, *dn1; - ftnlen *dims, *dims1; - ftnlen b, b0, b1, ex, no, nomax, size, span; - ftnint no1, type; - char *vaddr; - long iva, ivae; - dimen dimens[MAXDIM], substr; + int ch, got1, k, n, nd, quote, readall; + Namelist *nl; + static char where[] = "namelist read"; + char buf[64]; + hashtab *ht; + Vardesc *v; + dimen *dn, *dn0, *dn1; + ftnlen *dims, *dims1; + ftnlen b, b0, b1, ex, no, nomax, size, span; + ftnint no1, type; + char *vaddr; + long iva, ivae; + dimen dimens[MAXDIM], substr; - if (!Alpha['a']) - nl_init(); - f__reading=1; - f__formatted=1; - got1 = 0; - top: - for(;;) switch(GETC(ch)) { - case EOF: - eof: - err(a->ciend,(EOF),where0); - case '&': - case '$': - goto have_amp; + if (!Alpha['a']) + nl_init (); + f__reading = 1; + f__formatted = 1; + got1 = 0; +top: + for (;;) + switch (GETC (ch)) + { + case EOF: + eof: + err (a->ciend, (EOF), where0); + case '&': + case '$': + goto have_amp; #ifndef No_Namelist_Questions - case '?': - print_ne(a); - continue; + case '?': + print_ne (a); + continue; #endif - default: - if (ch <= ' ' && ch >= 0) - continue; + default: + if (ch <= ' ' && ch >= 0) + continue; #ifndef No_Namelist_Comments - while(GETC(ch) != '\n') - if (ch == EOF) - goto eof; + while (GETC (ch) != '\n') + if (ch == EOF) + goto eof; #else - errfl(a->cierr, 115, where0); + errfl (a->cierr, 115, where0); #endif - } - have_amp: - if (ch = getname(buf,sizeof(buf))) - return ch; - nl = (Namelist *)a->cifmt; - if (strcmp(buf, nl->name)) + } +have_amp: + if (ch = getname (buf, sizeof (buf))) + return ch; + nl = (Namelist *) a->cifmt; + if (strcmp (buf, nl->name)) #ifdef No_Bad_Namelist_Skip - errfl(a->cierr, 118, where0); + errfl (a->cierr, 118, where0); #else + { + fprintf (stderr, + "Skipping namelist \"%s\": seeking namelist \"%s\".\n", + buf, nl->name); + fflush (stderr); + for (;;) + switch (GETC (ch)) + { + case EOF: + err (a->ciend, EOF, where0); + case '/': + case '&': + case '$': + if (f__external) + e_rsle (); + else + z_rnew (); + goto top; + case '"': + case '\'': + quote = ch; + more_quoted: + while (GETC (ch) != quote) + if (ch == EOF) + err (a->ciend, EOF, where0); + if (GETC (ch) == quote) + goto more_quoted; + Ungetc (ch, f__cf); + default: + continue; + } + } +#endif + ht = mk_hashtab (nl); + if (!ht) + errfl (f__elist->cierr, 113, where0); + for (;;) + { + for (;;) + switch (GETC (ch)) + { + case EOF: + if (got1) + return 0; + err (a->ciend, EOF, where0); + case '/': + case '$': + case '&': + return 0; + default: + if (ch <= ' ' && ch >= 0 || ch == ',') + continue; + Ungetc (ch, f__cf); + if (ch = getname (buf, sizeof (buf))) + return ch; + goto havename; + } + havename: + v = hash (ht, buf); + if (!v) + errfl (a->cierr, 119, where); + while (GETC (ch) <= ' ' && ch >= 0); + vaddr = v->addr; + type = v->type; + if (type < 0) + { + size = -type; + type = TYCHAR; + } + else + size = f__typesize[type]; + ivae = size; + iva = readall = 0; + if (ch == '(' /*) */ ) { - fprintf(stderr, - "Skipping namelist \"%s\": seeking namelist \"%s\".\n", - buf, nl->name); - fflush(stderr); - for(;;) switch(GETC(ch)) { - case EOF: - err(a->ciend, EOF, where0); - case '/': - case '&': - case '$': - if (f__external) - e_rsle(); - else - z_rnew(); - goto top; - case '"': - case '\'': - quote = ch; - more_quoted: - while(GETC(ch) != quote) - if (ch == EOF) - err(a->ciend, EOF, where0); - if (GETC(ch) == quote) - goto more_quoted; - Ungetc(ch,f__cf); - default: - continue; - } + dn = dimens; + if (!(dims = v->dims)) + { + if (type != TYCHAR) + errfl (a->cierr, 122, where); + if (k = getdimen (&ch, dn, (ftnlen) size, (ftnlen) size, &b)) + errfl (a->cierr, k, where); + if (ch != ')') + errfl (a->cierr, 115, where); + b1 = dn->extent; + if (--b < 0 || b + b1 > size) + return 124; + iva += b; + size = b1; + while (GETC (ch) <= ' ' && ch >= 0); + goto scalar; + } + nd = (int) dims[0]; + nomax = span = dims[1]; + ivae = iva + size * nomax; + colonseen = 0; + if (k = getdimen (&ch, dn, size, nomax, &b)) + errfl (a->cierr, k, where); + no = dn->extent; + b0 = dims[2]; + dims1 = dims += 3; + ex = 1; + for (n = 1; n++ < nd; dims++) + { + if (ch != ',') + errfl (a->cierr, 115, where); + dn1 = dn + 1; + span /= *dims; + if (k = getdimen (&ch, dn1, dn->delta ** dims, span, &b1)) + errfl (a->cierr, k, where); + ex *= *dims; + b += b1 * ex; + no *= dn1->extent; + dn = dn1; + } + if (ch != ')') + errfl (a->cierr, 115, where); + readall = 1 - colonseen; + b -= b0; + if (b < 0 || b >= nomax) + errfl (a->cierr, 125, where); + iva += size * b; + dims = dims1; + while (GETC (ch) <= ' ' && ch >= 0); + no1 = 1; + dn0 = dimens; + if (type == TYCHAR && ch == '(' /*) */ ) + { + if (k = getdimen (&ch, &substr, size, size, &b)) + errfl (a->cierr, k, where); + if (ch != ')') + errfl (a->cierr, 115, where); + b1 = substr.extent; + if (--b < 0 || b + b1 > size) + return 124; + iva += b; + b0 = size; + size = b1; + while (GETC (ch) <= ' ' && ch >= 0); + if (b1 < b0) + goto delta_adj; + } + if (readall) + goto delta_adj; + for (; dn0 < dn; dn0++) + { + if (dn0->extent != *dims++ || dn0->stride != 1) + break; + no1 *= dn0->extent; + } + if (dn0 == dimens && dimens[0].stride == 1) + { + no1 = dimens[0].extent; + dn0++; + } + delta_adj: + ex = 0; + for (dn1 = dn0; dn1 <= dn; dn1++) + ex += (dn1->extent - 1) * (dn1->delta *= dn1->stride); + for (dn1 = dn; dn1 > dn0; dn1--) + { + ex -= (dn1->extent - 1) * dn1->delta; + dn1->delta -= ex; + } + } + else if (dims = v->dims) + { + no = no1 = dims[1]; + ivae = iva + no * size; + } + else + scalar: + no = no1 = 1; + if (ch != '=') + errfl (a->cierr, 115, where); + got1 = nml_read = 1; + f__lcount = 0; + readloop: + for (;;) + { + if (iva >= ivae || iva < 0) + { + f__lquit = 1; + goto mustend; + } + else if (iva + no1 * size > ivae) + no1 = (ivae - iva) / size; + f__lquit = 0; + if (k = l_read (&no1, vaddr + iva, size, type)) + return k; + if (f__lquit == 1) + return 0; + if (readall) + { + iva += dn0->delta; + if (f__lcount > 0) + { + no1 = (ivae - iva) / size; + if (no1 > f__lcount) + no1 = f__lcount; + if (k = l_read (&no1, vaddr + iva, size, type)) + return k; + iva += no1 * dn0->delta; } -#endif - ht = mk_hashtab(nl); - if (!ht) - errfl(f__elist->cierr, 113, where0); - for(;;) { - for(;;) switch(GETC(ch)) { - case EOF: - if (got1) - return 0; - err(a->ciend, EOF, where0); - case '/': - case '$': - case '&': - return 0; - default: - if (ch <= ' ' && ch >= 0 || ch == ',') - continue; - Ungetc(ch,f__cf); - if (ch = getname(buf,sizeof(buf))) - return ch; - goto havename; - } - havename: - v = hash(ht,buf); - if (!v) - errfl(a->cierr, 119, where); - while(GETC(ch) <= ' ' && ch >= 0); - vaddr = v->addr; - type = v->type; - if (type < 0) { - size = -type; - type = TYCHAR; - } - else - size = f__typesize[type]; - ivae = size; - iva = readall = 0; - if (ch == '(' /*)*/ ) { - dn = dimens; - if (!(dims = v->dims)) { - if (type != TYCHAR) - errfl(a->cierr, 122, where); - if (k = getdimen(&ch, dn, (ftnlen)size, - (ftnlen)size, &b)) - errfl(a->cierr, k, where); - if (ch != ')') - errfl(a->cierr, 115, where); - b1 = dn->extent; - if (--b < 0 || b + b1 > size) - return 124; - iva += b; - size = b1; - while(GETC(ch) <= ' ' && ch >= 0); - goto scalar; - } - nd = (int)dims[0]; - nomax = span = dims[1]; - ivae = iva + size*nomax; - colonseen = 0; - if (k = getdimen(&ch, dn, size, nomax, &b)) - errfl(a->cierr, k, where); - no = dn->extent; - b0 = dims[2]; - dims1 = dims += 3; - ex = 1; - for(n = 1; n++ < nd; dims++) { - if (ch != ',') - errfl(a->cierr, 115, where); - dn1 = dn + 1; - span /= *dims; - if (k = getdimen(&ch, dn1, dn->delta**dims, - span, &b1)) - errfl(a->cierr, k, where); - ex *= *dims; - b += b1*ex; - no *= dn1->extent; - dn = dn1; - } - if (ch != ')') - errfl(a->cierr, 115, where); - readall = 1 - colonseen; - b -= b0; - if (b < 0 || b >= nomax) - errfl(a->cierr, 125, where); - iva += size * b; - dims = dims1; - while(GETC(ch) <= ' ' && ch >= 0); - no1 = 1; - dn0 = dimens; - if (type == TYCHAR && ch == '(' /*)*/) { - if (k = getdimen(&ch, &substr, size, size, &b)) - errfl(a->cierr, k, where); - if (ch != ')') - errfl(a->cierr, 115, where); - b1 = substr.extent; - if (--b < 0 || b + b1 > size) - return 124; - iva += b; - b0 = size; - size = b1; - while(GETC(ch) <= ' ' && ch >= 0); - if (b1 < b0) - goto delta_adj; - } - if (readall) - goto delta_adj; - for(; dn0 < dn; dn0++) { - if (dn0->extent != *dims++ || dn0->stride != 1) - break; - no1 *= dn0->extent; - } - if (dn0 == dimens && dimens[0].stride == 1) { - no1 = dimens[0].extent; - dn0++; - } - delta_adj: - ex = 0; - for(dn1 = dn0; dn1 <= dn; dn1++) - ex += (dn1->extent-1) - * (dn1->delta *= dn1->stride); - for(dn1 = dn; dn1 > dn0; dn1--) { - ex -= (dn1->extent - 1) * dn1->delta; - dn1->delta -= ex; - } - } - else if (dims = v->dims) { - no = no1 = dims[1]; - ivae = iva + no*size; - } - else - scalar: - no = no1 = 1; - if (ch != '=') - errfl(a->cierr, 115, where); - got1 = nml_read = 1; - f__lcount = 0; - readloop: - for(;;) { - if (iva >= ivae || iva < 0) { - f__lquit = 1; - goto mustend; - } - else if (iva + no1*size > ivae) - no1 = (ivae - iva)/size; - f__lquit = 0; - if (k = l_read(&no1, vaddr + iva, size, type)) - return k; - if (f__lquit == 1) - return 0; - if (readall) { - iva += dn0->delta; - if (f__lcount > 0) { - no1 = (ivae - iva)/size; - if (no1 > f__lcount) - no1 = f__lcount; - if (k = l_read(&no1, vaddr + iva, - size, type)) - return k; - iva += no1 * dn0->delta; - } - } - mustend: - GETC(ch); - if (readall) - if (iva >= ivae) - readall = 0; - else for(;;) { - switch(ch) { - case ' ': - case '\t': - case '\n': - GETC(ch); - continue; - } - break; - } - if (ch == '/' || ch == '$' || ch == '&') { - f__lquit = 1; - return 0; - } - else if (f__lquit) { - while(ch <= ' ' && ch >= 0) - GETC(ch); - Ungetc(ch,f__cf); - if (!Alpha[ch & 0xff] && ch >= 0) - errfl(a->cierr, 125, where); - break; - } - Ungetc(ch,f__cf); - if (readall && !Alpha[ch & 0xff]) - goto readloop; - if ((no -= no1) <= 0) - break; - for(dn1 = dn0; dn1 <= dn; dn1++) { - if (++dn1->curval < dn1->extent) { - iva += dn1->delta; - goto readloop; - } - dn1->curval = 0; - } - break; - } + } + mustend: + GETC (ch); + if (readall) + if (iva >= ivae) + readall = 0; + else + for (;;) + { + switch (ch) + { + case ' ': + case '\t': + case '\n': + GETC (ch); + continue; + } + break; + } + if (ch == '/' || ch == '$' || ch == '&') + { + f__lquit = 1; + return 0; + } + else if (f__lquit) + { + while (ch <= ' ' && ch >= 0) + GETC (ch); + Ungetc (ch, f__cf); + if (!Alpha[ch & 0xff] && ch >= 0) + errfl (a->cierr, 125, where); + break; + } + Ungetc (ch, f__cf); + if (readall && !Alpha[ch & 0xff]) + goto readloop; + if ((no -= no1) <= 0) + break; + for (dn1 = dn0; dn1 <= dn; dn1++) + { + if (++dn1->curval < dn1->extent) + { + iva += dn1->delta; + goto readloop; } + dn1->curval = 0; + } + break; } + } +} - integer -s_rsne(cilist *a) +integer +s_rsne (cilist * a) { - extern int l_eof; - int n; + extern int l_eof; + int n; - f__external=1; - l_eof = 0; - if(n = c_le(a)) - return n; - if(f__curunit->uwrt && f__nowreading(f__curunit)) - err(a->cierr,errno,where0); - l_getc = t_getc; - l_ungetc = un_getc; - f__doend = xrd_SL; - n = x_rsne(a); - nml_read = 0; - if (n) - return n; - return e_rsle(); - } + f__external = 1; + l_eof = 0; + if (n = c_le (a)) + return n; + if (f__curunit->uwrt && f__nowreading (f__curunit)) + err (a->cierr, errno, where0); + l_getc = t_getc; + l_ungetc = un_getc; + f__doend = xrd_SL; + n = x_rsne (a); + nml_read = 0; + if (n) + return n; + return e_rsle (); +} |