mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-06 07:30:28 +02:00
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
This commit is contained in:
Andy Wingo
parent
dd0e455755
commit
1a3f427d4e
10 changed files with 78 additions and 1221 deletions
|
|
@ -241,10 +241,6 @@ AC_ARG_ENABLE(regex,
|
||||||
[ --disable-regex omit regular expression interfaces],,
|
[ --disable-regex omit regular expression interfaces],,
|
||||||
enable_regex=yes)
|
enable_regex=yes)
|
||||||
|
|
||||||
AC_ARG_ENABLE(tmpnam,
|
|
||||||
AS_HELP_STRING([--disable-tmpnam],[omit POSIX tmpnam]),,
|
|
||||||
enable_tmpnam=yes)
|
|
||||||
|
|
||||||
AC_ARG_ENABLE([deprecated],
|
AC_ARG_ENABLE([deprecated],
|
||||||
AS_HELP_STRING([--disable-deprecated],[omit deprecated features]))
|
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.])
|
AC_DEFINE([ENABLE_REGEX], 1, [Define when regex support is enabled.])
|
||||||
fi
|
fi
|
||||||
|
|
||||||
if test "$enable_tmpnam" = yes; then
|
|
||||||
AC_DEFINE([ENABLE_TMPNAM], 1, [Define when tmpnam support is enabled.])
|
|
||||||
fi
|
|
||||||
|
|
||||||
AC_REPLACE_FUNCS([strerror memmove])
|
AC_REPLACE_FUNCS([strerror memmove])
|
||||||
|
|
||||||
# Reasons for testing:
|
# Reasons for testing:
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
@c -*-texinfo-*-
|
@c -*-texinfo-*-
|
||||||
@c This is part of the GNU Guile Reference Manual.
|
@c This is part of the GNU Guile Reference Manual.
|
||||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
|
@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 Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
|
||||||
@c See the file guile.texi for copying conditions.
|
@c See the file guile.texi for copying conditions.
|
||||||
|
|
||||||
|
|
@ -1070,24 +1070,6 @@ E.g.,
|
||||||
The return value is unspecified.
|
The return value is unspecified.
|
||||||
@end deffn
|
@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]
|
@deffn {Scheme Procedure} mkstemp tmpl [mode]
|
||||||
@cindex temporary file
|
@cindex temporary file
|
||||||
Create a new unique file in the file system and return a new buffered
|
Create a new unique file in the file system and return a new buffered
|
||||||
|
|
|
||||||
|
|
@ -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.
|
Free Software Foundation, Inc.
|
||||||
|
|
||||||
This file is part of Guile.
|
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;
|
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);
|
uint32_t mask = 1;
|
||||||
size_t len = BITVECTOR_LENGTH (vec);
|
for (size_t j = 0; j < 32 && j < len; j++, mask <<= 1)
|
||||||
size_t word_len = (len + 31) / 32;
|
res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
|
||||||
|
|
||||||
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);
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
return scm_reverse_x (res, SCM_EOL);
|
return scm_reverse_x (res, SCM_EOL);
|
||||||
|
|
|
||||||
|
|
@ -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.
|
Free Software Foundation, Inc.
|
||||||
|
|
||||||
This file is part of Guile.
|
This file is part of Guile.
|
||||||
|
|
@ -21,816 +21,15 @@
|
||||||
# include <config.h>
|
# include <config.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#include <stdio.h>
|
|
||||||
#include <string.h>
|
|
||||||
#include <unistd.h>
|
|
||||||
|
|
||||||
#define SCM_BUILDING_DEPRECATED_CODE
|
#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"
|
#include "deprecated.h"
|
||||||
|
|
||||||
#if (SCM_ENABLE_DEPRECATED == 1)
|
#if (SCM_ENABLE_DEPRECATED == 1)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
#ifndef MAXPATHLEN
|
/* Deprecated functions go here. */
|
||||||
#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;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -840,4 +39,4 @@ scm_i_init_deprecated ()
|
||||||
#include "deprecated.x"
|
#include "deprecated.x"
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif /* SCM_ENABLE_DEPRECATD == 1 */
|
#endif /* SCM_ENABLE_DEPRECATED == 1 */
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
#ifndef SCM_DEPRECATED_H
|
#ifndef SCM_DEPRECATED_H
|
||||||
#define 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.
|
Free Software Foundation, Inc.
|
||||||
|
|
||||||
This file is part of Guile.
|
This file is part of Guile.
|
||||||
|
|
@ -26,149 +26,6 @@
|
||||||
|
|
||||||
/* Deprecated declarations go here. */
|
/* 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);
|
void scm_i_init_deprecated (void);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
|
||||||
|
|
@ -82,10 +82,6 @@
|
||||||
#include "verify.h"
|
#include "verify.h"
|
||||||
#include "version.h"
|
#include "version.h"
|
||||||
|
|
||||||
#if (SCM_ENABLE_DEPRECATED == 1)
|
|
||||||
#include "deprecation.h"
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#include "posix.h"
|
#include "posix.h"
|
||||||
|
|
||||||
#if HAVE_SYS_WAIT_H
|
#if HAVE_SYS_WAIT_H
|
||||||
|
|
@ -1778,37 +1774,6 @@ SCM_DEFINE (scm_environ, "environ", 0, 1, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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,
|
SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0,
|
||||||
(void),
|
(void),
|
||||||
"Return an input/output port to a unique temporary file\n"
|
"Return an input/output port to a unique temporary file\n"
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
#ifndef SCM_POSIX_H
|
#ifndef SCM_POSIX_H
|
||||||
#define 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.
|
Free Software Foundation, Inc.
|
||||||
|
|
||||||
This file is part of Guile.
|
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_fork (void);
|
||||||
SCM_API SCM scm_uname (void);
|
SCM_API SCM scm_uname (void);
|
||||||
SCM_API SCM scm_environ (SCM env);
|
SCM_API SCM scm_environ (SCM env);
|
||||||
SCM_API SCM scm_tmpnam (void);
|
|
||||||
SCM_API SCM scm_tmpfile (void);
|
SCM_API SCM scm_tmpfile (void);
|
||||||
SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
|
SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
|
||||||
SCM_API SCM scm_close_pipe (SCM port);
|
SCM_API SCM scm_close_pipe (SCM port);
|
||||||
|
|
|
||||||
|
|
@ -181,12 +181,6 @@ scm_is_valid_vtable_layout (SCM layout)
|
||||||
case 'w':
|
case 'w':
|
||||||
case 'h':
|
case 'h':
|
||||||
break;
|
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:
|
default:
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -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.
|
Free Software Foundation, Inc.
|
||||||
|
|
||||||
This file is part of Guile.
|
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
|
#define FUNC_NAME s_scm_vector_copy_partial
|
||||||
{
|
{
|
||||||
SCM result;
|
SCM result;
|
||||||
if (SCM_I_IS_VECTOR (vec))
|
|
||||||
{
|
SCM_VALIDATE_VECTOR (1, vec);
|
||||||
size_t cstart = 0, cend = SCM_I_VECTOR_LENGTH (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))
|
|
||||||
{
|
|
||||||
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;
|
cstart = scm_to_size_t (start);
|
||||||
size_t i, len;
|
SCM_ASSERT_RANGE (SCM_ARG2, start, cstart<=cend);
|
||||||
ssize_t inc;
|
|
||||||
const SCM *src;
|
|
||||||
SCM *dst;
|
|
||||||
|
|
||||||
src = scm_vector_elements (vec, &handle, &len, &inc);
|
if (!SCM_UNBNDP (end))
|
||||||
scm_c_issue_deprecation_warning
|
{
|
||||||
("Using vector-copy on arrays is deprecated. "
|
size_t e = scm_to_size_t (end);
|
||||||
"Use array-copy instead.");
|
SCM_ASSERT_RANGE (SCM_ARG3, end, e>=cstart && e<=cend);
|
||||||
|
cend = e;
|
||||||
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;
|
return result;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
@ -377,32 +353,13 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
|
||||||
{
|
{
|
||||||
SCM res = SCM_EOL;
|
SCM res = SCM_EOL;
|
||||||
|
|
||||||
if (SCM_I_IS_VECTOR (vec))
|
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);
|
|
||||||
}
|
|
||||||
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);
|
ssize_t len = SCM_I_VECTOR_LENGTH (vec);
|
||||||
scm_c_issue_deprecation_warning
|
const SCM * data = SCM_I_VECTOR_ELTS (vec);
|
||||||
("Using vector->list on arrays is deprecated. "
|
for (ssize_t i = len-1; i >= 0; --i)
|
||||||
"Use array->list instead.");
|
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;
|
return res;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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}.")
|
"@var{start1} is greater than @var{start2}.")
|
||||||
#define FUNC_NAME s_scm_vector_move_left_x
|
#define FUNC_NAME s_scm_vector_move_left_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;
|
SCM_VALIDATE_MUTABLE_VECTOR (1, vec2);
|
||||||
i = scm_to_unsigned_integer (start1, 0, len1);
|
const SCM *elts1 = SCM_I_VECTOR_ELTS (vec1);
|
||||||
e = scm_to_unsigned_integer (end1, i, len1);
|
SCM *elts2 = SCM_I_VECTOR_WELTS (vec2);
|
||||||
SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
|
size_t len1 = SCM_I_VECTOR_LENGTH (vec1);
|
||||||
j = scm_to_unsigned_integer (start2, 0, len2);
|
size_t len2 = SCM_I_VECTOR_LENGTH (vec2);
|
||||||
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);
|
size_t i, j, e;
|
||||||
elts2 = scm_vector_writable_elements (vec2, &handle2, &len2, &inc2);
|
i = scm_to_unsigned_integer (start1, 0, len1);
|
||||||
scm_c_issue_deprecation_warning
|
e = scm_to_unsigned_integer (end1, i, len1);
|
||||||
("Using vector-move-left! on arrays is deprecated. "
|
SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) <= len2);
|
||||||
"Use array-copy-in-order! instead.");
|
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;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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}.")
|
"@var{start1} is less than @var{start2}.")
|
||||||
#define FUNC_NAME s_scm_vector_move_right_x
|
#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);
|
--e;
|
||||||
const SCM *elts1 = SCM_I_VECTOR_ELTS (vec1);
|
--j;
|
||||||
SCM *elts2 = SCM_I_VECTOR_WELTS (vec2);
|
elts2[j] = elts1[e];
|
||||||
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);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
;;;; vectors.test --- test suite for Guile's vector functions -*- scheme -*-
|
;;;; 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
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
|
@ -50,11 +50,7 @@
|
||||||
|
|
||||||
(pass-if "string-vector 2"
|
(pass-if "string-vector 2"
|
||||||
(equal? '("abc\u0100" "def\u0101" "ghi\u0102")
|
(equal? '("abc\u0100" "def\u0101" "ghi\u0102")
|
||||||
(vector->list #("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))))))
|
|
||||||
|
|
||||||
(with-test-prefix "make-vector"
|
(with-test-prefix "make-vector"
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue