[Emacs-diffs] trunk r117913: Avoid extra call to oblookup when interning symbols.

[Dmitry Antipov]

------------------------------------------------------------
revno: 117913
revision-id: address@hidden
parent: address@hidden
committer: Dmitry Antipov <address@hidden>
branch nick: trunk
timestamp: Mon 2014-09-22 10:06:19 +0400
message:
  Avoid extra call to oblookup when interning symbols.
  * lisp.h (intern_driver): Add prototype.
  * lread.c (intern_driver): New function.
  (intern1, intern_c_string_1, Fintern):
  * font.c (font_intern_prop):
  * w32font.c (intern_font_name): Use it.
modified:
  src/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1438
  src/font.c                     font.c-20091113204419-o5vbwnq5f7feedwu-8540
  src/lisp.h                     lisp.h-20091113204419-o5vbwnq5f7feedwu-253
  src/lread.c                    lread.c-20091113204419-o5vbwnq5f7feedwu-266
  src/w32font.c                  w32font.c-20091113204419-o5vbwnq5f7feedwu-8545

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2014-09-21 22:49:24 +0000
+++ b/src/ChangeLog     2014-09-22 06:06:19 +0000
@@ -1,3 +1,12 @@
+2014-09-22  Dmitry Antipov  <address@hidden>
+
+       Avoid extra call to oblookup when interning symbols.
+       * lisp.h (intern_driver): Add prototype.
+       * lread.c (intern_driver): New function.
+       (intern1, intern_c_string_1, Fintern):
+       * font.c (font_intern_prop):
+       * w32font.c (intern_font_name): Use it.
+
 2014-09-21  Paul Eggert  <address@hidden>
 
        Minor improvements to new stack-allocated Lisp objects.

=== modified file 'src/font.c'
--- a/src/font.c        2014-09-15 14:53:23 +0000
+++ b/src/font.c        2014-09-22 06:06:19 +0000
@@ -277,10 +277,8 @@
 Lisp_Object
 font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
 {
-  ptrdiff_t i;
-  Lisp_Object tem;
-  Lisp_Object obarray;
-  ptrdiff_t nbytes, nchars;
+  ptrdiff_t i, nbytes, nchars;
+  Lisp_Object tem, name, obarray;
 
   if (len == 1 && *str == '*')
     return Qnil;
@@ -311,12 +309,11 @@
   parse_str_as_multibyte ((unsigned char *) str, len, &nchars, &nbytes);
   tem = oblookup (obarray, str,
                  (len == nchars || len != nbytes) ? len : nchars, len);
-
   if (SYMBOLP (tem))
     return tem;
-  tem = make_specified_string (str, nchars, len,
-                              len != nchars && len == nbytes);
-  return Fintern (tem, obarray);
+  name = make_specified_string (str, nchars, len,
+                               len != nchars && len == nbytes);
+  return intern_driver (name, obarray, XINT (tem));
 }
 
 /* Return a pixel size of font-spec SPEC on frame F.  */

=== modified file 'src/lisp.h'
--- a/src/lisp.h        2014-09-21 22:49:24 +0000
+++ b/src/lisp.h        2014-09-22 06:06:19 +0000
@@ -3877,6 +3877,7 @@
 extern Lisp_Object check_obarray (Lisp_Object);
 extern Lisp_Object intern_1 (const char *, ptrdiff_t);
 extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
+extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, ptrdiff_t);
 extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
 INLINE void
 LOADHIST_ATTACH (Lisp_Object x)

=== modified file 'src/lread.c'
--- a/src/lread.c       2014-09-16 08:20:08 +0000
+++ b/src/lread.c       2014-09-22 06:06:19 +0000
@@ -3807,6 +3807,30 @@
   return obarray;
 }
 
