From babbc32835be2bcaedba61caba054f6b6ccab6fa Mon Sep 17 00:00:00 2001 From: Lutz Euler Date: Wed, 5 Dec 2012 00:06:23 +0100 Subject: [PATCH] Fix printing of prefix instructions during disassembly. During disassembly of assembler segments (which happens when compiling with SB-C::*COMPILER-TRACE-OUTPUT* set) sometimes instruction prefixes like x86-64's REX would be printed wrongly. Fix this by tying them tighter to the following instruction in SEGMENT-OVERFLOW and modifying MAP-SEGMENT-INSTRUCTIONS to optionally stop mapping only after a non-prefix instruction. Add a predicate for prefix instructions to avoid code duplication. Rename a related constant to adhere to current naming conventions. Fixes lp#1085729. --- src/compiler/target-disassem.lisp | 73 ++++++++++++++++++++++++++----------- 1 files changed, 51 insertions(+), 22 deletions(-) diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index b1f09cc..0c8599a 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -498,20 +498,36 @@ (defun handle-bogus-instruction (stream dstate prefix-len) (print-bytes (+ prefix-len alignment) stream dstate)) (incf (dstate-next-offs dstate) alignment))) +;;; Return non-NIL if INST is a prefix instruction, meaning that it +;;; prints on the same line as the following instruction. +;;; Prefix instructions are used on x86[-64] to implement prefixes like +;;; FS, LOCK and REX without making the instruction space explode +;;; combinatorically. They are distinguished from normal instructions by +;;; having an INST-PRINTER of NIL. They can be made invisible by setting +;;; their INST-PRINT-NAME to NIL, which is suitable for REX, for +;;; example. +(defun prefix-instruction-p (inst) + (null (inst-printer inst))) + ;;; Iterate through the instructions in SEGMENT, calling FUNCTION for ;;; each instruction, with arguments of CHUNK, STREAM, and DSTATE. ;;; Additionally, unless STREAM is NIL, several items are output to it: ;;; things printed from several hooks, for example labels, and instruction ;;; bytes before FUNCTION is called, notes and a newline afterwards. -;;; Instructions having an INST-PRINTER of NIL are treated as prefix -;;; instructions which makes them print on the same line as the following +;;; Prefix instructions are printed on the same line as the following ;;; instruction, outputting their INST-PRINT-NAME (unless that is NIL) -;;; before FUNCTION is called for the following instruction. -(defun map-segment-instructions (function segment dstate &optional stream) +;;; before FUNCTION is called for the following instruction. If +;;; OVERSHOOT-WHILE-PREFIX is given and the last instruction in SEGMENT +;;; is a prefix instruction the iteration continues by at most this +;;; amount of bytes beyond the end of SEGMENT until a non-prefix +;;; instruction is encountered. +(defun map-segment-instructions (function segment dstate + &optional stream overshoot-while-prefix) (declare (type function function) (type segment segment) (type disassem-state dstate) - (type (or null stream) stream)) + (type (or null stream) stream) + (type (or null (integer 0)) overshoot-while-prefix)) (let ((ispace (get-inst-space)) (prefix-p nil) ; just processed a prefix inst @@ -522,7 +538,10 @@ (defun map-segment-instructions (function segment dstate &optional stream) (loop (when (>= (dstate-cur-offs dstate) - (seg-length (dstate-segment dstate))) + (if (and prefix-p overshoot-while-prefix) + (+ (seg-length (dstate-segment dstate)) + overshoot-while-prefix) + (seg-length (dstate-segment dstate)))) ;; done! (when (and stream (> prefix-len 0)) (pad-inst-column stream prefix-len) @@ -565,7 +584,7 @@ (defun map-segment-instructions (function segment dstate &optional stream) (when prefilter (funcall prefilter chunk dstate)) - (setf prefix-p (null (inst-printer inst))) + (setf prefix-p (prefix-instruction-p inst)) (when stream ;; Print any instruction bytes recognized by @@ -1365,20 +1384,36 @@ (defun get-code-segments (code (make-code-segment code start-offset length) (nreverse segments)))) +;;; the maximum size of an instruction. Note that this includes +;;; pseudo-instructions like error traps with their associated +;;; operands, so it should be big enough to include them, i.e. it's +;;; not just 4 on a risc machine! Also, it includes instruction prefixes +;;; like for example LOCK or FS as used on x86[-64]. +(defconstant +max-instruction-size+ 16) + ;;; Return two values: the amount by which the last instruction in the ;;; segment goes past the end of the segment, and the offset of the ;;; end of the segment from the beginning of that instruction. If all -;;; instructions fit perfectly, return 0 and 0. +;;; instructions fit perfectly, return 0 and 0. Prefix instructions are +;;; treated as an inseparable part of the following instruction here, +;;; that is, to calculate the second return value the beginning of the +;;; first prefix instruction belonging to the last instruction is used. (defun segment-overflow (segment dstate) (declare (type segment segment) (type disassem-state dstate)) (let ((seglen (seg-length segment)) - (last-start 0)) + (last-start 0) + previous-prefix-p) (map-segment-instructions (lambda (chunk inst) - (declare (ignore chunk inst)) - (setf last-start (dstate-cur-offs dstate))) + (declare (ignore chunk)) + (unless previous-prefix-p + (setf last-start (dstate-cur-offs dstate))) + (setf previous-prefix-p + (prefix-instruction-p inst))) segment - dstate) + dstate + nil + +max-instruction-size+) (values (- (dstate-cur-offs dstate) seglen) (- seglen last-start)))) @@ -1560,12 +1595,6 @@ (defun disassemble-code-component (code-component &key ;;; code for making useful segments from arbitrary lists of code-blocks -;;; the maximum size of an instruction. Note that this includes -;;; pseudo-instructions like error traps with their associated -;;; operands, so it should be big enough to include them, i.e. it's -;;; not just 4 on a risc machine! -(defconstant max-instruction-size 16) - (defun add-block-segments (seg-code-block seglist location @@ -1586,7 +1615,7 @@ (defun add-block-segments (seg-code-block (when connecting-vec ;; Tack on some of the new block to the old overflow vector. (let* ((beginning-of-block-amount - (if seg-code-block (min max-instruction-size amount) 0)) + (if seg-code-block (min +max-instruction-size+ amount) 0)) (connecting-vec (if seg-code-block (concatenate @@ -1594,7 +1623,7 @@ (defun add-block-segments (seg-code-block connecting-vec (subseq seg-code-block 0 beginning-of-block-amount)) connecting-vec))) - (when (and (< (length connecting-vec) max-instruction-size) + (when (and (< (length connecting-vec) +max-instruction-size+) (not (null seg-code-block))) (return-from add-block-segments ;; We want connecting vectors to be large enough to hold @@ -1615,7 +1644,7 @@ (defun add-block-segments (seg-code-block (cond ((null seg-code-block) ;; nothing more to add (values seglist location nil)) - ((< (- amount connecting-overflow) max-instruction-size) + ((< (- amount connecting-overflow) +max-instruction-size+) ;; We can't create a segment with the minimum size ;; required for an instruction, so just keep on accumulating ;; in the overflow vector for the time-being. @@ -1626,7 +1655,7 @@ (defun add-block-segments (seg-code-block ;; Put as much as we can into a new segment, and the rest ;; into the overflow-vector. (let* ((initial-length - (- amount connecting-overflow max-instruction-size)) + (- amount connecting-overflow +max-instruction-size+)) (seg (make-vector-segment seg-code-block connecting-overflow -- 1.7.4.1