*** empty log message ***

[gnu-emacs] / src / data.c

diff --git a/src/data.c b/src/data.c
index 3585d2d105b29f40cedc87b2eb5ff6808b11bec5..c0c797da266ff80cc3245a1f279ef4c45e669d63 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -1,6 +1,6 @@
 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.

-   Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 2003
-   Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000,
+                 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.

 
 This file is part of GNU Emacs.
 
 
 This file is part of GNU Emacs.
 


@@ -16,8 +16,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to

-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */

 
 
 #include <config.h>
 
 
 #include <config.h>


@@ -71,6 +71,7 @@ Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
 Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
 Lisp_Object Qtext_read_only;
 Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
 Lisp_Object Qtext_read_only;

+

 Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
 Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
 Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
 Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;


@@ -87,7 +88,8 @@ Lisp_Object Qoverflow_error, Qunderflow_error;
 Lisp_Object Qfloatp;
 Lisp_Object Qnumberp, Qnumber_or_marker_p;
 
 Lisp_Object Qfloatp;
 Lisp_Object Qnumberp, Qnumber_or_marker_p;
 

-static Lisp_Object Qinteger, Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
+Lisp_Object Qinteger;
+static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;

 static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
 Lisp_Object Qprocess;
 static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
 static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
 Lisp_Object Qprocess;
 static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;


@@ -721,14 +723,14 @@ determined by DEFINITION.  */)
       && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
     LOADHIST_ATTACH (Fcons (Qt, symbol));
   definition = Ffset (symbol, definition);
       && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
     LOADHIST_ATTACH (Fcons (Qt, symbol));
   definition = Ffset (symbol, definition);

-  LOADHIST_ATTACH (symbol);
+  LOADHIST_ATTACH (Fcons (Qdefun, symbol));

   if (!NILP (docstring))
     Fput (symbol, Qfunction_documentation, docstring);
   return definition;
 }
 
 DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
   if (!NILP (docstring))
     Fput (symbol, Qfunction_documentation, docstring);
   return definition;
 }
 
 DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,

-       doc: /* Set SYMBOL's property list to NEWVAL, and return NEWVAL.  */)
+       doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.  */)

      (symbol, newplist)
      register Lisp_Object symbol, newplist;
 {
      (symbol, newplist)
      register Lisp_Object symbol, newplist;
 {


@@ -759,17 +761,52 @@ function with `&rest' args, or `unevalled' for a special form.  */)
     return Fcons (make_number (minargs), make_number (maxargs));
 }
 
     return Fcons (make_number (minargs), make_number (maxargs));
 }
 

-DEFUN ("subr-interactive-form", Fsubr_interactive_form, Ssubr_interactive_form, 1, 1, 0,
-       doc: /* Return the interactive form of SUBR or nil if none.
-SUBR must be a built-in function.  Value, if non-nil, is a list
-\(interactive SPEC).  */)
+DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
+       doc: /* Return name of subroutine SUBR.
+SUBR must be a built-in function.  */)

      (subr)
      Lisp_Object subr;
 {
      (subr)
      Lisp_Object subr;
 {

+  const char *name;

   if (!SUBRP (subr))
     wrong_type_argument (Qsubrp, subr);
   if (!SUBRP (subr))
     wrong_type_argument (Qsubrp, subr);

-  if (XSUBR (subr)->prompt)
-    return list2 (Qinteractive, build_string (XSUBR (subr)->prompt));
+  name = XSUBR (subr)->symbol_name;
+  return make_string (name, strlen (name));
+}
+
+DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
+       doc: /* Return the interactive form of CMD or nil if none.
+If CMD is not a command, the return value is nil.
+Value, if non-nil, is a list \(interactive SPEC).  */)
+     (cmd)
+     Lisp_Object cmd;
+{
+  Lisp_Object fun = indirect_function (cmd);
+
+  if (SUBRP (fun))
+    {
+      if (XSUBR (fun)->prompt)
+       return list2 (Qinteractive, build_string (XSUBR (fun)->prompt));
+    }
+  else if (COMPILEDP (fun))
+    {
+      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
+       return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
+    }
+  else if (CONSP (fun))
+    {
+      Lisp_Object funcar = XCAR (fun);
+      if (EQ (funcar, Qlambda))
+       return Fassq (Qinteractive, Fcdr (XCDR (fun)));
+      else if (EQ (funcar, Qautoload))
+       {
+         struct gcpro gcpro1;
+         GCPRO1 (cmd);
+         do_autoload (fun, cmd);
+         UNGCPRO;
+         return Finteractive_form (cmd);
+       }
+    }

   return Qnil;
 }
 
   return Qnil;
 }
 


