mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 04:10:18 +02:00
bytevectors provide scm_i_native_endianness to the vm
* libguile/bytevectors.h (scm_i_native_endianness): Allow the VM to use scm_i_native_endianness, but still keep it marked as internal. * libguile/bytevectors.c: Adjust to use scm_i_native_endianness instead of native_endianness. Define it at bootstrap time.
This commit is contained in:
parent
5fa2deb3f7
commit
caa92f5e95
2 changed files with 34 additions and 31 deletions
|
@ -88,22 +88,22 @@
|
||||||
scm_out_of_range (FUNC_NAME, index);
|
scm_out_of_range (FUNC_NAME, index);
|
||||||
|
|
||||||
/* Template for fixed-size integer access (only 8, 16 or 32-bit). */
|
/* Template for fixed-size integer access (only 8, 16 or 32-bit). */
|
||||||
#define INTEGER_REF(_len, _sign) \
|
#define INTEGER_REF(_len, _sign) \
|
||||||
SCM result; \
|
SCM result; \
|
||||||
\
|
\
|
||||||
INTEGER_ACCESSOR_PROLOGUE (_len, _sign); \
|
INTEGER_ACCESSOR_PROLOGUE (_len, _sign); \
|
||||||
SCM_VALIDATE_SYMBOL (3, endianness); \
|
SCM_VALIDATE_SYMBOL (3, endianness); \
|
||||||
\
|
\
|
||||||
{ \
|
{ \
|
||||||
INT_TYPE (_len, _sign) c_result; \
|
INT_TYPE (_len, _sign) c_result; \
|
||||||
\
|
\
|
||||||
memcpy (&c_result, &c_bv[c_index], (_len) / 8); \
|
memcpy (&c_result, &c_bv[c_index], (_len) / 8); \
|
||||||
if (!scm_is_eq (endianness, native_endianness)) \
|
if (!scm_is_eq (endianness, scm_i_native_endianness)) \
|
||||||
c_result = INT_SWAP (_len) (c_result); \
|
c_result = INT_SWAP (_len) (c_result); \
|
||||||
\
|
\
|
||||||
result = SCM_I_MAKINUM (c_result); \
|
result = SCM_I_MAKINUM (c_result); \
|
||||||
} \
|
} \
|
||||||
\
|
\
|
||||||
return result;
|
return result;
|
||||||
|
|
||||||
/* Template for fixed-size integer access using the native endianness. */
|
/* Template for fixed-size integer access using the native endianness. */
|
||||||
|
@ -138,7 +138,7 @@
|
||||||
scm_out_of_range (FUNC_NAME, value); \
|
scm_out_of_range (FUNC_NAME, value); \
|
||||||
\
|
\
|
||||||
c_value_short = (INT_TYPE (_len, _sign)) c_value; \
|
c_value_short = (INT_TYPE (_len, _sign)) c_value; \
|
||||||
if (!scm_is_eq (endianness, native_endianness)) \
|
if (!scm_is_eq (endianness, scm_i_native_endianness)) \
|
||||||
c_value_short = INT_SWAP (_len) (c_value_short); \
|
c_value_short = INT_SWAP (_len) (c_value_short); \
|
||||||
\
|
\
|
||||||
memcpy (&c_bv[c_index], &c_value_short, (_len) / 8); \
|
memcpy (&c_bv[c_index], &c_value_short, (_len) / 8); \
|
||||||
|
@ -398,7 +398,7 @@ SCM_SYMBOL (scm_sym_little, "little");
|
||||||
SCM scm_endianness_big, scm_endianness_little;
|
SCM scm_endianness_big, scm_endianness_little;
|
||||||
|
|
||||||
/* Host endianness (a symbol). */
|
/* Host endianness (a symbol). */
|
||||||
static SCM native_endianness = SCM_UNSPECIFIED;
|
SCM scm_i_native_endianness = SCM_UNSPECIFIED;
|
||||||
|
|
||||||
/* Byte-swapping. */
|
/* Byte-swapping. */
|
||||||
#ifndef bswap_24
|
#ifndef bswap_24
|
||||||
|
@ -414,7 +414,7 @@ SCM_DEFINE (scm_native_endianness, "native-endianness", 0, 0, 0,
|
||||||
"Return a symbol denoting the machine's native endianness.")
|
"Return a symbol denoting the machine's native endianness.")
|
||||||
#define FUNC_NAME s_scm_native_endianness
|
#define FUNC_NAME s_scm_native_endianness
|
||||||
{
|
{
|
||||||
return native_endianness;
|
return scm_i_native_endianness;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -868,7 +868,7 @@ bytevector_large_set (char *c_bv, size_t c_size, int signed_p,
|
||||||
int swap; \
|
int swap; \
|
||||||
_sign int value; \
|
_sign int value; \
|
||||||
\
|
\
|
||||||
swap = !scm_is_eq (endianness, native_endianness); \
|
swap = !scm_is_eq (endianness, scm_i_native_endianness); \
|
||||||
switch (c_size) \
|
switch (c_size) \
|
||||||
{ \
|
{ \
|
||||||
case 1: \
|
case 1: \
|
||||||
|
@ -943,7 +943,7 @@ bytevector_unsigned_ref (const char *c_bv, size_t c_size, SCM endianness)
|
||||||
int swap; \
|
int swap; \
|
||||||
INT_TYPE (16, _sign) c_value16; \
|
INT_TYPE (16, _sign) c_value16; \
|
||||||
\
|
\
|
||||||
swap = !scm_is_eq (endianness, native_endianness); \
|
swap = !scm_is_eq (endianness, scm_i_native_endianness); \
|
||||||
\
|
\
|
||||||
if (swap) \
|
if (swap) \
|
||||||
c_value16 = (INT_TYPE (16, _sign)) bswap_16 (c_value); \
|
c_value16 = (INT_TYPE (16, _sign)) bswap_16 (c_value); \
|
||||||
|
@ -1293,7 +1293,7 @@ SCM_DEFINE (scm_bytevector_s16_native_set_x, "bytevector-s16-native-set!",
|
||||||
#define LARGE_INTEGER_NATIVE_REF(_len, _sign) \
|
#define LARGE_INTEGER_NATIVE_REF(_len, _sign) \
|
||||||
INTEGER_ACCESSOR_PROLOGUE(_len, _sign); \
|
INTEGER_ACCESSOR_PROLOGUE(_len, _sign); \
|
||||||
return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8, \
|
return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8, \
|
||||||
SIGNEDNESS (_sign), native_endianness));
|
SIGNEDNESS (_sign), scm_i_native_endianness));
|
||||||
|
|
||||||
#define LARGE_INTEGER_NATIVE_SET(_len, _sign) \
|
#define LARGE_INTEGER_NATIVE_SET(_len, _sign) \
|
||||||
int err; \
|
int err; \
|
||||||
|
@ -1301,7 +1301,7 @@ SCM_DEFINE (scm_bytevector_s16_native_set_x, "bytevector-s16-native-set!",
|
||||||
\
|
\
|
||||||
err = bytevector_large_set ((char *) c_bv + c_index, _len / 8, \
|
err = bytevector_large_set ((char *) c_bv + c_index, _len / 8, \
|
||||||
SIGNEDNESS (_sign), value, \
|
SIGNEDNESS (_sign), value, \
|
||||||
native_endianness); \
|
scm_i_native_endianness); \
|
||||||
if (SCM_UNLIKELY (err)) \
|
if (SCM_UNLIKELY (err)) \
|
||||||
scm_out_of_range (FUNC_NAME, value); \
|
scm_out_of_range (FUNC_NAME, value); \
|
||||||
\
|
\
|
||||||
|
@ -1640,7 +1640,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
|
||||||
IEEE754_ACCESSOR_PROLOGUE (_type); \
|
IEEE754_ACCESSOR_PROLOGUE (_type); \
|
||||||
SCM_VALIDATE_SYMBOL (3, endianness); \
|
SCM_VALIDATE_SYMBOL (3, endianness); \
|
||||||
\
|
\
|
||||||
if (scm_is_eq (endianness, native_endianness)) \
|
if (scm_is_eq (endianness, scm_i_native_endianness)) \
|
||||||
memcpy (&c_result, &c_bv[c_index], sizeof (c_result)); \
|
memcpy (&c_result, &c_bv[c_index], sizeof (c_result)); \
|
||||||
else \
|
else \
|
||||||
{ \
|
{ \
|
||||||
|
@ -1669,7 +1669,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
|
||||||
SCM_VALIDATE_SYMBOL (4, endianness); \
|
SCM_VALIDATE_SYMBOL (4, endianness); \
|
||||||
c_value = IEEE754_FROM_SCM (_type) (value); \
|
c_value = IEEE754_FROM_SCM (_type) (value); \
|
||||||
\
|
\
|
||||||
if (scm_is_eq (endianness, native_endianness)) \
|
if (scm_is_eq (endianness, scm_i_native_endianness)) \
|
||||||
memcpy (&c_bv[c_index], &c_value, sizeof (c_value)); \
|
memcpy (&c_bv[c_index], &c_value, sizeof (c_value)); \
|
||||||
else \
|
else \
|
||||||
{ \
|
{ \
|
||||||
|
@ -2075,6 +2075,12 @@ scm_bootstrap_bytevectors (void)
|
||||||
scm_null_bytevector =
|
scm_null_bytevector =
|
||||||
scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
|
scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
|
||||||
|
|
||||||
|
#ifdef WORDS_BIGENDIAN
|
||||||
|
scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol ("big"));
|
||||||
|
#else
|
||||||
|
scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol ("little"));
|
||||||
|
#endif
|
||||||
|
|
||||||
scm_c_register_extension ("libguile", "scm_init_bytevectors",
|
scm_c_register_extension ("libguile", "scm_init_bytevectors",
|
||||||
(scm_t_extension_init_func) scm_init_bytevectors,
|
(scm_t_extension_init_func) scm_init_bytevectors,
|
||||||
NULL);
|
NULL);
|
||||||
|
@ -2085,12 +2091,6 @@ scm_init_bytevectors (void)
|
||||||
{
|
{
|
||||||
#include "libguile/bytevectors.x"
|
#include "libguile/bytevectors.x"
|
||||||
|
|
||||||
#ifdef WORDS_BIGENDIAN
|
|
||||||
native_endianness = scm_sym_big;
|
|
||||||
#else
|
|
||||||
native_endianness = scm_sym_little;
|
|
||||||
#endif
|
|
||||||
|
|
||||||
scm_endianness_big = scm_sym_big;
|
scm_endianness_big = scm_sym_big;
|
||||||
scm_endianness_little = scm_sym_little;
|
scm_endianness_little = scm_sym_little;
|
||||||
}
|
}
|
||||||
|
|
|
@ -116,6 +116,8 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
|
||||||
i.e., without allocating memory beside the SMOB itself (a double cell).
|
i.e., without allocating memory beside the SMOB itself (a double cell).
|
||||||
This optimization is necessary since small bytevectors are expected to be
|
This optimization is necessary since small bytevectors are expected to be
|
||||||
common. */
|
common. */
|
||||||
|
#define SCM_BYTEVECTOR_P(_bv) \
|
||||||
|
SCM_SMOB_PREDICATE (scm_tc16_bytevector, _bv)
|
||||||
#define SCM_BYTEVECTOR_INLINE_THRESHOLD (2 * sizeof (SCM))
|
#define SCM_BYTEVECTOR_INLINE_THRESHOLD (2 * sizeof (SCM))
|
||||||
#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size) \
|
#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size) \
|
||||||
((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
|
((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
|
||||||
|
@ -129,6 +131,7 @@ SCM_INTERNAL void scm_bootstrap_bytevectors (void);
|
||||||
SCM_INTERNAL void scm_init_bytevectors (void);
|
SCM_INTERNAL void scm_init_bytevectors (void);
|
||||||
|
|
||||||
SCM_INTERNAL scm_t_bits scm_tc16_bytevector;
|
SCM_INTERNAL scm_t_bits scm_tc16_bytevector;
|
||||||
|
SCM_INTERNAL SCM scm_i_native_endianness;
|
||||||
SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, size_t);
|
SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, size_t);
|
||||||
|
|
||||||
#define scm_c_shrink_bytevector(_bv, _len) \
|
#define scm_c_shrink_bytevector(_bv, _len) \
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue