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

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

[Daniel Llorens]

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


> Message: 5
> Date: Mon, 1 Apr 2013 15:40:48 +0800
> From: Daniel Hartwig <mandyke@gmail.com>
> To: guile-devel@gnu.org
> Subject: Re: Extremly slow for format & string-join

> On 1 April 2013 14:59, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:

>> How can it be slower to allocate the result at once?
> 
> Shrug.  I do not know much of array internals.  You probably have much
> more experience there than I.

Not much with the implementation, no :-/

> Except for the curious profile output, I suspect the overhead is due
> to such factors as repeated application of MAPFUNC and consequent
> arithmetic to access the shared arrays contents

mapfunc is used only to compute the strides and bounds, it isn't kept beyond make-shared-array.

But I hadn't thought that the profile was wrong. Indeed, the slow part is not make-typed-array but array-copy!.

scheme@(guile-user)> (define s "1234567890")
scheme@(guile-user)> (define t (make-shared-array s (lambda (i j) (list j)) 1000000 10))
scheme@(guile-user)> (define a (make-typed-array 'a *unspecified* 1000000 10))
scheme@(guile-user)> (define b (make-typed-array 'a *unspecified* 1000000 10))
scheme@(guile-user)> ,time (array-copy! t a)
;; 1.718000s real time, 1.710000s run time.  0.000000s spent in GC.
scheme@(guile-user)> ,time (array-copy! a b)
;; 1.673000s real time, 1.670000s run time.  0.000000s spent in GC.
scheme@(guile-user)> 

Since I have no intuition for these numbers, I thought maybe it's really this slow, or a cache problem, who knows:

scheme@(guile-user)> (import (rnrs bytevectors))
scheme@(guile-user)> (define x (make-bytevector 40000000))
scheme@(guile-user)> ,time (define y (bytevector-copy x))
;; 0.018000s real time, 0.020000s run time.  0.000000s spent in GC.

In NumPy (using doubles):

In [11]: %time a = np.zeros([1000000, 10])
CPU times: user 0.04 s, sys: 0.05 s, total: 0.09 s
Wall time: 0.09 s

In [12]: %time b = a+1
CPU times: user 0.04 s, sys: 0.05 s, total: 0.09 s
Wall time: 0.09 s

So it's really bad. I had a look at libguile/array-map.c. There are three parts in there:

[1] scm_ramapc(). This is a general array traversal function. It does linearization, so the (array-copy! a b) call above should resolve to a single call to racp().

[2] array-copy!, array-fill!, array-map!, array-for-each, etc. These all use scm_ramapc().

[3] a bunch of specializations scm_ra_sum, scm_ra_difference, and so on. 

First, I think that all of [3] should be gone, it's dead code. This is the first patch.

Second, array-map!, array-for-each cons on each application of proc. The quick & dirty solution is to add 1-arg, 2-args, etc. cases to ramap(), rafe(). array-index-map! does its own traversal and can't be linearized, so that can't be fixed as easily. There are weirdo cases. For example array-equal? calls array_compare that recurses on itself down to the last rank. This means that there's a function call on each and every array element.

I don't know whether fixing these problems is worthwhile, or the whole thing should be rewritten, maybe with a different approach. Either go to Scheme where we have macros and can inline the inner loops, or use a code generator to generate fixed rank cases, etc.

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

It's only a bit faster than before, though:

scheme@(guile-user)> (define s "1234567890")
scheme@(guile-user)> (define t (make-shared-array s (lambda (i j) (list j)) 1000000 10))
scheme@(guile-user)> (define a (make-typed-array 'a *unspecified* 1000000 10))
scheme@(guile-user)> (define b (make-typed-array 'a *unspecified* 1000000 10))
scheme@(guile-user)> ,time (array-copy! t a)
;; 1.187000s real time, 1.190000s run time.  0.000000s spent in GC.
scheme@(guile-user)> ,time (array-copy! a b)
;; 1.107000s real time, 1.110000s run time.  0.000000s spent in GC.
scheme@(guile-user)> 

There's the overhead of impl->, etc. I'm thinking that one can do a direct memory copy when the array types are the same, or even call memcpy() when the strides allow. I think these should be relatively common cases.

Regards,

	Daniel


[-- Attachment #2: 0001-Remove-dead-code-in-array-map.c.patch --]
[-- Type: application/octet-stream, Size: 8036 bytes --]

From 3ab911215c98d6c3a018755439dda59cd5c0ed40 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Mon, 1 Apr 2013 17:16:15 +0200
Subject: [PATCH 1/2] Remove dead code in array-map.c

* array-map.h, array-map.c: remove scm_ra_eqp, ra_compare, scm_ra_lessp,
  scm_ra_leqp, scm_ra_grp, scm_ra_greqp, scm_ra_sum, scm_ra_difference,
  scm_ra_product, scm_ra_divide, scm_array_identity.
---
 libguile/array-map.c | 244 ---------------------------------------------------
 libguile/array-map.h |  10 ---
 2 files changed, 254 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index d4da152..8c60f34 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -385,252 +385,8 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-/* Functions callable by ARRAY-MAP! */
-
-
-int
-scm_ra_eqp (SCM ra0, SCM ras)
-{
-  SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
-  scm_t_array_handle ra0_handle;
-  scm_t_array_dim *ra0_dims;
-  size_t n;
-  ssize_t inc0;
-  size_t i0 = 0;
-  unsigned long i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
-  long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  ra1 = SCM_I_ARRAY_V (ra1);
-  ra2 = SCM_I_ARRAY_V (ra2);
-
-  scm_array_get_handle (ra0, &ra0_handle);
-  ra0_dims = scm_array_handle_dims (&ra0_handle);
-  n = ra0_dims[0].ubnd - ra0_dims[0].lbnd + 1;
-  inc0 = ra0_dims[0].inc;
-
-  {
-    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
-      if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0)))
-	if (!scm_is_eq (GVREF (ra1, i1), GVREF (ra2, i2)))
-	  scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F);
-  }
-
-  scm_array_handle_release (&ra0_handle);
-  return 1;
-}
-
-/* opt 0 means <, nonzero means >= */
 
 static int
-ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt)
-{
-  scm_t_array_handle ra0_handle;
-  scm_t_array_dim *ra0_dims;
-  size_t n;
-  ssize_t inc0;
-  size_t i0 = 0;
-  unsigned long i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
-  long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  ra1 = SCM_I_ARRAY_V (ra1);
-  ra2 = SCM_I_ARRAY_V (ra2);
-
-  scm_array_get_handle (ra0, &ra0_handle);
-  ra0_dims = scm_array_handle_dims (&ra0_handle);
-  n = ra0_dims[0].ubnd - ra0_dims[0].lbnd + 1;
-  inc0 = ra0_dims[0].inc;
-
-  {
-    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
-      if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0)))
-	if (opt ?
-	    scm_is_true (scm_less_p (GVREF (ra1, i1), GVREF (ra2, i2))) :
-	    scm_is_false (scm_less_p (GVREF (ra1, i1), GVREF (ra2, i2))))
-	  scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F);
-  }
-
-  scm_array_handle_release (&ra0_handle);
-  return 1;
-}
-
-
-
-int
-scm_ra_lessp (SCM ra0, SCM ras)
-{
-  return ra_compare (ra0, SCM_CAR (ras), SCM_CAR (SCM_CDR (ras)), 0);
-}
-
-
-int
-scm_ra_leqp (SCM ra0, SCM ras)
-{
-  return ra_compare (ra0, SCM_CAR (SCM_CDR (ras)), SCM_CAR (ras), 1);
-}
-
-
-int
-scm_ra_grp (SCM ra0, SCM ras)
-{
-  return ra_compare (ra0, SCM_CAR (SCM_CDR (ras)), SCM_CAR (ras), 0);
-}
-
-
-int
-scm_ra_greqp (SCM ra0, SCM ras)
-{
-  return ra_compare (ra0, SCM_CAR (ras), SCM_CAR (SCM_CDR (ras)), 1);
-}
-
-
-int
-scm_ra_sum (SCM ra0, SCM ras)
-{
-  long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
-  unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
-  long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-  ra0 = SCM_I_ARRAY_V (ra0);
-  if (!scm_is_null(ras))
-    {
-      SCM ra1 = SCM_CAR (ras);
-      unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
-      long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-      ra1 = SCM_I_ARRAY_V (ra1);
-      switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
-	{
-	default:
-	  {
-	    for (; n-- > 0; i0 += inc0, i1 += inc1)
-	      GVSET (ra0, i0, scm_sum (GVREF(ra0, i0), GVREF(ra1, i1)));
-	    break;
-	  }
-	}
-    }
-  return 1;
-}
-
-
-
-int
-scm_ra_difference (SCM ra0, SCM ras)
-{
-  long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
-  unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
-  long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-  ra0 = SCM_I_ARRAY_V (ra0);
-  if (scm_is_null (ras))
-    {
-      switch (SCM_TYP7 (ra0))
-	{
-	default:
-	  {
-	    for (; n-- > 0; i0 += inc0)
-	      GVSET (ra0, i0, scm_difference (GVREF(ra0, i0), SCM_UNDEFINED));
-	    break;
-	  }
-	}
-    }
-  else
-    {
-      SCM ra1 = SCM_CAR (ras);
-      unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
-      long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-      ra1 = SCM_I_ARRAY_V (ra1);
-      switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
-	{
-	default:
-	  {
-	    for (; n-- > 0; i0 += inc0, i1 += inc1)
-	      GVSET (ra0, i0, scm_difference (GVREF (ra0, i0),
-					      GVREF (ra1, i1)));
-	    break;
-	  }
-	}
-    }
-  return 1;
-}
-
-
-
-int
-scm_ra_product (SCM ra0, SCM ras)
-{
-  long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
-  unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
-  long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-  ra0 = SCM_I_ARRAY_V (ra0);
-  if (!scm_is_null (ras))
-    {
-      SCM ra1 = SCM_CAR (ras);
-      unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
-      long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-      ra1 = SCM_I_ARRAY_V (ra1);
-      switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
-	{
-	default:
-	  {
-	    for (; n-- > 0; i0 += inc0, i1 += inc1)
-	      GVSET (ra0, i0, scm_product (GVREF (ra0, i0),
-					   GVREF (ra1, i1)));
-	  }
-	}
-    }
-  return 1;
-}
-
-
-int
-scm_ra_divide (SCM ra0, SCM ras)
-{
-  long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
-  unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
-  long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-  ra0 = SCM_I_ARRAY_V (ra0);
-  if (scm_is_null (ras))
-    {
-      switch (SCM_TYP7 (ra0))
-	{
-	default:
-	  {
-	    for (; n-- > 0; i0 += inc0)
-	      GVSET (ra0, i0, scm_divide (GVREF (ra0, i0), SCM_UNDEFINED));
-	    break;
-	  }
-	}
-    }
-  else
-    {
-      SCM ra1 = SCM_CAR (ras);
-      unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
-      long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-      ra1 = SCM_I_ARRAY_V (ra1);
-      switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
-	{
-	default:
-	  {
-	    for (; n-- > 0; i0 += inc0, i1 += inc1)
-	      {
-		SCM res =  scm_divide (GVREF (ra0, i0),
-				       GVREF (ra1, i1));
-		GVSET (ra0, i0, res);
-	      }
-	    break;
-	  }
-	}
-    }
-  return 1;
-}
-
-
-int
-scm_array_identity (SCM dst, SCM src)
-{
-  return racp (SCM_CAR (src), scm_cons (dst, SCM_EOL));
-}
-
-
-
-static int 
 ramap (SCM ra0, SCM proc, SCM ras)
 {
   long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
diff --git a/libguile/array-map.h b/libguile/array-map.h
index 43d2a92..a50fcc5 100644
--- a/libguile/array-map.h
+++ b/libguile/array-map.h
@@ -34,16 +34,6 @@ SCM_API int scm_ramapc (void *cproc, SCM data, SCM ra0, SCM lra,
 SCM_API int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
 SCM_API SCM scm_array_fill_x (SCM ra, SCM fill);
 SCM_API SCM scm_array_copy_x (SCM src, SCM dst);
-SCM_API int scm_ra_eqp (SCM ra0, SCM ras);
-SCM_API int scm_ra_lessp (SCM ra0, SCM ras);
-SCM_API int scm_ra_leqp (SCM ra0, SCM ras);
-SCM_API int scm_ra_grp (SCM ra0, SCM ras);
-SCM_API int scm_ra_greqp (SCM ra0, SCM ras);
-SCM_API int scm_ra_sum (SCM ra0, SCM ras);
-SCM_API int scm_ra_difference (SCM ra0, SCM ras);
-SCM_API int scm_ra_product (SCM ra0, SCM ras);
-SCM_API int scm_ra_divide (SCM ra0, SCM ras);
-SCM_API int scm_array_identity (SCM src, SCM dst);
 SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra);
 SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
 SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc);
-- 
1.8.2


[-- Attachment #3: 0002-Remove-double-indirection-in-element-access-in-array.patch --]
[-- Type: application/octet-stream, Size: 1851 bytes --]

From a38b0a98ed6093ee9ebe4ac60b4b6f9efbdcfdd5 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Mon, 1 Apr 2013 18:43:58 +0200
Subject: [PATCH 2/2] Remove double indirection in element access in
 array-copy!

* libguile/array-map.c: (racp): factor scm_generalized_vector_ref,
  scm_generalized_vector_set_x out of the rank-1 loop.
---
 libguile/array-map.c | 23 +++++++++++++----------
 1 file changed, 13 insertions(+), 10 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 8c60f34..767e97d 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -350,21 +350,24 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
 #undef FUNC_NAME
 
 
-
-static int 
+static int
 racp (SCM src, SCM dst)
 {
   long n = (SCM_I_ARRAY_DIMS (src)->ubnd - SCM_I_ARRAY_DIMS (src)->lbnd + 1);
-  long inc_d, inc_s = SCM_I_ARRAY_DIMS (src)->inc;
-  unsigned long i_d, i_s = SCM_I_ARRAY_BASE (src);
-  dst = SCM_CAR (dst);
-  inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
-  i_d = SCM_I_ARRAY_BASE (dst);
-  src = SCM_I_ARRAY_V (src);
-  dst = SCM_I_ARRAY_V (dst);
+  scm_t_array_handle h_s, h_d;
+  size_t i_s, i_d;
+  ssize_t inc_s, inc_d;
+  dst = SCM_CAR(dst);
+  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (src), &h_s);
+  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (dst), &h_d);
+  i_s = h_s.base + h_s.dims[0].lbnd + SCM_I_ARRAY_BASE (src)*h_s.dims[0].inc;
+  i_d = h_d.base + h_d.dims[0].lbnd + SCM_I_ARRAY_BASE (dst)*h_d.dims[0].inc;
+  inc_s = SCM_I_ARRAY_DIMS (src)->inc * h_s.dims[0].inc;
+  inc_d = SCM_I_ARRAY_DIMS (dst)->inc * h_d.dims[0].inc;
 
   for (; n-- > 0; i_s += inc_s, i_d += inc_d)
-    GVSET (dst, i_d, GVREF (src, i_s));
+    h_d.impl->vset (&h_d, i_d, h_s.impl->vref (&h_s, i_s));
+
   return 1;
 }
 
-- 
1.8.2


[-- Attachment #4: Type: text/plain, Size: 2 bytes --]

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

[Daniel Llorens]

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


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.

Before:

scheme@(guile-user)> (define a (make-typed-array 'a *unspecified* 1000000 10))
scheme@(guile-user)> ,time (array-fill! a #\v)
;; 1.211000s real time, 1.200000s run time.  0.000000s spent in GC.

After:

scheme@(guile-user)> ,time (array-fill! a #\v)
;; 0.855000s real time, 0.850000s run time.  0.000000s spent in GC.

Regards

	Daniel



[-- Attachment #2: 0004-Remove-double-indirection-in-array-fill.patch --]
[-- Type: application/octet-stream, Size: 3509 bytes --]

From e8d4bebba1d17ce0ff7af34d00305b31e998fafb Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Tue, 2 Apr 2013 11:47:32 +0200
Subject: [PATCH 4/4] Remove double indirection in array-fill!

* libguile/array-map.c: (scm_array_fill_int) rename to rafill after the
  pattern of rafe, ramap, racp, and factor scm_generalized_vector_set_x
  out of the loop.
* libguile/array-map.h: remove scm_array_fill_int from the export list.
* doc/guile-api.alist: remove scm_array_fill_int.
---
 doc/guile-api.alist  |    1 -
 libguile/array-map.c |   40 +++++++++++++++++++---------------------
 libguile/array-map.h |    1 -
 3 files changed, 19 insertions(+), 23 deletions(-)

diff --git a/doc/guile-api.alist b/doc/guile-api.alist
index 5830c91..78d3a5c 100644
--- a/doc/guile-api.alist
+++ b/doc/guile-api.alist
@@ -1359,7 +1359,6 @@
 (scm_array_copy_x (groups scm C) (scan-data T))
 (scm_array_dimensions (groups scm C) (scan-data T))
 (scm_array_equal_p (groups scm C) (scan-data T))
-(scm_array_fill_int (groups scm C) (scan-data T))
 (scm_array_fill_x (groups scm C) (scan-data T))
 (scm_array_for_each (groups scm C) (scan-data T))
 (scm_array_identity (groups scm C) (scan-data T))
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 767e97d..f591419 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -318,37 +318,35 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
 }
 
 
+static int
+rafill (SCM dst, SCM fill)
+{
+  long n = (SCM_I_ARRAY_DIMS (dst)->ubnd - SCM_I_ARRAY_DIMS (dst)->lbnd + 1);
+  scm_t_array_handle h;
+  size_t i;
+  ssize_t inc;
+  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (dst), &h);
+  i = h.base + h.dims[0].lbnd + SCM_I_ARRAY_BASE (dst)*h.dims[0].inc;
+  inc = SCM_I_ARRAY_DIMS (dst)->inc * h.dims[0].inc;
+
+  for (; n-- > 0; i += inc)
+    h.impl->vset (&h, i, fill);
+
+  return 1;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
 	    (SCM ra, SCM fill),
 	    "Store @var{fill} in every element of array @var{ra}.  The value\n"
 	    "returned is unspecified.")
 #define FUNC_NAME s_scm_array_fill_x
 {
-  scm_ramapc (scm_array_fill_int, fill, ra, SCM_EOL, FUNC_NAME);
+  scm_ramapc (rafill, fill, ra, SCM_EOL, FUNC_NAME);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-/* to be used as cproc in scm_ramapc to fill an array dimension with
-   "fill". */
-int 
-scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
-#define FUNC_NAME s_scm_array_fill_x
-{
-  unsigned long i;
-  unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd + 1;
-  long inc = SCM_I_ARRAY_DIMS (ra)->inc;
-  unsigned long base = SCM_I_ARRAY_BASE (ra);
-
-  ra = SCM_I_ARRAY_V (ra);
-
-  for (i = base; n--; i += inc)
-    GVSET (ra, i, fill);
-
-  return 1;
-}
-#undef FUNC_NAME
-
 
 static int
 racp (SCM src, SCM dst)
diff --git a/libguile/array-map.h b/libguile/array-map.h
index a50fcc5..0626c22 100644
--- a/libguile/array-map.h
+++ b/libguile/array-map.h
@@ -31,7 +31,6 @@
 SCM_API int scm_ra_matchp (SCM ra0, SCM ras);
 SCM_API int scm_ramapc (void *cproc, SCM data, SCM ra0, SCM lra,
 			const char *what);
-SCM_API int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
 SCM_API SCM scm_array_fill_x (SCM ra, SCM fill);
 SCM_API SCM scm_array_copy_x (SCM src, SCM dst);
 SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra);
-- 
1.7.9.5

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

[Daniel Llorens]

[-- 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/6] 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/6] 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

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <dll@jast.ch> skribis:

> 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!.

Could you provide a patch that adds test cases for array-map! in
arrays.test?  I’d like to have a minimal safety net before applying
these.

TIA,  :-)
Ludo’.

Re: array-copy! is slow & array-map.c

[Daniel Llorens]

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


On Apr 3, 2013, at 14:50, Ludovic Courtès wrote:

> Daniel Llorens <dll@jast.ch> skribis:
> 
>> 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!.
> 
> Could you provide a patch that adds test cases for array-map! in
> arrays.test?  I’d like to have a minimal safety net before applying
> these.
> 
> TIA,  :-)
> Ludo’.

The patches pass the tests in ramap.test. These include different types and non-compact arrays. I can add more if you think these aren't sufficient.

Here is the new patch set on top of the one you've already applied. The patch for array-fill! includes a test for non-compact arrays that I didn't see in arrays.test. 

Regards,

	Daniel


[-- Attachment #2: 0001-Deprecate-dead-code-in-array-map.c.patch --]
[-- Type: application/octet-stream, Size: 2812 bytes --]

From 3fba07976ac26b7e7def16679a7e7d1f92b2951c Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 3 Apr 2013 15:40:48 +0200
Subject: [PATCH 1/5] Deprecate dead code in array-map.c

* libguile/array-map.c, libguile/array-map.h: deprecate scm_ra_eqp,
  scm_ra_lessp, scm_ra_leqp, scm_ra_grp, scm_ra_greqp, scm_ra_sum,
  scm_ra_product, scm_ra_difference, scm_ra_divide, scm_array_identity.
---
 libguile/array-map.c |    5 +++--
 libguile/array-map.h |   20 ++++++++++----------
 2 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 00a24f1..1dc5d3b 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -396,6 +396,7 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
 
 /* Functions callable by ARRAY-MAP! */
 
+#if SCM_ENABLE_DEPRECATED == 1
 
 int
 scm_ra_eqp (SCM ra0, SCM ras)
@@ -637,9 +638,9 @@ scm_array_identity (SCM dst, SCM src)
   return racp (SCM_CAR (src), scm_cons (dst, SCM_EOL));
 }
 
+#endif /* SCM_ENABLE_DEPRECATED */
 
-
-static int 
+static int
 ramap (SCM ra0, SCM proc, SCM ras)
 {
   long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
diff --git a/libguile/array-map.h b/libguile/array-map.h
index 43d2a92..9785666 100644
--- a/libguile/array-map.h
+++ b/libguile/array-map.h
@@ -34,16 +34,16 @@ SCM_API int scm_ramapc (void *cproc, SCM data, SCM ra0, SCM lra,
 SCM_API int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
 SCM_API SCM scm_array_fill_x (SCM ra, SCM fill);
 SCM_API SCM scm_array_copy_x (SCM src, SCM dst);
-SCM_API int scm_ra_eqp (SCM ra0, SCM ras);
-SCM_API int scm_ra_lessp (SCM ra0, SCM ras);
-SCM_API int scm_ra_leqp (SCM ra0, SCM ras);
-SCM_API int scm_ra_grp (SCM ra0, SCM ras);
-SCM_API int scm_ra_greqp (SCM ra0, SCM ras);
-SCM_API int scm_ra_sum (SCM ra0, SCM ras);
-SCM_API int scm_ra_difference (SCM ra0, SCM ras);
-SCM_API int scm_ra_product (SCM ra0, SCM ras);
-SCM_API int scm_ra_divide (SCM ra0, SCM ras);
-SCM_API int scm_array_identity (SCM src, SCM dst);
+SCM_DEPRECATED int scm_ra_eqp (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_lessp (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_leqp (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_grp (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_greqp (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_sum (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_difference (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_product (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_ra_divide (SCM ra0, SCM ras);
+SCM_DEPRECATED int scm_array_identity (SCM src, SCM dst);
 SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra);
 SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
 SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc);
-- 
1.7.9.5


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

From eb4bbb3f42a4a0fcf1d51ecacd557606533d5b40 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 2/5] 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 1dc5d3b..9ed0401 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -643,31 +643,38 @@ scm_array_identity (SCM dst, SCM src)
 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 #4: 0003-Remove-double-indirection-in-array-map-with-2-args.patch --]
[-- Type: application/octet-stream, Size: 2842 bytes --]

From 78322cca895275772028bebeb79ac5038df04047 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 3/5] 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, 20 insertions(+), 12 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 9ed0401..b05548b 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -644,25 +644,31 @@ static int
 ramap (SCM ra0, SCM proc, SCM ras)
 {
   ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
+  size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1;
 
-  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);
+  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);
@@ -672,10 +678,12 @@ 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));
             }
         }
+      scm_array_handle_release (&h1);
     }
+  scm_array_handle_release (&h0);
   return 1;
 }
 
