0.8.21.5:

[sbcl.git] / src / compiler / x86 / insts.lisp

diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index 29cb698..fd398ba 100644 (file)
--- 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)
@@ -607,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))
@@ -1272,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))
@@ -1454,20 +1471,20 @@
 (eval-when (:compile-toplevel :execute)
   (defun double-shift-inst-printer-list (op)
     `(#+nil
-      (ext-reg-reg/mem-imm ((op ,(logior op #b100))
+      (ext-reg-reg/mem-imm ((op ,(logior op #b10))
                            (imm nil :type signed-imm-byte)))
-      (ext-reg-reg/mem ((op ,(logior op #b101)))
-        (:name :tab reg/mem ", " 'cl)))))
+      (ext-reg-reg/mem ((op ,(logior op #b10)))
+        (:name :tab reg/mem ", " reg ", " 'cl)))))
 
 (define-instruction shld (segment dst src amt)
   (:declare (type (or (member :cl) (mod 32)) amt))
-  (:printer-list (double-shift-inst-printer-list #b10100000))
+  (:printer-list (double-shift-inst-printer-list #b1010000))
   (:emitter
    (emit-double-shift segment #b0 dst src amt)))
 
 (define-instruction shrd (segment dst src amt)
   (:declare (type (or (member :cl) (mod 32)) amt))
-  (:printer-list (double-shift-inst-printer-list #b10101000))
+  (:printer-list (double-shift-inst-printer-list #b1010100))
   (:emitter
    (emit-double-shift segment #b1 dst src amt)))
 
@@ -1831,6 +1848,43 @@
   (:emitter
    (emit-byte segment #b11001001)))
 \f
+;;;; 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)))
+\f
 ;;;; interrupt instructions
 
 (defun snarf-error-junk (sap offset &optional length-only)
@@ -1842,10 +1896,8 @@
     (cond (length-only
           (values 0 (1+ length) nil nil))
          (t
-          (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset))
-                                           vector (* n-word-bits
-                                                     vector-data-offset)
-                                           (* length n-byte-bits))
+          (sb!kernel:copy-ub8-from-system-area sap (1+ offset)
+                                                vector 0 length)
           (collect ((sc-offsets)
                     (lengths))
             (lengths 1)                ; the length byte