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

diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index b764f08..514f116 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))
@@ -189,64 +199,64 @@
 
 ;;;; disassembler argument types
 
-(sb!disassem:define-argument-type displacement
+(sb!disassem:define-arg-type displacement
   :sign-extend t
   :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-argument-type accum
+(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-argument-type word-accum
+(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-argument-type reg
+(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
+(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-argument-type signed-imm-data
+(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-argument-type signed-imm-byte
+(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-argument-type signed-imm-dword
+(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-argument-type imm-word
+(sb!disassem:define-arg-type imm-word
   :prefilter (lambda (value dstate)
 	       (declare (ignore value)) ; always nil anyway
 	       (let ((width
@@ -255,25 +265,28 @@
 		 (sb!disassem:read-suffix (width-bits width) dstate))))
 
 ;;; needed for the ret imm16 instruction
-(sb!disassem:define-argument-type imm-word-16
+(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))
@@ -282,11 +295,11 @@
   (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)
@@ -330,7 +343,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)
@@ -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.
 
@@ -791,9 +810,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 +1053,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 +1136,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 +1148,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 +1595,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 +1606,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 +1630,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)))
 
@@ -1790,13 +1828,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)