1 files changed, 101 insertions, 0 deletions
diff --git a/libf2c/libI77/close.c b/libf2c/libI77/close.c
new file mode 100644
index 0000000..769c569
--- /dev/null
+++ b/libf2c/libI77/close.c
@@ -0,0 +1,101 @@
+#include "config.h"
+#include "f2c.h"
+#include "fio.h"
+
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#ifdef NON_UNIX_STDIO
+#ifndef unlink
+#define unlink remove
+#endif
+#else
+#if defined (MSDOS) && !defined (GO32)
+#include "io.h"
+#else
+extern int unlink (const char *);
+#endif
+#endif
+
+integer
+f_clos (cllist * a)
+{
+  unit *b;
+
+  if (f__init & 2)
+    f__fatal (131, "I/O recursion");
+  if (a->cunit >= MXUNIT)
+    return (0);
+  b = &f__units[a->cunit];
+  if (b->ufd == NULL)
+    goto done;
+  if (b->uscrtch == 1)
+    goto Delete;
+  if (!a->csta)
+    goto Keep;
+  switch (*a->csta)
+    {
+    default:
+    Keep:
+    case 'k':
+    case 'K':
+      if (b->uwrt == 1)
+	t_runc ((alist *) a);
+      if (b->ufnm)
+	{
+	  fclose (b->ufd);
+	  free (b->ufnm);
+	}
+      break;
+    case 'd':
+    case 'D':
+    Delete:
+      fclose (b->ufd);
+      if (b->ufnm)
+	{
+	  unlink (b->ufnm);
+	  /*SYSDEP*/ free (b->ufnm);
+	}
+    }
+  b->ufd = NULL;
+done:
+  b->uend = 0;
+  b->ufnm = NULL;
+  return (0);
+}
+
+void
+f_exit (void)
+{
+  int i;
+  static cllist xx;
+  if (!(f__init & 1))
+    return;			/* Not initialized, so no open units. */
+  /* I/O no longer in progress.  If, during an I/O operation (such
+     as waiting for the user to enter a line), there is an
+     interrupt (such as ^C to stop the program on a UNIX system),
+     f_exit() is called, but there is no longer any I/O in
+     progress.  Without turning off this flag, f_clos() would
+     think that there is an I/O recursion in this circumstance. */
+  f__init &= ~2;
+  if (!xx.cerr)
+    {
+      xx.cerr = 1;
+      xx.csta = NULL;
+      for (i = 0; i < MXUNIT; i++)
+	{
+	  xx.cunit = i;
+	  (void) f_clos (&xx);
+	}
+    }
+}
+int
+G77_flush_0 (void)
+{
+  int i;
+  for (i = 0; i < MXUNIT; i++)
+    if (f__units[i].ufd != NULL && f__units[i].uwrt)
+      fflush (f__units[i].ufd);
+  return 0;
+}