HCoop
/
bpt
/
guile.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge commit 'ca5e0414e96886177d883a249edd957d2331db65'
[bpt/guile.git]
/
libguile
/
arrays.c
diff --git
a/libguile/arrays.c
b/libguile/arrays.c
index
83d7db2
..
a771739
100644
(file)
--- a/
libguile/arrays.c
+++ b/
libguile/arrays.c
@@
-1,5
+1,5
@@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005,
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005,
- * 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ * 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
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@
-27,6
+27,7
@@
#include <stdio.h>
#include <errno.h>
#include <string.h>
#include <stdio.h>
#include <errno.h>
#include <string.h>
+#include <assert.h>
#include "libguile/_scm.h"
#include "libguile/__scm.h"
#include "libguile/_scm.h"
#include "libguile/__scm.h"
@@
-60,21
+61,22
@@
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
-SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
+SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
(SCM ra),
"Return the root vector of a shared array.")
#define FUNC_NAME s_scm_shared_array_root
{
(SCM ra),
"Return the root vector of a shared array.")
#define FUNC_NAME s_scm_shared_array_root
{
- if (SCM_I_ARRAYP (ra))
+ if (!scm_is_array (ra))
+ scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
+ else if (SCM_I_ARRAYP (ra))
return SCM_I_ARRAY_V (ra);
return SCM_I_ARRAY_V (ra);
- else
if (scm_is_generalized_vector (ra))
+ else
return ra;
return ra;
- scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
}
#undef FUNC_NAME
}
#undef FUNC_NAME
-SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0,
+SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0,
(SCM ra),
"Return the root vector index of the first element in the array.")
#define FUNC_NAME s_scm_shared_array_offset
(SCM ra),
"Return the root vector index of the first element in the array.")
#define FUNC_NAME s_scm_shared_array_offset
@@
-195,8
+197,9
@@
SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
scm_make_generalized_vector (type, scm_from_size_t (rlen), fill);
if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (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 (
s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)
)
+ if (
0 == s->lbnd
)
return SCM_I_ARRAY_V (ra);
return SCM_I_ARRAY_V (ra);
+
return ra;
}
#undef FUNC_NAME
return ra;
}
#undef FUNC_NAME
@@
-242,8
+245,9
@@
scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
}
else if (sz < 8)
{
}
else if (sz < 8)
{
- /* byte_len ?= ceil (rlen * sz / 8) */
- if (byte_len != (rlen * sz + 7) / 8)
+ /* Elements of sub-byte size (bitvectors) are addressed in 32-bit
+ units. */
+ if (byte_len != ((rlen * sz + 31) / 32) * 4)
SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
}
else
SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
}
else
@@
-253,7
+257,7
@@
scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
memcpy (elts, bytes, byte_len);
if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
memcpy (elts, bytes, byte_len);
if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
- if (
s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)
)
+ if (
0 == s->lbnd
)
return SCM_I_ARRAY_V (ra);
return ra;
}
return SCM_I_ARRAY_V (ra);
return ra;
}
@@
-288,7
+292,7
@@
scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
scm_array_handle_release (&h);
if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
scm_array_handle_release (&h);
if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
- if (
s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)
)
+ if (
0 == s->lbnd
)
return SCM_I_ARRAY_V (ra);
return ra;
}
return SCM_I_ARRAY_V (ra);
return ra;
}
@@
-378,7
+382,7
@@
SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
{
SCM_I_ARRAY_V (ra) = oldra;
old_base = old_min = 0;
{
SCM_I_ARRAY_V (ra) = oldra;
old_base = old_min = 0;
- old_max = scm_c_
generalized_vector
_length (oldra) - 1;
+ old_max = scm_c_
array
_length (oldra) - 1;
}
inds = SCM_EOL;
}
inds = SCM_EOL;
@@
-430,7
+434,7
@@
SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
{
SCM v = SCM_I_ARRAY_V (ra);
if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
{
SCM v = SCM_I_ARRAY_V (ra);
- size_t length = scm_c_
generalized_vector
_length (v);
+ size_t length = scm_c_
array
_length (v);
if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
return v;
if (s->ubnd < s->lbnd)
if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
return v;
if (s->ubnd < s->lbnd)
@@
-474,20
+478,22
@@
SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (args);
SCM_ASSERT (SCM_HEAP_OBJECT_P (ra), ra, SCM_ARG1, FUNC_NAME);
SCM_VALIDATE_REST_ARGUMENT (args);
SCM_ASSERT (SCM_HEAP_OBJECT_P (ra), ra, SCM_ARG1, FUNC_NAME);
-
if (scm_is_generalized_vector
(ra))
+
switch (scm_c_array_rank
(ra))
{
{
+ case 0:
+ if (!scm_is_null (args))
+ SCM_WRONG_NUM_ARGS ();
+ return ra;
+ case 1:
/* Make sure that we are called with a single zero as
/* Make sure that we are called with a single zero as
- arguments.
+ arguments.
*/
if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
SCM_WRONG_NUM_ARGS ();
SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
return ra;
*/
if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
SCM_WRONG_NUM_ARGS ();
SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
return ra;
- }
-
- if (SCM_I_ARRAYP (ra))
- {
+ default:
vargs = scm_vector (args);
if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
SCM_WRONG_NUM_ARGS ();
vargs = scm_vector (args);
if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
SCM_WRONG_NUM_ARGS ();
@@
-537,8
+543,6
@@
SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
scm_i_ra_set_contp (res);
return res;
}
scm_i_ra_set_contp (res);
return res;
}
-
- scm_wrong_type_arg_msg (NULL, 0, ra, "array");
}
#undef FUNC_NAME
}
#undef FUNC_NAME
@@
-583,14
+587,14
@@
SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
return SCM_BOOL_F;
}
}
return SCM_BOOL_F;
}
}
-
+
{
SCM v = SCM_I_ARRAY_V (ra);
{
SCM v = SCM_I_ARRAY_V (ra);
- size_t length = scm_c_
generalized_vector
_length (v);
+ size_t length = scm_c_
array
_length (v);
if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS (ra)->inc)
return v;
}
if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS (ra)->inc)
return v;
}
-
+
sra = scm_i_make_array (1);
SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
sra = scm_i_make_array (1);
SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
@@
-816,15
+820,15
@@
scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
}
static SCM
}
static SCM
-array_handle_ref (scm_t_array_handle *h, size_t pos)
+array_handle_ref (scm_t_array_handle *h
h
, size_t pos)
{
{
- return scm_c_
generalized_vector_ref (SCM_I_ARRAY_V (
h->array), pos);
+ return scm_c_
array_ref_1 (SCM_I_ARRAY_V (h
h->array), pos);
}
static void
}
static void
-array_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+array_handle_set (scm_t_array_handle *h
h
, size_t pos, SCM val)
{
{
- scm_c_
generalized_vector_set_x (SCM_I_ARRAY_V (h->array), pos, val
);
+ scm_c_
array_set_1_x (SCM_I_ARRAY_V (hh->array), val, pos
);
}
/* FIXME: should be handle for vect? maybe not, because of dims */
}
/* FIXME: should be handle for vect? maybe not, because of dims */
@@
-833,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);
{
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;
h->element_type = vh.element_type;
h->elements = vh.elements;
h->writable_elements = vh.writable_elements;