summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <lloda@sarc.name>2021-08-16 16:38:28 +0200
committerDaniel Llorens <lloda@sarc.name>2021-08-16 17:00:03 +0200
commitc60601332e8f328b014ac09ebd9b0e1c562f9238 (patch)
treeda8e81a62a6b204be73a87719d121c99300517fd
parentc2cf685b65ee652600ecd914d86e8a00e750b4da (diff)
downloadguile-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.c57
-rw-r--r--libguile/arrays.h3
-rw-r--r--libguile/deprecated.c68
-rw-r--r--libguile/deprecated.h3
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