static Lisp_Object Qsubr;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
+static Lisp_Object Qwrong_length_argument;
static Lisp_Object Qwrong_type_argument;
Lisp_Object Qvoid_variable, Qvoid_function;
static Lisp_Object Qcyclic_function_indirection;
blv->valcell = val;
}
+static _Noreturn void
+wrong_length_argument (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
+{
+ Lisp_Object size1 = make_number (bool_vector_size (a1));
+ Lisp_Object size2 = make_number (bool_vector_size (a2));
+ if (NILP (a3))
+ xsignal2 (Qwrong_length_argument, size1, size2);
+ else
+ xsignal3 (Qwrong_length_argument, size1, size2,
+ make_number (bool_vector_size (a3)));
+}
+
Lisp_Object
wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
{
}
else if (BOOL_VECTOR_P (array))
{
- int val;
-
- if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
+ 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))
{
}
else if (BOOL_VECTOR_P (array))
{
- int val;
-
- if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
+ 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))
{
that we don't have to special-case empty bit vectors. */
static bits_word
-bool_vector_spare_mask (ptrdiff_t nr_bits)
+bool_vector_spare_mask (EMACS_INT nr_bits)
{
- eassert (nr_bits > 0);
return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1;
}
CHECK_BOOL_VECTOR (op1);
CHECK_BOOL_VECTOR (op2);
- nr_bits = min (XBOOL_VECTOR (op1)->size,
- XBOOL_VECTOR (op2)->size);
+ nr_bits = bool_vector_size (op1);
+ if (bool_vector_size (op2) != nr_bits)
+ wrong_length_argument (op1, op2, dest);
if (NILP (dest))
{
else
{
CHECK_BOOL_VECTOR (dest);
- nr_bits = min (nr_bits, XBOOL_VECTOR (dest)->size);
+ if (bool_vector_size (dest) != nr_bits)
+ wrong_length_argument (op1, op2, dest);
}
- eassert (nr_bits >= 0);
- 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
{
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
DEFUN ("bool-vector-exclusive-or", Fbool_vector_exclusive_or,
Sbool_vector_exclusive_or, 2, 3, 0,
- doc: /* Compute C = A ^ B, bitwise exclusive or.
-A, B, and C must be bool vectors. If C is nil, allocate a new bool
-vector in which to store the result. Return the destination vector if
-it changed or nil otherwise. */
- )
+ doc: /* Return A ^ B, bitwise exclusive or.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise. */)
(Lisp_Object a, Lisp_Object b, Lisp_Object c)
{
return bool_vector_binop_driver (a, b, c, bool_vector_exclusive_or);
DEFUN ("bool-vector-union", Fbool_vector_union,
Sbool_vector_union, 2, 3, 0,
- doc: /* Compute C = A | B, bitwise or.
-A, B, and C must be bool vectors. If C is nil, allocate a new bool
-vector in which to store the result. Return the destination vector if
-it changed or nil otherwise. */)
+ doc: /* Return A | B, bitwise or.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise. */)
(Lisp_Object a, Lisp_Object b, Lisp_Object c)
{
return bool_vector_binop_driver (a, b, c, bool_vector_union);
DEFUN ("bool-vector-intersection", Fbool_vector_intersection,
Sbool_vector_intersection, 2, 3, 0,
- doc: /* Compute C = A & B, bitwise and.
-A, B, and C must be bool vectors. If C is nil, allocate a new bool
-vector in which to store the result. Return the destination vector if
-it changed or nil otherwise. */)
+ doc: /* Return A & B, bitwise and.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise. */)
(Lisp_Object a, Lisp_Object b, Lisp_Object c)
{
return bool_vector_binop_driver (a, b, c, bool_vector_intersection);
DEFUN ("bool-vector-set-difference", Fbool_vector_set_difference,
Sbool_vector_set_difference, 2, 3, 0,
- doc: /* Compute C = A &~ B, set difference.
-A, B, and C must be bool vectors. If C is nil, allocate a new bool
-vector in which to store the result. Return the destination vector if
-it changed or nil otherwise. */)
+ doc: /* Return A &~ B, set difference.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise. */)
(Lisp_Object a, Lisp_Object b, Lisp_Object c)
{
return bool_vector_binop_driver (a, b, c, bool_vector_set_difference);
DEFUN ("bool-vector-not", Fbool_vector_not,
Sbool_vector_not, 1, 2, 0,
- doc: /* Compute B = ~A.
-B must be a bool vector. A must be a bool vector or nil.
-If A is nil, allocate a new bool vector in which to store the result.
+ doc: /* Compute ~A, set complement.
+If optional second argument B is given, store result into B.
+A and B must be bool vectors of the same length.
Return the destination vector. */)
(Lisp_Object a, Lisp_Object b)
{
EMACS_INT nr_bits;
bits_word *bdata, *adata;
ptrdiff_t i;
- bits_word mword;
CHECK_BOOL_VECTOR (a);
- nr_bits = XBOOL_VECTOR (a)->size;
+ nr_bits = bool_vector_size (a);
if (NILP (b))
b = Fmake_bool_vector (make_number (nr_bits), Qnil);
else
{
CHECK_BOOL_VECTOR (b);
- nr_bits = min (nr_bits, XBOOL_VECTOR (b)->size);
+ if (bool_vector_size (b) != nr_bits)
+ wrong_length_argument (a, b, Qnil);
}
- bdata = (bits_word *) XBOOL_VECTOR (b)->data;
- adata = (bits_word *) XBOOL_VECTOR (a)->data;
-
- eassert (nr_bits >= 0);
+ 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);
A must be a bool vector. B is a generalized bool. */)
(Lisp_Object a, Lisp_Object b)
{
- ptrdiff_t count;
+ EMACS_INT count;
EMACS_INT nr_bits;
bits_word *adata;
bits_word match;
CHECK_BOOL_VECTOR (a);
- nr_bits = XBOOL_VECTOR (a)->size;
+ nr_bits = bool_vector_size (a);
count = 0;
- match = NILP (b) ? -1 : 0;
- adata = (bits_word *) XBOOL_VECTOR (a)->data;
-
- eassert (nr_bits >= 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);
index into the vector. */)
(Lisp_Object a, Lisp_Object b, Lisp_Object i)
{
- ptrdiff_t count;
+ EMACS_INT count;
EMACS_INT nr_bits;
- ptrdiff_t offset;
+ int offset;
bits_word *adata;
bits_word twiddle;
bits_word mword; /* Machine word. */
CHECK_BOOL_VECTOR (a);
CHECK_NATNUM (i);
- nr_bits = XBOOL_VECTOR (a)->size;
+ nr_bits = bool_vector_size (a);
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;
-
- assume (nr_bits >= 0);
- 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;
/* 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)
DEFSYM (Qerror, "error");
DEFSYM (Quser_error, "user-error");
DEFSYM (Qquit, "quit");
+ DEFSYM (Qwrong_length_argument, "wrong-length-argument");
DEFSYM (Qwrong_type_argument, "wrong-type-argument");
DEFSYM (Qargs_out_of_range, "args-out-of-range");
DEFSYM (Qvoid_function, "void-function");
PUT_ERROR (Qquit, Qnil, "Quit");
PUT_ERROR (Quser_error, error_tail, "");
+ PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument");
PUT_ERROR (Qwrong_type_argument, error_tail, "Wrong type argument");
PUT_ERROR (Qargs_out_of_range, error_tail, "Args out of range");
PUT_ERROR (Qvoid_function, error_tail,