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

Implement boxing and unboxing of SSE values in the compiler.

Browse source 
This makes the SSE types marginally usable via c-inline:

(defun foo (xx yy)
  (let ((sum (ffi:c-inline
                 (xx yy) (:float-sse-pack :float-sse-pack)
                 :float-sse-pack
               "_mm_add_ps(#0,#1)" :one-liner t)))
    (ffi:c-inline (sum) (:float-sse-pack) :float-sse-pack
      "_mm_mul_ps(#0,_mm_set1_ps(3.0))" :one-liner t)))
This commit is contained in:
Alexander Gavrilov 2010-08-07 17:32:25 +04:00 • committed by Juan Jose Garcia Ripoll
parent ce2badff90
commit c348b6f948
3 changed files with 95 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

61
src/c/sse2.d
View file

@ -146,4 +146,65 @@ si_vector_to_sse_pack(cl_object x)
@(return ssev)
}
/* Boxing and unboxing.
The unboxing primitives accept any kind of sse-pack on purpose. */
cl_object
ecl_make_int_sse_pack(__m128i value)
{
cl_object obj = ecl_alloc_object(t_sse_pack);
obj->sse.elttype = aet_b8;
obj->sse.data.vi = value;
@(return obj);
}
__m128i
ecl_unbox_int_sse_pack(cl_object x)
{
do {
if (ECL_SSE_PACK_P(x))
return x->sse.data.vi;
x = ecl_type_error(@'coerce', "variable", x, @'ext::sse-pack');
} while(1);
}
cl_object
ecl_make_float_sse_pack(__m128 value)
{
cl_object obj = ecl_alloc_object(t_sse_pack);
obj->sse.elttype = aet_sf;
obj->sse.data.vf = value;
@(return obj);
}
__m128
ecl_unbox_float_sse_pack(cl_object x)
{
do {
if (ECL_SSE_PACK_P(x))
return x->sse.data.vf;
x = ecl_type_error(@'coerce', "variable", x, @'ext::sse-pack');
} while(1);
}
cl_object
ecl_make_double_sse_pack(__m128d value)
{
cl_object obj = ecl_alloc_object(t_sse_pack);
obj->sse.elttype = aet_df;
obj->sse.data.vd = value;
@(return obj);
}
__m128d
ecl_unbox_double_sse_pack(cl_object x)
{
do {
if (ECL_SSE_PACK_P(x))
return x->sse.data.vd;
x = ecl_type_error(@'coerce', "variable", x, @'ext::sse-pack');
} while(1);
}
#endif // ECL_SSE2

22
src/cmp/cmpffi.lsp
View file

@ -77,6 +77,21 @@
(base-char "char" "CODE_CHAR" "ecl_base_char_code" "CHAR_CODE")
: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"
"ecl_unbox_float_sse_pack" "ecl_unbox_float_sse_pack_unsafe")
#+sse2
:double-sse-pack
#+sse2
(ext:double-sse-pack "__m128d" "ecl_make_double_sse_pack"
"ecl_unbox_double_sse_pack" "ecl_unbox_double_sse_pack_unsafe")
:object
(t "cl_object")
:bool
@ -330,6 +345,13 @@
(wt "(char *)(" loc ")"))
(otherwise
(coercion-error))))
#+sse2
((:int-sse-pack :float-sse-pack :double-sse-pack)
(case loc-rep-type
((:object)
(wt-from-object-conversion dest-type loc-type dest-rep-type loc))
(otherwise
(coercion-error))))
(t
(coercion-error))))))

12
src/h/external.h
View file

@ -1515,6 +1515,18 @@ extern ECL_API cl_object si_sse_pack_as_elt_type(cl_object x, cl_object type);
extern ECL_API cl_object si_vector_to_sse_pack(cl_object x);
extern ECL_API cl_object si_sse_pack_to_vector(cl_object x, cl_object elt_type);
extern ECL_API cl_object ecl_make_int_sse_pack(__m128i value);
extern ECL_API __m128i ecl_unbox_int_sse_pack(cl_object value);
#define ecl_unbox_int_sse_pack_unsafe(x) ((x)->sse.data.vi)
extern ECL_API cl_object ecl_make_float_sse_pack(__m128 value);
extern ECL_API __m128 ecl_unbox_float_sse_pack(cl_object value);
#define ecl_unbox_float_sse_pack_unsafe(x) ((x)->sse.data.vf)
extern ECL_API cl_object ecl_make_double_sse_pack(__m128d value);
extern ECL_API __m128d ecl_unbox_double_sse_pack(cl_object value);
#define ecl_unbox_double_sse_pack_unsafe(x) ((x)->sse.data.vd)
#endif
/* stacks.c */