mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 08:10:17 +02:00
Code Activity

Pack array dimensions in array object

Browse source 
* libguile/arrays.c (scm_i_make_array): redo object layout.

* libguile/arrays.h (SCM_I_ARRAY_V, SCM_ARRAY_BASE, SCM_I_ARRAY_DIMS):
  to match new layout.

  (SCM_I_ARRAY_SET_V, SCM_ARRAY_SET_BASE): new setters.

  (SCM_I_ARRAY_MEM, scm_i_t_array): unused, remove.

  (scm_i_shap2ra, scm_make_typed_array, scm_from_contiguous_typed_array,
  scm_from_contiguous_array, scm_make_shared_array, scm_transpose_array,
  scm_array_contents): fix uses of SCM_I_ARRAY_V, SCM_ARRAY_BASE as
  lvalues.

* libguile/array-map.c (make1array, scm_ramapc): fix uses of
  SCM_I_ARRAY_V, SCM_ARRAY_BASE as lvalues.
This commit is contained in:
Daniel Llorens 2014-09-19 14:48:22 +02:00
parent ea342aa6f7
commit 65704b982d
4 changed files with 51 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

20
libguile/array-map.c
View file

@ -1,6 +1,6 @@
/* Copyright (C) 1996, 1998, 2000, 2001, 2004, 2005, 2006, 2008, 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
* as published by the Free Software Foundation; either version 3 of
@ -63,11 +63,11 @@ static SCM
make1array (SCM v, ssize_t inc)
{
SCM a = scm_i_make_array (1);
SCM_I_ARRAY_BASE (a) = 0;
SCM_I_ARRAY_SET_BASE (a, 0);
SCM_I_ARRAY_DIMS (a)->lbnd = 0;
SCM_I_ARRAY_DIMS (a)->ubnd = scm_c_array_length (v) - 1;
SCM_I_ARRAY_DIMS (a)->inc = inc;
SCM_I_ARRAY_V (a) = v;
SCM_I_ARRAY_SET_V (a, v);
return a;
}
@ -195,9 +195,9 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
if (k == kroll)
{
SCM y = lra;
SCM_I_ARRAY_BASE (va0) = cindk (ra0, vi, kroll);
SCM_I_ARRAY_SET_BASE (va0, cindk (ra0, vi, kroll));
for (z = lva; !scm_is_null (z); z = SCM_CDR (z), y = SCM_CDR (y))
SCM_I_ARRAY_BASE (SCM_CAR (z)) = cindk (SCM_CAR (y), vi, kroll);
SCM_I_ARRAY_SET_BASE (SCM_CAR (z), cindk (SCM_CAR (y), vi, kroll));
if (! (SCM_UNBNDP (data) ? cproc (va0, lva) : cproc (va0, data, lva)))
return 0;
--k;
@ -815,7 +815,7 @@ array_compare (scm_t_array_handle *hx, scm_t_array_handle *hy,
return 0;
i = hx->dims[dim].ubnd - hx->dims[dim].lbnd + 1;
incx = hx->dims[dim].inc;
incy = hy->dims[dim].inc;
posx += (i - 1) * incx;
@ -832,11 +832,11 @@ SCM
scm_array_equal_p (SCM x, SCM y)
{
scm_t_array_handle hx, hy;
SCM res;
SCM res;
scm_array_get_handle (x, &hx);
scm_array_get_handle (y, &hy);
res = scm_from_bool (hx.ndims == hy.ndims
&& hx.element_type == hy.element_type);
@ -860,7 +860,7 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1,
{
if (SCM_UNBNDP (ra0) || SCM_UNBNDP (ra1))
return SCM_BOOL_T;
while (!scm_is_null (rest))
{ if (scm_is_false (scm_array_equal_p (ra0, ra1)))
return SCM_BOOL_F;

66
libguile/arrays.c
View file

@ -1,6 +1,6 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,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
* as published by the Free Software Foundation; either version 3 of
@ -29,6 +29,8 @@
#include <string.h>
#include <assert.h>
#include "verify.h"
#include "libguile/_scm.h"
#include "libguile/__scm.h"
#include "libguile/eq.h"
@ -92,7 +94,7 @@ SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0,
SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0,
(SCM ra),
"For each dimension, return the distance between elements in the root vector.")
#define FUNC_NAME s_scm_shared_array_increments
@ -112,15 +114,19 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0,
}
#undef FUNC_NAME
/* FIXME: to avoid this assumption, fix the accessors in arrays.h,
scm_i_make_array, and the array cases in system/vm/assembler.scm. */
verify (sizeof (scm_t_array_dim) == 3*sizeof (scm_t_bits));
/* Matching SCM_I_ARRAY accessors in arrays.h */
SCM
scm_i_make_array (int ndim)
{
SCM ra;
ra = scm_cell (((scm_t_bits) ndim << 17) + scm_tc7_array,
(scm_t_bits) scm_gc_malloc (sizeof (scm_i_t_array) +
ndim * sizeof (scm_t_array_dim),
"array"));
SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
SCM ra = scm_words (((scm_t_bits) ndim << 17) + scm_tc7_array, 3 + ndim*3);
SCM_I_ARRAY_SET_V (ra, SCM_BOOL_F);
SCM_I_ARRAY_SET_BASE (ra, 0);
/* dimensions are unset */
return ra;
}
@ -139,7 +145,7 @@ scm_i_shap2ra (SCM args)
scm_misc_error (NULL, s_bad_spec, SCM_EOL);
ra = scm_i_make_array (ndim);
SCM_I_ARRAY_BASE (ra) = 0;
SCM_I_ARRAY_SET_BASE (ra, 0);
s = SCM_I_ARRAY_DIMS (ra);
for (; !scm_is_null (args); s++, args = SCM_CDR (args))
{
@ -179,7 +185,7 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
size_t k, rlen = 1;
scm_t_array_dim *s;
SCM ra;
ra = scm_i_shap2ra (bounds);
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
s = SCM_I_ARRAY_DIMS (ra);
@ -195,8 +201,7 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
if (scm_is_eq (fill, SCM_UNSPECIFIED))
fill = SCM_UNDEFINED;
SCM_I_ARRAY_V (ra) =
scm_make_generalized_vector (type, scm_from_size_t (rlen), fill);
SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (type, scm_from_size_t (rlen), fill));
if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
if (0 == s->lbnd)
@ -217,7 +222,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
scm_t_array_handle h;
void *elts;
size_t sz;
ra = scm_i_shap2ra (bounds);
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
s = SCM_I_ARRAY_DIMS (ra);
@ -229,8 +234,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
}
SCM_I_ARRAY_V (ra) =
scm_make_generalized_vector (type, scm_from_size_t (rlen), SCM_UNDEFINED);
SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (type, scm_from_size_t (rlen), SCM_UNDEFINED));
scm_array_get_handle (ra, &h);
@ -273,7 +277,7 @@ scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
scm_t_array_dim *s;
SCM ra;
scm_t_array_handle h;
ra = scm_i_shap2ra (bounds);
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
s = SCM_I_ARRAY_DIMS (ra);
@ -288,7 +292,7 @@ scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
if (rlen != len)
SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL);
SCM_I_ARRAY_V (ra) = scm_c_make_vector (rlen, SCM_UNDEFINED);
SCM_I_ARRAY_SET_V (ra, scm_c_make_vector (rlen, SCM_UNDEFINED));
scm_array_get_handle (ra, &h);
memcpy (h.writable_elements, elts, rlen * sizeof(SCM));
scm_array_handle_release (&h);
@ -323,7 +327,7 @@ scm_i_ra_set_contp (SCM ra)
SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
return;
}
inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd
inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd
- SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
}
}
@ -368,7 +372,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
if (SCM_I_ARRAYP (oldra))
{
SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
SCM_I_ARRAY_SET_V (ra, SCM_I_ARRAY_V (oldra));
old_base = old_min = old_max = SCM_I_ARRAY_BASE (oldra);
s = scm_array_handle_dims (&old_handle);
k = scm_array_handle_rank (&old_handle);
@ -382,7 +386,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
}
else
{
SCM_I_ARRAY_V (ra) = oldra;
SCM_I_ARRAY_SET_V (ra, oldra);
old_base = old_min = 0;
old_max = scm_c_array_length (oldra) - 1;
}
@ -398,9 +402,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
ra = scm_make_generalized_vector (scm_array_type (ra),
SCM_INUM0, SCM_UNDEFINED);
else
SCM_I_ARRAY_V (ra) =
scm_make_generalized_vector (scm_array_type (ra),
SCM_INUM0, SCM_UNDEFINED);
SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (scm_array_type (ra),
SCM_INUM0, SCM_UNDEFINED));
scm_array_handle_release (&old_handle);
return ra;
}
@ -408,7 +411,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
imap = scm_apply_0 (mapfunc, scm_reverse (inds));
i = scm_array_handle_pos (&old_handle, imap);
SCM_I_ARRAY_BASE (ra) = new_min = new_max = i + old_base;
new_min = new_max = i + old_base;
SCM_I_ARRAY_SET_BASE (ra, new_min);
indptr = inds;
k = SCM_I_ARRAY_NDIM (ra);
while (k--)
@ -450,7 +454,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
/* args are RA . DIMS */
SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
(SCM ra, SCM args),
"Return an array sharing contents with @var{ra}, but with\n"
"dimensions arranged in a different order. There must be one\n"
@ -509,8 +513,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
}
ndim++;
res = scm_i_make_array (ndim);
SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
SCM_I_ARRAY_SET_V (res, SCM_I_ARRAY_V (ra));
SCM_I_ARRAY_SET_BASE (res, SCM_I_ARRAY_BASE (ra));
for (k = ndim; k--;)
{
SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
@ -534,7 +538,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
r->ubnd = s->ubnd;
if (r->lbnd < s->lbnd)
{
SCM_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
SCM_I_ARRAY_SET_BASE (res, SCM_I_ARRAY_BASE (res) + (s->lbnd - r->lbnd) * r->inc);
r->lbnd = s->lbnd;
}
r->inc += s->inc;
@ -596,8 +600,8 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
SCM sra = scm_i_make_array (1);
SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
SCM_I_ARRAY_V (sra) = v;
SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
SCM_I_ARRAY_SET_V (sra, v);
SCM_I_ARRAY_SET_BASE (sra, SCM_I_ARRAY_BASE (ra));
SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1);
return sra;
}
@ -760,7 +764,7 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
scm_intprint (h.ndims, 10, port);
if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
scm_write (scm_array_handle_element_type (&h), port);
for (i = 0; i < h.ndims; i++)
{
if (h.dims[i].lbnd != 0)

17
libguile/arrays.h
View file

@ -54,23 +54,18 @@ SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
/* internal. */
typedef struct scm_i_t_array
{
SCM v; /* the contents of the array, e.g., a vector or uniform vector. */
unsigned long base;
} scm_i_t_array;
#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)
#define SCM_I_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc7_array, a)
#define SCM_I_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x)>>17))
#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) & (SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))
#define SCM_I_ARRAY_MEM(a) ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
#define SCM_I_ARRAY_V(a) (SCM_I_ARRAY_MEM (a)->v)
#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
#define SCM_I_ARRAY_DIMS(a) \
((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
#define SCM_I_ARRAY_V(a) SCM_CELL_OBJECT_1 (a)
#define SCM_I_ARRAY_BASE(a) ((size_t) SCM_CELL_WORD_2 (a))
#define SCM_I_ARRAY_DIMS(a) ((scm_t_array_dim *) SCM_CELL_OBJECT_LOC (a, 3))
#define SCM_I_ARRAY_SET_V(a, v) SCM_SET_CELL_OBJECT_1(a, v)
#define SCM_I_ARRAY_SET_BASE(a, base) SCM_SET_CELL_WORD_2(a, base)
SCM_INTERNAL SCM scm_i_make_array (int ndim);
SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state *pstate);

1
libguile/deprecated.h
View file

@ -129,7 +129,6 @@ SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard before,
#define scm_substring_move_right_x scm_substring_move_right_x__GONE__REPLACE_WITH__scm_substring_move_x
#define scm_vtable_index_printer scm_vtable_index_printer__GONE__REPLACE_WITH__scm_vtable_index_instance_printer
#define scm_vtable_index_vtable scm_vtable_index_vtable__GONE__REPLACE_WITH__scm_vtable_index_self
typedef scm_i_t_array scm_i_t_array__GONE__REPLACE_WITH__scm_t_array;
#ifndef BUILDING_LIBGUILE
#define SCM_ASYNC_TICK SCM_ASYNC_TICK__GONE__REPLACE_WITH__scm_async_tick