Commit 03049ee7 authored by Alexander Gavrilov's avatar Alexander Gavrilov Committed by Juan Jose Garcia Ripoll

Make boxed SSE packs untyped for all purposes but printing.

Now the following rules hold:

- (type-of pack) = SSE-PACK
- (typep pack '*-SSE-PACK) = T

The compiler is tweaked to unbox unidentified packs as
__m128i (integer), assuming that a cast would be inserted
later if that is not what was needed.
parent 8f835233
......@@ -294,10 +294,7 @@ ecl_eql(cl_object x, cl_object y)
ecl_eql(x->complex.imag, y->complex.imag));
#ifdef ECL_SSE2
case t_sse_pack:
return (x->sse.elttype == y->sse.elttype ||
(x->sse.elttype != aet_sf && x->sse.elttype != aet_df &&
y->sse.elttype != aet_sf && y->sse.elttype != aet_df))
&& !memcmp(x->sse.data.b8, y->sse.data.b8, 16);
return !memcmp(x->sse.data.b8, y->sse.data.b8, 16);
#endif
default:
return FALSE;
......
......@@ -31,24 +31,6 @@ si_sse_pack_p(cl_object x)
@(return (ECL_SSE_PACK_P(x) ? Ct : Cnil))
}
cl_object
si_int_sse_pack_p(cl_object x)
{
@(return (ECL_SSE_PACK_P(x) && x->sse.elttype != aet_sf && x->sse.elttype != aet_df ? Ct : Cnil))
}
cl_object
si_float_sse_pack_p(cl_object x)
{
@(return (ECL_SSE_PACK_P(x) && x->sse.elttype == aet_sf ? Ct : Cnil))
}
cl_object
si_double_sse_pack_p(cl_object x)
{
@(return (ECL_SSE_PACK_P(x) && x->sse.elttype == aet_df ? Ct : Cnil))
}
/* Element type substitution */
static void verify_sse_elttype(cl_elttype eltt) {
......
......@@ -1937,11 +1937,8 @@ cl_symbols[] = {
{EXT_ "VECTOR-TO-SSE-PACK", EXT_ORDINARY, si_vector_to_sse_pack, 1, OBJNULL},
{EXT_ "SSE-PACK-TO-VECTOR", EXT_ORDINARY, si_sse_pack_to_vector, 2, OBJNULL},
{EXT_ "INT-SSE-PACK", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "INT-SSE-PACK-P", EXT_ORDINARY, si_int_sse_pack_p, 1, OBJNULL},
{EXT_ "FLOAT-SSE-PACK", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "FLOAT-SSE-PACK-P", EXT_ORDINARY, si_float_sse_pack_p, 1, OBJNULL},
{EXT_ "DOUBLE-SSE-PACK", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "DOUBLE-SSE-PACK-P", EXT_ORDINARY, si_double_sse_pack_p, 1, OBJNULL},
{EXT_ "SSE-PACK-ELEMENT-TYPE", EXT_ORDINARY, si_sse_pack_element_type, 1, OBJNULL},
#endif
......
......@@ -1937,11 +1937,8 @@ cl_symbols[] = {
{EXT_ "VECTOR-TO-SSE-PACK","si_vector_to_sse_pack"},
{EXT_ "SSE-PACK-TO-VECTOR","si_sse_pack_to_vector"},
{EXT_ "INT-SSE-PACK",NULL},
{EXT_ "INT-SSE-PACK-P","si_int_sse_pack_p"},
{EXT_ "FLOAT-SSE-PACK",NULL},
{EXT_ "FLOAT-SSE-PACK-P","si_float_sse_pack_p"},
{EXT_ "DOUBLE-SSE-PACK",NULL},
{EXT_ "DOUBLE-SSE-PACK-P","si_double_sse_pack_p"},
{EXT_ "SSE-PACK-ELEMENT-TYPE","si_sse_pack_element_type"},
#endif
......
......@@ -328,11 +328,7 @@ cl_type_of(cl_object x)
break;
#ifdef ECL_SSE2
case t_sse_pack:
switch (x->sse.elttype) {
case aet_sf: t = @'ext::float-sse-pack'; break;
case aet_df: t = @'ext::double-sse-pack'; break;
default: t = @'ext::int-sse-pack'; break;
}
t = @'ext::sse-pack';
break;
#endif
default:
......
......@@ -78,11 +78,6 @@
:wchar
(character "ecl_character" "CODE_CHAR" "ecl_char_code" "CHAR_CODE")
#+sse2
:int-sse-pack
#+sse2
(ext:int-sse-pack "__m128i" "ecl_make_int_sse_pack"
"ecl_unbox_int_sse_pack" "ecl_unbox_int_sse_pack_unsafe")
#+sse2
:float-sse-pack
#+sse2
(ext:float-sse-pack "__m128" "ecl_make_float_sse_pack"
......@@ -92,6 +87,11 @@
#+sse2
(ext:double-sse-pack "__m128d" "ecl_make_double_sse_pack"
"ecl_unbox_double_sse_pack" "ecl_unbox_double_sse_pack_unsafe")
#+sse2
:int-sse-pack
#+sse2
(ext:sse-pack #|<-intentional|# "__m128i" "ecl_make_int_sse_pack"
"ecl_unbox_int_sse_pack" "ecl_unbox_int_sse_pack_unsafe")
:object
(t "cl_object")
:bool
......@@ -148,7 +148,11 @@
for rep-type = (first record)
for information = (second record)
do (setf (gethash rep-type table) information)
finally (return table)))
finally (progn
#+sse2 ; hack: sse-pack -> int, but int -> int-sse-pack
(setf (gethash :int-sse-pack table)
(list* 'ext:int-sse-pack (cdr (gethash :int-sse-pack table))))
(return table))))
(defun c-number-rep-type-p (rep-type)
(member rep-type +all-number-rep-types+))
......
......@@ -61,7 +61,7 @@
#+clos
(STRUCTURE-OBJECT 'STRUCTURE-OBJECT)
#+sse2
((EXT:INT-SSE-PACK EXT:FLOAT-SSE-PACK EXT:DOUBLE-SSE-PACK) type)
((EXT:SSE-PACK EXT:INT-SSE-PACK EXT:FLOAT-SSE-PACK EXT:DOUBLE-SSE-PACK) type)
(t t))))
(defun valid-type-specifier (type)
......
......@@ -1517,9 +1517,6 @@ extern ECL_API cl_object ecl_copy_seq(cl_object seq);
/* sse2.c */
extern ECL_API cl_object si_sse_pack_p(cl_object x);
extern ECL_API cl_object si_int_sse_pack_p(cl_object x);
extern ECL_API cl_object si_float_sse_pack_p(cl_object x);
extern ECL_API cl_object si_double_sse_pack_p(cl_object x);
extern ECL_API cl_object si_sse_pack_as_elt_type(cl_object x, cl_object type);
extern ECL_API cl_object si_sse_pack_element_type(cl_object x);
......
......@@ -343,9 +343,9 @@ and is not adjustable."
(STRUCTURE . SYS:STRUCTUREP)
(SYMBOL . SYMBOLP)
#+sse2 (EXT:SSE-PACK . EXT:SSE-PACK-P)
#+sse2 (EXT:INT-SSE-PACK . EXT:INT-SSE-PACK-P)
#+sse2 (EXT:FLOAT-SSE-PACK . EXT:FLOAT-SSE-PACK-P)
#+sse2 (EXT:DOUBLE-SSE-PACK . EXT:DOUBLE-SSE-PACK-P)
#+sse2 (EXT:INT-SSE-PACK . EXT:SSE-PACK-P)
#+sse2 (EXT:FLOAT-SSE-PACK . EXT:SSE-PACK-P)
#+sse2 (EXT:DOUBLE-SSE-PACK . EXT:SSE-PACK-P)
(T . CONSTANTLY-T)
(VECTOR . VECTORP))))
......@@ -654,14 +654,6 @@ if not possible."
(FUNCTION (coerce-to-function object))
((VECTOR SIMPLE-VECTOR #+unicode SIMPLE-BASE-STRING SIMPLE-STRING #+unicode BASE-STRING STRING BIT-VECTOR SIMPLE-BIT-VECTOR)
(concatenate type object))
#+sse2
((EXT:INT-SSE-PACK EXT:FLOAT-SSE-PACK EXT:DOUBLE-SSE-PACK)
(if (ext:sse-pack-p object)
(ext:sse-pack-as-elt-type object (case type
(EXT:INT-SSE-PACK '(unsigned-byte 8))
(EXT:FLOAT-SSE-PACK 'single-float)
(EXT:DOUBLE-SSE-PACK 'double-float)))
(error-coerce object type)))
(t
(if (or (listp object) (vector object))
(concatenate type object)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment