From 807e5a6641b2aa37ce4198a6c13f1aaebd3a5f25 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 30 Aug 2009 20:12:09 +0200 Subject: [PATCH] Use a TC7 tag instead of a SMOB for bytevectors. * libguile/bytevectors.c (scm_tc16_bytevector): Remove. (SCM_BYTEVECTOR_SET_LENGTH, SCM_BYTEVECTOR_SET_CONTENTS, SCM_BYTEVECTOR_SET_INLINE, SCM_BYTEVECTOR_SET_ELEMENT_TYPE, make_bytevector_from_buffer, scm_is_bytevector, scm_bootstrap_bytevectors): Adjust to the SMOB->tc7 change. (scm_i_print_bytevector): New, formerly `print_bytevector ()'. (bytevector_equal_p): Remove. * libguile/bytevectors.h (SCM_BYTEVECTOR_LENGTH, SCM_BYTEVECTOR_CONTENTS, SCM_BYTEVECTOR_P): Adjust to SMOB->tc7 change. (SCM_BYTEVECTOR_FLAGS, SCM_SET_BYTEVECTOR_FLAGS): New macros. (scm_tc16_bytevector): Remove declaration. (scm_i_print_bytevector): New declaration. * libguile/eq.c (scm_equal_p): Handle `scm_tc7_bytevector'. * libguile/evalext.c (scm_self_evaluating_p): Likewise. * libguile/print.c (iprin1): Likewise. * libguile/tags.h (scm_tc7_bytevector): New. (scm_tc7_unused_8): Remove. * libguile/validate.h (SCM_VALIDATE_BYTEVECTOR): Adjust. * test-suite/tests/bytevectors.test ("Datum Syntax")["self-evaluating?"]: New test. --- libguile/bytevectors.c | 61 +++++++++++++++---------------- libguile/bytevectors.h | 29 ++++++++------- libguile/eq.c | 3 ++ libguile/evalext.c | 1 + libguile/print.c | 3 ++ libguile/tags.h | 2 +- libguile/validate.h | 5 ++- test-suite/tests/bytevectors.test | 3 ++ 8 files changed, 59 insertions(+), 48 deletions(-) diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index b2e5ec9b0..5a0ae501b 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -175,19 +175,27 @@ /* Bytevector type. */ -scm_t_bits scm_tc16_bytevector; - +/* The threshold (in octets) under which bytevectors are stored "in-line", + i.e., without allocating memory beside the double cell itself. + This optimization is necessary since small bytevectors are expected to be + common. */ #define SCM_BYTEVECTOR_INLINE_THRESHOLD (2 * sizeof (SCM)) + #define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size) \ ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD) #define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \ - SCM_SET_SMOB_DATA ((_bv), (scm_t_bits) (_len)) + SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len)) #define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf) \ - SCM_SET_SMOB_DATA_2 ((_bv), (scm_t_bits) (_buf)) -#define SCM_BYTEVECTOR_SET_INLINE(bv) \ - SCM_SET_SMOB_FLAGS (bv, SCM_SMOB_FLAGS (bv) | SCM_F_BYTEVECTOR_INLINE) -#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint) \ - SCM_SET_SMOB_FLAGS (bv, (SCM_SMOB_FLAGS (bv) & 0xFF) | (hint << 8)) + SCM_SET_CELL_WORD_2 ((_bv), (scm_t_bits) (_buf)) +#define SCM_BYTEVECTOR_SET_INLINE(bv) \ + SCM_SET_BYTEVECTOR_FLAGS (bv, \ + SCM_BYTEVECTOR_FLAGS (bv) \ + | SCM_F_BYTEVECTOR_INLINE) + +#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint) \ + SCM_SET_BYTEVECTOR_FLAGS (bv, \ + (SCM_BYTEVECTOR_FLAGS (bv) & SCM_F_BYTEVECTOR_INLINE) \ + | ((hint) << 1UL)) #define SCM_BYTEVECTOR_TYPE_SIZE(var) \ (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8) #define SCM_BYTEVECTOR_TYPED_LENGTH(var) \ @@ -213,10 +221,11 @@ make_bytevector_from_buffer (size_t len, void *contents, c_len = len * (scm_i_array_element_type_sizes[element_type] / 8); if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len)) - SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, contents); + ret = scm_double_cell (scm_tc7_bytevector, (scm_t_bits) c_len, + (scm_t_bits) contents, 0); else { - SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL); + ret = scm_double_cell (scm_tc7_bytevector, (scm_t_bits) c_len, 0, 0); SCM_BYTEVECTOR_SET_INLINE (ret); if (contents) { @@ -246,7 +255,7 @@ make_bytevector (size_t len, scm_t_array_element_type element_type) if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len)) { SCM ret; - SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL); + ret = scm_double_cell (scm_tc7_bytevector, (scm_t_bits) c_len, 0, 0); SCM_BYTEVECTOR_SET_INLINE (ret); SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type); return ret; @@ -331,7 +340,7 @@ scm_i_shrink_bytevector (SCM bv, size_t c_new_len) int scm_is_bytevector (SCM obj) { - return SCM_SMOB_PREDICATE (scm_tc16_bytevector, obj); + return SCM_BYTEVECTOR_P (obj); } size_t @@ -384,10 +393,8 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value) - - -static int -print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED) +int +scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED) { ssize_t ubnd, inc, i; scm_t_array_handle h; @@ -409,12 +416,6 @@ print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED) return 1; } -static SCM -bytevector_equal_p (SCM bv1, SCM bv2) -{ - return scm_bytevector_eq_p (bv1, bv2); -} - /* General operations. */ @@ -2237,13 +2238,9 @@ bytevector_get_handle (SCM v, scm_t_array_handle *h) void scm_bootstrap_bytevectors (void) { - /* The SMOB type must be instantiated here because the - generalized-vector API may want to access bytevectors even though - `(rnrs bytevector)' hasn't been loaded. */ - scm_tc16_bytevector = scm_make_smob_type ("bytevector", 0); - scm_set_smob_print (scm_tc16_bytevector, print_bytevector); - scm_set_smob_equalp (scm_tc16_bytevector, bytevector_equal_p); - + /* This must be instantiated here because the generalized-vector API may + want to access bytevectors even though `(rnrs bytevector)' hasn't been + loaded. */ scm_null_bytevector = scm_gc_protect_object (make_bytevector_from_buffer (0, NULL, SCM_ARRAY_ELEMENT_TYPE_VU8)); @@ -2260,9 +2257,9 @@ scm_bootstrap_bytevectors (void) { scm_t_array_implementation impl; - - impl.tag = scm_tc16_bytevector; - impl.mask = 0xffff; + + impl.tag = scm_tc7_bytevector; + impl.mask = 0x7f; impl.vref = bv_handle_ref; impl.vset = bv_handle_set_x; impl.get_handle = bytevector_get_handle; diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h index e29fe6d11..e3296500f 100644 --- a/libguile/bytevectors.h +++ b/libguile/bytevectors.h @@ -27,11 +27,11 @@ /* R6RS bytevectors. */ #define SCM_BYTEVECTOR_LENGTH(_bv) \ - ((size_t) SCM_SMOB_DATA (_bv)) -#define SCM_BYTEVECTOR_CONTENTS(_bv) \ + ((size_t) SCM_CELL_WORD_1 (_bv)) +#define SCM_BYTEVECTOR_CONTENTS(_bv) \ (SCM_BYTEVECTOR_INLINE_P (_bv) \ - ? (signed char *) SCM_SMOB_OBJECT_2_LOC (_bv) \ - : (signed char *) SCM_SMOB_DATA_2 (_bv)) + ? (signed char *) SCM_CELL_OBJECT_LOC ((_bv), 2) \ + : (signed char *) SCM_CELL_WORD_2 (_bv)) SCM_API SCM scm_endianness_big; @@ -112,17 +112,18 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM); /* Internal API. */ -/* The threshold (in octets) under which bytevectors are stored "in-line", - i.e., without allocating memory beside the SMOB itself (a double cell). - This optimization is necessary since small bytevectors are expected to be - common. */ -#define SCM_BYTEVECTOR_P(_bv) \ - SCM_SMOB_PREDICATE (scm_tc16_bytevector, _bv) +#define SCM_BYTEVECTOR_P(x) \ + (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_bytevector) +#define SCM_BYTEVECTOR_FLAGS(_bv) \ + (SCM_CELL_TYPE (_bv) >> 7UL) +#define SCM_SET_BYTEVECTOR_FLAGS(_bv, _f) \ + SCM_SET_CELL_TYPE ((_bv), scm_tc7_bytevector | ((_f) << 7UL)) + #define SCM_F_BYTEVECTOR_INLINE 0x1 #define SCM_BYTEVECTOR_INLINE_P(_bv) \ - (SCM_SMOB_FLAGS (_bv) & SCM_F_BYTEVECTOR_INLINE) + (SCM_BYTEVECTOR_FLAGS (_bv) & SCM_F_BYTEVECTOR_INLINE) #define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv) \ - (SCM_SMOB_FLAGS (_bv) >> 8) + (SCM_BYTEVECTOR_FLAGS (_bv) >> 1UL) /* Hint that is passed to `scm_gc_malloc ()' and friends. */ #define SCM_GC_BYTEVECTOR "bytevector" @@ -134,10 +135,12 @@ SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t, SCM_INTERNAL void scm_bootstrap_bytevectors (void); SCM_INTERNAL void scm_init_bytevectors (void); -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 int scm_i_print_bytevector (SCM, SCM, scm_print_state *); + + #define scm_c_shrink_bytevector(_bv, _len) \ (SCM_BYTEVECTOR_INLINE_P (_bv) \ ? (_bv) \ diff --git a/libguile/eq.c b/libguile/eq.c index 11dee2793..fadd75620 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -30,6 +30,7 @@ #include "libguile/smob.h" #include "libguile/arrays.h" #include "libguile/vectors.h" +#include "libguile/bytevectors.h" #include "libguile/struct.h" #include "libguile/goops.h" @@ -239,6 +240,8 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, } if (SCM_TYP7 (x) == scm_tc7_string && SCM_TYP7 (y) == scm_tc7_string) return scm_string_equal_p (x, y); + if (SCM_TYP7 (x) == scm_tc7_bytevector && SCM_TYP7 (y) == scm_tc7_bytevector) + return scm_bytevector_eq_p (x, y); if (SCM_TYP7 (x) == scm_tc7_smob && SCM_TYP16 (x) == SCM_TYP16 (y)) { int i = SCM_SMOBNUM (x); diff --git a/libguile/evalext.c b/libguile/evalext.c index b1f185cc5..78b666f65 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -83,6 +83,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0, case scm_tc7_smob: case scm_tc7_pws: case scm_tc7_program: + case scm_tc7_bytevector: case scm_tcs_subrs: case scm_tcs_struct: return SCM_BOOL_T; diff --git a/libguile/print.c b/libguile/print.c index c38eba76e..3bb6cb167 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -739,6 +739,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) scm_puts ("#w(", port); goto common_vector_printer; + case scm_tc7_bytevector: + scm_i_print_bytevector (exp, port, pstate); + break; case scm_tc7_vector: ENTER_NESTED_DATA (pstate, exp, circref); scm_puts ("#(", port); diff --git a/libguile/tags.h b/libguile/tags.h index e51b865cd..9a520937d 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -434,6 +434,7 @@ typedef unsigned long scm_t_bits; #define scm_tc7_string 21 #define scm_tc7_number 23 #define scm_tc7_stringbuf 39 +#define scm_tc7_bytevector 77 /* Many of the following should be turned * into structs or smobs. We need back some @@ -448,7 +449,6 @@ typedef unsigned long scm_t_bits; #define scm_tc7_unused_5 53 #define scm_tc7_unused_6 55 #define scm_tc7_unused_7 71 -#define scm_tc7_unused_8 77 #define scm_tc7_dsubr 61 #define scm_tc7_gsubr 63 diff --git a/libguile/validate.h b/libguile/validate.h index b48bec758..8c7946902 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -151,8 +151,9 @@ cvar = scm_to_bool (flag); \ } while (0) -#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj) \ - SCM_VALIDATE_SMOB ((_pos), (_obj), bytevector) +#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj) \ + SCM_ASSERT_TYPE (SCM_BYTEVECTOR_P (_obj), (_obj), (_pos), \ + FUNC_NAME, "bytevector") #define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CHARP, "character") diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test index 8b336bb5b..1009fb051 100644 --- a/test-suite/tests/bytevectors.test +++ b/test-suite/tests/bytevectors.test @@ -565,6 +565,9 @@ (equal? (with-input-from-string "#vu8(0 255 127 128)" read) (u8-list->bytevector '(0 255 127 128)))) + (pass-if "self-evaluating?" + (self-evaluating? (make-bytevector 1))) + (pass-if "self-evaluating" (equal? (eval (with-input-from-string "#vu8(1 2 3 4 5)" read) (current-module)) -- 2.20.1