Gcc 3.3.1-pre 2003-07-11 libf2c bits.

1 files changed, 355 insertions, 320 deletions

diff --git a/contrib/libf2c/libI77/wrtfmt.c b/contrib/libf2c/libI77/wrtfmt.c
index 37006ba..0190f71 100644
--- a/contrib/libf2c/libI77/wrtfmt.c
+++ b/contrib/libf2c/libI77/wrtfmt.c
@@ -6,361 +6,396 @@
 extern icilist *f__svic;
 extern char *f__icptr;
 
- static int
-mv_cur(Void)	/* shouldn't use fseek because it insists on calling fflush */
+static int
+mv_cur (void)			/* shouldn't use fseek because it insists on calling fflush */
 		/* instead we know too much about stdio */
 {
-	int cursor = f__cursor;
-	f__cursor = 0;
-	if(f__external == 0) {
-		if(cursor < 0) {
-			if(f__hiwater < f__recpos)
-				f__hiwater = f__recpos;
-			f__recpos += cursor;
-			f__icptr += cursor;
-			if(f__recpos < 0)
-				err(f__elist->cierr, 110, "left off");
-		}
-		else if(cursor > 0) {
-			if(f__recpos + cursor >= f__svic->icirlen)
-				err(f__elist->cierr, 110, "recend");
-			if(f__hiwater <= f__recpos)
-				for(; cursor > 0; cursor--)
-					(*f__putn)(' ');
-			else if(f__hiwater <= f__recpos + cursor) {
-				cursor -= f__hiwater - f__recpos;
-				f__icptr += f__hiwater - f__recpos;
-				f__recpos = f__hiwater;
-				for(; cursor > 0; cursor--)
-					(*f__putn)(' ');
-			}
-			else {
-				f__icptr += cursor;
-				f__recpos += cursor;
-			}
-		}
-		return(0);
+  int cursor = f__cursor;
+  f__cursor = 0;
+  if (f__external == 0)
+    {
+      if (cursor < 0)
+	{
+	  if (f__hiwater < f__recpos)
+	    f__hiwater = f__recpos;
+	  f__recpos += cursor;
+	  f__icptr += cursor;
+	  if (f__recpos < 0)
+	    err (f__elist->cierr, 110, "left off");
 	}
-	if (cursor > 0) {
-		if(f__hiwater <= f__recpos)
-			for(;cursor>0;cursor--) (*f__putn)(' ');
-		else if(f__hiwater <= f__recpos + cursor) {
-			cursor -= f__hiwater - f__recpos;
-			f__recpos = f__hiwater;
-			for(; cursor > 0; cursor--)
-				(*f__putn)(' ');
-		}
-		else {
-			f__recpos += cursor;
-		}
+      else if (cursor > 0)
+	{
+	  if (f__recpos + cursor >= f__svic->icirlen)
+	    err (f__elist->cierr, 110, "recend");
+	  if (f__hiwater <= f__recpos)
+	    for (; cursor > 0; cursor--)
+	      (*f__putn) (' ');
+	  else if (f__hiwater <= f__recpos + cursor)
+	    {
+	      cursor -= f__hiwater - f__recpos;
+	      f__icptr += f__hiwater - f__recpos;
+	      f__recpos = f__hiwater;
+	      for (; cursor > 0; cursor--)
+		(*f__putn) (' ');
+	    }
+	  else
+	    {
+	      f__icptr += cursor;
+	      f__recpos += cursor;
+	    }
 	}
-	else if (cursor < 0)
+      return (0);
+    }
+  if (cursor > 0)
+    {
+      if (f__hiwater <= f__recpos)
+	for (; cursor > 0; cursor--)
+	  (*f__putn) (' ');
+      else if (f__hiwater <= f__recpos + cursor)
 	{
-		if(cursor + f__recpos < 0)
-			err(f__elist->cierr,110,"left off");
-		if(f__hiwater < f__recpos)
-			f__hiwater = f__recpos;
-		f__recpos += cursor;
+	  cursor -= f__hiwater - f__recpos;
+	  f__recpos = f__hiwater;
+	  for (; cursor > 0; cursor--)
+	    (*f__putn) (' ');
 	}
-	return(0);
+      else
+	{
+	  f__recpos += cursor;
+	}
+    }
+  else if (cursor < 0)
+    {
+      if (cursor + f__recpos < 0)
+	err (f__elist->cierr, 110, "left off");
+      if (f__hiwater < f__recpos)
+	f__hiwater = f__recpos;
+      f__recpos += cursor;
+    }
+  return (0);
 }
 
- static int
-#ifdef KR_headers
-wrt_Z(n,w,minlen,len) Uint *n; int w, minlen; ftnlen len;
-#else
-wrt_Z(Uint *n, int w, int minlen, ftnlen len)
-#endif
+static int
+wrt_Z (Uint * n, int w, int minlen, ftnlen len)
 {
-	register char *s, *se;
-	register int i, w1;
-	static int one = 1;
-	static char hex[] = "0123456789ABCDEF";
-	s = (char *)n;
-	--len;
-	if (*(char *)&one) {
-		/* little endian */
-		se = s;
-		s += len;
-		i = -1;
-		}
-	else {
-		se = s + len;
-		i = 1;
-		}
-	for(;; s += i)
-		if (s == se || *s)
-			break;
-	w1 = (i*(se-s) << 1) + 1;
-	if (*s & 0xf0)
-		w1++;
-	if (w1 > w)
-		for(i = 0; i < w; i++)
-			(*f__putn)('*');
-	else {
-		if ((minlen -= w1) > 0)
-			w1 += minlen;
-		while(--w >= w1)
-			(*f__putn)(' ');
-		while(--minlen >= 0)
-			(*f__putn)('0');
-		if (!(*s & 0xf0)) {
-			(*f__putn)(hex[*s & 0xf]);
-			if (s == se)
-				return 0;
-			s += i;
-			}
-		for(;; s += i) {
-			(*f__putn)(hex[*s >> 4 & 0xf]);
-			(*f__putn)(hex[*s & 0xf]);
-			if (s == se)
-				break;
-			}
-		}
-	return 0;
+  register char *s, *se;
+  register int i, w1;
+  static int one = 1;
+  static char hex[] = "0123456789ABCDEF";
+  s = (char *) n;
+  --len;
+  if (*(char *) &one)
+    {
+      /* little endian */
+      se = s;
+      s += len;
+      i = -1;
+    }
+  else
+    {
+      se = s + len;
+      i = 1;
+    }
+  for (;; s += i)
+    if (s == se || *s)
+      break;
+  w1 = (i * (se - s) << 1) + 1;
+  if (*s & 0xf0)
+    w1++;
+  if (w1 > w)
+    for (i = 0; i < w; i++)
+      (*f__putn) ('*');
+  else
+    {
+      if ((minlen -= w1) > 0)
+	w1 += minlen;
+      while (--w >= w1)
+	(*f__putn) (' ');
+      while (--minlen >= 0)
+	(*f__putn) ('0');
+      if (!(*s & 0xf0))
+	{
+	  (*f__putn) (hex[*s & 0xf]);
+	  if (s == se)
+	    return 0;
+	  s += i;
+	}
+      for (;; s += i)
+	{
+	  (*f__putn) (hex[*s >> 4 & 0xf]);
+	  (*f__putn) (hex[*s & 0xf]);
+	  if (s == se)
+	    break;
 	}
+    }
+  return 0;
+}
 
- static int
-#ifdef KR_headers
-wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base;
-#else
-wrt_I(Uint *n, int w, ftnlen len, register int base)
-#endif
-{	int ndigit,sign,spare,i;
-	longint x;
-	char *ans;
-	if(len==sizeof(integer)) x=n->il;
-	else if(len == sizeof(char)) x = n->ic;
+static int
+wrt_I (Uint * n, int w, ftnlen len, register int base)
+{
+  int ndigit, sign, spare, i;
+  longint x;
+  char *ans;
+  if (len == sizeof (integer))
+    x = n->il;
+  else if (len == sizeof (char))
+    x = n->ic;
 #ifdef Allow_TYQUAD
-	else if (len == sizeof(longint)) x = n->ili;
+  else if (len == sizeof (longint))
+    x = n->ili;
 #endif
-	else x=n->is;
-	ans=f__icvt(x,&ndigit,&sign, base);
-	spare=w-ndigit;
-	if(sign || f__cplus) spare--;
-	if(spare<0)
-		for(i=0;i<w;i++) (*f__putn)('*');
-	else
-	{	for(i=0;i<spare;i++) (*f__putn)(' ');
-		if(sign) (*f__putn)('-');
-		else if(f__cplus) (*f__putn)('+');
-		for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
-	}
-	return(0);
+  else
+    x = n->is;
+  ans = f__icvt (x, &ndigit, &sign, base);
+  spare = w - ndigit;
+  if (sign || f__cplus)
+    spare--;
+  if (spare < 0)
+    for (i = 0; i < w; i++)
+      (*f__putn) ('*');
+  else
+    {
+      for (i = 0; i < spare; i++)
+	(*f__putn) (' ');
+      if (sign)
+	(*f__putn) ('-');
+      else if (f__cplus)
+	(*f__putn) ('+');
+      for (i = 0; i < ndigit; i++)
+	(*f__putn) (*ans++);
+    }
+  return (0);
 }
- static int
-#ifdef KR_headers
-wrt_IM(n,w,m,len,base) Uint *n; ftnlen len; int base;
-#else
-wrt_IM(Uint *n, int w, int m, ftnlen len, int base)
-#endif
-{	int ndigit,sign,spare,i,xsign;
-	longint x;
-	char *ans;
-	if(sizeof(integer)==len) x=n->il;
-	else if(len == sizeof(char)) x = n->ic;
+static int
+wrt_IM (Uint * n, int w, int m, ftnlen len, int base)
+{
+  int ndigit, sign, spare, i, xsign;
+  longint x;
+  char *ans;
+  if (sizeof (integer) == len)
+    x = n->il;
+  else if (len == sizeof (char))
+    x = n->ic;
 #ifdef Allow_TYQUAD
-	else if (len == sizeof(longint)) x = n->ili;
+  else if (len == sizeof (longint))
+    x = n->ili;
 #endif
-	else x=n->is;
-	ans=f__icvt(x,&ndigit,&sign, base);
-	if(sign || f__cplus) xsign=1;
-	else xsign=0;
-	if(ndigit+xsign>w || m+xsign>w)
-	{	for(i=0;i<w;i++) (*f__putn)('*');
-		return(0);
-	}
-	if(x==0 && m==0)
-	{	for(i=0;i<w;i++) (*f__putn)(' ');
-		return(0);
-	}
-	if(ndigit>=m)
-		spare=w-ndigit-xsign;
-	else
-		spare=w-m-xsign;
-	for(i=0;i<spare;i++) (*f__putn)(' ');
-	if(sign) (*f__putn)('-');
-	else if(f__cplus) (*f__putn)('+');
-	for(i=0;i<m-ndigit;i++) (*f__putn)('0');
-	for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
-	return(0);
+  else
+    x = n->is;
+  ans = f__icvt (x, &ndigit, &sign, base);
+  if (sign || f__cplus)
+    xsign = 1;
+  else
+    xsign = 0;
+  if (ndigit + xsign > w || m + xsign > w)
+    {
+      for (i = 0; i < w; i++)
+	(*f__putn) ('*');
+      return (0);
+    }
+  if (x == 0 && m == 0)
+    {
+      for (i = 0; i < w; i++)
+	(*f__putn) (' ');
+      return (0);
+    }
+  if (ndigit >= m)
+    spare = w - ndigit - xsign;
+  else
+    spare = w - m - xsign;
+  for (i = 0; i < spare; i++)
+    (*f__putn) (' ');
+  if (sign)
+    (*f__putn) ('-');
+  else if (f__cplus)
+    (*f__putn) ('+');
+  for (i = 0; i < m - ndigit; i++)
+    (*f__putn) ('0');
+  for (i = 0; i < ndigit; i++)
+    (*f__putn) (*ans++);
+  return (0);
 }
- static int
-#ifdef KR_headers
-wrt_AP(s) char *s;
-#else
-wrt_AP(char *s)
-#endif
-{	char quote;
-	int i;
+static int
+wrt_AP (char *s)
+{
+  char quote;
+  int i;
 
-	if(f__cursor && (i = mv_cur()))
-		return i;
-	quote = *s++;
-	for(;*s;s++)
-	{	if(*s!=quote) (*f__putn)(*s);
-		else if(*++s==quote) (*f__putn)(*s);
-		else return(1);
-	}
-	return(1);
+  if (f__cursor && (i = mv_cur ()))
+    return i;
+  quote = *s++;
+  for (; *s; s++)
+    {
+      if (*s != quote)
+	(*f__putn) (*s);
+      else if (*++s == quote)
+	(*f__putn) (*s);
+      else
+	return (1);
+    }
+  return (1);
 }
- static int
-#ifdef KR_headers
-wrt_H(a,s) char *s;
-#else
-wrt_H(int a, char *s)
-#endif
+static int
+wrt_H (int a, char *s)
 {
-	int i;
+  int i;
 
-	if(f__cursor && (i = mv_cur()))
-		return i;
-	while(a--) (*f__putn)(*s++);
-	return(1);
+  if (f__cursor && (i = mv_cur ()))
+    return i;
+  while (a--)
+    (*f__putn) (*s++);
+  return (1);
 }
-#ifdef KR_headers
-wrt_L(n,len, sz) Uint *n; ftnlen sz;
-#else
-wrt_L(Uint *n, int len, ftnlen sz)
-#endif
-{	int i;
-	long x;
-	if(sizeof(long)==sz) x=n->il;
-	else if(sz == sizeof(char)) x = n->ic;
-	else x=n->is;
-	for(i=0;i<len-1;i++)
-		(*f__putn)(' ');
-	if(x) (*f__putn)('T');
-	else (*f__putn)('F');
-	return(0);
+
+int
+wrt_L (Uint * n, int len, ftnlen sz)
+{
+  int i;
+  long x;
+  if (sizeof (long) == sz)
+    x = n->il;
+  else if (sz == sizeof (char))
+    x = n->ic;
+  else
+    x = n->is;
+  for (i = 0; i < len - 1; i++)
+    (*f__putn) (' ');
+  if (x)
+    (*f__putn) ('T');
+  else
+    (*f__putn) ('F');
+  return (0);
 }
- static int
-#ifdef KR_headers
-wrt_A(p,len) char *p; ftnlen len;
-#else
-wrt_A(char *p, ftnlen len)
-#endif
+static int
+wrt_A (char *p, ftnlen len)
 {
-	while(len-- > 0) (*f__putn)(*p++);
-	return(0);
+  while (len-- > 0)
+    (*f__putn) (*p++);
+  return (0);
 }
- static int
-#ifdef KR_headers
-wrt_AW(p,w,len) char * p; ftnlen len;
-#else
-wrt_AW(char * p, int w, ftnlen len)
-#endif
+static int
+wrt_AW (char *p, int w, ftnlen len)
 {
-	while(w>len)
-	{	w--;
-		(*f__putn)(' ');
-	}
-	while(w-- > 0)
-		(*f__putn)(*p++);
-	return(0);
+  while (w > len)
+    {
+      w--;
+      (*f__putn) (' ');
+    }
+  while (w-- > 0)
+    (*f__putn) (*p++);
+  return (0);
 }
 
- static int
-#ifdef KR_headers
-wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
-#else
-wrt_G(ufloat *p, int w, int d, int e, ftnlen len)
-#endif
-{	double up = 1,x;
-	int i=0,oldscale,n,j;
-	x = len==sizeof(real)?p->pf:p->pd;
-	if(x < 0 ) x = -x;
-	if(x<.1) {
-		if (x != 0.)
-			return(wrt_E(p,w,d,e,len));
-		i = 1;
-		goto have_i;
-		}
-	for(;i<=d;i++,up*=10)
-	{	if(x>=up) continue;
- have_i:
-		oldscale = f__scale;
-		f__scale = 0;
-		if(e==0) n=4;
-		else	n=e+2;
-		i=wrt_F(p,w-n,d-i,len);
-		for(j=0;j<n;j++) (*f__putn)(' ');
-		f__scale=oldscale;
-		return(i);
-	}
-	return(wrt_E(p,w,d,e,len));
+static int
+wrt_G (ufloat * p, int w, int d, int e, ftnlen len)
+{
+  double up = 1, x;
+  int i = 0, oldscale, n, j;
+  x = len == sizeof (real) ? p->pf : p->pd;
+  if (x < 0)
+    x = -x;
+  if (x < .1)
+    {
+      if (x != 0.)
+	return (wrt_E (p, w, d, e, len));
+      i = 1;
+      goto have_i;
+    }
+  for (; i <= d; i++, up *= 10)
+    {
+      if (x >= up)
+	continue;
+    have_i:
+      oldscale = f__scale;
+      f__scale = 0;
+      if (e == 0)
+	n = 4;
+      else
+	n = e + 2;
+      i = wrt_F (p, w - n, d - i, len);
+      for (j = 0; j < n; j++)
+	(*f__putn) (' ');
+      f__scale = oldscale;
+      return (i);
+    }
+  return (wrt_E (p, w, d, e, len));
 }
-#ifdef KR_headers
-w_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
-#else
-w_ed(struct syl *p, char *ptr, ftnlen len)
-#endif
+
+int
+w_ed (struct syl * p, char *ptr, ftnlen len)
 {
-	int i;
+  int i;
 
-	if(f__cursor && (i = mv_cur()))
-		return i;
-	switch(p->op)
-	{
-	default:
-		fprintf(stderr,"w_ed, unexpected code: %d\n", p->op);
-		sig_die(f__fmtbuf, 1);
-	case I:	return(wrt_I((Uint *)ptr,p->p1,len, 10));
-	case IM:
-		return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,10));
+  if (f__cursor && (i = mv_cur ()))
+    return i;
+  switch (p->op)
+    {
+    default:
+      fprintf (stderr, "w_ed, unexpected code: %d\n", p->op);
+      sig_die (f__fmtbuf, 1);
+    case I:
+      return (wrt_I ((Uint *) ptr, p->p1, len, 10));
+    case IM:
+      return (wrt_IM ((Uint *) ptr, p->p1, p->p2.i[0], len, 10));
 
-		/* O and OM don't work right for character, double, complex, */
-		/* or doublecomplex, and they differ from Fortran 90 in */
-		/* showing a minus sign for negative values. */
+      /* O and OM don't work right for character, double, complex, */
+      /* or doublecomplex, and they differ from Fortran 90 in */
+      /* showing a minus sign for negative values. */
 
-	case O:	return(wrt_I((Uint *)ptr, p->p1, len, 8));
-	case OM:
-		return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,8));
-	case L:	return(wrt_L((Uint *)ptr,p->p1, len));
-	case A: return(wrt_A(ptr,len));
-	case AW:
-		return(wrt_AW(ptr,p->p1,len));
-	case D:
-	case E:
-	case EE:
-		return(wrt_E((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len));
-	case G:
-	case GE:
-		return(wrt_G((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len));
-	case F:	return(wrt_F((ufloat *)ptr,p->p1,p->p2.i[0],len));
+    case O:
+      return (wrt_I ((Uint *) ptr, p->p1, len, 8));
+    case OM:
+      return (wrt_IM ((Uint *) ptr, p->p1, p->p2.i[0], len, 8));
+    case L:
+      return (wrt_L ((Uint *) ptr, p->p1, len));
+    case A:
+      return (wrt_A (ptr, len));
+    case AW:
+      return (wrt_AW (ptr, p->p1, len));
+    case D:
+    case E:
+    case EE:
+      return (wrt_E ((ufloat *) ptr, p->p1, p->p2.i[0], p->p2.i[1], len));
+    case G:
+    case GE:
+      return (wrt_G ((ufloat *) ptr, p->p1, p->p2.i[0], p->p2.i[1], len));
+    case F:
+      return (wrt_F ((ufloat *) ptr, p->p1, p->p2.i[0], len));
 
-		/* Z and ZM assume 8-bit bytes. */
+      /* Z and ZM assume 8-bit bytes. */
 
-	case Z: return(wrt_Z((Uint *)ptr,p->p1,0,len));
-	case ZM:
-		return(wrt_Z((Uint *)ptr,p->p1,p->p2.i[0],len));
-	}
+    case Z:
+      return (wrt_Z ((Uint *) ptr, p->p1, 0, len));
+    case ZM:
+      return (wrt_Z ((Uint *) ptr, p->p1, p->p2.i[0], len));
+    }
 }
-#ifdef KR_headers
-w_ned(p) struct syl *p;
-#else
-w_ned(struct syl *p)
-#endif
+
+int
+w_ned (struct syl * p)
 {
-	switch(p->op)
-	{
-	default: fprintf(stderr,"w_ned, unexpected code: %d\n", p->op);
-		sig_die(f__fmtbuf, 1);
-	case SLASH:
-		return((*f__donewrec)());
-	case T: f__cursor = p->p1-f__recpos - 1;
-		return(1);
-	case TL: f__cursor -= p->p1;
-		if(f__cursor < -f__recpos)	/* TL1000, 1X */
-			f__cursor = -f__recpos;
-		return(1);
-	case TR:
-	case X:
-		f__cursor += p->p1;
-		return(1);
-	case APOS:
-		return(wrt_AP(p->p2.s));
-	case H:
-		return(wrt_H(p->p1,p->p2.s));
-	}
+  switch (p->op)
+    {
+    default:
+      fprintf (stderr, "w_ned, unexpected code: %d\n", p->op);
+      sig_die (f__fmtbuf, 1);
+    case SLASH:
+      return ((*f__donewrec) ());
+    case T:
+      f__cursor = p->p1 - f__recpos - 1;
+      return (1);
+    case TL:
+      f__cursor -= p->p1;
+      if (f__cursor < -f__recpos)	/* TL1000, 1X */
+	f__cursor = -f__recpos;
+      return (1);
+    case TR:
+    case X:
+      f__cursor += p->p1;
+      return (1);
+    case APOS:
+      return (wrt_AP (p->p2.s));
+    case H:
+      return (wrt_H (p->p1, p->p2.s));
+    }
 }