mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

parts of unif.[ch] to array-handle.[ch]

Browse source 
* libguile/array-handle.c:
* libguile/array-handle.h: Move some parts of unif.c and unif.h to these
  new files.

* libguile/unif.c:
* libguile/unif.h: Update includers. Since unif.h depends on the array
  handle type, we include array-handle.h, which also means that there
  will be no difference for our callers.

* libguile/init.c: Call scm_init_array_handle, though it does nothing as
  of yet.

* libguile/Makefile.am: Adapt for new files.
This commit is contained in:
Andy Wingo 2009-07-17 00:47:31 +02:00
parent 5d1b3b2db9
commit c53c0893a3
6 changed files with 364 additions and 271 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/Makefile.am
View file

@ -108,6 +108,7 @@ libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
libguile_la_SOURCES = \
alist.c \
arbiters.c \
array-handle.c \
array-map.c \
async.c \
backtrace.c \
@ -216,6 +217,7 @@ libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LDFLAGS = \
DOT_X_FILES = \
alist.x \
arbiters.x \
array-handle.x \
array-map.x \
async.x \
backtrace.x \
@ -312,6 +314,7 @@ EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
DOT_DOC_FILES = \
alist.doc \
arbiters.doc \
array-handle.doc \
array-map.doc \
async.doc \
backtrace.doc \
@ -452,6 +455,7 @@ modinclude_HEADERS = \
__scm.h \
alist.h \
arbiters.h \
array-handle.h \
array-map.h \
async.h \
backtrace.h \

286
libguile/array-handle.c Normal file
View file

