Additional niceties and middle end support for short vector SIMD packs

 * Allow FASL loading/dumping of (boxed) SIMD packs, and mark them as
   trivially (i.e. without going through make-load-form) dumpable.

 * SIMD packs print nicely, and take the element type into account while
   doing so.

 * (C)TYPE-OF is more accurate for SIMD packs; this enables IR2 conversion
   to choose the right primitive type and storage class for constants.

The FASL code was kept on life support by Alexander Gavrilov for too many years,
and the printing logic is a very light adaptation of the output code he developed
for his branch.

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index b3863eb..1161239 100644 (file)
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -322,6 +322,12 @@
     #!+long-float
     (define-float-fop fop-long-float 52 long-float)))
 
+#!+sb-simd-pack
+(define-fop (fop-simd-pack 88)
+  (with-fast-read-byte ((unsigned-byte 8) *fasl-input-stream*)
+    (%make-simd-pack (fast-read-s-integer 8)
+                     (fast-read-u-integer 8)
+                     (fast-read-u-integer 8))))
 \f
 ;;;; loading lists
 

diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index f303f81..9f8ac78 100644 (file)
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -172,7 +172,7 @@
     (extended-char 'extended-char)
     ((member t) 'boolean)
     (keyword 'keyword)
-    ((or array complex)
+    ((or array complex #!+sb-simd-pack sb!kernel:simd-pack)
      (type-specifier (ctype-of object)))
     (t
      (let* ((classoid (layout-classoid (layout-of object)))

diff --git a/src/code/print.lisp b/src/code/print.lisp
index c86aee4..3aaaf74 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -524,6 +524,9 @@ variable: an unreadable object representing the error is printed instead.")
      (output-code-component object stream))
     (fdefn
      (output-fdefn object stream))
+    #!+sb-simd-pack
+    (simd-pack
+     (output-simd-pack object stream))
     (t
      (output-random object stream))))
 \f
@@ -1775,6 +1778,58 @@ variable: an unreadable object representing the error is printed instead.")
   (print-unreadable-object (fdefn stream)
     (write-string "FDEFINITION object for " stream)
     (output-object (fdefn-name fdefn) stream)))
+
+#!+sb-simd-pack
+(defun output-simd-pack (pack stream)
+  (declare (type simd-pack pack))
+  (cond ((and *print-readably* *read-eval*)
+         (etypecase pack
+           ((simd-pack double-float)
+            (multiple-value-call #'format stream
+              "#.(~S ~S ~S)"
+              '%make-simd-pack-double
+              (%simd-pack-doubles pack)))
+           ((simd-pack single-float)
+            (multiple-value-call #'format stream
+              "#.(~S ~S ~S ~S ~S)"
+              '%make-simd-pack-single
+              (%simd-pack-singles pack)))
+           (t
+            (multiple-value-call #'format stream
+              "#.(~S #X~16,'0X #X~16,'0X)"
+              '%make-simd-pack-ub64
+              (%simd-pack-ub64s pack)))))
+        (t
+         (print-unreadable-object (pack stream)
+           (flet ((all-ones-p (value start end &aux (mask (- (ash 1 end) (ash 1 start))))
+                      (= (logand value mask) mask))
+                    (split-num (value start)
+                      (loop
+                         for i from 0 to 3
+                         and v = (ash value (- start)) then (ash v -8)
+                         collect (logand v #xFF))))
+             (multiple-value-bind (low high)
+                 (%simd-pack-ub64s pack)
+               (etypecase pack
+                 ((simd-pack double-float)
+                  (multiple-value-bind (v0 v1) (%simd-pack-doubles pack)
+                    (format stream "~S~@{ ~:[~,13E~;~*TRUE~]~}"
+                            'simd-pack
+                            (all-ones-p low 0 64) v0
+                            (all-ones-p high 0 64) v1)))
+                 ((simd-pack single-float)
+                  (multiple-value-bind (v0 v1 v2 v3) (%simd-pack-singles pack)
+                    (format stream "~S~@{ ~:[~,7E~;~*TRUE~]~}"
+                            'simd-pack
+                            (all-ones-p low 0 32) v0
+                            (all-ones-p low 32 64) v1
+                            (all-ones-p high 0 32) v2
+                            (all-ones-p high 32 64) v3)))
+                 (t
+                  (format stream "~S~@{ ~{ ~2,'0X~}~}"
+                          'simd-pack
+                          (split-num low 0) (split-num low 32)
+                          (split-num high 0) (split-num high 32))))))))))
 \f
 ;;;; functions
 

diff --git a/src/code/target-type.lisp b/src/code/target-type.lisp
index 1310453..1f877a0 100644 (file)
--- a/src/code/target-type.lisp
+++ b/src/code/target-type.lisp
@@ -167,6 +167,12 @@
      (make-cons-type *universal-type* *universal-type*))
     (character
      (specifier-type 'character))
+    #!+sb-simd-pack
+    (simd-pack
+     (let ((type (nth (%simd-pack-tag x) *simd-pack-element-types*)))
+       (if type
+           (specifier-type `(simd-pack ,type))
+           (specifier-type 'simd-pack))))
     (t
      (classoid-of x))))
 \f

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index cf97382..f2152f0 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -389,6 +389,14 @@
                   (float (dump-float x file))
                   (integer (dump-integer x file)))
                 (equal-save-object x file)))
+             #!+sb-simd-pack
+             (simd-pack
+              (unless (equal-check-table x file)
+                (dump-fop 'fop-simd-pack file)
+                (dump-integer-as-n-bytes (%simd-pack-tag  x) 8 file)
+                (dump-integer-as-n-bytes (%simd-pack-low  x) 8 file)
+                (dump-integer-as-n-bytes (%simd-pack-high x) 8 file))
+              (equal-save-object x file))
              (t
               ;; This probably never happens, since bad things tend to
               ;; be detected during IR1 conversion.

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 8bb36fb..b05f9c3 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -320,7 +320,10 @@
                         symbol
                         number
                         character
-                        string)))
+                        string
+                        #!+sb-simd-pack
+                        #+sb-xc-host nil
+                        #-sb-xc-host sb!kernel:simd-pack)))
              (grovel (value)
                ;; Unless VALUE is an object which which obviously
                ;; can't contain other objects