summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2013-04-11 13:03:45 +0200
committerAndy Wingo <wingo@pobox.com>2014-01-27 21:45:17 +0100
commit943f690a308f917fbac994fc1dd14d339879d6d4 (patch)
tree93e63d2601bc415ec8bf518fc3c0aac7894648b8
parent499a9804c784a92a1dbe51cd3fb45847c29a1c7d (diff)
downloadguile-943f690a308f917fbac994fc1dd14d339879d6d4.tar.gz
Fix bad uses of base and lbnd on rank 1 arrays
* libguile/array-map.c - rafill, ramap, rafe, racp: object from SCM_I_ARRAY_V always has base 0, lbnd 0 and inc 1; make use of this. * libguile/arrays.c - array_handle_ref, array_handle_set: idem. - array_get_handle: sanity check. * libguile/generalized-vectors.c - scm_c_generalized_vector_ref, scm_c_generalized_vector_set_x: pos should be base when idx is lbnd. Furthermore, pos should be signed and have its overflow checked; do this by handling the job to scm_c_array_ref_1, scm_c_array_set_1_x. * libguile/generalized-vectors.h - fix prototypes.
-rw-r--r--libguile/array-map.c27
-rw-r--r--libguile/arrays.c8
-rw-r--r--libguile/generalized-vectors.c20
-rw-r--r--libguile/generalized-vectors.h4
4 files changed, 25 insertions, 34 deletions
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 4d7d3e38e..6d8d25fe0 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -194,9 +194,8 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
SCM lvra, *plvra;
long *vinds;
int k, kmax;
- int (*cproc) ();
+ int (*cproc) () = cproc_ptr;
- cproc = cproc_ptr;
switch (scm_ra_matchp (ra0, lra))
{
default:
@@ -344,8 +343,8 @@ rafill (SCM dst, SCM fill)
size_t i;
ssize_t inc;
scm_array_get_handle (SCM_I_ARRAY_V (dst), &h);
- i = h.base + h.dims[0].lbnd + SCM_I_ARRAY_BASE (dst)*h.dims[0].inc;
- inc = SCM_I_ARRAY_DIMS (dst)->inc * h.dims[0].inc;
+ i = SCM_I_ARRAY_BASE (dst);
+ inc = SCM_I_ARRAY_DIMS (dst)->inc;
for (; n-- > 0; i += inc)
h.impl->vset (&h, i, fill);
@@ -378,10 +377,10 @@ racp (SCM src, SCM dst)
scm_array_get_handle (SCM_I_ARRAY_V (src), &h_s);
scm_array_get_handle (SCM_I_ARRAY_V (dst), &h_d);
- i_s = h_s.base + h_s.dims[0].lbnd + SCM_I_ARRAY_BASE (src) * h_s.dims[0].inc;
- i_d = h_d.base + h_d.dims[0].lbnd + SCM_I_ARRAY_BASE (dst) * h_d.dims[0].inc;
- inc_s = SCM_I_ARRAY_DIMS (src)->inc * h_s.dims[0].inc;
- inc_d = SCM_I_ARRAY_DIMS (dst)->inc * h_d.dims[0].inc;
+ 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;
for (; n-- > 0; i_s += inc_s, i_d += inc_d)
h_d.impl->vset (&h_d, i_d, h_s.impl->vref (&h_s, i_s));
@@ -681,8 +680,8 @@ ramap (SCM ra0, SCM proc, SCM ras)
size_t i0, i0end;
ssize_t inc0;
scm_array_get_handle (SCM_I_ARRAY_V (ra0), &h0);
- i0 = h0.base + h0.dims[0].lbnd + SCM_I_ARRAY_BASE (ra0)*h0.dims[0].inc;
- inc0 = SCM_I_ARRAY_DIMS (ra0)->inc * h0.dims[0].inc;
+ i0 = SCM_I_ARRAY_BASE (ra0);
+ inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
i0end = i0 + n*inc0;
if (scm_is_null (ras))
for (; i0 < i0end; i0 += inc0)
@@ -694,8 +693,8 @@ ramap (SCM ra0, SCM proc, SCM ras)
size_t i1;
ssize_t inc1;
scm_array_get_handle (SCM_I_ARRAY_V (ra1), &h1);
- i1 = h1.base + h1.dims[0].lbnd + SCM_I_ARRAY_BASE (ra1)*h1.dims[0].inc;
- inc1 = SCM_I_ARRAY_DIMS (ra1)->inc * h1.dims[0].inc;
+ i1 = SCM_I_ARRAY_BASE (ra1);
+ inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ras = SCM_CDR (ras);
if (scm_is_null (ras))
for (; i0 < i0end; i0 += inc0, i1 += inc1)
@@ -754,8 +753,8 @@ rafe (SCM ra0, SCM proc, SCM ras)
size_t i0, i0end;
ssize_t inc0;
scm_array_get_handle (SCM_I_ARRAY_V (ra0), &h0);
- i0 = h0.base + h0.dims[0].lbnd + SCM_I_ARRAY_BASE (ra0)*h0.dims[0].inc;
- inc0 = SCM_I_ARRAY_DIMS (ra0)->inc * h0.dims[0].inc;
+ i0 = SCM_I_ARRAY_BASE (ra0);
+ inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
i0end = i0 + n*inc0;
if (scm_is_null (ras))
for (; i0 < i0end; i0 += inc0)
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 6188e42e5..dd8448ab5 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -824,7 +824,6 @@ array_handle_ref (scm_t_array_handle *hh, size_t pos)
scm_t_array_handle h;
SCM ret;
scm_array_get_handle (SCM_I_ARRAY_V (hh->array), &h);
- pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
ret = h.impl->vref (&h, pos);
scm_array_handle_release (&h);
return ret;
@@ -835,7 +834,6 @@ array_handle_set (scm_t_array_handle *hh, size_t pos, SCM val)
{
scm_t_array_handle h;
scm_array_get_handle (SCM_I_ARRAY_V (hh->array), &h);
- pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
h.impl->vset (&h, pos, val);
scm_array_handle_release (&h);
}
@@ -846,6 +844,12 @@ array_get_handle (SCM array, scm_t_array_handle *h)
{
scm_t_array_handle vh;
scm_array_get_handle (SCM_I_ARRAY_V (array), &vh);
+ if (vh.dims[0].inc != 1 || vh.dims[0].lbnd != 0 || vh.base != 0)
+ {
+ fprintf(stderr, "INC %ld, %ld", vh.dims[0].inc, vh.dims[0].lbnd);
+ fflush(stderr);
+ abort();
+ }
h->element_type = vh.element_type;
h->elements = vh.elements;
h->writable_elements = vh.writable_elements;
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index 5e3e5526a..6e88f3c6d 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -110,27 +110,15 @@ scm_c_generalized_vector_length (SCM v)
}
SCM
-scm_c_generalized_vector_ref (SCM v, size_t idx)
+scm_c_generalized_vector_ref (SCM v, ssize_t idx)
{
- scm_t_array_handle h;
- size_t pos;
- SCM ret;
- scm_generalized_vector_get_handle (v, &h);
- pos = h.base + h.dims[0].lbnd + idx * h.dims[0].inc;
- ret = h.impl->vref (&h, pos);
- scm_array_handle_release (&h);
- return ret;
+ return scm_c_array_ref_1(v, idx);
}
void
-scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
+scm_c_generalized_vector_set_x (SCM v, ssize_t idx, SCM val)
{
- scm_t_array_handle h;
- size_t pos;
- scm_generalized_vector_get_handle (v, &h);
- pos = h.base + h.dims[0].lbnd + idx * h.dims[0].inc;
- h.impl->vset (&h, pos, val);
- scm_array_handle_release (&h);
+ scm_c_array_set_1_x(v, val, idx);
}
void
diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h
index e2acb9879..876537ae0 100644
--- a/libguile/generalized-vectors.h
+++ b/libguile/generalized-vectors.h
@@ -32,8 +32,8 @@
SCM_API int scm_is_generalized_vector (SCM obj);
SCM_API size_t scm_c_generalized_vector_length (SCM v);
-SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
+SCM_API SCM scm_c_generalized_vector_ref (SCM v, ssize_t idx);
+SCM_API void scm_c_generalized_vector_set_x (SCM v, ssize_t idx, SCM val);
SCM_API void scm_generalized_vector_get_handle (SCM vec,
scm_t_array_handle *h);