+/* Intern a symbol with name STRING in OBARRAY using bucket INDEX.  */
+
+Lisp_Object
+intern_driver (Lisp_Object string, Lisp_Object obarray, ptrdiff_t index)
+{
+  Lisp_Object *ptr, sym = Fmake_symbol (string);
+
+  XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray)
+                            ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
+                            : SYMBOL_INTERNED);
+
+  if ((SREF (string, 0) == ':') && EQ (obarray, initial_obarray))
+    {
+      XSYMBOL (sym)->constant = 1;
+      XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
+      SET_SYMBOL_VAL (XSYMBOL (sym), sym);
+    }
+
+  ptr = aref_addr (obarray, index);
+  set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL);
+  *ptr = sym;
+  return sym;
+}
+
 /* Intern the C string STR: return a symbol with that name,
    interned in the current obarray.  */
 
@@ -3816,7 +3840,8 @@
   Lisp_Object obarray = check_obarray (Vobarray);
   Lisp_Object tem = oblookup (obarray, str, len, len);
 
-  return SYMBOLP (tem) ? tem : Fintern (make_string (str, len), obarray);
+  return SYMBOLP (tem) ? tem : intern_driver (make_string (str, len),
+                                             obarray, XINT (tem));
 }
 
 Lisp_Object
@@ -3825,16 +3850,14 @@
   Lisp_Object obarray = check_obarray (Vobarray);
   Lisp_Object tem = oblookup (obarray, str, len, len);
 
-  if (SYMBOLP (tem))
-    return tem;
-
-  if (NILP (Vpurify_flag))
-    /* Creating a non-pure string from a string literal not
-       implemented yet.  We could just use make_string here and live
-       with the extra copy.  */
-    emacs_abort ();
-
-  return Fintern (make_pure_c_string (str, len), obarray);
+  if (!SYMBOLP (tem))
+    {
+      /* Creating a non-pure string from a string literal not implemented yet.
+        We could just use make_string here and live with the extra copy.  */
+      eassert (!NILP (Vpurify_flag));
+      tem = intern_driver (make_pure_c_string (str, len), obarray, XINT (tem));
+    }
+  return tem;
 }
 
 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
@@ -3844,43 +3867,16 @@
 it defaults to the value of `obarray'.  */)
   (Lisp_Object string, Lisp_Object obarray)
 {
-  register Lisp_Object tem, sym, *ptr;
-
-  if (NILP (obarray)) obarray = Vobarray;
-  obarray = check_obarray (obarray);
-
+  Lisp_Object tem;
+
+  obarray = check_obarray (NILP (obarray) ? Vobarray : obarray);
   CHECK_STRING (string);
 
-  tem = oblookup (obarray, SSDATA (string),
-                 SCHARS (string),
-                 SBYTES (string));
-  if (!INTEGERP (tem))
-    return tem;
-
-  if (!NILP (Vpurify_flag))
-    string = Fpurecopy (string);
-  sym = Fmake_symbol (string);
-
-  if (EQ (obarray, initial_obarray))
-    XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
-  else
-    XSYMBOL (sym)->interned = SYMBOL_INTERNED;
-
-  if ((SREF (string, 0) == ':')
-      && EQ (obarray, initial_obarray))
-    {
-      XSYMBOL (sym)->constant = 1;
-      XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
-      SET_SYMBOL_VAL (XSYMBOL (sym), sym);
-    }
-
-  ptr = aref_addr (obarray, XINT (tem));
-  if (SYMBOLP (*ptr))
-    set_symbol_next (sym, XSYMBOL (*ptr));
-  else
-    set_symbol_next (sym, NULL);
-  *ptr = sym;
-  return sym;
+  tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
+  if (!SYMBOLP (tem))
+    tem = intern_driver (NILP (Vpurify_flag) ? string
+                        : Fpurecopy (string), obarray, XINT (tem));
+  return tem;
 }
 
 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,

=== modified file 'src/w32font.c'
--- a/src/w32font.c     2014-09-16 11:43:49 +0000
+++ b/src/w32font.c     2014-09-22 06:06:19 +0000
@@ -291,7 +291,7 @@
   Lisp_Object obarray = check_obarray (Vobarray);
   Lisp_Object tem = oblookup (obarray, SDATA (str), len, len);
   /* This code is similar to intern function from lread.c.  */
-  return SYMBOLP (tem) ? tem : Fintern (str, obarray);
+  return SYMBOLP (tem) ? tem : intern_driver (str, obarray, XINT (tem));
 }
 
 /* w32 implementation of get_cache for font backend.