@@ -890,6 +927,36 @@ store_symval_forwarding (symbol, valcontents, newval, buf)
 
        case Lisp_Misc_Objfwd:
          *XOBJFWD (valcontents)->objvar = newval;
 
        case Lisp_Misc_Objfwd:
          *XOBJFWD (valcontents)->objvar = newval;

+
+         /* If this variable is a default for something stored
+            in the buffer itself, such as default-fill-column,
+            find the buffers that don't have local values for it
+            and update them.  */
+         if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
+             && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
+           {
+             int offset = ((char *) XOBJFWD (valcontents)->objvar
+                           - (char *) &buffer_defaults);
+             int idx = PER_BUFFER_IDX (offset);
+
+             Lisp_Object tail;
+
+             if (idx <= 0)
+               break;
+
+             for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
+               {
+                 Lisp_Object buf;
+                 struct buffer *b;
+
+                 buf = Fcdr (XCAR (tail));
+                 if (!BUFFERP (buf)) continue;
+                 b = XBUFFER (buf);
+
+                 if (! PER_BUFFER_VALUE_P (b, idx))
+                   PER_BUFFER_VALUE (b, offset) = newval;
+               }
+           }

          break;
 
        case Lisp_Misc_Buffer_Objfwd:
          break;
 
        case Lisp_Misc_Buffer_Objfwd:


@@ -1338,7 +1405,7 @@ local bindings in certain buffers.  */)
 }
 
 DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
 }
 
 DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,

-       doc: /* Set SYMBOL's default value to VAL.  SYMBOL and VAL are evaluated.
+       doc: /* Set SYMBOL's default value to VALUE.  SYMBOL and VALUE are evaluated.

 The default value is seen in buffers that do not have their own values
 for this variable.  */)
      (symbol, value)
 The default value is seen in buffers that do not have their own values
 for this variable.  */)
      (symbol, value)


@@ -1391,7 +1458,7 @@ for this variable.  */)
   return value;
 }
 
   return value;
 }
 

-DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0,
+DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0,

        doc: /* Set the default value of variable VAR to VALUE.
 VAR, the variable name, is literal (not evaluated);
 VALUE is an expression: it is evaluated and its value returned.
        doc: /* Set the default value of variable VAR to VALUE.
 VAR, the variable name, is literal (not evaluated);
 VALUE is an expression: it is evaluated and its value returned.


@@ -1399,11 +1466,11 @@ The default value of a variable is seen in buffers
 that do not have their own values for the variable.
 
 More generally, you can use multiple variables and values, as in
 that do not have their own values for the variable.
 
 More generally, you can use multiple variables and values, as in

-  (setq-default SYMBOL VALUE SYMBOL VALUE...)
-This sets each SYMBOL's default value to the corresponding VALUE.
-The VALUE for the Nth SYMBOL can refer to the new default values
-of previous SYMs.
-usage: (setq-default SYMBOL VALUE [SYMBOL VALUE...])  */)
+  (setq-default VAR VALUE VAR VALUE...)
+This sets each VAR's default value to the corresponding VALUE.
+The VALUE for the Nth VAR can refer to the new default values
+of previous VARs.
+usage: (setq-default [VAR VALUE...])  */)

      (args)
      Lisp_Object args;
 {
      (args)
      Lisp_Object args;
 {


@@ -1442,6 +1509,9 @@ 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.
 
 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.
+

 The function `default-value' gets the default value and `set-default' sets it.  */)
      (variable)
      register Lisp_Object variable;
 The function `default-value' gets the default value and `set-default' sets it.  */)
      (variable)
      register Lisp_Object variable;


@@ -1485,7 +1555,7 @@ DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
 Other buffers will continue to share a common default value.
 \(The buffer-local value of VARIABLE starts out as the same value
 VARIABLE previously had.  If VARIABLE was void, it remains void.\)
 Other buffers will continue to share a common default value.
 \(The buffer-local value of VARIABLE starts out as the same value
 VARIABLE previously had.  If VARIABLE was void, it remains void.\)

-See also `make-variable-buffer-local'.  Return VARIABLE.
+Return VARIABLE.

 
 If the variable is already arranged to become local when set,
 this function causes a local value to exist for this buffer,
 
 If the variable is already arranged to become local when set,
 this function causes a local value to exist for this buffer,


@@ -1495,6 +1565,8 @@ This function returns VARIABLE, and therefore
   (set (make-local-variable 'VARIABLE) VALUE-EXP)
 works.
 
   (set (make-local-variable 'VARIABLE) VALUE-EXP)
 works.
 

+See also `make-variable-buffer-local'.
+

 Do not use `make-local-variable' to make a hook variable buffer-local.
 Instead, use `add-hook' and specify t for the LOCAL argument.  */)
      (variable)
 Do not use `make-local-variable' to make a hook variable buffer-local.
 Instead, use `add-hook' and specify t for the LOCAL argument.  */)
      (variable)


@@ -1725,7 +1797,11 @@ BUFFER defaults to the current buffer.  */)
 
 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
        1, 2, 0,
 
 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
        1, 2, 0,

-       doc: /* Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.
+       doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there.
+More precisely, this means that setting the variable \(with `set' or`setq'),
+while it does not have a `let'-style binding that was made in BUFFER,
+will produce a buffer local binding.  See Info node
+`(elisp)Creating Buffer-Local'.

 BUFFER defaults to the current buffer.  */)
      (variable, buffer)
      register Lisp_Object variable, buffer;
 BUFFER defaults to the current buffer.  */)
      (variable, buffer)
      register Lisp_Object variable, buffer;


@@ -1890,8 +1966,8 @@ or a byte-code object.  IDX starts at 0.  */)
       if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
        args_out_of_range (array, idx);
 
       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);
