summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2013-04-30 16:11:07 +0200
committerAndy Wingo <wingo@pobox.com>2014-01-27 21:48:44 +0100
commitdcc91f931cb63145fee7729a718245c658d8094d (patch)
tree03f4c855155a17b232443b1931f81995a91cc095
parentd0b47b494682ebe36f8a93dbc96afe6cae2c5e13 (diff)
downloadguile-dcc91f931cb63145fee7729a718245c658d8094d.tar.gz
Preallocate index list in scm_array_index_map_x
* libguile/array-map.c - (scm_array_index_map_x): preallocate the index list instead of constructing it on each rank-1 iteration. - (ramap, rafe): use SCM_I_ARRAY_V just once.
-rw-r--r--libguile/array-map.c34
-rw-r--r--test-suite/tests/ramap.test10
2 files changed, 26 insertions, 18 deletions
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 6af1539e9..af72a764a 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -583,12 +583,12 @@ ramap (SCM ra0, SCM proc, SCM ras)
scm_t_array_handle h0;
size_t n, i0;
ssize_t i, inc0;
- scm_array_get_handle (SCM_I_ARRAY_V (ra0), &h0);
i0 = SCM_I_ARRAY_BASE (ra0);
inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1;
ra0 = SCM_I_ARRAY_V (ra0);
+ scm_array_get_handle (ra0, &h0);
if (scm_is_null (ras))
for (; n--; i0 += inc0)
h0.impl->vset (ra0, i0, scm_call_0 (proc));
@@ -598,11 +598,11 @@ ramap (SCM ra0, SCM proc, SCM ras)
scm_t_array_handle h1;
size_t i1;
ssize_t inc1;
- scm_array_get_handle (SCM_I_ARRAY_V (ra1), &h1);
i1 = SCM_I_ARRAY_BASE (ra1);
inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ras = SCM_CDR (ras);
ra1 = SCM_I_ARRAY_V (ra1);
+ scm_array_get_handle (ra1, &h1);
if (scm_is_null (ras))
for (; n--; i0 += inc0, i1 += inc1)
h0.impl->vset (ra0, i0, scm_call_1 (proc, h1.impl->vref (ra1, i1)));
@@ -659,12 +659,13 @@ rafe (SCM ra0, SCM proc, SCM ras)
scm_t_array_handle h0;
size_t i0;
ssize_t inc0;
- scm_array_get_handle (SCM_I_ARRAY_V (ra0), &h0);
i0 = SCM_I_ARRAY_BASE (ra0);
inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ ra0 = SCM_I_ARRAY_V (ra0);
+ scm_array_get_handle (ra0, &h0);
if (scm_is_null (ras))
for (; n--; i0 += inc0)
- scm_call_1 (proc, h0.impl->vref (SCM_I_ARRAY_V (ra0), i0));
+ scm_call_1 (proc, h0.impl->vref (ra0, i0));
else
{
ras = scm_vector (ras);
@@ -674,7 +675,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
unsigned long k;
for (k = scm_c_vector_length (ras); k--;)
args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
- scm_apply_1 (proc, h0.impl->vref (SCM_I_ARRAY_V (ra0), i0), args);
+ scm_apply_1 (proc, h0.impl->vref (ra0, i0), args);
}
}
scm_array_handle_release (&h0);
@@ -734,19 +735,26 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
else
{
size_t i;
- int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
+ int k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
ssize_t *vi;
+ SCM **si;
+ SCM args = SCM_EOL;
+ SCM *p = &args;
if (kmax < 0)
return scm_array_set_x (ra, scm_call_0 (proc), SCM_EOL);
vi = scm_gc_malloc_pointerless (sizeof(ssize_t) * (kmax + 1), vi_gc_hint);
+ si = scm_gc_malloc_pointerless (sizeof(SCM *) * (kmax + 1), vi_gc_hint);
for (k = 0; k <= kmax; k++)
{
vi[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
if (vi[k] > SCM_I_ARRAY_DIMS (ra)[k].ubnd)
return SCM_UNSPECIFIED;
+ *p = scm_cons (scm_from_ssize_t (vi[k]), SCM_EOL);
+ si[k] = SCM_CARLOC (*p);
+ p = SCM_CDRLOC (*p);
}
scm_array_get_handle (ra, &h);
@@ -755,19 +763,11 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
{
if (k == kmax)
{
- SCM args = SCM_EOL;
- SCM *p = &args, *q;
vi[kmax] = SCM_I_ARRAY_DIMS (ra)[kmax].lbnd;
i = cindk (ra, vi, kmax+1);
- for (j = 0; j<=kmax; ++j)
- {
- *p = scm_cons (scm_from_ssize_t (vi[j]), SCM_EOL);
- q = SCM_CARLOC (*p);
- p = SCM_CDRLOC (*p);
- }
- for (; vi[kmax] <= SCM_I_ARRAY_DIMS (ra)[kmax].ubnd;
- *q = scm_from_ssize_t (++vi[kmax]))
+ for (; vi[kmax] <= SCM_I_ARRAY_DIMS (ra)[kmax].ubnd; ++vi[kmax])
{
+ *(si[kmax]) = scm_from_ssize_t (vi[kmax]);
h.impl->vset (h.root, i, scm_apply_0 (proc, args));
i += SCM_I_ARRAY_DIMS (ra)[kmax].inc;
}
@@ -775,7 +775,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
}
else if (vi[k] < SCM_I_ARRAY_DIMS (ra)[k].ubnd)
{
- vi[k]++;
+ *(si[k]) = scm_from_ssize_t (++vi[k]);
k++;
}
else
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test
index 950f65925..c8eaf96eb 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/ramap.test
@@ -62,7 +62,15 @@
(array-index-map! (make-typed-array 'f64 0 0 2) (const 0))
(array-index-map! (make-typed-array 'b #t 0 2) (const #t))
(array-index-map! (make-typed-array #t 0 0 2) (const 0))
- #t)))
+ #t))
+
+ (pass-if "rank 2"
+ (let ((a (make-array 0 2 2))
+ (b (make-array 0 2 2)))
+ (array-index-map! a (lambda (i j) i))
+ (array-index-map! b (lambda (i j) j))
+ (and (array-equal? a #2((0 0) (1 1)))
+ (array-equal? b #2((0 1) (0 1)))))))
;;;
;;; array-copy!