Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24532

Modified Files: image.lisp Log Message: Added movitz-disassemble-method, and use it in movitz-mode.el.

Date: Sun Aug 21 14:11:48 2005 Author: ffjeld

Index: movitz/image.lisp diff -u movitz/image.lisp:1.102 movitz/image.lisp:1.103 --- movitz/image.lisp:1.102 Sat Aug 20 22:31:05 2005 +++ movitz/image.lisp Sun Aug 21 14:11:41 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.102 2005/08/20 20:31:05 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.103 2005/08/21 12:11:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -1299,6 +1299,26 @@ (assert funobj (module) "No load funobj found for module ~S." module) (movitz-disassemble-funobj funobj :name module))) + +(defun movitz-disassemble-method (name lambda-list &optional qualifiers) + (let* ((gf (or (movitz-env-named-function name) + (error "No function named ~S." name))) + (specializing-lambda-list + (subseq lambda-list 0 + (position-if (lambda (x) + (and (symbolp x) + (char= #& (char (string x) 0)))) + lambda-list))) + (specializers (mapcar #'muerte::find-specializer + (mapcar (lambda (x) + (if (consp x) + (second x) + 'muerte.cl::t)) + specializing-lambda-list))) + (method (muerte::movitz-find-method gf qualifiers specializers)) + (funobj (muerte::movitz-slot-value method 'muerte::function)) + (*print-base* 16)) + (movitz-disassemble-funobj funobj)))

(defparameter *recursive-disassemble-remember-funobjs* nil)