Improve CHECK_IMPURE and PURE_P speedup

[gnu-emacs] / src / data.c

diff --git a/src/data.c b/src/data.c
index d06b9916b3a61204def8006927a5cdb0b6c3cb53..b85d8a77106abf4bbfc6e311e2cfe9e30dc3f0ec 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -186,7 +186,7 @@ DEFUN ("eq", Feq, Seq, 2, 2, 0,
 }
 
 DEFUN ("null", Fnull, Snull, 1, 1, 0,
 }
 
 DEFUN ("null", Fnull, Snull, 1, 1, 0,

-       doc: /* Return t if OBJECT is nil.  */
+       doc: /* Return t if OBJECT is nil, and return nil otherwise.  */

        attributes: const)
   (Lisp_Object object)
 {
        attributes: const)
   (Lisp_Object object)
 {


@@ -223,9 +223,12 @@ for example, (type-of 1) returns `integer'.  */)
        case Lisp_Misc_Overlay:
          return Qoverlay;
        case Lisp_Misc_Float:
        case Lisp_Misc_Overlay:
          return Qoverlay;
        case Lisp_Misc_Float:

-         return Qfloat;
+          return Qfloat;
+        case Lisp_Misc_Finalizer:
+          return Qfinalizer;
+       default:
+         emacs_abort ();

        }
        }

-      emacs_abort ();

 
     case Lisp_Vectorlike:
       if (WINDOW_CONFIGURATIONP (object))
 
     case Lisp_Vectorlike:
       if (WINDOW_CONFIGURATIONP (object))


@@ -557,7 +560,7 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
   (register Lisp_Object cell, Lisp_Object newcar)
 {
   CHECK_CONS (cell);
   (register Lisp_Object cell, Lisp_Object newcar)
 {
   CHECK_CONS (cell);

-  CHECK_IMPURE (cell);
+  CHECK_IMPURE (cell, XCONS (cell));

   XSETCAR (cell, newcar);
   return newcar;
 }
   XSETCAR (cell, newcar);
   return newcar;
 }


@@ -567,7 +570,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
   (register Lisp_Object cell, Lisp_Object newcdr)
 {
   CHECK_CONS (cell);
   (register Lisp_Object cell, Lisp_Object newcdr)
 {
   CHECK_CONS (cell);

-  CHECK_IMPURE (cell);
+  CHECK_IMPURE (cell, XCONS (cell));

   XSETCDR (cell, newcdr);
   return newcdr;
 }
   XSETCDR (cell, newcdr);
   return newcdr;
 }


@@ -788,7 +791,7 @@ SUBR must be a built-in function.  */)
 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
        doc: /* Return the interactive form of CMD or nil if none.
 If CMD is not a command, the return value is nil.
 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
        doc: /* Return the interactive form of CMD or nil if none.
 If CMD is not a command, the return value is nil.

-Value, if non-nil, is a list \(interactive SPEC).  */)
+Value, if non-nil, is a list (interactive SPEC).  */)

   (Lisp_Object cmd)
 {
   Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */
   (Lisp_Object cmd)
 {
   Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */


@@ -1527,10 +1530,8 @@ usage: (setq-default [VAR VALUE]...)  */)
   (Lisp_Object args)
 {
   Lisp_Object args_left, symbol, val;
   (Lisp_Object args)
 {
   Lisp_Object args_left, symbol, val;

-  struct gcpro gcpro1;

 
   args_left = val = args;
 
   args_left = val = args;

-  GCPRO1 (args);

 
   while (CONSP (args_left))
     {
 
   while (CONSP (args_left))
     {


@@ -1540,7 +1541,6 @@ usage: (setq-default [VAR VALUE]...)  */)
       args_left = Fcdr (XCDR (args_left));
     }
 
       args_left = Fcdr (XCDR (args_left));
     }
 

-  UNGCPRO;

   return val;
 }
 \f
   return val;
 }
 \f


@@ -1645,8 +1645,10 @@ The function `default-value' gets the default value and `set-default' sets it.
        Lisp_Object symbol;
        XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
        if (let_shadows_global_binding_p (symbol))
        Lisp_Object symbol;
        XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
        if (let_shadows_global_binding_p (symbol))

-         message ("Making %s buffer-local while let-bound!",
-                  SDATA (SYMBOL_NAME (variable)));
+         {
+           AUTO_STRING (format, "Making %s buffer-local while let-bound!");
+           CALLN (Fmessage, format, SYMBOL_NAME (variable));
+         }

       }
     }
 
       }
     }
 


