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 &optional (idx nil))
  29   `(make-ea :dword :base ,vect ,@(if idx `(: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 xmm-reg) sse-temp1)
 136                   (:temporary (:sc xmm-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   ;; TWO-ARG SSE VOPs w/ DIFFERENT ARG TYPES
 155   (loop for (op-name type1 type2 mov-inst1 mov-inst2 op-inst elem-width) in
 156         '(
 157           (andnot single-float unsigned-byte-8 movups movdqu andnps   4)
 158           (and    single-float unsigned-byte-8 movups movdqu andps    4)
 159           (or     single-float unsigned-byte-8 movups movdqu orps     4)
 160           (xor    single-float unsigned-byte-8 movups movdqu xorps    4)
 161
 162           (andnot double-float unsigned-byte-8 movupd movdqu andnpd   4)
 163           (and    double-float unsigned-byte-8 movupd movdqu andpd    4)
 164           (or     double-float unsigned-byte-8 movupd movdqu orpd     4)
 165           (xor    double-float unsigned-byte-8 movupd movdqu xorpd    4)
 166           )
 167         do
 168         (format stream "~S~%~%"
 169                 `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A/SIMPLE-ARRAY-~A-1" op-name type1 type2)))
 170                                          (format t "; defining VOP ~A..~%" name)
 171                                          name)))
 172
 173                   (:policy :fast-safe)
 174
 175                   ;;(:guard (member :sse2 *backend-subfeatures*))
 176
 177                   (:args
 178                    (result :scs (descriptor-reg))
 179                    (vect1 :scs (descriptor-reg))
 180                    (vect2 :scs (descriptor-reg))
 181                    (index :scs (unsigned-reg)))
 182
 183                   (:arg-types
 184                    ,(intern (format nil "SIMPLE-ARRAY-~A" type2))
 185                    ,(intern (format nil "SIMPLE-ARRAY-~A" type1))
 186                    ,(intern (format nil "SIMPLE-ARRAY-~A" type2))
 187                    fixnum)
 188
 189                   (:temporary (:sc xmm-reg) sse-temp1)
 190                   (:temporary (:sc xmm-reg) sse-temp2)
 191
 192                   (:generator 10
 193
 194                    ;; scale index by 4 (size-of single-float)
 195                    (inst shl index ,(floor (log elem-width 2)))
 196
 197                    ;; load
 198                    (inst ,mov-inst1 sse-temp1 ,(vect-ea 'vect1 'index))
 199                    (inst ,mov-inst2 sse-temp2 ,(vect-ea 'vect2))
 200
 201                    ;; operate
 202                    (inst ,op-inst sse-temp1 sse-temp2)
 203
 204                    ;; store
 205                    (inst ,mov-inst2 ,(vect-ea 'result 'index) sse-temp1)
 206                    ))))
 207
 208
 209   ;; SINGLE-ARG SSE VOPs
 210   (loop for (op-name type mov-inst op-inst elem-width) in
 211         '(
 212           (recip  single-float movups rcpps   4)
 213           (rsqrt  single-float movups rsqrtps 4)
 214           (sqrt   single-float movups sqrtps  4)
 215           (sqrt   double-float movupd sqrtpd  8)
 216           )
 217         do
 218         (format stream "~S~%~%"
 219                 `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
 220                                          (format t "; defining VOP ~A..~%" name)
 221                                          name)))
 222                   (:policy :fast-safe)
 223
 224                   ;;(:guard (member :sse2 *backend-subfeatures*))
 225
 226                   (:args
 227                    (result :scs (descriptor-reg))
 228                    (vect1 :scs (descriptor-reg))
 229                    (index :scs (unsigned-reg)))
 230
 231                   (:arg-types
 232                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 233                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 234                    fixnum)
 235
 236                   (:temporary (:sc xmm-reg) sse-temp1)
 237                   (:temporary (:sc xmm-reg) sse-temp2)
 238
 239                   (:generator 10
 240
 241                    ;; scale index by 4 (size-of single-float)
 242                    (inst shl index ,(floor (log elem-width 2)))
 243
 244                    ;; load
 245                    (inst ,mov-inst sse-temp1 ,(vect-ea 'vect1 'index))
 246
 247                    ;; operate
 248                    (inst ,op-inst sse-temp2 sse-temp1)
 249
 250                    ;; store
 251                    (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp2)
 252                    ))))
 253
 254   ;; COMPARE
 255   (loop for (op-name type mov-inst op-inst elem-width) in
 256         '(
 257           (cmp    single-float movups cmpps 4)
 258           (cmp    double-float movupd cmppd 8)
 259           )
 260         do
 261         (format stream "~S~%~%"
 262                 `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
 263                                          (format t "; defining VOP ~A..~%" name)
 264                                          name)))
 265
 266                   (:policy :fast-safe)
 267
 268                   ;;(:guard (member :sse2 *backend-subfeatures*))
 269
 270                   (:args
 271                    (result :scs (descriptor-reg))
 272                    (vect1 :scs (descriptor-reg))
 273                    (vect2 :scs (descriptor-reg))
 274                    (index :scs (unsigned-reg)))
 275
 276                   (:info cond)
 277
 278                   (:arg-types
 279                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 280                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 281                    ,(intern (format nil "SIMPLE-ARRAY-~A" type))
 282                    fixnum
 283                    (:constant keyword)
 284                    )
 285
 286                   (:temporary (:sc xmm-reg) sse-temp1)
 287                   (:temporary (:sc xmm-reg) sse-temp2)
 288
 289                   (:generator 10
 290
 291                    ;; scale index by 4 (size-of single-float)
 292                    (inst shl index ,(floor (log elem-width 2)))
 293
 294                    ;; load
 295                    (inst ,mov-inst sse-temp1 ,(vect-ea 'vect1 'index))
 296                    (inst ,mov-inst sse-temp2 ,(vect-ea 'vect2 'index))
 297
 298                    ;; operate
 299                    (inst ,op-inst sse-temp1 sse-temp2 cond)
 300
 301                    ;; store
 302                    (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp1)
 303                    ))))
 304
 305   )