mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

optimize access to arrays of rank 1 or 2

Browse source 
* libguile/array-handle.c (scm_array_handle_pos_1):
  (scm_array_handle_pos_2): New functions.

* libguile/generalized-arrays.c (scm_c_array_ref_1, scm_c_array_ref_2):
  (scm_c_array_set_1_x, scm_c_array_set_2_x): New functions.
  (scm_i_array_ref, scm_i_array_set_x): New subr bindings for array-ref
  and array-set! that avoid consing for arrays of rank 1 or 2.

* test-suite/tests/arrays.test ("array-set!"): Fix expected exception
  for wrong number of indices.
This commit is contained in:
Andy Wingo 2013-02-18 16:38:24 +01:00
parent 18cd9aff94
commit 336c921146
5 changed files with 154 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

43
libguile/array-handle.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,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
@ -97,6 +97,47 @@ scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
return pos;
}
static void
check_array_index_bounds (scm_t_array_dim *dim, ssize_t idx)
{
if (idx < dim->lbnd || idx > dim->ubnd)
scm_error (scm_out_of_range_key, NULL, "Value out of range ~S to ~S: ~S",
scm_list_3 (scm_from_ssize_t (dim->lbnd),
scm_from_ssize_t (dim->ubnd),
scm_from_ssize_t (idx)),
scm_list_1 (scm_from_ssize_t (idx)));
}
ssize_t
scm_array_handle_pos_1 (scm_t_array_handle *h, ssize_t idx0)
{
scm_t_array_dim *dim = scm_array_handle_dims (h);
if (scm_array_handle_rank (h) != 1)
scm_misc_error (NULL, "wrong number of indices, expecting ~A",
scm_list_1 (scm_from_size_t (scm_array_handle_rank (h))));
check_array_index_bounds (&dim[0], idx0);
return (idx0 - dim[0].lbnd) * dim[0].inc;
}
ssize_t
scm_array_handle_pos_2 (scm_t_array_handle *h, ssize_t idx0, ssize_t idx1)
{
scm_t_array_dim *dim = scm_array_handle_dims (h);
if (scm_array_handle_rank (h) != 2)
scm_misc_error (NULL, "wrong number of indices, expecting ~A",
scm_list_1 (scm_from_size_t (scm_array_handle_rank (h))));
check_array_index_bounds (&dim[0], idx0);
check_array_index_bounds (&dim[1], idx1);
return ((idx0 - dim[0].lbnd) * dim[0].inc
+ (idx1 - dim[1].lbnd) * dim[1].inc);
}
SCM
scm_array_handle_element_type (scm_t_array_handle *h)
{