]> code.delx.au - gnu-emacs/blobdiff - src/data.c
(Fbyte_code): Harmonize arguments with documentation.
[gnu-emacs] / src / data.c
index c5a546d53fe35aa0573e698d5910dcbbc59884a9..b02294301411fb91872622115d69ef32905df00a 100644 (file)
@@ -5,7 +5,7 @@ This file is part of GNU Emacs.
 
 GNU Emacs is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
@@ -26,17 +26,11 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 #ifndef standalone
 #include "buffer.h"
+#include "keyboard.h"
 #endif
 
 #include "syssignal.h"
 
-#ifdef MSDOS
-/* These are redefined (correctly, but differently) in values.h.  */
-#undef INTBITS
-#undef LONGBITS
-#undef SHORTBITS
-#endif
-
 #ifdef LISP_FLOAT_TYPE
 
 #ifdef STDC_HEADERS
@@ -73,6 +67,7 @@ Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
 Lisp_Object Qbuffer_or_string_p;
 Lisp_Object Qboundp, Qfboundp;
+Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
 
 Lisp_Object Qcdr;
 Lisp_Object Qad_advice_info, Qad_activate;
@@ -88,6 +83,7 @@ Lisp_Object Qnumberp, Qnumber_or_marker_p;
 static Lisp_Object Qinteger, Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
 static Lisp_Object Qfloat, Qwindow_configuration, Qprocess, Qwindow;
 static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
+static Lisp_Object Qchar_table, Qbool_vector;
 
 static Lisp_Object swap_in_symval_forwarding ();
 
@@ -209,7 +205,7 @@ for example, (type-of 1) returns `integer'.")
       return Qcons;
 
     case Lisp_Misc:
-      switch (XMISC (object)->type)
+      switch (XMISCTYPE (object))
        {
        case Lisp_Misc_Marker:
          return Qmarker;
@@ -233,6 +229,10 @@ for example, (type-of 1) returns `integer'.")
        return Qcompiled_function;
       if (GC_BUFFERP (object))
        return Qbuffer;
+      if (GC_CHAR_TABLE_P (object))
+       return Qchar_table;
+      if (GC_BOOL_VECTOR_P (object))
+       return Qbool_vector;
 
 #ifdef MULTI_FRAME
       if (GC_FRAMEP (object))
@@ -313,6 +313,35 @@ DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "T if OBJECT is a string.")
   return Qnil;
 }
 
+DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0, "T if OBJECT is a char-table.")
+  (object)
+     Lisp_Object object;
+{
+  if (CHAR_TABLE_P (object))
+    return Qt;
+  return Qnil;
+}
+
+DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p,
+       Svector_or_char_table_p, 1, 1, 0,
+       "T if OBJECT is a char-table or vector.")
+  (object)
+     Lisp_Object object;
+{
+  if (VECTORP (object) || CHAR_TABLE_P (object))
+    return Qt;
+  return Qnil;
+}
+
+DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0, "T if OBJECT is a bool-vector.")
+  (object)
+     Lisp_Object object;
+{
+  if (BOOL_VECTOR_P (object))
+    return Qt;
+  return Qnil;
+}
+
 DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "T if OBJECT is an array (string or vector).")
   (object)
      Lisp_Object object;
@@ -327,7 +356,8 @@ DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
   (object)
      register Lisp_Object object;
 {
-  if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object))
+  if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object)
+      || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
     return Qt;
   return Qnil;
 }
@@ -445,7 +475,7 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
 /* Extract and set components of lists */
 
 DEFUN ("car", Fcar, Scar, 1, 1, 0,
-  "Return the car of CONSCELL.  If arg is nil, return nil.\n\
+  "Return the car of LIST.  If arg is nil, return nil.\n\
 Error if arg is not nil and not a cons cell.  See also `car-safe'.")
   (list)
      register Lisp_Object list;
@@ -473,7 +503,7 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
 }
 
 DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
-  "Return the cdr of CONSCELL.  If arg is nil, return nil.\n\
+  "Return the cdr of LIST.  If arg is nil, return nil.\n\
 Error if arg is not nil and not a cons cell.  See also `cdr-safe'.")
 
   (list)
@@ -502,7 +532,7 @@ DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
 }
 
 DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
