mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-02 07:40:30 +02:00
Move vectors off scm_words
Also move most internal vector representation into a private header file. * libguile/vectors-internal.h: New file. * libguile/vectors.h (SCM_I_IS_MUTABLE_VECTOR, SCM_I_VECTOR_WELTS) (SCM_I_VECTOR_ELTS, SCM_I_VECTOR_LENGTH): Remove these internal definitions. * libguile/vectors.c: Adapt to use new data types. * libguile/eval.c: Include internal file. * libguile/init.c: Include internal file. * libguile/array-handle.c (scm_array_get_handle): Use new functions.
This commit is contained in:
Andy Wingo
parent
7dfbb8bc4b
commit
a478665ab6
7 changed files with 162 additions and 73 deletions
|
|
@ -531,6 +531,7 @@ noinst_HEADERS = atomic.h \
|
|||
strings-internal.h \
|
||||
syntax.h \
|
||||
trace.h \
|
||||
vectors-internal.h \
|
||||
whippet-embedder.h
|
||||
|
||||
# vm instructions
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@
|
|||
#include "pairs.h"
|
||||
#include "strings-internal.h"
|
||||
#include "symbols.h"
|
||||
#include "vectors.h"
|
||||
#include "vectors-internal.h"
|
||||
|
||||
#include "array-handle.h"
|
||||
|
||||
|
|
@ -202,8 +202,8 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
|
|||
initialize_vector_handle (h, scm_c_vector_length (array),
|
||||
SCM_ARRAY_ELEMENT_TYPE_SCM,
|
||||
scm_c_vector_ref, scm_c_vector_set_x,
|
||||
SCM_I_VECTOR_WELTS (array),
|
||||
SCM_I_IS_MUTABLE_VECTOR (array));
|
||||
scm_i_vector_slots (scm_to_vector (array)),
|
||||
scm_is_mutable_vector (array));
|
||||
break;
|
||||
case scm_tc7_bitvector:
|
||||
initialize_vector_handle (h, scm_c_bitvector_length (array),
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@
|
|||
#include "strorder.h"
|
||||
#include "struct.h"
|
||||
#include "syntax.h"
|
||||
#include "vectors.h"
|
||||
#include "vectors-internal.h"
|
||||
|
||||
#include "eq.h"
|
||||
|
||||
|
|
|
|||
|
|
@ -138,7 +138,7 @@
|
|||
#include "uniform.h"
|
||||
#include "values.h"
|
||||
#include "variable.h"
|
||||
#include "vectors.h"
|
||||
#include "vectors-internal.h"
|
||||
#include "version.h"
|
||||
#include "vm.h"
|
||||
|
||||
|
|
|
|||
93
libguile/vectors-internal.h
Normal file
93
libguile/vectors-internal.h
Normal file
|
|
@ -0,0 +1,93 @@
|
|||
#ifndef SCM_VECTORS_INTERNAL_H
|
||||
#define SCM_VECTORS_INTERNAL_H
|
||||
|
||||
/* Copyright 1995-1996,1998,2000-2002,2004-2006,2008-2009,2011,2014,2018,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
||||
Guile 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.
|
||||
|
||||
Guile 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 Guile. If not, see
|
||||
<https://www.gnu.org/licenses/>. */
|
||||
|
||||
|
||||
|
||||
#include "libguile/vectors.h"
|
||||
|
||||
|
||||
|
||||
#define SCM_F_VECTOR_IMMUTABLE 0x80UL
|
||||
|
||||
struct scm_vector
|
||||
{
|
||||
scm_t_bits tag_and_size;
|
||||
SCM slots[];
|
||||
};
|
||||
|
||||
static inline int
|
||||
scm_is_mutable_vector (SCM x)
|
||||
{
|
||||
return SCM_NIMP (x) &&
|
||||
(SCM_CELL_TYPE (x) & (0x7f | SCM_F_VECTOR_IMMUTABLE)) == scm_tc7_vector;
|
||||
}
|
||||
|
||||
static inline struct scm_vector *
|
||||
scm_to_vector (SCM v)
|
||||
{
|
||||
if (!scm_is_vector (v))
|
||||
abort ();
|
||||
return (struct scm_vector *) SCM_UNPACK_POINTER (v);
|
||||
}
|
||||
|
||||
static inline SCM
|
||||
scm_from_vector (struct scm_vector *v)
|
||||
{
|
||||
return SCM_PACK_POINTER (v);
|
||||
}
|
||||
|
||||
static inline size_t
|
||||
scm_i_vector_length (struct scm_vector *v)
|
||||
{
|
||||
return v->tag_and_size >> 8;
|
||||
}
|
||||
|
||||
static inline SCM*
|
||||
scm_i_vector_slots (struct scm_vector *v)
|
||||
{
|
||||
return v->slots;
|
||||
}
|
||||
|
||||
static inline SCM*
|
||||
scm_i_vector_slot (struct scm_vector *v, size_t idx)
|
||||
{
|
||||
if (idx >= scm_i_vector_length (v))
|
||||
abort ();
|
||||
return &scm_i_vector_slots (v)[idx];
|
||||
}
|
||||
|
||||
static inline SCM
|
||||
scm_i_vector_ref (struct scm_vector *v, size_t idx)
|
||||
{
|
||||
return *scm_i_vector_slot (v, idx);
|
||||
}
|
||||
|
||||
static inline void
|
||||
scm_i_vector_set_x (struct scm_vector *v, size_t idx, SCM val)
|
||||
{
|
||||
*scm_i_vector_slot (v, idx) = val;
|
||||
}
|
||||
|
||||
SCM_INTERNAL SCM scm_i_vector_equal_p (SCM x, SCM y);
|
||||
SCM_INTERNAL void scm_init_vectors (void);
|
||||
|
||||
#endif /* SCM_VECTORS_INTERNAL_H */
|
||||
|
|
@ -35,7 +35,8 @@
|
|||
#include "list.h"
|
||||
#include "numbers.h"
|
||||
#include "pairs.h"
|
||||
#include "vectors.h"
|
||||
#include "threads.h"
|
||||
#include "vectors-internal.h"
|
||||
|
||||
|
||||
|
||||
|
|
@ -43,7 +44,7 @@
|
|||
|
||||
#define SCM_VALIDATE_MUTABLE_VECTOR(pos, v) \
|
||||
do { \
|
||||
SCM_ASSERT_TYPE (SCM_I_IS_MUTABLE_VECTOR (v), v, pos, FUNC_NAME, \
|
||||
SCM_ASSERT_TYPE (scm_is_mutable_vector (v), v, pos, FUNC_NAME, \
|
||||
"mutable vector"); \
|
||||
} while (0)
|
||||
|
||||
|
|
@ -105,7 +106,7 @@ scm_c_vector_length (SCM v)
|
|||
{
|
||||
SCM_VALIDATE_VECTOR (1, v);
|
||||
|
||||
return SCM_I_VECTOR_LENGTH (v);
|
||||
return scm_i_vector_length (scm_to_vector (v));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -136,7 +137,7 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
|
|||
SCM_VALIDATE_LIST_COPYLEN (1, l, len);
|
||||
|
||||
res = scm_c_make_vector (len, SCM_UNSPECIFIED);
|
||||
data = SCM_I_VECTOR_WELTS (res);
|
||||
data = scm_i_vector_slots (scm_to_vector (res));
|
||||
i = 0;
|
||||
while (scm_is_pair (l) && i < len)
|
||||
{
|
||||
|
|
@ -173,11 +174,12 @@ scm_c_vector_ref (SCM v, size_t k)
|
|||
#define FUNC_NAME s_scm_vector_ref
|
||||
{
|
||||
SCM_VALIDATE_VECTOR (1, v);
|
||||
struct scm_vector *vv = scm_to_vector (v);
|
||||
|
||||
if (k >= SCM_I_VECTOR_LENGTH (v))
|
||||
if (k >= scm_i_vector_length (vv))
|
||||
scm_out_of_range (NULL, scm_from_size_t (k));
|
||||
|
||||
return SCM_I_VECTOR_ELTS (v)[k];
|
||||
return scm_i_vector_ref (vv, k);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -204,11 +206,12 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
|
|||
#define FUNC_NAME s_scm_vector_set_x
|
||||
{
|
||||
SCM_VALIDATE_MUTABLE_VECTOR (1, v);
|
||||
struct scm_vector *vv = scm_to_vector (v);
|
||||
|
||||
if (k >= SCM_I_VECTOR_LENGTH (v))
|
||||
if (k >= scm_i_vector_length (vv))
|
||||
scm_out_of_range (NULL, scm_from_size_t (k));
|
||||
|
||||
SCM_I_VECTOR_WELTS (v)[k] = obj;
|
||||
scm_i_vector_set_x (vv, k, obj);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -229,26 +232,27 @@ SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
static SCM
|
||||
static struct scm_vector *
|
||||
make_vector (size_t size)
|
||||
{
|
||||
return scm_words ((size << 8) | scm_tc7_vector, size + 1);
|
||||
struct scm_vector *ret =
|
||||
scm_allocate_tagged (SCM_I_CURRENT_THREAD,
|
||||
sizeof (*ret) + size * sizeof (SCM));
|
||||
ret->tag_and_size = (size << 8) | scm_tc7_vector;
|
||||
return ret;
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_c_make_vector (size_t k, SCM fill)
|
||||
#define FUNC_NAME s_scm_make_vector
|
||||
{
|
||||
SCM vector;
|
||||
|
||||
SCM_ASSERT_RANGE (1, scm_from_size_t (k), k <= VECTOR_MAX_LENGTH);
|
||||
|
||||
vector = make_vector (k);
|
||||
SCM *slots = SCM_I_VECTOR_WELTS (vector);
|
||||
struct scm_vector *vector = make_vector (k);
|
||||
for (size_t i = 0; i < k; ++i)
|
||||
slots[i] = fill;
|
||||
scm_i_vector_set_x (vector, i, fill);
|
||||
|
||||
return vector;
|
||||
return scm_from_vector (vector);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -260,10 +264,9 @@ SCM_DEFINE (scm_vector_copy_partial, "vector-copy", 1, 2, 0,
|
|||
"length of @var{vec}.")
|
||||
#define FUNC_NAME s_scm_vector_copy_partial
|
||||
{
|
||||
SCM result;
|
||||
|
||||
SCM_VALIDATE_VECTOR (1, vec);
|
||||
size_t cstart = 0, cend = SCM_I_VECTOR_LENGTH (vec);
|
||||
struct scm_vector *src = scm_to_vector (vec);
|
||||
size_t cstart = 0, cend = scm_i_vector_length (src);
|
||||
|
||||
if (!SCM_UNBNDP (start))
|
||||
{
|
||||
|
|
@ -278,11 +281,11 @@ SCM_DEFINE (scm_vector_copy_partial, "vector-copy", 1, 2, 0,
|
|||
}
|
||||
}
|
||||
|
||||
size_t len = cend-cstart;
|
||||
result = make_vector (len);
|
||||
memcpy (SCM_I_VECTOR_WELTS (result), SCM_I_VECTOR_ELTS (vec) + cstart,
|
||||
size_t len = cend - cstart;
|
||||
struct scm_vector *dst = make_vector (len);
|
||||
memcpy (scm_i_vector_slots (dst), scm_i_vector_slots (src) + cstart,
|
||||
len * sizeof(SCM));
|
||||
return result;
|
||||
return scm_from_vector (dst);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -306,10 +309,12 @@ SCM_DEFINE (scm_vector_copy_x, "vector-copy!", 3, 2, 0,
|
|||
{
|
||||
SCM_VALIDATE_MUTABLE_VECTOR (1, dst);
|
||||
SCM_VALIDATE_VECTOR (3, src);
|
||||
struct scm_vector *vdst = scm_to_vector (dst);
|
||||
struct scm_vector *vsrc = scm_to_vector (src);
|
||||
size_t src_org = 0;
|
||||
size_t dst_org = scm_to_size_t (at);
|
||||
size_t src_end = SCM_I_VECTOR_LENGTH (src);
|
||||
size_t dst_end = SCM_I_VECTOR_LENGTH (dst);
|
||||
size_t src_end = scm_i_vector_length (vsrc);
|
||||
size_t dst_end = scm_i_vector_length (vdst);
|
||||
|
||||
if (!SCM_UNBNDP (start))
|
||||
{
|
||||
|
|
@ -326,7 +331,8 @@ SCM_DEFINE (scm_vector_copy_x, "vector-copy!", 3, 2, 0,
|
|||
size_t len = src_end-src_org;
|
||||
SCM_ASSERT_RANGE (SCM_ARG2, at, dst_org<=dst_end && len<=dst_end-dst_org);
|
||||
|
||||
memmove (SCM_I_VECTOR_WELTS (dst) + dst_org, SCM_I_VECTOR_ELTS (src) + src_org,
|
||||
memmove (scm_i_vector_slots (vdst) + dst_org,
|
||||
scm_i_vector_slots (vsrc) + src_org,
|
||||
len * sizeof(SCM));
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
|
|
@ -347,11 +353,11 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
|
|||
SCM res = SCM_EOL;
|
||||
|
||||
SCM_VALIDATE_VECTOR (1, vec);
|
||||
struct scm_vector *v = scm_to_vector (vec);
|
||||
|
||||
ssize_t len = SCM_I_VECTOR_LENGTH (vec);
|
||||
const SCM * data = SCM_I_VECTOR_ELTS (vec);
|
||||
ssize_t len = scm_i_vector_length (v);
|
||||
for (ssize_t i = len-1; i >= 0; --i)
|
||||
res = scm_cons (data[i], res);
|
||||
res = scm_cons (scm_i_vector_ref (v, i), res);
|
||||
|
||||
return res;
|
||||
}
|
||||
|
|
@ -367,11 +373,12 @@ SCM_DEFINE_STATIC (scm_vector_fill_partial_x, "vector-fill!", 2, 2, 0,
|
|||
"returned by @code{vector-fill!} is unspecified.")
|
||||
#define FUNC_NAME s_scm_vector_fill_partial_x
|
||||
{
|
||||
SCM_VALIDATE_MUTABLE_VECTOR(1, vec);
|
||||
SCM_VALIDATE_MUTABLE_VECTOR (1, vec);
|
||||
struct scm_vector *v = scm_to_vector (vec);
|
||||
|
||||
size_t i = 0;
|
||||
size_t c_end = SCM_I_VECTOR_LENGTH (vec);
|
||||
SCM *data = SCM_I_VECTOR_WELTS (vec);
|
||||
size_t c_end = scm_i_vector_length (v);
|
||||
SCM *data = scm_i_vector_slots (v);
|
||||
|
||||
if (!SCM_UNBNDP (start))
|
||||
i = scm_to_unsigned_integer (start, 0, c_end);
|
||||
|
|
@ -399,9 +406,11 @@ SCM
|
|||
scm_i_vector_equal_p (SCM x, SCM y)
|
||||
{
|
||||
long i;
|
||||
for (i = SCM_I_VECTOR_LENGTH (x) - 1; i >= 0; i--)
|
||||
if (scm_is_false (scm_equal_p (SCM_I_VECTOR_ELTS (x)[i],
|
||||
SCM_I_VECTOR_ELTS (y)[i])))
|
||||
struct scm_vector *vx = scm_to_vector (x);
|
||||
struct scm_vector *vy = scm_to_vector (y);
|
||||
for (i = scm_i_vector_length (vx) - 1; i >= 0; i--)
|
||||
if (scm_is_false (scm_equal_p (scm_i_vector_ref (vx, i),
|
||||
scm_i_vector_ref (vy, i))))
|
||||
return SCM_BOOL_F;
|
||||
return SCM_BOOL_T;
|
||||
}
|
||||
|
|
@ -419,13 +428,14 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
|
|||
#define FUNC_NAME s_scm_vector_move_left_x
|
||||
{
|
||||
SCM_VALIDATE_VECTOR (1, vec1);
|
||||
SCM_VALIDATE_VECTOR (4, vec2);
|
||||
SCM_VALIDATE_MUTABLE_VECTOR (4, vec2);
|
||||
struct scm_vector *v1 = scm_to_vector (vec1);
|
||||
struct scm_vector *v2 = scm_to_vector (vec2);
|
||||
|
||||
SCM_VALIDATE_MUTABLE_VECTOR (1, vec2);
|
||||
const SCM *elts1 = SCM_I_VECTOR_ELTS (vec1);
|
||||
SCM *elts2 = SCM_I_VECTOR_WELTS (vec2);
|
||||
size_t len1 = SCM_I_VECTOR_LENGTH (vec1);
|
||||
size_t len2 = SCM_I_VECTOR_LENGTH (vec2);
|
||||
const SCM *elts1 = scm_i_vector_slots (v1);
|
||||
SCM *elts2 = scm_i_vector_slots (v2);
|
||||
size_t len1 = scm_i_vector_length (v1);
|
||||
size_t len2 = scm_i_vector_length (v2);
|
||||
|
||||
size_t i, j, e;
|
||||
i = scm_to_unsigned_integer (start1, 0, len1);
|
||||
|
|
@ -452,13 +462,14 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
|
|||
#define FUNC_NAME s_scm_vector_move_right_x
|
||||
{
|
||||
SCM_VALIDATE_VECTOR (1, vec1);
|
||||
SCM_VALIDATE_VECTOR (4, vec2);
|
||||
SCM_VALIDATE_MUTABLE_VECTOR (4, vec2);
|
||||
struct scm_vector *v1 = scm_to_vector (vec1);
|
||||
struct scm_vector *v2 = scm_to_vector (vec2);
|
||||
|
||||
SCM_VALIDATE_MUTABLE_VECTOR (1, vec2);
|
||||
const SCM *elts1 = SCM_I_VECTOR_ELTS (vec1);
|
||||
SCM *elts2 = SCM_I_VECTOR_WELTS (vec2);
|
||||
size_t len1 = SCM_I_VECTOR_LENGTH (vec1);
|
||||
size_t len2 = SCM_I_VECTOR_LENGTH (vec2);
|
||||
const SCM *elts1 = scm_i_vector_slots (v1);
|
||||
SCM *elts2 = scm_i_vector_slots (v2);
|
||||
size_t len1 = scm_i_vector_length (v1);
|
||||
size_t len2 = scm_i_vector_length (v2);
|
||||
|
||||
size_t i, j, e;
|
||||
i = scm_to_unsigned_integer (start1, 0, len1);
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#ifndef SCM_VECTORS_H
|
||||
#define SCM_VECTORS_H
|
||||
|
||||
/* Copyright 1995-1996,1998,2000-2002,2004-2006,2008-2009,2011,2014,2018
|
||||
/* Copyright 1995-1996,1998,2000-2002,2004-2006,2008-2009,2011,2014,2018,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -24,14 +24,15 @@
|
|||
|
||||
#include "libguile/array-handle.h"
|
||||
#include <libguile/error.h>
|
||||
#include "libguile/gc.h"
|
||||
|
||||
|
||||
|
||||
#define SCM_F_VECTOR_IMMUTABLE 0x80UL
|
||||
|
||||
static inline int
|
||||
scm_is_vector (SCM obj)
|
||||
scm_is_vector (SCM x)
|
||||
{
|
||||
return SCM_HAS_TYP7 (obj, scm_tc7_vector);
|
||||
return SCM_HAS_TYP7 (x, scm_tc7_vector);
|
||||
}
|
||||
|
||||
SCM_API SCM scm_vector_p (SCM x);
|
||||
|
|
@ -71,22 +72,5 @@ SCM_API SCM *scm_vector_writable_elements (SCM array,
|
|||
SCM_ASSERT (scm_is_vector (v) && len == scm_c_vector_length (v), v, pos, FUNC_NAME); \
|
||||
} while (0)
|
||||
|
||||
|
||||
/* Internals */
|
||||
|
||||
/* Vectors residualized into compiled objects have scm_tc7_vector in the
|
||||
low 7 bits, but also an additional bit set to indicate
|
||||
immutability. */
|
||||
#define SCM_F_VECTOR_IMMUTABLE 0x80UL
|
||||
#define SCM_I_IS_MUTABLE_VECTOR(x) \
|
||||
(SCM_NIMP (x) && \
|
||||
((SCM_CELL_TYPE (x) & (0x7f | SCM_F_VECTOR_IMMUTABLE)) \
|
||||
== scm_tc7_vector))
|
||||
#define SCM_I_VECTOR_ELTS(x) ((const SCM *) SCM_I_VECTOR_WELTS (x))
|
||||
#define SCM_I_VECTOR_WELTS(x) (SCM_CELL_OBJECT_LOC (x, 1))
|
||||
#define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)
|
||||
|
||||
SCM_INTERNAL SCM scm_i_vector_equal_p (SCM x, SCM y);
|
||||
SCM_INTERNAL void scm_init_vectors (void);
|
||||
|
||||
#endif /* SCM_VECTORS_H */
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue