generate-sse-vops.lisp

   1 #|
   2 Copyright (c) 2005 Risto Laakso
   3 All rights reserved.
   4
   5 Redistribution and use in source and binary forms, with or without
   6 modification, are permitted provided that the following conditions
   7 are met:
   8 1. Redistributions of source code must retain the above copyright
   9    notice, this list of conditions and the following disclaimer.
  10 2. Redistributions in binary form must reproduce the above copyright
  11    notice, this list of conditions and the following disclaimer in the
  12    documentation and/or other materials provided with the distribution.
  13 3. The name of the author may not be used to endorse or promote products
  14    derived from this software without specific prior written permission.
  15
  16 THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
  17 IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  18 OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  19 IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
  20 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  21 NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  22 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  23 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  24 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  25 THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  26 |#
  27
  28 (defun vect-ea (vect idx)
  29   `(make-ea :dword :base ,vect :index ,idx
  30     :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))
  31
  32 (defun gen-vops-to-file (filename)
  33   (with-open-file (stream filename :direction :output :if-exists :supersede)
  34     (gen-vops stream)))
  35
  36 (defun gen-vops (&optional (stream t))
  37
  38   (format stream "(in-package :sb-vm)~%~%")
  39
  40   ;; TWO-ARG SSE VOPs
  41   (loop for (op-name type mov-inst op-inst elem-width) in
  42         '(
  43           ;; single float
  44           (add    single-float movups addps    4)
  45           (addsub single-float movups addsubps 4)
  46           (andnot single-float movups andnps   4)
  47           (and    single-float movups andps    4)
  48           (div    single-float movups divps    4)
  49           (hadd   single-float movups haddps   4)
  50           (hsub   single-float movups hsubps   4)
  51           (max    single-float movups maxps    4)
  52           (min    single-float movups minps    4)
  53           (mul    single-float movups mulps    4)
  54           (or     single-float movups orps     4)
  55           (sub    single-float movups subps    4)
  56           (xor    single-float movups xorps    4)
  57
  58           ;; double float
  59           (add    double-float movupd addpd    8)
  60           (addsub double-float movupd addsubpd 8)
  61           (andnot double-float movupd andnpd   8)
  62           (and    double-float movupd andpd    8)
  63           (div    double-float movupd divpd    8)
  64           (hadd   double-float movupd haddpd   8)
  65           (hsub   double-float movupd hsubpd   8)
  66           (max    double-float movupd maxpd    8)
  67           (min    double-float movupd minpd    8)
  68           (mul    double-float movupd mulpd    8)
  69           (or     double-float movupd orpd     8)
  70           (sub    double-float movupd subpd    8)
  71           (xor    double-float movupd xorpd    8)
  72
  73           ;; unsigned byte 8
  74           (add    unsigned-byte-8 movdqu paddb  1)
  75           (avg    unsigned-byte-8 movdqu pavgb  1)
  76           (max    unsigned-byte-8 movdqu pmaxub 1)
  77           (min    unsigned-byte-8 movdqu pminub 1)
  78           (sub    unsigned-byte-8 movdqu psubb  1)
  79
  80           (and    unsigned-byte-8 movdqu pand   1)
  81           (andn   unsigned-byte-8 movdqu pandn  1)
  82           (or     unsigned-byte-8 movdqu por    1)
  83           (xor    unsigned-byte-8 movdqu pxor   1)
  84
  85           ;; unsigned byte 16
  86           (add    unsigned-byte-16 movdqu paddw 2)
  87           (avg    unsigned-byte-16 movdqu pavgw 2)
  88           (sub    unsigned-byte-16 movdqu psubw 2)
  89
  90           (and    unsigned-byte-16 movdqu pand  2)
  91           (andn   unsigned-byte-16 movdqu pandn 2)
  92           (or     unsigned-byte-16 movdqu por   2)
  93           (xor    unsigned-byte-16 movdqu pxor  2)
  94
  95           (shl    unsigned-byte-16 movdqu psllw 2)
  96           (shr    unsigned-byte-16 movdqu psrlw 2)
  97
  98           ;; signed byte 16
  99           (add    signed-byte-16 movdqu paddw   2)
 100           (max    signed-byte-16 movdqu pmaxsw  2)
 101           (min    signed-byte-16 movdqu pminsw  2)
 102           (sub    signed-byte-16 movdqu psubw   2)
 103
 104           (and    signed-byte-16 movdqu pand    2)
 105           (andn   signed-byte-16 movdqu pandn   2)
 106           (or     signed-byte-16 movdqu por     2)
 107           (xor    signed-byte-16 movdqu pxor    2)
 108
 109           (shl    signed-byte-16 movdqu psllw   2)
 110           (shr    signed-byte-16 movdqu psraw   2)
 111           )
 112         do
 113
 114         (format stream "~S~%~%"
 115                 `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
 116                                          (format t "; defining VOP ~A..~%" name)
 117                                          name)))
 118
 119                   (:policy :fast-safe)
 120
 121                   ;;(:guard (member :sse2 *backend-subfeatures*))
 122
 123                   (:args
 124                    (result :scs (descriptor-reg))
 125                    (vect1 :scs (descriptor-reg))
 126                    (vect2 :scs (descriptor-reg))
 127                    (index :scs (unsigned-reg)))
 128
 129                   (:arg-types
 130                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 131                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 132                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 133                    fixnum)
 134
 135                   (:temporary (:sc sse-reg) sse-temp1)
 136                   (:temporary (:sc sse-reg) sse-temp2)
 137
 138                   (:generator 10
 139
 140                    ;; scale index by 4 (size-of single-float)
 141                    (inst shl index ,(floor (log elem-width 2)))
 142
 143                    ;; load
 144                    (inst ,mov-inst sse-temp1 ,(vect-ea 'vect1 'index))
 145                    (inst ,mov-inst sse-temp2 ,(vect-ea 'vect2 'index))
 146
 147                    ;; operate
 148                    (inst ,op-inst sse-temp1 sse-temp2)
 149
 150                    ;; store
 151                    (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp1)
 152                    ))))
 153
 154   ;; SINGLE-ARG SSE VOPs
 155   (loop for (op-name type mov-inst op-inst elem-width) in
 156         '(
 157           (recip  single-float movups rcpps   4)
 158           (rsqrt  single-float movups rsqrtps 4)
 159           (sqrt   single-float movups sqrtps  4)
 160           (sqrt   double-float movupd sqrtpd  8)
 161           )
 162         do
 163         (format stream "~S~%~%"
 164                 `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
 165                                          (format t "; defining VOP ~A..~%" name)
 166                                          name)))
 167                   (:policy :fast-safe)
 168
 169                   ;;(:guard (member :sse2 *backend-subfeatures*))
 170
 171                   (:args
 172                    (result :scs (descriptor-reg))
 173                    (vect1 :scs (descriptor-reg))
 174                    (index :scs (unsigned-reg)))
 175
 176                   (:arg-types
 177                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 178                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 179                    fixnum)
 180
 181                   (:temporary (:sc sse-reg) sse-temp1)
 182                   (:temporary (:sc sse-reg) sse-temp2)
 183
 184                   (:generator 10
 185
 186                    ;; scale index by 4 (size-of single-float)
 187                    (inst shl index ,(floor (log elem-width 2)))
 188
 189                    ;; load
 190                    (inst ,mov-inst sse-temp1 ,(vect-ea 'vect1 'index))
 191
 192                    ;; operate
 193                    (inst ,op-inst sse-temp2 sse-temp1)
 194
 195                    ;; store
 196                    (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp2)
 197                    ))))
 198
 199   ;; COMPARE
 200   (loop for (op-name type mov-inst op-inst elem-width) in
 201         '(
 202           (cmp    single-float movups cmpps 4)
 203           (cmp    double-float movupd cmppd 8)
 204           )
 205         do
 206         (format stream "~S~%~%"
 207                 `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
 208                                          (format t "; defining VOP ~A..~%" name)
 209                                          name)))
 210
 211                   (:policy :fast-safe)
 212
 213                   ;;(:guard (member :sse2 *backend-subfeatures*))
 214
 215                   (:args
 216                    (result :scs (descriptor-reg))
 217                    (vect1 :scs (descriptor-reg))
 218                    (vect2 :scs (descriptor-reg))
 219                    (index :scs (unsigned-reg)))
 220
 221                   (:info cond)
 222
 223                   (:arg-types
 224                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 225                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 226                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 227                    fixnum
 228                    (:constant keyword)
 229                    )
 230
 231                   (:temporary (:sc sse-reg) sse-temp1)
 232                   (:temporary (:sc sse-reg) sse-temp2)
 233
 234                   (:generator 10
 235
 236                    ;; scale index by 4 (size-of single-float)
 237                    (inst shl index ,(floor (log elem-width 2)))
 238
 239                    ;; load
 240                    (inst ,mov-inst sse-temp1 ,(vect-ea 'vect1 'index))
 241                    (inst ,mov-inst sse-temp2 ,(vect-ea 'vect2 'index))
 242
 243                    ;; operate
 244                    (inst ,op-inst sse-temp1 sse-temp2 cond)
 245
 246                    ;; store
 247                    (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp1)
 248                    ))))
 249
 250   )