Raw pointer loop in array-copy! for vector/vector case
authorDaniel Llorens <daniel.llorens@bluewin.ch>
Fri, 19 Apr 2013 12:53:34 +0000 (14:53 +0200)
committerAndy Wingo <wingo@pobox.com>
Sun, 9 Feb 2014 20:04:25 +0000 (21:04 +0100)
This special case improves

(define a (make-array 1. 1000000 10))
(define b (make-array *unspecified* 1000000 10))
(define c (transpose-array (make-array *unspecified* 10 1000000) 1 0))
,time (array-copy! a b)
,time (array-copy! a c)

from 0.041598s / 0.072561 to 0.012164s / 0.041886s on a i7-3930K.

* libguile/array-map.c: (racp): if both src and dst are on vectors, use
  the element pointers to do the copy.

libguile/array-map.c

index f3f95bc..59de81a 100644 (file)
@@ -328,6 +328,9 @@ SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
 #undef FUNC_NAME
 
 
+/* FIXME src-dst is the wrong order for scm_ra_matchp, but scm_ramapc
+   doesn't send SCM_I_ARRAYP for both src and dst, and this segfaults
+   with the 'right' order. */
 static int
 racp (SCM src, SCM dst)
 {
@@ -337,16 +340,25 @@ racp (SCM src, SCM dst)
   ssize_t inc_s, inc_d;
 
   dst = SCM_CAR (dst);
-  scm_array_get_handle (SCM_I_ARRAY_V (src), &h_s);
-  scm_array_get_handle (SCM_I_ARRAY_V (dst), &h_d);
-
   i_s = SCM_I_ARRAY_BASE (src);
   i_d = SCM_I_ARRAY_BASE (dst);
   inc_s = SCM_I_ARRAY_DIMS (src)->inc;
   inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
 
-  for (; n-- > 0; i_s += inc_s, i_d += inc_d)
-    h_d.vset (h_d.vector, i_d, h_s.vref (h_s.vector, i_s));
+  scm_array_get_handle (SCM_I_ARRAY_V (src), &h_s);
+  scm_array_get_handle (SCM_I_ARRAY_V (dst), &h_d);
+
+  if (h_s.element_type == SCM_ARRAY_ELEMENT_TYPE_SCM
+      && h_d.element_type == SCM_ARRAY_ELEMENT_TYPE_SCM)
+    {
+      SCM const * el_s = h_s.elements;
+      SCM * el_d = h_d.writable_elements;
+      for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+        el_d[i_d] = el_s[i_s];
+    }
+  else
+    for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+      h_d.vset (h_d.vector, i_d, h_s.vref (h_s.vector, i_s));
 
   scm_array_handle_release (&h_d);
   scm_array_handle_release (&h_s);