diff options
author | Daniel Llorens <lloda@sarc.name> | 2021-08-16 16:38:28 +0200 |
---|---|---|
committer | Daniel Llorens <lloda@sarc.name> | 2021-08-16 17:00:03 +0200 |
commit | c60601332e8f328b014ac09ebd9b0e1c562f9238 (patch) | |
tree | da8e81a62a6b204be73a87719d121c99300517fd | |
parent | c2cf685b65ee652600ecd914d86e8a00e750b4da (diff) | |
download | guile-c60601332e8f328b014ac09ebd9b0e1c562f9238.tar.gz |
Deprecate scm_from_contiguous_typed_array
This was never documented and it's not used in Guile itself, either.
-rw-r--r-- | libguile/arrays.c | 57 | ||||
-rw-r--r-- | libguile/arrays.h | 3 | ||||
-rw-r--r-- | libguile/deprecated.c | 68 | ||||
-rw-r--r-- | libguile/deprecated.h | 3 |
4 files changed, 71 insertions, 60 deletions
diff --git a/libguile/arrays.c b/libguile/arrays.c index 1c81a14c1..f4eddd90a 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -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), diff --git a/libguile/arrays.h b/libguile/arrays.h index 8cc84c2b1..494645d72 100644 --- a/libguile/arrays.h +++ b/libguile/arrays.h @@ -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); diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 57cb037d2..7ec08ec50 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -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 diff --git a/libguile/deprecated.h b/libguile/deprecated.h index bd0fae9d5..a062cbecb 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -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 |