mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
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.
This commit is contained in:
Daniel Llorens
parent
348d8b46b0
commit
c17799dda9
3 changed files with 86 additions and 77 deletions
|
|
@ -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
|
||||
|
|
@ -47,18 +47,6 @@
|
|||
/* The WHAT argument for `scm_gc_malloc ()' et al. */
|
||||
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)
|
||||
{
|
||||
|
|
@ -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)
|
||||
{
|
||||
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));
|
||||
*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)
|
||||
{
|
||||
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]);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue