0.9.18.16: disassembly of funcallable instances

 * Pull out the funcallable-instance-fun using %FUN-FUN.
 * Test.

diff --git a/NEWS b/NEWS
index d753a76..18b34db 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,7 @@ changes in sbcl-0.9.19 (1.0.0?) relative to sbcl-0.9.18:
   * bug fix: ADJUST-ARRAY :FILL-POINTER T on an array without a
     fill-pointer signals a type-error as required. (thanks to
     Lars Brinkhoff)
+  * bug fix: disassemly of funcallable instances works.
   * improvements to the Windows port:
     ** floating point exceptions are now reported correctly.
     ** stack exhaustion detection works partially.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 00d63e5..f611f8b 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1132,8 +1132,11 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "%DOUBLE-FLOAT" "%DPB" "%EQL" "%EXP" "%EXPM1" "%FIND-POSITION"
                "%FIND-POSITION-VECTOR-MACRO" "%FIND-POSITION-IF"
                "%FIND-POSITION-IF-VECTOR-MACRO" "%FIND-POSITION-IF-NOT"
-               "%FIND-POSITION-IF-NOT-VECTOR-MACRO" "%FUN-DOC"
-               "%FUN-NAME" "%HYPOT" "%LDB" "%LOG" "%LOGB" "%LOG10"
+               "%FIND-POSITION-IF-NOT-VECTOR-MACRO"
+               "%FUN-DOC"
+               "%FUN-FUN"
+               "%FUN-NAME"
+               "%HYPOT" "%LDB" "%LOG" "%LOGB" "%LOG10"
                "%LOG1P"
                #!+long-float "%LONG-FLOAT"
                "%MAKE-COMPLEX" "%MAKE-FUNCALLABLE-INSTANCE"

diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 805c1c6..3339a73 100644 (file)
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -280,7 +280,7 @@
 
 (defun fun-self (fun)
   (declare (type compiled-function fun))
-  (sb!kernel:%simple-fun-self fun))
+  (sb!kernel:%simple-fun-self (sb!kernel:%fun-fun fun)))
 
 (defun fun-code (fun)
   (declare (type compiled-function fun))
@@ -288,17 +288,11 @@
 
 (defun fun-next (fun)
   (declare (type compiled-function fun))
-  (sb!kernel:%simple-fun-next fun))
+  (sb!kernel:%simple-fun-next (sb!kernel:%fun-fun fun)))
 
 (defun fun-address (fun)
   (declare (type compiled-function fun))
-  (ecase (sb!kernel:widetag-of fun)
-    (#.sb!vm:simple-fun-header-widetag
-     (- (sb!kernel:get-lisp-obj-address fun) sb!vm:fun-pointer-lowtag))
-    (#.sb!vm:closure-header-widetag
-     (fun-address (sb!kernel:%closure-fun fun)))
-    (#.sb!vm:funcallable-instance-header-widetag
-     (fun-address (sb!kernel:funcallable-instance-fun fun)))))
+  (- (sb!kernel:get-lisp-obj-address (sb!kernel:%fun-fun fun)) sb!vm:fun-pointer-lowtag))
 
 ;;; the offset of FUNCTION from the start of its code-component's
 ;;; instruction area

diff --git a/tests/interface.impure.lisp b/tests/interface.impure.lisp
index 1914816..3c21d5f 100644 (file)
--- a/tests/interface.impure.lisp
+++ b/tests/interface.impure.lisp
@@ -47,6 +47,12 @@
   ;; it is first compiled but the result of this implicit compilation
   ;; is not installed.)"
   (assert (sb-eval:interpreted-function-p #'disassemble-eval)))
+
+;; nor should it fail on generic functions or other funcallable instances
+(defgeneric disassemble-generic (x))
+(disassemble 'disassemble-generic)
+(let ((fin (sb-mop:make-instance 'sb-mop:funcallable-standard-object)))
+  (disassemble fin))
 \f
 ;;; support for DESCRIBE tests
 (defstruct to-be-described a b)

diff --git a/version.lisp-expr b/version.lisp-expr
index 7d46731..2334483 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.18.15"
+"0.9.18.16"