X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4eed3157327f8406921658442a11af7e9d84d603..844e0de1bc2bf56118b749f50a4880db7c918fd5:/src/data.c

diff --git a/src/data.c b/src/data.c
index a6bfe50a3b..79e605b731 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-2014 Free Software
    Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -22,6 +22,8 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <stdio.h>
 
 #include <byteswap.h>
+#include <count-one-bits.h>
+#include <count-trailing-zeros.h>
 #include <intprops.h>
 
 #include "lisp.h"
@@ -36,9 +38,11 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "keymap.h"
 
 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
+Lisp_Object Qnil_, Qt_;
 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;
@@ -83,10 +87,11 @@ static Lisp_Object Qmany, Qunevalled;
 Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
 static Lisp_Object Qdefun;
 
+Lisp_Object Qspecial_operator;
 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 (sym_t, struct Lisp_Buffer_Local_Value *);
 
 static bool
 BOOLFWDP (union Lisp_Fwd *a)
@@ -137,7 +142,7 @@ XOBJFWD (union Lisp_Fwd *a)
 static void
 CHECK_SUBR (Lisp_Object x)
 {
-  CHECK_TYPE (SUBRP (x), Qsubrp, x);
+  CHECK_TYPE (! NILP (Fsubrp (x)), Qsubrp, x);
 }
 
 static void
@@ -177,6 +182,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)
 {
@@ -190,12 +207,6 @@ wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
   xsignal2 (Qwrong_type_argument, predicate, value);
 }
 
-void
-pure_write_error (Lisp_Object obj)
-{
-  xsignal2 (Qerror, build_string ("Attempt to modify read-only object"), obj);
-}
-
 void
 args_out_of_range (Lisp_Object a1, Lisp_Object a2)
 {
@@ -235,21 +246,16 @@ The symbol returned names the object's basic type;
 for example, (type-of 1) returns `integer'.  */)
   (Lisp_Object object)
 {
-  switch (XTYPE (object))
+  if (INTEGERP (object))
+    return Qinteger;
+  else if (SYMBOLP (object))
+    return Qsymbol;
+  else if (STRINGP (object))
+    return Qstring;
+  else if (CONSP (object))
+    return Qcons;
+  else if (MISCP (object))
     {
-    case_Lisp_Int:
-      return Qinteger;
-
-    case Lisp_Symbol:
-      return Qsymbol;
-
-    case Lisp_String:
-      return Qstring;
-
-    case Lisp_Cons:
-      return Qcons;
-
-    case Lisp_Misc:
       switch (XMISCTYPE (object))
 	{
 	case Lisp_Misc_Marker:
@@ -260,16 +266,15 @@ for example, (type-of 1) returns `integer'.  */)
 	  return Qfloat;
 	}
       emacs_abort ();
