From 2063c1c13530ea18bf93cfaedb03bab755ea8970 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 30 Oct 2006 08:11:49 +0000 Subject: [PATCH] 0.9.18.16: disassembly of funcallable instances * Pull out the funcallable-instance-fun using %FUN-FUN. * Test. --- NEWS | 1 + package-data-list.lisp-expr | 7 +++++-- src/compiler/target-disassem.lisp | 12 +++--------- tests/interface.impure.lisp | 6 ++++++ version.lisp-expr | 2 +- 5 files changed, 16 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index d753a76..18b34db 100644 --- 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 --- 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 --- 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 --- 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)) ;;; support for DESCRIBE tests (defstruct to-be-described a b) diff --git a/version.lisp-expr b/version.lisp-expr index 7d46731..2334483 100644 --- 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" -- 1.7.10.4