From c348b6f9484f521583b21757560eb658effe83c4 Mon Sep 17 00:00:00 2001
From: Alexander Gavrilov <angavrilov@gmail.com>
Date: Sat, 7 Aug 2010 17:32:25 +0400
Subject: [PATCH] Implement boxing and unboxing of SSE values in the compiler.

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)))
---
 src/c/sse2.d       | 61 ++++++++++++++++++++++++++++++++++++++++++++++
 src/cmp/cmpffi.lsp | 22 +++++++++++++++++
 src/h/external.h   | 12 +++++++++
 3 files changed, 95 insertions(+)

diff --git a/src/c/sse2.d b/src/c/sse2.d
index ac253200b..8a9fe0ea9 100644
--- a/src/c/sse2.d
+++ b/src/c/sse2.d
@@ -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
diff --git a/src/cmp/cmpffi.lsp b/src/cmp/cmpffi.lsp
index 4cd0db743..aeaca653a 100644
--- a/src/cmp/cmpffi.lsp
+++ b/src/cmp/cmpffi.lsp
@@ -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))))))
 
diff --git a/src/h/external.h b/src/h/external.h
index 59aafd04a..12e885658 100755
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -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 */