+      val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR];
+      return (val & (1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)) ? Qt : Qnil);

     }
   else if (CHAR_TABLE_P (array))
     {
     }
   else if (CHAR_TABLE_P (array))
     {


@@ -1903,9 +1979,19 @@ or a byte-code object.  IDX starts at 0.  */)
        args_out_of_range (array, idx);
       if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
        {
        args_out_of_range (array, idx);
       if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
        {

+         if (! SINGLE_BYTE_CHAR_P (idxval))
+           args_out_of_range (array, idx);

          /* For ASCII and 8-bit European characters, the element is
              stored in the top table.  */
          val = XCHAR_TABLE (array)->contents[idxval];
          /* For ASCII and 8-bit European characters, the element is
              stored in the top table.  */
          val = XCHAR_TABLE (array)->contents[idxval];

+         if (NILP (val))
+           {
+             int default_slot
+               = (idxval < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII
+                  : idxval < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL
+                  : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC);
+             val = XCHAR_TABLE (array)->contents[default_slot];
+           }

          if (NILP (val))
            val = XCHAR_TABLE (array)->defalt;
          while (NILP (val))    /* Follow parents until we find some value.  */
          if (NILP (val))
            val = XCHAR_TABLE (array)->defalt;
          while (NILP (val))    /* Follow parents until we find some value.  */


@@ -1923,6 +2009,7 @@ or a byte-code object.  IDX starts at 0.  */)
        {
          int code[4], i;
          Lisp_Object sub_table;
        {
          int code[4], i;
          Lisp_Object sub_table;

+         Lisp_Object current_default;

 
          SPLIT_CHAR (idxval, code[0], code[1], code[2]);
          if (code[1] < 32) code[1] = -1;
 
          SPLIT_CHAR (idxval, code[0], code[1], code[2]);
          if (code[1] < 32) code[1] = -1;


@@ -1936,16 +2023,21 @@ or a byte-code object.  IDX starts at 0.  */)
          code[3] = -1;         /* anchor */
 
        try_parent_char_table:
          code[3] = -1;         /* anchor */
 
        try_parent_char_table:

+         current_default = XCHAR_TABLE (array)->defalt;

          sub_table = array;
          for (i = 0; code[i] >= 0; i++)
            {
              val = XCHAR_TABLE (sub_table)->contents[code[i]];
              if (SUB_CHAR_TABLE_P (val))
          sub_table = array;
          for (i = 0; code[i] >= 0; i++)
            {
              val = XCHAR_TABLE (sub_table)->contents[code[i]];
              if (SUB_CHAR_TABLE_P (val))

-               sub_table = val;
+               {
+                 sub_table = val;
+                 if (! NILP (XCHAR_TABLE (sub_table)->defalt))
+                   current_default = XCHAR_TABLE (sub_table)->defalt;
+               }

              else
                {
                  if (NILP (val))
              else
                {
                  if (NILP (val))

-                   val = XCHAR_TABLE (sub_table)->defalt;
+                   val = current_default;

                  if (NILP (val))
                    {
                      array = XCHAR_TABLE (array)->parent;
                  if (NILP (val))
                    {
                      array = XCHAR_TABLE (array)->parent;


@@ -1955,9 +2047,12 @@ or a byte-code object.  IDX starts at 0.  */)
                  return val;
                }
            }
                  return val;
                }
            }

-         /* Here, VAL is a sub char table.  We try the default value
-             and parent.  */
-         val = XCHAR_TABLE (val)->defalt;
+         /* Reaching here means IDXVAL is a generic character in
+            which each character or a group has independent value.
+            Essentially it's nonsense to get a value for such a
+            generic character, but for backward compatibility, we try
+            the default value and parent.  */
+         val = current_default;

          if (NILP (val))
            {
              array = XCHAR_TABLE (array)->parent;
          if (NILP (val))
            {
              array = XCHAR_TABLE (array)->parent;


@@ -1983,11 +2078,6 @@ or a byte-code object.  IDX starts at 0.  */)
     }
 }
 
     }
 }
 

-/* Don't use alloca for relocating string data larger than this, lest
-   we overflow their stack.  The value is the same as what used in
-   fns.c for base64 handling.  */
-#define MAX_ALLOCA 16*1024
-

 DEFUN ("aset", Faset, Saset, 3, 3, 0,
        doc: /* Store into the element of ARRAY at index IDX the value NEWELT.
 Return NEWELT.  ARRAY may be a vector, a string, a char-table or a
 DEFUN ("aset", Faset, Saset, 3, 3, 0,
        doc: /* Store into the element of ARRAY at index IDX the value NEWELT.
 Return NEWELT.  ARRAY may be a vector, a string, a char-table or a


@@ -2018,20 +2108,24 @@ bool-vector.  IDX starts at 0.  */)
       if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
        args_out_of_range (array, idx);
 
       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];
+      val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR];

 
       if (! NILP (newelt))
 
       if (! NILP (newelt))

-       val |= 1 << (idxval % BITS_PER_CHAR);
+       val |= 1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR);

       else
       else