-
-    case Lisp_Vectorlike:
+    }
+  else if (VECTORLIKEP (object))
+    {
       if (WINDOW_CONFIGURATIONP (object))
 	return Qwindow_configuration;
       if (PROCESSP (object))
 	return Qprocess;
       if (WINDOWP (object))
 	return Qwindow;
-      if (SUBRP (object))
-	return Qsubr;
       if (COMPILEDP (object))
 	return Qcompiled_function;
       if (BUFFERP (object))
@@ -289,13 +294,13 @@ for example, (type-of 1) returns `integer'.  */)
       if (FONT_OBJECT_P (object))
 	return Qfont_object;
       return Qvector;
-
-    case Lisp_Float:
-      return Qfloat;
-
-    default:
-      emacs_abort ();
     }
+  else if (FLOATP (object))
+    return Qfloat;
+  else if (! NILP (Fsubrp (object)))
+    return Qsubr;
+  else
+    return Qt;
 }
 
 DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
@@ -344,6 +349,15 @@ DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
   return Qnil;
 }
 
+static bool
+SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
+{
+  /* Should be initial_obarray */
+  Lisp_Object tem = Ffind_symbol (SYMBOL_NAME (sym), Vobarray);
+  return (! NILP (scm_c_value_ref (tem, 1))
+          && (EQ (sym, scm_c_value_ref (tem, 0))));
+}
+
 /* Define this in C to avoid unnecessarily consing up the symbol
    name.  */
 DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0,
@@ -456,7 +470,9 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
        doc: /* Return t if OBJECT is a built-in function.  */)
   (Lisp_Object object)
 {
-  if (SUBRP (object))
+  if (CONSP (object) && EQ (XCAR (object), Qspecial_operator))
+    object = XCDR (object);
+  if (SCM_PRIMITIVE_P (object))
     return Qt;
   return Qnil;
 }
@@ -604,12 +620,12 @@ global value outside of any lexical scope.  */)
   (register Lisp_Object symbol)
 {
   Lisp_Object valcontents;
-  struct Lisp_Symbol *sym;
+  sym_t sym;
   CHECK_SYMBOL (symbol);
   sym = XSYMBOL (symbol);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break;
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
@@ -643,7 +659,7 @@ DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
   (register Lisp_Object symbol)
 {
   CHECK_SYMBOL (symbol);
-  return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
+  return NILP (SYMBOL_FUNCTION (symbol)) ? Qnil : Qt;
 }
 
 DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
@@ -671,11 +687,11 @@ 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);
-  return XSYMBOL (symbol)->function;
+  return SYMBOL_FUNCTION (symbol);
 }
 
 DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
@@ -683,7 +699,7 @@ DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
   (register Lisp_Object symbol)
 {
   CHECK_SYMBOL (symbol);
-  return XSYMBOL (symbol)->plist;
+  return symbol_plist (symbol);
 }
 
 DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
@@ -704,7 +720,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
   register Lisp_Object function;
   CHECK_SYMBOL (symbol);
 
-  function = XSYMBOL (symbol)->function;
+  function = SYMBOL_FUNCTION (symbol);
 
   if (!NILP (Vautoload_queue) && !NILP (function))
     Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
@@ -712,6 +728,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) < 1)
+    emacs_abort ();
+
   set_symbol_function (symbol, definition);
 
   return definition;
@@ -723,6 +744,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)
 {
@@ -738,7 +763,7 @@ The return value is undefined.  */)
       { /* 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))
+	if (AUTOLOADP (SYMBOL_FUNCTION (symbol)))
 	  /* Remember that the function was already an autoload.  */
 	  LOADHIST_ATTACH (Fcons (Qt, symbol));
 	LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
@@ -778,14 +803,27 @@ of args.  MAX is the maximum number or the symbol `many', for a
 function with `&rest' args, or `unevalled' for a special form.  */)
   (Lisp_Object subr)
 {
-  short minargs, maxargs;
+  Lisp_Object min, max;
+  Lisp_Object arity;
+  bool special = false;
+
   CHECK_SUBR (subr);
-  minargs = XSUBR (subr)->min_args;
-  maxargs = XSUBR (subr)->max_args;
-  return Fcons (make_number (minargs),
-		maxargs == MANY ?        Qmany
-		: maxargs == UNEVALLED ? Qunevalled
-		:                        make_number (maxargs));
+  if (CONSP (subr) && EQ (XCAR (subr), Qspecial_operator))
+    {
+      subr = XCDR (subr);
+      special = true;
+    }
+  arity = scm_procedure_minimum_arity (subr);
+  if (scm_is_false (arity))
+    return Qnil;
+  min = XCAR (arity);
+  if (special)
+    max = Qunevalled;
+  else if (scm_is_true (XCAR (XCDR (XCDR (arity)))))
+    max = Qmany;
+  else
+    max = scm_sum (min, XCAR (XCDR (arity)));
+  return Fcons (min, max);
 }
 
 DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
@@ -793,10 +831,10 @@ DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
 SUBR must be a built-in function.  */)
   (Lisp_Object subr)
 {
-  const char *name;
   CHECK_SUBR (subr);
-  name = XSUBR (subr)->symbol_name;
-  return build_string (name);
+  if (CONSP (subr) && EQ (XCAR (subr), Qspecial_operator))
+    subr = XCDR (subr);
+  return Fsymbol_name (SCM_SUBR_NAME (subr));
 }
 
 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
@@ -822,13 +860,11 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
 	fun = Fsymbol_function (fun);
     }
 
