From df5b49306e8e82e2f18ed3243700c11ca7835750 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 4 Nov 2013 23:11:24 -0800 Subject: [PATCH] Simplify and port recent bool vector changes. * configure.ac (BITSIZEOF_SIZE_T, SIZEOF_SIZE_T): New symbols to configure. * src/alloc.c (ROUNDUP): Move here from lisp.h, since it's now used only in this file. Use a more-efficient implementation if the second argument is a power of 2. (ALIGN): Rewrite in terms of ROUNDUP. Make it a function. Remove no-longer-necessary compile-time checks. (bool_vector_exact_payload_bytes): New function. (bool_vector_payload_bytes): Remove 2nd arg; callers that need exact payload changed to call the new function. Do not assume that the arg or result fits in ptrdiff_t. (bool_vector_fill): New function. (Fmake_bool_vector): Use it. Don't assume bit counts fit in ptrdiff_t. (vroundup_ct): Don't assume arg fits in size_t. * src/category.c (SET_CATEGORY_SET): Remove. All callers now just invoke set_category_set. (set_category_set): 2nd arg is now EMACS_INT and 3rd is now bool. All callers changed. Use bool_vector_set. * src/category.h (XCATEGORY_SET): Remove; no longer needed. (CATEGORY_MEMBER): Now a function. Rewrite in terms of bool_vector_bitref. * src/data.c (Faref): Use bool_vector_ref. (Faset): Use bool_vector_set. (bits_word_to_host_endian): Don't assume you can shift by CHAR_BIT. (Fbool_vector_not, Fbool_vector_count_matches) (Fbool_vector_count_matches_at): Don't assume CHAR_BIT == 8. * src/fns.c (concat): Use bool_vector_ref. (Ffillarray): Use bool_vector_fill. (mapcar1): Use bool_vector_ref. (sxhash_bool_vector): Hash words, not bytes. * src/lisp.h (BOOL_VECTOR_BITS_PER_CHAR): Now a macro as well as a constant, since it's now used in #if. (bits_word, BITS_WORD_MAX, BITS_PER_BITS_WORD): Fall back on unsigned char on unusual architectures, so that we no longer assume that the number of bits per bits_word is a power of two or is a multiple of 8 or of CHAR_BIT. (Qt): Add forward decl. (struct Lisp_Bool_Vector): Don't assume EMACS_INT is aligned at least as strictly as bits_word. (bool_vector_data, bool_vector_uchar_data): New accessors. All data structure accesses changed to use them. (bool_vector_words, bool_vector_bitref, bool_vector_ref) (bool_vector_set): New functions. (bool_vector_fill): New decl. (ROUNDUP): Move to alloc.c as described above. --- ChangeLog | 6 +++ configure.ac | 2 + src/ChangeLog | 46 +++++++++++++++++++++ src/alloc.c | 108 ++++++++++++++++++++++++------------------------- src/category.c | 41 ++++++------------- src/category.h | 12 +++--- src/data.c | 51 +++++++++-------------- src/fns.c | 37 ++++------------- src/image.c | 4 +- src/lisp.h | 87 +++++++++++++++++++++++++++++++++------ src/lread.c | 6 ++- src/print.c | 2 +- 12 files changed, 232 insertions(+), 170 deletions(-) diff --git a/ChangeLog b/ChangeLog index 547f5ce1afc..f316996461e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2013-11-05 Paul Eggert + + Simplify and port recent bool vector changes. + * configure.ac (BITSIZEOF_SIZE_T, SIZEOF_SIZE_T): + New symbols to configure. + 2013-11-04 Eli Zaretskii * configure.ac: Don't disallow builds in non-ASCII directories. diff --git a/configure.ac b/configure.ac index 2540f185078..cb97564cadc 100644 --- a/configure.ac +++ b/configure.ac @@ -4719,6 +4719,8 @@ 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 bd5688d868f..9ba39e20432 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,51 @@ 2013-11-05 Paul Eggert + Simplify and port recent bool vector changes. + * alloc.c (ROUNDUP): Move here from lisp.h, since it's now used + only in this file. Use a more-efficient implementation if the + second argument is a power of 2. + (ALIGN): Rewrite in terms of ROUNDUP. Make it a function. + Remove no-longer-necessary compile-time checks. + (bool_vector_exact_payload_bytes): New function. + (bool_vector_payload_bytes): Remove 2nd arg; callers that need + exact payload changed to call the new function. Do not assume + that the arg or result fits in ptrdiff_t. + (bool_vector_fill): New function. + (Fmake_bool_vector): Use it. Don't assume bit counts fit + in ptrdiff_t. + (vroundup_ct): Don't assume arg fits in size_t. + * category.c (SET_CATEGORY_SET): Remove. All callers now just + invoke set_category_set. + (set_category_set): 2nd arg is now EMACS_INT and 3rd is now bool. + All callers changed. Use bool_vector_set. + * category.h (XCATEGORY_SET): Remove; no longer needed. + (CATEGORY_MEMBER): Now a function. Rewrite in terms of + bool_vector_bitref. + * data.c (Faref): Use bool_vector_ref. + (Faset): Use bool_vector_set. + (bits_word_to_host_endian): Don't assume you can shift by CHAR_BIT. + (Fbool_vector_not, Fbool_vector_count_matches) + (Fbool_vector_count_matches_at): Don't assume CHAR_BIT == 8. + * fns.c (concat): Use bool_vector_ref. + (Ffillarray): Use bool_vector_fill. + (mapcar1): Use bool_vector_ref. + (sxhash_bool_vector): Hash words, not bytes. + * lisp.h (BOOL_VECTOR_BITS_PER_CHAR): Now a macro as well as + a constant, since it's now used in #if. + (bits_word, BITS_WORD_MAX, BITS_PER_BITS_WORD): Fall back on + unsigned char on unusual architectures, so that we no longer + assume that the number of bits per bits_word is a power of two or + is a multiple of 8 or of CHAR_BIT. + (Qt): Add forward decl. + (struct Lisp_Bool_Vector): Don't assume EMACS_INT is aligned + at least as strictly as bits_word. + (bool_vector_data, bool_vector_uchar_data): New accessors. + All data structure accesses changed to use them. + (bool_vector_words, bool_vector_bitref, bool_vector_ref) + (bool_vector_set): New functions. + (bool_vector_fill): New decl. + (ROUNDUP): Move to alloc.c as described above. + Fix recent gnutls changes. * gnutls.c (Fgnutls_boot): Don't assume C99. * process.c (wait_reading_process_output): Fix typo in recent change. diff --git a/src/alloc.c b/src/alloc.c index b35f7c4333f..7054083acba 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -361,13 +361,21 @@ static int staticidx; static void *pure_alloc (size_t, int); +/* Return X rounded to the next multiple of Y. Arguments should not + have side effects, as they are evaluated more than once. Assume X + + Y - 1 does not overflow. Tune for Y being a power of 2. */ -/* Value is SZ rounded up to the next multiple of ALIGNMENT. - ALIGNMENT must be a power of 2. */ +#define ROUNDUP(x, y) ((y) & ((y) - 1) \ + ? ((x) + (y) - 1) - ((x) + (y) - 1) % (y) \ + : ((x) + (y) - 1) & ~ ((y) - 1)) -#define ALIGN(ptr, ALIGNMENT) \ - ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \ - & ~ ((ALIGNMENT) - 1))) +/* Return PTR rounded up to the next multiple of ALIGNMENT. */ + +static void * +ALIGN (void *ptr, int alignment) +{ + return (void *) ROUNDUP ((uintptr_t) ptr, alignment); +} static void XFLOAT_INIT (Lisp_Object f, double n) @@ -2026,33 +2034,39 @@ INIT must be an integer that represents a character. */) return val; } -verify (sizeof (size_t) * CHAR_BIT == BITS_PER_BITS_WORD); -verify ((BITS_PER_BITS_WORD & (BITS_PER_BITS_WORD - 1)) == 0); - -static ptrdiff_t -bool_vector_payload_bytes (ptrdiff_t nr_bits, - ptrdiff_t *exact_needed_bytes_out) +static EMACS_INT +bool_vector_exact_payload_bytes (EMACS_INT nbits) { - ptrdiff_t exact_needed_bytes; - ptrdiff_t needed_bytes; + eassume (0 <= nbits); + return (nbits + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR; +} - eassume (nr_bits >= 0); +static EMACS_INT +bool_vector_payload_bytes (EMACS_INT nbits) +{ + EMACS_INT exact_needed_bytes = bool_vector_exact_payload_bytes (nbits); - exact_needed_bytes = ROUNDUP ((size_t) nr_bits, CHAR_BIT) / CHAR_BIT; - needed_bytes = ROUNDUP ((size_t) nr_bits, BITS_PER_BITS_WORD) / CHAR_BIT; + /* 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)); +} - if (needed_bytes == 0) +void +bool_vector_fill (Lisp_Object a, Lisp_Object init) +{ + EMACS_INT nbits = bool_vector_size (a); + if (0 < nbits) { - /* 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. */ - needed_bytes = sizeof (bits_word); + 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); + int last_mask = ~ (~0 << ((nbits - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)); + memset (data, pattern, nbytes - 1); + data[nbytes - 1] = pattern & last_mask; } - - if (exact_needed_bytes_out != NULL) - *exact_needed_bytes_out = exact_needed_bytes; - - return needed_bytes; } DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, @@ -2060,42 +2074,29 @@ DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, LENGTH must be a number. INIT matters only in whether it is t or nil. */) (Lisp_Object length, Lisp_Object init) { - register Lisp_Object val; + Lisp_Object val; struct Lisp_Bool_Vector *p; - ptrdiff_t exact_payload_bytes; - ptrdiff_t total_payload_bytes; - ptrdiff_t needed_elements; + EMACS_INT exact_payload_bytes, total_payload_bytes, needed_elements; CHECK_NATNUM (length); - if (PTRDIFF_MAX < XFASTINT (length)) - memory_full (SIZE_MAX); - - total_payload_bytes = bool_vector_payload_bytes - (XFASTINT (length), &exact_payload_bytes); - eassume (exact_payload_bytes <= total_payload_bytes); - eassume (0 <= exact_payload_bytes); + exact_payload_bytes = bool_vector_exact_payload_bytes (XFASTINT (length)); + total_payload_bytes = bool_vector_payload_bytes (XFASTINT (length)); - needed_elements = ROUNDUP ((size_t) ((bool_header_size - header_size) - + total_payload_bytes), - word_size) / word_size; + needed_elements = ((bool_header_size - header_size + total_payload_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); - if (exact_payload_bytes) - { - memset (p->data, ! NILP (init) ? -1 : 0, exact_payload_bytes); - - /* Clear any extraneous bits in the last byte. */ - p->data[exact_payload_bytes - 1] - &= (1 << ((XFASTINT (length) - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)) - 1; - } + bool_vector_fill (val, init); /* Clear padding at the end. */ - memset (p->data + exact_payload_bytes, + eassume (exact_payload_bytes <= total_payload_bytes); + memset (bool_vector_uchar_data (val) + exact_payload_bytes, 0, total_payload_bytes - exact_payload_bytes); @@ -2648,7 +2649,7 @@ verify ((VECTOR_BLOCK_SIZE % roundup_size) == 0); verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS)); /* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at compile time. */ -#define vroundup_ct(x) ROUNDUP ((size_t) (x), roundup_size) +#define vroundup_ct(x) ROUNDUP (x, roundup_size) /* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at runtime. */ #define vroundup(x) (eassume ((x) >= 0), vroundup_ct (x)) @@ -2856,11 +2857,8 @@ vector_nbytes (struct Lisp_Vector *v) 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, NULL); - - eassume (payload_bytes >= 0); - size = bool_header_size + ROUNDUP (payload_bytes, word_size); + ptrdiff_t payload_bytes = bool_vector_payload_bytes (bv->size); + size = bool_header_size + payload_bytes; } else size = (header_size diff --git a/src/category.c b/src/category.c index da5e81e4709..80d8b1ca1a2 100644 --- a/src/category.c +++ b/src/category.c @@ -55,17 +55,9 @@ bset_category_table (struct buffer *b, Lisp_Object val) static int category_table_version; static Lisp_Object Qcategory_table, Qcategoryp, Qcategorysetp, Qcategory_table_p; - -/* Make CATEGORY_SET includes (if VAL is t) or excludes (if VAL is - nil) CATEGORY. */ -#define SET_CATEGORY_SET(category_set, category, val) \ - set_category_set (category_set, category, val) -static void set_category_set (Lisp_Object, Lisp_Object, Lisp_Object); /* Category set staff. */ -static Lisp_Object hash_get_category_set (Lisp_Object, Lisp_Object); - static Lisp_Object hash_get_category_set (Lisp_Object table, Lisp_Object category_set) { @@ -88,6 +80,13 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) return category_set; } +/* Make CATEGORY_SET include (if VAL) or exclude (if !VAL) CATEGORY. */ + +static void +set_category_set (Lisp_Object category_set, EMACS_INT category, bool val) +{ + bool_vector_set (category_set, category, val); +} DEFUN ("make-category-set", Fmake_category_set, Smake_category_set, 1, 1, 0, doc: /* Return a newly created category-set which contains CATEGORIES. @@ -108,11 +107,11 @@ those categories. */) len = SCHARS (categories); while (--len >= 0) { - Lisp_Object category; + unsigned char cat = SREF (categories, len); + Lisp_Object category = make_number (cat); - XSETFASTINT (category, SREF (categories, len)); CHECK_CATEGORY (category); - SET_CATEGORY_SET (val, category, Qt); + set_category_set (val, cat, 1); } return val; } @@ -334,20 +333,6 @@ The return value is a string containing those same categories. */) return build_string (str); } -static void -set_category_set (Lisp_Object category_set, Lisp_Object category, Lisp_Object val) -{ - do { - int idx = XINT (category) / 8; - unsigned char bits = 1 << (XINT (category) % 8); - - if (NILP (val)) - XCATEGORY_SET (category_set)->data[idx] &= ~bits; - else - XCATEGORY_SET (category_set)->data[idx] |= bits; - } while (0); -} - DEFUN ("modify-category-entry", Fmodify_category_entry, Smodify_category_entry, 2, 4, 0, doc: /* Modify the category set of CHARACTER by adding CATEGORY to it. @@ -359,7 +344,7 @@ If optional fourth argument RESET is non-nil, then delete CATEGORY from the category set instead of adding it. */) (Lisp_Object character, Lisp_Object category, Lisp_Object table, Lisp_Object reset) { - Lisp_Object set_value; /* Actual value to be set in category sets. */ + bool set_value; /* Actual value to be set in category sets. */ Lisp_Object category_set; int start, end; int from, to; @@ -384,7 +369,7 @@ then delete CATEGORY from the category set instead of adding it. */) if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category)))) error ("Undefined category: %c", (int) XFASTINT (category)); - set_value = NILP (reset) ? Qt : Qnil; + set_value = NILP (reset); while (start <= end) { @@ -393,7 +378,7 @@ then delete CATEGORY from the category set instead of adding it. */) if (CATEGORY_MEMBER (XFASTINT (category), category_set) != NILP (reset)) { category_set = Fcopy_sequence (category_set); - SET_CATEGORY_SET (category_set, category, set_value); + set_category_set (category_set, XFASTINT (category), set_value); category_set = hash_get_category_set (table, category_set); char_table_set_range (table, start, to, category_set); } diff --git a/src/category.h b/src/category.h index a2eaf010132..ef784c8cbf5 100644 --- a/src/category.h +++ b/src/category.h @@ -60,8 +60,6 @@ INLINE_HEADER_BEGIN #define CHECK_CATEGORY(x) \ CHECK_TYPE (CATEGORYP (x), Qcategoryp, x) -#define XCATEGORY_SET XBOOL_VECTOR - #define CATEGORY_SET_P(x) \ (BOOL_VECTOR_P (x) && bool_vector_size (x) == 128) @@ -75,10 +73,12 @@ INLINE_HEADER_BEGIN #define CATEGORY_SET(c) char_category_set (c) /* Return true if CATEGORY_SET contains CATEGORY. - The faster version of `!NILP (Faref (category_set, category))'. */ -#define CATEGORY_MEMBER(category, category_set) \ - ((XCATEGORY_SET (category_set)->data[(category) / 8] \ - >> ((category) % 8)) & 1) + Faster than '!NILP (Faref (category_set, make_number (category)))'. */ +INLINE bool +CATEGORY_MEMBER (EMACS_INT category, Lisp_Object category_set) +{ + return bool_vector_bitref (category_set, category); +} /* Return true if category set of CH contains CATEGORY. */ INLINE bool diff --git a/src/data.c b/src/data.c index 22d051ef932..4043fbe279b 100644 --- a/src/data.c +++ b/src/data.c @@ -2141,13 +2141,9 @@ or a byte-code object. IDX starts at 0. */) } else if (BOOL_VECTOR_P (array)) { - int val; - if (idxval < 0 || idxval >= bool_vector_size (array)) args_out_of_range (array, idx); - - val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR]; - return (val & (1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)) ? Qt : Qnil); + return bool_vector_ref (array, idxval); } else if (CHAR_TABLE_P (array)) { @@ -2191,18 +2187,9 @@ bool-vector. IDX starts at 0. */) } else if (BOOL_VECTOR_P (array)) { - int val; - if (idxval < 0 || idxval >= bool_vector_size (array)) args_out_of_range (array, idx); - - val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR]; - - if (! NILP (newelt)) - val |= 1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR); - else - val &= ~(1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)); - XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR] = val; + bool_vector_set (array, idxval, !NILP (newelt)); } else if (CHAR_TABLE_P (array)) { @@ -3033,11 +3020,11 @@ bool_vector_binop_driver (Lisp_Object op1, wrong_length_argument (op1, op2, dest); } - nr_words = ROUNDUP (nr_bits, BITS_PER_BITS_WORD) / BITS_PER_BITS_WORD; + nr_words = bool_vector_words (nr_bits); - adata = (bits_word *) XBOOL_VECTOR (dest)->data; - bdata = (bits_word *) XBOOL_VECTOR (op1)->data; - cdata = (bits_word *) XBOOL_VECTOR (op2)->data; + adata = bool_vector_data (dest); + bdata = bool_vector_data (op1); + cdata = bool_vector_data (op2); i = 0; do { @@ -3110,8 +3097,9 @@ bits_word_to_host_endian (bits_word val) bits_word r = 0; for (i = 0; i < sizeof val; i++) { - r = (r << CHAR_BIT) | (val & ((1u << CHAR_BIT) - 1)); - val >>= CHAR_BIT; + r = ((r << 1 << (CHAR_BIT - 1)) + | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1))); + val = val >> 1 >> (CHAR_BIT - 1); } return r; #endif @@ -3181,7 +3169,6 @@ Return the destination vector. */) EMACS_INT nr_bits; bits_word *bdata, *adata; ptrdiff_t i; - bits_word mword; CHECK_BOOL_VECTOR (a); nr_bits = bool_vector_size (a); @@ -3195,15 +3182,15 @@ Return the destination vector. */) wrong_length_argument (a, b, Qnil); } - bdata = (bits_word *) XBOOL_VECTOR (b)->data; - adata = (bits_word *) XBOOL_VECTOR (a)->data; + bdata = bool_vector_data (b); + adata = bool_vector_data (a); for (i = 0; i < nr_bits / BITS_PER_BITS_WORD; i++) - bdata[i] = ~adata[i]; + bdata[i] = BITS_WORD_MAX & ~adata[i]; if (nr_bits % BITS_PER_BITS_WORD) { - mword = bits_word_to_host_endian (adata[i]); + bits_word mword = bits_word_to_host_endian (adata[i]); mword = ~mword; mword &= bool_vector_spare_mask (nr_bits); bdata[i] = bits_word_to_host_endian (mword); @@ -3228,8 +3215,8 @@ A must be a bool vector. B is a generalized bool. */) nr_bits = bool_vector_size (a); count = 0; - match = NILP (b) ? -1 : 0; - adata = (bits_word *) XBOOL_VECTOR (a)->data; + 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); @@ -3269,10 +3256,8 @@ index into the vector. */) if (XFASTINT (i) > nr_bits) /* Allow one past the end for convenience */ args_out_of_range (a, i); - adata = (bits_word *) XBOOL_VECTOR (a)->data; - - nr_words = ROUNDUP (nr_bits, BITS_PER_BITS_WORD) / BITS_PER_BITS_WORD; - + adata = bool_vector_data (a); + nr_words = bool_vector_words (nr_bits); pos = XFASTINT (i) / BITS_PER_BITS_WORD; offset = XFASTINT (i) % BITS_PER_BITS_WORD; count = 0; @@ -3280,7 +3265,7 @@ index into the vector. */) /* By XORing with twiddle, we transform the problem of "count consecutive equal values" into "count the zero bits". The latter operation usually has hardware support. */ - twiddle = NILP (b) ? 0 : -1; + twiddle = NILP (b) ? 0 : BITS_WORD_MAX; /* Scan the remainder of the mword at the current offset. */ if (pos < nr_words && offset != 0) diff --git a/src/fns.c b/src/fns.c index 93f2eee0666..44b70af6eb5 100644 --- a/src/fns.c +++ b/src/fns.c @@ -441,8 +441,7 @@ with the original. */) / BOOL_VECTOR_BITS_PER_CHAR); val = Fmake_bool_vector (Flength (arg), Qnil); - memcpy (XBOOL_VECTOR (val)->data, XBOOL_VECTOR (arg)->data, - size_in_chars); + memcpy (bool_vector_data (val), bool_vector_data (arg), size_in_chars); return val; } @@ -674,12 +673,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, } else if (BOOL_VECTOR_P (this)) { - int byte; - byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR]; - if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR))) - elt = Qt; - else - elt = Qnil; + elt = bool_vector_ref (this, thisindex); thisindex++; } else @@ -2071,7 +2065,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props) EMACS_INT size = bool_vector_size (o1); if (size != bool_vector_size (o2)) return 0; - if (memcmp (XBOOL_VECTOR (o1)->data, XBOOL_VECTOR (o2)->data, + if (memcmp (bool_vector_data (o1), bool_vector_data (o2), ((size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR))) return 0; @@ -2163,19 +2157,7 @@ ARRAY is a vector, string, char-table, or bool-vector. */) p[idx] = charval; } else if (BOOL_VECTOR_P (array)) - { - unsigned char *p = XBOOL_VECTOR (array)->data; - size = ((bool_vector_size (array) + BOOL_VECTOR_BITS_PER_CHAR - 1) - / BOOL_VECTOR_BITS_PER_CHAR); - - if (size) - { - memset (p, ! NILP (item) ? -1 : 0, size); - - /* Clear any extraneous bits in the last byte. */ - p[size - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1; - } - } + bool_vector_fill (array, item); else wrong_type_argument (Qarrayp, array); return array; @@ -2287,10 +2269,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) { for (i = 0; i < leni; i++) { - unsigned char byte; - byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR]; - dummy = (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) ? Qt : Qnil; - dummy = call1 (fn, dummy); + dummy = call1 (fn, bool_vector_ref (seq, i)); if (vals) vals[i] = dummy; } @@ -4189,11 +4168,9 @@ sxhash_bool_vector (Lisp_Object vec) EMACS_UINT hash = size; int i, n; - n = min (SXHASH_MAX_LEN, - ((size + BOOL_VECTOR_BITS_PER_CHAR - 1) - / BOOL_VECTOR_BITS_PER_CHAR)); + n = min (SXHASH_MAX_LEN, bool_vector_words (size)); for (i = 0; i < n; ++i) - hash = sxhash_combine (hash, XBOOL_VECTOR (vec)->data[i]); + hash = sxhash_combine (hash, bool_vector_data (vec)[i]); return SXHASH_REDUCE (hash); } diff --git a/src/image.c b/src/image.c index 958295c5d09..02565fa7b08 100644 --- a/src/image.c +++ b/src/image.c @@ -3026,13 +3026,13 @@ xbm_load (struct frame *f, struct image *img) if (STRINGP (line)) memcpy (p, SDATA (line), nbytes); else - memcpy (p, XBOOL_VECTOR (line)->data, nbytes); + memcpy (p, bool_vector_data (line), nbytes); } } else if (STRINGP (data)) bits = SSDATA (data); else - bits = (char *) XBOOL_VECTOR (data)->data; + bits = (char *) bool_vector_data (data); #ifdef HAVE_NTGUI { diff --git a/src/lisp.h b/src/lisp.h index f538cec5ed1..863b0842f59 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -82,10 +82,26 @@ typedef unsigned int EMACS_UINT; # endif #endif +/* Number of bits to put in each character in the internal representation + of bool vectors. This should not vary across implementations. */ +enum { BOOL_VECTOR_BITS_PER_CHAR = +#define BOOL_VECTOR_BITS_PER_CHAR 8 + BOOL_VECTOR_BITS_PER_CHAR +}; + /* An unsigned integer type representing a fixed-length bit sequence, - suitable for words in a Lisp bool vector. */ + 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) typedef size_t bits_word; #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) +enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR }; +#endif /* Number of bits in some machine integer types. */ enum @@ -94,7 +110,6 @@ enum BITS_PER_SHORT = CHAR_BIT * sizeof (short), BITS_PER_INT = CHAR_BIT * sizeof (int), BITS_PER_LONG = CHAR_BIT * sizeof (long int), - BITS_PER_BITS_WORD = CHAR_BIT * sizeof (bits_word), BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT) }; @@ -616,10 +631,6 @@ enum More_Lisp_Bits /* Used to extract pseudovector subtype information. */ PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS, PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS, - - /* Number of bits to put in each character in the internal representation - of bool vectors. This should not vary across implementations. */ - BOOL_VECTOR_BITS_PER_CHAR = 8 }; /* These functions extract various sorts of values from a Lisp_Object. @@ -777,7 +788,7 @@ extern int char_table_translate (Lisp_Object, int); /* Defined in data.c. */ extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p; extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil; -extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qvectorp; +extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qt, Qvectorp; extern Lisp_Object Qbool_vector_p; extern Lisp_Object Qvector_or_char_table_p, Qwholenump; extern Lisp_Object Qwindow; @@ -1152,7 +1163,7 @@ STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new, and PSEUDOVECTORP cast their pointers to struct vectorlike_header *, because when two such pointers potentially alias, a compiler won't incorrectly reorder loads and stores to their size fields. See - . */ + Bug#8546. */ struct vectorlike_header { /* The only field contains various pieces of information: @@ -1202,7 +1213,7 @@ struct Lisp_Bool_Vector /* This is the size in bits. */ EMACS_INT size; /* This contains the actual bits, packed into bytes. */ - unsigned char data[FLEXIBLE_ARRAY_MEMBER]; + bits_word data[FLEXIBLE_ARRAY_MEMBER]; }; INLINE EMACS_INT @@ -1213,6 +1224,59 @@ bool_vector_size (Lisp_Object a) return size; } +INLINE bits_word * +bool_vector_data (Lisp_Object a) +{ + return XBOOL_VECTOR (a)->data; +} + +INLINE unsigned char * +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. */ + +INLINE EMACS_INT +bool_vector_words (EMACS_INT size) +{ + eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1)); + return (size + BITS_PER_BITS_WORD - 1) / BITS_PER_BITS_WORD; +} + +/* True if A's Ith bit is set. */ + +INLINE bool +bool_vector_bitref (Lisp_Object a, EMACS_INT i) +{ + eassume (0 <= i && i < bool_vector_size (a)); + return !! (bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR] + & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))); +} + +INLINE Lisp_Object +bool_vector_ref (Lisp_Object a, EMACS_INT i) +{ + return bool_vector_bitref (a, i) ? Qt : Qnil; +} + +/* Set A's Ith bit to B. */ + +INLINE void +bool_vector_set (Lisp_Object a, EMACS_INT i, bool b) +{ + unsigned char *addr; + + eassume (0 <= i && i < bool_vector_size (a)); + addr = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR]; + + if (b) + *addr |= 1 << (i % BOOL_VECTOR_BITS_PER_CHAR); + else + *addr &= ~ (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)); +} + /* Some handy constants for calculating sizes and offsets, mostly of vectorlike objects. */ @@ -3526,6 +3590,7 @@ 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 _Noreturn void string_overflow (void); extern Lisp_Object make_string (const char *, ptrdiff_t); extern Lisp_Object make_formatted_string (char *, const char *, ...) @@ -4419,10 +4484,6 @@ functionp (Lisp_Object object) return 0; } -/* Round x to the next multiple of y. Does not overflow. Evaluates - arguments repeatedly. */ -#define ROUNDUP(x,y) ((y)*((x)/(y) + ((x)%(y)!=0))) - INLINE_HEADER_END #endif /* EMACS_LISP_H */ diff --git a/src/lread.c b/src/lread.c index 618b0cadb53..7e4f5d38d09 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2580,6 +2580,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) EMACS_INT size_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR); + unsigned char *data; UNREAD (c); tmp = read1 (readcharfun, pch, first_in_list); @@ -2594,10 +2595,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) invalid_syntax ("#&..."); val = Fmake_bool_vector (length, Qnil); - memcpy (XBOOL_VECTOR (val)->data, SDATA (tmp), size_in_chars); + data = bool_vector_uchar_data (val); + memcpy (data, SDATA (tmp), size_in_chars); /* Clear the extraneous bits in the last byte. */ if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR) - XBOOL_VECTOR (val)->data[size_in_chars - 1] + data[size_in_chars - 1] &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; } diff --git a/src/print.c b/src/print.c index 965d719f852..6eda6a86fc4 100644 --- a/src/print.c +++ b/src/print.c @@ -1726,7 +1726,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) for (i = 0; i < size_in_chars; i++) { QUIT; - c = XBOOL_VECTOR (obj)->data[i]; + c = bool_vector_uchar_data (obj)[i]; if (c == '\n' && print_escape_newlines) { PRINTCHAR ('\\'); -- 2.39.2