mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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 1e2a55e42a
commit b98e2f47aa
2 changed files with 24 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

30
libguile/array-map.c
View file

@ -574,12 +574,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.vset (h0.vector, i0, scm_call_0 (proc)); h0.vset (h0.vector, i0, scm_call_0 (proc));
@ -589,11 +589,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.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1))); h0.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1)));
@ -651,9 +651,10 @@ 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.vref (h0.vector, i0)); scm_call_1 (proc, h0.vref (h0.vector, i0));
@ -706,16 +707,23 @@ array_index_map_n (SCM ra, SCM proc)
{ {
scm_t_array_handle h; scm_t_array_handle h;
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;
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; return;
*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);
@ -724,19 +732,11 @@ array_index_map_n (SCM ra, SCM proc)
{ {
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.vset (h.vector, i, scm_apply_0 (proc, args)); h.vset (h.vector, i, scm_apply_0 (proc, args));
i += SCM_I_ARRAY_DIMS (ra)[kmax].inc; i += SCM_I_ARRAY_DIMS (ra)[kmax].inc;
} }
@ -744,7 +744,7 @@ array_index_map_n (SCM ra, SCM proc)
} }
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!