emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Expose `Fpurecopy' via `purecopy', eliminate redundant optimizations


From: Chris Gregory
Subject: Expose `Fpurecopy' via `purecopy', eliminate redundant optimizations
Date: Tue, 27 Dec 2016 23:51:41 -0600

This patch adds an inline function to `lisp.h' called `purecopy' that
contains the old definition of `Fpurecopy'.  The new `Fpurecopy' calls
`purecopy'.  It also renames the static function `purecopy' in
`alloc.c', that actually implements the `purecopy', to `purecopy_impl'
to avoid a name conflict (and makes it non-static so `purecopy' can call
it).

The new (inline) `purecopy' will locally declare `purecopy_impl' and
call it.

All usages of `Fpurecopy' are remapped to `purecopy'.
-- 
Chris Gregory

diff --git a/src/alloc.c b/src/alloc.c
index 121d704..a046bb1 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5420,7 +5420,7 @@ make_pure_c_string (const char *data, ptrdiff_t nchars)
   return string;
 }
 
-static Lisp_Object purecopy (Lisp_Object obj);
+static Lisp_Object purecopy_impl (Lisp_Object obj);
 
 /* Return a cons allocated from pure space.  Give it pure copies
    of CAR as car and CDR as cdr.  */
@@ -5431,8 +5431,8 @@ pure_cons (Lisp_Object car, Lisp_Object cdr)
   Lisp_Object new;
   struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons);
   XSETCONS (new, p);
-  XSETCAR (new, purecopy (car));
-  XSETCDR (new, purecopy (cdr));
+  XSETCAR (new, purecopy_impl (car));
+  XSETCDR (new, purecopy_impl (cdr));
   return new;
 }
 
@@ -5470,18 +5470,11 @@ Recursively copies contents of vectors and cons cells.
 Does not copy symbols.  Copies strings without text properties.  */)
   (register Lisp_Object obj)
 {
-  if (NILP (Vpurify_flag))
-    return obj;
-  else if (MARKERP (obj) || OVERLAYP (obj)
-          || HASH_TABLE_P (obj) || SYMBOLP (obj))
-    /* Can't purify those.  */
-    return obj;
-  else
-    return purecopy (obj);
+  return purecopy (obj);
 }
 
-static Lisp_Object
-purecopy (Lisp_Object obj)
+Lisp_Object
+purecopy_impl (Lisp_Object obj)
 {
   if (INTEGERP (obj)
       || (! SYMBOLP (obj) && PURE_P (XPNTR_OR_SYMBOL_OFFSET (obj)))
@@ -5518,7 +5511,7 @@ purecopy (Lisp_Object obj)
        size &= PSEUDOVECTOR_SIZE_MASK;
       memcpy (vec, objp, nbytes);
       for (i = 0; i < size; i++)
-       vec->contents[i] = purecopy (vec->contents[i]);
+       vec->contents[i] = purecopy_impl (vec->contents[i]);
       XSETVECTOR (obj, vec);
     }
   else if (SYMBOLP (obj))
diff --git a/src/category.c b/src/category.c
index 8315797..06e8e52 100644
--- a/src/category.c
+++ b/src/category.c
@@ -133,9 +133,8 @@ the current buffer's category table.  */)
 
   if (!NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
     error ("Category `%c' is already defined", (int) XFASTINT (category));
-  if (!NILP (Vpurify_flag))
-    docstring = Fpurecopy (docstring);
-  SET_CATEGORY_DOCSTRING (table, XFASTINT (category), docstring);
+  SET_CATEGORY_DOCSTRING (table, XFASTINT (category),
+                          purecopy (docstring));
 
   return Qnil;
 }
diff --git a/src/data.c b/src/data.c
index e2c1a28..fcd316e 100644
--- a/src/data.c
+++ b/src/data.c
@@ -773,7 +773,7 @@ The return value is undefined.  */)
   if (!NILP (Vpurify_flag)
       /* If `definition' is a keymap, immutable (and copying) is wrong.  */
       && !KEYMAPP (definition))
-    definition = Fpurecopy (definition);
+    definition = purecopy (definition);
 
   {
     bool autoload = AUTOLOADP (definition);
diff --git a/src/doc.c b/src/doc.c
index 6a78ed6..a304300 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -576,7 +576,7 @@ the same file name is found in the `doc-directory'.  */)
       int i = ARRAYELTS (buildobj);
       while (0 <= --i)
        Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
-      Vbuild_files = Fpurecopy (Vbuild_files);
+      Vbuild_files = purecopy (Vbuild_files);
     }
 
   fd = emacs_open (name, O_RDONLY, 0);
diff --git a/src/eval.c b/src/eval.c
index e50e26a..3993410 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -764,11 +764,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
       tail = XCDR (tail);
       tem = Fcar (tail);
       if (!NILP (tem))
-       {
-         if (!NILP (Vpurify_flag))
-           tem = Fpurecopy (tem);
-         Fput (sym, Qvariable_documentation, tem);
-       }
+       Fput (sym, Qvariable_documentation, purecopy (tem));
       LOADHIST_ATTACH (sym);
     }
   else if (!NILP (Vinternal_interpreter_environment)
@@ -813,17 +809,11 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
     error ("Too many arguments");
 
   tem = eval_sub (Fcar (XCDR (args)));
-  if (!NILP (Vpurify_flag))
-    tem = Fpurecopy (tem);
-  Fset_default (sym, tem);
+  Fset_default (sym, purecopy (tem));
   XSYMBOL (sym)->declared_special = 1;
   tem = Fcar (XCDR (XCDR (args)));
   if (!NILP (tem))
-    {
-      if (!NILP (Vpurify_flag))
-       tem = Fpurecopy (tem);
-      Fput (sym, Qvariable_documentation, tem);
-    }
+    Fput (sym, Qvariable_documentation, purecopy (tem));
   Fput (sym, Qrisky_local_variable, Qt);
   LOADHIST_ATTACH (sym);
   return sym;
diff --git a/src/fileio.c b/src/fileio.c
index 1a744e0..c915aa6 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -6023,27 +6023,27 @@ behaves as if file names were encoded in `utf-8'.  */);
   DEFSYM (Qcar_less_than_car, "car-less-than-car");
 
   Fput (Qfile_error, Qerror_conditions,
-       Fpurecopy (list2 (Qfile_error, Qerror)));
+       purecopy (list2 (Qfile_error, Qerror)));
   Fput (Qfile_error, Qerror_message,
        build_pure_c_string ("File error"));
 
   Fput (Qfile_already_exists, Qerror_conditions,
-       Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
+       purecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
   Fput (Qfile_already_exists, Qerror_message,
        build_pure_c_string ("File already exists"));
 
   Fput (Qfile_date_error, Qerror_conditions,
-       Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
+       purecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
   Fput (Qfile_date_error, Qerror_message,
        build_pure_c_string ("Cannot set file date"));
 
   Fput (Qfile_missing, Qerror_conditions,
-       Fpurecopy (list3 (Qfile_missing, Qfile_error, Qerror)));
+       purecopy (list3 (Qfile_missing, Qfile_error, Qerror)));
   Fput (Qfile_missing, Qerror_message,
        build_pure_c_string ("File is missing"));
 
   Fput (Qfile_notify_error, Qerror_conditions,
-       Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
+       purecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
   Fput (Qfile_notify_error, Qerror_message,
        build_pure_c_string ("File notification error"));
 
diff --git a/src/keymap.c b/src/keymap.c
index c4a59ad..6ad8613 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -142,9 +142,7 @@ in case you use it as a menu with `x-popup-menu'.  */)
 {
   if (!NILP (string))
     {
-      if (!NILP (Vpurify_flag))
-       string = Fpurecopy (string);
-      return list2 (Qkeymap, string);
+      return list2 (Qkeymap, purecopy (string));
     }
   return list1 (Qkeymap);
 }
diff --git a/src/lisp.h b/src/lisp.h
index 1a586ca..33cb7da 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3545,6 +3545,21 @@ extern Lisp_Object list5 (Lisp_Object, Lisp_Object, 
Lisp_Object, Lisp_Object,
 enum constype {CONSTYPE_HEAP, CONSTYPE_PURE};
 extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...);
 
+/* Implementation of Fpurecopy exposed for optimization */
+INLINE Lisp_Object
+purecopy (register Lisp_Object obj)
+{
+  Lisp_Object purecopy_impl (Lisp_Object);
+  if (NILP (Vpurify_flag))
+    return obj;
+  else if (MARKERP (obj) || OVERLAYP (obj)
+          || HASH_TABLE_P (obj) || SYMBOLP (obj))
+    /* Can't purify those.  */
+    return obj;
+  else
+    return purecopy_impl (obj);
+}
+
 /* Build a frequently used 2/3/4-integer lists.  */
 
 INLINE Lisp_Object
diff --git a/src/lread.c b/src/lread.c
index 35348f1..ee90889 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1306,7 +1306,7 @@ Return t if the file exists and loads successfully.  */)
   set_unwind_protect_ptr (fd_index, fclose_unwind, stream);
 
   if (! NILP (Vpurify_flag))
-    Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
+    Vpreloaded_file_list = Fcons (purecopy (file), Vpreloaded_file_list);
 
   if (NILP (nomessage) || force_load_messages)
     {
@@ -3932,8 +3932,7 @@ it defaults to the value of `obarray'.  */)
 
   tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
   if (!SYMBOLP (tem))
-    tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string),
-                        obarray, tem);
+    tem = intern_driver (purecopy (string), obarray, tem);
   return tem;
 }
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]