-  "Set the car of CONSCELL to be NEWCAR.  Returns NEWCAR.")
+  "Set the car of CELL to be NEWCAR.  Returns NEWCAR.")
   (cell, newcar)
      register Lisp_Object cell, newcar;
 {
@@ -515,7 +545,7 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
 }
 
 DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
-  "Set the cdr of CONSCELL to be NEWCDR.  Returns NEWCDR.")
+  "Set the cdr of CELL to be NEWCDR.  Returns NEWCDR.")
   (cell, newcdr)
      register Lisp_Object cell, newcdr;
 {
@@ -695,7 +725,7 @@ do_symval_forwarding (valcontents)
   register Lisp_Object val;
   int offset;
   if (MISCP (valcontents))
-    switch (XMISC (valcontents)->type)
+    switch (XMISCTYPE (valcontents))
       {
       case Lisp_Misc_Intfwd:
        XSETINT (val, *XINTFWD (valcontents)->intvar);
@@ -711,11 +741,9 @@ do_symval_forwarding (valcontents)
        offset = XBUFFER_OBJFWD (valcontents)->offset;
        return *(Lisp_Object *)(offset + (char *)current_buffer);
 
-      case Lisp_Misc_Display_Objfwd:
-       if (!current_perdisplay)
-         abort ();
-       offset = XDISPLAY_OBJFWD (valcontents)->offset;
-       return *(Lisp_Object *)(offset + (char *)current_perdisplay);
+      case Lisp_Misc_Kboard_Objfwd:
+       offset = XKBOARD_OBJFWD (valcontents)->offset;
+       return *(Lisp_Object *)(offset + (char *)current_kboard);
       }
   return valcontents;
 }
@@ -733,11 +761,14 @@ store_symval_forwarding (sym, valcontents, newval)
   switch (SWITCH_ENUM_CAST (XTYPE (valcontents)))
     {
     case Lisp_Misc:
-      switch (XMISC (valcontents)->type)
+      switch (XMISCTYPE (valcontents))
        {
        case Lisp_Misc_Intfwd:
          CHECK_NUMBER (newval, 1);
          *XINTFWD (valcontents)->intvar = XINT (newval);
+         if (*XINTFWD (valcontents)->intvar != XINT (newval))
+           error ("Value out of range for variable `%s'",
+                  XSYMBOL (sym)->name->data);
          break;
 
        case Lisp_Misc_Boolfwd:
@@ -762,11 +793,9 @@ store_symval_forwarding (sym, valcontents, newval)
          }
          break;
 
-       case Lisp_Misc_Display_Objfwd:
-         if (!current_perdisplay)
-           abort ();
-         (*(Lisp_Object *)((char *)current_perdisplay
-                           + XDISPLAY_OBJFWD (valcontents)->offset))
+       case Lisp_Misc_Kboard_Objfwd:
+         (*(Lisp_Object *)((char *)current_kboard
+                           + XKBOARD_OBJFWD (valcontents)->offset))
            = newval;
          break;
 
@@ -833,7 +862,7 @@ swap_in_symval_forwarding (sym, valcontents)
 \f
 /* Find the value of a symbol, returning Qunbound if it's not bound.
    This is helpful for code which just wants to get a variable's value
-   if it has one, without signalling an error.
+   if it has one, without signaling an error.
    Note that it must not be possible to quit
    within this function.  Great care is required for this.  */
 
@@ -852,7 +881,7 @@ find_symbol_value (sym)
 
   if (MISCP (valcontents))
     {
-      switch (XMISC (valcontents)->type)
+      switch (XMISCTYPE (valcontents))
        {
        case Lisp_Misc_Intfwd:
          XSETINT (val, *XINTFWD (valcontents)->intvar);
@@ -868,11 +897,9 @@ find_symbol_value (sym)
          return *(Lisp_Object *)(XBUFFER_OBJFWD (valcontents)->offset
                                  + (char *)current_buffer);
 
-       case Lisp_Misc_Display_Objfwd:
-         if (!current_perdisplay)
-           abort ();
-         return *(Lisp_Object *)(XDISPLAY_OBJFWD (valcontents)->offset
-                                 + (char *)current_perdisplay);
+       case Lisp_Misc_Kboard_Objfwd:
+         return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
+                                 + (char *)current_kboard);
        }
     }
 
