mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

Preallocate index list in scm_array_index_map_x

Browse source 
* 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.
This commit is contained in:
Daniel Llorens 2013-04-30 16:11:07 +02:00 • committed by Andy Wingo
parent d0b47b4946
commit dcc91f931c
2 changed files with 26 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

34
libguile/array-map.c
View file

@ -583,12 +583,12 @@ ramap (SCM ra0, SCM proc, SCM ras)
scm_t_array_handle h0; scm_t_array_handle h0;
size_t n, i0; size_t n, i0;
ssize_t i, inc0; ssize_t i, inc0;
scm_array_get_handle (SCM_I_ARRAY_V (ra0), &h0);
i0 = SCM_I_ARRAY_BASE (ra0); i0 = SCM_I_ARRAY_BASE (ra0);
inc0 = SCM_I_ARRAY_DIMS (ra0)->inc; inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
i = SCM_I_ARRAY_DIMS (ra0)->lbnd; i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1; n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1;
ra0 = SCM_I_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
scm_array_get_handle (ra0, &h0);
if (scm_is_null (ras)) if (scm_is_null (ras))
for (; n--; i0 += inc0) for (; n--; i0 += inc0)
h0.impl->vset (ra0, i0, scm_call_0 (proc)); 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; scm_t_array_handle h1;
size_t i1; size_t i1;
ssize_t inc1; ssize_t inc1;
scm_array_get_handle (SCM_I_ARRAY_V (ra1), &h1);
i1 = SCM_I_ARRAY_BASE (ra1); i1 = SCM_I_ARRAY_BASE (ra1);
inc1 = SCM_I_ARRAY_DIMS (ra1)->inc; inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ras = SCM_CDR (ras); ras = SCM_CDR (ras);
ra1 = SCM_I_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
scm_array_get_handle (ra1, &h1);
if (scm_is_null (ras)) if (scm_is_null (ras))
for (; n--; i0 += inc0, i1 += inc1) for (; n--; i0 += inc0, i1 += inc1)
h0.impl->vset (ra0, i0, scm_call_1 (proc, h1.impl->vref (ra1, i1))); 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; scm_t_array_handle h0;
size_t i0; size_t i0;
ssize_t inc0; ssize_t inc0;
scm_array_get_handle (SCM_I_ARRAY_V (ra0), &h0);
i0 = SCM_I_ARRAY_BASE (ra0); i0 = SCM_I_ARRAY_BASE (ra0);
inc0 = SCM_I_ARRAY_DIMS (ra0)->inc; inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_I_ARRAY_V (ra0);
scm_array_get_handle (ra0, &h0);
if (scm_is_null (ras)) if (scm_is_null (ras))
for (; n--; i0 += inc0) 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 else
{ {
ras = scm_vector (ras); ras = scm_vector (ras);
@ -674,7 +675,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
unsigned long k; unsigned long k;
for (k = scm_c_vector_length (ras); k--;) for (k = scm_c_vector_length (ras); k--;)
args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args); 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); scm_array_handle_release (&h0);
@ -734,19 +735,26 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
else else
{ {
size_t i; 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; ssize_t *vi;
SCM **si;
SCM args = SCM_EOL;
SCM *p = &args;
if (kmax < 0) if (kmax < 0)
return scm_array_set_x (ra, scm_call_0 (proc), SCM_EOL); 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); 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++) for (k = 0; k <= kmax; k++)
{ {
vi[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd; vi[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
if (vi[k] > SCM_I_ARRAY_DIMS (ra)[k].ubnd) if (vi[k] > SCM_I_ARRAY_DIMS (ra)[k].ubnd)
return SCM_UNSPECIFIED; 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); 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) if (k == kmax)
{ {
SCM args = SCM_EOL;
SCM *p = &args, *q;
vi[kmax] = SCM_I_ARRAY_DIMS (ra)[kmax].lbnd; vi[kmax] = SCM_I_ARRAY_DIMS (ra)[kmax].lbnd;
i = cindk (ra, vi, kmax+1); i = cindk (ra, vi, kmax+1);
for (j = 0; j<=kmax; ++j) for (; vi[kmax] <= SCM_I_ARRAY_DIMS (ra)[kmax].ubnd; ++vi[kmax])
{
*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]))
{ {
*(si[kmax]) = scm_from_ssize_t (vi[kmax]);
h.impl->vset (h.root, i, scm_apply_0 (proc, args)); h.impl->vset (h.root, i, scm_apply_0 (proc, args));
i += SCM_I_ARRAY_DIMS (ra)[kmax].inc; 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) else if (vi[k] < SCM_I_ARRAY_DIMS (ra)[k].ubnd)
{ {
vi[k]++; *(si[k]) = scm_from_ssize_t (++vi[k]);
k++; k++;
} }
else else

10
test-suite/tests/ramap.test
View file

@ -62,7 +62,15 @@
(array-index-map! (make-typed-array 'f64 0 0 2) (const 0)) (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 'b #t 0 2) (const #t))
(array-index-map! (make-typed-array #t 0 0 2) (const 0)) (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! ;;; array-copy!