X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ab422c4d6899b1442cb6954c1829c1fb656b006c..d57f4dde80447f0fcdb1c31df7f0657fd2eea369:/src/data.c

diff --git a/src/data.c b/src/data.c
index c44bdb16cd..4043fbe279 100644
--- a/src/data.c
+++ b/src/data.c
@@ -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"
@@ -38,6 +41,7 @@ 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_length_argument;
 static Lisp_Object Qwrong_type_argument;
 Lisp_Object Qvoid_variable, Qvoid_function;
 static Lisp_Object Qcyclic_function_indirection;
@@ -54,6 +58,7 @@ 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 Qbool_vector_p;
 Lisp_Object Qbuffer_or_string_p;
 static Lisp_Object Qkeywordp, Qboundp;
 Lisp_Object Qfboundp;
@@ -76,14 +81,116 @@ 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, Qmany, Qunevalled;
+static Lisp_Object Qsubrp;
+static Lisp_Object Qmany, Qunevalled;
 Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
 static Lisp_Object Qdefun;
 
 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 bool
+BOOLFWDP (union Lisp_Fwd *a)
+{
+  return XFWDTYPE (a) == Lisp_Fwd_Bool;
+}
+static bool
+INTFWDP (union Lisp_Fwd *a)
+{
+  return XFWDTYPE (a) == Lisp_Fwd_Int;
+}
+static bool
+KBOARD_OBJFWDP (union Lisp_Fwd *a)
+{
+  return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj;
+}
+static bool
+OBJFWDP (union Lisp_Fwd *a)
+{
+  return XFWDTYPE (a) == Lisp_Fwd_Obj;
+}
+
+static struct Lisp_Boolfwd *
+XBOOLFWD (union Lisp_Fwd *a)
+{
+  eassert (BOOLFWDP (a));
+  return &a->u_boolfwd;
+}
+static struct Lisp_Kboard_Objfwd *
+XKBOARD_OBJFWD (union Lisp_Fwd *a)
+{
+  eassert (KBOARD_OBJFWDP (a));
+  return &a->u_kboard_objfwd;
+}
+static struct Lisp_Intfwd *
+XINTFWD (union Lisp_Fwd *a)
+{
+  eassert (INTFWDP (a));
+  return &a->u_intfwd;
+}
+static struct Lisp_Objfwd *
+XOBJFWD (union Lisp_Fwd *a)
+{
+  eassert (OBJFWDP (a));
+  return &a->u_objfwd;
+}
+
+static void
+CHECK_SUBR (Lisp_Object x)
+{
+  CHECK_TYPE (SUBRP (x), Qsubrp, x);
+}
+
+static void
+set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
+{
+  eassert (found == !EQ (blv->defcell, blv->valcell));
+  blv->found = found;
+}
+
+static Lisp_Object
+blv_value (struct Lisp_Buffer_Local_Value *blv)
+{
+  return XCDR (blv->valcell);
+}
+
+static void
+set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+  XSETCDR (blv->valcell, val);
+}
+
+static void
+set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+  blv->where = val;
+}
+
+static void
+set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+  blv->defcell = val;
+}
+
+static void
+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)
@@ -99,9 +206,9 @@ wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
 }
 
 void
-pure_write_error (void)
+pure_write_error (Lisp_Object obj)
 {
-  error ("Attempt to modify read-only object");
+  xsignal2 (Qerror, build_string ("Attempt to modify read-only object"), obj);
 }
 
 void
@@ -287,7 +394,8 @@ DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
 
 DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p,
        1, 1, 0,
-       doc: /* Return t if OBJECT is a multibyte string.  */)
+       doc: /* Return t if OBJECT is a multibyte string.
+Return nil if OBJECT is either a unibyte string, or not a string.  */)
   (Lisp_Object object)
 {
   if (STRINGP (object) && STRING_MULTIBYTE (object))
@@ -444,7 +552,7 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
 }
 
 
-/* Extract and set components of lists */
+/* Extract and set components of lists.  */
 
 DEFUN ("car", Fcar, Scar, 1, 1, 0,
        doc: /* Return the car of LIST.  If arg is nil, return nil.
@@ -525,7 +633,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
 	  {
@@ -536,7 +644,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 ();
     }
@@ -544,12 +652,13 @@ global value outside of any lexical scope.  */)
   return (EQ (valcontents, Qunbound) ? Qnil : Qt);
 }
 
+/* FIXME: Make it an alias for function-symbol!  */
 DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
        doc: /* Return t if SYMBOL's function definition is not void.  */)
   (register Lisp_Object symbol)
 {
   CHECK_SYMBOL (symbol);
-  return EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt;
+  return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
 }
 
 DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
@@ -565,14 +674,14 @@ Return SYMBOL.  */)
 }
 
 DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
-       doc: /* Make SYMBOL's function definition be void.
+       doc: /* Make SYMBOL's function definition be nil.
 Return SYMBOL.  */)
   (register Lisp_Object symbol)
 {
   CHECK_SYMBOL (symbol);
   if (NILP (symbol) || EQ (symbol, Qt))
     xsignal1 (Qsetting_constant, symbol);
-  set_symbol_function (symbol, Qunbound);
+  set_symbol_function (symbol, Qnil);
   return symbol;
 }
 
@@ -581,9 +690,7 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
   (register Lisp_Object symbol)
 {
   CHECK_SYMBOL (symbol);
-  if (!EQ (XSYMBOL (symbol)->function, Qunbound))
-    return XSYMBOL (symbol)->function;
-  xsignal1 (Qvoid_function, symbol);
+  return XSYMBOL (symbol)->function;
 }
 
 DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
@@ -610,27 +717,18 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
   (register Lisp_Object symbol, Lisp_Object definition)
 {
   register Lisp_Object function;
-
   CHECK_SYMBOL (symbol);
-  if (NILP (symbol) || EQ (symbol, Qt))
-    xsignal1 (Qsetting_constant, symbol);
 
   function = XSYMBOL (symbol)->function;
 
-  if (!NILP (Vautoload_queue) && !EQ (function, Qunbound))
+  if (!NILP (Vautoload_queue) && !NILP (function))
     Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
 
-  if (CONSP (function) && EQ (XCAR (function), Qautoload))
+  if (AUTOLOADP (function))
     Fput (symbol, Qautoload, XCDR (function));
 
   set_symbol_function (symbol, definition);
-  /* Handle automatic advice activation.  */
-  if (CONSP (XSYMBOL (symbol)->plist)
-      && !NILP (Fget (symbol, Qad_advice_info)))
-    {
-      call2 (Qad_activate_internal, symbol, Qnil);
-      definition = XSYMBOL (symbol)->function;
-    }
+
   return definition;
 }
 
@@ -644,15 +742,32 @@ The return value is undefined.  */)
   (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
 {
   CHECK_SYMBOL (symbol);
-  if (CONSP (XSYMBOL (symbol)->function)
-      && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
-    LOADHIST_ATTACH (Fcons (Qt, symbol));
   if (!NILP (Vpurify_flag)
       /* If `definition' is a keymap, immutable (and copying) is wrong.  */
       && !KEYMAPP (definition))
     definition = Fpurecopy (definition);
-  definition = Ffset (symbol, definition);
-  LOADHIST_ATTACH (Fcons (Qdefun, symbol));
+
+  {
+    bool autoload = AUTOLOADP (definition);
+    if (NILP (Vpurify_flag) || !autoload)
+      { /* Only add autoload entries after dumping, because the ones before are
+	   not useful and else we get loads of them from the loaddefs.el.  */
+
+	if (AUTOLOADP (XSYMBOL (symbol)->function))
+	  /* Remember that the function was already an autoload.  */
+	  LOADHIST_ATTACH (Fcons (Qt, symbol));
+	LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
+      }
+  }
+
+  { /* Handle automatic advice activation.  */
+    Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
+    if (!NILP (hook))
+      call2 (hook, symbol, definition);
+    else
+      Ffset (symbol, definition);
+  }
+
   if (!NILP (docstring))
     Fput (symbol, Qfunction_documentation, docstring);
   /* We used to return `definition', but now that `defun' and `defmacro' expand
@@ -682,12 +797,10 @@ function with `&rest' args, or `unevalled' for a special form.  */)
   CHECK_SUBR (subr);
   minargs = XSUBR (subr)->min_args;
   maxargs = XSUBR (subr)->max_args;
-  if (maxargs == MANY)
-    return Fcons (make_number (minargs), Qmany);
-  else if (maxargs == UNEVALLED)
-    return Fcons (make_number (minargs), Qunevalled);
-  else
-    return Fcons (make_number (minargs), make_number (maxargs));
+  return Fcons (make_number (minargs),
+		maxargs == MANY ?        Qmany
+		: maxargs == UNEVALLED ? Qunevalled
+		:                        make_number (maxargs));
 }
 
 DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
@@ -709,11 +822,11 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
 {
   Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */
 
-  if (NILP (fun) || EQ (fun, Qunbound))
+  if (NILP (fun))
     return Qnil;
 
   /* Use an `interactive-form' property if present, analogous to the
-     function-documentation property. */
+     function-documentation property.  */
   fun = cmd;
   while (SYMBOLP (fun))
     {
@@ -737,6 +850,8 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
 	return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
     }
+  else if (AUTOLOADP (fun))
+    return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
   else if (CONSP (fun))
     {
       Lisp_Object funcar = XCAR (fun);
@@ -744,14 +859,6 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
 	return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
       else if (EQ (funcar, Qlambda))
 	return Fassq (Qinteractive, Fcdr (XCDR (fun)));
-      else if (EQ (funcar, Qautoload))
-	{
-	  struct gcpro gcpro1;
-	  GCPRO1 (cmd);
-	  Fautoload_do_load (fun, cmd, Qnil);
-	  UNGCPRO;
-	  return Finteractive_form (cmd);
-	}
     }
   return Qnil;
 }
@@ -891,19 +998,14 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
 			- (char *) &buffer_defaults);
 	  int idx = PER_BUFFER_IDX (offset);
 
-	  Lisp_Object tail;
+	  Lisp_Object tail, buf;
 
 	  if (idx <= 0)
 	    break;
 
-	  for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
+	  FOR_EACH_LIVE_BUFFER (tail, buf)
 	    {
-	      Lisp_Object lbuf;
-	      struct buffer *b;
-
-	      lbuf = Fcdr (XCAR (tail));
-	      if (!BUFFERP (lbuf)) continue;
-	      b = XBUFFER (lbuf);
+	      struct buffer *b = XBUFFER (buf);
 
 	      if (! PER_BUFFER_VALUE_P (b, idx))
 		set_per_buffer_value (b, offset, newval);
@@ -914,13 +1016,11 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
     case Lisp_Fwd_Buffer_Obj:
       {
 	int offset = XBUFFER_OBJFWD (valcontents)->offset;
-	Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
+	Lisp_Object predicate = XBUFFER_OBJFWD (valcontents)->predicate;
 
-	if (!(NILP (type) || NILP (newval)
-	      || (XINT (type) == Lisp_Int0
-		  ? INTEGERP (newval)
-		  : XTYPE (newval) == XINT (type))))
-	  buffer_slot_type_mismatch (newval, XINT (type));
+	if (!NILP (predicate) && !NILP (newval)
+	    && NILP (call1 (predicate, newval)))
+	  wrong_type_argument (predicate, newval);
 
 	if (buf == NULL)
 	  buf = current_buffer;
@@ -1071,40 +1171,6 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
   return newval;
 }
 
-/* Return true if SYMBOL currently has a let-binding
-   which was made in the buffer that is now current.  */
-
-static bool
-let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
-{
-  struct specbinding *p;
-
-  for (p = specpdl_ptr; p > specpdl; )
-    if ((--p)->func == NULL
-	&& CONSP (p->symbol))
-      {
-	struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
-	eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
-	if (symbol == let_bound_symbol
-	    && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
-	  return 1;
-      }
-
-  return 0;
-}
-
-static bool
-let_shadows_global_binding_p (Lisp_Object symbol)
-{
-  struct specbinding *p;
-
-  for (p = specpdl_ptr; p > specpdl; )
-    if ((--p)->func == NULL && EQ (p->symbol, symbol))
-      return 1;
-
-  return 0;
-}
-
 /* Store the value NEWVAL into SYMBOL.
    If buffer/frame-locality is an issue, WHERE specifies which context to use.
    (nil stands for the current buffer/frame).
@@ -1330,9 +1396,7 @@ for this variable.  The default value is meaningful for variables with
 local bindings in certain buffers.  */)
   (Lisp_Object symbol)
 {
-  register Lisp_Object value;
-
-  value = default_value (symbol);
+  Lisp_Object value = default_value (symbol);
   if (!EQ (value, Qunbound))
     return value;
 
@@ -1424,24 +1488,19 @@ of previous VARs.
 usage: (setq-default [VAR VALUE]...)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object args_left;
-  register Lisp_Object val, symbol;
+  Lisp_Object args_left, symbol, val;
   struct gcpro gcpro1;
 
-  if (NILP (args))
-    return Qnil;
-
-  args_left = args;
+  args_left = val = args;
   GCPRO1 (args);
 
-  do
+  while (CONSP (args_left))
     {
-      val = eval_sub (Fcar (Fcdr (args_left)));
+      val = eval_sub (Fcar (XCDR (args_left)));
       symbol = XCAR (args_left);
       Fset_default (symbol, val);
       args_left = Fcdr (XCDR (args_left));
     }
-  while (!NILP (args_left));
 
   UNGCPRO;
   return val;
@@ -1843,17 +1902,18 @@ BUFFER defaults to the current buffer.  */)
 	XSETBUFFER (tmp, buf);
 	XSETSYMBOL (variable, sym); /* Update in case of aliasing.  */
 
-	for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
-	  {
-	    elt = XCAR (tail);
-	    if (EQ (variable, XCAR (elt)))
-	      {
-		eassert (!blv->frame_local);
-		eassert (blv_found (blv) || !EQ (blv->where, tmp));
-		return Qt;
-	      }
-	  }
-	eassert (!blv_found (blv) || !EQ (blv->where, tmp));
+	if (EQ (blv->where, tmp)) /* The binding is already loaded.  */
+	  return blv_found (blv) ? Qt : Qnil;
+	else
+	  for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
+	    {
+	      elt = XCAR (tail);
+	      if (EQ (variable, XCAR (elt)))
+		{
+		  eassert (!blv->frame_local);
+		  return Qt;
+		}
+	    }
 	return Qnil;
       }
     case SYMBOL_FORWARDED:
@@ -1932,7 +1992,7 @@ If the current binding is global (the default), the value is nil.  */)
       {
 	union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
 	if (KBOARD_OBJFWDP (valcontents))
-	  return Fframe_terminal (Fselected_frame ());
+	  return Fframe_terminal (selected_frame);
 	else if (!BUFFER_OBJFWDP (valcontents))
 	  return Qnil;
       }
@@ -1952,7 +2012,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);
 
@@ -2011,10 +2071,10 @@ indirect_function (register Lisp_Object object)
 
   for (;;)
     {
-      if (!SYMBOLP (hare) || EQ (hare, Qunbound))
+      if (!SYMBOLP (hare) || NILP (hare))
 	break;
       hare = XSYMBOL (hare)->function;
-      if (!SYMBOLP (hare) || EQ (hare, Qunbound))
+      if (!SYMBOLP (hare) || NILP (hare))
 	break;
       hare = XSYMBOL (hare)->function;
 
@@ -2041,10 +2101,10 @@ function chain of symbols.  */)
 
   /* Optimize for no indirection.  */
   result = object;
-  if (SYMBOLP (result) && !EQ (result, Qunbound)
+  if (SYMBOLP (result) && !NILP (result)
       && (result = XSYMBOL (result)->function, SYMBOLP (result)))
     result = indirect_function (result);
-  if (!EQ (result, Qunbound))
+  if (!NILP (result))
     return result;
 
   if (NILP (noerror))
@@ -2081,13 +2141,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))
     {
@@ -2131,18 +2187,9 @@ bool-vector.  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];
-
-      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))
     {
@@ -2212,10 +2259,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;
@@ -2232,32 +2277,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;
@@ -2267,48 +2312,65 @@ 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);
+  for (ptrdiff_t 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 is less than the next arg.  All must be numbers or markers.
+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 is greater than the next arg.  All must be numbers or markers.
+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 is less than or equal to the next arg.
+All must be numbers or markers.
+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 (">=", Fgeq, Sgeq, 1, MANY, 0,
+       doc: /* Return t if each arg is greater than or equal to the next arg.
+All must be numbers or markers.
+usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
+{
+  return arithcompare_driver (nargs, args, ARITH_GRTR_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)
 {
-  return arithcompare (num1, num2, notequal);
+  return arithcompare (num1, num2, ARITH_NOTEQUAL);
 }
 
 DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
@@ -2699,10 +2761,10 @@ usage: (* &rest NUMBERS-OR-MARKERS)  */)
   return arith_driver (Amult, nargs, args);
 }
 
-DEFUN ("/", Fquo, Squo, 2, MANY, 0,
+DEFUN ("/", Fquo, Squo, 1, MANY, 0,
        doc: /* Return first argument divided by all the remaining arguments.
 The arguments must be numbers or markers.
-usage: (/ DIVIDEND DIVISOR &rest DIVISORS)  */)
+usage: (/ DIVIDEND &rest DIVISORS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t argnum;
@@ -2898,6 +2960,353 @@ 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.  Also, we
+   always allocate bool vectors with at least one bits_word of storage so
+   that we don't have to special-case empty bit vectors.  */
+
+static bits_word
+bool_vector_spare_mask (EMACS_INT nr_bits)
+{
+  return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1;
+}
+
+#if BITS_WORD_MAX <= UINT_MAX
+# define popcount_bits_word count_one_bits
+#elif BITS_WORD_MAX <= ULONG_MAX
+# define popcount_bits_word count_one_bits_l
+#elif BITS_WORD_MAX <= ULLONG_MAX
+# define popcount_bits_word count_one_bits_ll
+#else
+# error "bits_word wider than long long? Please file a bug report."
+#endif
+
+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 op1,
+                          Lisp_Object op2,
+                          Lisp_Object dest,
+                          enum bool_vector_op op)
+{
+  EMACS_INT nr_bits;
+  bits_word *adata, *bdata, *cdata;
+  ptrdiff_t i;
+  bits_word changed = 0;
+  bits_word mword;
+  ptrdiff_t nr_words;
+
+  CHECK_BOOL_VECTOR (op1);
+  CHECK_BOOL_VECTOR (op2);
+
+  nr_bits = bool_vector_size (op1);
+  if (bool_vector_size (op2) != nr_bits)
+    wrong_length_argument (op1, op2, dest);
+
+  if (NILP (dest))
+    {
+      dest = Fmake_bool_vector (make_number (nr_bits), Qnil);
+      changed = 1;
+    }
+  else
+    {
+      CHECK_BOOL_VECTOR (dest);
+      if (bool_vector_size (dest) != nr_bits)
+	wrong_length_argument (op1, op2, dest);
+    }
+
+  nr_words = bool_vector_words (nr_bits);
+
+  adata = bool_vector_data (dest);
+  bdata = bool_vector_data (op1);
+  cdata = bool_vector_data (op2);
+  i = 0;
+  do
+    {
+      if (op == bool_vector_exclusive_or)
+        mword = bdata[i] ^ cdata[i];
+      else if (op == bool_vector_union || op == bool_vector_subsetp)
+        mword = bdata[i] | cdata[i];
+      else if (op == bool_vector_intersection)
+        mword = bdata[i] & cdata[i];
+      else if (op == bool_vector_set_difference)
+        mword = bdata[i] &~ cdata[i];
+      else
+        abort ();
+
+      changed |= adata[i] ^ mword;
+
+      if (op != bool_vector_subsetp)
+        adata[i] = mword;
+
+      i++;
+    }
+  while (i < nr_words);
+
+  return changed ? dest : Qnil;
+}
+
+/* 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 HAVE_UNSIGNED_LONG_LONG_INT
+  if (BITS_WORD_MAX == ULLONG_MAX)
+    return count_trailing_zeros_ll (val);
+# endif
+
+  /* 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.  */
+  if (val == 0)
+    return CHAR_BIT * sizeof (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 HAVE_UNSIGNED_LONG_LONG_INT
+    verify (BITS_WORD_MAX <= ULLONG_MAX);
+    return count_trailing_zeros_ll (val);
+# else
+    verify (BITS_WORD_MAX <= ULONG_MAX);
+# endif
+  }
+}
+
+static bits_word
+bits_word_to_host_endian (bits_word val)
+{
+#ifndef WORDS_BIGENDIAN
+  return val;
+#elif BITS_WORD_MAX >> 31 == 1
+  return bswap_32 (val);
+#elif BITS_WORD_MAX >> 31 >> 31 >> 1 == 1
+  return bswap_64 (val);
+#else
+  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: )
+  (Lisp_Object a, Lisp_Object b)
+{
+  /* Like bool_vector_union, but doesn't modify b.  */
+  return bool_vector_binop_driver (b, a, 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 = Fmake_bool_vector (make_number (nr_bits), Qnil);
+  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-matches", Fbool_vector_count_matches,
+       Sbool_vector_count_matches, 2, 2, 0,
+       doc: /* Count how many elements in A equal B.
+A must be a bool vector.  B is a generalized bool.  */)
+  (Lisp_Object a, Lisp_Object b)
+{
+  EMACS_INT count;
+  EMACS_INT nr_bits;
+  bits_word *adata;
+  bits_word match;
+  ptrdiff_t i;
+
+  CHECK_BOOL_VECTOR (a);
+
+  nr_bits = bool_vector_size (a);
+  count = 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);
+
+  /* Mask out trailing parts of final mword.  */
+  if (nr_bits % BITS_PER_BITS_WORD)
+    {
+      bits_word mword = adata[i] ^ match;
+      mword = bits_word_to_host_endian (mword);
+      count += popcount_bits_word (mword & bool_vector_spare_mask (nr_bits));
+    }
+
+  return make_number (count);
+}
+
+DEFUN ("bool-vector-count-matches-at",
+       Fbool_vector_count_matches_at,
+       Sbool_vector_count_matches_at, 3, 3, 0,
+       doc: /* Count how many consecutive elements in A equal B at i.
+A must be a bool vector.  B is a generalized boolean.  i is an
+index into the vector.  */)
+  (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;
+  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;
+      count = count_trailing_zero_bits (mword);
+      count = min (count, BITS_PER_BITS_WORD - offset);
+      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.  */
+  while (pos < nr_words && adata[pos] == twiddle)
+    {
+      count += BITS_PER_BITS_WORD;
+      ++pos;
+    }
+
+  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
@@ -2915,6 +3324,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");
@@ -2947,6 +3357,7 @@ 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");
@@ -2988,6 +3399,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,
@@ -3067,6 +3479,7 @@ syms_of_data (void)
   DEFSYM (Qfont_object, "font-object");
 
   DEFSYM (Qinteractive_form, "interactive-form");
+  DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
 
   defsubr (&Sindirect_variable);
   defsubr (&Sinteractive_form);
@@ -3163,6 +3576,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_matches);
+  defsubr (&Sbool_vector_count_matches_at);
+
   set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function);
 
   DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,