mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-11 11:42:51 -08:00
Code Issues Projects Releases Packages Wiki Activity

Make boxed SSE packs untyped for all purposes but printing.

Browse source 
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.
This commit is contained in:
Alexander Gavrilov 2010-08-27 18:23:23 +04:00 • committed by Juan Jose Garcia Ripoll
parent 8f835233d6
commit 03049ee7e2
9 changed files with 16 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

5
src/c/predicate.d
View file

@ -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;

18
src/c/sse2.d
View file

@ -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) {

3
src/c/symbols_list.h
View file

@ -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

3
src/c/symbols_list2.h
View file

@ -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

6
src/c/typespec.d
View file

@ -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:

16
src/cmp/cmpffi.lsp
View file

@ -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+))

2
src/cmp/cmptype-arith.lsp
View file

@ -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)

3
src/h/external.h
View file

@ -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);

14
src/lsp/predlib.lsp
View file

@ -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)