From: Dmitry Antipov Date: Mon, 22 Sep 2014 06:06:19 +0000 (+0400) Subject: Avoid extra call to oblookup when interning symbols. X-Git-Tag: emacs-25.0.90~2635^2~679^2~258 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=99c3fad7d44ceced111d8fa1b46d938bd4c67c73;p=emacs.git 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. --- 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 + + 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 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.