merge from trunk

1 files changed, 676 insertions, 208 deletions

diff --git a/src/data.c b/src/data.c
index 3763dc8adc8..f48c9ef2d10 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1,5 +1,5 @@
 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
+   Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
    Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -21,6 +21,9 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <config.h>
 #include <stdio.h>
 
+#include <byteswap.h>
+#include <count-one-bits.h>
+#include <count-trailing-zeros.h>
 #include <intprops.h>
 
 #include "lisp.h"
@@ -29,63 +32,10 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "buffer.h"
 #include "keyboard.h"
 #include "frame.h"
-#include "syssignal.h"
-#include "termhooks.h"  /* For FRAME_KBOARD reference in y-or-n-p.  */
-#include "font.h"
 #include "keymap.h"
 
-Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
-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_type_argument;
-Lisp_Object Qvoid_variable, Qvoid_function;
-static Lisp_Object Qcyclic_function_indirection;
-static Lisp_Object Qcyclic_variable_indirection;
-Lisp_Object Qcircular_list;
-static Lisp_Object Qsetting_constant;
-Lisp_Object Qinvalid_read_syntax;
-Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
-Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
-Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
-Lisp_Object Qtext_read_only;
-
-Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp;
-static Lisp_Object Qnatnump;
-Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
-Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
-Lisp_Object Qbuffer_or_string_p;
-static Lisp_Object Qkeywordp, Qboundp;
-Lisp_Object Qfboundp;
-Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
-
-Lisp_Object Qcdr;
-static Lisp_Object Qad_advice_info, Qad_activate_internal;
-
-static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error;
-Lisp_Object Qrange_error, Qoverflow_error;
-
-Lisp_Object Qfloatp;
-Lisp_Object Qnumberp, Qnumber_or_marker_p;
-
-Lisp_Object Qinteger, Qsymbol;
-static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector;
-Lisp_Object Qwindow;
-static Lisp_Object Qoverlay, Qwindow_configuration;
-static Lisp_Object Qprocess, Qmarker;
-static Lisp_Object Qcompiled_function, Qframe;
-Lisp_Object Qbuffer;
-static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
-static Lisp_Object Qsubrp;
-static Lisp_Object Qmany, Qunevalled;
-Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
-static Lisp_Object Qdefun;
-Lisp_Object Qthread, Qmutex, Qcondition_variable;
-
-Lisp_Object Qinteractive_form;
-static Lisp_Object Qdefalias_fset_function;
-
-static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
+static void swap_in_symval_forwarding (struct Lisp_Symbol *,
+                                       struct Lisp_Buffer_Local_Value *);
 
 static bool
 BOOLFWDP (union Lisp_Fwd *a)
@@ -176,6 +126,18 @@ set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
   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)
 {
@@ -211,7 +173,8 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
 /* Data type predicates.  */
 
 DEFUN ("eq", Feq, Seq, 2, 2, 0,
-       doc: /* Return t if the two args are the same Lisp object.  */)
+       doc: /* Return t if the two args are the same Lisp object.  */
+       attributes: const)
   (Lisp_Object obj1, Lisp_Object obj2)
 {
   if (EQ (obj1, obj2))
@@ -220,7 +183,8 @@ DEFUN ("eq", Feq, Seq, 2, 2, 0,
 }
 
 DEFUN ("null", Fnull, Snull, 1, 1, 0,
-       doc: /* Return t if OBJECT is nil.  */)
+       doc: /* Return t if OBJECT is nil, and return nil otherwise.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (NILP (object))
@@ -256,9 +220,12 @@ for example, (type-of 1) returns `integer'.  */)
         case Lisp_Misc_Overlay:
           return Qoverlay;
         case Lisp_Misc_Float:
-          return Qfloat;
+          return Qfloat;
+        case Lisp_Misc_Finalizer:
+          return Qfinalizer;
+        default:
+          emacs_abort ();
         }
-      emacs_abort ();
 
     case Lisp_Vectorlike:
       if (WINDOW_CONFIGURATIONP (object))
@@ -304,7 +271,8 @@ for example, (type-of 1) returns `integer'.  */)
 }
 
 DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a cons cell.  */)
+       doc: /* Return t if OBJECT is a cons cell.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (CONSP (object))
@@ -313,7 +281,8 @@ DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
 }
 
 DEFUN ("atom", Fatom, Satom, 1, 1, 0,
-       doc: /* Return t if OBJECT is not a cons cell.  This includes nil.  */)
+       doc: /* Return t if OBJECT is not a cons cell.  This includes nil.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (CONSP (object))
@@ -323,7 +292,8 @@ DEFUN ("atom", Fatom, Satom, 1, 1, 0,
 
 DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
        doc: /* Return t if OBJECT is a list, that is, a cons cell or nil.
-Otherwise, return nil.  */)
+Otherwise, return nil.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (CONSP (object) || NILP (object))
@@ -332,7 +302,8 @@ Otherwise, return nil.  */)
 }
 
 DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
-       doc: /* Return t if OBJECT is not a list.  Lists include nil.  */)
+       doc: /* Return t if OBJECT is not a list.  Lists include nil.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (CONSP (object) || NILP (object))
@@ -341,7 +312,8 @@ DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
 }
 
 DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a symbol.  */)
+       doc: /* Return t if OBJECT is a symbol.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (SYMBOLP (object))
@@ -374,7 +346,8 @@ DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0,
 }
 
 DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a string.  */)
+       doc: /* Return t if OBJECT is a string.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (STRINGP (object))
@@ -477,7 +450,8 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
 }
 
 DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
-       doc: /* Return t if OBJECT is a character or a string.  */)
+       doc: /* Return t if OBJECT is a character or a string.  */
+       attributes: const)
   (register Lisp_Object object)
 {
   if (CHARACTERP (object) || STRINGP (object))
@@ -486,7 +460,8 @@ DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
 }
 
 DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
-       doc: /* Return t if OBJECT is an integer.  */)
+       doc: /* Return t if OBJECT is an integer.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (INTEGERP (object))
@@ -504,7 +479,8 @@ DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1,
 }
 
 DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
-       doc: /* Return t if OBJECT is a nonnegative integer.  */)
+       doc: /* Return t if OBJECT is a nonnegative integer.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (NATNUMP (object))
@@ -513,7 +489,8 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
 }
 
 DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a number (floating point or integer).  */)
+       doc: /* Return t if OBJECT is a number (floating point or integer).  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (NUMBERP (object))
@@ -533,7 +510,8 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
 }
 
 DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a floating point number.  */)
+       doc: /* Return t if OBJECT is a floating point number.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (FLOATP (object))
@@ -612,7 +590,7 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
   (register Lisp_Object cell, Lisp_Object newcar)
 {
   CHECK_CONS (cell);
-  CHECK_IMPURE (cell);
+  CHECK_IMPURE (cell, XCONS (cell));
   XSETCAR (cell, newcar);
   return newcar;
 }
@@ -622,7 +600,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
   (register Lisp_Object cell, Lisp_Object newcdr)
 {
   CHECK_CONS (cell);
-  CHECK_IMPURE (cell);
+  CHECK_IMPURE (cell, XCONS (cell));
   XSETCDR (cell, newcdr);
   return newcdr;
 }
@@ -650,7 +628,7 @@ global value outside of any lexical scope.  */)
         struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
         if (blv->fwd)
           /* In set_internal, we un-forward vars when their value is
-             set to Qunbound. */
+             set to Qunbound.  */
           return Qt;
         else
           {
@@ -661,7 +639,7 @@ global value outside of any lexical scope.  */)
       }
     case SYMBOL_FORWARDED:
       /* In set_internal, we un-forward vars when their value is
-         set to Qunbound. */
+         set to Qunbound.  */
       return Qt;
     default: emacs_abort ();
     }
@@ -703,7 +681,7 @@ Return SYMBOL.  */)
 }
 
 DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
-       doc: /* Return SYMBOL's function definition.  Error if that is void.  */)
+       doc: /* Return SYMBOL's function definition, or nil if that is void.  */)
   (register Lisp_Object symbol)
 {
   CHECK_SYMBOL (symbol);
@@ -744,6 +722,11 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
   if (AUTOLOADP (function))
     Fput (symbol, Qautoload, XCDR (function));
 
+  /* Convert to eassert or remove after GC bug is found.  In the
+     meantime, check unconditionally, at a slight perf hit.  */
+  if (! valid_lisp_object_p (definition))
+    emacs_abort ();
+
   set_symbol_function (symbol, definition);
 
   return definition;
@@ -755,6 +738,10 @@ Associates the function with the current load file, if any.
 The optional third argument DOCSTRING specifies the documentation string
 for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
 determined by DEFINITION.
+
+Internally, this normally uses `fset', but if SYMBOL has a
+`defalias-fset-function' property, the associated value is used instead.
+
 The return value is undefined.  */)
   (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
 {
@@ -834,7 +821,7 @@ SUBR must be a built-in function.  */)
 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
        doc: /* Return the interactive form of CMD or nil if none.
 If CMD is not a command, the return value is nil.
-Value, if non-nil, is a list \(interactive SPEC).  */)
+Value, if non-nil, is a list (interactive SPEC).  */)
   (Lisp_Object cmd)
 {
   Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */
@@ -979,6 +966,50 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
     }
 }
 
+/* Used to signal a user-friendly error when symbol WRONG is
+   not a member of CHOICE, which should be a list of symbols.  */
+
+void
+wrong_choice (Lisp_Object choice, Lisp_Object wrong)
+{
+  ptrdiff_t i = 0, len = XINT (Flength (choice));
+  Lisp_Object obj, *args;
+  AUTO_STRING (one_of, "One of ");
+  AUTO_STRING (comma, ", ");
+  AUTO_STRING (or, " or ");
+  AUTO_STRING (should_be_specified, " should be specified");
+
+  USE_SAFE_ALLOCA;
+  SAFE_ALLOCA_LISP (args, len * 2 + 1);
+
+  args[i++] = one_of;
+
+  for (obj = choice; !NILP (obj); obj = XCDR (obj))
+    {
+      args[i++] = SYMBOL_NAME (XCAR (obj));
+      args[i++] = (NILP (XCDR (obj)) ? should_be_specified
+                   : NILP (XCDR (XCDR (obj))) ? or : comma);
+    }
+
+  obj = Fconcat (i, args);
+  SAFE_FREE ();
+  xsignal2 (Qerror, obj, wrong);
+}
+
+/* Used to signal a user-friendly error if WRONG is not a number or
+   integer/floating-point number outsize of inclusive MIN..MAX range.  */
+
+static void
+wrong_range (Lisp_Object min, Lisp_Object max, Lisp_Object wrong)
+{
+  AUTO_STRING (value_should_be_from, "Value should be from ");
+  AUTO_STRING (to, " to ");
+  xsignal2 (Qerror,
+            CALLN (Fconcat, value_should_be_from, Fnumber_to_string (min),
+                   to, Fnumber_to_string (max)),
+            wrong);
+}
+
 /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
    of SYMBOL.  If SYMBOL is buffer-local, VALCONTENTS should be the
    buffer-independent contents of the value cell: forwarded just one
@@ -1035,10 +1066,33 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
         int offset = XBUFFER_OBJFWD (valcontents)->offset;
         Lisp_Object predicate = XBUFFER_OBJFWD (valcontents)->predicate;
 
-        if (!NILP (predicate) && !NILP (newval)
-            && NILP (call1 (predicate, newval)))
-          wrong_type_argument (predicate, newval);
+        if (!NILP (newval))
+          {
+            if (SYMBOLP (predicate))
+              {
+                Lisp_Object prop;
+
+                if ((prop = Fget (predicate, Qchoice), !NILP (prop)))
+                  {
+                    if (NILP (Fmemq (newval, prop)))
+                      wrong_choice (prop, newval);
+                  }
+                else if ((prop = Fget (predicate, Qrange), !NILP (prop)))
+                  {
+                    Lisp_Object min = XCAR (prop), max = XCDR (prop);
 
+                    if (!NUMBERP (newval)
+                        || !NILP (arithcompare (newval, min, ARITH_LESS))
+                        || !NILP (arithcompare (newval, max, ARITH_GRTR)))
+                      wrong_range (min, max, newval);
+                  }
+                else if (FUNCTIONP (predicate))
+                  {
+                    if (NILP (call1 (predicate, newval)))
+                      wrong_type_argument (predicate, newval);
+                  }
+              }
+          }
         if (buf == NULL)
           buf = current_buffer;
         set_per_buffer_value (buf, offset, newval);
@@ -1254,10 +1308,10 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
 
             /* Find the new binding.  */
             XSETSYMBOL (symbol, sym); /* May have changed via aliasing.  */
-            tem1 = Fassq (symbol,
-                          (blv->frame_local
-                           ? XFRAME (where)->param_alist
-                           : BVAR (XBUFFER (where), local_var_alist)));
+            tem1 = assq_no_quit (symbol,
+                                 (blv->frame_local
+                                  ? XFRAME (where)->param_alist
+                                  : BVAR (XBUFFER (where), local_var_alist)));
             set_blv_where (blv, where);
             blv->found = 1;
 
@@ -1506,10 +1560,8 @@ usage: (setq-default [VAR VALUE]...)  */)
   (Lisp_Object args)
 {
   Lisp_Object args_left, symbol, val;
-  struct gcpro gcpro1;
 
   args_left = val = args;
-  GCPRO1 (args);
 
   while (CONSP (args_left))
     {
@@ -1519,7 +1571,6 @@ usage: (setq-default [VAR VALUE]...)  */)
       args_left = Fcdr (XCDR (args_left));
     }
 
-  UNGCPRO;
   return val;
 }
 
@@ -1568,8 +1619,12 @@ Note that binding the variable with `let', or setting it while
 a `let'-style binding made in this buffer is in effect,
 does not make the variable buffer-local.  Return VARIABLE.
 
-In most cases it is better to use `make-local-variable',
-which makes a variable local in just one buffer.
+This globally affects all uses of this variable, so it belongs together with
+the variable declaration, rather than with its uses (if you just want to make
+a variable local to the current buffer for one particular use, use
+`make-local-variable').  Buffer-local bindings are normally cleared
+while setting up a new major mode, unless they have a `permanent-local'
+property.
 
 The function `default-value' gets the default value and `set-default' sets it.  */)
   (register Lisp_Object variable)
@@ -1620,8 +1675,10 @@ The function `default-value' gets the default value and `set-default' sets it.
         Lisp_Object symbol;
         XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
         if (let_shadows_global_binding_p (symbol))
-          message ("Making %s buffer-local while let-bound!",
-                   SDATA (SYMBOL_NAME (variable)));
+          {
+            AUTO_STRING (format, "Making %s buffer-local while let-bound!");
+            CALLN (Fmessage, format, SYMBOL_NAME (variable));
+          }
       }
     }
 
@@ -1633,8 +1690,8 @@ DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
        1, 1, "vMake Local Variable: ",
        doc: /* Make VARIABLE have a separate value in the current buffer.
 Other buffers will continue to share a common default value.
-\(The buffer-local value of VARIABLE starts out as the same value
-VARIABLE previously had.  If VARIABLE was void, it remains void.\)
+(The buffer-local value of VARIABLE starts out as the same value
+VARIABLE previously had.  If VARIABLE was void, it remains void.)
 Return VARIABLE.
 
 If the variable is already arranged to become local when set,
@@ -1642,7 +1699,7 @@ this function causes a local value to exist for this buffer,
 just as setting the variable would do.
 
 This function returns VARIABLE, and therefore
-  (set (make-local-variable 'VARIABLE) VALUE-EXP)
+  (set (make-local-variable \\='VARIABLE) VALUE-EXP)
 works.
 
 See also `make-variable-buffer-local'.
@@ -1703,9 +1760,11 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
         Lisp_Object symbol;
         XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
         if (let_shadows_global_binding_p (symbol))
-          message ("Making %s local to %s while let-bound!",
-                   SDATA (SYMBOL_NAME (variable)),
-                   SDATA (BVAR (current_buffer, name)));
+          {
+            AUTO_STRING (format, "Making %s local to %s while let-bound!");
+            CALLN (Fmessage, format, SYMBOL_NAME (variable),
+                   BVAR (current_buffer, name));
+          }
       }
     }
 
@@ -1715,8 +1774,11 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
   if (NILP (tem))
     {
       if (let_shadows_buffer_binding_p (sym))
-        message ("Making %s buffer-local while locally let-bound!",
-                 SDATA (SYMBOL_NAME (variable)));
+        {
+          AUTO_STRING (format,
+                       "Making %s buffer-local while locally let-bound!");
+          CALLN (Fmessage, format, SYMBOL_NAME (variable));
+        }
 
       /* Swap out any local binding for some other buffer, and make
          sure the current value is permanently recorded, if it's the
@@ -1881,8 +1943,10 @@ frame-local bindings).  */)
     Lisp_Object symbol;
     XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
     if (let_shadows_global_binding_p (symbol))
-      message ("Making %s frame-local while let-bound!",
-               SDATA (SYMBOL_NAME (variable)));
+      {
+        AUTO_STRING (format, "Making %s frame-local while let-bound!");
+        CALLN (Fmessage, format, SYMBOL_NAME (variable));
+      }
   }
   return variable;
 }
@@ -1891,19 +1955,11 @@ DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
        1, 2, 0,
        doc: /* Non-nil if VARIABLE has a local binding in buffer BUFFER.
 BUFFER defaults to the current buffer.  */)
-  (register Lisp_Object variable, Lisp_Object buffer)
+  (Lisp_Object variable, Lisp_Object buffer)
 {
-  register struct buffer *buf;
+  struct buffer *buf = decode_buffer (buffer);
   struct Lisp_Symbol *sym;
 
-  if (NILP (buffer))
-    buf = current_buffer;
-  else
-    {
-      CHECK_BUFFER (buffer);
-      buf = XBUFFER (buffer);
-    }
-
   CHECK_SYMBOL (variable);
   sym = XSYMBOL (variable);
 
@@ -2029,7 +2085,7 @@ If the current binding is global (the default), the value is nil.  */)
 }
 
 /* This code is disabled now that we use the selected frame to return
-   keyboard-local-values. */
+   keyboard-local-values.  */
 #if 0
 extern struct terminal *get_terminal (Lisp_Object display, int);
 
@@ -2108,8 +2164,6 @@ DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0,
        doc: /* Return the function at the end of OBJECT's function chain.
 If OBJECT is not a symbol, just return it.  Otherwise, follow all
 function indirections to find the final function binding and return it.
-If the final symbol in the chain is unbound, signal a void-function error.
-Optional arg NOERROR non-nil means to return nil instead of signaling.
 Signal a cyclic-function-indirection error if there is a loop in the
 function chain of symbols.  */)
   (register Lisp_Object object, Lisp_Object noerror)
@@ -2124,9 +2178,6 @@ function chain of symbols.  */)
   if (!NILP (result))
     return result;
 
-  if (NILP (noerror))
-    xsignal1 (Qvoid_function, object);
-
   return Qnil;
 }
 
@@ -2158,13 +2209,9 @@ or a byte-code object.  IDX starts at 0.  */)
     }
   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))
     {
@@ -2198,28 +2245,19 @@ bool-vector.  IDX starts at 0.  */)
   CHECK_NUMBER (idx);
   idxval = XINT (idx);
   CHECK_ARRAY (array, Qarrayp);
-  CHECK_IMPURE (array);
 
   if (VECTORP (array))
     {
+      CHECK_IMPURE (array, XVECTOR (array));
       if (idxval < 0 || idxval >= ASIZE (array))
         args_out_of_range (array, idx);
       ASET (array, idxval, newelt);
     }
   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))
     {
@@ -2230,6 +2268,7 @@ bool-vector.  IDX starts at 0.  */)
     {
       int c;
 
+      CHECK_IMPURE (array, XSTRING (array));
       if (idxval < 0 || idxval >= SCHARS (array))
         args_out_of_range (array, idx);
       CHECK_CHARACTER (newelt);
@@ -2270,7 +2309,7 @@ bool-vector.  IDX starts at 0.  */)
         {
           if (! SINGLE_BYTE_CHAR_P (c))
             {
-              int i;
+              ptrdiff_t i;
 
               for (i = SBYTES (array) - 1; i >= 0; i--)
                 if (SREF (array, i) >= 0x80)
@@ -2289,10 +2328,8 @@ bool-vector.  IDX starts at 0.  */)
 
 /* Arithmetic functions */
 
-enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal };
-
-static Lisp_Object
-arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
+Lisp_Object
+arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison)
 {
   double f1 = 0, f2 = 0;
   bool floatp = 0;
@@ -2309,32 +2346,32 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
 
   switch (comparison)
     {
-    case equal:
+    case ARITH_EQUAL:
       if (floatp ? f1 == f2 : XINT (num1) == XINT (num2))
         return Qt;
       return Qnil;
 
-    case notequal:
+    case ARITH_NOTEQUAL:
       if (floatp ? f1 != f2 : XINT (num1) != XINT (num2))
         return Qt;
       return Qnil;
 
-    case less:
+    case ARITH_LESS:
       if (floatp ? f1 < f2 : XINT (num1) < XINT (num2))
         return Qt;
       return Qnil;
 
-    case less_or_equal:
+    case ARITH_LESS_OR_EQUAL:
       if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2))
         return Qt;
       return Qnil;
 
-    case grtr:
+    case ARITH_GRTR:
       if (floatp ? f1 > f2 : XINT (num1) > XINT (num2))
         return Qt;
       return Qnil;
 
