From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Tue, 15 Jul 1997 22:31:53 +0000 (+0000)
Subject: Fixed the trap debugging primitive
X-Git-Tag: 20090517-FFI~5053
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2cbaa0f37008b6c7cb51177c0d8029d5d5acd28c;p=mit-scheme.git

Fixed the trap debugging primitive
INSTRUCTION-ADDRESS->COMPILED-CODE-BLOCK to handle integer arguments
correctly.
---

diff --git a/v7/src/microcode/pruxenv.c b/v7/src/microcode/pruxenv.c
index 1b151dc4c..55de6d7ed 100644
--- a/v7/src/microcode/pruxenv.c
+++ b/v7/src/microcode/pruxenv.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: pruxenv.c,v 1.16 1995/07/27 00:37:51 adams Exp $
+$Id: pruxenv.c,v 1.17 1997/07/15 22:31:53 adams Exp $
 
 Copyright (c) 1990-1995 Massachusetts Institute of Technology
 
@@ -258,9 +258,11 @@ DEFINE_PRIMITIVE ("INSTRUCTION-ADDRESS->COMPILED-CODE-BLOCK",
 {
   PRIMITIVE_HEADER (1);
   {
-      extern SCHEME_OBJECT find_ccblock();
-      long the_pc = (long) OBJECT_ADDRESS(ARG_REF(1));
-      PRIMITIVE_RETURN (find_ccblock(the_pc));
+      extern SCHEME_OBJECT find_ccblock(long);
+      long the_pc = (INTEGER_P (ARG_REF (1)))
+	? (integer_to_long (ARG_REF (1)))
+	: ((long) OBJECT_ADDRESS (ARG_REF (1)));
+      PRIMITIVE_RETURN (find_ccblock (the_pc));
   }
 }