From 0b504d76fa759b32675e28ffadde7d9e2b9c45a7 Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Thu, 29 Jul 1993 07:02:52 +0000
Subject: [PATCH] Generalize hook/builtin information for use by trap recovery
 and PC sampling.

---
 v7/src/microcode/cmpauxmd/hppa.m4 |  85 +++++++--
 v7/src/microcode/cmpint.c         | 286 +++++++++++++++++++++++++++++-
 v7/src/microcode/cmpintmd/hppa.h  |  45 ++---
 v7/src/microcode/comutl.c         |  16 +-
 v7/src/microcode/unxutl/ymkfile   |  26 +--
 v7/src/microcode/uxtrap.c         |  94 +++++-----
 v7/src/microcode/uxtrap.h         |  13 +-
 v8/src/microcode/cmpauxmd/hppa.m4 |  85 +++++++--
 v8/src/microcode/cmpint.c         | 286 +++++++++++++++++++++++++++++-
 v8/src/microcode/cmpintmd/hppa.h  |  45 ++---
 10 files changed, 830 insertions(+), 151 deletions(-)

diff --git a/v7/src/microcode/cmpauxmd/hppa.m4 b/v7/src/microcode/cmpauxmd/hppa.m4
index c1bbfd697..4016dd9cf 100644
--- a/v7/src/microcode/cmpauxmd/hppa.m4
+++ b/v7/src/microcode/cmpauxmd/hppa.m4
@@ -1,6 +1,6 @@
 changecom(`;');;; -*-Midas-*-
 ;;;
-;;;	$Id: hppa.m4,v 1.28 1993/07/27 17:47:34 gjr Exp $
+;;;	$Id: hppa.m4,v 1.29 1993/07/29 07:02:17 gjr Exp $
 ;;;
 ;;;	Copyright (c) 1989-1993 Massachusetts Institute of Technology
 ;;;
@@ -732,6 +732,7 @@ generic_$1_fail					; ?? * ??, out of line
 	B	scheme_to_interface
 	LDI	HEX($2),28			; operation code")
 
+flonum_result
 unary_flonum_result
 	ADDI,TR	4,22,6				; ret. add. location
 
@@ -1110,33 +1111,90 @@ ep_interface_to_C
 
 interface_initialize
 	.PROC
-	.CALLINFO CALLER,FRAME=0
+	.CALLINFO CALLER,FRAME=4,SAVE_RP
 	.ENTRY
-	LDO	4(30),30			; Allocate stack slot
-	FSTWS	0,0(30)
-	LDW	0(30),22
+	STW	2,-20(0,30)			; Preserve return address
+	LDO	64(30),30			; Allocate stack frame
+	STW	3,-64(30)			; Preserve gr3
+	FSTWS	0,-4(30)
+	LDW	-4(30),22
 	LDI	30,21				; enable V, Z, O, U traps
 	OR	21,22,22
-	STW	22,0(30)
-	FLDWS	0(30),0
+	STW	22,-4(30)
+	FLDWS	-4(30),0
 						; Prepare entry points
-	BL	known_pc,28			; get pc
+	BL	known_pc,3			; get pc
 	NOP
 known_pc
 
-define(store_entry_point,"ADDIL	L'ep_$1-known_pc,28
+define(store_entry_point,"ADDIL	L'ep_$1-known_pc,3
 	LDO	R'ep_$1-known_pc(1),29
 	ADDIL	L'$1-$global$,27
 	STW	29,R'$1-$global$(1)")
 
 	store_entry_point(interface_to_scheme)
 	store_entry_point(interface_to_C)
-	store_entry_point(scheme_hooks_low)
-	store_entry_point(scheme_hooks_high)
+
+define(builtin,"ADDIL L'$1-known_pc,3
+	.CALL	ARGW0=GR
+	BL	declare_builtin,2
+	LDO	R'$1-known_pc(1),26")	
+
+	builtin(scheme_to_interface_ble)
+	builtin(ep_scheme_hooks_low)
+	builtin(store_closure_entry)
+	builtin(store_closure_code)
+	builtin(multiply_fixnum)
+	builtin(fixnum_quotient)
+	builtin(fixnum_remainder)
+	builtin(fixnum_lsh)
+	builtin(flonum_result)
+	builtin(generic_boolean_result)
+	builtin(generic_decrement)
+	builtin(generic_divide)
+	builtin(generic_equal)
+	builtin(generic_greater)
+	builtin(generic_increment)
+	builtin(generic_less)
+	builtin(generic_subtract)
+	builtin(generic_times)
+	builtin(generic_negative)
+	builtin(generic_plus)
+	builtin(generic_positive)
+	builtin(generic_zero)
+	builtin(shortcircuit_apply)
+	builtin(shortcircuit_apply_1)
+	builtin(shortcircuit_apply_2)
+	builtin(shortcircuit_apply_3)
+	builtin(shortcircuit_apply_4)
+	builtin(shortcircuit_apply_5)
+	builtin(shortcircuit_apply_6)
+	builtin(shortcircuit_apply_7)
+	builtin(shortcircuit_apply_8)
+	builtin(stack_and_interrupt_check)
+	builtin(invoke_primitive)
+	builtin(vector_cons)
+	builtin(string_allocate)
+	builtin(floating_vector_cons)
+	builtin(flonum_sin)
+	builtin(flonum_cos)
+	builtin(flonum_tan)
+	builtin(flonum_asin)
+	builtin(flonum_acos)
+	builtin(flonum_atan)
+	builtin(flonum_exp)
+	builtin(flonum_log)
+	builtin(flonum_truncate)
+	builtin(flonum_ceiling)
+	builtin(flonum_floor)
+	builtin(flonum_atan2)
+	builtin(ep_scheme_hooks_high)
 						; Return
+	LDW	-84(30),2			; Restore return address
+	LDW	-64(30),3			; Restore gr3
 	BV	0(2)
 	.EXIT
-	LDO	-4(30),30			; De-allocate stack slot
+	LDO	-64(30),30			; De-allocate stack frame
 	.PROCEND
 
 ;;;; Routine to flush some locations from the processor cache.
@@ -1372,6 +1430,7 @@ interface_limit
 	.SPACE	$TEXT$
 	.SUBSPA $CODE$
         .IMPORT $$remI,MILLICODE
+	.IMPORT declare_builtin,CODE
 	.IMPORT	sin,CODE
 	.IMPORT	cos,CODE
 	.IMPORT	tan,CODE
@@ -1394,7 +1453,5 @@ interface_limit
 	.EXPORT cache_flush_all,PRIV_LEV=3
 	.EXPORT ep_interface_to_C,PRIV_LEV=3
 	.EXPORT ep_interface_to_scheme,PRIV_LEV=3
-	.EXPORT ep_scheme_hooks_low,PRIV_LEV=3
-	.EXPORT ep_scheme_hooks_high,PRIV_LEV=3
 	.EXPORT	flonum_atan2,PRIV_LEV=3
 	.END
diff --git a/v7/src/microcode/cmpint.c b/v7/src/microcode/cmpint.c
index afb674673..9d562d25a 100644
--- a/v7/src/microcode/cmpint.c
+++ b/v7/src/microcode/cmpint.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: cmpint.c,v 1.58 1993/07/27 21:00:48 gjr Exp $
+$Id: cmpint.c,v 1.59 1993/07/29 07:02:47 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -2759,6 +2759,262 @@ utility_table_entry utility_table[] =
   UTE(comutil_apply_in_interpreter)		/* 0x3a */
   };
 
+/* Support for trap handling. */
+
+static void
+DEFUN_VOID (end_of_utils)
+{
+  return;
+}
+
+struct util_descriptor_s
+{
+  PTR pc;
+  char * name;
+};
+
+#ifdef __STDC__
+#  define UTLD(name)  { ((PTR) name), #name }
+#else
+/* Hope that this works. */
+#  define UTLD(name)  { ((PTR) name), "name" }
+#endif
+
+static
+struct util_descriptor_s utility_descriptor_table[] =
+{
+  UTLD(C_to_interface),
+  UTLD(open_gap),
+  UTLD(setup_lexpr_invocation),
+  UTLD(setup_compiled_invocation),
+  UTLD(enter_compiled_expression),
+  UTLD(apply_compiled_procedure),
+  UTLD(return_to_compiled_code),
+  UTLD(apply_compiled_from_primitive),
+  UTLD(comutil_return_to_interpreter),
+  UTLD(comutil_apply_in_interpreter),
+  UTLD(comutil_primitive_apply),
+  UTLD(comutil_primitive_lexpr_apply),
+  UTLD(comutil_apply),
+  UTLD(comutil_error),
+  UTLD(comutil_lexpr_apply),
+  UTLD(abort_link_cc_block),
+  UTLD(link_cc_block),
+  UTLD(comutil_link),
+  UTLD(comp_link_caches_restart),
+  UTLD(comutil_operator_apply_trap),
+  UTLD(comutil_operator_arity_trap),
+  UTLD(comutil_operator_entity_trap),
+  UTLD(comutil_operator_interpreted_trap),
+  UTLD(comutil_operator_lexpr_trap),
+  UTLD(comutil_operator_primitive_trap),
+  UTLD(comutil_operator_lookup_trap),
+  UTLD(comp_op_lookup_trap_restart),
+  UTLD(comutil_operator_1_0_trap),
+  UTLD(comutil_operator_2_1_trap),
+  UTLD(comutil_operator_2_0_trap),
+  UTLD(comutil_operator_3_2_trap),
+  UTLD(comutil_operator_3_1_trap),
+  UTLD(comutil_operator_3_0_trap),
+  UTLD(comutil_operator_4_3_trap),
+  UTLD(comutil_operator_4_2_trap),
+  UTLD(comutil_operator_4_1_trap),
+  UTLD(comutil_operator_4_0_trap),
+  UTLD(compiler_interrupt_common),
+  UTLD(comutil_interrupt_closure),
+  UTLD(comutil_interrupt_dlink),
+  UTLD(comutil_interrupt_procedure),
+  UTLD(comutil_interrupt_continuation),
+  UTLD(comutil_interrupt_ic_procedure),
+  UTLD(comp_interrupt_restart),
+
+  UTLD(comutil_assignment_trap),
+  UTLD(comp_assignment_trap_restart),
+  UTLD(comutil_cache_lookup_apply),
+  UTLD(comp_cache_lookup_apply_restart),
+  UTLD(comutil_lookup_trap),
+  UTLD(comp_lookup_trap_restart),
+  UTLD(comutil_safe_lookup_trap),
+  UTLD(comp_safe_lookup_trap_restart),
+  UTLD(comutil_unassigned_p_trap),
+  UTLD(comp_unassigned_p_trap_restart),
+  UTLD(comutil_decrement),
+  UTLD(comutil_divide),
+  UTLD(comutil_equal),
+  UTLD(comutil_greater),
+  UTLD(comutil_increment),
+  UTLD(comutil_less),
+  UTLD(comutil_minus),
+  UTLD(comutil_modulo),
+  UTLD(comutil_multiply),
+  UTLD(comutil_negative),
+  UTLD(comutil_plus),
+  UTLD(comutil_positive),
+  UTLD(comutil_quotient),
+  UTLD(comutil_remainder),
+  UTLD(comutil_zero),
+  UTLD(comutil_access),
+  UTLD(comp_access_restart),
+  UTLD(comutil_reference),
+  UTLD(comp_reference_restart),
+  UTLD(comutil_safe_reference),
+  UTLD(comp_safe_reference_restart),
+  UTLD(comutil_unassigned_p),
+  UTLD(comp_unassigned_p_restart),
+  UTLD(comutil_unbound_p),
+  UTLD(comp_unbound_p_restart),
+  UTLD(comutil_assignment),
+  UTLD(comp_assignment_restart),
+  UTLD(comutil_definition),
+  UTLD(comp_definition_restart),
+  UTLD(comutil_lookup_apply),
+  UTLD(comp_lookup_apply_restart),
+  UTLD(comutil_primitive_error),
+  UTLD(comp_error_restart),
+  UTLD(compiled_block_debugging_info),
+  UTLD(compiled_block_environment),
+  UTLD(compiled_entry_to_block_address),
+  UTLD(compiled_entry_to_block),
+  UTLD(compiled_entry_to_block_offset),
+  UTLD(block_address_closure_p),
+  UTLD(compiled_block_closure_p),
+  UTLD(compiled_entry_closure_p),
+  UTLD(compiled_closure_to_entry),
+  UTLD(compiled_entry_type),
+  UTLD(store_variable_cache),
+  UTLD(extract_variable_cache),
+  UTLD(extract_uuo_link),
+  UTLD(store_uuo_link),
+  UTLD(fill_trampoline),
+  UTLD(make_trampoline),
+  UTLD(make_redirection_trampoline),
+  UTLD(make_apply_trampoline),
+  UTLD(make_uuo_link),
+  UTLD(make_fake_uuo_link),
+  UTLD(coerce_to_compiled),
+  UTLD(end_of_utils)
+};
+
+extern char * EXFUN (utility_index_to_name, (int));
+extern int EXFUN (pc_to_utility_index, (unsigned long));
+
+#define UTIL_TABLE_PC_REF_REAL(index)					\
+  ((unsigned long) (utility_descriptor_table[index].pc))
+
+#ifndef UTIL_TABLE_PC_REF
+#  define UTIL_TABLE_PC_REF(index)	(UTIL_TABLE_PC_REF_REAL (index))
+#endif
+
+static int last_util_table_index =
+  (((sizeof (utility_descriptor_table)) / (sizeof (struct util_descriptor_s))) - 1);
+
+char *
+DEFUN (utility_index_to_name, (index), int index)
+{
+  if ((index < 0) || (index >= last_util_table_index))
+    return ((char *) NULL);
+  else
+    return (utility_descriptor_table[index].name);
+}
+
+int
+DEFUN (pc_to_utility_index, (pc), unsigned long pc)
+{
+  /* Binary search */
+
+  extern int EXFUN (pc_to_builtin_index, (unsigned long));
+
+  if ((pc < (UTIL_TABLE_PC_REF (0)))
+      || (pc >= (UTIL_TABLE_PC_REF (last_util_table_index))))
+    return (-1);
+  else if (pc < (UTIL_TABLE_PC_REF (1)))
+    return ((pc_to_builtin_index (pc)) ? -1 : 0);
+  else
+  {
+    int low, high, middle;
+
+    low = 0;
+    high = last_util_table_index;
+    while ((low + 1) < high)
+    {
+      middle = ((low + high) / 2);
+      if (pc < (UTIL_TABLE_PC_REF (middle)))
+	high = middle;
+      else if (pc > (UTIL_TABLE_PC_REF (middle)))
+	low = middle;
+      else
+	return (middle);
+    }
+    return ((pc == (UTIL_TABLE_PC_REF (high))) ? high : low);
+  }
+}
+
+extern void EXFUN (declare_builtin, (unsigned long));
+extern int EXFUN (pc_to_builtin_index, (unsigned long));
+extern unsigned long * builtins;
+
+static int n_builtins = 0;
+static int s_builtins = 0;
+unsigned long * builtins = ((unsigned long *) NULL);
+
+void
+DEFUN (declare_builtin, (builtin), unsigned long builtin)
+{
+  if (n_builtins == s_builtins)
+  {
+    if (s_builtins == 0)
+    {
+      s_builtins = 30;
+      builtins = ((unsigned long *)
+		  (malloc (s_builtins * (sizeof (unsigned long)))));
+    }
+    else
+    {
+      s_builtins += s_builtins;
+      builtins = ((unsigned long *)
+		  (realloc (builtins,
+			    (s_builtins * (sizeof (unsigned long))))));
+    }
+    if (builtins == ((unsigned long *) NULL))
+    {
+      outf_fatal ("declare_builtin: malloc/realloc failed (size = %d).\n",
+		  (s_builtins * (sizeof (unsigned long))));
+      termination_init_error ();
+    }
+  }
+  builtins[n_builtins++] = builtin;
+  return;
+}
+
+int
+DEFUN (pc_to_builtin_index, (pc), unsigned long pc)
+{
+  /* Binary search */
+
+  if ((builtins == ((unsigned long *) NULL))
+      || (pc < (builtins[0]))
+      || (pc >= (builtins[n_builtins - 1])))
+    return (-1);
+  else
+  {
+    int low, high, middle;
+
+    low = 0;
+    high = (n_builtins - 1);
+    while ((low + 1) < high)
+    {
+      middle = ((low + high) / 2);
+      if (pc < (builtins[middle]))
+	high = middle;
+      else if (pc > (builtins[middle]))
+	low = middle;
+      else
+	return (middle);
+    }
+    return ((pc == (builtins[high])) ? high : low);
+  }
+}
+
 /* Initialization */
 
 #define COMPILER_INTERFACE_VERSION		3
@@ -3196,6 +3452,34 @@ DEFUN (coerce_to_compiled,
   return (PRIM_DONE);
 }
 
+extern char * EXFUN (utility_index_to_name, (int));
+extern void EXFUN (declare_builtin, (unsigned long));
+extern int EXFUN (pc_to_utility_index, (unsigned long));
+extern int EXFUN (pc_to_builtin_index, (unsigned long));
+
+char *
+DEFUN (utility_index_to_name, (index), int index)
+{
+  return ((char *) NULL);
+}
+
+void
+DEFUN (declare_builtin, (builtin), unsigned long builtin)
+{
+  return;
+}
+
+int
+DEFUN (pc_to_utility_index, (pc), unsigned long pc)
+{
+  return (-1);
+}
+
+int
+DEFUN (pc_to_builtin_index, (pc), unsigned long pc)
+{
+  return (-1);
+}
 #endif	/* HAS_COMPILER_SUPPORT */
 
 #ifdef WINNT
diff --git a/v7/src/microcode/cmpintmd/hppa.h b/v7/src/microcode/cmpintmd/hppa.h
index 0415ac355..d94500c05 100644
--- a/v7/src/microcode/cmpintmd/hppa.h
+++ b/v7/src/microcode/cmpintmd/hppa.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: hppa.h,v 1.42 1993/06/30 03:35:47 gjr Exp $
+$Id: hppa.h,v 1.43 1993/07/29 07:02:09 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -446,12 +446,6 @@ DEFUN_VOID (flush_i_cache_initialize)
 
  */
 
-/* A NOP on machines where instructions are longword-aligned. */
-
-#define ADJUST_CLOSURE_AT_CALL(entry_point, location) do		\
-{									\
-} while (0)
-
 /* Compiled closures */
 
 /* Manifest closure entry block size.
@@ -738,6 +732,22 @@ DEFUN (assemble_17, (inst), union ble_inst inst)
   return off.value;
 }
 
+static unsigned long
+DEFUN (C_closure_entry_point, (closure), unsigned long C_closure)
+{
+  if ((C_closure & 0x3) == 0x2)
+  {
+    long offset;
+    char * blp = (* ((char **) (C_closure - 2)));
+
+    blp = ((char *) (((unsigned long) blp) & ~3));
+    offset = (assemble_17 (* ((union ble_inst *) blp)));
+    return ((unsigned long) ((blp + 8) + offset));
+  }
+  else
+    return (C_closure);
+}
+
 PTR *
 DEFUN (transform_procedure_table, (table_length, old_table),
        long table_length AND PTR * old_table)
@@ -754,21 +764,13 @@ DEFUN (transform_procedure_table, (table_length, old_table),
   }
 
   for (counter = 0; counter < table_length; counter++)
-  {
-    char * C_closure = ((char *) (old_table [counter]));
-    if ((((unsigned long) C_closure) & 0x3) == 0x2)
-    {
-      long offset;
-      char * blp = (* ((char **) (C_closure - 2)));
-      blp = ((char *) (((unsigned long) blp) & ~3));
-      offset = (assemble_17 (* ((union ble_inst *) blp)));
-      new_table[counter] = ((PTR) ((blp + 8) + offset));
-    }
-    else
-      new_table[counter] = ((PTR) (old_table [counter]));
-  }
+    new_table[counter] =
+      ((PTR) (C_closure_entry_point ((unsigned long) (old_table [counter]))));
   return (new_table);
 }
+
+#define UTIL_TABLE_PC_REF(index)					\
+  (C_closure_entry_point (UTIL_TABLE_PC_REF_REAL (index)))
 
 #ifdef _BSD4_3
 #  include <sys/mman.h>
@@ -817,8 +819,7 @@ DEFUN (hppa_reset_hook, (utility_length, utility_table,
        long utility_length AND PTR * utility_table
        AND long primitive_length AND PTR * primitive_table)
 {
-  extern void
-    EXFUN (interface_initialize, (void));
+  extern void EXFUN (interface_initialize, (void));
 
   flush_i_cache_initialize ();
   interface_initialize ();
diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c
index b1f5aaec0..b38ad1644 100644
--- a/v7/src/microcode/comutl.c
+++ b/v7/src/microcode/comutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: comutl.c,v 1.22 1993/06/09 20:34:39 jawilson Exp $
+$Id: comutl.c,v 1.23 1993/07/29 07:02:50 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -140,6 +140,20 @@ DEFINE_PRIMITIVE ("COMPILED-CLOSURE->ENTRY", Prim_compiled_closure_to_entry, 1,
   PRIMITIVE_RETURN (compiled_closure_to_entry (closure));
 }
 
+DEFINE_PRIMITIVE ("UTILITY-INDEX->NAME", Prim_utility_index_to_name, 1, 1,
+  "Given an integer, return the name of the corresponding compiled code utility.")
+{
+  extern char * EXFUN (utility_index_to_name, (int));
+  char * result;
+  PRIMITIVE_HEADER (1);
+
+  result = (utility_index_to_name (arg_integer (1)));
+  if (result == ((char *) NULL))
+    PRIMITIVE_RETURN (SHARP_F);
+  else
+    PRIMITIVE_RETURN (char_pointer_to_string ((unsigned char *) result));
+}
+
 /* This is only meaningful for the C back end. */
 
 DEFINE_PRIMITIVE ("INITIALIZE-C-COMPILED-BLOCK", Prim_initialize_C_compiled_block, 1, 1,
diff --git a/v7/src/microcode/unxutl/ymkfile b/v7/src/microcode/unxutl/ymkfile
index 5117140c2..18d3a966d 100644
--- a/v7/src/microcode/unxutl/ymkfile
+++ b/v7/src/microcode/unxutl/ymkfile
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: ymkfile,v 1.70 1993/06/24 22:26:22 gjr Exp $
+$Id: ymkfile,v 1.71 1993/07/29 07:01:26 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -187,8 +187,8 @@ GC_HEAD_FILES = gccode.h cmpgc.h
 #if (PROC_TYPE == PROC_TYPE_VAX)
 #define PROC_TYPE_KNOWN
 MACHINE_SWITCHES =
-MACHINE_SOURCES = cmpint.c cmpauxmd.m4
-MACHINE_OBJECTS = cmpint.o cmpauxmd.o
+MACHINE_SOURCES = cmpauxmd.m4 cmpint.c
+MACHINE_OBJECTS = cmpauxmd.o cmpint.o
 GC_HEAD_FILES = gccode.h cmpgc.h cmpintmd.h
 
 cmpauxmd.o : cmpauxmd.s
@@ -200,8 +200,8 @@ cmpauxmd.s : cmpauxmd.m4 xmkfile
 #define PROC_TYPE_KNOWN
 #undef hppa
 MACHINE_SWITCHES =
-MACHINE_SOURCES = cmpint.c cmpauxmd.m4
-MACHINE_OBJECTS = cmpint.o cmpauxmd.o
+MACHINE_SOURCES = cmpauxmd.m4 cmpint.c
+MACHINE_OBJECTS = cmpauxmd.o cmpint.o
 GC_HEAD_FILES = gccode.h cmpgc.h cmpintmd.h hppacach.h
 XTRA_TARGETS = hppacach
 
@@ -214,8 +214,8 @@ cmpauxmd.s : cmpauxmd.m4 xmkfile
 #define PROC_TYPE_KNOWN
 #undef mips
 MACHINE_SWITCHES =
-MACHINE_SOURCES = cmpint.c cmpauxmd.m4
-MACHINE_OBJECTS = cmpint.o cmpauxmd.o
+MACHINE_SOURCES = cmpauxmd.m4 cmpint.c
+MACHINE_OBJECTS = cmpauxmd.o cmpint.o
 GC_HEAD_FILES = gccode.h cmpgc.h cmpintmd.h
 
 cmpauxmd.o : cmpauxmd.s
@@ -227,8 +227,8 @@ cmpauxmd.s : cmpauxmd.m4 xmkfile
 #define PROC_TYPE_KNOWN
 #undef i386
 MACHINE_SWITCHES =
-MACHINE_SOURCES = cmpint.c cmpauxmd.m4
-MACHINE_OBJECTS = cmpint.o cmpauxmd.o
+MACHINE_SOURCES = cmpauxmd.m4 cmpint.c
+MACHINE_OBJECTS = cmpauxmd.o cmpint.o
 GC_HEAD_FILES = gccode.h cmpgc.h cmpintmd.h
 
 cmpauxmd.o : cmpauxmd.s
@@ -239,8 +239,8 @@ cmpauxmd.s : cmpauxmd.m4 xmkfile
 #if (PROC_TYPE == PROC_TYPE_ALPHA)
 #define PROC_TYPE_KNOWN
 MACHINE_SWITCHES =
-MACHINE_SOURCES = cmpint.c cmpauxmd.m4
-MACHINE_OBJECTS = cmpint.o cmpauxmd.o
+MACHINE_SOURCES = cmpauxmd.m4 cmpint.c
+MACHINE_OBJECTS = cmpauxmd.o cmpint.o
 GC_HEAD_FILES = gccode.h cmpgc.h cmpintmd.h
 
 cmpauxmd.o : cmpauxmd.s
@@ -256,8 +256,8 @@ cmpauxmd.s : cmpauxmd.m4 xmkfile
 COMPILED_OBJECTS = $(COMPILED_SOURCES:.c=.o)
 
 MACHINE_SWITCHES = -DNATIVE_CODE_IS_C
-MACHINE_SOURCES = cmpint.c cmpauxmd.c compinit.c $(COMPILED_SOURCES)
-MACHINE_OBJECTS = cmpint.o cmpauxmd.o compinit.o $(COMPILED_OBJECTS)
+MACHINE_SOURCES = cmpauxmd.c cmpint.c compinit.c $(COMPILED_SOURCES)
+MACHINE_OBJECTS = cmpauxmd.o cmpint.o compinit.o $(COMPILED_OBJECTS)
 GC_HEAD_FILES = gccode.h cmpgc.h cmpintmd.h
 LIARC_HEAD_FILES = \
 ansidecl.h \
diff --git a/v7/src/microcode/uxtrap.c b/v7/src/microcode/uxtrap.c
index ba84a0d3f..978f2d388 100644
--- a/v7/src/microcode/uxtrap.c
+++ b/v7/src/microcode/uxtrap.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: uxtrap.c,v 1.21 1993/03/16 21:36:10 gjr Exp $
+$Id: uxtrap.c,v 1.22 1993/07/29 07:02:51 gjr Exp $
 
 Copyright (c) 1990-1993 Massachusetts Institute of Technology
 
@@ -481,21 +481,24 @@ static SCHEME_OBJECT * EXFUN
 #if !(defined (_HPUX) && (_HPUX_VERSION >= 80) && defined (hp9000s300))
 extern long etext;
 #endif
-#define get_etext() (&etext)
+#  define get_etext() (&etext)
 #endif
-
+
 static void
 DEFUN (continue_from_trap, (signo, info, scp),
        int signo AND
        SIGINFO_T info AND
        struct FULL_SIGCONTEXT * scp)
 {
-  int pc_in_hook;
+  int pc_in_builtin;
+  int builtin_index;
   int pc_in_C;
   int pc_in_heap;
   int pc_in_constant_space;
   int pc_in_scheme;
   int pc_in_hyper_space;
+  int pc_in_utility;
+  int utility_index;
   int scheme_sp_valid;
   long C_sp = (FULL_SIGCONTEXT_SP (scp));
   long scheme_sp = (FULL_SIGCONTEXT_SCHSP (scp));
@@ -503,24 +506,13 @@ DEFUN (continue_from_trap, (signo, info, scp),
   SCHEME_OBJECT * new_stack_pointer;
   SCHEME_OBJECT * xtra_info;
   struct trap_recovery_info trinfo;
-
-#if FALSE
-  fprintf (stderr, "\ncontinue_from_trap:");
-  fprintf (stderr, "\tpc = 0x%08lx\n", the_pc);
-  fprintf (stderr, "\tCsp = 0x%08lx\n", C_sp);
-  fprintf (stderr, "\tssp = 0x%08lx\n", scheme_sp);
-  fprintf (stderr, "\tesp = 0x%08lx\n", Ext_Stack_Pointer);
-#ifdef hp9000s800
-  {
-    fprintf (stderr, "\tscheme_hooks_low = 0x%08lx\n", scheme_hooks_low);
-    fprintf (stderr, "\tscheme_hooks_high = 0x%08lx\n", scheme_hooks_high);
-  }
-#endif
-#endif
+  extern int EXFUN (pc_to_utility_index, (unsigned long));
+  extern int EXFUN (pc_to_builtin_index, (unsigned long));
 
   if ((the_pc & PC_ALIGNMENT_MASK) != 0)
   {
-    pc_in_hook = 0;
+    pc_in_builtin = 0;
+    pc_in_utility = 0;
     pc_in_C = 0;
     pc_in_heap = 0;
     pc_in_constant_space = 0;
@@ -529,14 +521,17 @@ DEFUN (continue_from_trap, (signo, info, scp),
   }
   else
   {
-    pc_in_hook = (PC_HOOK_P (the_pc));
-    pc_in_C = ((the_pc <= ((long) (get_etext ()))) && (!pc_in_hook));
+    builtin_index = (pc_to_builtin_index (the_pc));
+    pc_in_builtin = (builtin_index != -1);
+    utility_index = (pc_to_utility_index (the_pc));
+    pc_in_utility = (utility_index != -1);    
+    pc_in_C = ((the_pc <= ((long) (get_etext ()))) && (!pc_in_builtin));
     pc_in_heap =
       ((the_pc < ((long) Heap_Top)) && (the_pc >= ((long) Heap_Bottom)));
     pc_in_constant_space =
       ((the_pc < ((long) Constant_Top)) &&
        (the_pc >= ((long) Constant_Space)));
-    pc_in_scheme = (pc_in_heap || pc_in_constant_space || pc_in_hook);
+    pc_in_scheme = (pc_in_heap || pc_in_constant_space || pc_in_builtin);
     pc_in_hyper_space = ((!pc_in_C) && (!pc_in_scheme));
   }
 
@@ -553,7 +548,7 @@ DEFUN (continue_from_trap, (signo, info, scp),
 	&& (Stack_Pointer > Absolute_Stack_Base))
      ? Stack_Pointer
      : ((SCHEME_OBJECT *) 0));
-
+
   if (pc_in_hyper_space || (pc_in_scheme && ALLOW_ONLY_C))
   {
     /* In hyper space. */
@@ -564,9 +559,7 @@ DEFUN (continue_from_trap, (signo, info, scp),
     if ((Free < MemTop) ||
 	(Free >= Heap_Top) ||
 	((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
-    {
       Free = MemTop;
-    }
   }
   else if (pc_in_scheme)
   {
@@ -574,17 +567,11 @@ DEFUN (continue_from_trap, (signo, info, scp),
     SCHEME_OBJECT * block_addr;
     SCHEME_OBJECT * maybe_free;
     block_addr =
-      (pc_in_hook
+      (pc_in_builtin
        ? ((SCHEME_OBJECT *) NULL)
        : (find_block_address (((PTR) the_pc),
 			      (pc_in_heap ? Heap_Bottom : Constant_Space))));
-    if (block_addr == ((SCHEME_OBJECT *) NULL))
-    {
-      (trinfo . state) = STATE_PROBABLY_COMPILED;
-      (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (the_pc));
-      (trinfo . pc_info_2) = SHARP_F;
-    }
-    else
+    if (block_addr != ((SCHEME_OBJECT *) NULL))
     {
       (trinfo . state) = STATE_COMPILED_CODE;
       (trinfo . pc_info_1) =
@@ -592,8 +579,20 @@ DEFUN (continue_from_trap, (signo, info, scp),
       (trinfo . pc_info_2) =
 	(LONG_TO_UNSIGNED_FIXNUM (the_pc - ((long) block_addr)));
     }
-    if ((block_addr == ((SCHEME_OBJECT *) NULL))
-	&& (! pc_in_hook))
+    else if (pc_in_builtin)
+    {
+      (trinfo . state) = STATE_PROBABLY_COMPILED;
+      (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (builtin_index));
+      (trinfo . pc_info_2) = SHARP_T;
+    }
+    else 
+    {
+      (trinfo . state) = STATE_PROBABLY_COMPILED;
+      (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (the_pc));
+      (trinfo . pc_info_2) = SHARP_F;
+    }
+
+    if ((block_addr == ((SCHEME_OBJECT *) NULL)) && (! pc_in_builtin))
     {
       if ((Free < MemTop) ||
 	  (Free >= Heap_Top) ||
@@ -606,25 +605,28 @@ DEFUN (continue_from_trap, (signo, info, scp),
       maybe_free = ((SCHEME_OBJECT *) (FULL_SIGCONTEXT_RFREE (scp)));
       if (((((unsigned long) maybe_free) & SCHEME_ALIGNMENT_MASK) == 0)
 	  && (maybe_free >= Heap_Bottom) && (maybe_free < Heap_Top))
-      {
 	Free = (maybe_free + FREE_PARANOIA_MARGIN);
-      }
       else
 #endif
-      {
 	if ((Free < MemTop) || (Free >= Heap_Top)
 	    || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
 	  Free = MemTop;
-      }
     }
   }
-  else
+
+  else /* pc_in_C */
   {
     /* In the interpreter, a primitive, or a compiled code utility. */
 
     SCHEME_OBJECT primitive = (Regs[REGBLOCK_PRIMITIVE]);
 
-    if ((OBJECT_TYPE (primitive)) != TC_PRIMITIVE)
+    if (pc_in_utility)
+    {
+      (trinfo . state) = STATE_PROBABLY_COMPILED;
+      (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (utility_index));
+      (trinfo . pc_info_2) = UNSPECIFIC;
+    }
+    else if ((OBJECT_TYPE (primitive)) != TC_PRIMITIVE)
     {
       (trinfo . state) = STATE_UNKNOWN;
       (trinfo . pc_info_1) = SHARP_F;
@@ -644,13 +646,9 @@ DEFUN (continue_from_trap, (signo, info, scp),
 	|| ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0)
 	|| ((Free < Heap_Bottom) || (Free >= Heap_Top))
 	|| ((Free < MemTop) && ((Free + FREE_PARANOIA_MARGIN) >= MemTop)))
-    {
       Free = MemTop;
-    }
     else if ((Free + FREE_PARANOIA_MARGIN) < MemTop)
-    {
       Free +=  FREE_PARANOIA_MARGIN;
-    }
   }
   xtra_info = Free;
   Free += (1 + 2 + PROCESSOR_NREGS);
@@ -664,20 +662,14 @@ DEFUN (continue_from_trap, (signo, info, scp),
     int counter = FULL_SIGCONTEXT_NREGS;
     long * regs = ((long *) (FULL_SIGCONTEXT_FIRST_REG (scp)));
     while ((counter--) > 0)
-    {
       (*xtra_info++) = ((SCHEME_OBJECT) (*regs++));
-    }
   }
   /* We assume that regs,sp,pc is the order in the processor.
      Scheme can always fix this. */
   if ((PROCESSOR_NREGS - FULL_SIGCONTEXT_NREGS) > 0)
-  {
     (*xtra_info++) = ((SCHEME_OBJECT) C_sp);
-  }
   if ((PROCESSOR_NREGS - FULL_SIGCONTEXT_NREGS) > 1)
-  {
     (*xtra_info++) = ((SCHEME_OBJECT) the_pc);
-  }
   setup_trap_frame (signo, info, scp, (&trinfo), new_stack_pointer);
 }
 
diff --git a/v7/src/microcode/uxtrap.h b/v7/src/microcode/uxtrap.h
index 405fe6cd7..1d1dfd959 100644
--- a/v7/src/microcode/uxtrap.h
+++ b/v7/src/microcode/uxtrap.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: uxtrap.h,v 1.19 1993/03/16 21:36:16 gjr Exp $
+$Id: uxtrap.h,v 1.20 1993/07/29 07:02:52 gjr Exp $
 
 Copyright (c) 1990-1993 Massachusetts Institute of Technology
 
@@ -96,13 +96,6 @@ MIT in each case. */
 
 #define PC_VALUE_MASK			((~0) << 2)
 
-/* Pseudo-compiled code in assembly language. */
-
-extern void * scheme_hooks_low, * scheme_hooks_high;
-#define PC_HOOK_P(pc)							\
-  ((((void *) (pc)) >= scheme_hooks_low)				\
-   && (((void *) (pc)) < scheme_hooks_high))
-
 /* pcoq is the offset (32 bit in 64 bit virtual address space)
    in the space included in the corresponding sc_pcsq.
    head is the current instruction, tail is the next instruction
@@ -526,10 +519,6 @@ struct full_sigcontext
 #ifndef INITIALIZE_UX_SIGNAL_CODES
 #define INITIALIZE_UX_SIGNAL_CODES()
 #endif
-
-#ifndef PC_HOOK_P
-#define PC_HOOK_P(pc) 0
-#endif
 
 enum trap_state
 {
diff --git a/v8/src/microcode/cmpauxmd/hppa.m4 b/v8/src/microcode/cmpauxmd/hppa.m4
index c1bbfd697..4016dd9cf 100644
--- a/v8/src/microcode/cmpauxmd/hppa.m4
+++ b/v8/src/microcode/cmpauxmd/hppa.m4
@@ -1,6 +1,6 @@
 changecom(`;');;; -*-Midas-*-
 ;;;
-;;;	$Id: hppa.m4,v 1.28 1993/07/27 17:47:34 gjr Exp $
+;;;	$Id: hppa.m4,v 1.29 1993/07/29 07:02:17 gjr Exp $
 ;;;
 ;;;	Copyright (c) 1989-1993 Massachusetts Institute of Technology
 ;;;
@@ -732,6 +732,7 @@ generic_$1_fail					; ?? * ??, out of line
 	B	scheme_to_interface
 	LDI	HEX($2),28			; operation code")
 
+flonum_result
 unary_flonum_result
 	ADDI,TR	4,22,6				; ret. add. location
 
@@ -1110,33 +1111,90 @@ ep_interface_to_C
 
 interface_initialize
 	.PROC
-	.CALLINFO CALLER,FRAME=0
+	.CALLINFO CALLER,FRAME=4,SAVE_RP
 	.ENTRY
-	LDO	4(30),30			; Allocate stack slot
-	FSTWS	0,0(30)
-	LDW	0(30),22
+	STW	2,-20(0,30)			; Preserve return address
+	LDO	64(30),30			; Allocate stack frame
+	STW	3,-64(30)			; Preserve gr3
+	FSTWS	0,-4(30)
+	LDW	-4(30),22
 	LDI	30,21				; enable V, Z, O, U traps
 	OR	21,22,22
-	STW	22,0(30)
-	FLDWS	0(30),0
+	STW	22,-4(30)
+	FLDWS	-4(30),0
 						; Prepare entry points
-	BL	known_pc,28			; get pc
+	BL	known_pc,3			; get pc
 	NOP
 known_pc
 
-define(store_entry_point,"ADDIL	L'ep_$1-known_pc,28
+define(store_entry_point,"ADDIL	L'ep_$1-known_pc,3
 	LDO	R'ep_$1-known_pc(1),29
 	ADDIL	L'$1-$global$,27
 	STW	29,R'$1-$global$(1)")
 
 	store_entry_point(interface_to_scheme)
 	store_entry_point(interface_to_C)
-	store_entry_point(scheme_hooks_low)
-	store_entry_point(scheme_hooks_high)
+
+define(builtin,"ADDIL L'$1-known_pc,3
+	.CALL	ARGW0=GR
+	BL	declare_builtin,2
+	LDO	R'$1-known_pc(1),26")	
+
+	builtin(scheme_to_interface_ble)
+	builtin(ep_scheme_hooks_low)
+	builtin(store_closure_entry)
+	builtin(store_closure_code)
+	builtin(multiply_fixnum)
+	builtin(fixnum_quotient)
+	builtin(fixnum_remainder)
+	builtin(fixnum_lsh)
+	builtin(flonum_result)
+	builtin(generic_boolean_result)
+	builtin(generic_decrement)
+	builtin(generic_divide)
+	builtin(generic_equal)
+	builtin(generic_greater)
+	builtin(generic_increment)
+	builtin(generic_less)
+	builtin(generic_subtract)
+	builtin(generic_times)
+	builtin(generic_negative)
+	builtin(generic_plus)
+	builtin(generic_positive)
+	builtin(generic_zero)
+	builtin(shortcircuit_apply)
+	builtin(shortcircuit_apply_1)
+	builtin(shortcircuit_apply_2)
+	builtin(shortcircuit_apply_3)
+	builtin(shortcircuit_apply_4)
+	builtin(shortcircuit_apply_5)
+	builtin(shortcircuit_apply_6)
+	builtin(shortcircuit_apply_7)
+	builtin(shortcircuit_apply_8)
+	builtin(stack_and_interrupt_check)
+	builtin(invoke_primitive)
+	builtin(vector_cons)
+	builtin(string_allocate)
+	builtin(floating_vector_cons)
+	builtin(flonum_sin)
+	builtin(flonum_cos)
+	builtin(flonum_tan)
+	builtin(flonum_asin)
+	builtin(flonum_acos)
+	builtin(flonum_atan)
+	builtin(flonum_exp)
+	builtin(flonum_log)
+	builtin(flonum_truncate)
+	builtin(flonum_ceiling)
+	builtin(flonum_floor)
+	builtin(flonum_atan2)
+	builtin(ep_scheme_hooks_high)
 						; Return
+	LDW	-84(30),2			; Restore return address
+	LDW	-64(30),3			; Restore gr3
 	BV	0(2)
 	.EXIT
-	LDO	-4(30),30			; De-allocate stack slot
+	LDO	-64(30),30			; De-allocate stack frame
 	.PROCEND
 
 ;;;; Routine to flush some locations from the processor cache.
@@ -1372,6 +1430,7 @@ interface_limit
 	.SPACE	$TEXT$
 	.SUBSPA $CODE$
         .IMPORT $$remI,MILLICODE
+	.IMPORT declare_builtin,CODE
 	.IMPORT	sin,CODE
 	.IMPORT	cos,CODE
 	.IMPORT	tan,CODE
@@ -1394,7 +1453,5 @@ interface_limit
 	.EXPORT cache_flush_all,PRIV_LEV=3
 	.EXPORT ep_interface_to_C,PRIV_LEV=3
 	.EXPORT ep_interface_to_scheme,PRIV_LEV=3
-	.EXPORT ep_scheme_hooks_low,PRIV_LEV=3
-	.EXPORT ep_scheme_hooks_high,PRIV_LEV=3
 	.EXPORT	flonum_atan2,PRIV_LEV=3
 	.END
diff --git a/v8/src/microcode/cmpint.c b/v8/src/microcode/cmpint.c
index afb674673..9d562d25a 100644
--- a/v8/src/microcode/cmpint.c
+++ b/v8/src/microcode/cmpint.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: cmpint.c,v 1.58 1993/07/27 21:00:48 gjr Exp $
+$Id: cmpint.c,v 1.59 1993/07/29 07:02:47 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -2759,6 +2759,262 @@ utility_table_entry utility_table[] =
   UTE(comutil_apply_in_interpreter)		/* 0x3a */
   };
 
+/* Support for trap handling. */
+
+static void
+DEFUN_VOID (end_of_utils)
+{
+  return;
+}
+
+struct util_descriptor_s
+{
+  PTR pc;
+  char * name;
+};
+
+#ifdef __STDC__
+#  define UTLD(name)  { ((PTR) name), #name }
+#else
+/* Hope that this works. */
+#  define UTLD(name)  { ((PTR) name), "name" }
+#endif
+
+static
+struct util_descriptor_s utility_descriptor_table[] =
+{
+  UTLD(C_to_interface),
+  UTLD(open_gap),
+  UTLD(setup_lexpr_invocation),
+  UTLD(setup_compiled_invocation),
+  UTLD(enter_compiled_expression),
+  UTLD(apply_compiled_procedure),
+  UTLD(return_to_compiled_code),
+  UTLD(apply_compiled_from_primitive),
+  UTLD(comutil_return_to_interpreter),
+  UTLD(comutil_apply_in_interpreter),
+  UTLD(comutil_primitive_apply),
+  UTLD(comutil_primitive_lexpr_apply),
+  UTLD(comutil_apply),
+  UTLD(comutil_error),
+  UTLD(comutil_lexpr_apply),
+  UTLD(abort_link_cc_block),
+  UTLD(link_cc_block),
+  UTLD(comutil_link),
+  UTLD(comp_link_caches_restart),
+  UTLD(comutil_operator_apply_trap),
+  UTLD(comutil_operator_arity_trap),
+  UTLD(comutil_operator_entity_trap),
+  UTLD(comutil_operator_interpreted_trap),
+  UTLD(comutil_operator_lexpr_trap),
+  UTLD(comutil_operator_primitive_trap),
+  UTLD(comutil_operator_lookup_trap),
+  UTLD(comp_op_lookup_trap_restart),
+  UTLD(comutil_operator_1_0_trap),
+  UTLD(comutil_operator_2_1_trap),
+  UTLD(comutil_operator_2_0_trap),
+  UTLD(comutil_operator_3_2_trap),
+  UTLD(comutil_operator_3_1_trap),
+  UTLD(comutil_operator_3_0_trap),
+  UTLD(comutil_operator_4_3_trap),
+  UTLD(comutil_operator_4_2_trap),
+  UTLD(comutil_operator_4_1_trap),
+  UTLD(comutil_operator_4_0_trap),
+  UTLD(compiler_interrupt_common),
+  UTLD(comutil_interrupt_closure),
+  UTLD(comutil_interrupt_dlink),
+  UTLD(comutil_interrupt_procedure),
+  UTLD(comutil_interrupt_continuation),
+  UTLD(comutil_interrupt_ic_procedure),
+  UTLD(comp_interrupt_restart),
+
+  UTLD(comutil_assignment_trap),
+  UTLD(comp_assignment_trap_restart),
+  UTLD(comutil_cache_lookup_apply),
+  UTLD(comp_cache_lookup_apply_restart),
+  UTLD(comutil_lookup_trap),
+  UTLD(comp_lookup_trap_restart),
+  UTLD(comutil_safe_lookup_trap),
+  UTLD(comp_safe_lookup_trap_restart),
+  UTLD(comutil_unassigned_p_trap),
+  UTLD(comp_unassigned_p_trap_restart),
+  UTLD(comutil_decrement),
+  UTLD(comutil_divide),
+  UTLD(comutil_equal),
+  UTLD(comutil_greater),
+  UTLD(comutil_increment),
+  UTLD(comutil_less),
+  UTLD(comutil_minus),
+  UTLD(comutil_modulo),
+  UTLD(comutil_multiply),
+  UTLD(comutil_negative),
+  UTLD(comutil_plus),
+  UTLD(comutil_positive),
+  UTLD(comutil_quotient),
+  UTLD(comutil_remainder),
+  UTLD(comutil_zero),
+  UTLD(comutil_access),
+  UTLD(comp_access_restart),
+  UTLD(comutil_reference),
+  UTLD(comp_reference_restart),
+  UTLD(comutil_safe_reference),
+  UTLD(comp_safe_reference_restart),
+  UTLD(comutil_unassigned_p),
+  UTLD(comp_unassigned_p_restart),
+  UTLD(comutil_unbound_p),
+  UTLD(comp_unbound_p_restart),
+  UTLD(comutil_assignment),
+  UTLD(comp_assignment_restart),
+  UTLD(comutil_definition),
+  UTLD(comp_definition_restart),
+  UTLD(comutil_lookup_apply),
+  UTLD(comp_lookup_apply_restart),
+  UTLD(comutil_primitive_error),
+  UTLD(comp_error_restart),
+  UTLD(compiled_block_debugging_info),
+  UTLD(compiled_block_environment),
+  UTLD(compiled_entry_to_block_address),
+  UTLD(compiled_entry_to_block),
+  UTLD(compiled_entry_to_block_offset),
+  UTLD(block_address_closure_p),
+  UTLD(compiled_block_closure_p),
+  UTLD(compiled_entry_closure_p),
+  UTLD(compiled_closure_to_entry),
+  UTLD(compiled_entry_type),
+  UTLD(store_variable_cache),
+  UTLD(extract_variable_cache),
+  UTLD(extract_uuo_link),
+  UTLD(store_uuo_link),
+  UTLD(fill_trampoline),
+  UTLD(make_trampoline),
+  UTLD(make_redirection_trampoline),
+  UTLD(make_apply_trampoline),
+  UTLD(make_uuo_link),
+  UTLD(make_fake_uuo_link),
+  UTLD(coerce_to_compiled),
+  UTLD(end_of_utils)
+};
+
+extern char * EXFUN (utility_index_to_name, (int));
+extern int EXFUN (pc_to_utility_index, (unsigned long));
+
+#define UTIL_TABLE_PC_REF_REAL(index)					\
+  ((unsigned long) (utility_descriptor_table[index].pc))
+
+#ifndef UTIL_TABLE_PC_REF
+#  define UTIL_TABLE_PC_REF(index)	(UTIL_TABLE_PC_REF_REAL (index))
+#endif
+
+static int last_util_table_index =
+  (((sizeof (utility_descriptor_table)) / (sizeof (struct util_descriptor_s))) - 1);
+
+char *
+DEFUN (utility_index_to_name, (index), int index)
+{
+  if ((index < 0) || (index >= last_util_table_index))
+    return ((char *) NULL);
+  else
+    return (utility_descriptor_table[index].name);
+}
+
+int
+DEFUN (pc_to_utility_index, (pc), unsigned long pc)
+{
+  /* Binary search */
+
+  extern int EXFUN (pc_to_builtin_index, (unsigned long));
+
+  if ((pc < (UTIL_TABLE_PC_REF (0)))
+      || (pc >= (UTIL_TABLE_PC_REF (last_util_table_index))))
+    return (-1);
+  else if (pc < (UTIL_TABLE_PC_REF (1)))
+    return ((pc_to_builtin_index (pc)) ? -1 : 0);
+  else
+  {
+    int low, high, middle;
+
+    low = 0;
+    high = last_util_table_index;
+    while ((low + 1) < high)
+    {
+      middle = ((low + high) / 2);
+      if (pc < (UTIL_TABLE_PC_REF (middle)))
+	high = middle;
+      else if (pc > (UTIL_TABLE_PC_REF (middle)))
+	low = middle;
+      else
+	return (middle);
+    }
+    return ((pc == (UTIL_TABLE_PC_REF (high))) ? high : low);
+  }
+}
+
+extern void EXFUN (declare_builtin, (unsigned long));
+extern int EXFUN (pc_to_builtin_index, (unsigned long));
+extern unsigned long * builtins;
+
+static int n_builtins = 0;
+static int s_builtins = 0;
+unsigned long * builtins = ((unsigned long *) NULL);
+
+void
+DEFUN (declare_builtin, (builtin), unsigned long builtin)
+{
+  if (n_builtins == s_builtins)
+  {
+    if (s_builtins == 0)
+    {
+      s_builtins = 30;
+      builtins = ((unsigned long *)
+		  (malloc (s_builtins * (sizeof (unsigned long)))));
+    }
+    else
+    {
+      s_builtins += s_builtins;
+      builtins = ((unsigned long *)
+		  (realloc (builtins,
+			    (s_builtins * (sizeof (unsigned long))))));
+    }
+    if (builtins == ((unsigned long *) NULL))
+    {
+      outf_fatal ("declare_builtin: malloc/realloc failed (size = %d).\n",
+		  (s_builtins * (sizeof (unsigned long))));
+      termination_init_error ();
+    }
+  }
+  builtins[n_builtins++] = builtin;
+  return;
+}
+
+int
+DEFUN (pc_to_builtin_index, (pc), unsigned long pc)
+{
+  /* Binary search */
+
+  if ((builtins == ((unsigned long *) NULL))
+      || (pc < (builtins[0]))
+      || (pc >= (builtins[n_builtins - 1])))
+    return (-1);
+  else
+  {
+    int low, high, middle;
+
+    low = 0;
+    high = (n_builtins - 1);
+    while ((low + 1) < high)
+    {
+      middle = ((low + high) / 2);
+      if (pc < (builtins[middle]))
+	high = middle;
+      else if (pc > (builtins[middle]))
+	low = middle;
+      else
+	return (middle);
+    }
+    return ((pc == (builtins[high])) ? high : low);
+  }
+}
+
 /* Initialization */
 
 #define COMPILER_INTERFACE_VERSION		3
@@ -3196,6 +3452,34 @@ DEFUN (coerce_to_compiled,
   return (PRIM_DONE);
 }
 
+extern char * EXFUN (utility_index_to_name, (int));
+extern void EXFUN (declare_builtin, (unsigned long));
+extern int EXFUN (pc_to_utility_index, (unsigned long));
+extern int EXFUN (pc_to_builtin_index, (unsigned long));
+
+char *
+DEFUN (utility_index_to_name, (index), int index)
+{
+  return ((char *) NULL);
+}
+
+void
+DEFUN (declare_builtin, (builtin), unsigned long builtin)
+{
+  return;
+}
+
+int
+DEFUN (pc_to_utility_index, (pc), unsigned long pc)
+{
+  return (-1);
+}
+
+int
+DEFUN (pc_to_builtin_index, (pc), unsigned long pc)
+{
+  return (-1);
+}
 #endif	/* HAS_COMPILER_SUPPORT */
 
 #ifdef WINNT
diff --git a/v8/src/microcode/cmpintmd/hppa.h b/v8/src/microcode/cmpintmd/hppa.h
index 0415ac355..d94500c05 100644
--- a/v8/src/microcode/cmpintmd/hppa.h
+++ b/v8/src/microcode/cmpintmd/hppa.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: hppa.h,v 1.42 1993/06/30 03:35:47 gjr Exp $
+$Id: hppa.h,v 1.43 1993/07/29 07:02:09 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -446,12 +446,6 @@ DEFUN_VOID (flush_i_cache_initialize)
 
  */
 
-/* A NOP on machines where instructions are longword-aligned. */
-
-#define ADJUST_CLOSURE_AT_CALL(entry_point, location) do		\
-{									\
-} while (0)
-
 /* Compiled closures */
 
 /* Manifest closure entry block size.
@@ -738,6 +732,22 @@ DEFUN (assemble_17, (inst), union ble_inst inst)
   return off.value;
 }
 
+static unsigned long
+DEFUN (C_closure_entry_point, (closure), unsigned long C_closure)
+{
+  if ((C_closure & 0x3) == 0x2)
+  {
+    long offset;
+    char * blp = (* ((char **) (C_closure - 2)));
+
+    blp = ((char *) (((unsigned long) blp) & ~3));
+    offset = (assemble_17 (* ((union ble_inst *) blp)));
+    return ((unsigned long) ((blp + 8) + offset));
+  }
+  else
+    return (C_closure);
+}
+
 PTR *
 DEFUN (transform_procedure_table, (table_length, old_table),
        long table_length AND PTR * old_table)
@@ -754,21 +764,13 @@ DEFUN (transform_procedure_table, (table_length, old_table),
   }
 
   for (counter = 0; counter < table_length; counter++)
-  {
-    char * C_closure = ((char *) (old_table [counter]));
-    if ((((unsigned long) C_closure) & 0x3) == 0x2)
-    {
-      long offset;
-      char * blp = (* ((char **) (C_closure - 2)));
-      blp = ((char *) (((unsigned long) blp) & ~3));
-      offset = (assemble_17 (* ((union ble_inst *) blp)));
-      new_table[counter] = ((PTR) ((blp + 8) + offset));
-    }
-    else
-      new_table[counter] = ((PTR) (old_table [counter]));
-  }
+    new_table[counter] =
+      ((PTR) (C_closure_entry_point ((unsigned long) (old_table [counter]))));
   return (new_table);
 }
+
+#define UTIL_TABLE_PC_REF(index)					\
+  (C_closure_entry_point (UTIL_TABLE_PC_REF_REAL (index)))
 
 #ifdef _BSD4_3
 #  include <sys/mman.h>
@@ -817,8 +819,7 @@ DEFUN (hppa_reset_hook, (utility_length, utility_table,
        long utility_length AND PTR * utility_table
        AND long primitive_length AND PTR * primitive_table)
 {
-  extern void
-    EXFUN (interface_initialize, (void));
+  extern void EXFUN (interface_initialize, (void));
 
   flush_i_cache_initialize ();
   interface_initialize ();
-- 
2.25.1