Ignore:
Timestamp:
Sep 16, 2009, 6:33:00 PM (10 years ago)
Author:
gz
Message:

Make the gui inspector show function disassembly. Extend the inspector protocol to support this a little better. Fix a number of bugs in closing and method inspectors.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/x86-disassemble.lisp

    r12838 r12846  
    28982898     nil)
    28992899    (instructions)))
     2900
     2901(defun x86-disassembled-instruction-line (ds instruction function &optional string-stream)
     2902  (if (null string-stream)
     2903    (with-output-to-string (stream)
     2904      (return-from x86-disassembled-instruction-line
     2905                   (x86-disassembled-instruction-line ds instruction function stream)))
     2906    (let* ((addr (x86-di-address instruction))
     2907           (entry (x86-ds-entry-point ds))
     2908           (pc (- addr entry))
     2909           (op0 (x86-di-op0 instruction))
     2910           (op1 (x86-di-op1 instruction))
     2911           (op2 (x86-di-op2 instruction))
     2912           (label (if (x86-di-labeled instruction) (list :label pc) pc))
     2913           (instr (progn
     2914                    (dolist (p (x86-di-prefixes instruction))
     2915                      (format string-stream "(~a) " p))
     2916                    (format string-stream "(~a" (x86-di-mnemonic instruction))
     2917                    (when op0 (write-x86-lap-operand string-stream op0 ds))
     2918                    (when op1 (write-x86-lap-operand string-stream op1 ds))
     2919                    (when op2 (write-x86-lap-operand string-stream op2 ds))
     2920                    (format string-stream ")")
     2921                    (get-output-stream-string string-stream)))
     2922           (comment (let ((source-note (find-source-note-at-pc function pc)))
     2923                      (unless (eql (source-note-file-range source-note)
     2924                                   (source-note-file-range *previous-source-note*))
     2925                        (setf *previous-source-note* source-note)
     2926                        (let* ((source-text (source-note-text source-note))
     2927                               (text (if source-text
     2928                                       (string-sans-most-whitespace source-text 100)
     2929                                       "#<no source text>")))
     2930                          (format string-stream ";;; ~A" text)
     2931                          (get-output-stream-string string-stream)))))
     2932           (imms (let ((imms nil))
     2933                   (multiple-value-bind (imm foundp) (x86-lap-operand-constant op2 ds)
     2934                     (when foundp (push imm imms)))
     2935                   (multiple-value-bind (imm foundp) (x86-lap-operand-constant op1 ds)
     2936                     (when foundp (push imm imms)))
     2937                   (multiple-value-bind (imm foundp) (x86-lap-operand-constant op0 ds)
     2938                     (when foundp (push imm imms)))
     2939                   imms)))
     2940      ;; Subtle difference between no imms and a single NIL imm, so if anybody ever
     2941      ;; cares for some reason, they could distinguish the two cases.
     2942      (if imms
     2943        (values comment label instr (if (cdr imms) (coerce imms 'vector) (car imms)))
     2944        (values comment label instr)))))
     2945
     2946(defun disassemble-lines (function)
     2947  (let ((source-note (function-source-note function)))
     2948    (when source-note
     2949      ;; Fetch source from file if don't already have it.
     2950      (ensure-source-note-text source-note)))
     2951  (let ((lines (make-array 20 :adjustable t :fill-pointer 0)))
     2952    (with-output-to-string (stream)
     2953      (x86-xdisassemble
     2954       function
     2955       #'(lambda (ds instruction seq function)
     2956           (declare (ignore seq))
     2957           (multiple-value-bind (comment label instr object)
     2958                                (x86-disassembled-instruction-line ds instruction function stream)
     2959             (when comment
     2960               (vector-push-extend comment lines))
     2961             (vector-push-extend (list object label instr) lines)))
     2962       nil))
     2963    (coerce lines 'simple-vector)))
Note: See TracChangeset for help on using the changeset viewer.