diff options
Diffstat (limited to 'libguile/weak-vector.c')
-rw-r--r-- | libguile/weak-vector.c | 273 |
1 files changed, 0 insertions, 273 deletions
diff --git a/libguile/weak-vector.c b/libguile/weak-vector.c deleted file mode 100644 index 533a07ff0..000000000 --- a/libguile/weak-vector.c +++ /dev/null @@ -1,273 +0,0 @@ -/* Copyright 1995-1996,1998,2000-2001,2003,2006,2008-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/>. */ - - - -#ifdef HAVE_CONFIG_H -# include <config.h> -#endif - -#include <stdio.h> -#include <string.h> - -#include "bdw-gc.h" -#include "boolean.h" -#include "extensions.h" -#include "gsubr.h" -#include "list.h" -#include "pairs.h" -#include "vectors.h" -#include "version.h" - -#include "weak-vector.h" - - - - -/* {Weak Vectors} - */ - -#define VECTOR_MAX_LENGTH (SCM_T_BITS_MAX >> 8) - -SCM -scm_c_make_weak_vector (size_t len, SCM fill) -#define FUNC_NAME "make-weak-vector" -{ - SCM wv; - size_t j; - - SCM_ASSERT_RANGE (1, scm_from_size_t (len), len <= VECTOR_MAX_LENGTH); - - if (SCM_UNBNDP (fill)) - fill = SCM_UNSPECIFIED; - - wv = SCM_PACK_POINTER (scm_gc_malloc_pointerless ((len + 1) * sizeof (SCM), - "weak vector")); - - SCM_SET_CELL_WORD_0 (wv, (len << 8) | scm_tc7_wvect); - - if (SCM_HEAP_OBJECT_P (fill)) - { - memset (SCM_I_VECTOR_WELTS (wv), 0, len * sizeof (SCM)); - for (j = 0; j < len; j++) - scm_c_weak_vector_set_x (wv, j, fill); - } - else - for (j = 0; j < len; j++) - SCM_SIMPLE_VECTOR_SET (wv, j, fill); - - return wv; -} -#undef FUNC_NAME - -SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0, - (SCM size, SCM fill), - "Return a weak vector with @var{size} elements. If the optional\n" - "argument @var{fill} is given, all entries in the vector will be\n" - "set to @var{fill}. The default value for @var{fill} is the\n" - "empty list.") -#define FUNC_NAME s_scm_make_weak_vector -{ - return scm_c_make_weak_vector (scm_to_size_t (size), fill); -} -#undef FUNC_NAME - - -SCM_REGISTER_PROC(s_list_to_weak_vector, "list->weak-vector", 1, 0, 0, scm_weak_vector); - -SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1, - (SCM lst), - "@deffnx {Scheme Procedure} list->weak-vector lst\n" - "Construct a weak vector from a list: @code{weak-vector} uses\n" - "the list of its arguments while @code{list->weak-vector} uses\n" - "its only argument @var{l} (a list) to construct a weak vector\n" - "the same way @code{list->vector} would.") -#define FUNC_NAME s_scm_weak_vector -{ - SCM wv; - size_t i; - long c_size; - - SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, lst, c_size); - - wv = scm_c_make_weak_vector ((size_t) c_size, SCM_BOOL_F); - - for (i = 0; scm_is_pair (lst); lst = SCM_CDR (lst), i++) - scm_c_weak_vector_set_x (wv, i, SCM_CAR (lst)); - - return wv; -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0, - (SCM obj), - "Return @code{#t} if @var{obj} is a weak vector. Note that all\n" - "weak hashes are also weak vectors.") -#define FUNC_NAME s_scm_weak_vector_p -{ - return scm_from_bool (scm_is_weak_vector (obj)); -} -#undef FUNC_NAME - - -int -scm_is_weak_vector (SCM obj) -#define FUNC_NAME s_scm_weak_vector_p -{ - return SCM_I_WVECTP (obj); -} -#undef FUNC_NAME - - -#define SCM_VALIDATE_WEAK_VECTOR(pos, var) \ - SCM_I_MAKE_VALIDATE_MSG2 (pos, var, SCM_I_WVECTP, "weak vector") - - -SCM_DEFINE (scm_weak_vector_length, "weak-vector-length", 1, 0, 0, - (SCM wvect), - "Like @code{vector-length}, but for weak vectors.") -#define FUNC_NAME s_scm_weak_vector_length -{ - return scm_from_size_t (scm_c_weak_vector_length (wvect)); -} -#undef FUNC_NAME - - -size_t -scm_c_weak_vector_length (SCM wvect) -#define FUNC_NAME s_scm_weak_vector_length -{ - SCM_VALIDATE_WEAK_VECTOR (1, wvect); - return SCM_I_VECTOR_LENGTH (wvect); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_weak_vector_ref, "weak-vector-ref", 2, 0, 0, - (SCM wvect, SCM k), - "Like @code{vector-ref}, but for weak vectors.") -#define FUNC_NAME s_scm_weak_vector_ref -{ - return scm_c_weak_vector_ref (wvect, scm_to_size_t (k)); -} -#undef FUNC_NAME - - -struct weak_vector_ref_data -{ - SCM wv; - size_t k; -}; - -static void* -weak_vector_ref (void *data) -{ - struct weak_vector_ref_data *d = data; - - return (void *) SCM_UNPACK (SCM_SIMPLE_VECTOR_REF (d->wv, d->k)); -} - -SCM -scm_c_weak_vector_ref (SCM wv, size_t k) -#define FUNC_NAME s_scm_weak_vector_ref -{ - struct weak_vector_ref_data d; - void *ret; - - SCM_VALIDATE_WEAK_VECTOR (1, wv); - - d.wv = wv; - d.k = k; - - if (k >= SCM_I_VECTOR_LENGTH (wv)) - scm_out_of_range ("weak-vector-ref", scm_from_size_t (k)); - - ret = GC_call_with_alloc_lock (weak_vector_ref, &d); - - if (ret) - return SCM_PACK_POINTER (ret); - else - return SCM_BOOL_F; -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_weak_vector_set_x, "weak-vector-set!", 3, 0, 0, - (SCM wvect, SCM k, SCM obj), - "Like @code{vector-set!}, but for weak vectors.") -#define FUNC_NAME s_scm_weak_vector_set_x -{ - scm_c_weak_vector_set_x (wvect, scm_to_size_t (k), obj); - - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - - -void -scm_c_weak_vector_set_x (SCM wv, size_t k, SCM x) -#define FUNC_NAME s_scm_weak_vector_set_x -{ - SCM *elts; - struct weak_vector_ref_data d; - void *prev; - - SCM_VALIDATE_WEAK_VECTOR (1, wv); - - d.wv = wv; - d.k = k; - - if (k >= SCM_I_VECTOR_LENGTH (wv)) - scm_out_of_range ("weak-vector-set!", scm_from_size_t (k)); - - prev = GC_call_with_alloc_lock (weak_vector_ref, &d); - - elts = SCM_I_VECTOR_WELTS (wv); - - if (prev && SCM_HEAP_OBJECT_P (SCM_PACK_POINTER (prev))) - GC_unregister_disappearing_link ((void **) &elts[k]); - - elts[k] = x; - - if (SCM_HEAP_OBJECT_P (x)) - SCM_I_REGISTER_DISAPPEARING_LINK ((void **) &elts[k], - SCM2PTR (x)); -} -#undef FUNC_NAME - - - -static void -scm_init_weak_vector_builtins (void) -{ -#ifndef SCM_MAGIC_SNARFER -#include "weak-vector.x" -#endif -} - -void -scm_init_weak_vectors () -{ - scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, - "scm_init_weak_vector_builtins", - (scm_t_extension_init_func)scm_init_weak_vector_builtins, - NULL); -} - |