-    case grtr_or_equal:
+    case ARITH_GRTR_OR_EQUAL:
       if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
         return Qt;
       return Qnil;
@@ -2344,66 +2381,64 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
     }
 }
 
-DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0,
-       doc: /* Return t if two args, both numbers or markers, are equal.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+static Lisp_Object
+arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
+                     enum Arith_Comparison comparison)
 {
-  return arithcompare (num1, num2, equal);
+  ptrdiff_t argnum;
+  for (argnum = 1; argnum < nargs; ++argnum)
+    {
+      if (EQ (Qnil, arithcompare (args[argnum - 1], args[argnum], comparison)))
+        return Qnil;
+    }
+  return Qt;
 }
 
-DEFUN ("<", Flss, Slss, 2, 2, 0,
-       doc: /* Return t if first arg is less than second arg.  Both must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("=", Feqlsign, Seqlsign, 1, MANY, 0,
+       doc: /* Return t if args, all numbers or markers, are equal.
+usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, less);
+  return arithcompare_driver (nargs, args, ARITH_EQUAL);
 }
 
-DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
-       doc: /* Return t if first arg is greater than second arg.  Both must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("<", Flss, Slss, 1, MANY, 0,
+       doc: /* Return t if each arg (a number or marker), is less than the next arg.
+usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, grtr);
+  return arithcompare_driver (nargs, args, ARITH_LESS);
 }
 
-DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
-       doc: /* Return t if first arg is less than or equal to second arg.
-Both must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN (">", Fgtr, Sgtr, 1, MANY, 0,
+       doc: /* Return t if each arg (a number or marker) is greater than the next arg.
+usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, less_or_equal);
+  return arithcompare_driver (nargs, args, ARITH_GRTR);
 }
 
-DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
-       doc: /* Return t if first arg is greater than or equal to second arg.
-Both must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("<=", Fleq, Sleq, 1, MANY, 0,
+       doc: /* Return t if each arg (a number or marker) is less than or equal to the next.
+usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, grtr_or_equal);
+  return arithcompare_driver (nargs, args, ARITH_LESS_OR_EQUAL);
 }
 
-DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
-       doc: /* Return t if first arg is not equal to second arg.  Both must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0,
+       doc: /* Return t if each arg (a number or marker) is greater than or equal to the next.
+usage: (>= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, notequal);
+  return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL);
 }
 
-DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
-       doc: /* Return t if NUMBER is zero.  */)
-  (register Lisp_Object number)
+DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
+       doc: /* Return t if first arg is not equal to second arg.  Both must be numbers or markers.  */)
+  (register Lisp_Object num1, Lisp_Object num2)
 {
-  CHECK_NUMBER_OR_FLOAT (number);
-
-  if (FLOATP (number))
-    {
-      if (XFLOAT_DATA (number) == 0.0)
-        return Qt;
-      return Qnil;
-    }
-
-  if (!XINT (number))
-    return Qt;
-  return Qnil;
+  return arithcompare (num1, num2, ARITH_NOTEQUAL);
 }
 
 /* Convert the cons-of-integers, integer, or float value C to an
@@ -2533,12 +2568,12 @@ NUMBER may be an integer or a floating point number.  */)
 
 DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
        doc: /* Parse STRING as a decimal number and return the number.
-This parses both integers and floating point numbers.
-It ignores leading spaces and tabs, and all trailing chars.
+Ignore leading spaces and tabs, and all trailing chars.  Return 0 if
+STRING cannot be parsed as an integer or floating point number.
 
 If BASE, interpret STRING as a number in that base.  If BASE isn't
 present, base 10 is used.  BASE must be between 2 and 16 (inclusive).
-If the base used is not 10, STRING is always parsed as integer.  */)
+If the base used is not 10, STRING is always parsed as an integer.  */)
   (register Lisp_Object string, Lisp_Object base)
 {
   register char *p;
@@ -2598,6 +2633,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
       accum = 0;
       break;
     case Amult:
+    case Adiv:
       accum = 1;
       break;
     case Alogand:
@@ -2653,7 +2689,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
             accum *= next;
           break;
         case Adiv:
-          if (!argnum)
+          if (! (argnum || nargs == 1))
             accum = next;
           else
             {
@@ -2722,7 +2758,7 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
           accum *= next;
           break;
         case Adiv:
-          if (!argnum)
+          if (! (argnum || nargs == 1))
             accum = next;
           else
             {
@@ -2777,9 +2813,11 @@ usage: (* &rest NUMBERS-OR-MARKERS)  */)
 }
 
 DEFUN ("/", Fquo, Squo, 1, MANY, 0,
-       doc: /* Return first argument divided by all the remaining arguments.
+       doc: /* Divide number by divisors and return the result.
+With two or more arguments, return first argument divided by the rest.
+With one argument, return 1 divided by the argument.
 The arguments must be numbers or markers.
-usage: (/ DIVIDEND &rest DIVISORS)  */)
+usage: (/ NUMBER &rest DIVISORS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t argnum;
@@ -2896,7 +2934,7 @@ In this case, the sign bit is duplicated.  */)
   if (XINT (count) >= BITS_PER_EMACS_INT)
     XSETINT (val, 0);
   else if (XINT (count) > 0)
-    XSETINT (val, XINT (value) << XFASTINT (count));
+    XSETINT (val, XUINT (value) << XFASTINT (count));
   else if (XINT (count) <= -BITS_PER_EMACS_INT)
     XSETINT (val, XINT (value) < 0 ? -1 : 0);
   else
@@ -2966,7 +3004,8 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
 DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
        doc: /* Return the byteorder for the machine.
 Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII
-lowercase l) for small endian machines.  */)
+lowercase l) for small endian machines.  */
+       attributes: const)
   (void)
 {
   unsigned i = 0x04030201;
@@ -2975,6 +3014,434 @@ lowercase l) for small endian machines.  */)
   return make_number (order);
 }
 
