mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Deprecate scm_from_contiguous_typed_array

Browse source 
This was never documented and it's not used in Guile itself, either.
This commit is contained in:
Daniel Llorens 2021-08-16 16:38:28 +02:00
parent c2cf685b65
commit c60601332e
4 changed files with 71 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

57
libguile/arrays.c
View file

@ -590,63 +590,6 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
}
#undef FUNC_NAME
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;
ra = scm_i_shap2ra (bounds);
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
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_DEFINE (scm_make_array, "make-array", 1, 0, 1,
(SCM fill, SCM bounds),

3
libguile/arrays.h
View file

@ -42,9 +42,6 @@
SCM_API SCM scm_make_array (SCM fill, SCM bounds);
SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
const void *bytes,
size_t byte_len);
SCM_API SCM scm_shared_array_root (SCM ra);
SCM_API SCM scm_shared_array_offset (SCM ra);

68
libguile/deprecated.c
View file

@ -28,12 +28,15 @@
#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 "generalized-vectors.h"
#include "gc.h"
#include "gsubr.h"
#include "modules.h"
@ -42,6 +45,7 @@
#include "srfi-4.h"
#include "strings.h"
#include "symbols.h"
#include "uniform.h"
#include "vectors.h"
#include "deprecated.h"
@ -586,6 +590,70 @@ scm_istr2bve (SCM 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);
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
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

3
libguile/deprecated.h
View file

@ -131,6 +131,9 @@ 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