From 8d2d5641fdacaae31996e9afcfc0eb4a35555b70 Mon Sep 17 00:00:00 2001 From: Daniel Llorens Date: Wed, 17 Sep 2014 07:15:42 +0200 Subject: [PATCH 2/3] Pack array dimensions in array object * 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. --- libguile/array-map.c | 20 +++++++-------- libguile/arrays.c | 67 ++++++++++++++++++++++++++----------------------- libguile/arrays.h | 17 +++++-------- libguile/deprecated.h | 1 - 4 files changed, 52 insertions(+), 53 deletions(-) diff --git a/libguile/array-map.c b/libguile/array-map.c index 2d68f5f..938f0a7 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -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; diff --git a/libguile/arrays.c b/libguile/arrays.c index 702faac..1fd6066 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -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 #include +#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,20 @@ 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; + verify (sizeof(size_t)==sizeof(scm_t_bits)); + 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 +146,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 +186,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 +202,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 +223,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 +235,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 +278,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 +293,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 +328,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 +373,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 +387,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 +403,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 +412,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 +455,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 +514,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 +539,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 +601,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 +765,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) diff --git a/libguile/arrays.h b/libguile/arrays.h index 6045ab6..5f40597 100644 --- a/libguile/arrays.h +++ b/libguile/arrays.h @@ -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); diff --git a/libguile/deprecated.h b/libguile/deprecated.h index ae1fb04..d642b79 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -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 -- 1.7.9.5