Merge in microcode gc hook support for Ziggy's profiler.

diff --git a/v7/src/microcode/bchmmg.c b/v7/src/microcode/bchmmg.c
index 6cc13330cff0ab7b562c0638c1c4e837e690580f..869296becc4b7d0ad7994349192047aecd6454d6 100644 (file)
--- a/v7/src/microcode/bchmmg.c
+++ b/v7/src/microcode/bchmmg.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: bchmmg.c,v 9.78 1993/08/03 08:29:35 gjr Exp $
+$Id: bchmmg.c,v 9.79 1993/08/22 22:38:59 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -3135,9 +3135,11 @@ DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0)
     termination_gc_out_of_space ();
 
   ENTER_CRITICAL_SECTION ("garbage collector");
+  run_pre_gc_hooks ();
   gc_counter += 1;
   GC_Reserve = new_gc_reserve;
   GC (0);
+  run_post_gc_hooks ();
   POP_PRIMITIVE_FRAME (1);
   GC_Daemon_Proc = (Get_Fixed_Obj_Slot (GC_Daemon));
 

diff --git a/v7/src/microcode/bchpur.c b/v7/src/microcode/bchpur.c
index d56aa88b66af6c149b62834fe154479a52698ee9..63f77c62c9abffb5c62bd70c15d7f0347c30b680 100644 (file)
--- a/v7/src/microcode/bchpur.c
+++ b/v7/src/microcode/bchpur.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: bchpur.c,v 9.59 1993/06/24 07:06:59 gjr Exp $
+$Id: bchpur.c,v 9.60 1993/08/22 22:39:01 gjr Exp $
 
 Copyright (c) 1987-1992 Massachusetts Institute of Technology
 
@@ -116,9 +116,7 @@ DEFUN (purifyloop, (Scan, To_ptr, To_Address_ptr, purify_mode),
           and if so we need a new bufferfull. */
        Scan += (OBJECT_DATUM (Temp));
        if (Scan < scan_buffer_top)
-       {
          break;
-       }
        else
        {
          unsigned long overflow;
@@ -535,6 +533,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0)
   GC_Reserve = (arg_nonnegative_integer (3));
 
   ENTER_CRITICAL_SECTION ("purify");
+  run_pre_gc_hooks ();
   {
     SCHEME_OBJECT purify_result;
     SCHEME_OBJECT words_free;
@@ -545,6 +544,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0)
     (*Free++) = purify_result;
     (*Free++) = words_free;
   }
+  run_post_gc_hooks ();
   POP_PRIMITIVE_FRAME (3);
   daemon = (Get_Fixed_Obj_Slot (GC_Daemon));
   if (daemon == SHARP_F)

diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h
index 771cf46e2d80fb42fa26eaf51764ab8dc1fc45d1..c3105309add0fa08297047fa2005328089503356 100644 (file)
--- a/v7/src/microcode/gccode.h
+++ b/v7/src/microcode/gccode.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: gccode.h,v 9.49 1993/08/21 02:25:29 gjr Exp $
+$Id: gccode.h,v 9.50 1993/08/22 22:39:02 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -362,20 +362,16 @@ extern SCHEME_OBJECT * gc_objects_referencing_end;
 
 #ifdef ENABLE_GC_DEBUGGING_TOOLS
 