@ -0,0 +1,286 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 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
* the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
* 02110-1301 USA
*/
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include "libguile/_scm.h"
#include "libguile/__scm.h"
#include "libguile/array-handle.h"
#include "libguile/unif.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
#include "libguile/srfi-4.h"
#include "libguile/bytevectors.h"
static SCM
enclosed_ref (scm_t_array_handle *h, ssize_t pos)
{
return scm_i_cvref (SCM_I_ARRAY_V (h->array), pos + h->base, 1);
}
static SCM
vector_ref (scm_t_array_handle *h, ssize_t pos)
{
return ((const SCM *)h->elements)[pos];
}
static SCM
string_ref (scm_t_array_handle *h, ssize_t pos)
{
pos += h->base;
if (SCM_I_ARRAYP (h->array))
return scm_c_string_ref (SCM_I_ARRAY_V (h->array), pos);
else
return scm_c_string_ref (h->array, pos);
}
static SCM
bitvector_ref (scm_t_array_handle *h, ssize_t pos)
{
pos += scm_array_handle_bit_elements_offset (h);
return
scm_from_bool (((scm_t_uint32 *)h->elements)[pos/32] & (1l << (pos % 32)));
}
static SCM
bytevector_ref (scm_t_array_handle *h, ssize_t pos)
{
return scm_from_uint8 (((scm_t_uint8 *) h->elements)[pos]);
}
static SCM
memoize_ref (scm_t_array_handle *h, ssize_t pos)
{
SCM v = h->array;
if (SCM_I_ENCLOSED_ARRAYP (v))
{
h->ref = enclosed_ref;
return enclosed_ref (h, pos);
}
if (SCM_I_ARRAYP (v))
v = SCM_I_ARRAY_V (v);
if (scm_is_vector (v))
{
h->elements = scm_array_handle_elements (h);
h->ref = vector_ref;
}
else if (scm_is_uniform_vector (v))
{
h->elements = scm_array_handle_uniform_elements (h);
h->ref = scm_i_uniform_vector_ref_proc (v);
}
else if (scm_is_string (v))
{
h->ref = string_ref;
}
else if (scm_is_bitvector (v))
{
h->elements = scm_array_handle_bit_elements (h);
h->ref = bitvector_ref;
}
else if (scm_is_bytevector (v))
{
h->elements = scm_array_handle_uniform_elements (h);
h->ref = bytevector_ref;
}
else
scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
return h->ref (h, pos);
}
static void
enclosed_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-enclosed array");
}
static void
vector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
((SCM *)h->writable_elements)[pos] = val;
}
static void
string_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
pos += h->base;
if (SCM_I_ARRAYP (h->array))
scm_c_string_set_x (SCM_I_ARRAY_V (h->array), pos, val);
else
scm_c_string_set_x (h->array, pos, val);
}
static void
bitvector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
scm_t_uint32 mask;
pos += scm_array_handle_bit_elements_offset (h);
mask = 1l << (pos % 32);
if (scm_to_bool (val))
((scm_t_uint32 *)h->writable_elements)[pos/32] |= mask;
else
((scm_t_uint32 *)h->writable_elements)[pos/32] &= ~mask;
}
static void
bytevector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
scm_t_uint8 c_value;
scm_t_uint8 *elements;
c_value = scm_to_uint8 (val);
elements = (scm_t_uint8 *) h->elements;
elements[pos] = (scm_t_uint8) c_value;
}
static void
memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
SCM v = h->array;
if (SCM_I_ENCLOSED_ARRAYP (v))
{
h->set = enclosed_set;
enclosed_set (h, pos, val);
return;
}
if (SCM_I_ARRAYP (v))
v = SCM_I_ARRAY_V (v);
if (scm_is_vector (v))
{
h->writable_elements = scm_array_handle_writable_elements (h);
h->set = vector_set;
}
else if (scm_is_uniform_vector (v))
{
h->writable_elements = scm_array_handle_uniform_writable_elements (h);
h->set = scm_i_uniform_vector_set_proc (v);
}
else if (scm_is_string (v))
{
h->set = string_set;
}
else if (scm_is_bitvector (v))
{
h->writable_elements = scm_array_handle_bit_writable_elements (h);
h->set = bitvector_set;
}
else if (scm_is_bytevector (v))
{
h->elements = scm_array_handle_uniform_writable_elements (h);
h->set = bytevector_set;
}
else
scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
h->set (h, pos, val);
}
void
scm_array_get_handle (SCM array, scm_t_array_handle *h)
{
h->array = array;
h->ref = memoize_ref;
h->set = memoize_set;
if (SCM_I_ARRAYP (array) || SCM_I_ENCLOSED_ARRAYP (array))
{
h->dims = SCM_I_ARRAY_DIMS (array);
h->base = SCM_I_ARRAY_BASE (array);
}
else if (scm_is_generalized_vector (array))
{
h->dim0.lbnd = 0;
h->dim0.ubnd = scm_c_generalized_vector_length (array) - 1;
h->dim0.inc = 1;
h->dims = &h->dim0;
h->base = 0;
}
else
scm_wrong_type_arg_msg (NULL, 0, array, "array");
}
void
scm_array_handle_release (scm_t_array_handle *h)
{
/* Nothing to do here until arrays need to be reserved for real.
*/
}
size_t
scm_array_handle_rank (scm_t_array_handle *h)
{
if (SCM_I_ARRAYP (h->array) || SCM_I_ENCLOSED_ARRAYP (h->array))
return SCM_I_ARRAY_NDIM (h->array);
else
return 1;
}
scm_t_array_dim *
scm_array_handle_dims (scm_t_array_handle *h)
{
return h->dims;
}
const SCM *
scm_array_handle_elements (scm_t_array_handle *h)
{
SCM vec = h->array;
if (SCM_I_ARRAYP (vec))
vec = SCM_I_ARRAY_V (vec);
if (SCM_I_IS_VECTOR (vec))
return SCM_I_VECTOR_ELTS (vec) + h->base;
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
}
SCM *
scm_array_handle_writable_elements (scm_t_array_handle *h)
{
SCM vec = h->array;
if (SCM_I_ARRAYP (vec))
vec = SCM_I_ARRAY_V (vec);
if (SCM_I_IS_VECTOR (vec))
return SCM_I_VECTOR_WELTS (vec) + h->base;
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
}
void
scm_init_array_handle (void)
{
#include "libguile/array-handle.x"
}
/*
Local Variables:
c-file-style: "gnu"
End:
*/

72
libguile/array-handle.h Normal file
View file

@ -0,0 +1,72 @@
/* classes: h_files */
#ifndef SCM_ARRAY_HANDLE_H
#define SCM_ARRAY_HANDLE_H
/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 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
* the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
* 02110-1301 USA
*/
#include "libguile/__scm.h"
typedef struct scm_t_array_dim
{
ssize_t lbnd;
ssize_t ubnd;
ssize_t inc;
} scm_t_array_dim;
struct scm_t_array_handle;
typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, ssize_t);
typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, ssize_t, SCM);
typedef struct scm_t_array_handle {
SCM array;
size_t base;
scm_t_array_dim *dims;
scm_t_array_dim dim0;
scm_i_t_array_ref ref;
scm_i_t_array_set set;
const void *elements;
void *writable_elements;
} scm_t_array_handle;
SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
SCM_API size_t scm_array_handle_rank (scm_t_array_handle *h);
SCM_API scm_t_array_dim *scm_array_handle_dims (scm_t_array_handle *h);
SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
SCM_API const SCM *scm_array_handle_elements (scm_t_array_handle *h);
SCM_API SCM *scm_array_handle_writable_elements (scm_t_array_handle *h);
SCM_API void scm_array_handle_release (scm_t_array_handle *h);
/* See inline.h for scm_array_handle_ref and scm_array_handle_set */
SCM_INTERNAL void scm_init_array_handle (void);
#endif /* SCM_ARRAY_HANDLE_H */
/*
Local Variables:
c-file-style: "gnu"
End:
*/

1
libguile/init.c
View file

@ -540,6 +540,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_evalext ();
scm_init_debug (); /* Requires macro smobs */
scm_init_random ();
scm_init_array_handle ();
scm_init_array_map ();
scm_init_unif ();
scm_init_simpos ();

238
libguile/unif.c
View file

@ -176,244 +176,6 @@ scm_is_typed_array (SCM obj, SCM type)
return scm_is_eq (type, scm_i_generalized_vector_type (obj));
}
static SCM
enclosed_ref (scm_t_array_handle *h, ssize_t pos)
{
return scm_i_cvref (SCM_I_ARRAY_V (h->array), pos + h->base, 1);
}
static SCM
vector_ref (scm_t_array_handle *h, ssize_t pos)
{
return ((const SCM *)h->elements)[pos];
}
static SCM
string_ref (scm_t_array_handle *h, ssize_t pos)
{
pos += h->base;
if (SCM_I_ARRAYP (h->array))
return scm_c_string_ref (SCM_I_ARRAY_V (h->array), pos);
else
return scm_c_string_ref (h->array, pos);
}
static SCM
bitvector_ref (scm_t_array_handle *h, ssize_t pos)
{
pos += scm_array_handle_bit_elements_offset (h);
return
scm_from_bool (((scm_t_uint32 *)h->elements)[pos/32] & (1l << (pos % 32)));
}
static SCM
bytevector_ref (scm_t_array_handle *h, ssize_t pos)
{
return scm_from_uint8 (((scm_t_uint8 *) h->elements)[pos]);
}
static SCM
memoize_ref (scm_t_array_handle *h, ssize_t pos)
{
SCM v = h->array;
if (SCM_I_ENCLOSED_ARRAYP (v))
{
h->ref = enclosed_ref;
return enclosed_ref (h, pos);
}
if (SCM_I_ARRAYP (v))
v = SCM_I_ARRAY_V (v);
if (scm_is_vector (v))
{
h->elements = scm_array_handle_elements (h);
h->ref = vector_ref;
}
else if (scm_is_uniform_vector (v))
{
h->elements = scm_array_handle_uniform_elements (h);
h->ref = scm_i_uniform_vector_ref_proc (v);
}
else if (scm_is_string (v))
{
h->ref = string_ref;
}
else if (scm_is_bitvector (v))
{
h->elements = scm_array_handle_bit_elements (h);
h->ref = bitvector_ref;
}
else if (scm_is_bytevector (v))
{
h->elements = scm_array_handle_uniform_elements (h);
h->ref = bytevector_ref;
}
else
scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
return h->ref (h, pos);
}
static void
enclosed_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-enclosed array");
}
static void
vector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
((SCM *)h->writable_elements)[pos] = val;
}
static void
string_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
pos += h->base;
if (SCM_I_ARRAYP (h->array))
scm_c_string_set_x (SCM_I_ARRAY_V (h->array), pos, val);
else
scm_c_string_set_x (h->array, pos, val);
}
static void
bitvector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
scm_t_uint32 mask;
pos += scm_array_handle_bit_elements_offset (h);
mask = 1l << (pos % 32);
if (scm_to_bool (val))
((scm_t_uint32 *)h->writable_elements)[pos/32] |= mask;
else
((scm_t_uint32 *)h->writable_elements)[pos/32] &= ~mask;
}
static void
bytevector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
scm_t_uint8 c_value;
scm_t_uint8 *elements;
c_value = scm_to_uint8 (val);
elements = (scm_t_uint8 *) h->elements;
elements[pos] = (scm_t_uint8) c_value;
}
static void
memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
SCM v = h->array;
if (SCM_I_ENCLOSED_ARRAYP (v))
{
h->set = enclosed_set;
enclosed_set (h, pos, val);
return;
}
if (SCM_I_ARRAYP (v))
v = SCM_I_ARRAY_V (v);
if (scm_is_vector (v))
{
h->writable_elements = scm_array_handle_writable_elements (h);
h->set = vector_set;
}
else if (scm_is_uniform_vector (v))
{
h->writable_elements = scm_array_handle_uniform_writable_elements (h);
h->set = scm_i_uniform_vector_set_proc (v);
}
else if (scm_is_string (v))
{
h->set = string_set;
}
else if (scm_is_bitvector (v))
{
h->writable_elements = scm_array_handle_bit_writable_elements (h);
h->set = bitvector_set;
}
else if (scm_is_bytevector (v))
{
h->elements = scm_array_handle_uniform_writable_elements (h);
h->set = bytevector_set;
}
else
scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
h->set (h, pos, val);
}
void
scm_array_get_handle (SCM array, scm_t_array_handle *h)
{
h->array = array;
h->ref = memoize_ref;
h->set = memoize_set;
if (SCM_I_ARRAYP (array) || SCM_I_ENCLOSED_ARRAYP (array))
{
h->dims = SCM_I_ARRAY_DIMS (array);
h->base = SCM_I_ARRAY_BASE (array);
}
else if (scm_is_generalized_vector (array))
{
h->dim0.lbnd = 0;
h->dim0.ubnd = scm_c_generalized_vector_length (array) - 1;
h->dim0.inc = 1;
h->dims = &h->dim0;
h->base = 0;
}
else
scm_wrong_type_arg_msg (NULL, 0, array, "array");
}
void
scm_array_handle_release (scm_t_array_handle *h)
{
/* Nothing to do here until arrays need to be reserved for real.
*/
}
size_t
scm_array_handle_rank (scm_t_array_handle *h)
{
if (SCM_I_ARRAYP (h->array) || SCM_I_ENCLOSED_ARRAYP (h->array))
return SCM_I_ARRAY_NDIM (h->array);
else
return 1;
}
scm_t_array_dim *
scm_array_handle_dims (scm_t_array_handle *h)
{
return h->dims;
}
const SCM *
scm_array_handle_elements (scm_t_array_handle *h)
{
SCM vec = h->array;
if (SCM_I_ARRAYP (vec))
vec = SCM_I_ARRAY_V (vec);
if (SCM_I_IS_VECTOR (vec))
return SCM_I_VECTOR_ELTS (vec) + h->base;
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
}
SCM *
scm_array_handle_writable_elements (scm_t_array_handle *h)
{
SCM vec = h->array;
if (SCM_I_ARRAYP (vec))
vec = SCM_I_ARRAY_V (vec);
if (SCM_I_IS_VECTOR (vec))
return SCM_I_VECTOR_WELTS (vec) + h->base;
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
}
/* We keep the old 2-argument C prototype for a while although the old
PROT argument is always ignored now. C code should probably use
scm_is_array or scm_is_typed_array anyway.

34
libguile/unif.h
View file

@ -25,6 +25,7 @@
#include "libguile/__scm.h"
#include "libguile/print.h"
#include "libguile/array-handle.h"
@ -35,13 +36,6 @@
/** Arrays */
typedef struct scm_t_array_dim
{
ssize_t lbnd;
ssize_t ubnd;
ssize_t inc;
} scm_t_array_dim;
SCM_API SCM scm_array_p (SCM v);
SCM_API SCM scm_typed_array_p (SCM v, SCM type);
SCM_API SCM scm_make_array (SCM fill, SCM bounds);
@ -76,32 +70,6 @@ SCM_API int scm_is_typed_array (SCM obj, SCM type);
SCM_API SCM scm_ra2contig (SCM ra, int copy);
struct scm_t_array_handle;
typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, ssize_t);
typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, ssize_t, SCM);
typedef struct scm_t_array_handle {
SCM array;
size_t base;
scm_t_array_dim *dims;
scm_t_array_dim dim0;
scm_i_t_array_ref ref;
scm_i_t_array_set set;
const void *elements;
void *writable_elements;
} scm_t_array_handle;
SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
SCM_API size_t scm_array_handle_rank (scm_t_array_handle *h);
SCM_API scm_t_array_dim *scm_array_handle_dims (scm_t_array_handle *h);
SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
SCM_API const SCM *scm_array_handle_elements (scm_t_array_handle *h);
SCM_API SCM *scm_array_handle_writable_elements (scm_t_array_handle *h);
SCM_API void scm_array_handle_release (scm_t_array_handle *h);
/* See inline.h for scm_array_handle_ref and scm_array_handle_set */
/** Bit vectors */