+/* Because we round up the bool vector allocate size to word_size
+   units, we can safely read past the "end" of the vector in the
+   operations below.  These extra bits are always zero.  */
+
+static bits_word
+bool_vector_spare_mask (EMACS_INT nr_bits)
+{
+  return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1;
+}
+
+/* Info about unsigned long long, falling back on unsigned long
+   if unsigned long long is not available.  */
+
+#if HAVE_UNSIGNED_LONG_LONG_INT && defined ULLONG_MAX
+enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long long) };
+# define ULL_MAX ULLONG_MAX
+#else
+enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long) };
+# define ULL_MAX ULONG_MAX
+# define count_one_bits_ll count_one_bits_l
+# define count_trailing_zeros_ll count_trailing_zeros_l
+#endif
+
+/* Shift VAL right by the width of an unsigned long long.
+   BITS_PER_ULL must be less than BITS_PER_BITS_WORD.  */
+
+static bits_word
+shift_right_ull (bits_word w)
+{
+  /* Pacify bogus GCC warning about shift count exceeding type width.  */
+  int shift = BITS_PER_ULL - BITS_PER_BITS_WORD < 0 ? BITS_PER_ULL : 0;
+  return w >> shift;
+}
+
+/* Return the number of 1 bits in W.  */
+
+static int
+count_one_bits_word (bits_word w)
+{
+  if (BITS_WORD_MAX <= UINT_MAX)
+    return count_one_bits (w);
+  else if (BITS_WORD_MAX <= ULONG_MAX)
+    return count_one_bits_l (w);
+  else
+    {
+      int i = 0, count = 0;
+      while (count += count_one_bits_ll (w),
+             (i += BITS_PER_ULL) < BITS_PER_BITS_WORD)
+        w = shift_right_ull (w);
+      return count;
+    }
+}
+
+enum bool_vector_op { bool_vector_exclusive_or,
+                      bool_vector_union,
+                      bool_vector_intersection,
+                      bool_vector_set_difference,
+                      bool_vector_subsetp };
+
+static Lisp_Object
+bool_vector_binop_driver (Lisp_Object a,
+                          Lisp_Object b,
+                          Lisp_Object dest,
+                          enum bool_vector_op op)
+{
+  EMACS_INT nr_bits;
+  bits_word *adata, *bdata, *destdata;
+  ptrdiff_t i = 0;
+  ptrdiff_t nr_words;
+
+  CHECK_BOOL_VECTOR (a);
+  CHECK_BOOL_VECTOR (b);
+
+  nr_bits = bool_vector_size (a);
+  if (bool_vector_size (b) != nr_bits)
+    wrong_length_argument (a, b, dest);
+
+  nr_words = bool_vector_words (nr_bits);
+  adata = bool_vector_data (a);
+  bdata = bool_vector_data (b);
+
+  if (NILP (dest))
+    {
+      dest = make_uninit_bool_vector (nr_bits);
+      destdata = bool_vector_data (dest);
+    }
+  else
+    {
+      CHECK_BOOL_VECTOR (dest);
+      destdata = bool_vector_data (dest);
+      if (bool_vector_size (dest) != nr_bits)
+        wrong_length_argument (a, b, dest);
+
+      switch (op)
+        {
+        case bool_vector_exclusive_or:
+          for (; i < nr_words; i++)
+            if (destdata[i] != (adata[i] ^ bdata[i]))
+              goto set_dest;
+          break;
+
+        case bool_vector_subsetp:
+          for (; i < nr_words; i++)
+            if (adata[i] &~ bdata[i])
+              return Qnil;
+          return Qt;
+
+        case bool_vector_union:
+          for (; i < nr_words; i++)
+            if (destdata[i] != (adata[i] | bdata[i]))
+              goto set_dest;
+          break;
+
+        case bool_vector_intersection:
+          for (; i < nr_words; i++)
+            if (destdata[i] != (adata[i] & bdata[i]))
+              goto set_dest;
+          break;
+
+        case bool_vector_set_difference:
+          for (; i < nr_words; i++)
+            if (destdata[i] != (adata[i] &~ bdata[i]))
+              goto set_dest;
+          break;
+        }
+
+      return Qnil;
+    }
+
+ set_dest:
+  switch (op)
+    {
+    case bool_vector_exclusive_or:
+      for (; i < nr_words; i++)
+        destdata[i] = adata[i] ^ bdata[i];
+      break;
+
+    case bool_vector_union:
+      for (; i < nr_words; i++)
+        destdata[i] = adata[i] | bdata[i];
+      break;
+
+    case bool_vector_intersection:
+      for (; i < nr_words; i++)
+        destdata[i] = adata[i] & bdata[i];
+      break;
+
+    case bool_vector_set_difference:
+      for (; i < nr_words; i++)
+        destdata[i] = adata[i] &~ bdata[i];
+      break;
+
+    default:
+      eassume (0);
+    }
+
+  return dest;
+}
+
+/* PRECONDITION must be true.  Return VALUE.  This odd construction
+   works around a bogus GCC diagnostic "shift count >= width of type".  */
+
+static int
+pre_value (bool precondition, int value)
+{
+  eassume (precondition);
+  return precondition ? value : 0;
+}
+
+/* Compute the number of trailing zero bits in val.  If val is zero,
+   return the number of bits in val.  */
+static int
+count_trailing_zero_bits (bits_word val)
+{
+  if (BITS_WORD_MAX == UINT_MAX)
+    return count_trailing_zeros (val);
+  if (BITS_WORD_MAX == ULONG_MAX)
+    return count_trailing_zeros_l (val);
+  if (BITS_WORD_MAX == ULL_MAX)
+    return count_trailing_zeros_ll (val);
+
+  /* The rest of this code is for the unlikely platform where bits_word differs
+     in width from unsigned int, unsigned long, and unsigned long long.  */
+  val |= ~ BITS_WORD_MAX;
+  if (BITS_WORD_MAX <= UINT_MAX)
+    return count_trailing_zeros (val);
+  if (BITS_WORD_MAX <= ULONG_MAX)
+    return count_trailing_zeros_l (val);
+  else
+    {
+      int count;
+      for (count = 0;
+           count < BITS_PER_BITS_WORD - BITS_PER_ULL;
+           count += BITS_PER_ULL)
+        {
+          if (val & ULL_MAX)
+            return count + count_trailing_zeros_ll (val);
+          val = shift_right_ull (val);
+        }
+
+      if (BITS_PER_BITS_WORD % BITS_PER_ULL != 0
+          && BITS_WORD_MAX == (bits_word) -1)
+        val |= (bits_word) 1 << pre_value (ULONG_MAX < BITS_WORD_MAX,
+                                           BITS_PER_BITS_WORD % BITS_PER_ULL);
+      return count + count_trailing_zeros_ll (val);
+    }
+}
+
+static bits_word
+bits_word_to_host_endian (bits_word val)
+{
+#ifndef WORDS_BIGENDIAN
+  return val;
+#else
+  if (BITS_WORD_MAX >> 31 == 1)
+    return bswap_32 (val);
+# if HAVE_UNSIGNED_LONG_LONG
+  if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1)
+    return bswap_64 (val);
+# endif
+  {
+    int i;
+    bits_word r = 0;
+    for (i = 0; i < sizeof val; i++)
+      {
+        r = ((r << 1 << (CHAR_BIT - 1))
+             | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1)));
+        val = val >> 1 >> (CHAR_BIT - 1);
+      }
+    return r;
+  }
+#endif
+}
+
+DEFUN ("bool-vector-exclusive-or", Fbool_vector_exclusive_or,
+       Sbool_vector_exclusive_or, 2, 3, 0,
+       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: /* 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: /* 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: /* 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-subsetp", Fbool_vector_subsetp,
+       Sbool_vector_subsetp, 2, 2, 0,
+       doc: /* Return t if every t value in A is also t in B, nil otherwise.
+A and B must be bool vectors of the same length.  */)
+  (Lisp_Object a, Lisp_Object b)
+{
+  return bool_vector_binop_driver (a, b, b, bool_vector_subsetp);
+}
+
+DEFUN ("bool-vector-not", Fbool_vector_not,
+       Sbool_vector_not, 1, 2, 0,
+       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;
+
+  CHECK_BOOL_VECTOR (a);
+  nr_bits = bool_vector_size (a);
+
+  if (NILP (b))
+    b = make_uninit_bool_vector (nr_bits);
+  else
+    {
+      CHECK_BOOL_VECTOR (b);
+      if (bool_vector_size (b) != nr_bits)
+        wrong_length_argument (a, b, Qnil);
+    }
+
+  bdata = bool_vector_data (b);
+  adata = bool_vector_data (a);
+
+  for (i = 0; i < nr_bits / BITS_PER_BITS_WORD; i++)
+    bdata[i] = BITS_WORD_MAX & ~adata[i];
+
+  if (nr_bits % BITS_PER_BITS_WORD)
+    {
+      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);
+    }
+
+  return b;
+}
+
+DEFUN ("bool-vector-count-population", Fbool_vector_count_population,
+       Sbool_vector_count_population, 1, 1, 0,
+       doc: /* Count how many elements in A are t.
+A is a bool vector.  To count A's nil elements, subtract the return
+value from A's length.  */)
+  (Lisp_Object a)
+{
+  EMACS_INT count;
+  EMACS_INT nr_bits;
+  bits_word *adata;
+  ptrdiff_t i, nwords;
+
+  CHECK_BOOL_VECTOR (a);
+
+  nr_bits = bool_vector_size (a);
+  nwords = bool_vector_words (nr_bits);
+  count = 0;
+  adata = bool_vector_data (a);
+
+  for (i = 0; i < nwords; i++)
+    count += count_one_bits_word (adata[i]);
+
+  return make_number (count);
+}
+
+DEFUN ("bool-vector-count-consecutive", Fbool_vector_count_consecutive,
+       Sbool_vector_count_consecutive, 3, 3, 0,
+       doc: /* Count how many consecutive elements in A equal B starting at I.
+A is a bool vector, B is t or nil, and I is an index into A.  */)
+  (Lisp_Object a, Lisp_Object b, Lisp_Object i)
+{
+  EMACS_INT count;
+  EMACS_INT nr_bits;
+  int offset;
+  bits_word *adata;
+  bits_word twiddle;
+  bits_word mword; /* Machine word.  */
+  ptrdiff_t pos, pos0;
+  ptrdiff_t nr_words;
+
+  CHECK_BOOL_VECTOR (a);
+  CHECK_NATNUM (i);
+
+  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 = 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 : BITS_WORD_MAX;
+
+  /* Scan the remainder of the mword at the current offset.  */
+  if (pos < nr_words && offset != 0)
+    {
+      mword = bits_word_to_host_endian (adata[pos]);
+      mword ^= twiddle;
+      mword >>= offset;
+
+      /* Do not count the pad bits.  */
+      mword |= (bits_word) 1 << (BITS_PER_BITS_WORD - offset);
+
+      count = count_trailing_zero_bits (mword);
+      pos++;
+      if (count + offset < BITS_PER_BITS_WORD)
+        return make_number (count);
+    }
+
+  /* Scan whole words until we either reach the end of the vector or
+     find an mword that doesn't completely match.  twiddle is
+     endian-independent.  */
+  pos0 = pos;
+  while (pos < nr_words && adata[pos] == twiddle)
+    pos++;
+  count += (pos - pos0) * BITS_PER_BITS_WORD;
+
+  if (pos < nr_words)
+    {
+      /* If we stopped because of a mismatch, see how many bits match
+         in the current mword.  */
+      mword = bits_word_to_host_endian (adata[pos]);
+      mword ^= twiddle;
+      count += count_trailing_zero_bits (mword);
+    }
+  else if (nr_bits % BITS_PER_BITS_WORD != 0)
+    {
+      /* If we hit the end, we might have overshot our count.  Reduce
+         the total by the number of spare bits at the end of the
+         vector.  */
+      count -= BITS_PER_BITS_WORD - nr_bits % BITS_PER_BITS_WORD;
+    }
+
+  return make_number (count);
+}
 
 
 void