-- 
1.7.9.5


[-- Attachment #5: 0004-Remove-double-indirection-for-1st-arg-of-array-for-e.patch --]
[-- Type: application/octet-stream, Size: 2678 bytes --]

From 0392b6ceab229d8d6546e1ff79e38d3c11881e04 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Tue, 2 Apr 2013 16:43:37 +0200
Subject: [PATCH 4/5] Remove double indirection for 1st arg of array-for-each

* libguile/array-map.c: (rafe): factor GVREF out of rank-1 loop for ra0.
---
 libguile/array-map.c |   45 ++++++++++++++++++++++-----------------------
 1 file changed, 22 insertions(+), 23 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index b05548b..b5b8cec 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -716,36 +716,35 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
 static int
 rafe (SCM ra0, SCM proc, SCM ras)
 {
-  long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
-  unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
-  long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-  long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
-  ra0 = SCM_I_ARRAY_V (ra0);
+  ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
+  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 (; i <= n; i++, i0 += inc0)
-      scm_call_1 (proc, GVREF (ra0, i0));
+    for (; i0 < i0end; i0 += inc0)
+      scm_call_1 (proc, h0.impl->vref (&h0, i0));
   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;
-      ra1 = SCM_I_ARRAY_V (ra1);
-      ras = scm_vector (SCM_CDR (ras));
-
-      for (; i <= n; i++, i0 += inc0, 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_cons2 (GVREF (ra0, i0), GVREF (ra1, i1), args);
-	  scm_apply_0 (proc, args);
-	}
+      ras = scm_vector (ras);
+      for (; i0 < i0end; i0 += inc0, ++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);
+          scm_apply_1 (proc, h0.impl->vref (&h0, i0), args);
+        }
     }
+  scm_array_handle_release (&h0);
   return 1;
 }
 
-
 SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1,
 	    (SCM proc, SCM ra0, SCM lra),
 	    "Apply @var{proc} to each tuple of elements of @var{ra0} @dots{}\n"
-- 
1.7.9.5


[-- Attachment #6: 0005-Remove-double-indirection-in-array-fill.patch --]
[-- Type: application/octet-stream, Size: 5160 bytes --]

From 03aa7ea2e61b419d38c6ca8de75ee34e5b55d28a Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 3 Apr 2013 16:19:17 +0200
Subject: [PATCH 5/5] Remove double indirection in array-fill!

* libguile/array-map.c, libguile/array-map.c: deprecate scm_array_fill_int.
* libguile/array-map.c: new function rafill, like scm_array_fill_int, but
  factors GVSET out of loop. Use this in scm_array_fill_x instead of
  scm_array_fill_int.
* test-suite/tests/arrays.test: test array-fill! with noncompact array.
* doc/guile-api.alist: unlist scm_array_fill_int.
---
 doc/guile-api.alist          |    1 -
 libguile/array-map.c         |   57 ++++++++++++++++++++++++++----------------
 libguile/array-map.h         |    2 +-
 test-suite/tests/arrays.test |   10 +++++++-
 4 files changed, 46 insertions(+), 24 deletions(-)

diff --git a/doc/guile-api.alist b/doc/guile-api.alist
index 5830c91..78d3a5c 100644
--- a/doc/guile-api.alist
+++ b/doc/guile-api.alist
@@ -1359,7 +1359,6 @@
 (scm_array_copy_x (groups scm C) (scan-data T))
 (scm_array_dimensions (groups scm C) (scan-data T))
 (scm_array_equal_p (groups scm C) (scan-data T))
-(scm_array_fill_int (groups scm C) (scan-data T))
 (scm_array_fill_x (groups scm C) (scan-data T))
 (scm_array_for_each (groups scm C) (scan-data T))
 (scm_array_identity (groups scm C) (scan-data T))
diff --git a/libguile/array-map.c b/libguile/array-map.c
index b5b8cec..517c9cb 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -318,6 +318,23 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
     }
 }
 
+static int
+rafill (SCM dst, SCM fill)
+{
+  long n = (SCM_I_ARRAY_DIMS (dst)->ubnd - SCM_I_ARRAY_DIMS (dst)->lbnd + 1);
+  scm_t_array_handle h;
+  size_t i;
+  ssize_t inc;
+  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (dst), &h);
+  i = h.base + h.dims[0].lbnd + SCM_I_ARRAY_BASE (dst)*h.dims[0].inc;
+  inc = SCM_I_ARRAY_DIMS (dst)->inc * h.dims[0].inc;
+
+  for (; n-- > 0; i += inc)
+    h.impl->vset (&h, i, fill);
+
+  scm_array_handle_release (&h);
+  return 1;
+}
 
 SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
 	    (SCM ra, SCM fill),