@@ -1191,14 +1218,14 @@ The function `default-value' gets the default value and `set-default' sets it.")
   CHECK_SYMBOL (sym, 0);
 
   valcontents = XSYMBOL (sym)->value;
-  if (EQ (sym, Qnil) || EQ (sym, Qt) || DISPLAY_OBJFWDP (valcontents))
+  if (EQ (sym, Qnil) || EQ (sym, Qt) || KBOARD_OBJFWDP (valcontents))
     error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data);
 
   if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
     return sym;
   if (SOME_BUFFER_LOCAL_VALUEP (valcontents))
     {
-      XMISC (XSYMBOL (sym)->value)->type = Lisp_Misc_Buffer_Local_Value;
+      XMISCTYPE (XSYMBOL (sym)->value) = Lisp_Misc_Buffer_Local_Value;
       return sym;
     }
   if (EQ (valcontents, Qunbound))
@@ -1206,7 +1233,7 @@ The function `default-value' gets the default value and `set-default' sets it.")
   tem = Fcons (Qnil, Fsymbol_value (sym));
   XCONS (tem)->car = tem;
   newval = allocate_misc ();
-  XMISC (newval)->type = Lisp_Misc_Buffer_Local_Value;
+  XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
   XBUFFER_LOCAL_VALUE (newval)->car = XSYMBOL (sym)->value;
   XBUFFER_LOCAL_VALUE (newval)->cdr = Fcons (Fcurrent_buffer (), tem);
   XSYMBOL (sym)->value = newval;
@@ -1234,7 +1261,7 @@ Use `make-local-hook' instead.")
   CHECK_SYMBOL (sym, 0);
 
   valcontents = XSYMBOL (sym)->value;
-  if (EQ (sym, Qnil) || EQ (sym, Qt) || DISPLAY_OBJFWDP (valcontents))
+  if (EQ (sym, Qnil) || EQ (sym, Qt) || KBOARD_OBJFWDP (valcontents))
     error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data);
 
   if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
@@ -1253,7 +1280,7 @@ Use `make-local-hook' instead.")
       tem = Fcons (Qnil, do_symval_forwarding (valcontents));
       XCONS (tem)->car = tem;
       newval = allocate_misc ();
-      XMISC (newval)->type = Lisp_Misc_Some_Buffer_Local_Value;
+      XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_Value;
       XBUFFER_LOCAL_VALUE (newval)->car = XSYMBOL (sym)->value;
       XBUFFER_LOCAL_VALUE (newval)->cdr = Fcons (Qnil, tem);
       XSYMBOL (sym)->value = newval;
@@ -1262,6 +1289,11 @@ Use `make-local-hook' instead.")
   tem = Fassq (sym, current_buffer->local_var_alist);
   if (NILP (tem))
     {
+      /* Swap out any local binding for some other buffer, and make
+        sure the current value is permanently recorded, if it's the
+        default value.  */
+      find_symbol_value (sym);
+
       current_buffer->local_var_alist
         = Fcons (Fcons (sym, XCONS (XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->cdr)->cdr),
                 current_buffer->local_var_alist);
@@ -1270,7 +1302,9 @@ Use `make-local-hook' instead.")
         force it to look once again for this buffer's value */
       {
        Lisp_Object *pvalbuf;
+
        valcontents = XSYMBOL (sym)->value;
+
        pvalbuf = &XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
        if (current_buffer == XBUFFER (*pvalbuf))
          *pvalbuf = Qnil;
@@ -1341,20 +1375,86 @@ From now on the default value will apply in this buffer.")
 }
 
 DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
-  1, 1, 0,
-  "Non-nil if VARIABLE has a local binding in the current buffer.")
-  (sym)
-     register Lisp_Object sym;
+  1, 2, 0,
+  "Non-nil if VARIABLE has a local binding in buffer BUFFER.\n\
+BUFFER defaults to the current buffer.")
+  (sym, buffer)
+     register Lisp_Object sym, buffer;
 {
   Lisp_Object valcontents;
+  register struct buffer *buf;
+
+  if (NILP (buffer))
+    buf = current_buffer;
+  else
+    {
+      CHECK_BUFFER (buffer, 0);
+      buf = XBUFFER (buffer);
+    }
 
   CHECK_SYMBOL (sym, 0);
 
   valcontents = XSYMBOL (sym)->value;
-  return ((BUFFER_LOCAL_VALUEP (valcontents)
-          || SOME_BUFFER_LOCAL_VALUEP (valcontents)
-          || BUFFER_OBJFWDP (valcontents))
-         ? Qt : Qnil);
+  if (BUFFER_LOCAL_VALUEP (valcontents)
+      || SOME_BUFFER_LOCAL_VALUEP (valcontents))
+    {
+      Lisp_Object tail, elt;
+      for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr)
+       {
+         elt = XCONS (tail)->car;
+         if (EQ (sym, XCONS (elt)->car))
+           return Qt;
+       }
+    }
+  if (BUFFER_OBJFWDP (valcontents))
+    {
+      int offset = XBUFFER_OBJFWD (valcontents)->offset;
+      int mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
+      if (mask == -1 || (buf->local_var_flags & mask))
+       return Qt;
+    }
+  return Qnil;
+}
+
+DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
+  1, 2, 0,
+  "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.\n\
+BUFFER defaults to the current buffer.")
+  (sym, buffer)
+     register Lisp_Object sym, buffer;
+{
+  Lisp_Object valcontents;
+  register struct buffer *buf;
+
+  if (NILP (buffer))
+    buf = current_buffer;
+  else
+    {
+      CHECK_BUFFER (buffer, 0);
+      buf = XBUFFER (buffer);
+    }
+
+  CHECK_SYMBOL (sym, 0);
+
+  valcontents = XSYMBOL (sym)->value;
+
+  /* This means that make-variable-buffer-local was done.  */
+  if (BUFFER_LOCAL_VALUEP (valcontents))
+    return Qt;
+  /* All these slots become local if they are set.  */
+  if (BUFFER_OBJFWDP (valcontents))
+    return Qt;
+  if (SOME_BUFFER_LOCAL_VALUEP (valcontents))
+    {
+      Lisp_Object tail, elt;
+      for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr)
+       {
+         elt = XCONS (tail)->car;
+         if (EQ (sym, XCONS (elt)->car))
+           return Qt;
+       }
+    }
+  return Qnil;
 }
 \f
 /* Find the function at the end of a chain of symbol function indirections.  */
@@ -1416,7 +1516,8 @@ function chain of symbols.")
 
 DEFUN ("aref", Faref, Saref, 2, 2, 0,
   "Return the element of ARRAY at index INDEX.\n\
-ARRAY may be a vector or a string, or a byte-code object.  INDEX starts at 0.")
+ARRAY may be a vector, a string, a char-table, a bool-vector,\n\
+or a byte-code object.  INDEX starts at 0.")
   (array, idx)
      register Lisp_Object array;
      Lisp_Object idx;
@@ -1433,6 +1534,74 @@ ARRAY may be a vector or a string, or a byte-code object.  INDEX starts at 0.")
       XSETFASTINT (val, (unsigned char) XSTRING (array)->data[idxval]);
       return val;
     }
