sb-bsd-sockets: GET-ADDRESS-INFO foreign memory leak
[sbcl.git] / src / compiler / x86-64 / insts.lisp
index 52b4256..5fc70d6 100644 (file)
     vec))
 ) ; EVAL-WHEN
 
+;;; SSE shuffle patterns. The names end in the number of bits of the
+;;; immediate byte that are used to encode the pattern and the radix
+;;; in which to print the value.
+(macrolet ((define-sse-shuffle-arg-type (name format-string)
+               `(sb!disassem:define-arg-type ,name
+                  :type 'imm-byte
+                  :printer (lambda (value stream dstate)
+                             (declare (type (unsigned-byte 8) value)
+                                      (type stream stream)
+                                      (ignore dstate))
+                             (format stream ,format-string value)))))
+  (define-sse-shuffle-arg-type sse-shuffle-pattern-2-2 "#b~2,'0B")
+  (define-sse-shuffle-arg-type sse-shuffle-pattern-8-4 "#4r~4,4,'0R"))
+
 ;;; Set assembler parameters. (In CMU CL, this was done with
 ;;; a call to a macro DEF-ASSEMBLER-PARAMS.)
 (eval-when (:compile-toplevel :load-toplevel :execute)
   ;; optional fields
   (imm))
 
+(sb!disassem:define-instruction-format (x66-ext-reg-reg/mem 32
+                                        :default-printer
+                                        `(:name :tab reg ", " reg/mem))
+  (x66     :field (byte 8 0)    :type 'x66 :value #x66)
+  (prefix  :field (byte 8 8)    :value #b00001111)
+  (op      :field (byte 7 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)
+  ;; optional fields
+  (imm))
+
+(sb!disassem:define-instruction-format (rex-ext-reg-reg/mem 32
+                                        :default-printer
+                                        `(:name :tab reg ", " reg/mem))
+  (rex     :field (byte 4 4)    :value #b0100)
+  (wrxb    :field (byte 4 0)    :type 'wrxb)
+  (prefix  :field (byte 8 8)    :value #b00001111)
+  (op      :field (byte 7 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)
+  ;; optional fields
+  (imm))
+
+(sb!disassem:define-instruction-format (x66-rex-ext-reg-reg/mem 40
+                                        :default-printer
+                                        `(:name :tab reg ", " reg/mem))
+  (x66     :field (byte 8 0)    :type 'x66 :value #x66)
+  (rex     :field (byte 4 12)   :value #b0100)
+  (wrxb    :field (byte 4 8)    :type 'wrxb)
+  (prefix  :field (byte 8 16)   :value #b00001111)
+  (op      :field (byte 7 25))
+  (width   :field (byte 1 24)   :type 'width)
+  (reg/mem :fields (list (byte 2 38) (byte 3 32))
+                                :type 'reg/mem)
+  (reg     :field (byte 3 35)   :type 'reg)
+  ;; optional fields
+  (imm))
+
+(eval-when (:compile-toplevel :execute)
+  (defun ext-reg-reg/mem-printer-list (op &optional printer)
+    `((ext-reg-reg/mem         ((op ,op)) ,@(when printer (list printer)))
+      (x66-ext-reg-reg/mem     ((op ,op)) ,@(when printer (list printer)))
+      (rex-ext-reg-reg/mem     ((op ,op)) ,@(when printer (list printer)))
+      (x66-rex-ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer))))))
+
 (sb!disassem:define-instruction-format (ext-reg-reg/mem-no-width 24
                                         :default-printer
                                         `(:name :tab reg ", " reg/mem))
   (op      :field (byte 8 8))
   (reg/mem :fields (list (byte 2 22) (byte 3 16))
                                 :type 'xmmreg/mem)
-  (reg     :field (byte 3 19)   :type 'xmmreg))
+  (reg     :field (byte 3 19)   :type 'xmmreg)
+  ;; optional fields
+  (imm))
 
 (sb!disassem:define-instruction-format (rex-xmm-xmm/mem 32
                                         :default-printer
   (op      :field (byte 8 16))
   (reg/mem :fields (list (byte 2 30) (byte 3 24))
                                 :type 'xmmreg/mem)
-  (reg     :field (byte 3 27)   :type 'xmmreg))
+  (reg     :field (byte 3 27)   :type 'xmmreg)
+  (imm))
 
 (sb!disassem:define-instruction-format (ext-xmm-xmm/mem 32
                                         :default-printer
   (op      :field (byte 8 16))
   (reg/mem :fields (list (byte 2 30) (byte 3 24))
                                 :type 'xmmreg/mem)
-  (reg     :field (byte 3 27)   :type 'xmmreg))
+  (reg     :field (byte 3 27)   :type 'xmmreg)
+  (imm))
 
 (sb!disassem:define-instruction-format (ext-rex-xmm-xmm/mem 40
                                         :default-printer
   (op      :field (byte 8 24))
   (reg/mem :fields (list (byte 2 38) (byte 3 32))
                                 :type 'xmmreg/mem)
-  (reg     :field (byte 3 35)   :type 'xmmreg))
+  (reg     :field (byte 3 35)   :type 'xmmreg)
+  (imm))
 
 ;;; Same as xmm-xmm/mem etc., but with direction bit.
 
   :type 'imm-byte
   :printer *sse-conditions*)
 
-;;; XMM instructions with 8 bit immediate data
-
-(sb!disassem:define-instruction-format (xmm-xmm/mem-imm 24
-                                        :default-printer
-                                        '(:name
-                                          :tab reg ", " reg/mem ", " imm))
-  (x0f     :field (byte 8 0)    :value #x0f)
-  (op      :field (byte 8 8))
-  (reg/mem :fields (list (byte 2 22) (byte 3 16))
-                                :type 'xmmreg/mem)
-  (reg     :field (byte 3 19)   :type 'xmmreg)
-  (imm     :type 'imm-byte))
-
-(sb!disassem:define-instruction-format (rex-xmm-xmm/mem-imm 32
-                                        :default-printer
-                                        '(:name
-                                          :tab reg ", " reg/mem ", " imm))
-  (rex     :field (byte 4 4)    :value #b0100)
-  (wrxb    :field (byte 4 0)    :type 'wrxb)
-  (x0f     :field (byte 8 8)    :value #x0f)
-  (op      :field (byte 8 16))
-  (reg/mem :fields (list (byte 2 30) (byte 3 24))
-                                :type 'xmmreg/mem)
-  (reg     :field (byte 3 27)   :type 'xmmreg)
-  (imm     :type 'imm-byte))
-
-(sb!disassem:define-instruction-format (ext-xmm-xmm/mem-imm 32
-                                        :default-printer
-                                        '(:name
-                                          :tab reg ", " reg/mem ", " imm))
-  (prefix  :field (byte 8 0))
-  (x0f     :field (byte 8 8)    :value #x0f)
-  (op      :field (byte 8 16))
-  (reg/mem :fields (list (byte 2 30) (byte 3 24))
-                                :type 'xmmreg/mem)
-  (reg     :field (byte 3 27)   :type 'xmmreg)
-  (imm     :type 'imm-byte))
-
-(sb!disassem:define-instruction-format (ext-rex-xmm-xmm/mem-imm 40
-                                        :default-printer
-                                        '(:name
-                                          :tab reg ", " reg/mem ", " imm))
-  (prefix  :field (byte 8 0))
-  (rex     :field (byte 4 12)   :value #b0100)
-  (wrxb    :field (byte 4 8)    :type 'wrxb)
-  (x0f     :field (byte 8 16)   :value #x0f)
-  (op      :field (byte 8 24))
-  (reg/mem :fields (list (byte 2 38) (byte 3 32))
-                                :type 'xmmreg/mem)
-  (reg     :field (byte 3 35)   :type 'xmmreg)
-  (imm     :type 'imm-byte))
-
 (sb!disassem:define-instruction-format (string-op 8
                                      :include 'simple
                                      :default-printer '(:name width)))
 
 (define-instruction cmpxchg (segment dst src &optional prefix)
   ;; Register/Memory with Register.
-  (:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg))
+  (:printer-list (ext-reg-reg/mem-printer-list #b1011000
+                                               '(:name :tab reg/mem ", " reg)))
   (:emitter
    (aver (register-p src))
    (emit-prefix segment prefix)
 
 (define-instruction xadd (segment dst src &optional prefix)
   ;; Register/Memory with Register.
-  (:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg))
+  (:printer-list (ext-reg-reg/mem-printer-list #b1100000
+                                               '(:name :tab reg/mem ", " reg)))
   (:emitter
    (aver (register-p src))
    (emit-prefix segment prefix)
       (ext-reg-reg/mem-imm ((op ,(logior op #b100))
                             (imm nil :type signed-imm-byte)))
       (ext-reg-reg/mem ((op ,(logior op #b101)))
-         (:name :tab reg/mem ", " 'cl)))))
+         (:name :tab reg/mem ", " reg ", " 'cl)))))
 
 (define-instruction shld (segment dst src amt)
   (:declare (type (or (member :cl) (mod 32)) amt))
 (macrolet
     ((define-imm-sse-instruction (name opcode /i)
          `(define-instruction ,name (segment dst/src imm)
-            (:printer ext-rex-xmm-imm ((prefix #x66) (op ,opcode) (/i ,/i)))
-            (:printer ext-xmm-imm ((prefix #x66) (op ,opcode) (/i ,/i)))
+            (:printer-list
+             ',(sse-inst-printer-list 'xmm-imm #x66 opcode
+                                      :more-fields `((/i ,/i))))
             (:emitter
              (emit-sse-inst-with-imm segment dst/src imm
                                      #x66 ,opcode ,/i
 
 (macrolet ((define-regular-sse-inst (name prefix opcode)
              `(define-instruction ,name (segment dst src)
-                ,@(if prefix
-                      `((:printer ext-xmm-xmm/mem
-                                  ((prefix ,prefix) (op ,opcode)))
-                        (:printer ext-rex-xmm-xmm/mem
-                                  ((prefix ,prefix) (op ,opcode))))
-                      `((:printer xmm-xmm/mem ((op ,opcode)))
-                        (:printer rex-xmm-xmm/mem ((op ,opcode)))))
+                (:printer-list
+                 ',(sse-inst-printer-list 'xmm-xmm/mem prefix opcode))
                 (:emitter
                  (emit-regular-sse-inst segment dst src ,prefix ,opcode)))))
   ;; logical
   (define-regular-sse-inst punpckldq #x66 #x62)
   (define-regular-sse-inst punpcklqdq #x66 #x6c))
 
-(macrolet ((define-xmm-shuffle-sse-inst (name prefix opcode)
-               `(define-instruction ,name (segment dst src pattern)
-                  ,@(if prefix
-                        `((:printer ext-xmm-xmm/mem-imm ; suboptimal
-                                    ((prefix ,prefix) (op ,opcode)))
-                          (:printer ext-rex-xmm-xmm/mem-imm
-                                    ((prefix ,prefix) (op ,opcode))))
-                        `((:printer xmm-xmm/mem-imm ((op ,opcode)))
-                          (:printer rex-xmm-xmm/mem-imm ((op ,opcode)))))
-                  (:emitter
-                   (aver (typep pattern '(unsigned-byte 8)))
-                   (emit-regular-sse-inst segment dst src ,prefix ,opcode
-                                          :remaining-bytes 1)
-                   (emit-byte segment pattern)))))
-  (define-xmm-shuffle-sse-inst pshufd  #x66 #x70)
-  (define-xmm-shuffle-sse-inst pshufhw #xf3 #x70)
-  (define-xmm-shuffle-sse-inst pshuflw #xf2 #x70)
-  (define-xmm-shuffle-sse-inst shufpd  #x66 #xc6)
-  (define-xmm-shuffle-sse-inst shufps  nil  #xc6))
+(macrolet ((define-xmm-shuffle-sse-inst (name prefix opcode n-bits radix)
+               (let ((shuffle-pattern
+                      (intern (format nil "SSE-SHUFFLE-PATTERN-~D-~D"
+                                      n-bits radix))))
+                 `(define-instruction ,name (segment dst src pattern)
+                    (:printer-list
+                     ',(sse-inst-printer-list
+                        'xmm-xmm/mem prefix opcode
+                        :more-fields `((imm nil :type ,shuffle-pattern))
+                        :printer '(:name :tab reg ", " reg/mem ", " imm)))
+
+                    (:emitter
+                     (aver (typep pattern '(unsigned-byte ,n-bits)))
+                     (emit-regular-sse-inst segment dst src ,prefix ,opcode
+                                            :remaining-bytes 1)
+                     (emit-byte segment pattern))))))
+  (define-xmm-shuffle-sse-inst pshufd  #x66 #x70 8 4)
+  (define-xmm-shuffle-sse-inst pshufhw #xf3 #x70 8 4)
+  (define-xmm-shuffle-sse-inst pshuflw #xf2 #x70 8 4)
+  (define-xmm-shuffle-sse-inst shufpd  #x66 #xc6 2 2)
+  (define-xmm-shuffle-sse-inst shufps  nil  #xc6 8 4))
 
 ;; MASKMOVDQU (dst is DS:RDI)
 (define-instruction maskmovdqu (segment src mask)
-  (:printer ext-xmm-xmm/mem
-            ((prefix #x66) (op #xf7)))
-  (:printer ext-rex-xmm-xmm/mem
-            ((prefix #x66) (op #xf7)))
+  (:printer-list
+   (sse-inst-printer-list 'xmm-xmm/mem #x66 #xf7))
   (:emitter
    (aver (xmm-register-p src))
    (aver (xmm-register-p mask))
                `(define-instruction ,name (segment op x y)
                   (:printer-list
                    ',(sse-inst-printer-list
-                      'xmm-xmm/mem-imm prefix opcode
+                      'xmm-xmm/mem prefix opcode
                       :more-fields '((imm nil :type sse-condition-code))
                       :printer `(,name-prefix imm ,name-suffix
                                  :tab reg ", " reg/mem)))
 ;;; MOVSD, MOVSS
 (macrolet ((define-movsd/ss-sse-inst (name prefix)
              `(define-instruction ,name (segment dst src)
-                (:printer ext-xmm-xmm/mem-dir ((prefix ,prefix)
-                                               (op #b0001000)))
-                (:printer ext-rex-xmm-xmm/mem-dir ((prefix ,prefix)
-                                                   (op #b0001000)))
+                (:printer-list
+                 ',(sse-inst-printer-list 'xmm-xmm/mem-dir
+                                          prefix #b0001000))
                 (:emitter
                  (cond ((xmm-register-p dst)
                         (emit-sse-inst segment dst src ,prefix #x10
                         (:emitter
                          (aver (xmm-register-p dst))
                          (aver (xmm-register-p src))
-                         (emit-regular-sse-inst segment dst src ,prefix ,opcode-from))))
+                         (emit-regular-sse-inst segment dst src
+                                                ,prefix ,opcode-from))))
                   (define-instruction ,name (segment dst src)
-                    ,@(let ((printers
-                             (if prefix
-                                 `((:printer ext-xmm-xmm/mem
-                                             ((prefix ,prefix) (op ,opcode-from)))
-                                   (:printer ext-rex-xmm-xmm/mem
-                                             ((prefix ,prefix) (op ,opcode-from)))
-                                   (:printer ext-xmm-xmm/mem
-                                             ((prefix ,prefix) (op ,opcode-to))
-                                             '(:name :tab reg/mem ", " reg))
-                                   (:printer ext-rex-xmm-xmm/mem
-                                             ((prefix ,prefix) (op ,opcode-to))
-                                             '(:name :tab reg/mem ", " reg)))
-                                 `((:printer xmm-xmm/mem
-                                             ((op ,opcode-from)))
-                                   (:printer rex-xmm-xmm/mem
-                                             ((op ,opcode-from)))
-                                   (:printer xmm-xmm/mem
-                                             ((op ,opcode-to))
-                                             '(:name :tab reg/mem ", " reg))
-                                   (:printer rex-xmm-xmm/mem
-                                             ((op ,opcode-to))
-                                             '(:name :tab reg/mem ", " reg))))))
-                        (if opcode-from printers (cddr printers)))
+                    (:printer-list
+                     '(,@(when opcode-from
+                           (sse-inst-printer-list
+                            'xmm-xmm/mem prefix opcode-from))
+                       ,@(sse-inst-printer-list
+                          'xmm-xmm/mem prefix opcode-to
+                          :printer '(:name :tab reg/mem ", " reg))))
                     (:emitter
                      (cond ,@(when opcode-from
                                `(((xmm-register-p dst)
                                   ,(when force-to-mem
                                      `(aver (not (or (register-p src)
                                                      (xmm-register-p src)))))
-                                  (emit-regular-sse-inst segment dst src ,prefix ,opcode-from))))
+                                  (emit-regular-sse-inst
+                                   segment dst src ,prefix ,opcode-from))))
                            (t
                             (aver (xmm-register-p src))
                             ,(when force-to-mem
                                `(aver (not (or (register-p dst)
                                                (xmm-register-p dst)))))
-                            (emit-regular-sse-inst segment src dst ,prefix ,opcode-to))))))))
+                            (emit-regular-sse-inst segment src dst
+                                                   ,prefix ,opcode-to))))))))
   ;; direction bit?
   (define-mov-sse-inst movapd #x66 #x28 #x29)
   (define-mov-sse-inst movaps nil  #x28 #x29)
 
 ;;; MOVQ
 (define-instruction movq (segment dst src)
-  (:printer ext-xmm-xmm/mem ((prefix #xf3) (op #x7e)))
-  (:printer ext-rex-xmm-xmm/mem ((prefix #xf3) (op #x7e)))
-  (:printer ext-xmm-xmm/mem ((prefix #x66) (op #xd6))
-            '(:name :tab reg/mem ", " reg))
-  (:printer ext-rex-xmm-xmm/mem ((prefix #x66) (op #xd6))
-            '(:name :tab reg/mem ", " reg))
+  (:printer-list
+   (append
+    (sse-inst-printer-list 'xmm-xmm/mem #xf3 #x7e)
+    (sse-inst-printer-list 'xmm-xmm/mem #x66 #xd6
+                           :printer '(:name :tab reg/mem ", " reg))))
   (:emitter
    (cond ((xmm-register-p dst)
           (emit-sse-inst segment dst src #xf3 #x7e
 ;;; with zero extension or vice versa.
 ;;; We do not support the MMX version of this instruction.
 (define-instruction movd (segment dst src)
-  (:printer ext-xmm-reg/mem ((prefix #x66) (op #x6e)))
-  (:printer ext-rex-xmm-reg/mem ((prefix #x66) (op #x6e)))
-  (:printer ext-xmm-reg/mem ((prefix #x66) (op #x7e))
-            '(:name :tab reg/mem ", " reg))
-  (:printer ext-rex-xmm-reg/mem ((prefix #x66) (op #x7e))
-            '(:name :tab reg/mem ", " reg))
+  (:printer-list
+   (append
+    (sse-inst-printer-list 'xmm-reg/mem #x66 #x6e)
+    (sse-inst-printer-list 'xmm-reg/mem #x66 #x7e
+                           :printer '(:name :tab reg/mem ", " reg))))
   (:emitter
    (cond ((xmm-register-p dst)
           (emit-sse-inst segment dst src #x66 #x6e))
 
 (macrolet ((define-integer-source-sse-inst (name prefix opcode &key mem-only)
              `(define-instruction ,name (segment dst src)
-                ,@(if prefix
-                      `((:printer ext-xmm-reg/mem ((prefix ,prefix) (op ,opcode)))
-                        (:printer ext-rex-xmm-reg/mem ((prefix ,prefix) (op ,opcode))))
-                      `((:printer xmm-reg/mem ((op ,opcode)))
-                        (:printer rex-xmm-reg/mem ((op ,opcode)))))
-
+                (:printer-list
+                 ',(sse-inst-printer-list 'xmm-reg/mem prefix opcode))
                 (:emitter
                  (aver (xmm-register-p dst))
                  ,(when mem-only
 
 (macrolet ((define-gpr-destination-sse-inst (name prefix opcode &key reg-only)
              `(define-instruction ,name (segment dst src)
-                ,@(if prefix
-                      `((:printer ext-reg-xmm/mem ((prefix ,prefix) (op ,opcode)))
-                        (:printer ext-rex-reg-xmm/mem ((prefix ,prefix) (op ,opcode))))
-                      `((:printer reg-xmm/mem ((op ,opcode)))
-                        (:printer rex-reg-xmm/mem ((op ,opcode)))))
+                (:printer-list
+                 ',(sse-inst-printer-list 'reg-xmm/mem prefix opcode))
                 (:emitter
                  (aver (register-p dst))
                  ,(when reg-only