X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Finsts.lisp;h=fd398ba966548d48030c23962bb9640ecdc947c0;hb=338732358d49ab202fe55c3581294597d63aec6b;hp=34738f70695bbe4ff27fdf6da0e7dfa82f08be69;hpb=0b5610d8a220a4b20cbeac958953ca4d67c00038;p=sbcl.git

diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index 34738f7..fd398ba 100644
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -15,18 +15,12 @@
 ;;; I wonder whether the separation of the disassembler from the
 ;;; virtual machine is valid or adds value.
 
-;;; FIXME: In CMU CL, the code in this file seems to be fully
-;;; compiled, not byte compiled. I'm not sure that's reasonable:
-;;; there's a lot of code in this file, and considering the overall
-;;; speed of the compiler, having some byte-interpretation overhead
-;;; for every few bytes emitted doesn't seem likely to be noticeable.
-;;; I'd like to see what happens if I come back and byte-compile this
-;;; file.
-
 ;;; Note: In CMU CL, this used to be a call to SET-DISASSEM-PARAMS.
 (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)
 
@@ -114,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))
@@ -197,91 +199,102 @@
 
 ;;;; disassembler argument types
 
-(sb!disassem:define-argument-type displacement
+(sb!disassem:define-arg-type displacement
   :sign-extend t
-  :use-label #'offset-next)
-
-(sb!disassem:define-argument-type accum
-  :printer #'(lambda (value stream dstate)
-	       (declare (ignore value)
-			(type stream stream)
-			(type sb!disassem:disassem-state dstate))
-	       (print-reg 0 stream dstate))
-  )
-
-(sb!disassem:define-argument-type word-accum
-  :printer #'(lambda (value stream dstate)
-	       (declare (ignore value)
-			(type stream stream)
-			(type sb!disassem:disassem-state dstate))
-	       (print-word-reg 0 stream dstate)))
-
-(sb!disassem:define-argument-type reg
+  :use-label #'offset-next
+  :printer (lambda (value stream dstate)
+	     (sb!disassem:maybe-note-assembler-routine value nil dstate)
+	     (print-label value stream dstate)))
+
+(sb!disassem:define-arg-type accum
+  :printer (lambda (value stream dstate)
+	     (declare (ignore value)
+		      (type stream stream)
+		      (type sb!disassem:disassem-state dstate))
+	     (print-reg 0 stream dstate)))
+
+(sb!disassem:define-arg-type word-accum
+  :printer (lambda (value stream dstate)
+	     (declare (ignore value)
+		      (type stream stream)
+		      (type sb!disassem:disassem-state dstate))
+	     (print-word-reg 0 stream dstate)))
+
+(sb!disassem:define-arg-type reg
   :printer #'print-reg)
 
-(sb!disassem:define-argument-type addr-reg
+(sb!disassem:define-arg-type addr-reg
   :printer #'print-addr-reg)
 
-(sb!disassem:define-argument-type word-reg
+(sb!disassem:define-arg-type word-reg
   :printer #'print-word-reg)
 
-(sb!disassem:define-argument-type imm-addr
+(sb!disassem:define-arg-type imm-addr
   :prefilter #'read-address
   :printer #'print-label)
 
-(sb!disassem:define-argument-type imm-data
-  :prefilter #'(lambda (value dstate)
-		 (declare (ignore value)) ; always nil anyway
-		 (sb!disassem:read-suffix
-		  (width-bits (sb!disassem:dstate-get-prop dstate 'width))
-		  dstate))
-  )
-
-(sb!disassem:define-argument-type signed-imm-data
-  :prefilter #'(lambda (value dstate)
-		 (declare (ignore value)) ; always nil anyway
-		 (let ((width (sb!disassem:dstate-get-prop dstate 'width)))
-		   (sb!disassem:read-signed-suffix (width-bits width) dstate)))
-  )
-
-(sb!disassem:define-argument-type signed-imm-byte
-  :prefilter #'(lambda (value dstate)
-		 (declare (ignore value)) ; always nil anyway
-		 (sb!disassem:read-signed-suffix 8 dstate)))
-
-(sb!disassem:define-argument-type signed-imm-dword
-  :prefilter #'(lambda (value dstate)
-		 (declare (ignore value))		; always nil anyway
-		 (sb!disassem:read-signed-suffix 32 dstate)))
-
-(sb!disassem:define-argument-type 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-suffix (width-bits width) dstate))))
+(sb!disassem:define-arg-type imm-data
+  :prefilter (lambda (value dstate)
+	       (declare (ignore value)) ; always nil anyway
+	       (sb!disassem:read-suffix
+		(width-bits (sb!disassem:dstate-get-prop dstate 'width))
+		dstate)))
+
+(sb!disassem:define-arg-type signed-imm-data
+  :prefilter (lambda (value dstate)
+	       (declare (ignore value)) ; always nil anyway
+	       (let ((width (sb!disassem:dstate-get-prop dstate 'width)))
+		 (sb!disassem:read-signed-suffix (width-bits width) dstate))))
+
+(sb!disassem:define-arg-type signed-imm-byte
+  :prefilter (lambda (value dstate)
+	       (declare (ignore value)) ; always nil anyway
+	       (sb!disassem:read-signed-suffix 8 dstate)))
+
+(sb!disassem:define-arg-type signed-imm-dword
+  :prefilter (lambda (value dstate)
+	       (declare (ignore value))	; always nil anyway
+	       (sb!disassem:read-signed-suffix 32 dstate)))
+
+(sb!disassem:define-arg-type 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-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-argument-type imm-word-16
-  :prefilter #'(lambda (value dstate)
-		 (declare (ignore value)) ; always nil anyway
-		 (sb!disassem:read-suffix 16 dstate)))
+(sb!disassem:define-arg-type imm-word-16
+  :prefilter (lambda (value dstate)
+	       (declare (ignore value)) ; always nil anyway
+	       (sb!disassem:read-suffix 16 dstate)))
 
-(sb!disassem:define-argument-type reg/mem
+(sb!disassem:define-arg-type reg/mem
   :prefilter #'prefilter-reg/mem
   :printer #'print-reg/mem)
-(sb!disassem:define-argument-type sized-reg/mem
+(sb!disassem:define-arg-type sized-reg/mem
   ;; Same as reg/mem, but prints an explicit size indicator for
   ;; memory references.
   :prefilter #'prefilter-reg/mem
   :printer #'print-sized-reg/mem)
-(sb!disassem:define-argument-type byte-reg/mem
+(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))
@@ -290,22 +303,22 @@
   (declare (ignore dstate))
   value)
 ) ; EVAL-WHEN
-(sb!disassem:define-argument-type fp-reg
-				  :prefilter #'prefilter-fp-reg
-				  :printer #'print-fp-reg)
+(sb!disassem:define-arg-type fp-reg
+			     :prefilter #'prefilter-fp-reg
+			     :printer #'print-fp-reg)
 
-(sb!disassem:define-argument-type width
+(sb!disassem:define-arg-type width
   :prefilter #'prefilter-width
-  :printer #'(lambda (value stream dstate)
-	       (if ;; (zerop value)
-		   (or (null value)
-		       (and (numberp value) (zerop value))) ; zzz jrd
-		   (princ 'b stream)
-		   (let ((word-width
-			  ;; set by a prefix instruction
-			  (or (sb!disassem:dstate-get-prop dstate 'word-width)
-			      +default-operand-size+)))
-		     (princ (schar (symbol-name word-width) 0) stream)))))
+  :printer (lambda (value stream dstate)
+	     (if;; (zerop value)
+		 (or (null value)
+		     (and (numberp value) (zerop value))) ; zzz jrd
+		 (princ 'b stream)
+		 (let ((word-width
+			;; set by a prefix instruction
+			(or (sb!disassem:dstate-get-prop dstate 'word-width)
+			    +default-operand-size+)))
+		   (princ (schar (symbol-name word-width) 0) stream)))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defparameter *conditions*
@@ -338,7 +351,7 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf sb!assem:*assem-scheduler-p* nil))
 
-(sb!disassem:define-argument-type condition-code
+(sb!disassem:define-arg-type condition-code
   :printer *condition-name-vec*)
 
 (defun conditional-opcode (condition)
@@ -476,6 +489,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.
 
@@ -553,9 +572,9 @@
   ;; The disassembler currently doesn't let you have an instruction > 32 bits
   ;; long, so we fake it by using a prefilter to read the offset.
   (label :type 'displacement
-	 :prefilter #'(lambda (value dstate)
-			(declare (ignore value))   ; always nil anyway
-			(sb!disassem:read-signed-suffix 32 dstate))))
+	 :prefilter (lambda (value dstate)
+		      (declare (ignore value)) ; always nil anyway
+		      (sb!disassem:read-signed-suffix 32 dstate))))
 
 (sb!disassem:define-instruction-format (near-jump 8
 				     :default-printer '(:name :tab label))
@@ -563,9 +582,9 @@
   ;; The disassembler currently doesn't let you have an instruction > 32 bits
   ;; long, so we fake it by using a prefilter to read the address.
   (label :type 'displacement
-	 :prefilter #'(lambda (value dstate)
-			(declare (ignore value))   ; always nil anyway
-			(sb!disassem:read-signed-suffix 32 dstate))))
+	 :prefilter (lambda (value dstate)
+		      (declare (ignore value)) ; always nil anyway
+		      (sb!disassem:read-signed-suffix 32 dstate))))
 
 
 (sb!disassem:define-instruction-format (cond-set 24
@@ -577,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
@@ -586,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))
@@ -616,14 +653,14 @@
   (let ((offset (fixup-offset fixup)))
     (if (label-p offset)
 	(emit-back-patch segment
-			 4 ; FIXME: sb!vm:word-bytes
-			 #'(lambda (segment posn)
-			     (declare (ignore posn))
-			     (emit-dword segment
-					 (- (+ (component-header-length)
-					       (or (label-position offset)
-						   0))
-					    other-pointer-type))))
+			 4 ; FIXME: n-word-bytes
+			 (lambda (segment posn)
+			   (declare (ignore posn))
+			   (emit-dword segment
+				       (- (+ (component-header-length)
+					     (or (label-position offset)
+						 0))
+					  other-pointer-lowtag))))
 	(emit-dword segment (or offset 0)))))
 
 (defun emit-relative-fixup (segment fixup)
@@ -634,7 +671,7 @@
 
 (defun reg-tn-encoding (tn)
   (declare (type tn tn))
-  (assert (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
+  (aver (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
   (let ((offset (tn-offset tn)))
     (logior (ash (logand offset 1) 2)
 	    (ash offset -1))))
@@ -645,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)
@@ -660,11 +697,11 @@
 	(t
 	 (format stream "~A PTR [" (symbol-name (ea-size ea)))
 	 (when (ea-base ea)
-	   (write-string (x86-location-print-name (ea-base ea)) stream)
+	   (write-string (sb!c::location-print-name (ea-base ea)) stream)
 	   (when (ea-index ea)
 	     (write-string "+" stream)))
 	 (when (ea-index ea)
-	   (write-string (x86-location-print-name (ea-index ea)) stream))
+	   (write-string (sb!c::location-print-name (ea-index ea)) stream))
 	 (unless (= (ea-scale ea) 1)
 	   (format stream "*~A" (ea-scale ea)))
 	 (typecase (ea-disp ea)
@@ -683,7 +720,7 @@
 	(emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
        (stack
 	;; Convert stack tns into an index off of EBP.
-	(let ((disp (- (* (1+ (tn-offset thing)) word-bytes))))
+	(let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes))))
 	  (cond ((< -128 disp 127)
 		 (emit-mod-reg-r/m-byte segment #b01 reg #b101)
 		 (emit-byte segment disp))
@@ -698,8 +735,8 @@
 	(emit-absolute-fixup segment
 			     (make-fixup nil
 					 :code-object
-					 (- (* (tn-offset thing) word-bytes)
-					    other-pointer-type))))))
+					 (- (* (tn-offset thing) n-word-bytes)
+					    other-pointer-lowtag))))))
     (ea
      (let* ((base (ea-base thing))
 	    (index (ea-index thing))
@@ -709,7 +746,7 @@
 			    (and (eql disp 0)
 				 (not (= (reg-tn-encoding base) #b101))))
 			#b00)
-		       ((and (target-fixnump disp) (<= -128 disp 127))
+		       ((and (fixnump disp) (<= -128 disp 127))
 			#b01)
 		       (t
 			#b10)))
@@ -799,9 +836,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+))
@@ -902,7 +937,7 @@
 	    (emit-byte segment (if (eq size :byte) #b10001000 #b10001001))
 	    (emit-ea segment dst (reg-tn-encoding src)))
 	   ((fixup-p src)
-	    (assert (eq size :dword))
+	    (aver (eq size :dword))
 	    (emit-byte segment #b11000111)
 	    (emit-ea segment dst #b000)
 	    (emit-absolute-fixup segment src))
@@ -910,12 +945,12 @@
 	    (error "bogus arguments to MOV: ~S ~S" dst src))))))
 
 (defun emit-move-with-extension (segment dst src opcode)
-  (assert (register-p dst))
+  (aver (register-p dst))
   (let ((dst-size (operand-size dst))
 	(src-size (operand-size src)))
     (ecase dst-size
       (:word
-       (assert (eq src-size :byte))
+       (aver (eq src-size :byte))
        (maybe-emit-operand-size-prefix segment :word)
        (emit-byte segment #b00001111)
        (emit-byte segment opcode)
@@ -966,7 +1001,7 @@
 	  (emit-absolute-fixup segment src))
 	 (t
 	  (let ((size (operand-size src)))
-	    (assert (not (eq size :byte)))
+	    (aver (not (eq size :byte)))
 	    (maybe-emit-operand-size-prefix segment size)
 	    (cond ((register-p src)
 		   (emit-byte-with-reg segment #b01010 (reg-tn-encoding src)))
@@ -984,7 +1019,7 @@
   (:printer reg/mem ((op '(#b1000111 #b000)) (width 1)))
   (:emitter
    (let ((size (operand-size dst)))
-     (assert (not (eq size :byte)))
+     (aver (not (eq size :byte)))
      (maybe-emit-operand-size-prefix segment size)
      (cond ((register-p dst)
 	    (emit-byte-with-reg segment #b01011 (reg-tn-encoding dst)))
@@ -1028,7 +1063,7 @@
 (define-instruction lea (segment dst src)
   (:printer reg-reg/mem ((op #b1000110) (width 1)))
   (:emitter
-   (assert (dword-reg-p dst))
+   (aver (dword-reg-p dst))
    (emit-byte segment #b10001101)
    (emit-ea segment src (reg-tn-encoding dst))))
 
@@ -1036,7 +1071,7 @@
   ;; Register/Memory with Register.
   (:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg))
   (:emitter
-   (assert (register-p src))
+   (aver (register-p src))
    (let ((size (matching-operand-size src dst)))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment #b00001111)
@@ -1044,6 +1079,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.
@@ -1122,7 +1162,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
@@ -1134,7 +1174,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
@@ -1240,7 +1280,7 @@
   (:printer accum-reg/mem ((op '(#b1111011 #b100))))
   (:emitter
    (let ((size (matching-operand-size dst src)))
-     (assert (accumulator-p dst))
+     (aver (accumulator-p dst))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment (if (eq size :byte) #b11110110 #b11110111))
      (emit-ea segment src #b100))))
@@ -1248,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))
@@ -1283,7 +1324,7 @@
   (:printer accum-reg/mem ((op '(#b1111011 #b110))))
   (:emitter
    (let ((size (matching-operand-size dst src)))
-     (assert (accumulator-p dst))
+     (aver (accumulator-p dst))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment (if (eq size :byte) #b11110110 #b11110111))
      (emit-ea segment src #b110))))
@@ -1292,7 +1333,7 @@
   (:printer accum-reg/mem ((op '(#b1111011 #b111))))
   (:emitter
    (let ((size (matching-operand-size dst src)))
-     (assert (accumulator-p dst))
+     (aver (accumulator-p dst))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment (if (eq size :byte) #b11110110 #b11110111))
      (emit-ea segment src #b111))))
@@ -1338,7 +1379,7 @@
   ;; Register/Memory with Register.
   (:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg))
   (:emitter
-   (assert (register-p src))
+   (aver (register-p src))
    (let ((size (matching-operand-size src dst)))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment #b00001111)
@@ -1430,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)))
 
@@ -1516,7 +1557,7 @@
   (:printer string-op ((op #b0110110)))
   (:emitter
    (let ((size (operand-size acc)))
-     (assert (accumulator-p acc))
+     (aver (accumulator-p acc))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment (if (eq size :byte) #b01101100 #b01101101)))))
 
@@ -1524,7 +1565,7 @@
   (:printer string-op ((op #b1010110)))
   (:emitter
    (let ((size (operand-size acc)))
-     (assert (accumulator-p acc))
+     (aver (accumulator-p acc))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment (if (eq size :byte) #b10101100 #b10101101)))))
 
@@ -1538,7 +1579,7 @@
   (:printer string-op ((op #b0110111)))
   (:emitter
    (let ((size (operand-size acc)))
-     (assert (accumulator-p acc))
+     (aver (accumulator-p acc))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment (if (eq size :byte) #b01101110 #b01101111)))))
 
@@ -1546,7 +1587,7 @@
   (:printer string-op ((op #b1010111)))
   (:emitter
    (let ((size (operand-size acc)))
-     (assert (accumulator-p acc))
+     (aver (accumulator-p acc))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment (if (eq size :byte) #b10101110 #b10101111)))))
 
@@ -1554,7 +1595,7 @@
   (:printer string-op ((op #b1010101)))
   (:emitter
    (let ((size (operand-size acc)))
-     (assert (accumulator-p acc))
+     (aver (accumulator-p acc))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment (if (eq size :byte) #b10101010 #b10101011)))))
 
@@ -1581,6 +1622,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)
@@ -1591,6 +1633,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)
@@ -1614,19 +1657,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)))
 
@@ -1642,10 +1699,10 @@
       (emit-byte segment #b11101000)
       (emit-back-patch segment
 		       4
-		       #'(lambda (segment posn)
-			   (emit-dword segment
-				       (- (label-position where)
-					  (+ posn 4))))))
+		       (lambda (segment posn)
+			 (emit-dword segment
+				     (- (label-position where)
+					(+ posn 4))))))
      (fixup
       (emit-byte segment #b11101000)
       (emit-relative-fixup segment where))
@@ -1656,10 +1713,10 @@
 (defun emit-byte-displacement-backpatch (segment target)
   (emit-back-patch segment
 		   1
-		   #'(lambda (segment posn)
-		       (let ((disp (- (label-position target) (1+ posn))))
-			 (assert (<= -128 disp 127))
-			 (emit-byte segment disp)))))
+		   (lambda (segment posn)
+		     (let ((disp (- (label-position target) (1+ posn))))
+		       (aver (<= -128 disp 127))
+		       (emit-byte segment disp)))))
 
 (define-instruction jmp (segment cond &optional where)
   ;; conditional jumps
@@ -1673,39 +1730,38 @@
    (cond (where
 	  (emit-chooser
 	   segment 6 2
-	   #'(lambda (segment posn delta-if-after)
-	       (let ((disp (- (label-position where posn delta-if-after)
-			      (+ posn 2))))
-		 (when (<= -128 disp 127)
-		       (emit-byte segment
-				  (dpb (conditional-opcode cond)
-				       (byte 4 0)
-				       #b01110000))
-		       (emit-byte-displacement-backpatch segment where)
-		       t)))
-	   #'(lambda (segment posn)
-	       (let ((disp (- (label-position where) (+ posn 6))))
-		 (emit-byte segment #b00001111)
+	   (lambda (segment posn delta-if-after)
+	     (let ((disp (- (label-position where posn delta-if-after)
+			    (+ posn 2))))
+	       (when (<= -128 disp 127)
 		 (emit-byte segment
 			    (dpb (conditional-opcode cond)
 				 (byte 4 0)
-				 #b10000000))
-		 (emit-dword segment disp)))))
+				 #b01110000))
+		 (emit-byte-displacement-backpatch segment where)
+		 t)))
+	   (lambda (segment posn)
+	     (let ((disp (- (label-position where) (+ posn 6))))
+	       (emit-byte segment #b00001111)
+	       (emit-byte segment
+			  (dpb (conditional-opcode cond)
+			       (byte 4 0)
+			       #b10000000))
+	       (emit-dword segment disp)))))
 	 ((label-p (setq where cond))
 	  (emit-chooser
 	   segment 5 0
-	   #'(lambda (segment posn delta-if-after)
-	       (let ((disp (- (label-position where posn delta-if-after)
-			      (+ posn 2))))
-		 (when (<= -128 disp 127)
-		       (emit-byte segment #b11101011)
-		       (emit-byte-displacement-backpatch segment where)
-		       t)))
-	   #'(lambda (segment posn)
-	       (let ((disp (- (label-position where) (+ posn 5))))
-		 (emit-byte segment #b11101001)
-		 (emit-dword segment disp))
-	       )))
+	   (lambda (segment posn delta-if-after)
+	     (let ((disp (- (label-position where posn delta-if-after)
+			    (+ posn 2))))
+	       (when (<= -128 disp 127)
+		 (emit-byte segment #b11101011)
+		 (emit-byte-displacement-backpatch segment where)
+		 t)))
+	   (lambda (segment posn)
+	     (let ((disp (- (label-position where) (+ posn 5))))
+	       (emit-byte segment #b11101001)
+	       (emit-dword segment disp)))))
 	 ((fixup-p where)
 	  (emit-byte segment #b11101001)
 	  (emit-relative-fixup segment where))
@@ -1755,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)
@@ -1780,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)
@@ -1791,21 +1896,19 @@
     (cond (length-only
 	   (values 0 (1+ length) nil nil))
 	  (t
-	   (sb!kernel:copy-from-system-area sap (* byte-bits (1+ offset))
-					    vector (* word-bits
-						      vector-data-offset)
-					    (* length byte-bits))
+	   (sb!kernel:copy-ub8-from-system-area sap (1+ offset)
+                                                vector 0 length)
 	   (collect ((sc-offsets)
 		     (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)
@@ -1831,19 +1934,19 @@
     ;; from first principles whether it's defined in some way that genesis
     ;; can't grok.
     (case (byte-imm-code chunk dstate)
-      (#.sb!vm:error-trap
+      (#.error-trap
        (nt "error trap")
        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
-      (#.sb!vm:cerror-trap
+      (#.cerror-trap
        (nt "cerror trap")
        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
-      (#.sb!vm:breakpoint-trap
+      (#.breakpoint-trap
        (nt "breakpoint trap"))
-      (#.sb!vm:pending-interrupt-trap
+      (#.pending-interrupt-trap
        (nt "pending interrupt trap"))
-      (#.sb!vm:halt-trap
+      (#.halt-trap
        (nt "halt trap"))
-      (#.sb!vm:function-end-breakpoint-trap
+      (#.fun-end-breakpoint-trap
        (nt "function end breakpoint trap")))))
 
 (define-instruction break (segment code)
@@ -1928,16 +2031,16 @@
 				 (logior type
 					 (ash (+ posn
 						 (component-header-length))
-					      (- type-bits
+					      (- n-widetag-bits
 						 word-shift)))))))
 
-(define-instruction function-header-word (segment)
+(define-instruction simple-fun-header-word (segment)
   (:emitter
-   (emit-header-data segment function-header-type)))
+   (emit-header-data segment simple-fun-header-widetag)))
 
 (define-instruction lra-header-word (segment)
   (:emitter
-   (emit-header-data segment return-pc-header-type)))
+   (emit-header-data segment return-pc-header-widetag)))
 
 ;;;; fp instructions
 ;;;;
@@ -2045,14 +2148,14 @@
 (define-instruction fadd-sti (segment destination)
   (:printer floating-point-fp ((op '(#b100 #b000))))
   (:emitter
-   (assert (fp-reg-tn-p destination))
+   (aver (fp-reg-tn-p destination))
    (emit-byte segment #b11011100)
    (emit-fp-op segment destination #b000)))
 ;;; with pop
 (define-instruction faddp-sti (segment destination)
   (:printer floating-point-fp ((op '(#b110 #b000))))
   (:emitter
-   (assert (fp-reg-tn-p destination))
+   (aver (fp-reg-tn-p destination))
    (emit-byte segment #b11011110)
    (emit-fp-op segment destination #b000)))
 
@@ -2102,14 +2205,14 @@
 (define-instruction fsub-sti (segment destination)
   (:printer floating-point-fp ((op '(#b100 #b101))))
   (:emitter
-   (assert (fp-reg-tn-p destination))
+   (aver (fp-reg-tn-p destination))
    (emit-byte segment #b11011100)
    (emit-fp-op segment destination #b101)))
 ;;; with a pop
 (define-instruction fsubp-sti (segment destination)
   (:printer floating-point-fp ((op '(#b110 #b101))))
   (:emitter
-   (assert (fp-reg-tn-p destination))
+   (aver (fp-reg-tn-p destination))
    (emit-byte segment #b11011110)
    (emit-fp-op segment destination #b101)))
 
@@ -2121,14 +2224,14 @@
 (define-instruction fsubr-sti (segment destination)
   (:printer floating-point-fp ((op '(#b100 #b100))))
   (:emitter
-   (assert (fp-reg-tn-p destination))
+   (aver (fp-reg-tn-p destination))
    (emit-byte segment #b11011100)
    (emit-fp-op segment destination #b100)))
 ;;; with a pop
 (define-instruction fsubrp-sti (segment destination)
   (:printer floating-point-fp ((op '(#b110 #b100))))
   (:emitter
-   (assert (fp-reg-tn-p destination))
+   (aver (fp-reg-tn-p destination))
    (emit-byte segment #b11011110)
    (emit-fp-op segment destination #b100)))
 
@@ -2156,7 +2259,7 @@
 (define-instruction fmul-sti (segment destination)
   (:printer floating-point-fp ((op '(#b100 #b001))))
   (:emitter
-   (assert (fp-reg-tn-p destination))
+   (aver (fp-reg-tn-p destination))
    (emit-byte segment #b11011100)
    (emit-fp-op segment destination #b001)))
 
@@ -2206,7 +2309,7 @@
 (define-instruction fdiv-sti (segment destination)
   (:printer floating-point-fp ((op '(#b100 #b111))))
   (:emitter
-   (assert (fp-reg-tn-p destination))
+   (aver (fp-reg-tn-p destination))
    (emit-byte segment #b11011100)
    (emit-fp-op segment destination #b111)))
 
@@ -2218,7 +2321,7 @@
 (define-instruction fdivr-sti (segment destination)
   (:printer floating-point-fp ((op '(#b100 #b110))))
   (:emitter
-   (assert (fp-reg-tn-p destination))
+   (aver (fp-reg-tn-p destination))
    (emit-byte segment #b11011100)
    (emit-fp-op segment destination #b110)))
 
@@ -2426,10 +2529,9 @@
 
 ;;; 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
-   (assert (fp-reg-tn-p src))
+   (aver (fp-reg-tn-p src))
    (emit-byte segment #b11011101)
    (emit-fp-op segment src #b100)))