From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Thu, 27 Jul 1995 00:37:51 +0000 (+0000)
Subject: Implement INSTRUCTION-ADDRESS->COMPILED-CODE-BLOCK.
X-Git-Tag: 20090517-FFI~6127
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a9c21bc3d6d8687014d415e1b6c8d1085818ab46;p=mit-scheme.git

Implement INSTRUCTION-ADDRESS->COMPILED-CODE-BLOCK.
---

diff --git a/v7/src/microcode/pruxenv.c b/v7/src/microcode/pruxenv.c
index 5daed32a9..1b151dc4c 100644
--- a/v7/src/microcode/pruxenv.c
+++ b/v7/src/microcode/pruxenv.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: pruxenv.c,v 1.15 1993/11/06 21:21:12 cph Exp $
+$Id: pruxenv.c,v 1.16 1995/07/27 00:37:51 adams Exp $
 
-Copyright (c) 1990-1993 Massachusetts Institute of Technology
+Copyright (c) 1990-1995 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -249,3 +249,18 @@ DEFINE_PRIMITIVE ("HOSTNAME", Prim_hostname, 0, 0,
 #endif
   }
 }
+
+
+
+
+DEFINE_PRIMITIVE ("INSTRUCTION-ADDRESS->COMPILED-CODE-BLOCK",
+		  Prim_instruction_address_to_compiled_code_block, 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  {
+      extern SCHEME_OBJECT find_ccblock();
+      long the_pc = (long) OBJECT_ADDRESS(ARG_REF(1));
+      PRIMITIVE_RETURN (find_ccblock(the_pc));
+  }
+}
+