Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Simplify and port recent bool vector changes.

Browse source 
* 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.
This commit is contained in:
Paul Eggert 2013-11-04 23:11:24 -08:00
parent 6936980934
commit df5b49306e
12 changed files with 232 additions and 170 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
ChangeLog
View file

@ -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.

2
configure.ac
View file

@ -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

46
src/ChangeLog
View file

@ -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.

108
src/alloc.c
View file

@ -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);
exact_payload_bytes = bool_vector_exact_payload_bytes (XFASTINT (length));
total_payload_bytes = bool_vector_payload_bytes (XFASTINT (length));
eassume (exact_payload_bytes <= total_payload_bytes);
eassume (0 <= exact_payload_bytes);
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

41
src/category.c
View file

@ -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);
}

12
src/category.h
View file

@ -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

51
src/data.c
View file

@ -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)

37
src/fns.c
View file

@ -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);
}

4
src/image.c
View file

@ -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
{

87
src/lisp.h
View file

@ -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 */

6
src/lread.c
View file

@ -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;
}

2
src/print.c
View file

@ -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 ('\\');