From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 16 Aug 1990 20:06:34 +0000 (+0000)
Subject: Implement new `reload_cleanup' facility to provide a hook for cleaning
X-Git-Tag: 20090517-FFI~11248
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=31eadc2a81b9cd223c490351d2620f2ef9d50d14;p=mit-scheme.git

Implement new `reload_cleanup' facility to provide a hook for cleaning
up various things before a disk-restore.
---

diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c
index 4b5010431..894864444 100644
--- a/v7/src/microcode/fasload.c
+++ b/v7/src/microcode/fasload.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.54 1990/08/16 08:43:53 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.55 1990/08/16 20:06:11 cph Exp $
 
 Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -669,22 +669,42 @@ DEFINE_PRIMITIVE ("BINARY-FASLOAD", Prim_binary_fasload, 1, 1, 0)
 /* Band loading. */
 
 static char *reload_band_name = 0;
-
-
-/* (RELOAD-BAND-NAME)
-   Returns the filename (as a Scheme string) from which the runtime system
-   was band loaded (load-band'ed ?), or #F if the system was fasl'ed.
-*/
+static Tptrvec reload_cleanups = 0;
 
-DEFINE_PRIMITIVE ("RELOAD-BAND-NAME", Prim_reload_band_name, 0, 0, 0)
+DEFINE_PRIMITIVE ("RELOAD-BAND-NAME", Prim_reload_band_name, 0, 0,
+  "Return the filename from which the runtime system was last restored.\n\
+The result is a string, or #F if the system was not restored.")
 {
   PRIMITIVE_HEADER (0);
   PRIMITIVE_RETURN
-    ((reload_band_name == NULL)
+    ((reload_band_name == 0)
      ? SHARP_F
      : (char_pointer_to_string (reload_band_name)));
 }
 
+typedef void EXFUN ((*Tcleanup), (void));
+
+void
+DEFUN (add_reload_cleanup, (cleanup_procedure), Tcleanup cleanup_procedure)
+{
+  if (reload_cleanups == 0)
+    {
+      reload_cleanups = (ptrvec_allocate (1));
+      (* ((Tcleanup *) (PTRVEC_LOC (reload_cleanups, 0)))) = cleanup_procedure;
+    }
+  else
+    ptrvec_adjoin (reload_cleanups, cleanup_procedure);
+}
+
+static void
+DEFUN_VOID (execute_reload_cleanups)
+{
+  PTR * scan = (PTRVEC_START (reload_cleanups));
+  PTR * end = (PTRVEC_END (reload_cleanups));
+  while (scan < end)
+    (* ((Tcleanup *) (scan++))) ();
+}
+
 /* Utility for load band below. */
 
 void
@@ -708,7 +728,7 @@ compiler_reset_error()
 #define END_BAND_LOAD(success, dying)					\
 {									\
   if (success || dying)							\
-    OS_channel_close_all ();						\
+    execute_reload_cleanups ();						\
   EXIT_CRITICAL_SECTION ({});						\
 }
 #endif
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index b9382e8a1..70ef49f8a 100644
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.41 1990/07/30 17:05:42 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.42 1990/08/16 20:06:34 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	41
+#define SUBVERSION	42
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index c64e18679..a7aaa8191 100644
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.41 1990/07/30 17:05:42 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.42 1990/08/16 20:06:34 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	41
+#define SUBVERSION	42
 #endif
 
 #ifndef UCODE_TABLES_FILENAME