X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=4179980b60c100e3297b36fee14b49df08719e05;hb=0e7a9105ae992fc4befa37846c42f298e12918c0;hp=73ca2effaf1fad05e43d77e7cdaf00b0dd54d0d5;hpb=46dddbfef93ef40af0119978063bf87738dc733d;p=sbcl.git diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 73ca2ef..4179980 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -257,6 +257,14 @@ (sb!disassem:dstate-put-inst-prop dstate 'operand-size-8)) value) +;;; This prefilter is used solely for its side effect, namely to put +;;; the property OPERAND-SIZE-16 into the DSTATE. +(defun prefilter-x66 (value dstate) + (declare (type (eql #x66) value) + (ignore value) + (type sb!disassem:disassem-state dstate)) + (sb!disassem:dstate-put-inst-prop dstate 'operand-size-16)) + ;;; A register field that can be extended by REX.R. (defun prefilter-reg-r (value dstate) (declare (type reg value) @@ -360,6 +368,10 @@ (princ (schar (symbol-name (inst-operand-size dstate)) 0) stream))) +;;; Used to capture the effect of the #x66 operand size override prefix. +(sb!disassem:define-arg-type x66 + :prefilter #'prefilter-x66) + (sb!disassem:define-arg-type displacement :sign-extend t :use-label #'offset-next @@ -610,18 +622,6 @@ :default-printer '(:name :tab reg)) (reg :type 'reg-b-default-qword)) -(sb!disassem:define-instruction-format (modrm-reg-no-width 24 - :default-printer '(:name :tab reg)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (ff :field (byte 8 8) :value #b11111111) - (mod :field (byte 2 22)) - (modrm-reg :field (byte 3 19)) - (reg :field (byte 3 16) :type 'reg-b) - ;; optional fields - (accum :type 'accum) - (imm)) - ;;; Adds a width field to reg-no-width. Note that we can't use ;;; :INCLUDE 'REG-NO-WIDTH here to save typing because that would put ;;; the WIDTH field last, but the prefilter for WIDTH must run before @@ -693,6 +693,34 @@ (op :field (byte 6 10)) (dir :field (byte 1 9))) +(sb!disassem:define-instruction-format (x66-reg-reg/mem-dir 24 + :default-printer + `(:name + :tab + ,(swap-if 'dir 'reg/mem ", " 'reg))) + (x66 :field (byte 8 0) :type 'x66 :value #x66) + (op :field (byte 6 10)) + (dir :field (byte 1 9)) + (width :field (byte 1 8) :type 'width) + (reg/mem :fields (list (byte 2 22) (byte 3 16)) + :type 'reg/mem) + (reg :field (byte 3 19) :type 'reg)) + +(sb!disassem:define-instruction-format (x66-rex-reg-reg/mem-dir 32 + :default-printer + `(:name + :tab + ,(swap-if 'dir 'reg/mem ", " 'reg))) + (x66 :field (byte 8 0) :type 'x66 :value #x66) + (rex :field (byte 4 12) :value #b0100) + (wrxb :field (byte 4 8) :type 'wrxb) + (op :field (byte 6 18)) + (dir :field (byte 1 17)) + (width :field (byte 1 16) :type 'width) + (reg/mem :fields (list (byte 2 30) (byte 3 24)) + :type 'reg/mem) + (reg :field (byte 3 27) :type 'reg)) + ;;; Same as reg-reg/mem, but uses the reg field as a second op code. (sb!disassem:define-instruction-format (reg/mem 16 :default-printer '(:name :tab reg/mem)) @@ -1024,6 +1052,14 @@ :default-printer '(:name :tab code)) (op :field (byte 8 0)) (code :field (byte 8 8))) + +;;; Two byte instruction with an immediate byte argument. +;;; +(sb!disassem:define-instruction-format (word-imm 24 + :default-printer '(:name :tab code)) + (op :field (byte 16 0)) + (code :field (byte 8 16))) + ;;;; primitive emitters @@ -1195,7 +1231,7 @@ (stack ;; Convert stack tns into an index off RBP. (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes)))) - (cond ((< -128 disp 127) + (cond ((<= -128 disp 127) (emit-mod-reg-r/m-byte segment #b01 reg #b101) (emit-byte segment disp)) (t @@ -1543,6 +1579,8 @@ ;; register to/from register/memory (:printer reg-reg/mem-dir ((op #b100010))) (:printer rex-reg-reg/mem-dir ((op #b100010))) + (:printer x66-reg-reg/mem-dir ((op #b100010))) + (:printer x66-rex-reg-reg/mem-dir ((op #b100010))) ;; immediate to register/memory (:printer reg/mem-imm ((op '(#b1100011 #b000)))) (:printer rex-reg/mem-imm ((op '(#b1100011 #b000)))) @@ -1938,38 +1976,27 @@ (:printer-list (arith-inst-printer-list #b111)) (:emitter (emit-random-arith-inst "CMP" segment dst src #b111 t))) +;;; The one-byte encodings for INC and DEC are used as REX prefixes +;;; in 64-bit mode so we always use the two-byte form. (define-instruction inc (segment dst) - ;; Register - (:printer modrm-reg-no-width ((modrm-reg #b000))) - ;; Register/Memory - ;; (:printer rex-reg/mem ((op '(#b11111111 #b001)))) (:printer reg/mem ((op '(#b1111111 #b000)))) + (:printer rex-reg/mem ((op '(#b1111111 #b000)))) (:emitter (let ((size (operand-size dst))) (maybe-emit-operand-size-prefix segment size) - (cond #+nil ; these opcodes become REX prefixes in x86-64 - ((and (not (eq size :byte)) (register-p dst)) - (emit-byte-with-reg segment #b01000 (reg-tn-encoding dst))) - (t - (maybe-emit-rex-for-ea segment dst nil) - (emit-byte segment (if (eq size :byte) #b11111110 #b11111111)) - (emit-ea segment dst #b000)))))) + (maybe-emit-rex-for-ea segment dst nil) + (emit-byte segment (if (eq size :byte) #b11111110 #b11111111)) + (emit-ea segment dst #b000)))) (define-instruction dec (segment dst) - ;; Register. - (:printer modrm-reg-no-width ((modrm-reg #b001))) - ;; Register/Memory (:printer reg/mem ((op '(#b1111111 #b001)))) + (:printer rex-reg/mem ((op '(#b1111111 #b001)))) (:emitter (let ((size (operand-size dst))) (maybe-emit-operand-size-prefix segment size) - (cond #+nil - ((and (not (eq size :byte)) (register-p dst)) - (emit-byte-with-reg segment #b01001 (reg-tn-encoding dst))) - (t - (maybe-emit-rex-for-ea segment dst nil) - (emit-byte segment (if (eq size :byte) #b11111110 #b11111111)) - (emit-ea segment dst #b001)))))) + (maybe-emit-rex-for-ea segment dst nil) + (emit-byte segment (if (eq size :byte) #b11111110 #b11111111)) + (emit-ea segment dst #b001)))) (define-instruction neg (segment dst) (:printer reg/mem ((op '(#b1111011 #b011)))) @@ -2548,11 +2575,6 @@ (emit-byte segment #b11111111) (emit-ea segment where #b100))))) -(define-instruction jmp-short (segment label) - (:emitter - (emit-byte segment #b11101011) - (emit-byte-displacement-backpatch segment label))) - (define-instruction ret (segment &optional stack-delta) (:printer byte ((op #b11000011))) (:printer byte ((op #b11000010) (imm nil :type 'imm-word-16)) @@ -2676,7 +2698,8 @@ ;; Lisp (with (DESCRIBE 'BYTE-IMM-CODE)) than to definitively deduce ;; from first principles whether it's defined in some way that genesis ;; can't grok. - (case (byte-imm-code chunk dstate) + (case #!-darwin (byte-imm-code chunk dstate) + #!+darwin (word-imm-code chunk dstate) (#.error-trap (nt "error trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) @@ -2690,14 +2713,25 @@ (#.halt-trap (nt "halt trap")) (#.fun-end-breakpoint-trap - (nt "function end breakpoint trap"))))) + (nt "function end breakpoint trap")) + (#.single-step-around-trap + (nt "single-step trap (around)")) + (#.single-step-before-trap + (nt "single-step trap (before)"))))) (define-instruction break (segment code) (:declare (type (unsigned-byte 8) code)) - (:printer byte-imm ((op #b11001100)) '(:name :tab code) - :control #'break-control) - (:emitter - (emit-byte segment #b11001100) + #!-darwin (:printer byte-imm ((op #b11001100)) '(:name :tab code) + :control #'break-control) + #!+darwin (:printer word-imm ((op #b0000101100001111)) '(:name :tab code) + :control #'break-control) + (:emitter + #!-darwin (emit-byte segment #b11001100) + ;; On darwin, trap handling via SIGTRAP is unreliable, therefore we + ;; throw a sigill with 0x0b0f instead and check for this in the + ;; SIGILL handler and pass it on to the sigtrap handler if + ;; appropriate + #!+darwin (emit-word segment #b0000101100001111) (emit-byte segment code))) (define-instruction int (segment number)