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

Special case for array-map! with three arguments

Browse source 
Benchmark:

(define type #t)
(define A (make-typed-array 's32 0 10000 1000))
(define B (make-typed-array 's32 0 10000 1000))
(define C (make-typed-array 's32 0 10000 1000))

before:

scheme@(guile-user)> ,time (array-map! C + A B)
;; 0.792653s real time, 0.790970s run time.  0.000000s spent in GC.

after:

scheme@(guile-user)> ,time (array-map! C + A B)
;; 0.598513s real time, 0.597146s run time.  0.000000s spent in GC.

* libguile/array-map.c (ramap): Add special case with 3 arguments.
This commit is contained in:
Daniel Llorens 2015-12-09 13:10:48 +01:00
parent ffd949e597
commit b854d0f34a
1 changed files with 36 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

18
libguile/array-map.c
View file

@ -318,6 +318,18 @@ ramap (SCM ra0, SCM proc, SCM ras)
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)));
else
{
SCM ra2 = SCM_CAR (ras);
ras = SCM_CDR (ras);
size_t i2 = SCM_I_ARRAY_BASE (ra2);
ssize_t inc2 = SCM_I_ARRAY_DIMS (ra2)->inc;
ra2 = SCM_I_ARRAY_V (ra2);
scm_t_array_handle h2;
scm_array_get_handle (ra2, &h2);
if (scm_is_null (ras))
for (; n--; i0 += inc0, i1 += inc1, i2 += inc2)
h0.vset (h0.vector, i0, scm_call_2 (proc, h1.vref (h1.vector, i1), h2.vref (h2.vector, i2)));
else else
{ {
size_t restn = scm_ilength (ras); size_t restn = scm_ilength (ras);
@ -337,16 +349,18 @@ ramap (SCM ra0, SCM proc, SCM ras)
for (size_t k = 0; k < restn; ++k, ras = scm_cdr (ras)) for (size_t k = 0; k < restn; ++k, ras = scm_cdr (ras))
scm_array_get_handle (scm_car (ras), hs+k); scm_array_get_handle (scm_car (ras), hs+k);
for (ssize_t i = 0; n--; i0 += inc0, i1 += inc1, ++i) for (ssize_t i = 0; n--; i0 += inc0, i1 += inc1, i2 += inc2, ++i)
{ {
for (size_t k = 0; k < restn; ++k) for (size_t k = 0; k < restn; ++k)
*(sa[k]) = scm_array_handle_ref (hs+k, i*hs[k].dims[0].inc); *(sa[k]) = scm_array_handle_ref (hs+k, i*hs[k].dims[0].inc);
h0.vset (h0.vector, i0, scm_apply_1 (proc, h1.vref (h1.vector, i1), args)); h0.vset (h0.vector, i0, scm_apply_2 (proc, h1.vref (h1.vector, i1), h2.vref (h2.vector, i2), args));
} }
for (size_t k = 0; k < restn; ++k) for (size_t k = 0; k < restn; ++k)
scm_array_handle_release (hs+k); scm_array_handle_release (hs+k);
} }
scm_array_handle_release (&h2);
}
scm_array_handle_release (&h1); scm_array_handle_release (&h1);
} }
scm_array_handle_release (&h0); scm_array_handle_release (&h0);