X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fprimtype.lisp;h=fa33e9c7a1a0659ee3263ab78329508d0f4d4a0b;hb=2372ff8da6e1099e8840b0815d75c414fff2f302;hp=4fee64c00cb0ae2bc3da704d802bdf6910879094;hpb=082940f3f469b8421c54615d7be5bd27aa4c11fb;p=sbcl.git

diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp
index 4fee64c..fa33e9c 100644
--- a/src/compiler/generic/primtype.lisp
+++ b/src/compiler/generic/primtype.lisp
@@ -95,7 +95,16 @@
 (/show0 "about to !DEF-PRIMITIVE-TYPE COMPLEX-DOUBLE-FLOAT")
 (!def-primitive-type complex-double-float (complex-double-reg descriptor-reg)
   :type (complex double-float))
-
+#!+sb-simd-pack
+(progn
+  (/show0 "about to !DEF-PRIMITIVE-TYPE SIMD-PACK")
+  (!def-primitive-type simd-pack-single (single-sse-reg descriptor-reg)
+    :type (simd-pack single-float))
+  (!def-primitive-type simd-pack-double (double-sse-reg descriptor-reg)
+    :type (simd-pack double-float))
+  (!def-primitive-type simd-pack-int (int-sse-reg descriptor-reg)
+   :type (simd-pack integer))
+  (!def-primitive-type-alias simd-pack (:or simd-pack-single simd-pack-double simd-pack-int)))
 
 ;;; primitive other-pointer array types
 (/show0 "primtype.lisp 96")
@@ -372,8 +381,21 @@
                     (= (cdar pairs) (1- sb!xc:char-code-limit)))
                (exactly character)
                (part-of character))))
+        #!+sb-simd-pack
+        (simd-pack-type
+         (let ((eltypes (simd-pack-type-element-type type)))
+           (cond ((member 'integer eltypes)
+                  (exactly simd-pack-int))
+                 ((member 'single-float eltypes)
+                  (exactly simd-pack-single))
+                 ((member 'double-float eltypes)
+                  (exactly simd-pack-double)))))
         (built-in-classoid
          (case (classoid-name type)
+           #!+sb-simd-pack
+           ;; Can't tell what specific type; assume integers.
+           (simd-pack
+            (exactly simd-pack-int))
            ((complex function system-area-pointer weak-pointer)
             (values (primitive-type-or-lose (classoid-name type)) t))
            (cons-type