From: Alastair Bridgewater <nyef@arisu.lisphacker.com>
Date: Wed, 9 Nov 2011 16:48:19 +0000 (-0500)
Subject: gencgc: Make MAKE-LISP-OBJ of SIMPLE-FUN object addresses work.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=597c0a46f50ff957a017a2934fde5978096596d9;p=sbcl.git

gencgc: Make MAKE-LISP-OBJ of SIMPLE-FUN object addresses work.

  * This turned out to be a bug in the gencgc guts,
looks_like_valid_lisp_pointer_p() was doing pointer arithmetic
when it should have been converting the pointer to an integer.
---

diff --git a/NEWS b/NEWS
index 9c29c28..ff33e74 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,8 @@ changes relative to sbcl-1.0.53:
     correctly, even on wide-fixnum builds. (lp#887220)
   * bug fix: (directory "foo/*/*.*") did not follow symlinks in foo/ that
     resolved to directories.
+  * bug fix: SB-KERNEL:MAKE-LISP-OBJ on GENCGC no longer categorically
+    refuses to create SIMPLE-FUN objects.
 
 changes in sbcl-1.0.53 relative to sbcl-1.0.52:
   * enhancement: on 64-bit targets, in src/compiler/generic/early-vm.lisp,
diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index ecced08..1023b6f 100644
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -2130,7 +2130,7 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
         case CODE_HEADER_WIDETAG:
           /* Make sure we actually point to a function in the code object,
            * as opposed to a random point there. */
-          if (SIMPLE_FUN_HEADER_WIDETAG==widetag_of(*(pointer-FUN_POINTER_LOWTAG)))
+          if (SIMPLE_FUN_HEADER_WIDETAG==widetag_of(*((lispobj *)(((unsigned long)pointer)-FUN_POINTER_LOWTAG))))
             return 1;
           else
             return 0;
diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp
index c3c5a3b..9d8c34b 100644
--- a/tests/debug.impure.lisp
+++ b/tests/debug.impure.lisp
@@ -563,5 +563,17 @@
 
 ;; unconditional, in case either previous left it enabled
 (disable-debugger)
+
+;;;; test some limitations of MAKE-LISP-OBJ
+
+;;; Older GENCGC systems had a bug in the pointer validation used by
+;;; MAKE-LISP-OBJ that made SIMPLE-FUN objects always fail to
+;;; validate.
+(with-test (:name (make-lisp-obj :simple-funs))
+  (sb-sys:without-gcing
+    (assert (eq #'identity
+                (sb-kernel:make-lisp-obj
+                 (sb-kernel:get-lisp-obj-address
+                  #'identity))))))
 
 (write-line "/debug.impure.lisp done")