+  else if (BOOL_VECTOR_P (array))
+    {
+      int val;
+
+      if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
+       args_out_of_range (array, idx);
+
+      val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR];
+      return (val & (1 << (idxval % BITS_PER_CHAR)) ? Qt : Qnil);
+    }
+  else if (CHAR_TABLE_P (array))
+    {
+      Lisp_Object val;
+
+      if (idxval < 0)
+       args_out_of_range (array, idx);
+#if 1
+      if ((unsigned) idxval >= CHAR_TABLE_ORDINARY_SLOTS)
+       args_out_of_range (array, idx);
+      return val = XCHAR_TABLE (array)->contents[idxval];
+#else /* 0 */
+      if ((unsigned) idxval < CHAR_TABLE_ORDINARY_SLOTS)
+       val = XCHAR_TABLE (array)->data[idxval];
+      else
+       {
+         int charset;
+         unsigned char c1, c2;
+         Lisp_Object val, temp;
+
+         BREAKUP_NON_ASCII_CHAR (idxval, charset, c1, c2);
+
+       try_parent_char_table:
+         val = XCHAR_TABLE (array)->contents[charset];
+         if (c1 == 0 || !CHAR_TABLE_P (val))
+           return val;
+
+         temp = XCHAR_TABLE (val)->contents[c1];
+         if (NILP (temp))
+           val = XCHAR_TABLE (val)->defalt;
+         else
+           val = temp;
+
+         if (NILP (val) && !NILP (XCHAR_TABLE (array)->parent))
+           {
+             array = XCHAR_TABLE (array)->parent;
+             goto try_parent_char_table;
+
+           }
+
+         if (c2 == 0 || !CHAR_TABLE_P (val))
+           return val;
+
+         temp = XCHAR_TABLE (val)->contents[c2];
+         if (NILP (temp))
+           val = XCHAR_TABLE (val)->defalt;
+         else
+           val = temp;
+
+         if (NILP (val) && !NILP (XCHAR_TABLE (array)->parent))
+           {
+             array = XCHAR_TABLE (array)->parent;
+             goto try_parent_char_table;
+           }
+
+         return val;
+       }
+#endif /* 0 */
+    }
   else
     {
       int size;
@@ -1460,7 +1629,8 @@ ARRAY may be a vector or a string.  IDX starts at 0.")
 
   CHECK_NUMBER (idx, 1);
   idxval = XINT (idx);
-  if (!VECTORP (array) && !STRINGP (array))
+  if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array)
+      && ! CHAR_TABLE_P (array))
     array = wrong_type_argument (Qarrayp, array);
   CHECK_IMPURE (array);
 
@@ -1470,6 +1640,63 @@ ARRAY may be a vector or a string.  IDX starts at 0.")
        args_out_of_range (array, idx);
       XVECTOR (array)->contents[idxval] = newelt;
     }
+  else if (BOOL_VECTOR_P (array))
+    {
+      int val;
+
+      if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
+       args_out_of_range (array, idx);
+
+      val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR];
+
+      if (! NILP (newelt))
+       val |= 1 << (idxval % BITS_PER_CHAR);
+      else
+       val &= ~(1 << (idxval % BITS_PER_CHAR));
+      XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR] = val;
+    }
+  else if (CHAR_TABLE_P (array))
+    {
+      Lisp_Object val;
+
+      if (idxval < 0)
+       args_out_of_range (array, idx);
+#if 1
+      if (idxval >= CHAR_TABLE_ORDINARY_SLOTS)
+       args_out_of_range (array, idx);
+      XCHAR_TABLE (array)->contents[idxval] = newelt;
+      return newelt;
+#else /* 0 */
+      if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
+       val = XCHAR_TABLE (array)->contents[idxval];
+      else
+       {
+         int charset;
+         unsigned char c1, c2;
+         Lisp_Object val, val2;
+
+         BREAKUP_NON_ASCII_CHAR (idxval, charset, c1, c2);
+
+         if (c1 == 0)
+           return XCHAR_TABLE (array)->contents[charset] = newelt;
+
+         val = XCHAR_TABLE (array)->contents[charset];
+         if (!CHAR_TABLE_P (val))
+           XCHAR_TABLE (array)->contents[charset]
+             = val = Fmake_char_table (Qnil);
+
+         if (c2 == 0)
+           return XCHAR_TABLE (val)->contents[c1] = newelt;
+
+         val2 = XCHAR_TABLE (val)->contents[c2];
+         if (!CHAR_TABLE_P (val2))
+           XCHAR_TABLE (val)->contents[charset]
+             = val2 = Fmake_char_table (Qnil);
+
+         return XCHAR_TABLE (val2)->contents[c2] = newelt;
+       }
+#endif /* 0 */
+    }
   else
     {
       if (idxval < 0 || idxval >= XSTRING (array)->size)
@@ -1617,7 +1844,7 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, "T if NUMBER is zero.")
   return Qnil;
 }
 \f
