Untag more efficiently if USE_LSB_TAG.

This is based on a proposal by YAMAMOTO Mitsuharu in
<http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01876.html>.
For an admittedly artificial (nth 8000 longlist) benchmark on
Fedora 15 x86-64, this yields a 25% CPU speedup.  Also, it shrinks
Emacs's overall text size by 1%.
* lisp.h (XUNTAG): New macro.
(XCONS, XVECTOR, XSTRING, XSYMBOL, XFLOAT, XMISC, XPROCESS, XWINDOW)
(XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE, XSUB_CHAR_TABLE, XBOOL_VECTOR)
(XSETTYPED_PSEUDOVECTOR, XHASH_TABLE, TYPED_PSEUDOVECTORP): Use it.
* eval.c (Fautoload):
* font.h (XFONT_SPEC, XFONT_ENTITY, XFONT_OBJECT):
* frame.h (XFRAME): Use XUNTAG.

5 files changed, 63 insertions, 22 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index b6415724b5e..e51d23435d1 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,19 @@
 2012-05-09  Paul Eggert  <eggert@cs.ucla.edu>
 
+        Untag more efficiently if USE_LSB_TAG.
+        This is based on a proposal by YAMAMOTO Mitsuharu in
+        <http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01876.html>.
+        For an admittedly artificial (nth 8000 longlist) benchmark on
+        Fedora 15 x86-64, this yields a 25% CPU speedup.  Also, it shrinks
+        Emacs's overall text size by 1%.
+        * lisp.h (XUNTAG): New macro.
+        (XCONS, XVECTOR, XSTRING, XSYMBOL, XFLOAT, XMISC, XPROCESS, XWINDOW)
+        (XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE, XSUB_CHAR_TABLE, XBOOL_VECTOR)
+        (XSETTYPED_PSEUDOVECTOR, XHASH_TABLE, TYPED_PSEUDOVECTORP): Use it.
+        * eval.c (Fautoload):
+        * font.h (XFONT_SPEC, XFONT_ENTITY, XFONT_OBJECT):
+        * frame.h (XFRAME): Use XUNTAG.
+
         Port recent dbusbind.c changes to 32-bit --with-wide-int.
         * dbusbind.c (xd_append_arg, xd_retrieve_arg, Fdbus_message_internal):
         Remove unportable assumptions about print widths of types like
diff --git a/src/eval.c b/src/eval.c
index cb0518f34ec..3d0e82c2d9f 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2048,7 +2048,7 @@ this does nothing and returns nil.  */)
        We used to use 0 here, but that leads to accidental sharing in
        purecopy's hash-consing, so we use a (hopefully) unique integer
        instead.  */
-    docstring = make_number (XPNTR (function));
+    docstring = make_number (XUNTAG (function, Lisp_Symbol));
   return Ffset (function,
                 Fpurecopy (list5 (Qautoload, file, docstring,
                                   interactive, type)));
diff --git a/src/font.h b/src/font.h
index 663cc675c05..ea392d2e3fa 100644
--- a/src/font.h
+++ b/src/font.h
@@ -469,11 +469,12 @@ struct font_bitmap
   } while (0)
 
 #define XFONT_SPEC(p)   \
-  (eassert (FONT_SPEC_P(p)), (struct font_spec *) XPNTR (p))
+  (eassert (FONT_SPEC_P (p)), (struct font_spec *) XUNTAG (p, Lisp_Vectorlike))
 #define XFONT_ENTITY(p) \
-  (eassert (FONT_ENTITY_P(p)), (struct font_entity *) XPNTR (p))
+  (eassert (FONT_ENTITY_P (p)), \
+   (struct font_entity *) XUNTAG (p, Lisp_Vectorlike))
 #define XFONT_OBJECT(p) \
-  (eassert (FONT_OBJECT_P(p)), (struct font *) XPNTR (p))
+  (eassert (FONT_OBJECT_P (p)), (struct font *) XUNTAG (p, Lisp_Vectorlike))
 #define XSETFONT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FONT))
 
 /* Number of pt per inch (from the TeXbook).  */
diff --git a/src/frame.h b/src/frame.h
index 5c89fc69628..9779f4a0926 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -501,7 +501,8 @@ struct frame
 
 typedef struct frame *FRAME_PTR;
 
-#define XFRAME(p) (eassert (FRAMEP(p)),(struct frame *) XPNTR (p))
+#define XFRAME(p) \
+  (eassert (FRAMEP (p)), (struct frame *) XUNTAG (p, Lisp_Vectorlike))
 #define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME))
 
 /* Given a window, return its frame as a Lisp_Object.  */
diff --git a/src/lisp.h b/src/lisp.h
index 1f839750609..6376862949a 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -475,6 +475,7 @@ enum pvec_type
      (var) = (type) | (intptr_t) (ptr))
 
 #define XPNTR(a) ((intptr_t) ((a) & ~TYPEMASK))
+#define XUNTAG(a, type) ((intptr_t) ((a) - (type)))
 
 #else  /* not USE_LSB_TAG */
 
@@ -581,6 +582,13 @@ extern Lisp_Object make_number (EMACS_INT);
 # define XSETFASTINT(a, b) (XSETINT (a, b))
 #endif
 