@@ -2992,6 +3459,7 @@ syms_of_data (void)
   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");
@@ -3015,7 +3483,6 @@ syms_of_data (void)
   DEFSYM (Qlistp, "listp");
   DEFSYM (Qconsp, "consp");
   DEFSYM (Qsymbolp, "symbolp");
-  DEFSYM (Qkeywordp, "keywordp");
   DEFSYM (Qintegerp, "integerp");
   DEFSYM (Qnatnump, "natnump");
   DEFSYM (Qwholenump, "wholenump");
@@ -3024,11 +3491,11 @@ syms_of_data (void)
   DEFSYM (Qsequencep, "sequencep");
   DEFSYM (Qbufferp, "bufferp");
   DEFSYM (Qvectorp, "vectorp");
+  DEFSYM (Qbool_vector_p, "bool-vector-p");
   DEFSYM (Qchar_or_string_p, "char-or-string-p");
   DEFSYM (Qmarkerp, "markerp");
   DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
   DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
-  DEFSYM (Qboundp, "boundp");
   DEFSYM (Qfboundp, "fboundp");
 
   DEFSYM (Qfloatp, "floatp");
@@ -3044,10 +3511,6 @@ syms_of_data (void)
 
   DEFSYM (Qcdr, "cdr");
 
-  /* Handle automatic advice activation.  */
-  DEFSYM (Qad_advice_info, "ad-advice-info");
-  DEFSYM (Qad_activate_internal, "ad-activate-internal");
-
   error_tail = pure_cons (Qerror, Qnil);
 
   /* ERROR is used as a signaler for random errors for which nothing else is
@@ -3065,6 +3528,7 @@ syms_of_data (void)
   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,
@@ -3113,10 +3577,6 @@ syms_of_data (void)
   PUT_ERROR (Qunderflow_error, Fcons (Qdomain_error, arith_tail),
              "Arithmetic underflow error");
 
-  staticpro (&Qnil);
-  staticpro (&Qt);
-  staticpro (&Qunbound);
-
   /* Types that type-of returns.  */
   DEFSYM (Qinteger, "integer");
   DEFSYM (Qsymbol, "symbol");