@@ -325,31 +342,11 @@ SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
 	    "returned is unspecified.")
 #define FUNC_NAME s_scm_array_fill_x
 {
-  scm_ramapc (scm_array_fill_int, fill, ra, SCM_EOL, FUNC_NAME);
+  scm_ramapc (rafill, fill, ra, SCM_EOL, FUNC_NAME);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-/* to be used as cproc in scm_ramapc to fill an array dimension with
-   "fill". */
-int 
-scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
-#define FUNC_NAME s_scm_array_fill_x
-{
-  unsigned long i;
-  unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd + 1;
-  long inc = SCM_I_ARRAY_DIMS (ra)->inc;
-  unsigned long base = SCM_I_ARRAY_BASE (ra);
-
-  ra = SCM_I_ARRAY_V (ra);
-
-  for (i = base; n--; i += inc)
-    GVSET (ra, i, fill);
-
-  return 1;
-}
-#undef FUNC_NAME
-
 
 static int
 racp (SCM src, SCM dst)
@@ -398,6 +395,24 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
 
 #if SCM_ENABLE_DEPRECATED == 1
 
+/* to be used as cproc in scm_ramapc to fill an array dimension with
+   "fill". */
+int
+scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
+{
+  unsigned long i;
+  unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd + 1;
+  long inc = SCM_I_ARRAY_DIMS (ra)->inc;
+  unsigned long base = SCM_I_ARRAY_BASE (ra);
+
+  ra = SCM_I_ARRAY_V (ra);
+
+  for (i = base; n--; i += inc)
+    GVSET (ra, i, fill);
+
+  return 1;
+}
+
 int
 scm_ra_eqp (SCM ra0, SCM ras)
 {
diff --git a/libguile/array-map.h b/libguile/array-map.h
index 9785666..c328d8d 100644
--- a/libguile/array-map.h
+++ b/libguile/array-map.h
@@ -31,7 +31,7 @@
 SCM_API int scm_ra_matchp (SCM ra0, SCM ras);
 SCM_API int scm_ramapc (void *cproc, SCM data, SCM ra0, SCM lra,
 			const char *what);
-SCM_API int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
+SCM_DEPRECATED int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
 SCM_API SCM scm_array_fill_x (SCM ra, SCM fill);
 SCM_API SCM scm_array_copy_x (SCM src, SCM dst);
 SCM_DEPRECATED int scm_ra_eqp (SCM ra0, SCM ras);
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index d88a1cb..0791783 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -291,7 +291,15 @@
       (pass-if "0"      (array-fill! a 0)      #t)
       (pass-if "123"    (array-fill! a 123)    #t)
       (pass-if "-123"   (array-fill! a -123)   #t)
-      (pass-if "5/8"    (array-fill! a 5/8)    #t))))
+      (pass-if "5/8"    (array-fill! a 5/8)    #t)))
+
+  (with-test-prefix "noncompact"
+    (let* ((a (make-array 0 3 3))
+           (b (make-shared-array a (lambda (i) (list i i)) 3)))
+      (array-fill! b 9)
+      (pass-if
+        (and (equal? b #(9 9 9))
+             (equal? a #2((9 0 0) (0 9 0) (0 0 9))))))))
 
 ;;;
 ;;; array-in-bounds?
-- 
1.7.9.5

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <dll@jast.ch> skribis:

> From 3fba07976ac26b7e7def16679a7e7d1f92b2951c Mon Sep 17 00:00:00 2001
> From: Daniel Llorens <daniel.llorens@bluewin.ch>
> Date: Wed, 3 Apr 2013 15:40:48 +0200
> Subject: [PATCH 1/5] Deprecate dead code in array-map.c
>
> * libguile/array-map.c, libguile/array-map.h: deprecate scm_ra_eqp,
>   scm_ra_lessp, scm_ra_leqp, scm_ra_grp, scm_ra_greqp, scm_ra_sum,
>   scm_ra_product, scm_ra_difference, scm_ra_divide, scm_array_identity.

Applied, with the declarations enclosed in #if SCM_ENABLE_DEPRECATED.

Ludo’.

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <dll@jast.ch> skribis:

> From eb4bbb3f42a4a0fcf1d51ecacd557606533d5b40 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 2/5] 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.

Applied.

Indeed, ‘ramap’ is covered by the tests:

  http://hydra.nixos.org/build/4285515/download/2/coverage/libguile/array-map.c.func.html

Ludo’.

Re: array-copy! is slow & array-map.c

[Daniel Llorens]

On Apr 3, 2013, at 19:06, Ludovic Courtès wrote:

> Daniel Llorens <dll@jast.ch> skribis:
> 
>> From eb4bbb3f42a4a0fcf1d51ecacd557606533d5b40 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 2/5] 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.
> 
> Applied.
> 
> Indeed, ‘ramap’ is covered by the tests:
> 
>  http://hydra.nixos.org/build/4285515/download/2/coverage/libguile/array-map.c.func.html
> 
> Ludo’.

Nifty, I didn't know about this.

I've verified that there are indeed no tests on array-copy!. I'll prepare a patch.

Regards,

	Daniel.

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <dll@jast.ch> skribis:

> From 78322cca895275772028bebeb79ac5038df04047 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 3/5] 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.

Applied.

Ludo’.

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <dll@jast.ch> skribis:

> From 0392b6ceab229d8d6546e1ff79e38d3c11881e04 Mon Sep 17 00:00:00 2001
> From: Daniel Llorens <daniel.llorens@bluewin.ch>
> Date: Tue, 2 Apr 2013 16:43:37 +0200
> Subject: [PATCH 4/5] Remove double indirection for 1st arg of array-for-each
>
> * libguile/array-map.c: (rafe): factor GVREF out of rank-1 loop for ra0.

Applied, after adding tests for rank-1 ‘array-for-each’ (which was not
covered, according to
<http://hydra.nixos.org/build/4285515/download/2/coverage/libguile/array-map.c.gcov.html#692>.).

Ludo’.

Re: array-copy! is slow & array-map.c

[Daniel Llorens]

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


Attached 1st a patch with some array-copy! tests, then the array-fill! patch split in two parts.

Thanks!

	Daniel


[-- Attachment #2: 0001-Tests-for-array-copy.patch --]
[-- Type: application/octet-stream, Size: 2162 bytes --]

From 292014d961eca156afec7f97954c117916518aa3 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 3 Apr 2013 22:31:47 +0200
Subject: [PATCH 1/3] Tests for array-copy!

* test-suite/tests/arrays.test: tests for arguments of rank 0, 1 and 2.
---
 test-suite/tests/arrays.test | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index d88a1cb..7f1bbde 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -294,6 +294,46 @@
       (pass-if "5/8"    (array-fill! a 5/8)    #t))))
 
 ;;;
+;;; array-copy!
+;;;
+
+(with-test-prefix "array-copy!"
+
+  (with-test-prefix "rank 2"
+    (pass-if (let ((a #2((1 2) (3 4)))
+                   (b (make-array 0 2 2))
+                   (c (make-array 0 2 2))
+                   (d (make-array 0 2 2))
+                   (e (make-array 0 2 2)))
+               (array-copy! a b)
+               (array-copy! a (transpose-array c 1 0))
+               (array-copy! (transpose-array a 1 0) d)
+               (array-copy! (transpose-array a 1 0) (transpose-array e 1 0))
+               (and (equal? a #2((1 2) (3 4)))
+                    (equal? b #2((1 2) (3 4)))
+                    (equal? c #2((1 3) (2 4)))
+                    (equal? d #2((1 3) (2 4)))
+                    (equal? e #2((1 2) (3 4)))))))
+
+  (with-test-prefix "rank 1"
+    (pass-if (let* ((a #2((1 2) (3 4)))
+                    (b (make-shared-array a (lambda (j) (list 1 j)) 2))
+                    (c (make-shared-array a (lambda (i) (list (- 1 i) 1)) 2))
+                    (d (make-array 0 2))
+                    (e (make-array 0 2)))
+               (array-copy! b d)
+               (array-copy! c e)
+               (and (equal? d #(3 4))
+                    (equal? e #(4 2))))))
+
+  (with-test-prefix "rank 0"
+    (pass-if (let ((a #0(99))
+                   (b (make-array 0)))
+               (array-copy! a b)
+               (equal? b #0(99))))))
+
+
+;;;
 ;;; array-in-bounds?
 ;;;
 
-- 
1.8.2


[-- Attachment #3: 0002-Remove-double-indirection-in-array-fill.patch --]
[-- Type: application/octet-stream, Size: 2800 bytes --]

From 76432b25fda11957142e94653aafbc798ef4d880 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 3 Apr 2013 22:40:40 +0200
Subject: [PATCH 2/3] Remove double indirection in array-fill!

* libguile/array-map.c: new function rafill, like scm_array_fill_int,
  but factors GVSET out of the loop. Use it in scm_array_fill_x instead of
  scm_array_fill_int.
* test-suite/tests/arrays.test: add test for array-fill! with stride != 1.
---
 libguile/array-map.c         | 21 +++++++++++++++++++--
 test-suite/tests/arrays.test | 10 +++++++++-
 2 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index b5b8cec..c86ea84 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -318,6 +318,23 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
     }
 }
 
+static int
+rafill (SCM dst, SCM fill)
+{
+  long n = (SCM_I_ARRAY_DIMS (dst)->ubnd - SCM_I_ARRAY_DIMS (dst)->lbnd + 1);
+  scm_t_array_handle h;
+  size_t i;
+  ssize_t inc;
+  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (dst), &h);
+  i = h.base + h.dims[0].lbnd + SCM_I_ARRAY_BASE (dst)*h.dims[0].inc;
+  inc = SCM_I_ARRAY_DIMS (dst)->inc * h.dims[0].inc;
+
+  for (; n-- > 0; i += inc)
+    h.impl->vset (&h, i, fill);
+
+  scm_array_handle_release (&h);
+  return 1;
+}
 
 SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
 	    (SCM ra, SCM fill),
@@ -325,14 +342,14 @@ SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
 	    "returned is unspecified.")
 #define FUNC_NAME s_scm_array_fill_x
 {
-  scm_ramapc (scm_array_fill_int, fill, ra, SCM_EOL, FUNC_NAME);
+  scm_ramapc (rafill, fill, ra, SCM_EOL, FUNC_NAME);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
 /* to be used as cproc in scm_ramapc to fill an array dimension with
    "fill". */
-int 
+int
 scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
 #define FUNC_NAME s_scm_array_fill_x
 {
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 7f1bbde..7b96b11 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -291,7 +291,15 @@
       (pass-if "0"      (array-fill! a 0)      #t)
       (pass-if "123"    (array-fill! a 123)    #t)
       (pass-if "-123"   (array-fill! a -123)   #t)
-      (pass-if "5/8"    (array-fill! a 5/8)    #t))))
+      (pass-if "5/8"    (array-fill! a 5/8)    #t)))
+
+  (with-test-prefix "noncompact"
+    (let* ((a (make-array 0 3 3))
+           (b (make-shared-array a (lambda (i) (list i i)) 3)))
+      (array-fill! b 9)
+      (pass-if
+        (and (equal? b #(9 9 9))
+             (equal? a #2((9 0 0) (0 9 0) (0 0 9))))))))
 
 ;;;
 ;;; array-copy!
-- 
1.8.2


[-- Attachment #4: 0003-Deprecate-scm_array_fill_int.patch --]
[-- Type: application/octet-stream, Size: 3479 bytes --]

From ef8e5b980c6d5a4dbea12fbed1ac7bc16277b859 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 3 Apr 2013 22:52:21 +0200
Subject: [PATCH 3/3] Deprecate scm_array_fill_int()

* libguile/array-map.h, libgule/array-map.c: move scm_array_fill_int
  to the deprecated section.
---
 doc/guile-api.alist  |  1 -
 libguile/array-map.c | 41 ++++++++++++++++++++---------------------
 libguile/array-map.h |  2 +-
 3 files changed, 21 insertions(+), 23 deletions(-)

diff --git a/doc/guile-api.alist b/doc/guile-api.alist
index 5830c91..78d3a5c 100644
--- a/doc/guile-api.alist
+++ b/doc/guile-api.alist
@@ -1359,7 +1359,6 @@
 (scm_array_copy_x (groups scm C) (scan-data T))
 (scm_array_dimensions (groups scm C) (scan-data T))
 (scm_array_equal_p (groups scm C) (scan-data T))
-(scm_array_fill_int (groups scm C) (scan-data T))
 (scm_array_fill_x (groups scm C) (scan-data T))
 (scm_array_for_each (groups scm C) (scan-data T))
 (scm_array_identity (groups scm C) (scan-data T))
diff --git a/libguile/array-map.c b/libguile/array-map.c
index c86ea84..2779458 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -347,26 +347,6 @@ SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-/* to be used as cproc in scm_ramapc to fill an array dimension with
-   "fill". */
-int
-scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
-#define FUNC_NAME s_scm_array_fill_x
-{
-  unsigned long i;
-  unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd + 1;
-  long inc = SCM_I_ARRAY_DIMS (ra)->inc;
-  unsigned long base = SCM_I_ARRAY_BASE (ra);
-
-  ra = SCM_I_ARRAY_V (ra);
-
-  for (i = base; n--; i += inc)
-    GVSET (ra, i, fill);
-
-  return 1;
-}
-#undef FUNC_NAME
-
 
 static int
 racp (SCM src, SCM dst)
@@ -411,10 +391,29 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-/* Functions callable by ARRAY-MAP! */
 
 #if SCM_ENABLE_DEPRECATED == 1
 
+/* to be used as cproc in scm_ramapc to fill an array dimension with
+   "fill". */
+int
+scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
+{
+  unsigned long i;
+  unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd + 1;
+  long inc = SCM_I_ARRAY_DIMS (ra)->inc;
+  unsigned long base = SCM_I_ARRAY_BASE (ra);
+
+  ra = SCM_I_ARRAY_V (ra);
+
+  for (i = base; n--; i += inc)
+    GVSET (ra, i, fill);
+
+  return 1;
+}
+
+/* Functions callable by ARRAY-MAP! */
+
 int
 scm_ra_eqp (SCM ra0, SCM ras)
 {
diff --git a/libguile/array-map.h b/libguile/array-map.h
index eb1aa37..b0592d8 100644
--- a/libguile/array-map.h
+++ b/libguile/array-map.h
@@ -31,7 +31,6 @@
 SCM_API int scm_ra_matchp (SCM ra0, SCM ras);
 SCM_API int scm_ramapc (void *cproc, SCM data, SCM ra0, SCM lra,
 			const char *what);
-SCM_API int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
 SCM_API SCM scm_array_fill_x (SCM ra, SCM fill);
 SCM_API SCM scm_array_copy_x (SCM src, SCM dst);
 SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra);
@@ -42,6 +41,7 @@ SCM_INTERNAL void scm_init_array_map (void);
 
 #if SCM_ENABLE_DEPRECATED == 1
 
+SCM_DEPRECATED int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
 SCM_DEPRECATED int scm_ra_eqp (SCM ra0, SCM ras);
 SCM_DEPRECATED int scm_ra_lessp (SCM ra0, SCM ras);
 SCM_DEPRECATED int scm_ra_leqp (SCM ra0, SCM ras);
-- 
1.8.2

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <dll@jast.ch> skribis:

> +(with-test-prefix "array-copy!"
> +
> +  (with-test-prefix "rank 2"
> +    (pass-if (let ((a #2((1 2) (3 4)))
> +                   (b (make-array 0 2 2))

Can you make that:

  (with-test-prefix "array-copy!"

    (pass-if "rank 2"
      (let ((a ...))))

(Same for the following tests.)

TIA,
Ludo’.

Re: array-copy! is slow & array-map.c

[Daniel Llorens]

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


On Apr 5, 2013, at 19:20, Ludovic Courtès wrote:

> Daniel Llorens <dll@jast.ch> skribis:
> 
>> +(with-test-prefix "array-copy!"
>> +
>> +  (with-test-prefix "rank 2"
>> +    (pass-if (let ((a #2((1 2) (3 4)))
>> +                   (b (make-array 0 2 2))
> 
> Can you make that:
> 
>  (with-test-prefix "array-copy!"
> 
>    (pass-if "rank 2"
>      (let ((a ...))))
> 
> (Same for the following tests.)
> 
> TIA,
> Ludo’.

Like this?


[-- Attachment #2: 0001-Tests-for-array-copy.patch --]
[-- Type: application/octet-stream, Size: 1889 bytes --]

From 6a1e9e846b075f785ad35b1bf7abd7068922254b Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 3 Apr 2013 22:31:47 +0200
Subject: [PATCH 1/3] Tests for array-copy!

* test-suite/tests/arrays.test: tests for arguments of rank 0, 1 and 2.
---
 test-suite/tests/arrays.test | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index d88a1cb..aa97631 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -294,6 +294,46 @@
       (pass-if "5/8"    (array-fill! a 5/8)    #t))))
 
 ;;;
+;;; array-copy!
+;;;
+
+(with-test-prefix "array-copy!"
+
+  (pass-if "rank 2"
+    (let ((a #2((1 2) (3 4)))
+          (b (make-array 0 2 2))
+          (c (make-array 0 2 2))
+          (d (make-array 0 2 2))
+          (e (make-array 0 2 2)))
+      (array-copy! a b)
+      (array-copy! a (transpose-array c 1 0))
+      (array-copy! (transpose-array a 1 0) d)
+      (array-copy! (transpose-array a 1 0) (transpose-array e 1 0))
+      (and (equal? a #2((1 2) (3 4)))
+           (equal? b #2((1 2) (3 4)))
+           (equal? c #2((1 3) (2 4)))
+           (equal? d #2((1 3) (2 4)))
+           (equal? e #2((1 2) (3 4))))))
+
+  (pass-if "rank 1"
+    (let* ((a #2((1 2) (3 4)))
+           (b (make-shared-array a (lambda (j) (list 1 j)) 2))
+           (c (make-shared-array a (lambda (i) (list (- 1 i) 1)) 2))
+           (d (make-array 0 2))
+           (e (make-array 0 2)))
+      (array-copy! b d)
+      (array-copy! c e)
+      (and (equal? d #(3 4))
+           (equal? e #(4 2)))))
+
+  (pass-if "rank 0"
+    (let ((a #0(99))
+          (b (make-array 0)))
+      (array-copy! a b)
+      (equal? b #0(99)))))
+
+
+;;;
 ;;; array-in-bounds?
 ;;;
 
-- 
1.8.2

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <dll@jast.ch> skribis:

> Like this?

Yes, thanks.

Ludo'.

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <dll@jast.ch> skribis:

> From 76432b25fda11957142e94653aafbc798ef4d880 Mon Sep 17 00:00:00 2001
> From: Daniel Llorens <daniel.llorens@bluewin.ch>
> Date: Wed, 3 Apr 2013 22:40:40 +0200
> Subject: [PATCH 2/3] Remove double indirection in array-fill!
>
> * libguile/array-map.c: new function rafill, like scm_array_fill_int,
>   but factors GVSET out of the loop. Use it in scm_array_fill_x instead of
>   scm_array_fill_int.
> * test-suite/tests/arrays.test: add test for array-fill! with stride != 1.

[...]


> From ef8e5b980c6d5a4dbea12fbed1ac7bc16277b859 Mon Sep 17 00:00:00 2001
> From: Daniel Llorens <daniel.llorens@bluewin.ch>
> Date: Wed, 3 Apr 2013 22:52:21 +0200
> Subject: [PATCH 3/3] Deprecate scm_array_fill_int()
>
> * libguile/array-map.h, libgule/array-map.c: move scm_array_fill_int
>   to the deprecated section.

Applied, thanks!

Ludo’.

Re: array-copy! is slow & array-map.c

[Daniel Llorens]

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


This patch replaces the scm_generalized_vector_get_handle() in the rank-1 functions by scm_array_get_handle().

These calls came from the GVSET/GVREF code that I spliced in there, but the arguments are known to be rank-1, so there's no reason not to use the simpler call.

Regards

	Daniel


[-- Attachment #2: 0001-Don-t-use-scm_generalized_vector_get_handle-in-array.patch --]
[-- Type: application/octet-stream, Size: 2714 bytes --]

From 70fec2abb32b5d2546a40c70d15526b0ee5ccc20 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Sun, 7 Apr 2013 00:04:35 +0200
Subject: [PATCH] Don't use scm_generalized_vector_get_handle() in array-map.c

* libguile/array-map.c: (rafill, racp, ramap, rafe): use
  scm_array_get_handle() instead of scm_generalized_get_vector_handle().
---
 libguile/array-map.c | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 2779458..1c443ac 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -325,7 +325,7 @@ rafill (SCM dst, SCM fill)
   scm_t_array_handle h;
   size_t i;
   ssize_t inc;
-  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (dst), &h);
+  scm_array_get_handle (SCM_I_ARRAY_V (dst), &h);
   i = h.base + h.dims[0].lbnd + SCM_I_ARRAY_BASE (dst)*h.dims[0].inc;
   inc = SCM_I_ARRAY_DIMS (dst)->inc * h.dims[0].inc;
 
@@ -357,8 +357,8 @@ racp (SCM src, SCM dst)
   ssize_t inc_s, inc_d;
 
   dst = SCM_CAR (dst);
-  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (src), &h_s);
-  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (dst), &h_d);
+  scm_array_get_handle (SCM_I_ARRAY_V (src), &h_s);
+  scm_array_get_handle (SCM_I_ARRAY_V (dst), &h_d);
 
   i_s = h_s.base + h_s.dims[0].lbnd + SCM_I_ARRAY_BASE (src) * h_s.dims[0].inc;
   i_d = h_d.base + h_d.dims[0].lbnd + SCM_I_ARRAY_BASE (dst) * h_d.dims[0].inc;
@@ -665,7 +665,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
   scm_t_array_handle h0;
   size_t i0, i0end;
   ssize_t inc0;
-  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra0), &h0);
+  scm_array_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;
@@ -678,7 +678,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
       scm_t_array_handle h1;
       size_t i1;
       ssize_t inc1;
-      scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra1), &h1);
+      scm_array_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);
@@ -738,7 +738,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
   scm_t_array_handle h0;
   size_t i0, i0end;
   ssize_t inc0;
-  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra0), &h0);
+  scm_array_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;
-- 
1.8.2

Fwd: array-copy! is slow & array-map.c

[Daniel Llorens]

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


This patch replaces the scm_generalized_vector_get_handle() in the rank-1 functions by scm_array_get_handle().

These calls came from the GVSET/GVREF code that I spliced in there, but the arguments are known to be rank-1, so there's no reason not to use the simpler call.

Regards

	Daniel


[-- Attachment #2: 0001-Don-t-use-scm_generalized_vector_get_handle-in-array.patch --]
[-- Type: application/octet-stream, Size: 2714 bytes --]

From 70fec2abb32b5d2546a40c70d15526b0ee5ccc20 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Sun, 7 Apr 2013 00:04:35 +0200
Subject: [PATCH] Don't use scm_generalized_vector_get_handle() in array-map.c

* libguile/array-map.c: (rafill, racp, ramap, rafe): use
  scm_array_get_handle() instead of scm_generalized_get_vector_handle().
---
 libguile/array-map.c | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 2779458..1c443ac 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -325,7 +325,7 @@ rafill (SCM dst, SCM fill)
   scm_t_array_handle h;
   size_t i;
   ssize_t inc;
-  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (dst), &h);
+  scm_array_get_handle (SCM_I_ARRAY_V (dst), &h);
   i = h.base + h.dims[0].lbnd + SCM_I_ARRAY_BASE (dst)*h.dims[0].inc;
   inc = SCM_I_ARRAY_DIMS (dst)->inc * h.dims[0].inc;
 
@@ -357,8 +357,8 @@ racp (SCM src, SCM dst)
   ssize_t inc_s, inc_d;
 
   dst = SCM_CAR (dst);
-  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (src), &h_s);
-  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (dst), &h_d);
+  scm_array_get_handle (SCM_I_ARRAY_V (src), &h_s);
+  scm_array_get_handle (SCM_I_ARRAY_V (dst), &h_d);
 
   i_s = h_s.base + h_s.dims[0].lbnd + SCM_I_ARRAY_BASE (src) * h_s.dims[0].inc;
   i_d = h_d.base + h_d.dims[0].lbnd + SCM_I_ARRAY_BASE (dst) * h_d.dims[0].inc;
@@ -665,7 +665,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
   scm_t_array_handle h0;
   size_t i0, i0end;
   ssize_t inc0;
-  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra0), &h0);
+  scm_array_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;
@@ -678,7 +678,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
       scm_t_array_handle h1;
       size_t i1;
       ssize_t inc1;
-      scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra1), &h1);
+      scm_array_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);
@@ -738,7 +738,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
   scm_t_array_handle h0;
   size_t i0, i0end;
   ssize_t inc0;
-  scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra0), &h0);
+  scm_array_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;
-- 
1.8.2


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

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <daniel.llorens@bluewin.ch> skribis:

> From 70fec2abb32b5d2546a40c70d15526b0ee5ccc20 Mon Sep 17 00:00:00 2001
> From: Daniel Llorens <daniel.llorens@bluewin.ch>
> Date: Sun, 7 Apr 2013 00:04:35 +0200
> Subject: [PATCH] Don't use scm_generalized_vector_get_handle() in array-map.c
>
> * libguile/array-map.c: (rafill, racp, ramap, rafe): use
>   scm_array_get_handle() instead of scm_generalized_get_vector_handle().

Applied, thanks!

Ludo’.

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <dll@jast.ch> skribis:

> From 03aa7ea2e61b419d38c6ca8de75ee34e5b55d28a Mon Sep 17 00:00:00 2001
> From: Daniel Llorens <daniel.llorens@bluewin.ch>
> Date: Wed, 3 Apr 2013 16:19:17 +0200
> Subject: [PATCH 5/5] Remove double indirection in array-fill!
>
> * libguile/array-map.c, libguile/array-map.c: deprecate scm_array_fill_int.
> * libguile/array-map.c: new function rafill, like scm_array_fill_int, but
>   factors GVSET out of loop. Use this in scm_array_fill_x instead of
>   scm_array_fill_int.
> * test-suite/tests/arrays.test: test array-fill! with noncompact array.
> * doc/guile-api.alist: unlist scm_array_fill_int.

Why deprecate scm_array_fill_int?  Seems to me that there’s nothing
wrong about it, no?

Ludo’.

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

[Daniel Llorens]

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

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

[Daniel Llorens]

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


This patch is for array-for-each. Only the first argument.

Before:

scheme@(guile-user)> (define a (make-array 1 1000000 10))
scheme@(guile-user)> ,time (let ((x 0)) (array-for-each (lambda (a) (set! x (+ a x))) a) x)
$8 = 10000000
;; 0.621887s real time, 0.620181s run time.  0.000000s spent in GC.

After:

scheme@(guile-user)> (define a (make-array 1 1000000 10))
scheme@(guile-user)> ,time (let ((x 0)) (array-for-each (lambda (a) (set! x (+ a x))) a) x)
$2 = 10000000
;; 0.529748s real time, 0.528301s run time.  0.000000s spent in GC.

Regards,
	
	Daniel


[-- Attachment #2: 0007-Remove-double-indirection-for-1st-arg-of-array-for-e.patch --]
[-- Type: application/octet-stream, Size: 2641 bytes --]

From e216b8ff059c7d05ecdeaf66f1447e0ddf97f999 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Tue, 2 Apr 2013 16:43:37 +0200
Subject: [PATCH 7/7] Remove double indirection for 1st arg of array-for-each

* libguile/array-map.c: (rafe): factor GVREF out of rank-1 loop for ra0.
---
 libguile/array-map.c |   44 +++++++++++++++++++++-----------------------
 1 file changed, 21 insertions(+), 23 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 7d5b19f..b504a69 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -461,36 +461,34 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
 static int
 rafe (SCM ra0, SCM proc, SCM ras)
 {
-  long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
-  unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
-  long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-  long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
-  ra0 = SCM_I_ARRAY_V (ra0);
+  ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
+  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 (; i <= n; i++, i0 += inc0)
-      scm_call_1 (proc, GVREF (ra0, i0));
+    for (; i0 < i0end; i0 += inc0)
+      scm_call_1 (proc, h0.impl->vref (&h0, i0));
   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;
-      ra1 = SCM_I_ARRAY_V (ra1);
-      ras = scm_vector (SCM_CDR (ras));
-
-      for (; i <= n; i++, i0 += inc0, 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_cons2 (GVREF (ra0, i0), GVREF (ra1, i1), args);
-	  scm_apply_0 (proc, args);
-	}
+      ras = scm_vector (ras);
+      for (; i0 < i0end; i0 += inc0, ++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);
+          scm_apply_1 (proc, h0.impl->vref (&h0, i0), args);
+        }
     }
   return 1;
 }
 
-
 SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1,
 	    (SCM proc, SCM ra0, SCM lra),
 	    "Apply @var{proc} to each tuple of elements of @var{ra0} @dots{}\n"
-- 
1.7.9.5


[-- Attachment #3: Type: text/plain, Size: 2 bytes --]

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

[Daniel Llorens]

Hello,

sorry for the repeated message earlier. 

Ok, i think it's clear that all these double indirections can be eliminated globally by composing the strides of the array descriptor with the stride of SCM_I_ARRAY_V (array) and using that directly in the array descriptor. Is there any reason not to do this?

Regards,

	Daniel

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Hi Daniel,

Daniel Llorens <daniel.llorens@bluewin.ch> skribis:

> --- a/libguile/array-map.h
> +++ b/libguile/array-map.h
> @@ -34,16 +34,6 @@ SCM_API int scm_ramapc (void *cproc, SCM data, SCM ra0, SCM lra,
>  SCM_API int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
>  SCM_API SCM scm_array_fill_x (SCM ra, SCM fill);
>  SCM_API SCM scm_array_copy_x (SCM src, SCM dst);
> -SCM_API int scm_ra_eqp (SCM ra0, SCM ras);
> -SCM_API int scm_ra_lessp (SCM ra0, SCM ras);
> -SCM_API int scm_ra_leqp (SCM ra0, SCM ras);
> -SCM_API int scm_ra_grp (SCM ra0, SCM ras);
> -SCM_API int scm_ra_greqp (SCM ra0, SCM ras);
> -SCM_API int scm_ra_sum (SCM ra0, SCM ras);
> -SCM_API int scm_ra_difference (SCM ra0, SCM ras);
> -SCM_API int scm_ra_product (SCM ra0, SCM ras);
> -SCM_API int scm_ra_divide (SCM ra0, SCM ras);
> -SCM_API int scm_array_identity (SCM src, SCM dst);
>  SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra);
>  SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
>  SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc);

This is problematic since they are part of the API.  But they’re
undocumented, and as you say, most likely dead code.

So, can you instead deprecate them?  You need to replace SCM_API with
SCM_DEPRECATED, and put them (body and declarations) in

  #if SCM_ENABLE_DEPRECATED == 1

Hopefully they can be removed in 2.2 or so.

TIA,
Ludo’.

Re: array-copy! is slow & array-map.c

[Ludovic Courtès]

Daniel Llorens <daniel.llorens@bluewin.ch> skribis:

> From a38b0a98ed6093ee9ebe4ac60b4b6f9efbdcfdd5 Mon Sep 17 00:00:00 2001
> From: Daniel Llorens <daniel.llorens@bluewin.ch>
> Date: Mon, 1 Apr 2013 18:43:58 +0200
> Subject: [PATCH 2/2] Remove double indirection in element access in
>  array-copy!
>
> * libguile/array-map.c: (racp): factor scm_generalized_vector_ref,
>   scm_generalized_vector_set_x out of the rank-1 loop.

Applied, with the addition of the couple of ‘scm_array_handle_release’
calls that were missing.

Thanks,
Ludo’.