Commit 99c3fad7 authored by Dmitry Antipov's avatar 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.
parent f135e94e
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.
......
......@@ -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. */
......
......@@ -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)
......
......@@ -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,
......
......@@ -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.
......
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