-       val &= ~(1 << (idxval % BITS_PER_CHAR));
-      XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR] = val;
+       val &= ~(1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR));
+      XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR] = val;

     }
   else if (CHAR_TABLE_P (array))
     {
       if (idxval < 0)
        args_out_of_range (array, idx);
       if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
     }
   else if (CHAR_TABLE_P (array))
     {
       if (idxval < 0)
        args_out_of_range (array, idx);
       if (idxval < CHAR_TABLE_ORDINARY_SLOTS)

-       XCHAR_TABLE (array)->contents[idxval] = newelt;
+       {
+         if (! SINGLE_BYTE_CHAR_P (idxval))
+           args_out_of_range (array, idx);
+         XCHAR_TABLE (array)->contents[idxval] = newelt;
+       }

       else
        {
          int code[4], i;
       else
        {
          int code[4], i;


@@ -2054,12 +2148,9 @@ bool-vector.  IDX starts at 0.  */)
                  Lisp_Object temp;
 
                  /* VAL is a leaf.  Create a sub char table with the
                  Lisp_Object temp;
 
                  /* VAL is a leaf.  Create a sub char table with the

-                    default value VAL or XCHAR_TABLE (array)->defalt
-                    and look into it.  */
+                    initial value VAL and look into it.  */

 
 

-                 temp = make_sub_char_table (NILP (val)
-                                             ? XCHAR_TABLE (array)->defalt
-                                             : val);
+                 temp = make_sub_char_table (val);

                  XCHAR_TABLE (array)->contents[code[i]] = temp;
                  array = temp;
                }
                  XCHAR_TABLE (array)->contents[code[i]] = temp;
                  array = temp;
                }


@@ -2087,10 +2178,9 @@ bool-vector.  IDX starts at 0.  */)
          /* We must relocate the string data.  */
          int nchars = SCHARS (array);
          unsigned char *str;
          /* We must relocate the string data.  */
          int nchars = SCHARS (array);
          unsigned char *str;

+         USE_SAFE_ALLOCA;

 
 

-         str = (nbytes <= MAX_ALLOCA
-                ? (unsigned char *) alloca (nbytes)
-                : (unsigned char *) xmalloc (nbytes));
+         SAFE_ALLOCA (str, unsigned char *, nbytes);

          bcopy (SDATA (array), str, nbytes);
          allocate_string_data (XSTRING (array), nchars,
                                nbytes + new_bytes - prev_bytes);
          bcopy (SDATA (array), str, nbytes);
          allocate_string_data (XSTRING (array), nchars,
                                nbytes + new_bytes - prev_bytes);


@@ -2098,8 +2188,7 @@ bool-vector.  IDX starts at 0.  */)
          p1 = SDATA (array) + idxval_byte;
          bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes,
                 nbytes - (idxval_byte + prev_bytes));
          p1 = SDATA (array) + idxval_byte;
          bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes,
                 nbytes - (idxval_byte + prev_bytes));

-         if (nbytes > MAX_ALLOCA)
-           xfree (str);
+         SAFE_FREE ();

          clear_string_char_byte_cache ();
        }
       while (new_bytes--)
          clear_string_char_byte_cache ();
        }
       while (new_bytes--)


@@ -2121,14 +2210,13 @@ bool-vector.  IDX starts at 0.  */)
          unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
          unsigned char *origstr = SDATA (array), *str;
          int nchars, nbytes;
          unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
          unsigned char *origstr = SDATA (array), *str;
          int nchars, nbytes;

+         USE_SAFE_ALLOCA;

 
          nchars = SCHARS (array);
          nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval);
          nbytes += count_size_as_multibyte (origstr + idxval,
                                             nchars - idxval);
 
          nchars = SCHARS (array);
          nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval);
          nbytes += count_size_as_multibyte (origstr + idxval,
                                             nchars - idxval);

-         str = (nbytes <= MAX_ALLOCA
-                ? (unsigned char *) alloca (nbytes)
-                : (unsigned char *) xmalloc (nbytes));
+         SAFE_ALLOCA (str, unsigned char *, nbytes);

          copy_text (SDATA (array), str, nchars, 0, 1);
          PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte,
                               prev_bytes);
          copy_text (SDATA (array), str, nchars, 0, 1);
          PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte,
                               prev_bytes);


