Remove libf2c. It hasn't been used for more than 11 years, since revision

1.90 (CVS; SVN r45770) of lib/Makefile.

1 files changed, 0 insertions, 407 deletions

diff --git a/contrib/libf2c/libI77/wrtfmt.c b/contrib/libf2c/libI77/wrtfmt.c
deleted file mode 100644
index 0747f92..0000000
--- a/contrib/libf2c/libI77/wrtfmt.c
+++ /dev/null
@@ -1,407 +0,0 @@
-#include "config.h"
-#include "f2c.h"
-#include "fio.h"
-#include "fmt.h"
-
-extern icilist *f__svic;
-extern char *f__icptr;
-
-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);
-    }
-  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 (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
-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;
-}
-
-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;
-#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);
-}
-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;
-#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);
-}
-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);
-}
-static int
-wrt_H (int a, char *s)
-{
-  int i;
-
-  if (f__cursor && (i = mv_cur ()))
-    return i;
-  while (a--)
-    (*f__putn) (*s++);
-  return (1);
-}
-
-int
-wrt_L (Uint * n, int len, ftnlen sz)
-{
-  int i;
-  longint x;
-#ifdef Allow_TYQUAD
-  if (sizeof (longint) == sz)
-    x = n->ili;
-  else
-#endif
-  if (sizeof (short ) == sz)
-    x = n->is;
-  else if (sizeof (char) == sz)
-    x = n->ic;
-  else if (sizeof (integer) == sz)
-    x = n->il;
-
-  for (i = 0; i < len - 1; i++)
-    (*f__putn) (' ');
-  if (x)
-    (*f__putn) ('T');
-  else
-    (*f__putn) ('F');
-  return (0);
-}
-static int
-wrt_A (char *p, ftnlen len)
-{
-  while (len-- > 0)
-    (*f__putn) (*p++);
-  return (0);
-}
-static int
-wrt_AW (char *p, int w, ftnlen len)
-{
-  while (w > len)
-    {
-      w--;
-      (*f__putn) (' ');
-    }
-  while (w-- > 0)
-    (*f__putn) (*p++);
-  return (0);
-}
-
-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));
-}
-
-int
-w_ed (struct syl * p, char *ptr, ftnlen len)
-{
-  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));
-
-      /* 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));
-
-      /* 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));
-    }
-}
-
-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));
-    }
-}