From cd7fee8e657cf21ca5013fd90fd5043105e6a907 Mon Sep 17 00:00:00 2001 From: Daniel Llorens Date: Wed, 9 Dec 2015 13:10:48 +0100 Subject: [PATCH] Special case for array-map! with three arguments 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. --- libguile/array-map.c | 64 +++++++++++++++++++++++++++----------------- 1 file changed, 40 insertions(+), 24 deletions(-) diff --git a/libguile/array-map.c b/libguile/array-map.c index e3af729c8..1f00c92fa 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -321,32 +321,48 @@ ramap (SCM ra0, SCM proc, SCM ras) h0.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1))); else { - scm_t_array_handle *hs; - size_t restn = scm_ilength (ras); - - SCM args = SCM_EOL; - SCM *p = &args; - SCM **sa = scm_gc_malloc (sizeof(SCM *) * restn, vi_gc_hint); - for (size_t k = 0; k < restn; ++k) + SCM ra2 = SCM_CAR (ras); + size_t i2 = SCM_I_ARRAY_BASE (ra2); + ssize_t inc2 = SCM_I_ARRAY_DIMS (ra2)->inc; + scm_t_array_handle h2; + ra2 = SCM_I_ARRAY_V (ra2); + scm_array_get_handle (ra2, &h2); + ras = SCM_CDR (ras); + 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 { - *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL); - sa[k] = SCM_CARLOC (*p); - p = SCM_CDRLOC (*p); + scm_t_array_handle *hs; + size_t restn = scm_ilength (ras); + SCM args = SCM_EOL; + SCM *p = &args; + SCM **sa = scm_gc_malloc (sizeof(SCM *) * restn, vi_gc_hint); + size_t k; + ssize_t i; + + for (k = 0; k < restn; ++k) + { + *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL); + sa[k] = SCM_CARLOC (*p); + p = SCM_CDRLOC (*p); + } + + hs = scm_gc_malloc (sizeof(scm_t_array_handle) * restn, vi_gc_hint); + for (k = 0; k < restn; ++k, ras = scm_cdr (ras)) + scm_array_get_handle (scm_car (ras), hs+k); + + for (i = 0; n--; i0 += inc0, i1 += inc1, i2 += inc2, ++i) + { + for (k = 0; k < restn; ++k) + *(sa[k]) = scm_array_handle_ref (hs+k, i*hs[k].dims[0].inc); + h0.vset (h0.vector, i0, scm_apply_2 (proc, h1.vref (h1.vector, i1), h2.vref (h2.vector, i2), args)); + } + + for (k = 0; k < restn; ++k) + scm_array_handle_release (hs+k); } - - hs = scm_gc_malloc (sizeof(scm_t_array_handle) * restn, vi_gc_hint); - for (size_t k = 0; k < restn; ++k, ras = scm_cdr (ras)) - scm_array_get_handle (scm_car (ras), hs+k); - - for (ssize_t i = 0; n--; i0 += inc0, i1 += inc1, ++i) - { - for (size_t k = 0; k < restn; ++k) - *(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)); - } - - for (size_t k = 0; k < restn; ++k) - scm_array_handle_release (hs+k); + scm_array_handle_release (&h2); } scm_array_handle_release (&h1); }