@@ -3124,6 +3584,7 @@ syms_of_data (void)
   DEFSYM (Qcons, "cons");
   DEFSYM (Qmarker, "marker");
   DEFSYM (Qoverlay, "overlay");
+  DEFSYM (Qfinalizer, "finalizer");
   DEFSYM (Qfloat, "float");
   DEFSYM (Qwindow_configuration, "window-configuration");
   DEFSYM (Qprocess, "process");
@@ -3138,7 +3599,6 @@ syms_of_data (void)
   DEFSYM (Qthread, "thread");
   DEFSYM (Qmutex, "mutex");
   DEFSYM (Qcondition_variable, "condition-variable");
-  DEFSYM (Qmisc, "misc");
 
   DEFSYM (Qdefun, "defun");
 
@@ -3226,7 +3686,6 @@ syms_of_data (void)
   defsubr (&Sleq);
   defsubr (&Sgeq);
   defsubr (&Sneq);
-  defsubr (&Szerop);
   defsubr (&Splus);
   defsubr (&Sminus);
   defsubr (&Stimes);
@@ -3247,6 +3706,15 @@ syms_of_data (void)
   defsubr (&Ssubr_arity);
   defsubr (&Ssubr_name);
 
+  defsubr (&Sbool_vector_exclusive_or);
+  defsubr (&Sbool_vector_union);
+  defsubr (&Sbool_vector_intersection);
+  defsubr (&Sbool_vector_set_difference);
+  defsubr (&Sbool_vector_not);
+  defsubr (&Sbool_vector_subsetp);
+  defsubr (&Sbool_vector_count_consecutive);
+  defsubr (&Sbool_vector_count_population);
+
   set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function);
 
   DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,