mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
parent
69843ac1b9
commit
13af75bfe0
4 changed files with 23 additions and 39 deletions
|
@ -183,9 +183,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:
|
||||
|
@ -333,8 +332,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);
|
||||
|
@ -367,10 +366,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));
|
||||
|
@ -670,8 +669,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)
|
||||
|
@ -683,8 +682,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)
|
||||
|
@ -743,8 +742,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)
|
||||
|
|
|
@ -27,6 +27,7 @@
|
|||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
|
||||
#include "libguile/_scm.h"
|
||||
#include "libguile/__scm.h"
|
||||
|
@ -836,6 +837,7 @@ 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);
|
||||
assert (vh.dims[0].inc == 1 && vh.dims[0].lbnd == 0 && vh.base == 0);
|
||||
h->element_type = vh.element_type;
|
||||
h->elements = vh.elements;
|
||||
h->writable_elements = vh.writable_elements;
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004,
|
||||
* 2005, 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
|
||||
* 2005, 2006, 2009, 2010, 2011, 2012, 2013, 2014 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
|
||||
|
@ -101,36 +101,19 @@ scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
|
|||
size_t
|
||||
scm_c_generalized_vector_length (SCM v)
|
||||
{
|
||||
scm_t_array_handle h;
|
||||
size_t ret;
|
||||
scm_generalized_vector_get_handle (v, &h);
|
||||
ret = h.dims[0].ubnd - h.dims[0].lbnd + 1;
|
||||
scm_array_handle_release (&h);
|
||||
return ret;
|
||||
return scm_c_array_length (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
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue