From 9663f407aa5b0c3fef2b52a413cb95df2b303b8e Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Thu, 11 Apr 2013 13:03:45 +0200
Subject: [PATCH 14/22] 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.
---
 libguile/array-map.c           | 27 +++++++++++++--------------
 libguile/arrays.c              |  8 ++++++--
 libguile/generalized-vectors.c | 20 ++++----------------
 libguile/generalized-vectors.h |  4 ++--
 4 files changed, 25 insertions(+), 34 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 8484d8c..426103c 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 695ab78..191d02d 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -823,7 +823,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;
@@ -834,7 +833,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);
 }
@@ -845,6 +843,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 5e3e552..6e88f3c 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 e2acb98..876537a 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);
 
-- 
1.8.2