+/* Extract the pointer value of the Lisp object A, under the
+   assumption that A's type is TYPE.  This is a fallback
+   implementation if nothing faster is available.  */
+#ifndef XUNTAG
+# define XUNTAG(a, type) XPNTR (a)
+#endif
+
 #define EQ(x, y) (XHASH (x) == XHASH (y))
 
 /* Number of bits in a fixnum, including the sign bit.  */
@@ -607,15 +615,20 @@ extern Lisp_Object make_number (EMACS_INT);
 
 /* Extract a value or address from a Lisp_Object.  */
 
-#define XCONS(a) (eassert (CONSP (a)), (struct Lisp_Cons *) XPNTR (a))
-#define XVECTOR(a) (eassert (VECTORLIKEP (a)), (struct Lisp_Vector *) XPNTR (a))
-#define XSTRING(a) (eassert (STRINGP (a)), (struct Lisp_String *) XPNTR (a))
-#define XSYMBOL(a) (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XPNTR (a))
-#define XFLOAT(a) (eassert (FLOATP (a)), (struct Lisp_Float *) XPNTR (a))
+#define XCONS(a)   (eassert (CONSP (a)), \
+                    (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
+#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \
+                    (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike))
+#define XSTRING(a) (eassert (STRINGP (a)), \
+                    (struct Lisp_String *) XUNTAG (a, Lisp_String))
+#define XSYMBOL(a) (eassert (SYMBOLP (a)), \
+                    (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
+#define XFLOAT(a)  (eassert (FLOATP (a)), \
+                    (struct Lisp_Float *) XUNTAG (a, Lisp_Float))
 
 /* Misc types.  */
 
-#define XMISC(a)   ((union Lisp_Misc *) XPNTR (a))
+#define XMISC(a)        ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc))
 #define XMISCANY(a)     (eassert (MISCP (a)), &(XMISC (a)->u_any))
 #define XMISCTYPE(a)   (XMISCANY (a)->type)
 #define XMARKER(a)      (eassert (MARKERP (a)), &(XMISC (a)->u_marker))
@@ -635,14 +648,24 @@ extern Lisp_Object make_number (EMACS_INT);
 
 /* Pseudovector types.  */
 
-#define XPROCESS(a) (eassert (PROCESSP (a)), (struct Lisp_Process *) XPNTR (a))
-#define XWINDOW(a) (eassert (WINDOWP (a)), (struct window *) XPNTR (a))
-#define XTERMINAL(a) (eassert (TERMINALP (a)), (struct terminal *) XPNTR (a))
-#define XSUBR(a) (eassert (SUBRP (a)), (struct Lisp_Subr *) XPNTR (a))
-#define XBUFFER(a) (eassert (BUFFERP (a)), (struct buffer *) XPNTR (a))
-#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR (a))
-#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), (struct Lisp_Sub_Char_Table *) XPNTR (a))
-#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR (a))
+#define XPROCESS(a) (eassert (PROCESSP (a)), \
+                     (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike))
+#define XWINDOW(a) (eassert (WINDOWP (a)), \
+                    (struct window *) XUNTAG (a, Lisp_Vectorlike))
+#define XTERMINAL(a) (eassert (TERMINALP (a)), \
+                      (struct terminal *) XUNTAG (a, Lisp_Vectorlike))
+#define XSUBR(a) (eassert (SUBRP (a)), \
+                  (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike))
+#define XBUFFER(a) (eassert (BUFFERP (a)), \
+                    (struct buffer *) XUNTAG (a, Lisp_Vectorlike))
+#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \
+                        (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike))
+#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \
+                            ((struct Lisp_Sub_Char_Table *) \
+                             XUNTAG (a, Lisp_Vectorlike)))
+#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \
+                         ((struct Lisp_Bool_Vector *) \
+                          XUNTAG (a, Lisp_Vectorlike)))
 
 /* Construct a Lisp_Object from a value or address.  */
 
@@ -669,7 +692,9 @@ extern Lisp_Object make_number (EMACS_INT);
 /* The cast to struct vectorlike_header * avoids aliasing issues.  */
 #define XSETPSEUDOVECTOR(a, b, code) \
   XSETTYPED_PSEUDOVECTOR(a, b,       \
-                         ((struct vectorlike_header *) XPNTR (a))->size, \
+                         (((struct vectorlike_header *) \
+                           XUNTAG (a, Lisp_Vectorlike)) \
+                          ->size),                      \
                          code)
 #define XSETTYPED_PSEUDOVECTOR(a, b, size, code)                        \
   (XSETVECTOR (a, b),                                                   \
@@ -1277,7 +1302,7 @@ struct Lisp_Hash_Table
 
 
 #define XHASH_TABLE(OBJ) \
-     ((struct Lisp_Hash_Table *) XPNTR (OBJ))
+     ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike))
 
 #define XSET_HASH_TABLE(VAR, PTR) \
      (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
@@ -1735,7 +1760,7 @@ typedef struct {
    code is CODE.  */
 #define TYPED_PSEUDOVECTORP(x, t, code)                         \
   (VECTORLIKEP (x)                                              \
-   && (((((struct t *) XPNTR (x))->size                         \
+   && (((((struct t *) XUNTAG (x, Lisp_Vectorlike))->size       \
          & (PSEUDOVECTOR_FLAG | (code))))                       \
        == (PSEUDOVECTOR_FLAG | (code))))