5 files changed, 57 insertions, 54 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index a80394b5855..b7858c609b4 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2014-09-22  Dmitry Antipov  <dmantipov@yandex.ru>
+
+        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  <eggert@cs.ucla.edu>
 
         Minor improvements to new stack-allocated Lisp objects.
diff --git a/src/font.c b/src/font.c
index 57cc4aa0b2b..83860090820 100644
--- a/src/font.c
+++ b/src/font.c
@@ -277,10 +277,8 @@ static int num_font_drivers;
 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 @@ font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
   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.  */
diff --git a/src/lisp.h b/src/lisp.h
index 1347b35f046..2bc9fb13284 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3877,6 +3877,7 @@ extern Lisp_Object Qlexical_binding;
 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)
diff --git a/src/lread.c b/src/lread.c
index f285312e592..b6f259f1a95 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3807,6 +3807,30 @@ check_obarray (Lisp_Object obarray)
   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 @@ intern_1 (const char *str, ptrdiff_t len)
   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 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
   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 @@ A second optional argument specifies the obarray to use;
 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,
diff --git a/src/w32font.c b/src/w32font.c
index 24666ad97c7..7b2aac1cbf2 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -291,7 +291,7 @@ intern_font_name (char * string)
   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.