X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Finsts.lisp;h=29cb69827a988e82ba8c0cab00e7f2de3d247ff2;hb=4ed3f0d08c3a57a6762018d9622f253ab9d0f2b6;hp=12cc5bfa5f7545c253112efc361381f8d513c63a;hpb=0bca0cb1bf5ce5572ab5cd7ba59f87fed1f2edb0;p=sbcl.git diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 12cc5bf..29cb698 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -19,6 +19,8 @@ (setf sb!disassem:*disassem-inst-alignment-bytes* 1) (deftype reg () '(unsigned-byte 3)) + +(def!constant +default-operand-size+ :dword) (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) @@ -106,6 +108,14 @@ (print-byte-reg value stream dstate) (print-mem-access value stream t dstate))) +(defun print-word-reg/mem (value stream dstate) + (declare (type (or list reg) value) + (type stream stream) + (type sb!disassem:disassem-state dstate)) + (if (typep value 'reg) + (print-word-reg value stream dstate) + (print-mem-access value stream nil dstate))) + (defun print-label (value stream dstate) (declare (ignore dstate)) (sb!disassem:princ16 value stream)) @@ -271,9 +281,12 @@ (sb!disassem:define-arg-type byte-reg/mem :prefilter #'prefilter-reg/mem :printer #'print-byte-reg/mem) +(sb!disassem:define-arg-type word-reg/mem + :prefilter #'prefilter-reg/mem + :printer #'print-word-reg/mem) ;;; added by jrd -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) (defun print-fp-reg (value stream dstate) (declare (ignore dstate)) (format stream "FR~D" value)) @@ -468,6 +481,12 @@ :type 'sized-reg/mem) ;; optional fields (imm)) + +(sb!disassem:define-instruction-format (ext-reg/mem-imm 24 + :include 'ext-reg/mem + :default-printer + '(:name :tab reg/mem ", " imm)) + (imm :type 'imm-data)) ;;;; This section was added by jrd, for fp instructions. @@ -569,6 +588,16 @@ :type 'byte-reg/mem) (reg :field (byte 3 19) :value #b000)) +(sb!disassem:define-instruction-format (cond-move 24 + :default-printer + '('cmov cc :tab reg ", " reg/mem)) + (prefix :field (byte 8 0) :value #b00001111) + (op :field (byte 4 12) :value #b0100) + (cc :field (byte 4 8) :type 'condition-code) + (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 (enter-format 32 :default-printer '(:name :tab disp @@ -608,7 +637,7 @@ (let ((offset (fixup-offset fixup))) (if (label-p offset) (emit-back-patch segment - 4 ; FIXME: sb!vm:n-word-bytes + 4 ; FIXME: n-word-bytes (lambda (segment posn) (declare (ignore posn)) (emit-dword segment @@ -637,7 +666,7 @@ (base nil :type (or tn null)) (index nil :type (or tn null)) (scale 1 :type (member 1 2 4 8)) - (disp 0 :type (or (signed-byte 32) fixup))) + (disp 0 :type (or (unsigned-byte 32) (signed-byte 32) fixup))) (def!method print-object ((ea ea) stream) (cond ((or *print-escape* *print-readably*) (print-unreadable-object (ea stream :type t) @@ -791,9 +820,7 @@ ;;;; utilities -(defconstant +operand-size-prefix-byte+ #b01100110) - -(defconstant +default-operand-size+ :dword) +(def!constant +operand-size-prefix-byte+ #b01100110) (defun maybe-emit-operand-size-prefix (segment size) (unless (or (eq size :byte) (eq size +default-operand-size+)) @@ -1036,6 +1063,11 @@ (emit-ea segment dst (reg-tn-encoding src))))) + +(define-instruction fs-segment-prefix (segment) + (:emitter + (emit-byte segment #x64))) + ;;;; flag control instructions ;;; CLC -- Clear Carry Flag. @@ -1114,7 +1146,7 @@ ((integerp src) (cond ((and (not (eq size :byte)) (<= -128 src 127)) (emit-byte segment #b10000011) - (emit-ea segment dst opcode) + (emit-ea segment dst opcode allow-constants) (emit-byte segment src)) ((accumulator-p dst) (emit-byte segment @@ -1126,7 +1158,7 @@ (emit-sized-immediate segment size src)) (t (emit-byte segment (if (eq size :byte) #b10000000 #b10000001)) - (emit-ea segment dst opcode) + (emit-ea segment dst opcode allow-constants) (emit-sized-immediate segment size src)))) ((register-p src) (emit-byte segment @@ -1573,6 +1605,7 @@ ;;;; bit manipulation (define-instruction bsf (segment dst src) + (:printer ext-reg-reg/mem ((op #b1011110) (width 0))) (:emitter (let ((size (matching-operand-size dst src))) (when (eq size :byte) @@ -1583,6 +1616,7 @@ (emit-ea segment src (reg-tn-encoding dst))))) (define-instruction bsr (segment dst src) + (:printer ext-reg-reg/mem ((op #b1011110) (width 1))) (:emitter (let ((size (matching-operand-size dst src))) (when (eq size :byte) @@ -1606,19 +1640,33 @@ (emit-byte segment (dpb opcode (byte 3 3) #b10000011)) (emit-ea segment src (reg-tn-encoding index)))))) +(eval-when (:compile-toplevel :execute) + (defun bit-test-inst-printer-list (subop) + `((ext-reg/mem-imm ((op (#b1011101 ,subop)) + (reg/mem nil :type word-reg/mem) + (imm nil :type imm-data) + (width 0))) + (ext-reg-reg/mem ((op ,(dpb subop (byte 3 2) #b1000001)) + (width 1)) + (:name :tab reg/mem ", " reg))))) + (define-instruction bt (segment src index) + (:printer-list (bit-test-inst-printer-list #b100)) (:emitter (emit-bit-test-and-mumble segment src index #b100))) (define-instruction btc (segment src index) + (:printer-list (bit-test-inst-printer-list #b111)) (:emitter (emit-bit-test-and-mumble segment src index #b111))) (define-instruction btr (segment src index) + (:printer-list (bit-test-inst-printer-list #b110)) (:emitter (emit-bit-test-and-mumble segment src index #b110))) (define-instruction bts (segment src index) + (:printer-list (bit-test-inst-printer-list #b101)) (:emitter (emit-bit-test-and-mumble segment src index #b101))) @@ -1746,6 +1794,18 @@ (emit-byte segment #b11100000) (emit-byte-displacement-backpatch segment target))) +;;;; conditional move +(define-instruction cmov (segment cond dst src) + (:printer cond-move ()) + (:emitter + (aver (register-p dst)) + (let ((size (matching-operand-size dst src))) + (aver (or (eq size :word) (eq size :dword))) + (maybe-emit-operand-size-prefix segment size)) + (emit-byte segment #b00001111) + (emit-byte segment (dpb (conditional-opcode cond) (byte 4 0) #b01000000)) + (emit-ea segment src (reg-tn-encoding dst)))) + ;;;; conditional byte set (define-instruction set (segment dst cond) @@ -1790,13 +1850,13 @@ (lengths)) (lengths 1) ; the length byte (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (lengths index) (loop (when (>= index length) (return)) (let ((old-index index)) - (sc-offsets (sb!c::read-var-integer vector index)) + (sc-offsets (sb!c:read-var-integer vector index)) (lengths (- index old-index)))) (values error-number (1+ length) @@ -2417,8 +2477,7 @@ ;;; unordered comparison (define-instruction fucom (segment src) - ;; XX Printer conflicts with frstor - ;; (:printer floating-point ((op '(#b101 #b100)))) + (:printer floating-point-fp ((op '(#b101 #b100)))) (:emitter (aver (fp-reg-tn-p src)) (emit-byte segment #b11011101)