Commit bb7c182f authored by Paul Eggert's avatar Paul Eggert

CHECK_IMPURE and PURE_P speedup

* src/intervals.c (create_root_interval):
Do CHECK_IMPURE only for strings; not needed for buffers.
Prefer ! STRINGP to BUFFERP, for a tad more speed.
* src/puresize.h (CHECK_IMPURE, PURE_P):
Now inline functions instead of macros.
(PURE_P): Don’t use XPNTR; that is now the caller’s responsibility.
All callers changed.
(CHECK_IMPURE): New argument PTR, to save us the work of running XPNTR.
All callers changed.
parent 1196e3fc
......@@ -560,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;
}
......@@ -570,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;
}
......@@ -2215,7 +2215,7 @@ bool-vector. IDX starts at 0. */)
CHECK_NUMBER (idx);
idxval = XINT (idx);
CHECK_ARRAY (array, Qarrayp);
CHECK_IMPURE (array);
CHECK_IMPURE (array, XVECTOR (array));
if (VECTORP (array))
{
......
......@@ -91,11 +91,9 @@ create_root_interval (Lisp_Object parent)
{
INTERVAL new;
CHECK_IMPURE (parent);
new = make_interval ();
if (BUFFERP (parent))
if (! STRINGP (parent))
{
new->total_length = (BUF_Z (XBUFFER (parent))
- BUF_BEG (XBUFFER (parent)));
......@@ -103,15 +101,16 @@ create_root_interval (Lisp_Object parent)
set_buffer_intervals (XBUFFER (parent), new);
new->position = BEG;
}
else if (STRINGP (parent))
else
{
CHECK_IMPURE (parent, XSTRING (parent));
new->total_length = SCHARS (parent);
eassert (TOTAL_LENGTH (new) >= 0);
set_string_intervals (parent, new);
new->position = 0;
}
eassert (LENGTH (new) > 0);
set_interval_object (new, parent);
return new;
......
......@@ -341,7 +341,7 @@ Return PARENT. PARENT should be nil or another keymap. */)
If we came to the end, add the parent in PREV. */
if (!CONSP (list) || KEYMAPP (list))
{
CHECK_IMPURE (prev);
CHECK_IMPURE (prev, XCONS (prev));
XSETCDR (prev, parent);
return parent;
}
......@@ -750,7 +750,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
/* If we are preparing to dump, and DEF is a menu element
with a menu item indicator, copy it to ensure it is not pure. */
if (CONSP (def) && PURE_P (def)
if (CONSP (def) && PURE_P (XCONS (def))
&& (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
def = Fcons (XCAR (def), XCDR (def));
......@@ -798,7 +798,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
{
if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
{
CHECK_IMPURE (elt);
CHECK_IMPURE (elt, XVECTOR (elt));
ASET (elt, XFASTINT (idx), def);
return def;
}
......@@ -851,7 +851,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
}
else if (EQ (idx, XCAR (elt)))
{
CHECK_IMPURE (elt);
CHECK_IMPURE (elt, XCONS (elt));
XSETCDR (elt, def);
return def;
}
......@@ -895,7 +895,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
}
else
elt = Fcons (idx, def);
CHECK_IMPURE (insertion_point);
CHECK_IMPURE (insertion_point, XCONS (insertion_point));
XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
}
}
......
......@@ -70,16 +70,21 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define PURESIZE (BASE_PURESIZE * PURESIZE_RATIO * PURESIZE_CHECKING_RATIO)
#endif
/* Signal an error if OBJ is pure. */
#define CHECK_IMPURE(obj) \
{ if (PURE_P (obj)) \
pure_write_error (obj); }
extern _Noreturn void pure_write_error (Lisp_Object);
/* Define PURE_P. */
extern EMACS_INT pure[];
#define PURE_P(obj) \
((uintptr_t) XPNTR (obj) - (uintptr_t) pure <= PURESIZE)
/* True if PTR is pure. */
INLINE bool
PURE_P (void *ptr)
{
return (uintptr_t) (ptr) - (uintptr_t) pure <= PURESIZE;
}
/* Signal an error if OBJ is pure. PTR is OBJ untagged. */
INLINE void
CHECK_IMPURE (Lisp_Object obj, void *ptr)
{
if (PURE_P (ptr))
pure_write_error (obj);
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment