From 5a280b56627a028518c72a840dbbd0f1ed3d6449 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 5 Jun 1987 16:25:42 +0000
Subject: [PATCH] Change definition and name of compiler address operations so
 that they work on all kinds of compiled code addresses.

---
 v7/src/microcode/comutl.c   | 12 +++++++-----
 v7/src/microcode/utabmd.scm |  6 +++---
 v8/src/microcode/utabmd.scm |  6 +++---
 3 files changed, 13 insertions(+), 11 deletions(-)

diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c
index 709340813..ad10b978a 100644
--- a/v7/src/microcode/comutl.c
+++ b/v7/src/microcode/comutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.1 1987/06/04 00:07:18 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.2 1987/06/05 16:25:22 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -38,16 +38,18 @@ MIT in each case. */
 #include "primitive.h"
 #include "gccode.h"
 
-#define RETURN_ADDRESS_P(object)					\
-  ((OBJECT_TYPE (object)) == TC_RETURN_ADDRESS)
+#define COMPILED_CODE_ADDRESS_P(object)					\
+  (((OBJECT_TYPE (object)) == TC_COMPILED_EXPRESSION) ||		\
+   ((OBJECT_TYPE (object)) == TC_RETURN_ADDRESS))
 
-Built_In_Primitive (Prim_return_address_block, 1, "RETURN-ADDRESS-BLOCK", 0xB5)
+Built_In_Primitive (Prim_compiled_code_address_block, 1,
+		    "COMPILED-CODE-ADDRESS-BLOCK", 0xB5)
 {
   Pointer *address;
   Primitive_1_Arg ();
 
 #ifdef CMPGCFILE
-  CHECK_ARG (1, RETURN_ADDRESS_P);
+  CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
   address = (Get_Pointer (Arg1));
   return (Make_Pointer (TC_VECTOR, (Get_Compiled_Block (address))));
 #else /* not CMPGCFILE */
diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm
index cbaac97d9..e65f3b07e 100644
--- a/v7/src/microcode/utabmd.scm
+++ b/v7/src/microcode/utabmd.scm
@@ -37,7 +37,7 @@
 
 ;;;; Machine Dependent Type Tables
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.32 1987/06/03 20:59:23 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.33 1987/06/05 16:25:42 cph Exp $
 
 (declare (usual-integrations))
 
@@ -509,7 +509,7 @@
 	       DEBUGGING-PRINTER			;$B2
 	       STRING-UPCASE     			;$B3
 	       PRIMITIVE-PURIFY				;$B4
-	       RETURN-ADDRESS-BLOCK			;$B5
+	       COMPILED-CODE-ADDRESS->BLOCK		;$B5
 	       COMPLETE-GARBAGE-COLLECT			;$B6
 	       DUMP-BAND				;$B7
 	       SUBSTRING-SEARCH				;$B8
@@ -863,4 +863,4 @@
 
 ;;; This identification string is saved by the system.
 
-"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.32 1987/06/03 20:59:23 cph Exp $"
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.33 1987/06/05 16:25:42 cph Exp $"
diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm
index 1b56d15a3..313b78096 100644
--- a/v8/src/microcode/utabmd.scm
+++ b/v8/src/microcode/utabmd.scm
@@ -37,7 +37,7 @@
 
 ;;;; Machine Dependent Type Tables
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.32 1987/06/03 20:59:23 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.33 1987/06/05 16:25:42 cph Exp $
 
 (declare (usual-integrations))
 
@@ -509,7 +509,7 @@
 	       DEBUGGING-PRINTER			;$B2
 	       STRING-UPCASE     			;$B3
 	       PRIMITIVE-PURIFY				;$B4
-	       RETURN-ADDRESS-BLOCK			;$B5
+	       COMPILED-CODE-ADDRESS->BLOCK		;$B5
 	       COMPLETE-GARBAGE-COLLECT			;$B6
 	       DUMP-BAND				;$B7
 	       SUBSTRING-SEARCH				;$B8
@@ -863,4 +863,4 @@
 
 ;;; This identification string is saved by the system.
 
-"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.32 1987/06/03 20:59:23 cph Exp $"
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.33 1987/06/05 16:25:42 cph Exp $"
-- 
2.25.1