From 829ced3e78a23ba153ba4db64e6ea6984c2313b6 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Tue, 21 May 2013 15:11:54 -0400 Subject: [PATCH] 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. --- src/code/fop.lisp | 6 +++++ src/code/pred.lisp | 2 +- src/code/print.lisp | 55 +++++++++++++++++++++++++++++++++++++++++++++ src/code/target-type.lisp | 6 +++++ src/compiler/dump.lisp | 8 +++++++ src/compiler/ir1tran.lisp | 5 ++++- 6 files changed, 80 insertions(+), 2 deletions(-) diff --git a/src/code/fop.lisp b/src/code/fop.lisp index b3863eb..1161239 100644 --- 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)))) ;;;; loading lists diff --git a/src/code/pred.lisp b/src/code/pred.lisp index f303f81..9f8ac78 100644 --- 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 --- 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)))) @@ -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)))))))))) ;;;; functions diff --git a/src/code/target-type.lisp b/src/code/target-type.lisp index 1310453..1f877a0 100644 --- 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)))) diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index cf97382..f2152f0 100644 --- 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 --- 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 -- 1.7.10.4