-/* Convert between 32-bit values and pairs of lispy 24-bit values.  */
+/* Convert between long values and pairs of Lisp integers.  */
 
 Lisp_Object
 long_to_cons (i)
@@ -1627,7 +1854,7 @@ long_to_cons (i)
   unsigned int bot = i & 0xFFFF;
   if (top == 0)
     return make_number (bot);
-  if (top == 0xFFFF)
+  if (top == (unsigned long)-1 >> 16)
     return Fcons (make_number (-1), make_number (bot));
   return Fcons (make_number (top), make_number (bot));
 }
@@ -1653,7 +1880,7 @@ NUM may be an integer or a floating point number.")
   (num)
      Lisp_Object num;
 {
-  char buffer[20];
+  char buffer[VALBITS];
 
 #ifndef LISP_FLOAT_TYPE
   CHECK_NUMBER (num, 0);
@@ -1669,7 +1896,12 @@ NUM may be an integer or a floating point number.")
     }
 #endif /* LISP_FLOAT_TYPE */
 
-  sprintf (buffer, "%d", XINT (num));
+  if (sizeof (int) == sizeof (EMACS_INT))
+    sprintf (buffer, "%d", XINT (num));
+  else if (sizeof (long) == sizeof (EMACS_INT))
+    sprintf (buffer, "%ld", XINT (num));
+  else
+    abort ();
   return build_string (buffer);
 }
 
@@ -1680,6 +1912,7 @@ It ignores leading spaces and tabs.")
   (str)
      register Lisp_Object str;
 {
+  Lisp_Object value;
   unsigned char *p;
 
   CHECK_STRING (str, 0);
@@ -1696,7 +1929,13 @@ It ignores leading spaces and tabs.")
     return make_float (atof (p));
 #endif /* LISP_FLOAT_TYPE */
 
-  return make_number (atoi (p));
+  if (sizeof (int) == sizeof (EMACS_INT))
+    XSETINT (value, atoi (p));
+  else if (sizeof (long) == sizeof (EMACS_INT))
+    XSETINT (value, atol (p));
+  else
+    abort ();
+  return value;
 }
 \f
 enum arithop
@@ -1712,8 +1951,8 @@ arith_driver (code, nargs, args)
 {
   register Lisp_Object val;
   register int argnum;
-  register int accum;
-  register int next;
+  register EMACS_INT accum;
+  register EMACS_INT next;
 
   switch (SWITCH_ENUM_CAST (code))
     {
@@ -1906,11 +2145,9 @@ double
 fmod (f1, f2)
      double f1, f2;
 {
-#ifdef HAVE_DREM  /* Some systems use this non-standard name.  */
-  return (drem (f1, f2));
-#else  /* Other systems don't seem to have it at all.  */
+  if (f2 < 0.0)
+    f2 = -f2;
   return (f1 - f2 * floor (f1/f2));
-#endif
 }
 #endif /* ! HAVE_FMOD */
 
@@ -1922,7 +2159,7 @@ Both X and Y must be numbers or markers.")
      register Lisp_Object num1, num2;
 {
   Lisp_Object val;
-  int i1, i2;
+  EMACS_INT i1, i2;
 
 #ifdef LISP_FLOAT_TYPE
   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
@@ -1939,7 +2176,7 @@ Both X and Y must be numbers or markers.")
 
       f1 = fmod (f1, f2);
       /* If the "remainder" comes out with the wrong sign, fix it.  */
-      if ((f1 < 0) != (f2 < 0))
+      if (f2 < 0 ? f1 > 0 : f1 < 0)
        f1 += f2;
       return (make_float (f1));
     }
@@ -1957,7 +2194,7 @@ Both X and Y must be numbers or markers.")
   i1 %= i2;
 
   /* If the "remainder" comes out with the wrong sign, fix it.  */
-  if ((i1 < 0) != (i2 < 0))
+  if (i2 < 0 ? i1 > 0 : i1 < 0)
     i1 += i2;
 
   XSETINT (val, i1);
@@ -2018,18 +2255,18 @@ DEFUN ("ash", Fash, Sash, 2, 2, 0,
   "Return VALUE with its bits shifted left by COUNT.\n\
 If COUNT is negative, shifting is actually to the right.\n\
 In this case, the sign bit is duplicated.")
-  (num1, num2)
-     register Lisp_Object num1, num2;
+  (value, count)
+     register Lisp_Object value, count;
 {
   register Lisp_Object val;
 
-  CHECK_NUMBER (num1, 0);
-  CHECK_NUMBER (num2, 1);
+  CHECK_NUMBER (value, 0);
+  CHECK_NUMBER (count, 1);
 
-  if (XINT (num2) > 0)
-    XSETINT (val, XINT (num1) << XFASTINT (num2));
+  if (XINT (count) > 0)
+    XSETINT (val, XINT (value) << XFASTINT (count));
   else
-    XSETINT (val, XINT (num1) >> -XINT (num2));
+    XSETINT (val, XINT (value) >> -XINT (count));
   return val;
 }
 
@@ -2037,18 +2274,18 @@ DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
   "Return VALUE with its bits shifted left by COUNT.\n\
 If COUNT is negative, shifting is actually to the right.\n\
 In this case,  zeros are shifted in on the left.")
-  (num1, num2)
-     register Lisp_Object num1, num2;
+  (value, count)
+     register Lisp_Object value, count;
 {
   register Lisp_Object val;
 
-  CHECK_NUMBER (num1, 0);
-  CHECK_NUMBER (num2, 1);
+  CHECK_NUMBER (value, 0);
+  CHECK_NUMBER (count, 1);
 
-  if (XINT (num2) > 0)
-    XSETINT (val, (EMACS_UINT) XUINT (num1) << XFASTINT (num2));
+  if (XINT (count) > 0)
+    XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count));
   else
-    XSETINT (val, (EMACS_UINT) XUINT (num1) >> -XINT (num2));
+    XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count));
   return val;
 }
 
@@ -2156,6 +2393,9 @@ syms_of_data ()
   Qnumber_or_marker_p = intern ("number-or-marker-p");
 #endif /* LISP_FLOAT_TYPE */
 
+  Qchar_table_p = intern ("char-table-p");
+  Qvector_or_char_table_p = intern ("vector-or-char-table-p");
+
   Qcdr = intern ("cdr");
 
   /* Handle automatic advice activation */
@@ -2340,6 +2580,8 @@ syms_of_data ()
   staticpro (&Qnumberp);
   staticpro (&Qnumber_or_marker_p);
 #endif /* LISP_FLOAT_TYPE */
+  staticpro (&Qchar_table_p);
+  staticpro (&Qvector_or_char_table_p);
 
   staticpro (&Qboundp);
   staticpro (&Qfboundp);
@@ -2363,6 +2605,8 @@ syms_of_data ()
   Qbuffer = intern ("buffer");
   Qframe = intern ("frame");
   Qvector = intern ("vector");
+  Qchar_table = intern ("char-table");
+  Qbool_vector = intern ("bool-vector");
 
   staticpro (&Qinteger);
   staticpro (&Qsymbol);
@@ -2379,6 +2623,8 @@ syms_of_data ()
   staticpro (&Qbuffer);
   staticpro (&Qframe);
   staticpro (&Qvector);
+  staticpro (&Qchar_table);
+  staticpro (&Qbool_vector);
 
   defsubr (&Seq);
   defsubr (&Snull);
@@ -2398,6 +2644,9 @@ syms_of_data ()
   defsubr (&Ssymbolp);
   defsubr (&Sstringp);
   defsubr (&Svectorp);
+  defsubr (&Schar_table_p);
+  defsubr (&Svector_or_char_table_p);
+  defsubr (&Sbool_vector_p);
   defsubr (&Sarrayp);
   defsubr (&Ssequencep);
   defsubr (&Sbufferp);
@@ -2433,6 +2682,7 @@ syms_of_data ()
   defsubr (&Smake_local_variable);
   defsubr (&Skill_local_variable);
   defsubr (&Slocal_variable_p);
+  defsubr (&Slocal_variable_if_set_p);
   defsubr (&Saref);
   defsubr (&Saset);
   defsubr (&Snumber_to_string);