+extern void EXFUN (check_transport_vector_lossage,
+                  (SCHEME_OBJECT *, SCHEME_OBJECT *, SCHEME_OBJECT *));
+
 #define CHECK_TRANSPORT_VECTOR_TERMINATION()                           \
 {                                                                      \
   if (! ((To <= Scan)                                                  \
         && (((Constant_Space <= To) && (To < Constant_Top))            \
             ? ((Constant_Space <= Scan) && (Scan < Constant_Top))      \
             : ((Heap_Bottom <= Scan) && (Scan < Heap_Top)))))          \
-    {                                                                  \
-      outf_fatal ("\nBad transport_vector limit:\n");                  \
-      outf_fatal ("  limit = 0x%lx\n", ((long) Scan));                 \
-      outf_fatal ("  Scan = 0x%lx\n", ((long) Saved_Scan));            \
-      outf_fatal ("  To = 0x%lx\n", ((long) To));                      \
-      outf_flush_fatal ();                                             \
-      abort ();                                                                \
-    }                                                                  \
+    check_transport_vector_lossage (Scan, Saved_Scan, To);             \
   if ((OBJECT_DATUM (*Old)) > 65536)                                   \
     {                                                                  \
       outf_error ("\nWarning: copying large vector: %d\n",             \
@@ -542,3 +538,14 @@ extern SCHEME_OBJECT Weak_Chain;
 /* Compiled Code Relocation Utilities */
 
 #include "cmpgc.h"
+\f
+typedef struct gc_hook_list_s
+{
+  void EXFUN ((* hook), (void));
+  struct gc_hook_list_s * next;
+} * gc_hook_list;
+
+extern int EXFUN (add_pre_gc_hook, (void (*) (void)));
+extern int EXFUN (add_post_gc_hook, (void (*) (void)));
+extern void EXFUN (run_pre_gc_hooks, (void));
+extern void EXFUN (run_post_gc_hooks, (void));

diff --git a/v7/src/microcode/memmag.c b/v7/src/microcode/memmag.c
index e72960d33536e81e0439d769cd60958ccaa7dd52..6e64edde789341ff6e781e08292049e0011bdf8a 100644 (file)
--- a/v7/src/microcode/memmag.c
+++ b/v7/src/microcode/memmag.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: memmag.c,v 9.53 1993/08/03 22:15:14 gjr Exp $
+$Id: memmag.c,v 9.54 1993/08/22 22:39:03 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -483,10 +483,12 @@ DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0)
   }
 
   ENTER_CRITICAL_SECTION ("garbage collector");
+  run_pre_gc_hooks ();
   gc_counter += 1;
   GC_Reserve = new_gc_reserve;
   GCFlip ();
   GC ();
+  run_post_gc_hooks ();
   POP_PRIMITIVE_FRAME (1);
   GC_Daemon_Proc = (Get_Fixed_Obj_Slot (GC_Daemon));
 
@@ -531,3 +533,17 @@ DEFINE_PRIMITIVE ("GC-TRACE-REFERENCES", Prim_gc_trace_references, 2, 2, 0)
   }
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
+
+void
+DEFUN (check_transport_vector_lossage, (Scan, Saved_Scan, To),
+       SCHEME_OBJECT * Scan
+       AND SCHEME_OBJECT * Saved_Scan
+       AND SCHEME_OBJECT * To)
+{
+  outf_fatal ("\nBad transport_vector limit:\n");
+  outf_fatal ("  limit = 0x%lx\n", ((long) Scan));
+  outf_fatal ("  Scan = 0x%lx\n", ((long) Saved_Scan));
+  outf_fatal ("  To = 0x%lx\n", ((long) To));
+  outf_flush_fatal ();
+  abort ();
+}

diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c
index 4dbb96a2eba3dedcd8eab92d9808abe7bb11e06b..05a36b6deedcb14385df3a1cfd13b2965a4299d5 100644 (file)
--- a/v7/src/microcode/purify.c
+++ b/v7/src/microcode/purify.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: purify.c,v 9.50 1993/08/21 04:01:15 gjr Exp $
+$Id: purify.c,v 9.51 1993/08/22 22:39:04 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -426,6 +426,7 @@ DEFUN (Purify,
 
 /* Pass 1 -- Copy object to new heap, then GC into that heap */
 
+  run_pre_gc_hooks ();
   GCFlip ();
   Heap_Start = Free;
   *Free++ = Object;
@@ -443,6 +444,7 @@ DEFUN (Purify,
   Free[Purify_Really_Pure] = Purify_Object;
   Answer =  MAKE_POINTER_OBJECT (TC_VECTOR, Free);
   Free += (Purify_N_Slots + 1);
+  run_post_gc_hooks ();
   return (Answer);
 }
 \f
@@ -456,21 +458,16 @@ DEFUN (Purify_Pass_2,
   SCHEME_OBJECT *New_Object, Relocated_Object, *Result;
   long Pure_Length, Recomputed_Length;
 
+  run_pre_gc_hooks ();
   STACK_SANITY_CHECK ("PURIFY");
   Length = (OBJECT_DATUM (FAST_MEMORY_REF (Info, Purify_Length)));
   if (FAST_MEMORY_REF (Info, Purify_Really_Pure) == SHARP_F)
-  {
     Purify_Object =  false;
-  }
   else
-  {
     Purify_Object = true;
-  }
   Relocated_Object = *Heap_Bottom;
   if (!(TEST_CONSTANT_TOP (Free_Constant + Length + 6)))
-  {
     return (SHARP_F);
-  }
   New_Object = Free_Constant;
   GCFlip ();
   *Free_Constant++ = SHARP_F;  /* Will hold pure space header */
@@ -487,9 +484,7 @@ DEFUN (Purify_Pass_2,
     Pure_Length = ((Free_Constant - New_Object) + 1);
   }
   else
-  {
     Pure_Length = 3;
-  }
   *Free_Constant++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1));
   *Free_Constant++ = (MAKE_OBJECT (CONSTANT_PART, Pure_Length));
   if (Purify_Object)
@@ -530,6 +525,7 @@ DEFUN (Purify_Pass_2,
   *New_Object = (MAKE_OBJECT (PURE_PART, (Recomputed_Length + 5)));
   SET_CONSTANT_TOP ();
   GC ();
+  run_post_gc_hooks ();
   return (SHARP_T);
 }
 \f

