guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 10/13: Special case for array-map! with three arguments


From: Daniel Llorens
Subject: [Guile-commits] 10/13: Special case for array-map! with three arguments
Date: Tue, 12 Jul 2016 07:30:51 +0000 (UTC)

lloda pushed a commit to branch lloda-squash0
in repository guile.

commit b3727a29c74fb351627bc8166b293ef34e72c11e
Author: Daniel Llorens <address@hidden>
Date:   Wed Dec 9 13:10:48 2015 +0100

    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 |   56 +++++++++++++++++++++++++++++++-------------------
 1 file changed, 35 insertions(+), 21 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 058b6fe..f07fd00 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -320,32 +320,46 @@ ramap (SCM ra0, SCM proc, SCM ras)
           h0.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1)));
       else
         {
-          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);
+          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
             {
-              *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL);
-              sa[k] = SCM_CARLOC (*p);
-              p = SCM_CDRLOC (*p);
-            }
+              size_t restn = scm_ilength (ras);
 
-          scm_t_array_handle *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);
+              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)
+                {
+                  *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL);
+                  sa[k] = SCM_CARLOC (*p);
+                  p = SCM_CDRLOC (*p);
+                }
+
+              scm_t_array_handle *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, i2 += inc2, ++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_2 (proc, h1.vref 
(h1.vector, i1), h2.vref (h2.vector, i2), args));
+                }
 
-          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));
+                scm_array_handle_release (hs+k);
             }
-
-          for (size_t k = 0; k < restn; ++k)
-            scm_array_handle_release (hs+k);
+          scm_array_handle_release (&h2);
         }
       scm_array_handle_release (&h1);
     }



reply via email to

[Prev in Thread] Current Thread [Next in Thread]