-  if (SUBRP (fun))
+  if (scm_is_true (scm_procedure_p (fun)))
     {
-      const char *spec = XSUBR (fun)->intspec;
-      if (spec)
-	return list2 (Qinteractive,
-		      (*spec != '(') ? build_string (spec) :
-		      Fcar (Fread_from_string (build_string (spec), Qnil, Qnil)));
+      Lisp_Object tem = scm_procedure_property (fun, Qinteractive_form);
+      if (scm_is_true (tem))
+        return list2 (Qinteractive, tem);
     }
   else if (COMPILEDP (fun))
     {
@@ -857,17 +893,17 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
    `cyclic-variable-indirection' if SYMBOL's chain of variable
    indirections contains a loop.  */
 
-struct Lisp_Symbol *
-indirect_variable (struct Lisp_Symbol *symbol)
+sym_t
+indirect_variable (sym_t symbol)
 {
-  struct Lisp_Symbol *tortoise, *hare;
+  sym_t tortoise, hare;
 
   hare = tortoise = symbol;
 
-  while (hare->redirect == SYMBOL_VARALIAS)
+  while (SYMBOL_REDIRECT (hare) == SYMBOL_VARALIAS)
     {
       hare = SYMBOL_ALIAS (hare);
-      if (hare->redirect != SYMBOL_VARALIAS)
+      if (SYMBOL_REDIRECT (hare) != SYMBOL_VARALIAS)
 	break;
 
       hare = SYMBOL_ALIAS (hare);
@@ -897,7 +933,7 @@ chain of aliases, signal a `cyclic-variable-indirection' error.  */)
 {
   if (SYMBOLP (object))
     {
-      struct Lisp_Symbol *sym = indirect_variable (XSYMBOL (object));
+      sym_t sym = indirect_variable (XSYMBOL (object));
       XSETSYMBOL (object, sym);
     }
   return object;
@@ -1032,7 +1068,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
    of BLV are marked after this function has changed them.  */
 
 void
-swap_in_global_binding (struct Lisp_Symbol *symbol)
+swap_in_global_binding (sym_t symbol)
 {
   struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (symbol);
 
@@ -1058,7 +1094,7 @@ swap_in_global_binding (struct Lisp_Symbol *symbol)
    This could be another forwarding pointer.  */
 
 static void
-swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_Value *blv)
+swap_in_symval_forwarding (sym_t symbol, struct Lisp_Buffer_Local_Value *blv)
 {
   register Lisp_Object tem1;
 
@@ -1110,13 +1146,13 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
 Lisp_Object
 find_symbol_value (Lisp_Object symbol)
 {
-  struct Lisp_Symbol *sym;
+  sym_t sym;
 
   CHECK_SYMBOL (symbol);
   sym = XSYMBOL (symbol);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
@@ -1169,7 +1205,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
 	      bool bindflag)
 {
   bool voide = EQ (newval, Qunbound);
-  struct Lisp_Symbol *sym;
+  sym_t sym;
   Lisp_Object tem1;
 
   /* If restoring in a dead buffer, do nothing.  */
@@ -1190,7 +1226,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
   sym = XSYMBOL (symbol);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
@@ -1300,7 +1336,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
 	if (voide)
 	  { /* If storing void (making the symbol void), forward only through
 	       buffer-local indicator, not through Lisp_Objfwd, etc.  */
-	    sym->redirect = SYMBOL_PLAINVAL;
+	    SET_SYMBOL_REDIRECT (sym, SYMBOL_PLAINVAL);
 	    SET_SYMBOL_VAL (sym, newval);
 	  }
 	else
@@ -1320,13 +1356,13 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
 static Lisp_Object
 default_value (Lisp_Object symbol)
 {
-  struct Lisp_Symbol *sym;
+  sym_t sym;
 
   CHECK_SYMBOL (symbol);
   sym = XSYMBOL (symbol);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
@@ -1394,7 +1430,7 @@ The default value is seen in buffers that do not have their own values
 for this variable.  */)
   (Lisp_Object symbol, Lisp_Object value)
 {
-  struct Lisp_Symbol *sym;
+  sym_t sym;
 
   CHECK_SYMBOL (symbol);
   if (SYMBOL_CONSTANT_P (symbol))
@@ -1409,7 +1445,7 @@ for this variable.  */)
   sym = XSYMBOL (symbol);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return Fset (symbol, value);
@@ -1500,7 +1536,7 @@ union Lisp_Val_Fwd
   };
 
 static struct Lisp_Buffer_Local_Value *
-make_blv (struct Lisp_Symbol *sym, bool forwarded,
+make_blv (sym_t sym, bool forwarded,
 	  union Lisp_Val_Fwd valcontents)
 {
   struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv);
@@ -1536,13 +1572,17 @@ 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)
 {
-  struct Lisp_Symbol *sym;
+  sym_t sym;
   struct Lisp_Buffer_Local_Value *blv = NULL;
   union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
   bool forwarded IF_LINT (= 0);
@@ -1551,7 +1591,7 @@ The function `default-value' gets the default value and `set-default' sets it.
   sym = XSYMBOL (variable);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL:
@@ -1576,13 +1616,13 @@ The function `default-value' gets the default value and `set-default' sets it.
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYMBOL_CONSTANT (sym))
     error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
 
   if (!blv)
     {
       blv = make_blv (sym, forwarded, valcontents);
-      sym->redirect = SYMBOL_LOCALIZED;
+      SET_SYMBOL_REDIRECT (sym, SYMBOL_LOCALIZED);
       SET_SYMBOL_BLV (sym, blv);
       {
 	Lisp_Object symbol;
@@ -1622,14 +1662,14 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
   Lisp_Object tem;
   bool forwarded IF_LINT (= 0);
   union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
-  struct Lisp_Symbol *sym;
+  sym_t sym;
   struct Lisp_Buffer_Local_Value *blv = NULL;
 
   CHECK_SYMBOL (variable);
   sym = XSYMBOL (variable);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL:
@@ -1649,7 +1689,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYMBOL_CONSTANT (sym))
     error ("Symbol %s may not be buffer-local",
 	   SDATA (SYMBOL_NAME (variable)));
 
@@ -1665,7 +1705,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
   if (!blv)
     {
       blv = make_blv (sym, forwarded, valcontents);
-      sym->redirect = SYMBOL_LOCALIZED;
+      SET_SYMBOL_REDIRECT (sym, SYMBOL_LOCALIZED);
       SET_SYMBOL_BLV (sym, blv);
       {
 	Lisp_Object symbol;
@@ -1721,13 +1761,13 @@ From now on the default value will apply in this buffer.  Return VARIABLE.  */)
 {
   register Lisp_Object tem;
   struct Lisp_Buffer_Local_Value *blv;
-  struct Lisp_Symbol *sym;
+  sym_t sym;
 
   CHECK_SYMBOL (variable);
   sym = XSYMBOL (variable);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return variable;
@@ -1808,14 +1848,14 @@ frame-local bindings).  */)
 {
   bool forwarded;
   union Lisp_Val_Fwd valcontents;
-  struct Lisp_Symbol *sym;
+  sym_t sym;
   struct Lisp_Buffer_Local_Value *blv = NULL;
 
   CHECK_SYMBOL (variable);
   sym = XSYMBOL (variable);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL:
@@ -1838,12 +1878,12 @@ frame-local bindings).  */)
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYMBOL_CONSTANT (sym))
     error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
 
   blv = make_blv (sym, forwarded, valcontents);
   blv->frame_local = 1;
-  sym->redirect = SYMBOL_LOCALIZED;
+  SET_SYMBOL_REDIRECT (sym, SYMBOL_LOCALIZED);
   SET_SYMBOL_BLV (sym, blv);
   {
     Lisp_Object symbol;
@@ -1862,7 +1902,7 @@ BUFFER defaults to the current buffer.  */)
   (register Lisp_Object variable, Lisp_Object buffer)
 {
   register struct buffer *buf;
-  struct Lisp_Symbol *sym;
+  sym_t sym;
 
   if (NILP (buffer))
     buf = current_buffer;
@@ -1876,7 +1916,7 @@ BUFFER defaults to the current buffer.  */)
   sym = XSYMBOL (variable);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return Qnil;
@@ -1927,13 +1967,13 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see
 `make-variable-buffer-local').  */)
   (register Lisp_Object variable, Lisp_Object buffer)
 {
-  struct Lisp_Symbol *sym;
+  sym_t sym;
 
   CHECK_SYMBOL (variable);
   sym = XSYMBOL (variable);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return Qnil;
@@ -1960,7 +2000,7 @@ If the current binding is frame-local, the value is the selected frame.
 If the current binding is global (the default), the value is nil.  */)
   (register Lisp_Object variable)
 {
-  struct Lisp_Symbol *sym;
+  sym_t sym;
 
   CHECK_SYMBOL (variable);
   sym = XSYMBOL (variable);
@@ -1969,7 +2009,7 @@ If the current binding is global (the default), the value is nil.  */)
   find_symbol_value (variable);
 
  start:
-  switch (sym->redirect)
+  switch (SYMBOL_REDIRECT (sym))
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return Qnil;
@@ -1987,7 +2027,7 @@ If the current binding is global (the default), the value is nil.  */)
 	 buffer's or frame's value we are saving.  */
       if (!NILP (Flocal_variable_p (variable, Qnil)))
 	return Fcurrent_buffer ();
-      else if (sym->redirect == SYMBOL_LOCALIZED
+      else if (SYMBOL_REDIRECT (sym) == SYMBOL_LOCALIZED
 	       && blv_found (SYMBOL_BLV (sym)))
 	return SYMBOL_BLV (sym)->where;
       else
@@ -2058,12 +2098,12 @@ indirect_function (register Lisp_Object object)
     {
       if (!SYMBOLP (hare) || NILP (hare))
 	break;
-      hare = XSYMBOL (hare)->function;
+      hare = SYMBOL_FUNCTION (hare);
       if (!SYMBOLP (hare) || NILP (hare))
 	break;
-      hare = XSYMBOL (hare)->function;
+      hare = SYMBOL_FUNCTION (hare);
 
-      tortoise = XSYMBOL (tortoise)->function;
+      tortoise = SYMBOL_FUNCTION (tortoise);
 
       if (EQ (hare, tortoise))
 	xsignal1 (Qcyclic_function_indirection, object);
@@ -2087,7 +2127,7 @@ function chain of symbols.  */)
   /* Optimize for no indirection.  */
   result = object;
   if (SYMBOLP (result) && !NILP (result)
-      && (result = XSYMBOL (result)->function, SYMBOLP (result)))
+      && (result = SYMBOL_FUNCTION (result), SYMBOLP (result)))
     result = indirect_function (result);
   if (!NILP (result))
     return result;
@@ -2126,13 +2166,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))
     {
@@ -2176,18 +2212,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))
     {
@@ -2314,9 +2341,10 @@ static Lisp_Object
 arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
                      enum Arith_Comparison comparison)
 {
-  for (ptrdiff_t argnum = 1; argnum < nargs; ++argnum)
+  ptrdiff_t argnum;
+  for (argnum = 1; argnum < nargs; ++argnum)
     {
-      if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum], comparison)))
+      if (EQ (Qnil, arithcompare (args[argnum - 1], args[argnum], comparison)))
         return Qnil;
     }
   return Qt;
@@ -2331,7 +2359,7 @@ usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
 }
 
 DEFUN ("<", Flss, Slss, 1, MANY, 0,
-       doc: /* Return t if each arg is less than the next arg.  All must be numbers or markers.
+       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)
 {
@@ -2339,7 +2367,7 @@ usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
 }
 
 DEFUN (">", Fgtr, Sgtr, 1, MANY, 0,
-       doc: /* Return t if each arg is greater than the next arg.  All must be numbers or markers.
+       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)
 {
@@ -2347,8 +2375,7 @@ usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
 }
 
 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.
+       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)
 {
@@ -2356,9 +2383,8 @@ usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
 }
 
 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)  */)
+       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_driver (nargs, args, ARITH_GRTR_OR_EQUAL);
@@ -2370,24 +2396,6 @@ DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
 {
   return arithcompare (num1, num2, ARITH_NOTEQUAL);
 }
-
-DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
-       doc: /* Return t if NUMBER is zero.  */)
-  (register Lisp_Object number)
-{
-  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;
-}
 
 /* Convert the cons-of-integers, integer, or float value C to an
    unsigned value with maximum value MAX.  Signal an error if C does not
@@ -2516,12 +2524,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;
@@ -2879,7 +2887,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
@@ -2960,117 +2968,55 @@ lowercase l) for small endian machines.  */)
 
 /* 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 size_t of storage so
-   that we don't have to special-case empty bit vectors.  */
+   operations below.  These extra bits are always zero.  */
 
-static size_t
-bool_vector_spare_mask (ptrdiff_t nr_bits)
+static bits_word
+bool_vector_spare_mask (EMACS_INT nr_bits)
 {
-  eassert (nr_bits > 0);
-  return (((size_t) 1) << (nr_bits % BITS_PER_SIZE_T)) - 1;
+  return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1;
 }
 
-#if _MSC_VER >= 1500 && (defined _M_IX86 || defined _M_X64)
-# define USE_MSC_POPCOUNT
-# define POPCOUNT_STATIC_INLINE static inline
-#elif __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
-# define USE_GCC_POPCOUNT
-# if 199901L <= __STDC_VERSION__ || !__STRICT_ANSI__
-#  define POPCOUNT_STATIC_INLINE static inline
-# endif
-#else
-# define NEED_GENERIC_POPCOUNT
-#endif
-#ifndef POPCOUNT_STATIC_INLINE
-# define POPCOUNT_STATIC_INLINE static
-#endif
+/* Info about unsigned long long, falling back on unsigned long
+   if unsigned long long is not available.  */
 
-#ifdef USE_MSC_POPCOUNT
-# define NEED_GENERIC_POPCOUNT
+#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
 
-#ifdef NEED_GENERIC_POPCOUNT
-POPCOUNT_STATIC_INLINE unsigned int
-popcount_size_t_generic (size_t val)
-{
-    unsigned short j;
-    unsigned int count = 0;
-
-    for (j = 0; j < BITS_PER_SIZE_T; ++j)
-      count += !!((((size_t) 1) << j) & val);
+/* Shift VAL right by the width of an unsigned long long.
+   BITS_PER_ULL must be less than BITS_PER_BITS_WORD.  */
 
-    return count;
-}
-#endif
-
-#ifdef USE_MSC_POPCOUNT
-POPCOUNT_STATIC_INLINE unsigned int
-popcount_size_t_msc (size_t val)
+static bits_word
+shift_right_ull (bits_word w)
 {
-  unsigned int count;
-
-#pragma intrinsic __cpuid
-  /* While gcc falls back to its own generic code if the machine on
-     which it's running doesn't support popcount, we need to perform the
-     detection and fallback ourselves when compiling with Microsoft's
-     compiler.  */
-
-    static enum {
-      popcount_unknown_support,
-      popcount_use_generic,
-      popcount_use_intrinsic
-    } popcount_state;
-
-    if (popcount_state == popcount_unknown_support)
-      {
-        int cpu_info[4];
-        __cpuid (cpu_info, 1);
-        if (cpu_info[2] & (1<<23)) /* See MSDN.  */
-          popcount_state = popcount_use_intrinsic;
-        else
-          popcount_state = popcount_use_generic;
-      }
-
-    if (popcount_state == popcount_use_intrinsic)
-      {
-# if BITS_PER_SIZE_T == 64
-#  pragma intrinsic __popcnt64
-      count = __popcnt64 (val);
-# else
-#  pragma intrinsic __popcnt
-    count = __popcnt (val);
-# endif
-      }
-    else
-      count = popcount_size_t_generic (val);
-
-    return count;
+  /* 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;
 }
-#endif /* USE_MSC_POPCOUNT */
 
-#ifdef USE_GCC_POPCOUNT
-POPCOUNT_STATIC_INLINE unsigned int
-popcount_size_t_gcc (size_t val)
-{
-# if BITS_PER_SIZE_T == 64
-  return __builtin_popcountll (val);
-# else
-  return __builtin_popcount (val);
-# endif
-}
-#endif /* USE_GCC_POPCOUNT */
+/* Return the number of 1 bits in W.  */
 
-POPCOUNT_STATIC_INLINE unsigned int
-popcount_size_t (size_t val)
+static int
+count_one_bits_word (bits_word w)
 {
-#if defined USE_MSC_POPCOUNT
-  return popcount_size_t_msc (val);
-#elif defined USE_GCC_POPCOUNT
-  return popcount_size_t_gcc (val);
-#else
-  return popcount_size_t_generic (val);
-#endif
+  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,
@@ -3080,128 +3026,186 @@ enum bool_vector_op { bool_vector_exclusive_or,
                       bool_vector_subsetp };
 
 static Lisp_Object
-bool_vector_binop_driver (Lisp_Object op1,
-                          Lisp_Object op2,
+bool_vector_binop_driver (Lisp_Object a,
+                          Lisp_Object b,
                           Lisp_Object dest,
                           enum bool_vector_op op)
 {
   EMACS_INT nr_bits;
-  size_t *adata, *bdata, *cdata;
-  ptrdiff_t i;
-  size_t changed = 0;
-  size_t mword;
+  bits_word *adata, *bdata, *destdata;
+  ptrdiff_t i = 0;
   ptrdiff_t nr_words;
 
-  CHECK_BOOL_VECTOR (op1);
-  CHECK_BOOL_VECTOR (op2);
+  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_bits = min (XBOOL_VECTOR (op1)->size,
-                 XBOOL_VECTOR (op2)->size);
+  nr_words = bool_vector_words (nr_bits);
+  adata = bool_vector_data (a);
+  bdata = bool_vector_data (b);
 
   if (NILP (dest))
     {
-      dest = Fmake_bool_vector (make_number (nr_bits), Qnil);
-      changed = 1;
+      dest = make_uninit_bool_vector (nr_bits);
+      destdata = bool_vector_data (dest);
     }
   else
     {
       CHECK_BOOL_VECTOR (dest);
-      nr_bits = min (nr_bits, XBOOL_VECTOR (dest)->size);
-    }
-
-  eassert (nr_bits >= 0);
-  nr_words = ROUNDUP (nr_bits, BITS_PER_SIZE_T) / BITS_PER_SIZE_T;
-
-  adata = (size_t *) XBOOL_VECTOR (dest)->data;
-  bdata = (size_t *) XBOOL_VECTOR (op1)->data;
-  cdata = (size_t *) XBOOL_VECTOR (op2)->data;
-  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 ();
+      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;
 
-      changed |= adata[i] ^ mword;
+	case bool_vector_subsetp:
+	  for (; i < nr_words; i++)
+	    if (adata[i] &~ bdata[i])
+	      return Qnil;
+	  return Qt;
 
-      if (op != bool_vector_subsetp)
-        adata[i] = mword;
+	case bool_vector_union:
+	  for (; i < nr_words; i++)
+	    if (destdata[i] != (adata[i] | bdata[i]))
+	      goto set_dest;
+	  break;
 
-      i++;
+	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;
     }
-  while (i < nr_words);
 
-  return changed ? dest : 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 unsigned int
-count_trailing_zero_bits (size_t val)
-{
-  if (val == 0)
-    return CHAR_BIT * sizeof (val);
-
-#if defined USE_GCC_POPCOUNT && BITS_PER_SIZE_T == 64
-  return __builtin_ctzll (val);
-#elif defined USE_GCC_POPCOUNT && BITS_PER_SIZE_T == 32
-  return __builtin_ctz (val);
-#elif _MSC_VER && BITS_PER_SIZE_T == 64
-# pragma intrinsic _BitScanForward64
-  {
-    /* No support test needed: support since 386.  */
-    unsigned long result;
-    _BitScanForward64 (&result, val);
-    return (unsigned int) result;
-  }
-#elif _MSC_VER && BITS_PER_SIZE_T == 32
-# pragma intrinsic _BitScanForward
-  {
-    /* No support test needed: support since 386.  */
-    unsigned long result;
-    _BitScanForward (&result, val);
-    return (unsigned int) result;
-  }
-#else
-  {
-    unsigned int count;
-    count = 0;
-    for (val = ~val; val & 1; val >>= 1)
-      ++count;
+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);
+	}
 
-    return count;
-  }
-#endif
+      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 size_t
-size_t_to_host_endian (size_t val)
+static bits_word
+bits_word_to_host_endian (bits_word val)
 {
-#ifdef WORDS_BIGENDIAN
-# if BITS_PER_SIZE_T == 64
-  return bswap_64 (val);
-# else
-  return bswap_32 (val);
-# endif
-#else
+#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: /* 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);
@@ -3209,10 +3213,10 @@ it changed or nil otherwise.  */
 
 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);
@@ -3220,10 +3224,10 @@ it changed or nil otherwise.  */)
 
 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);
@@ -3231,10 +3235,10 @@ it changed or nil otherwise.  */)
 
 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);
@@ -3242,165 +3246,150 @@ it changed or nil otherwise.  */)
 
 DEFUN ("bool-vector-subsetp", Fbool_vector_subsetp,
        Sbool_vector_subsetp, 2, 2, 0,
-       doc: )
+       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)
 {
-  /* Like bool_vector_union, but doesn't modify b.  */
-  return bool_vector_binop_driver (b, a, b, bool_vector_subsetp);
+  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 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;
-  size_t *bdata, *adata;
+  bits_word *bdata, *adata;
   ptrdiff_t i;
-  size_t 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);
+    b = make_uninit_bool_vector (nr_bits);
   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 = (size_t *) XBOOL_VECTOR (b)->data;
-  adata = (size_t *) 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_SIZE_T; i++)
-    bdata[i] = ~adata[i];
+  for (i = 0; i < nr_bits / BITS_PER_BITS_WORD; i++)
+    bdata[i] = BITS_WORD_MAX & ~adata[i];
 
-  if (nr_bits % BITS_PER_SIZE_T)
+  if (nr_bits % BITS_PER_BITS_WORD)
     {
-      mword = size_t_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] = size_t_to_host_endian (mword);
+      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)
+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)
 {
-  ptrdiff_t count;
+  EMACS_INT count;
   EMACS_INT nr_bits;
-  size_t *adata;
-  size_t match;
-  ptrdiff_t i;
+  bits_word *adata;
+  ptrdiff_t i, nwords;
 
   CHECK_BOOL_VECTOR (a);
 
-  nr_bits = XBOOL_VECTOR (a)->size;
+  nr_bits = bool_vector_size (a);
+  nwords = bool_vector_words (nr_bits);
   count = 0;
-  match = NILP (b) ? (size_t) -1 : 0;
-  adata = (size_t *) XBOOL_VECTOR (a)->data;
-
-  eassert (nr_bits >= 0);
+  adata = bool_vector_data (a);
 
-  for (i = 0; i < nr_bits / BITS_PER_SIZE_T; ++i)
-    count += popcount_size_t (adata[i] ^ match);
-
-  /* Mask out trailing parts of final mword.  */
-  if (nr_bits % BITS_PER_SIZE_T)
-    {
-      size_t mword = adata[i] ^ match;
-      mword = size_t_to_host_endian (mword);
-      count += popcount_size_t (mword & bool_vector_spare_mask (nr_bits));
-    }
+  for (i = 0; i < nwords; i++)
+    count += count_one_bits_word (adata[i]);
 
   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.  */)
+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)
 {
-  ptrdiff_t count;
+  EMACS_INT count;
   EMACS_INT nr_bits;
-  ptrdiff_t offset;
-  size_t *adata;
-  size_t twiddle;
-  size_t mword; /* Machine word.  */
-  ptrdiff_t pos;
+  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 = 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 = (size_t *) XBOOL_VECTOR (a)->data;
-
-  assume (nr_bits >= 0);
-  nr_words = ROUNDUP (nr_bits, BITS_PER_SIZE_T) / BITS_PER_SIZE_T;
-
-  pos = XFASTINT (i) / BITS_PER_SIZE_T;
-  offset = XFASTINT (i) % BITS_PER_SIZE_T;
+  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 : (size_t) -1;
+  twiddle = NILP (b) ? 0 : BITS_WORD_MAX;
 
   /* Scan the remainder of the mword at the current offset.  */
   if (pos < nr_words && offset != 0)
     {
-      mword = size_t_to_host_endian (adata[pos]);
+      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);
-      count = min (count, BITS_PER_SIZE_T - offset);
       pos++;
-      if (count + offset < BITS_PER_SIZE_T)
+      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)
-    {
-      count += BITS_PER_SIZE_T;
-      ++pos;
-    }
+    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 = size_t_to_host_endian (adata[pos]);
+      mword = bits_word_to_host_endian (adata[pos]);
       mword ^= twiddle;
       count += count_trailing_zero_bits (mword);
     }
-  else if (nr_bits % BITS_PER_SIZE_T != 0)
+  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_SIZE_T - nr_bits % BITS_PER_SIZE_T;
+      count -= BITS_PER_BITS_WORD - nr_bits % BITS_PER_BITS_WORD;
     }
 
   return make_number (count);
@@ -3412,6 +3401,12 @@ syms_of_data (void)
 {
   Lisp_Object error_tail, arith_tail;
 
+  /* Used by defsubr.  */
+  DEFSYM (Qspecial_operator, "special-operator");
+  DEFSYM (Qinteractive_form, "interactive-form");
+
+#include "data.x"
+
   DEFSYM (Qquote, "quote");
   DEFSYM (Qlambda, "lambda");
   DEFSYM (Qsubr, "subr");
@@ -3422,6 +3417,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");
@@ -3496,6 +3492,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,
@@ -3574,122 +3571,17 @@ syms_of_data (void)
   DEFSYM (Qfont_entity, "font-entity");
   DEFSYM (Qfont_object, "font-object");
 
-  DEFSYM (Qinteractive_form, "interactive-form");
   DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
 
-  defsubr (&Sindirect_variable);
-  defsubr (&Sinteractive_form);
-  defsubr (&Seq);
-  defsubr (&Snull);
-  defsubr (&Stype_of);
-  defsubr (&Slistp);
-  defsubr (&Snlistp);
-  defsubr (&Sconsp);
-  defsubr (&Satom);
-  defsubr (&Sintegerp);
-  defsubr (&Sinteger_or_marker_p);
-  defsubr (&Snumberp);
-  defsubr (&Snumber_or_marker_p);
-  defsubr (&Sfloatp);
-  defsubr (&Snatnump);
-  defsubr (&Ssymbolp);
-  defsubr (&Skeywordp);
-  defsubr (&Sstringp);
-  defsubr (&Smultibyte_string_p);
-  defsubr (&Svectorp);
-  defsubr (&Schar_table_p);
-  defsubr (&Svector_or_char_table_p);
-  defsubr (&Sbool_vector_p);
-  defsubr (&Sarrayp);
-  defsubr (&Ssequencep);
-  defsubr (&Sbufferp);
-  defsubr (&Smarkerp);
-  defsubr (&Ssubrp);
-  defsubr (&Sbyte_code_function_p);
-  defsubr (&Schar_or_string_p);
-  defsubr (&Scar);
-  defsubr (&Scdr);
-  defsubr (&Scar_safe);
-  defsubr (&Scdr_safe);
-  defsubr (&Ssetcar);
-  defsubr (&Ssetcdr);
-  defsubr (&Ssymbol_function);
-  defsubr (&Sindirect_function);
-  defsubr (&Ssymbol_plist);
-  defsubr (&Ssymbol_name);
-  defsubr (&Smakunbound);
-  defsubr (&Sfmakunbound);
-  defsubr (&Sboundp);
-  defsubr (&Sfboundp);
-  defsubr (&Sfset);
-  defsubr (&Sdefalias);
-  defsubr (&Ssetplist);
-  defsubr (&Ssymbol_value);
-  defsubr (&Sset);
-  defsubr (&Sdefault_boundp);
-  defsubr (&Sdefault_value);
-  defsubr (&Sset_default);
-  defsubr (&Ssetq_default);
-  defsubr (&Smake_variable_buffer_local);
-  defsubr (&Smake_local_variable);
-  defsubr (&Skill_local_variable);
-  defsubr (&Smake_variable_frame_local);
-  defsubr (&Slocal_variable_p);
-  defsubr (&Slocal_variable_if_set_p);
-  defsubr (&Svariable_binding_locus);
-#if 0                           /* XXX Remove this. --lorentey */
-  defsubr (&Sterminal_local_value);
-  defsubr (&Sset_terminal_local_value);
-#endif
-  defsubr (&Saref);
-  defsubr (&Saset);
-  defsubr (&Snumber_to_string);
-  defsubr (&Sstring_to_number);
-  defsubr (&Seqlsign);
-  defsubr (&Slss);
-  defsubr (&Sgtr);
-  defsubr (&Sleq);
-  defsubr (&Sgeq);
-  defsubr (&Sneq);
-  defsubr (&Szerop);
-  defsubr (&Splus);
-  defsubr (&Sminus);
-  defsubr (&Stimes);
-  defsubr (&Squo);
-  defsubr (&Srem);
-  defsubr (&Smod);
-  defsubr (&Smax);
-  defsubr (&Smin);
-  defsubr (&Slogand);
-  defsubr (&Slogior);
-  defsubr (&Slogxor);
-  defsubr (&Slsh);
-  defsubr (&Sash);
-  defsubr (&Sadd1);
-  defsubr (&Ssub1);
-  defsubr (&Slognot);
-  defsubr (&Sbyteorder);
-  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);
+  set_symbol_function (Qwholenump, SYMBOL_FUNCTION (Qnatnump));
 
   DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,
 	       doc: /* The largest value that is representable in a Lisp integer.  */);
   Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);
-  XSYMBOL (intern_c_string ("most-positive-fixnum"))->constant = 1;
+  SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("most-positive-fixnum")), 1);
 
   DEFVAR_LISP ("most-negative-fixnum", Vmost_negative_fixnum,
 	       doc: /* The smallest value that is representable in a Lisp integer.  */);
   Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
-  XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
+  SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("most-negative-fixnum")), 1);
 }