X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Finsts.lisp;h=811738374a55ff6eac774e9cd76a5dd08b94a8bc;hb=bffa99d35c7d50ac46b9eb7dbe25d1ab1a0e6145;hp=514f11698c2beed00de199de7be6a198f14fafdc;hpb=22b819c0cd0ca0ea5be52ba280b9e9e0b8e86210;p=sbcl.git

diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index 514f116..8117383 100644
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -264,6 +264,14 @@
 			  +default-operand-size+)))
 		 (sb!disassem:read-suffix (width-bits width) dstate))))
 
+(sb!disassem:define-arg-type signed-imm-word
+  :prefilter (lambda (value dstate)
+	       (declare (ignore value)) ; always nil anyway
+	       (let ((width
+		      (or (sb!disassem:dstate-get-prop dstate 'word-width)
+			  +default-operand-size+)))
+		 (sb!disassem:read-signed-suffix (width-bits width) dstate))))
+
 ;;; needed for the ret imm16 instruction
 (sb!disassem:define-arg-type imm-word-16
   :prefilter (lambda (value dstate)
@@ -588,6 +596,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
@@ -597,6 +615,14 @@
   (disp :field (byte 16 8))
   (level :field (byte 8 24)))
 
+(sb!disassem:define-instruction-format (prefetch 24
+						 :default-printer
+						 '(:name ", " reg/mem))
+  (prefix :field (byte 8 0) :value #b00001111)
+  (op :field (byte 8 8) :value #b00011000)
+  (reg/mem :fields (list (byte 2 22) (byte 3 16)) :type 'byte-reg/mem)
+  (reg :field (byte 3 19) :type 'reg))
+
 ;;; Single byte instruction with an immediate byte argument.
 (sb!disassem:define-instruction-format (byte-imm 16
 				     :default-printer '(:name :tab code))
@@ -627,7 +653,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
@@ -656,7 +682,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)
@@ -1262,7 +1288,8 @@
 (define-instruction imul (segment dst &optional src1 src2)
   (:printer accum-reg/mem ((op '(#b1111011 #b101))))
   (:printer ext-reg-reg/mem ((op #b1010111)))
-  (:printer reg-reg/mem ((op #b0110100) (width 1) (imm nil :type 'imm-word))
+  (:printer reg-reg/mem ((op #b0110100) (width 1)
+                         (imm nil :type 'signed-imm-word))
 	    '(:name :tab reg ", " reg/mem ", " imm))
   (:printer reg-reg/mem ((op #b0110101) (width 1)
 			 (imm nil :type 'signed-imm-byte))
@@ -1784,6 +1811,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)
@@ -1809,6 +1848,43 @@
   (:emitter
    (emit-byte segment #b11001001)))
 
+;;;; prefetch
+(define-instruction prefetchnta (segment ea)
+  (:printer prefetch ((op #b00011000) (reg #b000)))
+  (:emitter
+   (aver (typep ea 'ea))
+   (aver (eq :byte (ea-size ea)))
+   (emit-byte segment #b00001111)
+   (emit-byte segment #b00011000)
+   (emit-ea segment ea #b000)))
+
+(define-instruction prefetcht0 (segment ea)
+  (:printer prefetch ((op #b00011000) (reg #b001)))
+  (:emitter
+   (aver (typep ea 'ea))
+   (aver (eq :byte (ea-size ea)))
+   (emit-byte segment #b00001111)
+   (emit-byte segment #b00011000)
+   (emit-ea segment ea #b001)))
+
+(define-instruction prefetcht1 (segment ea)
+  (:printer prefetch ((op #b00011000) (reg #b010)))
+  (:emitter
+   (aver (typep ea 'ea))
+   (aver (eq :byte (ea-size ea)))
+   (emit-byte segment #b00001111)
+   (emit-byte segment #b00011000)
+   (emit-ea segment ea #b010)))
+
+(define-instruction prefetcht2 (segment ea)
+  (:printer prefetch ((op #b00011000) (reg #b011)))
+  (:emitter
+   (aver (typep ea 'ea))
+   (aver (eq :byte (ea-size ea)))
+   (emit-byte segment #b00001111)
+   (emit-byte segment #b00011000)
+   (emit-ea segment ea #b011)))
+
 ;;;; interrupt instructions
 
 (defun snarf-error-junk (sap offset &optional length-only)
@@ -2455,8 +2531,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)