@@ -1658,8 +1660,8 @@ DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
        1, 1, "vMake Local Variable: ",
        doc: /* Make VARIABLE have a separate value in the current buffer.
 Other buffers will continue to share a common default value.
        1, 1, "vMake Local Variable: ",
        doc: /* Make VARIABLE have a separate value in the current buffer.
 Other buffers will continue to share a common default value.

-\(The buffer-local value of VARIABLE starts out as the same value
-VARIABLE previously had.  If VARIABLE was void, it remains void.\)
+(The buffer-local value of VARIABLE starts out as the same value
+VARIABLE previously had.  If VARIABLE was void, it remains void.)

 Return VARIABLE.
 
 If the variable is already arranged to become local when set,
 Return VARIABLE.
 
 If the variable is already arranged to become local when set,


@@ -1667,7 +1669,7 @@ this function causes a local value to exist for this buffer,
 just as setting the variable would do.
 
 This function returns VARIABLE, and therefore
 just as setting the variable would do.
 
 This function returns VARIABLE, and therefore

-  (set (make-local-variable 'VARIABLE) VALUE-EXP)
+  (set (make-local-variable \\='VARIABLE) VALUE-EXP)

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


@@ -1728,9 +1730,11 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
        Lisp_Object symbol;
        XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
        if (let_shadows_global_binding_p (symbol))
        Lisp_Object symbol;
        XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
        if (let_shadows_global_binding_p (symbol))

-         message ("Making %s local to %s while let-bound!",
-                  SDATA (SYMBOL_NAME (variable)),
-                  SDATA (BVAR (current_buffer, name)));
+         {
+           AUTO_STRING (format, "Making %s local to %s while let-bound!");
+           CALLN (Fmessage, format, SYMBOL_NAME (variable),
+                  BVAR (current_buffer, name));
+         }

       }
     }
 
       }
     }
 


@@ -1740,8 +1744,11 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
   if (NILP (tem))
     {
       if (let_shadows_buffer_binding_p (sym))
   if (NILP (tem))
     {
       if (let_shadows_buffer_binding_p (sym))

-       message ("Making %s buffer-local while locally let-bound!",
-                SDATA (SYMBOL_NAME (variable)));
+       {
+         AUTO_STRING (format,
+                      "Making %s buffer-local while locally let-bound!");
+         CALLN (Fmessage, format, SYMBOL_NAME (variable));
+       }

 
       /* Swap out any local binding for some other buffer, and make
         sure the current value is permanently recorded, if it's the
 
       /* Swap out any local binding for some other buffer, and make
         sure the current value is permanently recorded, if it's the


@@ -1906,8 +1913,10 @@ frame-local bindings).  */)
     Lisp_Object symbol;
     XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
     if (let_shadows_global_binding_p (symbol))
     Lisp_Object symbol;
     XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
     if (let_shadows_global_binding_p (symbol))

-      message ("Making %s frame-local while let-bound!",
-              SDATA (SYMBOL_NAME (variable)));
+      {
+       AUTO_STRING (format, "Making %s frame-local while let-bound!");
+       CALLN (Fmessage, format, SYMBOL_NAME (variable));
+      }

   }
   return variable;
 }
   }
   return variable;
 }


@@ -2125,8 +2134,6 @@ DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0,
        doc: /* Return the function at the end of OBJECT's function chain.
 If OBJECT is not a symbol, just return it.  Otherwise, follow all
 function indirections to find the final function binding and return it.
        doc: /* Return the function at the end of OBJECT's function chain.
 If OBJECT is not a symbol, just return it.  Otherwise, follow all
 function indirections to find the final function binding and return it.

-If the final symbol in the chain is unbound, signal a void-function error.
-Optional arg NOERROR non-nil means to return nil instead of signaling.

 Signal a cyclic-function-indirection error if there is a loop in the
 function chain of symbols.  */)
   (register Lisp_Object object, Lisp_Object noerror)
 Signal a cyclic-function-indirection error if there is a loop in the
 function chain of symbols.  */)
   (register Lisp_Object object, Lisp_Object noerror)


@@ -2141,9 +2148,6 @@ function chain of symbols.  */)
   if (!NILP (result))
     return result;
 
   if (!NILP (result))
     return result;
 

-  if (NILP (noerror))
-    xsignal1 (Qvoid_function, object);
-

   return Qnil;
 }
 \f
   return Qnil;
 }
 \f


