* Expose `Fpurecopy' via `purecopy', eliminate redundant optimizations
@ 2016-12-28 5:51 Chris Gregory
0 siblings, 0 replies; only message in thread
From: Chris Gregory @ 2016-12-28 5:51 UTC (permalink / raw)
To: emacs-devel
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;
}
^ permalink raw reply related [flat|nested] only message in thread
only message in thread, other threads:[~2016-12-28 5:51 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-12-28 5:51 Expose `Fpurecopy' via `purecopy', eliminate redundant optimizations Chris Gregory
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).