wingo pushed a commit to branch wip-whippet
in repository guile.
commit 1a3f427d4e2843e2cf5af288fae691cb6037e484
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Wed Apr 30 13:14:58 2025 +0200
Remove all deprecated interfaces
We're on a new version series, let's remove deprecated things. Also
reduces the amount of work we need to do in adapting to a new GC,
notably for bignums.
* configure.ac (--disable-tmpnam): Remove flag, tmpnam is gone.
* doc/ref/posix.texi (File System): Remove tmpnam docs.
* libguile/bitvectors.c (scm_bitvector_to_list): Remove deprecated
branch treating arrays as bitvectors.
* libguile/deprecated.c: Remove all deprecated code. Whee!
* libguile/deprecated.h: Remove deprecated decls.
* libguile/posix.c (scm_tmpnam): Remove.
* libguile/struct.c (scm_is_valid_vtable_layout): Remove support for 'r'
fields.
* libguile/vectors.c (scm_vector_copy_partial, scm_vector_to_list)
(scm_vector_move_left_x, scm_vector_move_right_x): Remove generalized
array cases.
* test-suite/tests/vectors.test ("vector->list"): Remove shared array
test
---
configure.ac | 8 -
doc/ref/posix.texi | 20 +-
libguile/bitvectors.c | 39 +-
libguile/deprecated.c | 807 +-----------------------------------------
libguile/deprecated.h | 145 +-------
libguile/posix.c | 35 --
libguile/posix.h | 3 +-
libguile/struct.c | 6 -
libguile/vectors.c | 236 ++++--------
test-suite/tests/vectors.test | 8 +-
10 files changed, 82 insertions(+), 1225 deletions(-)
diff --git a/configure.ac b/configure.ac
index 40ebc6742..a2b9f41ad 100644
--- a/configure.ac
+++ b/configure.ac
@@ -241,10 +241,6 @@ AC_ARG_ENABLE(regex,
[ --disable-regex omit regular expression interfaces],,
enable_regex=yes)
-AC_ARG_ENABLE(tmpnam,
- AS_HELP_STRING([--disable-tmpnam],[omit POSIX tmpnam]),,
- enable_tmpnam=yes)
-
AC_ARG_ENABLE([deprecated],
AS_HELP_STRING([--disable-deprecated],[omit deprecated features]))
@@ -997,10 +993,6 @@ if test "$enable_regex" = yes; then
AC_DEFINE([ENABLE_REGEX], 1, [Define when regex support is enabled.])
fi
-if test "$enable_tmpnam" = yes; then
- AC_DEFINE([ENABLE_TMPNAM], 1, [Define when tmpnam support is enabled.])
-fi
-
AC_REPLACE_FUNCS([strerror memmove])
# Reasons for testing:
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 08d939b9f..01980b4f0 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1,7 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
-@c 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017, 2021 Free Software
Foundation, Inc.
+@c 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017, 2021, 2025 Free Software
Foundation, Inc.
@c Copyright (C) 2021 Maxime Devos <maximede...@telenet.be>
@c See the file guile.texi for copying conditions.
@@ -1070,24 +1070,6 @@ E.g.,
The return value is unspecified.
@end deffn
-@deffn {Scheme Procedure} tmpnam
-@deffnx {C Function} scm_tmpnam ()
-@cindex temporary file
-Return an auto-generated name of a temporary file, a file which
-doesn't already exist. The name includes a path, it's usually in
-@file{/tmp} but that's system dependent.
-
-Care must be taken when using @code{tmpnam}. In between choosing the
-name and creating the file another program might use that name, or an
-attacker might even make it a symlink pointing at something important
-and causing you to overwrite that.
-
-The safe way is to create the file using @code{open} with
-@code{O_EXCL} to avoid any overwriting. A loop can try again with
-another name if the file exists (error @code{EEXIST}).
-@code{mkstemp} below does that.
-@end deffn
-
@deffn {Scheme Procedure} mkstemp tmpl [mode]
@cindex temporary file
Create a new unique file in the file system and return a new buffered
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 41b91a51b..ad3212a62 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1998,2000-2006,2009-2014,2018,2020
+/* Copyright 1995-1998,2000-2006,2009-2014,2018,2020,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -432,36 +432,17 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1,
0, 0,
{
SCM res = SCM_EOL;
- if (IS_BITVECTOR (vec))
- {
- const uint32_t *bits = BITVECTOR_BITS (vec);
- size_t len = BITVECTOR_LENGTH (vec);
- size_t word_len = (len + 31) / 32;
-
- for (size_t i = 0; i < word_len; i++, len -= 32)
- {
- uint32_t mask = 1;
- for (size_t j = 0; j < 32 && j < len; j++, mask <<= 1)
- res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
- }
- }
- else
- {
- scm_t_array_handle handle;
- size_t off, len;
- ssize_t inc;
-
- scm_bitvector_elements (vec, &handle, &off, &len, &inc);
-
- scm_c_issue_deprecation_warning
- ("Using bitvector->list on arrays is deprecated. "
- "Use array->list instead.");
+ VALIDATE_BITVECTOR (1, vec);
- for (size_t i = 0; i < len; i++)
- res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
+ const uint32_t *bits = BITVECTOR_BITS (vec);
+ size_t len = BITVECTOR_LENGTH (vec);
+ size_t word_len = (len + 31) / 32;
- scm_array_handle_release (&handle);
-
+ for (size_t i = 0; i < word_len; i++, len -= 32)
+ {
+ uint32_t mask = 1;
+ for (size_t j = 0; j < 32 && j < len; j++, mask <<= 1)
+ res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
}
return scm_reverse_x (res, SCM_EOL);
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 0df946482..7329e3b5e 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1,4 +1,4 @@
-/* Copyright 2003-2004,2006,2008-2018,2020,2021,2022
+/* Copyright 2003-2004,2006,2008-2018,2020,2021,2022,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -21,816 +21,15 @@
# include <config.h>
#endif
-#include <stdio.h>
-#include <string.h>
-#include <unistd.h>
-
#define SCM_BUILDING_DEPRECATED_CODE
-#include "alist.h"
-#include "array-handle.h"
-#include "arrays.h"
-#include "boolean.h"
-#include "bitvectors.h"
-#include "deprecation.h"
-#include "dynl.h"
-#include "eval.h"
-#include "foreign.h"
-#include "finalizers.h"
-#include "generalized-vectors.h"
-#include "gc.h"
-#include "gsubr.h"
-#include "modules.h"
-#include "objprop.h"
-#include "procprop.h"
-#include "srcprop.h"
-#include "srfi-4.h"
-#include "strings.h"
-#include "symbols.h"
-#include "uniform.h"
-#include "vectors.h"
-
#include "deprecated.h"
#if (SCM_ENABLE_DEPRECATED == 1)
-#ifndef MAXPATHLEN
-#define MAXPATHLEN 80
-#endif /* ndef MAXPATHLEN */
-#ifndef X_OK
-#define X_OK 1
-#endif /* ndef X_OK */
-
-char *
-scm_find_executable (const char *name)
-{
- char tbuf[MAXPATHLEN];
- int i = 0, c;
- FILE *f;
-
- scm_c_issue_deprecation_warning ("scm_find_executable is deprecated.");
-
- /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name,
X_OK)); fflush(stderr); */
- if (access (name, X_OK))
- return 0L;
- f = fopen (name, "r");
- if (!f)
- return 0L;
- if ((fgetc (f) == '#') && (fgetc (f) == '!'))
- {
- while (1)
- switch (c = fgetc (f))
- {
- case /*WHITE_SPACES */ ' ':
- case '\t':
- case '\r':
- case '\f':
- case EOF:
- tbuf[i] = 0;
- fclose (f);
- return strdup (tbuf);
- default:
- tbuf[i++] = c;
- break;
- }
- }
- fclose (f);
- return strdup (name);
-}
-
-
-
-
-int
-scm_is_simple_vector (SCM obj)
-{
- scm_c_issue_deprecation_warning
- ("scm_is_simple_vector is deprecated. Use scm_is_vector instead.");
- return SCM_I_IS_VECTOR (obj);
-}
-
-SCM
-scm_bitvector_p (SCM vec)
-{
- scm_c_issue_deprecation_warning
- ("scm_bitvector_p is deprecated. Use scm_is_bitvector instead.");
-
- return scm_from_bool (scm_is_bitvector (vec));
-}
-
-SCM
-scm_bitvector (SCM list)
-{
- scm_c_issue_deprecation_warning
- ("scm_bitvector is deprecated. Use scm_list_to_bitvector instead.");
-
- return scm_list_to_bitvector (list);
-}
-
-SCM
-scm_make_bitvector (SCM len, SCM fill)
-{
- scm_c_issue_deprecation_warning
- ("scm_make_bitvector is deprecated. Use scm_c_make_bitvector instead.");
-
- return scm_c_make_bitvector (scm_to_size_t (len), fill);
-}
-
-SCM
-scm_bitvector_length (SCM vec)
-{
- scm_c_issue_deprecation_warning
- ("scm_bitvector_length is deprecated. Use scm_c_bitvector_length "
- "instead.");
-
- return scm_from_size_t (scm_c_bitvector_length (vec));
-}
-
-SCM
-scm_c_bitvector_ref (SCM vec, size_t idx)
-{
- scm_c_issue_deprecation_warning
- ("bitvector-ref is deprecated. Use bitvector-bit-set? instead.");
-
- if (scm_is_bitvector (vec))
- return scm_from_bool (scm_c_bitvector_bit_is_set (vec, idx));
-
- SCM res;
- scm_t_array_handle handle;
- size_t len, off;
- ssize_t inc;
-
- const uint32_t *bits =
- scm_bitvector_elements (vec, &handle, &off, &len, &inc);
-
- if (idx >= len)
- scm_out_of_range (NULL, scm_from_size_t (idx));
- idx = idx*inc + off;
- res = scm_from_bool (bits[idx/32] & (1L << (idx%32)));
- scm_array_handle_release (&handle);
- return res;
-}
-
-SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
- (SCM vec, SCM idx),
- "Return the element at index @var{idx} of the bitvector\n"
- "@var{vec}.")
-#define FUNC_NAME s_scm_bitvector_ref
-{
- return scm_c_bitvector_ref (vec, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
-{
- scm_c_issue_deprecation_warning
- ("bitvector-set! is deprecated. Use bitvector-set-bit! or "
- "bitvector-clear-bit! instead.");
-
- if (scm_is_bitvector (vec))
- {
- if (scm_is_true (val))
- scm_c_bitvector_set_bit_x (vec, idx);
- else
- scm_c_bitvector_clear_bit_x (vec, idx);
- }
- else
- {
- scm_t_array_handle handle;
- uint32_t *bits, mask;
- size_t len, off;
- ssize_t inc;
-
- bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
- if (idx >= len)
- scm_out_of_range (NULL, scm_from_size_t (idx));
- idx = idx*inc + off;
-
- mask = 1L << (idx%32);
- if (scm_is_true (val))
- bits[idx/32] |= mask;
- else
- bits[idx/32] &= ~mask;
-
- scm_array_handle_release (&handle);
- }
-}
-
-SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
- (SCM vec, SCM idx, SCM val),
- "Set the element at index @var{idx} of the bitvector\n"
- "@var{vec} when @var{val} is true, else clear it.")
-#define FUNC_NAME s_scm_bitvector_set_x
-{
- scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
- (SCM vec, SCM val),
- "Set all elements of the bitvector\n"
- "@var{vec} when @var{val} is true, else clear them.")
-#define FUNC_NAME s_scm_bitvector_fill_x
-{
- scm_c_issue_deprecation_warning
- ("bitvector-fill! is deprecated. Use bitvector-set-all-bits! or "
- "bitvector-clear-all-bits! instead.");
-
- if (scm_is_bitvector (vec))
- {
- if (scm_is_true (val))
- scm_c_bitvector_set_all_bits_x (vec);
- else
- scm_c_bitvector_clear_all_bits_x (vec);
-
- return SCM_UNSPECIFIED;
- }
-
- scm_t_array_handle handle;
- size_t off, len;
- ssize_t inc;
-
- scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
-
- size_t i;
- for (i = 0; i < len; i++)
- scm_array_handle_set (&handle, i*inc, val);
-
- scm_array_handle_release (&handle);
-
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0,
- (SCM v),
- "Modify the bit vector @var{v} by replacing each element with\n"
- "its negation.")
-#define FUNC_NAME s_scm_bit_invert_x
-{
- scm_c_issue_deprecation_warning
- ("bit-invert! is deprecated. Use bitvector-flip-all-bits!, or "
- "scalar array accessors in a loop for generic arrays.");
-
- if (scm_is_bitvector (v))
- scm_c_bitvector_flip_all_bits_x (v);
- else
- {
- size_t off, len;
- ssize_t inc;
- scm_t_array_handle handle;
-
- scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
- for (size_t i = 0; i < len; i++)
- scm_array_handle_set (&handle, i*inc,
- scm_not (scm_array_handle_ref (&handle, i*inc)));
- scm_array_handle_release (&handle);
- }
-
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
- (SCM b, SCM bitvector),
- "Return the number of occurrences of the boolean @var{b} in\n"
- "@var{bitvector}.")
-#define FUNC_NAME s_scm_bit_count
-{
- int bit = scm_to_bool (b);
- size_t count = 0, len;
-
- scm_c_issue_deprecation_warning
- ("bit-count is deprecated. Use bitvector-count, or a loop over array-ref "
- "if array support is needed.");
-
- if (scm_is_bitvector (bitvector))
- {
- len = scm_to_size_t (scm_bitvector_length (bitvector));
- count = scm_c_bitvector_count (bitvector);
- }
- else
- {
- scm_t_array_handle handle;
- size_t off;
- ssize_t inc;
-
- scm_bitvector_elements (bitvector, &handle, &off, &len, &inc);
-
- for (size_t i = 0; i < len; i++)
- if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
- count++;
-
- scm_array_handle_release (&handle);
- }
-
- return scm_from_size_t (bit ? count : len-count);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
- (SCM v, SCM kv, SCM obj),
- "Return a count of how many entries in bit vector @var{v} are\n"
- "equal to @var{obj}, with @var{kv} selecting the entries to\n"
- "consider.\n"
- "\n"
- "If @var{kv} is a bit vector, then those entries where it has\n"
- "@code{#t} are the ones in @var{v} which are considered.\n"
- "@var{kv} and @var{v} must be the same length.\n"
- "\n"
- "If @var{kv} is a u32vector, then it contains\n"
- "the indexes in @var{v} to consider.\n"
- "\n"
- "For example,\n"
- "\n"
- "@example\n"
- "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
- "(bit-count* #*01110111 #u32(7 0 4) #f) @result{} 2\n"
- "@end example")
-#define FUNC_NAME s_scm_bit_count_star
-{
- size_t count = 0;
-
- scm_c_issue_deprecation_warning
- ("bit-count* is deprecated. Use bitvector-count-bits instead, and in the "
- "case of counting false bits, subtract from a bitvector-count on the "
- "selection bitvector.");
-
- /* Validate that OBJ is a boolean so this is done even if we don't
- need BIT.
- */
- int bit = scm_to_bool (obj);
-
- if (scm_is_bitvector (v) && scm_is_bitvector (kv))
- {
- count = scm_c_bitvector_count_bits (v, kv);
- if (bit == 0)
- count = scm_c_bitvector_count (kv) - count;
- }
- else
- {
- scm_t_array_handle v_handle;
- size_t v_off, v_len;
- ssize_t v_inc;
-
- scm_bitvector_elements (v, &v_handle, &v_off, &v_len, &v_inc);
-
- if (scm_is_bitvector (kv))
- {
- size_t kv_len = scm_c_bitvector_length (kv);
- for (size_t i = 0; i < kv_len; i++)
- if (scm_c_bitvector_bit_is_set (kv, i))
- {
- SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
- if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
- count++;
- }
- }
- else if (scm_is_true (scm_u32vector_p (kv)))
- {
- scm_t_array_handle kv_handle;
- size_t i, kv_len;
- ssize_t kv_inc;
- const uint32_t *kv_elts;
-
- kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-
- for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
- {
- SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
- if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
- count++;
- }
-
- scm_array_handle_release (&kv_handle);
- }
- else
- scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
- scm_array_handle_release (&v_handle);
- }
-
- return scm_from_size_t (count);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
- (SCM item, SCM v, SCM k),
- "Return the index of the first occurrence of @var{item} in bit\n"
- "vector @var{v}, starting from @var{k}. If there is no\n"
- "@var{item} entry between @var{k} and the end of\n"
- "@var{v}, then return @code{#f}. For example,\n"
- "\n"
- "@example\n"
- "(bit-position #t #*000101 0) @result{} 3\n"
- "(bit-position #f #*0001111 3) @result{} #f\n"
- "@end example")
-#define FUNC_NAME s_scm_bit_position
-{
- scm_c_issue_deprecation_warning
- ("bit-position is deprecated. Use bitvector-position, or "
- "array-ref in a loop if you need generic arrays instead.");
-
- if (scm_is_bitvector (v))
- return scm_bitvector_position (v, item, k);
-
- scm_t_array_handle handle;
- size_t off, len;
- ssize_t inc;
- scm_bitvector_elements (v, &handle, &off, &len, &inc);
- int bit = scm_to_bool (item);
- size_t first_bit = scm_to_unsigned_integer (k, 0, len);
- SCM res = SCM_BOOL_F;
- for (size_t i = first_bit; i < len; i++)
- {
- SCM elt = scm_array_handle_ref (&handle, i*inc);
- if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
- {
- res = scm_from_size_t (i);
- break;
- }
- }
- scm_array_handle_release (&handle);
-
- return res;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
- (SCM v, SCM kv, SCM obj),
- "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
- "selecting the entries to change. The return value is\n"
- "unspecified.\n"
- "\n"
- "If @var{kv} is a bit vector, then those entries where it has\n"
- "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
- "@var{v} must be at least as long as @var{kv}. When @var{obj}\n"
- "is @code{#t} it's like @var{kv} is OR'ed into @var{v}. Or when\n"
- "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
- "\n"
- "@example\n"
- "(define bv #*01000010)\n"
- "(bit-set*! bv #*10010001 #t)\n"
- "bv\n"
- "@result{} #*11010011\n"
- "@end example\n"
- "\n"
- "If @var{kv} is a u32vector, then its elements are\n"
- "indices into @var{v} which are set to @var{obj}.\n"
- "\n"
- "@example\n"
- "(define bv #*01000010)\n"
- "(bit-set*! bv #u32(5 2 7) #t)\n"
- "bv\n"
- "@result{} #*01100111\n"
- "@end example")
-#define FUNC_NAME s_scm_bit_set_star_x
-{
- scm_c_issue_deprecation_warning
- ("bit-set*! is deprecated. Use bitvector-set-bits! or "
- "bitvector-clear-bits! on bitvectors, or array-set! in a loop "
- "if you need to work on generic arrays.");
-
- int bit = scm_to_bool (obj);
- if (scm_is_bitvector (v) && scm_is_bitvector (kv))
- {
- if (bit)
- scm_c_bitvector_set_bits_x (v, kv);
- else
- scm_c_bitvector_clear_bits_x (v, kv);
-
- return SCM_UNSPECIFIED;
- }
-
- scm_t_array_handle v_handle;
- size_t v_off, v_len;
- ssize_t v_inc;
- scm_bitvector_writable_elements (v, &v_handle, &v_off, &v_len, &v_inc);
-
- if (scm_is_bitvector (kv))
- {
- size_t kv_len = scm_c_bitvector_length (kv);
-
- if (v_len < kv_len)
- scm_misc_error (NULL,
- "selection bitvector longer than target bitvector",
- SCM_EOL);
-
- for (size_t i = 0; i < kv_len; i++)
- if (scm_is_true (scm_c_bitvector_ref (kv, i)))
- scm_array_handle_set (&v_handle, i*v_inc, obj);
- }
- else if (scm_is_true (scm_u32vector_p (kv)))
- {
- scm_t_array_handle kv_handle;
- size_t kv_len;
- ssize_t kv_inc;
- const uint32_t *kv_elts;
-
- kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
- for (size_t i = 0; i < kv_len; i++, kv_elts += kv_inc)
- scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
-
- scm_array_handle_release (&kv_handle);
- }
- else
- scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
- scm_array_handle_release (&v_handle);
-
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM
-scm_istr2bve (SCM str)
-{
- scm_t_array_handle handle;
- size_t len = scm_i_string_length (str);
- SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
- SCM res = vec;
-
- uint32_t mask;
- size_t k, j;
- const char *c_str;
- uint32_t *data;
-
- scm_c_issue_deprecation_warning
- ("scm_istr2bve is deprecated. "
- "Read from a string instead, prefixed with `#*'.");
-
- data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
- c_str = scm_i_string_chars (str);
-
- for (k = 0; k < (len + 31) / 32; k++)
- {
- data[k] = 0L;
- j = len - k * 32;
- if (j > 32)
- j = 32;
- for (mask = 1L; j--; mask <<= 1)
- switch (*c_str++)
- {
- case '0':
- break;
- case '1':
- data[k] |= mask;
- break;
- default:
- res = SCM_BOOL_F;
- goto exit;
- }
- }
-
- exit:
- scm_array_handle_release (&handle);
- scm_remember_upto_here_1 (str);
- return res;
-}
-
-SCM
-scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
- size_t byte_len)
-#define FUNC_NAME "scm_from_contiguous_typed_array"
-{
- size_t k, rlen = 1;
- scm_t_array_dim *s;
- SCM ra;
- scm_t_array_handle h;
- void *elts;
- size_t sz;
-
- scm_c_issue_deprecation_warning
- ("scm_from_contiguous_typed_array is deprecated. "
- "Instead, use scm_make_typed_array() and the array handle functions "
- "to copy data to the new array.");
-
- ra = scm_i_shap2ra (bounds);
- s = SCM_I_ARRAY_DIMS (ra);
- k = SCM_I_ARRAY_NDIM (ra);
-
- while (k--)
- {
- s[k].inc = rlen;
- 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_SET_V (ra, scm_make_generalized_vector (type, scm_from_size_t
(rlen), SCM_UNDEFINED));
-
-
- scm_array_get_handle (ra, &h);
- elts = h.writable_elements;
- sz = scm_array_handle_uniform_element_bit_size (&h);
- scm_array_handle_release (&h);
-
- if (sz >= 8 && ((sz % 8) == 0))
- {
- if (byte_len % (sz / 8))
- SCM_MISC_ERROR ("byte length not a multiple of the unit size",
SCM_EOL);
- if (byte_len / (sz / 8) != rlen)
- SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
- }
- else if (sz < 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
- /* an internal guile error, really */
- SCM_MISC_ERROR ("uniform elements larger than 8 bits must fill whole
bytes", SCM_EOL);
-
- memcpy (elts, bytes, byte_len);
-
- if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
- if (0 == s->lbnd)
- return SCM_I_ARRAY_V (ra);
- return ra;
-}
-#undef FUNC_NAME
-
-
-SCM_GLOBAL_SYMBOL (scm_sym_copy, "copy");
-
-SCM
-scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist)
-{
- scm_c_issue_deprecation_warning
- ("scm_make_srcprops is deprecated; use set-source-properties! instead");
-
- alist = SCM_UNBNDP (copy) ? alist : scm_acons (scm_sym_copy, copy, alist);
- return scm_i_make_srcprops (scm_from_long (line), scm_from_int (col),
- filename, alist);
-}
-
-SCM
-scm_copy_tree (SCM obj)
-{
- scm_c_issue_deprecation_warning
- ("scm_copy_tree is deprecated; use copy-tree from (ice-9 copy-tree) "
- "instead.");
-
- return scm_call_1 (scm_c_public_ref ("ice-9 copy-tree", "copy-tree"), obj);
-}
-
-
-/* Symbol properties. */
-
-SCM_SYMBOL (symbol_function_slot, "symbol-function-slot");
-SCM_SYMBOL (symbol_property_slot, "symbol-property-slot");
-
-SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0,
- (SCM s),
- "Return the contents of the symbol @var{s}'s @dfn{function slot}.")
-#define FUNC_NAME s_scm_symbol_fref
-{
- SCM_VALIDATE_SYMBOL (1, s);
- return scm_object_property (s, symbol_function_slot);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0,
- (SCM s),
- "Return the @dfn{property list} currently associated with the\n"
- "symbol @var{s}.")
-#define FUNC_NAME s_scm_symbol_pref
-{
- SCM result;
-
- SCM_VALIDATE_SYMBOL (1, s);
- result = scm_object_property (s, symbol_property_slot);
- return scm_is_false (result) ? SCM_EOL : result;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0,
- (SCM s, SCM val),
- "Change the binding of the symbol @var{s}'s function slot.")
-#define FUNC_NAME s_scm_symbol_fset_x
-{
- SCM_VALIDATE_SYMBOL (1, s);
- return scm_set_object_property_x (s, symbol_function_slot, val);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0,
- (SCM s, SCM val),
- "Change the binding of the symbol @var{s}'s property slot.")
-#define FUNC_NAME s_scm_symbol_pset_x
-{
- SCM_VALIDATE_SYMBOL (1, s);
- return scm_set_object_property_x (s, symbol_property_slot, val);
-}
-#undef FUNC_NAME
-
-
-
-SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0, (SCM obj), "")
-#define FUNC_NAME s_scm_dynamic_unlink
-{
- scm_c_issue_deprecation_warning
- ("scm_dynamic_unlink has no effect and is deprecated. Unloading "
- "shared libraries is no longer supported.");
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-
-
-static void
-finalize_bignum (void *ptr, void *data)
-{
- SCM bignum;
-
- bignum = SCM_PACK_POINTER (ptr);
- mpz_clear (SCM_I_BIG_MPZ (bignum));
-}
-
-static SCM
-make_bignum (void)
-{
- scm_t_bits *p;
-
- /* Allocate one word for the type tag and enough room for an `mpz_t'. */
- p = scm_gc_malloc_pointerless (sizeof (scm_t_bits) + sizeof (mpz_t),
- "bignum");
- p[0] = scm_tc16_big;
- scm_i_set_finalizer (p, finalize_bignum, NULL);
-
- return SCM_PACK (p);
-}
-
-/* scm_i_big2dbl() rounds to the closest representable double,
- in accordance with R5RS exact->inexact. */
-double
-scm_i_big2dbl (SCM b)
-{
- scm_c_issue_deprecation_warning
- ("scm_i_big2dbl is deprecated. Use scm_to_double instead.");
- return scm_to_double (b);
-}
-
-SCM
-scm_i_long2big (long x)
-{
- scm_c_issue_deprecation_warning
- ("scm_i_long2big is deprecated. Use scm_from_long instead.");
- /* Return a newly created bignum initialized to X. */
- SCM z = make_bignum ();
- mpz_init_set_si (SCM_I_BIG_MPZ (z), x);
- return z;
-}
-
-SCM
-scm_i_ulong2big (unsigned long x)
-{
- scm_c_issue_deprecation_warning
- ("scm_i_ulong2big is deprecated. Use scm_from_ulong instead.");
- /* Return a newly created bignum initialized to X. */
- SCM z = make_bignum ();
- mpz_init_set_ui (SCM_I_BIG_MPZ (z), x);
- return z;
-}
-
-SCM
-scm_i_clonebig (SCM src_big, int same_sign_p)
-{
- scm_c_issue_deprecation_warning
- ("scm_i_clonebig is deprecated. Use scm_to_mpz/scm_from_mpz instead.");
- /* Copy src_big's value, negate it if same_sign_p is false, and return. */
- SCM z = make_bignum ();
- scm_to_mpz (src_big, SCM_I_BIG_MPZ (z));
- if (!same_sign_p)
- mpz_neg (SCM_I_BIG_MPZ (z), SCM_I_BIG_MPZ (z));
- return z;
-}
-
-SCM
-scm_i_normbig (SCM b)
-{
- scm_c_issue_deprecation_warning
- ("scm_i_normbig is deprecated. Direct bignum bit manipulation is not "
- "supported.");
- /* convert a big back to a fixnum if it'll fit */
- /* presume b is a bignum */
- if (mpz_fits_slong_p (SCM_I_BIG_MPZ (b)))
- {
- scm_t_inum val = mpz_get_si (SCM_I_BIG_MPZ (b));
- if (SCM_FIXABLE (val))
- b = SCM_I_MAKINUM (val);
- }
- return b;
-}
-
-int scm_install_gmp_memory_functions;
+/* Deprecated functions go here. */
@@ -840,4 +39,4 @@ scm_i_init_deprecated ()
#include "deprecated.x"
}
-#endif /* SCM_ENABLE_DEPRECATD == 1 */
+#endif /* SCM_ENABLE_DEPRECATED == 1 */
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 75a6e78e1..f1a76baa2 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -1,7 +1,7 @@
#ifndef SCM_DEPRECATED_H
#define SCM_DEPRECATED_H
-/* Copyright 2003-2007,2009-2018,2020-2022
+/* Copyright 2003-2007,2009-2018,2020-2022,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -26,149 +26,6 @@
/* Deprecated declarations go here. */
-/* Return true (non-zero) if GCC version MAJ.MIN or later is being used
- * (macro taken from glibc.) */
-#if defined __GNUC__ && defined __GNUC_MINOR__
-# define SCM_GNUC_PREREQ(maj, min) \
- ((__GNUC__ << 16) + __GNUC_MINOR__ >= ((maj) << 16) + (min))
-#else
-# define SCM_GNUC_PREREQ(maj, min) 0
-#endif
-
-#define scm_i_jmp_buf scm_i_jmp_buf_GONE__USE_JMP_BUF_INSTEAD
-
-#define SCM_VALIDATE_VECTOR_OR_DVECTOR(pos, v) \
- do { \
- SCM_ASSERT (scm_is_vector (v) || scm_is_true (scm_f64vector_p (v)), \
- v, pos, FUNC_NAME); \
- } while (0)
-
-#ifdef SCM_SUPPORT_STATIC_ALLOCATION
-#define SCM_STATIC_DOUBLE_CELL(c_name, car, cbr, ccr, cdr) \
- static SCM_ALIGNED (8) SCM_UNUSED scm_t_cell \
- c_name ## _raw_cell [2] = \
- { \
- { SCM_PACK (car), SCM_PACK (cbr) }, \
- { SCM_PACK (ccr), SCM_PACK (cdr) } \
- }; \
- static SCM_UNUSED SCM c_name = SCM_PACK (& c_name ## _raw_cell)
-#endif /* SCM_SUPPORT_STATIC_ALLOCATION */
-
-#define scm_gc_running_p 0
-
-#define SCM_I_UTYPE_MAX(type) ((type)-1)
-#define SCM_I_TYPE_MAX(type,umax) ((type)((umax)/2))
-#define SCM_I_TYPE_MIN(type,umax) (-((type)((umax)/2))-1)
-
-#define SCM_T_UINT8_MAX UINT8_MAX
-#define SCM_T_INT8_MIN INT8_MIN
-#define SCM_T_INT8_MAX INT8_MAX
-
-#define SCM_T_UINT16_MAX UINT16_MAX
-#define SCM_T_INT16_MIN INT16_MIN
-#define SCM_T_INT16_MAX INT16_MAX
-
-#define SCM_T_UINT32_MAX UINT32_MAX
-#define SCM_T_INT32_MIN INT32_MIN
-#define SCM_T_INT32_MAX INT32_MAX
-
-#define SCM_T_UINT64_MAX UINT64_MAX
-#define SCM_T_INT64_MIN INT64_MIN
-#define SCM_T_INT64_MAX INT64_MAX
-
-#define SCM_T_UINTMAX_MAX UINTMAX_MAX
-#define SCM_T_INTMAX_MIN INTMAX_MIN
-#define SCM_T_INTMAX_MAX INTMAX_MAX
-
-#define SCM_T_UINTPTR_MAX UINTPTR_MAX
-#define SCM_T_INTPTR_MIN INTPTR_MIN
-#define SCM_T_INTPTR_MAX INTPTR_MAX
-
-#define SCM_HAVE_T_INT64 1 /* 0 or 1 */
-#define SCM_HAVE_T_UINT64 1 /* 0 or 1 */
-
-#define SCM_HAVE_ARRAYS 1 /* always true now */
-
-#ifdef __GNUC__
-#define SCM_DEPRECATED_TYPE __attribute__((__deprecated__))
-#else
-#define SCM_DEPRECATED_TYPE /*deprecated*/
-#endif
-typedef int8_t scm_t_int8 SCM_DEPRECATED_TYPE;
-typedef uint8_t scm_t_uint8 SCM_DEPRECATED_TYPE;
-typedef int16_t scm_t_int16 SCM_DEPRECATED_TYPE;
-typedef uint16_t scm_t_uint16 SCM_DEPRECATED_TYPE;
-typedef int32_t scm_t_int32 SCM_DEPRECATED_TYPE;
-typedef uint32_t scm_t_uint32 SCM_DEPRECATED_TYPE;
-typedef intmax_t scm_t_intmax SCM_DEPRECATED_TYPE;
-typedef uintmax_t scm_t_uintmax SCM_DEPRECATED_TYPE;
-typedef intptr_t scm_t_intptr SCM_DEPRECATED_TYPE;
-typedef uintptr_t scm_t_uintptr SCM_DEPRECATED_TYPE;
-typedef int64_t scm_t_int64 SCM_DEPRECATED_TYPE;
-typedef uint64_t scm_t_uint64 SCM_DEPRECATED_TYPE;
-typedef ptrdiff_t scm_t_ptrdiff SCM_DEPRECATED_TYPE;
-
-typedef struct scm_thread scm_i_thread SCM_DEPRECATED_TYPE;
-#undef SCM_DEPRECATED_TYPE
-
-#define SCM_MEMORY_ERROR do { scm_report_out_of_memory (); } while (0)
-
-SCM_DEPRECATED char* scm_find_executable (const char *name);
-
-SCM_DEPRECATED int scm_is_simple_vector (SCM obj);
-SCM_DEPRECATED SCM scm_bitvector_p (SCM vec);
-SCM_DEPRECATED SCM scm_bitvector (SCM bits);
-SCM_DEPRECATED SCM scm_make_bitvector (SCM len, SCM fill);
-SCM_DEPRECATED SCM scm_bitvector_length (SCM vec);
-SCM_DEPRECATED SCM scm_c_bitvector_ref (SCM vec, size_t idx);
-SCM_DEPRECATED SCM scm_bitvector_ref (SCM vec, SCM idx);
-SCM_DEPRECATED void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
-SCM_DEPRECATED SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
-SCM_DEPRECATED SCM scm_bitvector_fill_x (SCM vec, SCM val);
-SCM_DEPRECATED SCM scm_bit_invert_x (SCM vec);
-SCM_DEPRECATED SCM scm_bit_count (SCM item, SCM seq);
-SCM_DEPRECATED SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
-SCM_DEPRECATED SCM scm_bit_position (SCM item, SCM v, SCM k);
-SCM_DEPRECATED SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
-SCM_DEPRECATED SCM scm_istr2bve (SCM str);
-SCM_DEPRECATED SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
- const void *bytes,
- size_t byte_len);
-
-#define SCM_SOURCE_PROPERTY_FLAG_BREAK 1
-
-SCM_DEPRECATED scm_t_bits scm_tc16_srcprops;
-SCM_DEPRECATED SCM scm_sym_copy;
-SCM_DEPRECATED SCM scm_make_srcprops (long line, int col, SCM filename,
- SCM copy, SCM alist);
-
-SCM_DEPRECATED SCM scm_copy_tree (SCM obj);
-
-#define SCM_SYMBOL_FUNC(x) (scm_symbol_fref (x))
-#define SCM_SET_SYMBOL_FUNC(x,f) (scm_symbol_fset_x (x, f))
-#define SCM_SYMBOL_PROPS(x) (scm_symbol_pref (x))
-#define SCM_SET_SYMBOL_PROPS(x,p) (scm_symbol_pset_x (x, p))
-
-SCM_DEPRECATED SCM scm_symbol_fref (SCM s);
-SCM_DEPRECATED SCM scm_symbol_pref (SCM s);
-SCM_DEPRECATED SCM scm_symbol_fset_x (SCM s, SCM val);
-SCM_DEPRECATED SCM scm_symbol_pset_x (SCM s, SCM val);
-
-SCM_DEPRECATED SCM scm_dynamic_unlink (SCM obj);
-
-/* Each bignum is just an mpz_t stored in a double cell starting at word 1. */
-#if defined BUILDING_LIBGUILE || SCM_ENABLE_MINI_GMP == 0
-#define SCM_I_BIG_MPZ(x) (*((mpz_t *) (SCM_CELL_OBJECT_LOC((x),1))))
-#endif
-
-SCM_DEPRECATED int scm_install_gmp_memory_functions;
-SCM_DEPRECATED SCM scm_i_normbig (SCM x);
-SCM_DEPRECATED double scm_i_big2dbl (SCM b);
-SCM_DEPRECATED SCM scm_i_long2big (long n);
-SCM_DEPRECATED SCM scm_i_ulong2big (unsigned long n);
-SCM_DEPRECATED SCM scm_i_clonebig (SCM src_big, int same_sign_p);
-
-
void scm_i_init_deprecated (void);
#endif
diff --git a/libguile/posix.c b/libguile/posix.c
index c8bbb0f83..5a4739e42 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -82,10 +82,6 @@
#include "verify.h"
#include "version.h"
-#if (SCM_ENABLE_DEPRECATED == 1)
-#include "deprecation.h"
-#endif
-
#include "posix.h"
#if HAVE_SYS_WAIT_H
@@ -1778,37 +1774,6 @@ SCM_DEFINE (scm_environ, "environ", 0, 1, 0,
}
#undef FUNC_NAME
-#if (SCM_ENABLE_DEPRECATED == 1)
-#ifdef ENABLE_TMPNAM
-#ifdef L_tmpnam
-
-SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
- (),
- "Return a name in the file system that does not match any\n"
- "existing file. However there is no guarantee that another\n"
- "process will not create the file after @code{tmpnam} is called.\n"
- "Care should be taken if opening the file, e.g., use the\n"
- "@code{O_EXCL} open flag or use @code{mkstemp} instead.")
-#define FUNC_NAME s_scm_tmpnam
-{
- char name[L_tmpnam];
- char *rv;
-
- scm_c_issue_deprecation_warning
- ("Use of tmpnam is deprecated. Use mkstemp instead.");
-
- SCM_SYSCALL (rv = tmpnam (name));
- if (rv == NULL)
- /* not SCM_SYSERROR since errno probably not set. */
- SCM_MISC_ERROR ("tmpnam failed", SCM_EOL);
- return scm_from_locale_string (name);
-}
-#undef FUNC_NAME
-
-#endif
-#endif
-#endif
-
SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0,
(void),
"Return an input/output port to a unique temporary file\n"
diff --git a/libguile/posix.h b/libguile/posix.h
index a4b0297b3..39c67bd4e 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -1,7 +1,7 @@
#ifndef SCM_POSIX_H
#define SCM_POSIX_H
-/* Copyright 1995-1998, 2000-2001, 2003, 2006, 2008-2011, 2018, 2021-2023
+/* Copyright 1995-1998, 2000-2001, 2003, 2006, 2008-2011, 2018, 2021-2023, 2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -65,7 +65,6 @@ SCM_API SCM scm_execle (SCM filename, SCM env, SCM args);
SCM_API SCM scm_fork (void);
SCM_API SCM scm_uname (void);
SCM_API SCM scm_environ (SCM env);
-SCM_API SCM scm_tmpnam (void);
SCM_API SCM scm_tmpfile (void);
SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
SCM_API SCM scm_close_pipe (SCM port);
diff --git a/libguile/struct.c b/libguile/struct.c
index 8721c5469..3e220d9d0 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -181,12 +181,6 @@ scm_is_valid_vtable_layout (SCM layout)
case 'w':
case 'h':
break;
- case 'r':
- scm_c_issue_deprecation_warning
- ("Read-only struct fields are deprecated. Implement access "
- "control at a higher level instead, as structs no longer "
- "enforce field permissions.");
- break;
default:
return 0;
}
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 18c7dc54d..d81dc61a7 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1996,1998-2001,2006,2008-2012,2014,2018-2020
+/* Copyright 1995-1996,1998-2001,2006,2008-2012,2014,2018-2020,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -268,51 +268,27 @@ SCM_DEFINE (scm_vector_copy_partial, "vector-copy", 1, 2,
0,
#define FUNC_NAME s_scm_vector_copy_partial
{
SCM result;
- if (SCM_I_IS_VECTOR (vec))
- {
- size_t cstart = 0, cend = SCM_I_VECTOR_LENGTH (vec);
+
+ SCM_VALIDATE_VECTOR (1, vec);
+ size_t cstart = 0, cend = SCM_I_VECTOR_LENGTH (vec);
- if (!SCM_UNBNDP (start))
+ if (!SCM_UNBNDP (start))
+ {
+ cstart = scm_to_size_t (start);
+ SCM_ASSERT_RANGE (SCM_ARG2, start, cstart<=cend);
+
+ if (!SCM_UNBNDP (end))
{
- cstart = scm_to_size_t (start);
- SCM_ASSERT_RANGE (SCM_ARG2, start, cstart<=cend);
-
- if (!SCM_UNBNDP (end))
- {
- size_t e = scm_to_size_t (end);
- SCM_ASSERT_RANGE (SCM_ARG3, end, e>=cstart && e<=cend);
- cend = e;
- }
+ size_t e = scm_to_size_t (end);
+ SCM_ASSERT_RANGE (SCM_ARG3, end, e>=cstart && e<=cend);
+ cend = e;
}
-
- size_t len = cend-cstart;
- result = make_vector (len);
- memcpy (SCM_I_VECTOR_WELTS (result), SCM_I_VECTOR_ELTS (vec) + cstart,
- len * sizeof(SCM));
- }
- else
- {
- scm_t_array_handle handle;
- size_t i, len;
- ssize_t inc;
- const SCM *src;
- SCM *dst;
-
- src = scm_vector_elements (vec, &handle, &len, &inc);
- scm_c_issue_deprecation_warning
- ("Using vector-copy on arrays is deprecated. "
- "Use array-copy instead.");
-
- if (SCM_UNBNDP (start))
- scm_misc_error (s_scm_vector_copy_partial, "Too many arguments",
SCM_EOL);
-
- result = make_vector (len);
- dst = SCM_I_VECTOR_WELTS (result);
- for (i = 0; i < len; i++, src += inc)
- dst[i] = *src;
-
- scm_array_handle_release (&handle);
}
+
+ size_t len = cend-cstart;
+ result = make_vector (len);
+ memcpy (SCM_I_VECTOR_WELTS (result), SCM_I_VECTOR_ELTS (vec) + cstart,
+ len * sizeof(SCM));
return result;
}
#undef FUNC_NAME
@@ -377,32 +353,13 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
{
SCM res = SCM_EOL;
- if (SCM_I_IS_VECTOR (vec))
- {
- ssize_t len = SCM_I_VECTOR_LENGTH (vec);
- const SCM * data = SCM_I_VECTOR_ELTS (vec);
- for (ssize_t i = len-1; i >= 0; --i)
- res = scm_cons (data[i], res);
- }
- else
- {
- const SCM *data;
- scm_t_array_handle handle;
- size_t i, count, len;
- ssize_t inc;
-
- data = scm_vector_elements (vec, &handle, &len, &inc);
- scm_c_issue_deprecation_warning
- ("Using vector->list on arrays is deprecated. "
- "Use array->list instead.");
-
- for (i = (len - 1) * inc, count = 0;
- count < len;
- i -= inc, count++)
- res = scm_cons (data[i], res);
-
- scm_array_handle_release (&handle);
- }
+ SCM_VALIDATE_VECTOR (1, vec);
+
+ ssize_t len = SCM_I_VECTOR_LENGTH (vec);
+ const SCM * data = SCM_I_VECTOR_ELTS (vec);
+ for (ssize_t i = len-1; i >= 0; --i)
+ res = scm_cons (data[i], res);
+
return res;
}
#undef FUNC_NAME
@@ -468,53 +425,24 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!",
5, 0, 0,
"@var{start1} is greater than @var{start2}.")
#define FUNC_NAME s_scm_vector_move_left_x
{
- if (SCM_I_IS_VECTOR (vec1) && SCM_I_IS_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);
-
- size_t i, j, e;
- i = scm_to_unsigned_integer (start1, 0, len1);
- e = scm_to_unsigned_integer (end1, i, len1);
- SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
- j = scm_to_unsigned_integer (start2, 0, len2);
- SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
- for (; i < e; ++i, ++j)
- elts2[j] = elts1[i];
- }
- else
- {
- scm_t_array_handle handle1, handle2;
- const SCM *elts1;
- SCM *elts2;
- size_t len1, len2;
- ssize_t inc1, inc2;
- size_t i, j, e;
-
- elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
- elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
- scm_c_issue_deprecation_warning
- ("Using vector-move-left! on arrays is deprecated. "
- "Use array-copy-in-order! instead.");
-
- i = scm_to_unsigned_integer (start1, 0, len1);
- e = scm_to_unsigned_integer (end1, i, len1);
- SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
- j = scm_to_unsigned_integer (start2, 0, len2);
- SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
-
- i *= inc1;
- e *= inc1;
- j *= inc2;
- for (; i < e; i += inc1, j += inc2)
- elts2[j] = elts1[i];
-
- scm_array_handle_release (&handle2);
- scm_array_handle_release (&handle1);
- }
+ SCM_VALIDATE_VECTOR (1, vec1);
+ SCM_VALIDATE_VECTOR (4, 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);
+
+ size_t i, j, e;
+ i = scm_to_unsigned_integer (start1, 0, len1);
+ e = scm_to_unsigned_integer (end1, i, len1);
+ SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
+ j = scm_to_unsigned_integer (start2, 0, len2);
+ SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
+ for (; i < e; ++i, ++j)
+ elts2[j] = elts1[i];
+
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -530,64 +458,28 @@ SCM_DEFINE (scm_vector_move_right_x,
"vector-move-right!", 5, 0, 0,
"@var{start1} is less than @var{start2}.")
#define FUNC_NAME s_scm_vector_move_right_x
{
- if (SCM_I_IS_VECTOR (vec1) && SCM_I_IS_VECTOR (vec2))
+ SCM_VALIDATE_VECTOR (1, vec1);
+ SCM_VALIDATE_VECTOR (4, 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);
+
+ size_t i, j, e;
+ i = scm_to_unsigned_integer (start1, 0, len1);
+ e = scm_to_unsigned_integer (end1, i, len1);
+ SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
+ j = scm_to_unsigned_integer (start2, 0, len2);
+ SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
+ j += (e - i);
+
+ while (i < e)
{
- 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);
-
- size_t i, j, e;
- i = scm_to_unsigned_integer (start1, 0, len1);
- e = scm_to_unsigned_integer (end1, i, len1);
- SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
- j = scm_to_unsigned_integer (start2, 0, len2);
- SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
- j += (e - i);
-
- while (i < e)
- {
- --e;
- --j;
- elts2[j] = elts1[e];
- }
- }
- else
- {
- scm_t_array_handle handle1, handle2;
- const SCM *elts1;
- SCM *elts2;
- size_t len1, len2;
- ssize_t inc1, inc2;
- size_t i, j, e;
-
- elts1 = scm_vector_elements (vec1, &handle1, &len1, &inc1);
- elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
- scm_c_issue_deprecation_warning
- ("Using vector-move-right! on arrays is deprecated. "
- "Use array-copy-in-order! instead.");
-
- i = scm_to_unsigned_integer (start1, 0, len1);
- e = scm_to_unsigned_integer (end1, i, len1);
- SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
- j = scm_to_unsigned_integer (start2, 0, len2);
- SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
-
- j += (e - i);
-
- i *= inc1;
- e *= inc1;
- j *= inc2;
- while (i < e)
- {
- e -= inc1;
- j -= inc2;
- elts2[j] = elts1[e];
- }
-
- scm_array_handle_release (&handle2);
- scm_array_handle_release (&handle1);
+ --e;
+ --j;
+ elts2[j] = elts1[e];
}
return SCM_UNSPECIFIED;
diff --git a/test-suite/tests/vectors.test b/test-suite/tests/vectors.test
index 371b51840..a8dc34cef 100644
--- a/test-suite/tests/vectors.test
+++ b/test-suite/tests/vectors.test
@@ -1,6 +1,6 @@
;;;; vectors.test --- test suite for Guile's vector functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2003, 2006, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006, 2010, 2011, 2025 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
@@ -50,11 +50,7 @@
(pass-if "string-vector 2"
(equal? '("abc\u0100" "def\u0101" "ghi\u0102")
- (vector->list #("abc\u0100" "def\u0101" "ghi\u0102"))))
-
- (pass-if "shared array"
- (let ((b (make-shared-array #(1) (lambda (x) '(0)) 2)))
- (equal? b (list->vector (vector->list b))))))
+ (vector->list #("abc\u0100" "def\u0101" "ghi\u0102")))))
(with-test-prefix "make-vector"
