From 2cf00efc1b0db0ddc26fa14239026dd2d12c7d59 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 13 Nov 2013 18:39:28 -0800 Subject: [PATCH] Simplify, port and tune bool vector implementation. * configure.ac (BITSIZEOF_SIZE_T, SIZEOF_SIZE_T): Remove. * src/alloc.c (bool_vector_exact_payload_bytes) (bool_vector_payload_bytes): Remove. (bool_vector_fill): Return its argument. * src/alloc.c (bool_vector_fill): * src/lread.c (read1): * src/print.c (print_object): Simplify by using bool_vector_bytes. * src/alloc.c (make_uninit_bool_vector): New function, broken out from Fmake_bool_vector. (Fmake_bool_vector): Use it. Use tail call. (make_uninit_bool_vector, vector_nbytes): Simplify size calculations. * src/data.c (BITS_PER_ULL): New constant. (ULLONG_MAX, count_one_bits_ll): Fall back on long counterparts if long long versions don't exist. (shift_right_ull): New function. (count_one_bits_word): New function, replacing popcount_bits_word macro. Don't assume that bits_word is no wider than long long. (count_one_bits_word, count_trailing_zero_bits): Don't assume that bits_word is no wider than long long. * src/data.c (bool_vector_binop_driver, bool_vector_not): * src/fns.c (Fcopy_sequence): * src/lread.c (read1): Create an uninitialized destination, to avoid needless work. (internal_equal): Simplify. (Ffillarray): Prefer tail call. * src/data.c (bool_vector_binop_driver): Don't assume bit vectors always contain at least one word. (bits_word_to_host_endian): Prefer if to #if. Don't assume chars are narrower than ints. * src/data.c (Fbool_vector_count_matches, Fbool_vector_count_matches_at): * src/fns.c (Fcopy_sequence): Simplify and tune. * src/lisp.h (bits_word, BITS_WORD_MAX, BITS_PER_BITS_WORD): Don't try to port to hosts where bits_word values have holes; the code wouldn't work there anyway. Verify this assumption, though. (bool_vector_bytes): New function. (make_uninit_bool_vector): New decl. (bool_vector_fill): Now returns Lisp_Object. --- ChangeLog | 5 ++ configure.ac | 2 - src/ChangeLog | 40 +++++++++++++ src/alloc.c | 87 +++++++++++++--------------- src/data.c | 155 ++++++++++++++++++++++++++++++-------------------- src/fns.c | 16 ++---- src/lisp.h | 24 +++++--- src/lread.c | 6 +- src/print.c | 3 +- 9 files changed, 201 insertions(+), 137 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5d2edb7e040..95c10ec22a6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2013-11-14 Paul Eggert + + Simplify, port and tune bool vector implementation. + * configure.ac (BITSIZEOF_SIZE_T, SIZEOF_SIZE_T): Remove. + 2013-11-13 Paul Eggert * Makefile.in (ACLOCAL_INPUTS): Add configure.ac. diff --git a/configure.ac b/configure.ac index 25634549443..a9baf608bf3 100644 --- a/configure.ac +++ b/configure.ac @@ -4720,8 +4720,6 @@ LIBS="$LIB_PTHREAD $pre_PKG_CONFIG_LIBS" gl_ASSERT_NO_GNULIB_POSIXCHECK gl_ASSERT_NO_GNULIB_TESTS gl_INIT -gl_STDINT_BITSIZEOF([size_t], [[#include ]]) -AC_CHECK_SIZEOF([size_t]) CFLAGS=$SAVE_CFLAGS LIBS=$SAVE_LIBS diff --git a/src/ChangeLog b/src/ChangeLog index 3861449cf5a..290b83a7ecf 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,45 @@ 2013-11-14 Paul Eggert + Simplify, port and tune bool vector implementation. + * alloc.c (bool_vector_exact_payload_bytes) + (bool_vector_payload_bytes): Remove. + (bool_vector_fill): Return its argument. + * alloc.c (bool_vector_fill): + * lread.c (read1): + * print.c (print_object): + Simplify by using bool_vector_bytes. + * alloc.c (make_uninit_bool_vector): + New function, broken out from Fmake_bool_vector. + (Fmake_bool_vector): Use it. Use tail call. + (make_uninit_bool_vector, vector_nbytes): Simplify size calculations. + * data.c (BITS_PER_ULL): New constant. + (ULLONG_MAX, count_one_bits_ll): Fall back on long counterparts + if long long versions don't exist. + (shift_right_ull): New function. + (count_one_bits_word): New function, replacing popcount_bits_word + macro. Don't assume that bits_word is no wider than long long. + (count_one_bits_word, count_trailing_zero_bits): + Don't assume that bits_word is no wider than long long. + * data.c (bool_vector_binop_driver, bool_vector_not): + * fns.c (Fcopy_sequence): + * lread.c (read1): + Create an uninitialized destination, to avoid needless work. + (internal_equal): Simplify. + (Ffillarray): Prefer tail call. + * data.c (bool_vector_binop_driver): Don't assume bit vectors always + contain at least one word. + (bits_word_to_host_endian): Prefer if to #if. Don't assume + chars are narrower than ints. + * data.c (Fbool_vector_count_matches, Fbool_vector_count_matches_at): + * fns.c (Fcopy_sequence): + Simplify and tune. + * lisp.h (bits_word, BITS_WORD_MAX, BITS_PER_BITS_WORD): + Don't try to port to hosts where bits_word values have holes; the + code wouldn't work there anyway. Verify this assumption, though. + (bool_vector_bytes): New function. + (make_uninit_bool_vector): New decl. + (bool_vector_fill): Now returns Lisp_Object. + * xfns.c (xic_create_fontsetname): * xrdb.c (gethomedir): Prefer tail calls. diff --git a/src/alloc.c b/src/alloc.c index bc5ed6d94bb..f12fdc5c861 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2041,26 +2041,10 @@ INIT must be an integer that represents a character. */) return val; } -static EMACS_INT -bool_vector_exact_payload_bytes (EMACS_INT nbits) -{ - eassume (0 <= nbits); - return (nbits + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR; -} - -static EMACS_INT -bool_vector_payload_bytes (EMACS_INT nbits) -{ - EMACS_INT exact_needed_bytes = bool_vector_exact_payload_bytes (nbits); +/* Fill A with 1 bits if INIT is non-nil, and with 0 bits otherwise. + Return A. */ - /* Always allocate at least one machine word of payload so that - bool-vector operations in data.c don't need a special case - for empty vectors. */ - return ROUNDUP (exact_needed_bytes + !exact_needed_bytes, - sizeof (bits_word)); -} - -void +Lisp_Object bool_vector_fill (Lisp_Object a, Lisp_Object init) { EMACS_INT nbits = bool_vector_size (a); @@ -2068,48 +2052,50 @@ bool_vector_fill (Lisp_Object a, Lisp_Object init) { unsigned char *data = bool_vector_uchar_data (a); int pattern = NILP (init) ? 0 : (1 << BOOL_VECTOR_BITS_PER_CHAR) - 1; - ptrdiff_t nbytes = ((nbits + BOOL_VECTOR_BITS_PER_CHAR - 1) - / BOOL_VECTOR_BITS_PER_CHAR); + ptrdiff_t nbytes = bool_vector_bytes (nbits); int last_mask = ~ (~0 << ((nbits - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)); memset (data, pattern, nbytes - 1); data[nbytes - 1] = pattern & last_mask; } + return a; } -DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, - doc: /* Return a new bool-vector of length LENGTH, using INIT for each element. -LENGTH must be a number. INIT matters only in whether it is t or nil. */) - (Lisp_Object length, Lisp_Object init) +/* Return a newly allocated, uninitialized bool vector of size NBITS. */ + +Lisp_Object +make_uninit_bool_vector (EMACS_INT nbits) { Lisp_Object val; struct Lisp_Bool_Vector *p; - EMACS_INT exact_payload_bytes, total_payload_bytes, needed_elements; - - CHECK_NATNUM (length); - - exact_payload_bytes = bool_vector_exact_payload_bytes (XFASTINT (length)); - total_payload_bytes = bool_vector_payload_bytes (XFASTINT (length)); - - needed_elements = ((bool_header_size - header_size + total_payload_bytes + EMACS_INT word_bytes, needed_elements; + word_bytes = bool_vector_words (nbits) * sizeof (bits_word); + needed_elements = ((bool_header_size - header_size + word_bytes + word_size - 1) / word_size); - p = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements); XSETVECTOR (val, p); XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0); - - p->size = XFASTINT (length); - bool_vector_fill (val, init); + p->size = nbits; /* Clear padding at the end. */ - eassume (exact_payload_bytes <= total_payload_bytes); - memset (bool_vector_uchar_data (val) + exact_payload_bytes, - 0, - total_payload_bytes - exact_payload_bytes); + if (nbits) + p->data[bool_vector_words (nbits) - 1] = 0; return val; } +DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, + doc: /* Return a new bool-vector of length LENGTH, using INIT for each element. +LENGTH must be a number. INIT matters only in whether it is t or nil. */) + (Lisp_Object length, Lisp_Object init) +{ + Lisp_Object val; + + CHECK_NATNUM (length); + val = make_uninit_bool_vector (XFASTINT (length)); + return bool_vector_fill (val, init); +} + /* Make a string from NBYTES bytes at CONTENTS, and compute the number of characters from the contents. This string may be unibyte or @@ -2858,24 +2844,27 @@ static ptrdiff_t vector_nbytes (struct Lisp_Vector *v) { ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG; + ptrdiff_t nwords; if (size & PSEUDOVECTOR_FLAG) { if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR)) { struct Lisp_Bool_Vector *bv = (struct Lisp_Bool_Vector *) v; - ptrdiff_t payload_bytes = bool_vector_payload_bytes (bv->size); - size = bool_header_size + payload_bytes; + ptrdiff_t word_bytes = (bool_vector_words (bv->size) + * sizeof (bits_word)); + ptrdiff_t boolvec_bytes = bool_header_size + word_bytes; + verify (header_size <= bool_header_size); + nwords = (boolvec_bytes - header_size + word_size - 1) / word_size; } else - size = (header_size - + ((size & PSEUDOVECTOR_SIZE_MASK) - + ((size & PSEUDOVECTOR_REST_MASK) - >> PSEUDOVECTOR_SIZE_BITS)) * word_size); + nwords = ((size & PSEUDOVECTOR_SIZE_MASK) + + ((size & PSEUDOVECTOR_REST_MASK) + >> PSEUDOVECTOR_SIZE_BITS)); } else - size = header_size + size * word_size; - return vroundup (size); + nwords = size; + return vroundup (header_size + word_size * nwords); } /* Release extra resources still in use by VECTOR, which may be any diff --git a/src/data.c b/src/data.c index 4043fbe279b..7ff7ac6b130 100644 --- a/src/data.c +++ b/src/data.c @@ -2962,9 +2962,7 @@ lowercase l) for small endian machines. */) /* Because we round up the bool vector allocate size to word_size units, we can safely read past the "end" of the vector in the - operations below. These extra bits are always zero. Also, we - always allocate bool vectors with at least one bits_word of storage so - that we don't have to special-case empty bit vectors. */ + operations below. These extra bits are always zero. */ static bits_word bool_vector_spare_mask (EMACS_INT nr_bits) @@ -2972,16 +2970,47 @@ bool_vector_spare_mask (EMACS_INT nr_bits) return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1; } -#if BITS_WORD_MAX <= UINT_MAX -# define popcount_bits_word count_one_bits -#elif BITS_WORD_MAX <= ULONG_MAX -# define popcount_bits_word count_one_bits_l -#elif BITS_WORD_MAX <= ULLONG_MAX -# define popcount_bits_word count_one_bits_ll +/* Info about unsigned long long, falling back on unsigned long + if unsigned long long is not available. */ + +#if HAVE_UNSIGNED_LONG_LONG_INT +enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long long) }; #else -# error "bits_word wider than long long? Please file a bug report." +enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long) }; +# define ULLONG_MAX ULONG_MAX +# define count_one_bits_ll count_one_bits_l #endif +/* Shift VAL right by the width of an unsigned long long. + BITS_PER_ULL must be less than BITS_PER_BITS_WORD. */ + +static bits_word +shift_right_ull (bits_word w) +{ + /* Pacify bogus GCC warning about shift count exceeding type width. */ + int shift = BITS_PER_ULL - BITS_PER_BITS_WORD < 0 ? BITS_PER_ULL : 0; + return w >> shift; +} + +/* Return the number of 1 bits in W. */ + +static int +count_one_bits_word (bits_word w) +{ + if (BITS_WORD_MAX <= UINT_MAX) + return count_one_bits (w); + else if (BITS_WORD_MAX <= ULONG_MAX) + return count_one_bits_l (w); + else + { + int i = 0, count = 0; + while (count += count_one_bits_ll (w), + BITS_PER_BITS_WORD <= (i += BITS_PER_ULL)) + w = shift_right_ull (w); + return count; + } +} + enum bool_vector_op { bool_vector_exclusive_or, bool_vector_union, bool_vector_intersection, @@ -2997,7 +3026,7 @@ bool_vector_binop_driver (Lisp_Object op1, EMACS_INT nr_bits; bits_word *adata, *bdata, *cdata; ptrdiff_t i; - bits_word changed = 0; + bool changed = 0; bits_word mword; ptrdiff_t nr_words; @@ -3010,7 +3039,7 @@ bool_vector_binop_driver (Lisp_Object op1, if (NILP (dest)) { - dest = Fmake_bool_vector (make_number (nr_bits), Qnil); + dest = make_uninit_bool_vector (nr_bits); changed = 1; } else @@ -3025,8 +3054,8 @@ bool_vector_binop_driver (Lisp_Object op1, adata = bool_vector_data (dest); bdata = bool_vector_data (op1); cdata = bool_vector_data (op2); - i = 0; - do + + for (i = 0; i < nr_words; i++) { if (op == bool_vector_exclusive_or) mword = bdata[i] ^ cdata[i]; @@ -3039,14 +3068,12 @@ bool_vector_binop_driver (Lisp_Object op1, else abort (); - changed |= adata[i] ^ mword; + if (! changed) + changed = adata[i] != mword; if (op != bool_vector_subsetp) adata[i] = mword; - - i++; } - while (i < nr_words); return changed ? dest : Qnil; } @@ -3060,27 +3087,33 @@ count_trailing_zero_bits (bits_word val) return count_trailing_zeros (val); if (BITS_WORD_MAX == ULONG_MAX) return count_trailing_zeros_l (val); -# if HAVE_UNSIGNED_LONG_LONG_INT if (BITS_WORD_MAX == ULLONG_MAX) return count_trailing_zeros_ll (val); -# endif /* The rest of this code is for the unlikely platform where bits_word differs in width from unsigned int, unsigned long, and unsigned long long. */ - if (val == 0) - return CHAR_BIT * sizeof (val); + val |= ~ BITS_WORD_MAX; if (BITS_WORD_MAX <= UINT_MAX) return count_trailing_zeros (val); if (BITS_WORD_MAX <= ULONG_MAX) return count_trailing_zeros_l (val); - { -# if HAVE_UNSIGNED_LONG_LONG_INT - verify (BITS_WORD_MAX <= ULLONG_MAX); - return count_trailing_zeros_ll (val); -# else - verify (BITS_WORD_MAX <= ULONG_MAX); -# endif - } + else + { + int count; + for (count = 0; + count < BITS_PER_BITS_WORD - BITS_PER_ULL; + count += BITS_PER_ULL) + { + if (val & ULLONG_MAX) + return count + count_trailing_zeros_ll (val); + val = shift_right_ull (val); + } + + if (BITS_PER_BITS_WORD % BITS_PER_ULL != 0 + && BITS_WORD_MAX == (bits_word) -1) + val |= (bits_word) 1 << (BITS_PER_BITS_WORD % BITS_PER_ULL); + return count + count_trailing_zeros_ll (val); + } } static bits_word @@ -3088,20 +3121,24 @@ bits_word_to_host_endian (bits_word val) { #ifndef WORDS_BIGENDIAN return val; -#elif BITS_WORD_MAX >> 31 == 1 - return bswap_32 (val); -#elif BITS_WORD_MAX >> 31 >> 31 >> 1 == 1 - return bswap_64 (val); #else - int i; - bits_word r = 0; - for (i = 0; i < sizeof val; i++) - { - r = ((r << 1 << (CHAR_BIT - 1)) - | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1))); - val = val >> 1 >> (CHAR_BIT - 1); - } - return r; + if (BITS_WORD_MAX >> 31 == 1) + return bswap_32 (val); +# if HAVE_UNSIGNED_LONG_LONG + if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1) + return bswap_64 (val); +# endif + { + int i; + bits_word r = 0; + for (i = 0; i < sizeof val; i++) + { + r = ((r << 1 << (CHAR_BIT - 1)) + | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1))); + val = val >> 1 >> (CHAR_BIT - 1); + } + return r; + } #endif } @@ -3174,7 +3211,7 @@ Return the destination vector. */) nr_bits = bool_vector_size (a); if (NILP (b)) - b = Fmake_bool_vector (make_number (nr_bits), Qnil); + b = make_uninit_bool_vector (nr_bits); else { CHECK_BOOL_VECTOR (b); @@ -3208,27 +3245,20 @@ A must be a bool vector. B is a generalized bool. */) EMACS_INT count; EMACS_INT nr_bits; bits_word *adata; - bits_word match; - ptrdiff_t i; + ptrdiff_t i, nwords; CHECK_BOOL_VECTOR (a); nr_bits = bool_vector_size (a); + nwords = bool_vector_words (nr_bits); count = 0; - match = NILP (b) ? BITS_WORD_MAX : 0; adata = bool_vector_data (a); - for (i = 0; i < nr_bits / BITS_PER_BITS_WORD; ++i) - count += popcount_bits_word (adata[i] ^ match); - - /* Mask out trailing parts of final mword. */ - if (nr_bits % BITS_PER_BITS_WORD) - { - bits_word mword = adata[i] ^ match; - mword = bits_word_to_host_endian (mword); - count += popcount_bits_word (mword & bool_vector_spare_mask (nr_bits)); - } + for (i = 0; i < nwords; i++) + count += count_one_bits_word (adata[i]); + if (NILP (b)) + count = nr_bits - count; return make_number (count); } @@ -3246,7 +3276,7 @@ index into the vector. */) bits_word *adata; bits_word twiddle; bits_word mword; /* Machine word. */ - ptrdiff_t pos; + ptrdiff_t pos, pos0; ptrdiff_t nr_words; CHECK_BOOL_VECTOR (a); @@ -3273,8 +3303,8 @@ index into the vector. */) mword = bits_word_to_host_endian (adata[pos]); mword ^= twiddle; mword >>= offset; + mword |= (bits_word) 1 << (BITS_PER_BITS_WORD - offset); count = count_trailing_zero_bits (mword); - count = min (count, BITS_PER_BITS_WORD - offset); pos++; if (count + offset < BITS_PER_BITS_WORD) return make_number (count); @@ -3283,11 +3313,10 @@ index into the vector. */) /* Scan whole words until we either reach the end of the vector or find an mword that doesn't completely match. twiddle is endian-independent. */ + pos0 = pos; while (pos < nr_words && adata[pos] == twiddle) - { - count += BITS_PER_BITS_WORD; - ++pos; - } + pos++; + count += (pos - pos0) * BITS_PER_BITS_WORD; if (pos < nr_words) { diff --git a/src/fns.c b/src/fns.c index 44b70af6eb5..93829fb1d62 100644 --- a/src/fns.c +++ b/src/fns.c @@ -435,13 +435,10 @@ with the original. */) if (BOOL_VECTOR_P (arg)) { - Lisp_Object val; - ptrdiff_t size_in_chars - = ((bool_vector_size (arg) + BOOL_VECTOR_BITS_PER_CHAR - 1) - / BOOL_VECTOR_BITS_PER_CHAR); - - val = Fmake_bool_vector (Flength (arg), Qnil); - memcpy (bool_vector_data (val), bool_vector_data (arg), size_in_chars); + EMACS_INT nbits = bool_vector_size (arg); + ptrdiff_t nbytes = bool_vector_bytes (nbits); + Lisp_Object val = make_uninit_bool_vector (nbits); + memcpy (bool_vector_data (val), bool_vector_data (arg), nbytes); return val; } @@ -2066,8 +2063,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props) if (size != bool_vector_size (o2)) return 0; if (memcmp (bool_vector_data (o1), bool_vector_data (o2), - ((size + BOOL_VECTOR_BITS_PER_CHAR - 1) - / BOOL_VECTOR_BITS_PER_CHAR))) + bool_vector_bytes (size))) return 0; return 1; } @@ -2157,7 +2153,7 @@ ARRAY is a vector, string, char-table, or bool-vector. */) p[idx] = charval; } else if (BOOL_VECTOR_P (array)) - bool_vector_fill (array, item); + return bool_vector_fill (array, item); else wrong_type_argument (Qarrayp, array); return array; diff --git a/src/lisp.h b/src/lisp.h index 2b197cd32b1..72e5dad8ca3 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -92,16 +92,16 @@ enum { BOOL_VECTOR_BITS_PER_CHAR = /* An unsigned integer type representing a fixed-length bit sequence, suitable for words in a Lisp bool vector. Normally it is size_t for speed, but it is unsigned char on weird platforms. */ -#if (BITSIZEOF_SIZE_T == CHAR_BIT * SIZEOF_SIZE_T \ - && BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT) +#if BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT typedef size_t bits_word; -#define BITS_WORD_MAX SIZE_MAX +# define BITS_WORD_MAX SIZE_MAX enum { BITS_PER_BITS_WORD = CHAR_BIT * sizeof (bits_word) }; #else typedef unsigned char bits_word; -#define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1) +# define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1) enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR }; #endif +verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1); /* Number of bits in some machine integer types. */ enum @@ -1212,7 +1212,9 @@ struct Lisp_Bool_Vector struct vectorlike_header header; /* This is the size in bits. */ EMACS_INT size; - /* This contains the actual bits, packed into bytes. */ + /* The actual bits, packed into bytes. + The bits are in little-endian order in the bytes, and + the bytes are in little-endian order in the words. */ bits_word data[FLEXIBLE_ARRAY_MEMBER]; }; @@ -1236,7 +1238,7 @@ bool_vector_uchar_data (Lisp_Object a) return (unsigned char *) bool_vector_data (a); } -/* The number of data words in a bool vector with SIZE bits. */ +/* The number of data words and bytes in a bool vector with SIZE bits. */ INLINE EMACS_INT bool_vector_words (EMACS_INT size) @@ -1245,6 +1247,13 @@ bool_vector_words (EMACS_INT size) return (size + BITS_PER_BITS_WORD - 1) / BITS_PER_BITS_WORD; } +INLINE EMACS_INT +bool_vector_bytes (EMACS_INT size) +{ + eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1)); + return (size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR; +} + /* True if A's Ith bit is set. */ INLINE bool @@ -3588,7 +3597,8 @@ list4i (EMACS_INT x, EMACS_INT y, EMACS_INT w, EMACS_INT h) make_number (w), make_number (h)); } -extern void bool_vector_fill (Lisp_Object, Lisp_Object); +extern Lisp_Object make_uninit_bool_vector (EMACS_INT); +extern Lisp_Object bool_vector_fill (Lisp_Object, Lisp_Object); extern _Noreturn void string_overflow (void); extern Lisp_Object make_string (const char *, ptrdiff_t); extern Lisp_Object make_formatted_string (char *, const char *, ...) diff --git a/src/lread.c b/src/lread.c index 7e4f5d38d09..6c1b17f62b7 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2577,9 +2577,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == '"') { Lisp_Object tmp, val; - EMACS_INT size_in_chars - = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1) - / BOOL_VECTOR_BITS_PER_CHAR); + EMACS_INT size_in_chars = bool_vector_bytes (XFASTINT (length)); unsigned char *data; UNREAD (c); @@ -2594,7 +2592,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))) invalid_syntax ("#&..."); - val = Fmake_bool_vector (length, Qnil); + val = make_uninit_bool_vector (XFASTINT (length)); data = bool_vector_uchar_data (val); memcpy (data, SDATA (tmp), size_in_chars); /* Clear the extraneous bits in the last byte. */ diff --git a/src/print.c b/src/print.c index 6eda6a86fc4..e3c56a6de62 100644 --- a/src/print.c +++ b/src/print.c @@ -1705,8 +1705,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) unsigned char c; struct gcpro gcpro1; EMACS_INT size = bool_vector_size (obj); - ptrdiff_t size_in_chars = ((size + BOOL_VECTOR_BITS_PER_CHAR - 1) - / BOOL_VECTOR_BITS_PER_CHAR); + ptrdiff_t size_in_chars = bool_vector_bytes (size); ptrdiff_t real_size_in_chars = size_in_chars; GCPRO1 (obj); -- 2.39.2