X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=2abd0ea3a20076b98afe66db043968b9636203b0;hb=b63c4fb9b98fa8188e17ba926e150ba417a74635;hp=4b8fd6c08f34d33c9a5307d46f9e51dad07adc83;hpb=78fa16bf55be44cc16845be84d98023e83fb14bc;p=sbcl.git

diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
index 4b8fd6c..2abd0ea 100644
--- a/src/compiler/x86-64/insts.lisp
+++ b/src/compiler/x86-64/insts.lisp
@@ -1,5 +1,5 @@
-;;;; that part of the description of the x86 instruction set (for
-;;;; 80386 and above) which can live on the cross-compilation host
+;;;; that part of the description of the x86-64 instruction set
+;;;; which can live on the cross-compilation host
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -215,7 +215,7 @@
 			 (if (= index-reg #b100) nil index-reg)
 			 (ash 1 index-scale))))))
 	    ((and (= mod #b00) (= r/m #b101))
-	     (list nil (sb!disassem:read-signed-suffix 32 dstate)) )
+	     (list 'rip (sb!disassem:read-signed-suffix 32 dstate)) )
 	    ((= mod #b00)
 	     (list full-reg))
 	    ((= mod #b01)
@@ -304,6 +304,16 @@
 		     *default-address-size*))
 		dstate)))
 
+(sb!disassem:define-arg-type imm-data-upto-dword
+  :prefilter (lambda (value dstate)
+	       (declare (ignore value)) ; always nil anyway
+	       (let ((width (width-bits
+			     (or (sb!disassem:dstate-get-prop dstate 'width)
+				 *default-address-size*))))
+		 (if (= width 64)
+		     (sb!disassem:read-signed-suffix 32 dstate)
+		   (sb!disassem:read-suffix width dstate)))))
+
 (sb!disassem:define-arg-type signed-imm-data
   :prefilter (lambda (value dstate)
 	       (declare (ignore value)) ; always nil anyway
@@ -470,7 +480,7 @@
 				     :include 'rex-simple
 				     :default-printer '(:name
 							:tab accum ", " imm))
-  (imm :type 'imm-data))
+  (imm :type 'imm-data-upto-dword))
 
 (sb!disassem:define-instruction-format (reg-no-width 8
 				     :default-printer '(:name :tab reg))
@@ -604,7 +614,7 @@
 					:default-printer
 					'(:name :tab reg/mem ", " imm))
   (reg/mem :type 'sized-rex-reg/mem)
-  (imm     :type 'imm-data))
+  (imm     :type 'imm-data-upto-dword))
 
 ;;; Same as reg/mem, but with using the accumulator in the default printer
 (sb!disassem:define-instruction-format
@@ -1199,7 +1209,8 @@
   (:printer rex-reg-reg/mem-dir ((op #b100010)))
   ;; immediate to register/memory
   (:printer reg/mem-imm ((op '(#b1100011 #b000))))
-  (:printer rex-reg/mem-imm ((op '(#b1100011 #b000))))
+  ;; doesn't work for 8-bit register yet
+  (:printer rex-reg/mem-imm ((op '(#b11000111 #b000))))
 
   (:emitter
    (let ((size (matching-operand-size dst src)))
@@ -1377,6 +1388,8 @@
   (:printer reg-no-width ((op #b10010)) '(:name :tab accum ", " reg))
   ;; Register/Memory with Register.
   (:printer reg-reg/mem ((op #b1000011)))
+  ;; doesn't work for 8-bit register yet
+  (:printer rex-reg-reg/mem ((op #b10000111)))
   (:emitter
    (let ((size (matching-operand-size operand1 operand2)))
      (maybe-emit-operand-size-prefix segment size)
@@ -2075,6 +2088,7 @@
 
 (define-instruction call (segment where)
   (:printer near-jump ((op #b11101000)))
+  (:printer rex-reg/mem ((op '(#b11111111 #b010))))
   (:printer reg/mem ((op '(#b1111111 #b010)) (width 1)))
   (:emitter
    (typecase where
@@ -2154,7 +2168,9 @@
 	 (t
 	  (unless (or (ea-p where) (tn-p where))
 		  (error "don't know what to do with ~A" where))
-	  (maybe-emit-rex-for-ea segment where nil)
+	  ;; near jump defaults to 64 bit
+	  ;; w-bit in rex prefix is unnecessary 
+	  (maybe-emit-rex-for-ea segment where nil :operand-size :dword)
 	  (emit-byte segment #b11111111)
 	  (emit-ea segment where #b100)))))