guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] 12/24: Speed up for multi-arg cases of scm_ramap functio


From: Daniel Llorens
Subject: [Guile-commits] 12/24: Speed up for multi-arg cases of scm_ramap functions
Date: Sat, 25 Jun 2016 14:09:32 +0000 (UTC)

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 8127de42b3e91d2a60eb1bb9c90f66db55e47998
Author: Daniel Llorens <address@hidden>
Date:   Fri Feb 13 18:42:27 2015 +0100

    Speed up for multi-arg cases of scm_ramap functions
    
    This patch results in a 20%-40% speedup in the > 1 argument cases of
    the following microbenchmarks:
    
    (define A (make-shared-array #0(1) (const '()) #e1e7))
    ; 1, 2, 3 arguments.
    (define a 0) ,time (array-for-each (lambda (b) (set! a (+ a b))) A)
    (define a 0) ,time (array-for-each (lambda (b c) (set! a (+ a b c))) A A)
    (define a 0) ,time (array-for-each (lambda (b c d) (set! a (+ a b c d))) A 
A A)
    
    (define A (make-shared-array (make-array 1) (const '()) #e1e7))
    (define B (make-shared-array #0(1) (const '()) #e1e7))
    ; 1, 2, 3 arguments.
    ,time (array-map! A + B)
    ,time (array-map! A + B B)
    ,time (array-map! A + B B B)
    
    * libguile/array-map.c (scm_ramap): note on cproc arguments.
    
      (rafill): assume that dst's lbnd is 0.
    
      (racp): assume that src's lbnd is 0.
    
      (ramap): assume that ra0's lbnd is 0. When there're more than two
      arguments, compute the array handles before the loop. Allocate the arg
      list once and reuse it in the loop.
    
      (rafe): like rafe, when there's more than one argument.
    
      (AREF, ASET): remove.
---
 libguile/array-map.c        |  151 +++++++++++++++++++++++--------------------
 libguile/array-map.h        |    2 +-
 test-suite/tests/ramap.test |   10 +--
 3 files changed, 86 insertions(+), 77 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 587df02..058b6fe 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1996, 1998, 2000, 2001, 2004, 2005, 2006, 2008, 2009,
- *   2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ *   2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -48,18 +48,6 @@
 static const char vi_gc_hint[] = "array-indices";
 
 static SCM
-AREF (SCM v, size_t pos)
-{
-  return scm_c_array_ref_1 (v, pos);
-}
-
-static void
-ASET (SCM v, size_t pos, SCM val)
-{
-  scm_c_array_set_1_x (v, val, pos);
-}
-
-static SCM
 make1array (SCM v, ssize_t inc)
 {
   SCM a = scm_i_make_array (1);
@@ -99,6 +87,10 @@ cindk (SCM ra, ssize_t *ve, int kend)
 #define LBND(ra, k) SCM_I_ARRAY_DIMS (ra)[k].lbnd
 #define UBND(ra, k) SCM_I_ARRAY_DIMS (ra)[k].ubnd
 
+
+/* scm_ramapc() always calls cproc with rank-1 arrays created by
+   make1array. cproc (rafe, ramap, rafill, racp) can assume that the
+   dims[0].lbnd of these arrays is always 0. */
 int
 scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
 {
@@ -167,7 +159,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, 
const char *what)
             scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 
(ra0));
           va1 = make1array (ra1, 1);
 
-          if (LBND (ra0, 0) < LBND (va1, 0) || UBND (ra0, 0) > UBND (va1, 0))
+          if (LBND (ra0, 0) < 0 /* LBND (va1, 0) */ || UBND (ra0, 0) > UBND 
(va1, 0))
             scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 
(ra0));
         }
       *plva = scm_cons (va1, SCM_EOL);
@@ -224,14 +216,12 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, 
const char *what)
 static int
 rafill (SCM dst, SCM fill)
 {
-  scm_t_array_handle h;
-  size_t n, i;
-  ssize_t inc;
-  scm_array_get_handle (SCM_I_ARRAY_V (dst), &h);
-  i = SCM_I_ARRAY_BASE (dst);
-  inc = SCM_I_ARRAY_DIMS (dst)->inc;
-  n = (SCM_I_ARRAY_DIMS (dst)->ubnd - SCM_I_ARRAY_DIMS (dst)->lbnd + 1);
+  size_t n = SCM_I_ARRAY_DIMS (dst)->ubnd + 1;
+  size_t i = SCM_I_ARRAY_BASE (dst);
+  ssize_t inc = SCM_I_ARRAY_DIMS (dst)->inc;
   dst = SCM_I_ARRAY_V (dst);
+  scm_t_array_handle h;
+  scm_array_get_handle (dst, &h);
 
   for (; n-- > 0; i += inc)
     h.vset (h.vector, i, fill);
@@ -255,19 +245,15 @@ SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
 static int
 racp (SCM src, SCM dst)
 {
-  scm_t_array_handle h_s, h_d;
-  size_t n, i_s, i_d;
-  ssize_t inc_s, inc_d;
-
   dst = SCM_CAR (dst);
-  i_s = SCM_I_ARRAY_BASE (src);
-  i_d = SCM_I_ARRAY_BASE (dst);
-  inc_s = SCM_I_ARRAY_DIMS (src)->inc;
-  inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
-  n = (SCM_I_ARRAY_DIMS (src)->ubnd - SCM_I_ARRAY_DIMS (src)->lbnd + 1);
+  size_t i_s = SCM_I_ARRAY_BASE (src);
+  size_t i_d = SCM_I_ARRAY_BASE (dst);
+  size_t n = (SCM_I_ARRAY_DIMS (src)->ubnd + 1);
+  ssize_t inc_s = SCM_I_ARRAY_DIMS (src)->inc;
+  ssize_t inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
   src = SCM_I_ARRAY_V (src);
   dst = SCM_I_ARRAY_V (dst);
-
+  scm_t_array_handle h_s, h_d;
   scm_array_get_handle (src, &h_s);
   scm_array_get_handle (dst, &h_d);
 
@@ -310,44 +296,56 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
 static int
 ramap (SCM ra0, SCM proc, SCM ras)
 {
-  scm_t_array_handle h0;
-  size_t n, i0;
-  ssize_t i, inc0;
-  i0 = SCM_I_ARRAY_BASE (ra0);
-  inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-  i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
-  n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1;
+  size_t i0 = SCM_I_ARRAY_BASE (ra0);
+  ssize_t inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+  size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd + 1;
   ra0 = SCM_I_ARRAY_V (ra0);
+  scm_t_array_handle h0;
   scm_array_get_handle (ra0, &h0);
+
   if (scm_is_null (ras))
     for (; n--; i0 += inc0)
       h0.vset (h0.vector, i0, scm_call_0 (proc));
   else
     {
       SCM ra1 = SCM_CAR (ras);
-      scm_t_array_handle h1;
-      size_t i1;
-      ssize_t inc1;
-      i1 = SCM_I_ARRAY_BASE (ra1);
-      inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
       ras = SCM_CDR (ras);
+      size_t i1 = SCM_I_ARRAY_BASE (ra1);
+      ssize_t inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
       ra1 = SCM_I_ARRAY_V (ra1);
+      scm_t_array_handle h1;
       scm_array_get_handle (ra1, &h1);
       if (scm_is_null (ras))
         for (; n--; i0 += inc0, i1 += inc1)
           h0.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1)));
       else
         {
-          ras = scm_vector (ras);
-          for (; n--; i0 += inc0, i1 += inc1, ++i)
+          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)
+            {
+              *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, ++i)
             {
-              SCM args = SCM_EOL;
-              unsigned long k;
-              for (k = scm_c_vector_length (ras); k--;)
-                args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
-              h0.vset (h0.vector, i0,
-                       scm_apply_1 (proc, h1.vref (h1.vector, i1), args));
+              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 (&h1);
     }
@@ -384,30 +382,44 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
 static int
 rafe (SCM ra0, SCM proc, SCM ras)
 {
-  ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
-  size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1;
-
-  scm_t_array_handle h0;
-  size_t i0;
-  ssize_t inc0;
-  i0 = SCM_I_ARRAY_BASE (ra0);
-  inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+  size_t i0 = SCM_I_ARRAY_BASE (ra0);
+  ssize_t inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+  size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd + 1;
   ra0 = SCM_I_ARRAY_V (ra0);
+  scm_t_array_handle h0;
   scm_array_get_handle (ra0, &h0);
+
   if (scm_is_null (ras))
     for (; n--; i0 += inc0)
       scm_call_1 (proc, h0.vref (h0.vector, i0));
   else
     {
-      ras = scm_vector (ras);
-      for (; n--; i0 += inc0, ++i)
+      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 args = SCM_EOL;
-          unsigned long k;
-          for (k = scm_c_vector_length (ras); k--;)
-            args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
+          *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, ++i)
+        {
+          for (size_t k = 0; k < restn; ++k)
+            *(sa[k]) = scm_array_handle_ref (hs+k, i*hs[k].dims[0].inc);
           scm_apply_1 (proc, h0.vref (h0.vector, i0), args);
         }
+
+      for (size_t k = 0; k < restn; ++k)
+        scm_array_handle_release (hs+k);
     }
   scm_array_handle_release (&h0);
   return 1;
@@ -445,15 +457,12 @@ static void
 array_index_map_n (SCM ra, SCM proc)
 {
   scm_t_array_handle h;
-  size_t i;
   int k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
-  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);
-  si = scm_gc_malloc_pointerless (sizeof(SCM *) * (kmax + 1), vi_gc_hint);
+  ssize_t *vi = scm_gc_malloc_pointerless (sizeof(ssize_t) * (kmax + 1), 
vi_gc_hint);
+  SCM **si = scm_gc_malloc_pointerless (sizeof(SCM *) * (kmax + 1), 
vi_gc_hint);
 
   for (k = 0; k <= kmax; k++)
     {
@@ -472,7 +481,7 @@ array_index_map_n (SCM ra, SCM proc)
       if (k == kmax)
         {
           vi[kmax] = SCM_I_ARRAY_DIMS (ra)[kmax].lbnd;
-          i = cindk (ra, vi, kmax+1);
+          size_t i = cindk (ra, vi, kmax+1);
           for (; vi[kmax] <= SCM_I_ARRAY_DIMS (ra)[kmax].ubnd; ++vi[kmax])
             {
               *(si[kmax]) = scm_from_ssize_t (vi[kmax]);
diff --git a/libguile/array-map.h b/libguile/array-map.h
index e7431b1..cb18a62 100644
--- a/libguile/array-map.h
+++ b/libguile/array-map.h
@@ -4,7 +4,7 @@
 #define SCM_ARRAY_MAP_H
 
 /* Copyright (C) 1995, 1996, 1997, 2000, 2006, 2008, 2009, 2010,
- *   2011, 2013 Free Software Foundation, Inc.
+ *   2011, 2013, 2015 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test
index c8eaf96..d8241ef 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/ramap.test
@@ -1,17 +1,17 @@
 ;;;; ramap.test --- test array mapping functions -*- scheme -*-
-;;;; 
+;;;;
 ;;;; Copyright (C) 2004, 2005, 2006, 2009, 2013 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
 ;;;; version 3 of the License, or (at your option) any later version.
-;;;; 
+;;;;
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;;; Lesser General Public License for more details.
-;;;; 
+;;;;
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
@@ -453,11 +453,11 @@
 
   (with-test-prefix "3 sources"
     (pass-if-equal "noncompact arrays 1"
-        '((3 3 3) (2 2 2))
+        '((3 1 3) (2 0 2))
       (let* ((a #2((0 1) (2 3)))
              (l '())
              (rec (lambda args (set! l (cons args l)))))
-        (array-for-each rec (array-row a 1) (array-row a 1) (array-row a 1))
+        (array-for-each rec (array-row a 1) (array-row a 0) (array-row a 1))
         l))
 
     (pass-if-equal "noncompact arrays 2"



reply via email to

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