summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPaul Eggert <eggert@cs.ucla.edu>2013-11-04 23:11:24 -0800
committerPaul Eggert <eggert@cs.ucla.edu>2013-11-04 23:11:24 -0800
commitdf5b49306e8e82e2f18ed3243700c11ca7835750 (patch)
treed98fffc7d11d4565b6132e83f54ca3f3c547b1d4
parent693698093480628b7438ca0fd1614b00acfd1137 (diff)
downloademacs-df5b49306e8e82e2f18ed3243700c11ca7835750.tar.gz
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.
-rw-r--r--ChangeLog6
-rw-r--r--configure.ac2
-rw-r--r--src/ChangeLog46
-rw-r--r--src/alloc.c108
-rw-r--r--src/category.c41
-rw-r--r--src/category.h12
-rw-r--r--src/data.c51
-rw-r--r--src/fns.c37
-rw-r--r--src/image.c4
-rw-r--r--src/lisp.h87
-rw-r--r--src/lread.c6
-rw-r--r--src/print.c2
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 <eggert@cs.ucla.edu>
+
+ Simplify and port recent bool vector changes.
+ * configure.ac (BITSIZEOF_SIZE_T, SIZEOF_SIZE_T):
+ New symbols to configure.
+
2013-11-04 Eli Zaretskii <eliz@gnu.org>
* 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 <stddef.h>]])
+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 <eggert@cs.ucla.edu>
+ 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
- <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */
+ 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 ('\\');