@@ -2141,8 +2229,7 @@ bool-vector.  IDX starts at 0.  */)
            *p1++ = *p0++;
          bcopy (str + idxval_byte + prev_bytes, p1,
                 nbytes - (idxval_byte + prev_bytes));
            *p1++ = *p0++;
          bcopy (str + idxval_byte + prev_bytes, p1,
                 nbytes - (idxval_byte + prev_bytes));

-         if (nbytes > MAX_ALLOCA)
-           xfree (str);
+         SAFE_FREE ();

          clear_string_char_byte_cache ();
        }
     }
          clear_string_char_byte_cache ();
        }
     }


@@ -2629,6 +2716,10 @@ usage: (/ DIVIDEND DIVISOR &rest DIVISORS)  */)
      int nargs;
      Lisp_Object *args;
 {
      int nargs;
      Lisp_Object *args;
 {

+  int argnum;
+  for (argnum = 2; argnum < nargs; argnum++)
+    if (FLOATP (args[argnum]))
+      return float_arith_driver (0, 0, Adiv, nargs, args);

   return arith_driver (Adiv, nargs, args);
 }
 
   return arith_driver (Adiv, nargs, args);
 }
 


@@ -2845,6 +2936,20 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
   XSETINT (number, ~XINT (number));
   return number;
 }
   XSETINT (number, ~XINT (number));
   return number;
 }

+
+DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
+       doc: /* Return the byteorder for the machine.
+Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII
+lowercase l) for small endian machines.  */)
+     ()
+{
+  unsigned i = 0x04030201;
+  int order = *(char *)&i == 1 ? 108 : 66;
+
+  return make_number (order);
+}
+
+

 \f
 void
 syms_of_data ()
 \f
 void
 syms_of_data ()


@@ -3076,6 +3181,7 @@ syms_of_data ()
   staticpro (&Qargs_out_of_range);
   staticpro (&Qvoid_function);
   staticpro (&Qcyclic_function_indirection);
   staticpro (&Qargs_out_of_range);
   staticpro (&Qvoid_function);
   staticpro (&Qcyclic_function_indirection);

+  staticpro (&Qcyclic_variable_indirection);

   staticpro (&Qvoid_variable);
   staticpro (&Qsetting_constant);
   staticpro (&Qinvalid_read_syntax);
   staticpro (&Qvoid_variable);
   staticpro (&Qsetting_constant);
   staticpro (&Qinvalid_read_syntax);


@@ -3161,7 +3267,7 @@ syms_of_data ()
   staticpro (&Qhash_table);
 
   defsubr (&Sindirect_variable);
   staticpro (&Qhash_table);
 
   defsubr (&Sindirect_variable);

-  defsubr (&Ssubr_interactive_form);
+  defsubr (&Sinteractive_form);

   defsubr (&Seq);
   defsubr (&Snull);
   defsubr (&Stype_of);
   defsubr (&Seq);
   defsubr (&Snull);
   defsubr (&Stype_of);


@@ -3247,7 +3353,9 @@ syms_of_data ()
   defsubr (&Sadd1);
   defsubr (&Ssub1);
   defsubr (&Slognot);
   defsubr (&Sadd1);
   defsubr (&Ssub1);
   defsubr (&Slognot);

+  defsubr (&Sbyteorder);

   defsubr (&Ssubr_arity);
   defsubr (&Ssubr_arity);

+  defsubr (&Ssubr_name);

 
   XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function;
 
 
   XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function;
 


@@ -3279,6 +3387,7 @@ arith_error (signo)
   sigsetmask (SIGEMPTYMASK);
 #endif /* not BSD4_1 */
 
   sigsetmask (SIGEMPTYMASK);
 #endif /* not BSD4_1 */
 

+  SIGNAL_THREAD_CHECK (signo);

   Fsignal (Qarith_error, Qnil);
 }
 
   Fsignal (Qarith_error, Qnil);
 }