diff --git a/v7/src/microcode/purutl.c b/v7/src/microcode/purutl.c
index 291680d3ed0171a7ea2a3ac3131d98db93bf2914..f6ac23e731eecf6d108c28fcb9b453c40321597b 100644 (file)
--- a/v7/src/microcode/purutl.c
+++ b/v7/src/microcode/purutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: purutl.c,v 9.44 1993/06/24 06:20:03 gjr Exp $
+$Id: purutl.c,v 9.45 1993/08/22 22:39:05 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -286,9 +286,7 @@ DEFUN (find_constant_space_block,
 #endif
     where -= (1 + OBJECT_DATUM (*where));
     if (where < obj_address)
-    {
       return (where + 1);
-    }
   }
   return ((SCHEME_OBJECT *) NULL);
 }
@@ -302,9 +300,7 @@ DEFUN (Pure_Test,
 
   block = (find_constant_space_block (obj_address));
   if (block == ((SCHEME_OBJECT *) NULL))
-  {
     return (false);
-  }
   return
     ((Boolean) (obj_address <= (block + (OBJECT_DATUM (*block)))));
 }
@@ -337,8 +333,7 @@ DEFINE_PRIMITIVE ("CONSTANT?", Prim_constant_p, 1, 1,
   PRIMITIVE_HEADER (1);
   {
     fast SCHEME_OBJECT object = (ARG_REF (1));
-    if ((GC_Type_Non_Pointer (object)) ||
-       (GC_Type_Special (object)))
+    if ((GC_Type_Non_Pointer (object)) || (GC_Type_Special (object)))
       PRIMITIVE_RETURN (SHARP_T);
     TOUCH_IN_PRIMITIVE (object, object);
     PRIMITIVE_RETURN
@@ -384,13 +379,72 @@ DEFUN (copy_to_constant_space,
   *dest++ = (MAKE_OBJECT (CONSTANT_PART, 3));
   result = dest;
   for (i = nobjects; --i >= 0; )
-  {
     *dest++ = *source++;
-  }
   *dest++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1));
   *dest++ = (MAKE_OBJECT (END_OF_BLOCK, nobjects + 5));
   Free_Constant = dest;
   SET_CONSTANT_TOP ();
 
-  return result;
+  return (result);
+}
+\f
+gc_hook_list  pre_gc_hooks = ((gc_hook_list) NULL);
+gc_hook_list post_gc_hooks = ((gc_hook_list) NULL);
+
+static int
+DEFUN (add_gc_hook, (cell, hook),
+       gc_hook_list * cell AND void EXFUN ((* hook), (void)))
+{
+  gc_hook_list new = ((gc_hook_list)
+                     (malloc (sizeof (struct gc_hook_list_s))));
+  if (new == ((gc_hook_list) NULL))
+    return (-1);
+
+  new->hook = hook;
+  new->next = ((gc_hook_list) NULL);
+
+  while ((* cell) != ((gc_hook_list) NULL))
+    cell = (& ((* cell)->next));
+
+  * cell = new;
+  return (0);
+}
+
+static void
+DEFUN (run_gc_hooks, (gc_hooks), gc_hook_list gc_hooks)
+{
+  while (gc_hooks != ((gc_hook_list) NULL))
+  {
+    (* (gc_hooks->hook)) ();
+    gc_hooks = gc_hooks->next;
+  }
+  return;
+}
+
+int
+DEFUN (add_pre_gc_hook, (hook),
+       void EXFUN ((* hook), (void)))
+{
+  return (add_gc_hook ((& pre_gc_hooks), hook));
+}
+
+int
+DEFUN (add_post_gc_hook, (hook),
+       void EXFUN ((* hook), (void)))
+{
+  return (add_gc_hook ((& post_gc_hooks), hook));
+}
+
+void
+DEFUN_VOID (run_pre_gc_hooks)
+{
+  run_gc_hooks (pre_gc_hooks);
+  return;
+}
+
+void
+DEFUN_VOID (run_post_gc_hooks)
+{
+  run_gc_hooks (post_gc_hooks);
+  return;
 }

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 94a35260838d696642f122ae40efd16504cf4bbd..22555cb0a6da2d336f4d3e9e9bff8c160281ac8e 100644 (file)
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: version.h,v 11.137 1993/08/22 20:25:39 gjr Exp $
+$Id: version.h,v 11.138 1993/08/22 22:39:06 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -46,5 +46,5 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     137
+#define SUBVERSION     138
 #endif

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 94a35260838d696642f122ae40efd16504cf4bbd..22555cb0a6da2d336f4d3e9e9bff8c160281ac8e 100644 (file)
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: version.h,v 11.137 1993/08/22 20:25:39 gjr Exp $
+$Id: version.h,v 11.138 1993/08/22 22:39:06 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -46,5 +46,5 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     137
+#define SUBVERSION     138
 #endif