1.0.3.16: experimental x86-64/darwin suport
[sbcl.git] / src / compiler / x86-64 / insts.lisp
index 73ca2ef..5937993 100644 (file)
     (sb!disassem:dstate-put-inst-prop dstate 'operand-size-8))
   value)
 
+;;; This prefilter is used solely for its side effect, namely to put
+;;; the property OPERAND-SIZE-16 into the DSTATE.
+(defun prefilter-x66 (value dstate)
+  (declare (type (eql #x66) value)
+           (ignore value)
+           (type sb!disassem:disassem-state dstate))
+  (sb!disassem:dstate-put-inst-prop dstate 'operand-size-16))
+
 ;;; A register field that can be extended by REX.R.
 (defun prefilter-reg-r (value dstate)
   (declare (type reg value)
              (princ (schar (symbol-name (inst-operand-size dstate)) 0)
                     stream)))
 
+;;; Used to capture the effect of the #x66 operand size override prefix.
+(sb!disassem:define-arg-type x66
+  :prefilter #'prefilter-x66)
+
 (sb!disassem:define-arg-type displacement
   :sign-extend t
   :use-label #'offset-next
                                         :default-printer '(:name :tab reg))
   (reg     :type 'reg-b-default-qword))
 
-(sb!disassem:define-instruction-format (modrm-reg-no-width 24
-                                     :default-printer '(:name :tab reg))
-  (rex     :field (byte 4 4)    :value #b0100)
-  (wrxb    :field (byte 4 0)    :type 'wrxb)
-  (ff   :field (byte 8 8)  :value #b11111111)
-  (mod   :field (byte 2 22))
-  (modrm-reg :field (byte 3 19))
-  (reg     :field (byte 3 16)   :type 'reg-b)
-  ;; optional fields
-  (accum :type 'accum)
-  (imm))
-
 ;;; Adds a width field to reg-no-width. Note that we can't use
 ;;; :INCLUDE 'REG-NO-WIDTH here to save typing because that would put
 ;;; the WIDTH field last, but the prefilter for WIDTH must run before
   (op  :field (byte 6 10))
   (dir :field (byte 1 9)))
 
+(sb!disassem:define-instruction-format (x66-reg-reg/mem-dir 24
+                                        :default-printer
+                                        `(:name
+                                          :tab
+                                          ,(swap-if 'dir 'reg/mem ", " 'reg)))
+  (x66     :field (byte 8 0)    :type 'x66 :value #x66)
+  (op      :field (byte 6 10))
+  (dir     :field (byte 1 9))
+  (width   :field (byte 1 8)    :type 'width)
+  (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 (x66-rex-reg-reg/mem-dir 32
+                                        :default-printer
+                                        `(:name
+                                          :tab
+                                          ,(swap-if 'dir 'reg/mem ", " 'reg)))
+  (x66     :field (byte 8 0)    :type 'x66 :value #x66)
+  (rex     :field (byte 4 12)   :value #b0100)
+  (wrxb    :field (byte 4 8)    :type 'wrxb)
+  (op      :field (byte 6 18))
+  (dir     :field (byte 1 17))
+  (width   :field (byte 1 16)   :type 'width)
+  (reg/mem :fields (list (byte 2 30) (byte 3 24))
+                                :type 'reg/mem)
+  (reg     :field (byte 3 27)   :type 'reg))
+
 ;;; Same as reg-reg/mem, but uses the reg field as a second op code.
 (sb!disassem:define-instruction-format (reg/mem 16
                                         :default-printer '(:name :tab reg/mem))
                                      :default-printer '(:name :tab code))
  (op :field (byte 8 0))
  (code :field (byte 8 8)))
+
+;;; Two byte instruction with an immediate byte argument.
+;;;
+(sb!disassem:define-instruction-format (word-imm 24
+                                     :default-printer '(:name :tab code))
+  (op :field (byte 16 0))
+  (code :field (byte 8 16)))
+
 \f
 ;;;; primitive emitters
 
        (stack
         ;; Convert stack tns into an index off RBP.
         (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes))))
-          (cond ((< -128 disp 127)
+          (cond ((<= -128 disp 127)
                  (emit-mod-reg-r/m-byte segment #b01 reg #b101)
                  (emit-byte segment disp))
                 (t
   ;; register to/from register/memory
   (:printer reg-reg/mem-dir ((op #b100010)))
   (:printer rex-reg-reg/mem-dir ((op #b100010)))
+  (:printer x66-reg-reg/mem-dir ((op #b100010)))
+  (:printer x66-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))))
   (:printer-list (arith-inst-printer-list #b111))
   (:emitter (emit-random-arith-inst "CMP" segment dst src #b111 t)))
 
+;;; The one-byte encodings for INC and DEC are used as REX prefixes
+;;; in 64-bit mode so we always use the two-byte form.
 (define-instruction inc (segment dst)
-  ;; Register
-  (:printer modrm-reg-no-width ((modrm-reg #b000)))
-  ;; Register/Memory
-  ;; (:printer rex-reg/mem ((op '(#b11111111 #b001))))
   (:printer reg/mem ((op '(#b1111111 #b000))))
+  (:printer rex-reg/mem ((op '(#b1111111 #b000))))
   (:emitter
    (let ((size (operand-size dst)))
      (maybe-emit-operand-size-prefix segment size)
-     (cond #+nil ; these opcodes become REX prefixes in x86-64
-           ((and (not (eq size :byte)) (register-p dst))
-            (emit-byte-with-reg segment #b01000 (reg-tn-encoding dst)))
-           (t
-            (maybe-emit-rex-for-ea segment dst nil)
-            (emit-byte segment (if (eq size :byte) #b11111110 #b11111111))
-            (emit-ea segment dst #b000))))))
+     (maybe-emit-rex-for-ea segment dst nil)
+     (emit-byte segment (if (eq size :byte) #b11111110 #b11111111))
+     (emit-ea segment dst #b000))))
 
 (define-instruction dec (segment dst)
-  ;; Register.
-  (:printer modrm-reg-no-width ((modrm-reg #b001)))
-  ;; Register/Memory
   (:printer reg/mem ((op '(#b1111111 #b001))))
+  (:printer rex-reg/mem ((op '(#b1111111 #b001))))
   (:emitter
    (let ((size (operand-size dst)))
      (maybe-emit-operand-size-prefix segment size)
-     (cond #+nil
-           ((and (not (eq size :byte)) (register-p dst))
-            (emit-byte-with-reg segment #b01001 (reg-tn-encoding dst)))
-           (t
-            (maybe-emit-rex-for-ea segment dst nil)
-            (emit-byte segment (if (eq size :byte) #b11111110 #b11111111))
-            (emit-ea segment dst #b001))))))
+     (maybe-emit-rex-for-ea segment dst nil)
+     (emit-byte segment (if (eq size :byte) #b11111110 #b11111111))
+     (emit-ea segment dst #b001))))
 
 (define-instruction neg (segment dst)
   (:printer reg/mem ((op '(#b1111011 #b011))))
     ;; Lisp (with (DESCRIBE 'BYTE-IMM-CODE)) than to definitively deduce
     ;; from first principles whether it's defined in some way that genesis
     ;; can't grok.
-    (case (byte-imm-code chunk dstate)
+    (case #!-darwin (byte-imm-code chunk dstate)
+          #!+darwin (word-imm-code chunk dstate)
       (#.error-trap
        (nt "error trap")
        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
       (#.halt-trap
        (nt "halt trap"))
       (#.fun-end-breakpoint-trap
-       (nt "function end breakpoint trap")))))
+       (nt "function end breakpoint trap"))
+      (#.single-step-around-trap
+       (nt "single-step trap (around)"))
+      (#.single-step-before-trap
+       (nt "single-step trap (before)")))))
 
 (define-instruction break (segment code)
   (:declare (type (unsigned-byte 8) code))
-  (:printer byte-imm ((op #b11001100)) '(:name :tab code)
-            :control #'break-control)
-  (:emitter
-   (emit-byte segment #b11001100)
+  #!-darwin (:printer byte-imm ((op #b11001100)) '(:name :tab code)
+                     :control #'break-control)
+  #!+darwin (:printer word-imm ((op #b0000101100001111)) '(:name :tab code)
+                     :control #'break-control)
+  (:emitter
+   #!-darwin (emit-byte segment #b11001100)
+   ;; On darwin, trap handling via SIGTRAP is unreliable, therefore we
+   ;; throw a sigill with 0x0b0f instead and check for this in the
+   ;; SIGILL handler and pass it on to the sigtrap handler if
+   ;; appropriate
+   #!+darwin (emit-word segment #b0000101100001111)
    (emit-byte segment code)))
 
 (define-instruction int (segment number)