1 files changed, 532 insertions, 541 deletions

diff --git a/contrib/libf2c/libI77/rsne.c b/contrib/libf2c/libI77/rsne.c
index a0d0bfe..f233a4a 100644
--- a/contrib/libf2c/libI77/rsne.c
+++ b/contrib/libf2c/libI77/rsne.c
@@ -3,55 +3,45 @@
 #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 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 dimen
+{
+  ftnlen extent;
+  ftnlen curval;
+  ftnlen delta;
+  ftnlen stride;
+};
+typedef struct dimen dimen;
 
- static hashtab *nl_cache;
- static int n_nlcache;
- static hashentry **zot;
- static int colonseen;
- extern ftnlen f__typesize[];
+struct hashentry
+{
+  struct hashentry *next;
+  char *name;
+  Vardesc *vd;
+};
+typedef struct hashentry hashentry;
 
- extern flag f__lquit;
- extern int f__lcount, nml_read;
- extern t_getc(Void);
+struct hashtab
+{
+  struct hashtab *next;
+  Namelist *nl;
+  int htsize;
+  hashentry *tab[1];
+};
+typedef struct hashtab hashtab;
 
-#ifdef KR_headers
- extern char *malloc(), *memset();
+static hashtab *nl_cache;
+static int n_nlcache;
+static hashentry **zot;
+static int colonseen;
+extern ftnlen f__typesize[];
 
-#ifdef ungetc
- static int
-un_getc(x,f__cf) int x; FILE *f__cf;
-{ return ungetc(x,f__cf); }
-#else
-#define un_getc ungetc
- extern int ungetc();
-#endif
+extern flag f__lquit;
+extern int f__lcount, nml_read;
+extern int t_getc (void);
 
-#else
 #undef abs
 #undef min
 #undef max
@@ -59,550 +49,551 @@ un_getc(x,f__cf) int x; FILE *f__cf;
 #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 */
-#endif
+extern int ungetc (int, FILE *);	/* for systems with a buggy stdio.h */
 #endif
 
- static Vardesc *
-#ifdef KR_headers
-hash(ht, s) hashtab *ht; register char *s;
-#else
-hash(hashtab *ht, register char *s)
-#endif
+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 *
-#ifdef KR_headers
-mk_hashtab(nl) Namelist *nl;
-#else
-mk_hashtab(Namelist *nl)
-#endif
+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;
+static void
+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
-#ifdef KR_headers
-getname(s, slen) register char *s; int slen;
-#else
-getname(register char *s, int slen)
-#endif
+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
-#ifdef KR_headers
-getnum(chp, val) int *chp; ftnlen *val;
-#else
-getnum(int *chp, ftnlen *val)
-#endif
+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
-#ifdef KR_headers
-getdimen(chp, d, delta, extent, x1)
- int *chp; dimen *d; ftnlen delta, extent, *x1;
-#else
-getdimen(int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1)
-#endif
+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
-#ifdef KR_headers
-print_ne(a) cilist *a;
-#else
-print_ne(cilist *a)
-#endif
+static void
+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 ";
 
-#ifdef KR_headers
-x_rsne(a) cilist *a;
-#else
-x_rsne(cilist *a)
-#endif
+int
+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)
+		{
+		  ftnint no2 = (ivae - iva) / size;
+		  if (no2 > f__lcount)
+		    no2 = f__lcount;
+		  if ((k = l_read (&no2, vaddr + iva, size, type)))
+		    return k;
+		  iva += no2 * 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
-#ifdef KR_headers
-s_rsne(a) cilist *a;
-#else
-s_rsne(cilist *a)
-#endif
+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 ();
+}