@@ -2211,10 +2215,10 @@ bool-vector.  IDX starts at 0.  */)
   CHECK_NUMBER (idx);
   idxval = XINT (idx);
   CHECK_ARRAY (array, Qarrayp);
   CHECK_NUMBER (idx);
   idxval = XINT (idx);
   CHECK_ARRAY (array, Qarrayp);

-  CHECK_IMPURE (array);

 
   if (VECTORP (array))
     {
 
   if (VECTORP (array))
     {

+      CHECK_IMPURE (array, XVECTOR (array));

       if (idxval < 0 || idxval >= ASIZE (array))
        args_out_of_range (array, idx);
       ASET (array, idxval, newelt);
       if (idxval < 0 || idxval >= ASIZE (array))
        args_out_of_range (array, idx);
       ASET (array, idxval, newelt);


@@ -2234,6 +2238,7 @@ bool-vector.  IDX starts at 0.  */)
     {
       int c;
 
     {
       int c;
 

+      CHECK_IMPURE (array, XSTRING (array));

       if (idxval < 0 || idxval >= SCHARS (array))
        args_out_of_range (array, idx);
       CHECK_CHARACTER (newelt);
       if (idxval < 0 || idxval >= SCHARS (array))
        args_out_of_range (array, idx);
       CHECK_CHARACTER (newelt);


@@ -3445,7 +3450,6 @@ syms_of_data (void)
   DEFSYM (Qlistp, "listp");
   DEFSYM (Qconsp, "consp");
   DEFSYM (Qsymbolp, "symbolp");
   DEFSYM (Qlistp, "listp");
   DEFSYM (Qconsp, "consp");
   DEFSYM (Qsymbolp, "symbolp");

-  DEFSYM (Qkeywordp, "keywordp");

   DEFSYM (Qintegerp, "integerp");
   DEFSYM (Qnatnump, "natnump");
   DEFSYM (Qwholenump, "wholenump");
   DEFSYM (Qintegerp, "integerp");
   DEFSYM (Qnatnump, "natnump");
   DEFSYM (Qwholenump, "wholenump");


@@ -3459,7 +3463,6 @@ syms_of_data (void)
   DEFSYM (Qmarkerp, "markerp");
   DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
   DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
   DEFSYM (Qmarkerp, "markerp");
   DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
   DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");

-  DEFSYM (Qboundp, "boundp");

   DEFSYM (Qfboundp, "fboundp");
 
   DEFSYM (Qfloatp, "floatp");
   DEFSYM (Qfboundp, "fboundp");
 
   DEFSYM (Qfloatp, "floatp");


@@ -3475,10 +3478,6 @@ syms_of_data (void)
 
   DEFSYM (Qcdr, "cdr");
 
 
   DEFSYM (Qcdr, "cdr");
 

-  /* Handle automatic advice activation.  */
-  DEFSYM (Qad_advice_info, "ad-advice-info");
-  DEFSYM (Qad_activate_internal, "ad-activate-internal");
-

   error_tail = pure_cons (Qerror, Qnil);
 
   /* ERROR is used as a signaler for random errors for which nothing else is
   error_tail = pure_cons (Qerror, Qnil);
 
   /* ERROR is used as a signaler for random errors for which nothing else is


@@ -3552,6 +3551,7 @@ syms_of_data (void)
   DEFSYM (Qcons, "cons");
   DEFSYM (Qmarker, "marker");
   DEFSYM (Qoverlay, "overlay");
   DEFSYM (Qcons, "cons");
   DEFSYM (Qmarker, "marker");
   DEFSYM (Qoverlay, "overlay");

+  DEFSYM (Qfinalizer, "finalizer");

   DEFSYM (Qfloat, "float");
   DEFSYM (Qwindow_configuration, "window-configuration");
   DEFSYM (Qprocess, "process");
   DEFSYM (Qfloat, "float");
   DEFSYM (Qwindow_configuration, "window-configuration");
   DEFSYM (Qprocess, "process");


@@ -3563,7 +3563,6 @@ syms_of_data (void)
   DEFSYM (Qchar_table, "char-table");
   DEFSYM (Qbool_vector, "bool-vector");
   DEFSYM (Qhash_table, "hash-table");
   DEFSYM (Qchar_table, "char-table");
   DEFSYM (Qbool_vector, "bool-vector");
   DEFSYM (Qhash_table, "hash-table");

-  DEFSYM (Qmisc, "misc");

 
   DEFSYM (Qdefun, "defun");
 
 
   DEFSYM (Qdefun, "defun");