Commit 0bdeec6a authored by Frode Vatvedt Fjeld's avatar Frode Vatvedt Fjeld

Added movitz-disassemble-method, and use it in movitz-mode.el.

parent ed5234d9
......@@ -9,7 +9,7 @@
;;;; Created at: Sun Oct 22 00:22:43 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
;;;; $Id: image.lisp,v 1.101 2005/05/21 22:38:39 ffjeld Exp $
;;;; $Id: image.lisp,v 1.102 2005/08/20 20:31:05 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -1300,6 +1300,26 @@ In sum this accounts for ~,1F%, or ~D bytes.~%;;~%"
"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)
(defun movitz-disassemble-funobj (funobj &key (name (movitz-funobj-name funobj)) ((:image *image*) *image*)
......
......@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef@acm.org>
;;;; Created at: Thu Sep 27 18:12:17 2001
;;;;
;;;; $Id: movitz-mode.el,v 1.8 2004/11/30 14:16:18 ffjeld Exp $
;;;; $Id: movitz-mode.el,v 1.9 2005/04/30 21:19:42 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -107,9 +107,10 @@
(dont-run-bochs-p
(message "Dumping Movitz image...done. Bootblock ID: %d. Running qemu.."
(fi:eval-in-lisp "movitz::*bootblock-build*"))
(call-process "/bin/sh" nil 0 nil "-c"
(format "DISPLAY=\"%s\" cd ~/clnet/movitz && qemu -fda los0-image -boot a"
display-shortcut)))
;; (call-process "/bin/sh" nil 0 nil "-c"
;; (format "DISPLAY=\"%s\" cd ~/clnet/movitz && qemu -fda los0-image -boot a"
;; display-shortcut))
)
(t (message "Dumping Movitz image...done. Bootblock ID: %d. Running bochs on \"%s\"..."
(fi:eval-in-lisp "movitz::*bootblock-build*")
display-shortcut)
......@@ -212,25 +213,13 @@
((string= "method" defun-type)
(message "Movitz disassembling %s %s %s..." defun-type defun-name lambda-list)
(fi:eval-in-lisp
"(cl:let* ((method-name (cl:let ((cl:*package* (cl:find-package :%s)))
"(cl:let* ((gf-name (cl:let ((cl:*package* (cl:find-package :%s)))
(cl:read-from-string \"%s\")))
(gf (movitz::movitz-env-named-function method-name))
(qualifiers (cl:read-from-string \"%s\"))
(lambda-list (cl:let ((cl:*package* (cl:find-package :%s)))
(cl:read-from-string \"%s\")))
(specializing-lambda-list
(cl:subseq lambda-list 0
(cl:position-if (cl:lambda (x)
(cl:and (cl:symbolp x)
(cl:char= #\\& (cl:char (cl:string x) 0))))
lambda-list)))
(specializers (cl:mapcar #'muerte::find-specializer
(cl:mapcar (cl:lambda (x) (cl:if (cl:consp x) (cl:second x) 'muerte.cl:t))
specializing-lambda-list)))
(method (muerte::movitz-find-method gf qualifiers specializers))
(funobj (muerte::movitz-slot-value method 'muerte::function))
(cl:*print-base* 16))
(movitz::movitz-disassemble-funobj funobj))"
(movitz::movitz-disassemble-method gf-name lambda-list qualifiers))"
fi:package defun-name options fi:package lambda-list)
(switch-to-buffer "*common-lisp*")
(message "Movitz disassembling %s %s...done." defun-type defun-name))
......@@ -312,6 +301,7 @@
(put 'with-inline-assembly tag '(like prog))
(put 'with-inline-assembly-case tag '(like prog))
(put 'do-case tag '(like prog))
(put 'select tag '(like case))
(put 'compiler-typecase tag '(like case)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment