X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fx86%2Finsts.lisp;h=6395c9ea2cf479b710874062e451475f15f0a675;hb=fdf07da187cb31fd5bdd872c73245fd72877b1a1;hp=c0d67525c6bfb6e60cc616817efb1fafad247adc;hpb=2716573f357f204c5f546d1d34d285dd24ff43a1;p=sbcl.git

diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index c0d6752..6395c9e 100644
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -199,7 +199,10 @@
 
 (sb!disassem:define-argument-type displacement
   :sign-extend t
-  :use-label #'offset-next)
+  :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
   :printer #'(lambda (value stream dstate)
@@ -634,12 +637,13 @@
 
 (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))))
 
-(defstruct (ea (:constructor make-ea (size &key base index scale disp)))
+(defstruct (ea (:constructor make-ea (size &key base index scale disp))
+	       (:copier nil))
   (size nil :type (member :byte :word :dword))
   (base nil :type (or tn null))
   (index nil :type (or tn null))
@@ -659,11 +663,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)
@@ -708,7 +712,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)))
@@ -901,7 +905,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))
@@ -909,12 +913,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)
@@ -965,7 +969,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)))
@@ -983,7 +987,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)))
@@ -1027,7 +1031,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))))
 
@@ -1035,7 +1039,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)
@@ -1239,7 +1243,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))))
@@ -1282,7 +1286,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))))
@@ -1291,7 +1295,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))))
@@ -1337,7 +1341,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)
@@ -1515,7 +1519,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)))))
 
@@ -1523,7 +1527,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)))))
 
@@ -1537,7 +1541,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)))))
 
@@ -1545,7 +1549,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)))))
 
@@ -1553,7 +1557,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)))))
 
@@ -1657,7 +1661,7 @@
 		   1
 		   #'(lambda (segment posn)
 		       (let ((disp (- (label-position target) (1+ posn))))
-			 (assert (<= -128 disp 127))
+			 (aver (<= -128 disp 127))
 			 (emit-byte segment disp)))))
 
 (define-instruction jmp (segment cond &optional where)
@@ -2044,14 +2048,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)))
 
@@ -2101,14 +2105,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)))
 
@@ -2120,14 +2124,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)))
 
@@ -2155,7 +2159,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)))
 
@@ -2205,7 +2209,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)))
 
@@ -2217,7 +2221,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)))
 
@@ -2428,7 +2432,7 @@
   ;; XX Printer conflicts with frstor
   ;; (:printer floating-point ((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)))