X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Ftarget-insts.lisp;h=916971a919d991c7253feb0250aa47bb9984e575;hb=0d871fd7a98fc4af92a8b942a1154761466ad8c9;hp=aef6243ae3a77bc5a2316842cb58e1743eab825e;hpb=cbfed0be5a1ef9dc723ce3d08b511182fdab51a7;p=sbcl.git diff --git a/src/compiler/x86-64/target-insts.lisp b/src/compiler/x86-64/target-insts.lisp index aef6243..916971a 100644 --- a/src/compiler/x86-64/target-insts.lisp +++ b/src/compiler/x86-64/target-insts.lisp @@ -15,60 +15,68 @@ (in-package "SB!VM") -(defun print-mem-access (value stream print-size-p dstate) +;;; Prints a memory reference to STREAM. VALUE is a list of +;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component may be +;;; missing or nil to indicate that it's not used or has the obvious +;;; default value (e.g., 1 for the index-scale). BASE-REG can be the +;;; symbol RIP or a full register, INDEX-REG a full register. If WIDTH +;;; is non-nil it should be one of the symbols :BYTE, :WORD, :DWORD or +;;; :QWORD and a corresponding size indicator is printed first. +(defun print-mem-access (value width stream dstate) (declare (type list value) - (type stream stream) - (type (member t nil) print-size-p) - (type sb!disassem:disassem-state dstate)) - (when print-size-p - (princ (sb!disassem:dstate-get-prop dstate 'width) stream) + (type (member nil :byte :word :dword :qword) width) + (type stream stream) + (type sb!disassem:disassem-state dstate)) + (when width + (princ width stream) (princ '| PTR | stream)) (write-char #\[ stream) (let ((firstp t) (rip-p nil)) (macrolet ((pel ((var val) &body body) - ;; Print an element of the address, maybe with - ;; a leading separator. - `(let ((,var ,val)) - (when ,var - (unless firstp - (write-char #\+ stream)) - ,@body - (setq firstp nil))))) + ;; Print an element of the address, maybe with + ;; a leading separator. + `(let ((,var ,val)) + (when ,var + (unless firstp + (write-char #\+ stream)) + ,@body + (setq firstp nil))))) (pel (base-reg (first value)) - (cond ((eql 'rip base-reg) - (setf rip-p t) - (princ base-reg stream)) - (t - (print-addr-reg base-reg stream dstate)))) + (cond ((eql 'rip base-reg) + (setf rip-p t) + (princ base-reg stream)) + (t + (print-addr-reg base-reg stream dstate)))) (pel (index-reg (third value)) - (print-addr-reg index-reg stream dstate) - (let ((index-scale (fourth value))) - (when (and index-scale (not (= index-scale 1))) - (write-char #\* stream) - (princ index-scale stream)))) + (print-addr-reg index-reg stream dstate) + (let ((index-scale (fourth value))) + (when (and index-scale (not (= index-scale 1))) + (write-char #\* stream) + (princ index-scale stream)))) (let ((offset (second value))) - (when (and offset (or firstp (not (zerop offset)))) - (unless (or firstp (minusp offset)) - (write-char #\+ stream)) - (cond - (rip-p - (princ offset stream) - (let ((addr (+ offset (sb!disassem:dstate-next-addr dstate)))) - (or (nth-value 1 - (sb!disassem::note-code-constant-absolute - addr dstate)) - (sb!disassem:maybe-note-assembler-routine addr - nil - dstate)))) - (firstp - (progn - (sb!disassem:princ16 offset stream) - (or (minusp offset) - (nth-value 1 - (sb!disassem::note-code-constant-absolute offset dstate)) - (sb!disassem:maybe-note-assembler-routine offset - nil - dstate)))) - (t - (princ offset stream))))))) + (when (and offset (or firstp (not (zerop offset)))) + (unless (or firstp (minusp offset)) + (write-char #\+ stream)) + (cond + (rip-p + (princ offset stream) + (let ((addr (+ offset (sb!disassem:dstate-next-addr dstate)))) + (when (plusp addr) + (or (nth-value 1 + (sb!disassem::note-code-constant-absolute + addr dstate)) + (sb!disassem:maybe-note-assembler-routine addr + nil + dstate))))) + (firstp + (progn + (sb!disassem:princ16 offset stream) + (or (minusp offset) + (nth-value 1 + (sb!disassem::note-code-constant-absolute offset dstate)) + (sb!disassem:maybe-note-assembler-routine offset + nil + dstate)))) + (t + (princ offset stream))))))) (write-char #\] stream))