Re: array-copy! is slow & array-map.c (was: Extremly slow for format & string-join)

[Daniel Llorens <daniel.llorens@bluewin.ch>]

[-- Attachment #1: Type: text/plain, Size: 3191 bytes --]


On Apr 2, 2013, at 12:19, Daniel Llorens wrote:

> On Apr 1, 2013, at 19:15, Daniel Llorens wrote:
> 
>> Third, none of the above are causing the slowness of array-copy!. I noticed that there's a double indirection in racp(). The second patch removes it. Actually this double indirection goes on all over array-map.c and I don't understand why it's needed...
> 
> This patch does the same for array-fill!. The improvement is similar.

These two patches do it for array-map!.

The first patch avoids cons for the 1-argument case. The second patch removes the double indirection for the first two arguments in every case. Since there's some work done inside the loop, the improvement is smaller than for array-copy! or array-fill!.

Before the first patch:

scheme@(guile-user)> (define a (make-array 0. 1000000 10))
scheme@(guile-user)> (define b (make-array 0. 1000000 10))
scheme@(guile-user)> (define c (make-array *unspecified* 1000000 10))
scheme@(guile-user)> (define d (transpose-array (make-array *unspecified* 10 1000000) 1 0))
scheme@(guile-user)> ,time (array-map! c (const 0.))
;; 0.558498s real time, 0.556974s run time.  0.000000s spent in GC.
scheme@(guile-user)> ,time (array-map! c values a)
;; 1.467717s real time, 1.463470s run time.  0.269786s spent in GC.
scheme@(guile-user)> ,time (array-map! c values d)
;; 1.500785s real time, 1.496482s run time.  0.254156s spent in GC.
scheme@(guile-user)> ,time (array-map! c (lambda (a b) (+ a b)) a b)
;; 2.278655s real time, 2.271948s run time.  0.528379s spent in GC.

After the first patch:

scheme@(guile-user)> (define a (make-array 0. 1000000 10))
scheme@(guile-user)> (define b (make-array 0. 1000000 10))
scheme@(guile-user)> (define c (make-array *unspecified* 1000000 10))
scheme@(guile-user)> (define d (transpose-array (make-array *unspecified* 10 1000000) 1 0))
scheme@(guile-user)> ,time (array-map! c (const 0.))
;; 0.559337s real time, 0.557811s run time.  0.000000s spent in GC.
scheme@(guile-user)> ,time (array-map! c values a)
;; 1.038836s real time, 1.035859s run time.  0.134621s spent in GC.
scheme@(guile-user)> ,time (array-map! c values d)
;; 1.041937s real time, 1.039000s run time.  0.125787s spent in GC.
scheme@(guile-user)> ,time (array-map! c (lambda (a b) (+ a b)) a b)
;; 2.294594s real time, 2.287883s run time.  0.518576s spent in GC.

After both patches:

scheme@(guile-user)> (define a (make-array 0. 1000000 10))
scheme@(guile-user)> (define b (make-array 0. 1000000 10))
scheme@(guile-user)> (define c (make-array *unspecified* 1000000 10))
scheme@(guile-user)> (define d (transpose-array (make-array *unspecified* 10 1000000) 1 0))
scheme@(guile-user)> ,time (array-map! c (const 0.))
;; 0.467621s real time, 0.466343s run time.  0.000000s spent in GC.
scheme@(guile-user)> ,time (array-map! c values a)
;; 0.823515s real time, 0.821152s run time.  0.135106s spent in GC.
scheme@(guile-user)> ,time (array-map! c values d)
;; 0.825138s real time, 0.822763s run time.  0.124970s spent in GC.
scheme@(guile-user)> ,time (array-map! c (lambda (a b) (+ a b)) a b)
;; 2.066735s real time, 2.060635s run time.  0.525089s spent in GC.


[-- Attachment #2: 0005-Avoid-per-element-cons-for-1-arg-case-of-array-map.patch --]
[-- Type: application/octet-stream, Size: 2683 bytes --]

From 1bdf84a420defad44721e7ba1915e16621745b57 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Tue, 2 Apr 2013 15:23:55 +0200
Subject: [PATCH 5/7] Avoid per-element cons for 1-arg case of array-map!

* libguile/array-map.c: (ramap): special case when ras is a 1-element list.
---
 libguile/array-map.c |   45 ++++++++++++++++++++++++++-------------------
 1 file changed, 26 insertions(+), 19 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index f591419..079e3b1 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -390,31 +390,38 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
 static int
 ramap (SCM ra0, SCM proc, SCM ras)
 {
-  long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
-  long inc = SCM_I_ARRAY_DIMS (ra0)->inc;
-  long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
-  long base = SCM_I_ARRAY_BASE (ra0) - i * inc;
+  ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
+
+  size_t i0 = SCM_I_ARRAY_BASE (ra0);
+  ssize_t inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+  size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
+  size_t i0end = i0 + n*inc0;
   ra0 = SCM_I_ARRAY_V (ra0);
   if (scm_is_null (ras))
-    for (; i <= n; i++)
-      GVSET (ra0, i*inc+base, scm_call_0 (proc));
+    for (; i0 < i0end; i0 += inc0)
+      GVSET (ra0, i0, scm_call_0 (proc));
   else
     {
       SCM ra1 = SCM_CAR (ras);
-      SCM args;
-      unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1);
-      long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
+      size_t i1 = SCM_I_ARRAY_BASE (ra1);
+      ssize_t inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
       ra1 = SCM_I_ARRAY_V (ra1);
-      ras = scm_vector (SCM_CDR (ras));
-      
-      for (; i <= n; i++, i1 += inc1)
-	{
-	  args = SCM_EOL;
-	  for (k = scm_c_vector_length (ras); k--;)
-	    args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
-	  args = scm_cons (GVREF (ra1, i1), args);
-	  GVSET (ra0, i*inc+base, scm_apply_0 (proc, args));
-	}
+      ras = SCM_CDR (ras);
+      if (scm_is_null(ras))
+          for (; i0 < i0end; i0 += inc0, i1 += inc1)
+            GVSET (ra0, i0, scm_call_1 (proc, GVREF (ra1, i1)));
+      else
+        {
+          ras = scm_vector (ras);
+          for (; i0 < i0end; i0 += inc0, i1 += inc1, ++i)
+            {
+              SCM args = SCM_EOL;
+              unsigned long k;
+              for (k = scm_c_vector_length (ras); k--;)
+                args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
+              GVSET (ra0, i0, scm_apply_1 (proc, GVREF (ra1, i1), args));
+            }
+        }
     }
   return 1;
 }
-- 
1.7.9.5


[-- Attachment #3: 0006-Remove-double-indirection-in-array-map-with-2-args.patch --]
[-- Type: application/octet-stream, Size: 2746 bytes --]

From 92ecf4b1724ef2db958cf9b513822e6c62c95536 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Tue, 2 Apr 2013 15:53:22 +0200
Subject: [PATCH 6/7] Remove double indirection in array-map! with <2 args

* libguile/array-map.c: (ramap): factor GVSET/GVREF out of rank-1 loop
  for ra0 and the first element of ras.
---
 libguile/array-map.c |   32 +++++++++++++++++++-------------
 1 file changed, 19 insertions(+), 13 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 079e3b1..7d5b19f 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -391,25 +391,31 @@ static int
 ramap (SCM ra0, SCM proc, SCM ras)
 {
   ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
-
-  size_t i0 = SCM_I_ARRAY_BASE (ra0);
-  ssize_t inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-  size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
-  size_t i0end = i0 + n*inc0;
-  ra0 = SCM_I_ARRAY_V (ra0);
+  size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1;
+
+  scm_t_array_handle h0;
+  size_t i0, i0end;
+  ssize_t inc0;
+  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra0), &h0);
+  i0 = h0.base + h0.dims[0].lbnd + SCM_I_ARRAY_BASE (ra0)*h0.dims[0].inc;
+  inc0 = SCM_I_ARRAY_DIMS (ra0)->inc * h0.dims[0].inc;
+  i0end = i0 + n*inc0;
   if (scm_is_null (ras))
     for (; i0 < i0end; i0 += inc0)
-      GVSET (ra0, i0, scm_call_0 (proc));
+      h0.impl->vset (&h0, i0, scm_call_0 (proc));
   else
     {
       SCM ra1 = SCM_CAR (ras);
-      size_t i1 = SCM_I_ARRAY_BASE (ra1);
-      ssize_t inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-      ra1 = SCM_I_ARRAY_V (ra1);
+      scm_t_array_handle h1;
+      size_t i1;
+      ssize_t inc1;
+      scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra1), &h1);
+      i1 = h1.base + h1.dims[0].lbnd + SCM_I_ARRAY_BASE (ra1)*h1.dims[0].inc;
+      inc1 = SCM_I_ARRAY_DIMS (ra1)->inc * h1.dims[0].inc;
       ras = SCM_CDR (ras);
-      if (scm_is_null(ras))
+      if (scm_is_null (ras))
           for (; i0 < i0end; i0 += inc0, i1 += inc1)
-            GVSET (ra0, i0, scm_call_1 (proc, GVREF (ra1, i1)));
+            h0.impl->vset (&h0, i0, scm_call_1 (proc, h1.impl->vref (&h1, i1)));
       else
         {
           ras = scm_vector (ras);
@@ -419,7 +425,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
               unsigned long k;
               for (k = scm_c_vector_length (ras); k--;)
                 args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
-              GVSET (ra0, i0, scm_apply_1 (proc, GVREF (ra1, i1), args));
+              h0.impl->vset (&h0, i0, scm_apply_1 (proc, h1.impl->vref (&h1, i1), args));
             }
         }
     }
-- 
1.7.9.5