mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-06 15:40:29 +02:00
Code Activity

Remove all deprecated interfaces

Browse source 
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
This commit is contained in:
Andy Wingo 2025-04-30 13:14:58 +02:00
parent dd0e455755
commit 1a3f427d4e
10 changed files with 78 additions and 1221 deletions
Download patch file Download diff file Expand all files Collapse all files

8
configure.ac
View file

@ -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:

20
doc/ref/posix.texi
View file

@ -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 <maximedevos@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

41
libguile/bitvectors.c
View file

@ -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))
VALIDATE_BITVECTOR (1, 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)
{
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.");
for (size_t i = 0; i < len; i++)
res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
scm_array_handle_release (&handle);
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);

807
libguile/deprecated.c
View file

@ -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 */

145
libguile/deprecated.h
View file

@ -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

35
libguile/posix.c
View file

@ -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"

3
libguile/posix.h
View file

@ -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);

6
libguile/struct.c
View file

@ -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;
}

224
libguile/vectors.c
View file

@ -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);
if (!SCM_UNBNDP (start))
SCM_VALIDATE_VECTOR (1, vec);
size_t cstart = 0, cend = SCM_I_VECTOR_LENGTH (vec);
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;
SCM_VALIDATE_VECTOR (1, vec);
data = scm_vector_elements (vec, &handle, &len, &inc);
scm_c_issue_deprecation_warning
("Using vector->list on arrays is deprecated. "
"Use array->list instead.");
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);
for (i = (len - 1) * inc, count = 0;
count < len;
i -= inc, count++)
res = scm_cons (data[i], res);
scm_array_handle_release (&handle);
}
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);
SCM_VALIDATE_VECTOR (1, vec1);
SCM_VALIDATE_VECTOR (4, 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;
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);
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.");
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];
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);
}
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;

8
test-suite/tests/vectors.test
View file

@ -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"