]> code.delx.au - gnu-emacs/blobdiff - src/data.c
Improve CHECK_IMPURE and PURE_P speedup
[gnu-emacs] / src / data.c
index 47706584f5e2b5ef830cb80805a4b8ca7944742c..b85d8a77106abf4bbfc6e311e2cfe9e30dc3f0ec 100644 (file)
@@ -186,7 +186,7 @@ DEFUN ("eq", Feq, Seq, 2, 2, 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)
 {
@@ -223,9 +223,12 @@ for example, (type-of 1) returns `integer'.  */)
        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))
@@ -557,7 +560,7 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
   (register Lisp_Object cell, Lisp_Object newcar)
 {
   CHECK_CONS (cell);
-  CHECK_IMPURE (cell);
+  CHECK_IMPURE (cell, XCONS (cell));
   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);
-  CHECK_IMPURE (cell);
+  CHECK_IMPURE (cell, XCONS (cell));
   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.
-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.  */
@@ -1527,10 +1530,8 @@ usage: (setq-default [VAR VALUE]...)  */)
   (Lisp_Object args)
 {
   Lisp_Object args_left, symbol, val;
-  struct gcpro gcpro1;
 
   args_left = val = args;
-  GCPRO1 (args);
 
   while (CONSP (args_left))
     {
@@ -1540,7 +1541,6 @@ usage: (setq-default [VAR VALUE]...)  */)
       args_left = Fcdr (XCDR (args_left));
     }
 
-  UNGCPRO;
   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))
-         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.
-\(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,
@@ -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
-  (set (make-local-variable 'VARIABLE) VALUE-EXP)
+  (set (make-local-variable \\='VARIABLE) VALUE-EXP)
 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))
-         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))
-       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
@@ -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))
-      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;
 }
@@ -2206,10 +2215,10 @@ bool-vector.  IDX starts at 0.  */)
   CHECK_NUMBER (idx);
   idxval = XINT (idx);
   CHECK_ARRAY (array, Qarrayp);
-  CHECK_IMPURE (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);
@@ -2229,6 +2238,7 @@ bool-vector.  IDX starts at 0.  */)
     {
       int c;
 
+      CHECK_IMPURE (array, XSTRING (array));
       if (idxval < 0 || idxval >= SCHARS (array))
        args_out_of_range (array, idx);
       CHECK_CHARACTER (newelt);
@@ -3440,7 +3450,6 @@ syms_of_data (void)
   DEFSYM (Qlistp, "listp");
   DEFSYM (Qconsp, "consp");
   DEFSYM (Qsymbolp, "symbolp");
-  DEFSYM (Qkeywordp, "keywordp");
   DEFSYM (Qintegerp, "integerp");
   DEFSYM (Qnatnump, "natnump");
   DEFSYM (Qwholenump, "wholenump");
@@ -3454,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 (Qboundp, "boundp");
   DEFSYM (Qfboundp, "fboundp");
 
   DEFSYM (Qfloatp, "floatp");
@@ -3470,10 +3478,6 @@ syms_of_data (void)
 
   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
@@ -3547,6 +3551,7 @@ syms_of_data (void)
   DEFSYM (Qcons, "cons");
   DEFSYM (Qmarker, "marker");
   DEFSYM (Qoverlay, "overlay");
+  DEFSYM (Qfinalizer, "finalizer");
   DEFSYM (Qfloat, "float");
   DEFSYM (Qwindow_configuration, "window-configuration");
   DEFSYM (Qprocess, "process");
@@ -3558,7 +3563,6 @@ syms_of_data (void)
   DEFSYM (Qchar_table, "char-table");
   DEFSYM (Qbool_vector, "bool-vector");
   DEFSYM (Qhash_table, "hash-table");
-  DEFSYM (Qmisc, "misc");
 
   DEFSYM (Qdefun, "defun");