From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 29 Apr 1987 15:50:43 +0000 (+0000)
Subject: Define hook for recording primitive profiling information.
X-Git-Tag: 20090517-FFI~13567
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=598c733f2b137e11356ec0b6f84751b37cafb98d;p=mit-scheme.git

Define hook for recording primitive profiling information.
---

diff --git a/v7/src/microcode/utils.c b/v7/src/microcode/utils.c
index 67db4380f..50d79ced3 100644
--- a/v7/src/microcode/utils.c
+++ b/v7/src/microcode/utils.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.24 1987/04/21 15:22:08 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.25 1987/04/29 15:50:43 cph Exp $ */
 
 /* This file contains utilities for interrupts, errors, etc. */
 
@@ -875,6 +875,39 @@ Apply_Primitive (Primitive_Number)
   }
   return Result;
 }
+#endif
+
+#ifdef ENABLE_PRIMITIVE_PROFILING
+
+/* The profiling mechanism is enabled by storing a cons of two vectors
+   in the fixed objects vector.  The car will record the profiling for
+   built-in primitives, and the cdr for user defined primitives.  Both
+   vectors should be initialized to contain all zeros. */
+
+void
+record_primitive_entry (primitive)
+     Pointer primitive;
+{
+  if ((Fixed_Objects != NIL) &&
+      ((Get_Fixed_Obj_Slot (Primitive_Profiling_Table)) != NIL))
+    {
+      Pointer table;
+      long index;
+
+      /* Test for TC_PRIMITIVE_EXTERNAL rather than TC_PRIMITIVE here
+	 because the compiled code interface will use 0 rather than
+	 TC_PRIMITIVE. */
+      table =
+	(Vector_Ref
+	 ((Get_Fixed_Obj_Slot (Primitive_Profiling_Table)),
+	  (((pointer_type (primitive)) == TC_PRIMITIVE_EXTERNAL) ? 1 : 0)));
+      index = (1 + (pointer_datum (primitive)));
+      Vector_Set (table, index,
+		  (Make_Unsigned_Fixnum
+		   (1 + (Get_Integer (Vector_Ref (table, index))))));
+    }
+}
+
 #endif
 
 Pointer