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

Move uniform-array->bytevector from (rnrs bytevectors) to core

Browse source 
This is to have arrays use bytevectors and not the other way
around. Besides, it's not an RnRS function.
This commit is contained in:
Daniel Llorens 2020-02-11 12:40:21 +01:00
parent edf9abb4a0
commit 3b6a2f281a
9 changed files with 156 additions and 147 deletions
Download patch file Download diff file Expand all files Collapse all files

50
libguile/arrays.c
View file

@ -27,6 +27,7 @@
#include <stdio.h>
#include <errno.h>
#include <string.h>
#include <assert.h>
#include "array-map.h"
#include "bitvectors.h"
@ -1272,6 +1273,55 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
return d;
}
// -----------------------------------------------
// other functions
// -----------------------------------------------
SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
1, 0, 0, (SCM array),
"Return a newly allocated bytevector whose contents\n"
"will be copied from the uniform array @var{array}.")
#define FUNC_NAME s_scm_uniform_array_to_bytevector
{
SCM contents, ret;
size_t len, sz, byte_len;
scm_t_array_handle h;
const void *elts;
contents = scm_array_contents (array, SCM_BOOL_T);
if (scm_is_false (contents))
scm_wrong_type_arg_msg (FUNC_NAME, 0, array, "uniform contiguous array");
scm_array_get_handle (contents, &h);
assert (h.base == 0);
elts = h.elements;
len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1);
sz = scm_array_handle_uniform_element_bit_size (&h);
if (sz >= 8 && ((sz % 8) == 0))
byte_len = len * (sz / 8);
else if (sz < 8)
/* Elements of sub-byte size (bitvectors) are addressed in 32-bit
units. */
byte_len = ((len * sz + 31) / 32) * 4;
else
/* an internal guile error, really */
SCM_MISC_ERROR ("uniform elements larger than 8 bits must fill whole bytes", SCM_EOL);
ret = scm_c_make_bytevector (byte_len);
if (byte_len != 0)
/* Empty arrays may have elements == NULL. We must avoid passing
NULL to memcpy, even if the length is zero, to avoid undefined
behavior. */
memcpy (SCM_BYTEVECTOR_CONTENTS (ret), elts, byte_len);
scm_array_handle_release (&h);
return ret;
}
#undef FUNC_NAME
/* ---------------------- */
/* Init hook */

1
libguile/arrays.h
View file

@ -66,6 +66,7 @@ SCM_API void scm_c_array_set_2_x (SCM v, SCM obj, ssize_t idx0, ssize_t idx1);
SCM_API SCM scm_array_ref (SCM v, SCM args);
SCM_API SCM scm_array_set_x (SCM v, SCM obj, SCM args);
SCM_API SCM scm_array_to_list (SCM v);
SCM_API SCM scm_uniform_array_to_bytevector (SCM a);
SCM_API SCM scm_make_array (SCM fill, SCM bounds);
SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);

45
libguile/bytevectors.c
View file

@ -33,7 +33,6 @@
#include <unistr.h>
#include <string.h>
#include <alloca.h>
#include <assert.h>
#include <gmp.h>
@ -647,50 +646,6 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
1, 0, 0, (SCM array),
"Return a newly allocated bytevector whose contents\n"
"will be copied from the uniform array @var{array}.")
#define FUNC_NAME s_scm_uniform_array_to_bytevector
{
SCM contents, ret;
size_t len, sz, byte_len;
scm_t_array_handle h;
const void *elts;
contents = scm_array_contents (array, SCM_BOOL_T);
if (scm_is_false (contents))
scm_wrong_type_arg_msg (FUNC_NAME, 0, array, "uniform contiguous array");
scm_array_get_handle (contents, &h);
assert (h.base == 0);
elts = h.elements;
len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1);
sz = scm_array_handle_uniform_element_bit_size (&h);
if (sz >= 8 && ((sz % 8) == 0))
byte_len = len * (sz / 8);
else if (sz < 8)
/* Elements of sub-byte size (bitvectors) are addressed in 32-bit
units. */
byte_len = ((len * sz + 31) / 32) * 4;
else
/* an internal guile error, really */
SCM_MISC_ERROR ("uniform elements larger than 8 bits must fill whole bytes", SCM_EOL);
ret = make_bytevector (byte_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
if (byte_len != 0)
/* Empty arrays may have elements == NULL. We must avoid passing
NULL to memcpy, even if the length is zero, to avoid undefined
behavior. */
memcpy (SCM_BYTEVECTOR_CONTENTS (ret), elts, byte_len);
scm_array_handle_release (&h);
return ret;
}
#undef FUNC_NAME
/* Operations on bytes and octets. */

2
libguile/bytevectors.h
View file

@ -60,8 +60,6 @@ SCM_API SCM scm_bytevector_fill_x (SCM, SCM);
SCM_API SCM scm_bytevector_copy_x (SCM, SCM, SCM, SCM, SCM);
SCM_API SCM scm_bytevector_copy (SCM);
SCM_API SCM scm_uniform_array_to_bytevector (SCM);
SCM_API SCM scm_bytevector_to_u8_list (SCM);
SCM_API SCM scm_u8_list_to_bytevector (SCM);
SCM_API SCM scm_uint_list_to_bytevector (SCM, SCM, SCM);