static void
define_symbol (Lisp_Object sym, char const *str)
{
- ptrdiff_t len = strlen (str);
- Lisp_Object string = make_pure_c_string (str, len);
- init_symbol (sym, string);
+ const bool keyword = *str == ':';
+ const char *name_start = keyword ? str + 1 : str;
+
+ const Lisp_Object symbol_name
+ = make_pure_c_string (name_start, strlen (name_start));
+ init_symbol (sym, symbol_name);
/* Qunbound is uninterned, so that it's not confused with any symbol
'unbound' created by a Lisp program. */
- if (! BASE_EQ (sym, Qunbound))
+ if (!BASE_EQ (sym, Qunbound))
{
- Lisp_Object bucket = oblookup (initial_obarray, str, len, len);
- eassert (FIXNUMP (bucket));
- intern_sym (sym, initial_obarray, bucket);
+ if (keyword)
+ pkg_add_keyword (sym);
+ else
+ pkg_add_symbol (sym, Vemacs_package);
}
}
+void
+pkg_define_builtin_symbols (void)
+{
+ for (int i = 0; i < ARRAYELTS (lispsym); i++)
+ define_symbol (builtin_lisp_symbol (i), defsym_name[i]);
+}
+
DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
doc: /* Return the canonical symbol whose name is STRING.
If there is none, one is created by this function and returned.
it defaults to the value of `obarray'. */)
(Lisp_Object string, Lisp_Object package)
{
- /* PKG-FIXME: Remove this eassert. */
- eassert (SREF (string, 0) != ':' || !package_system_ready);
+ /* PKG-FIXME: What's the right thing to do */
+ eassert (SREF (string, 0) != ':');
return pkg_emacs_intern (string, package);
}
void
map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
{
- eassert (package_system_ready);
+ eassert (false);
ptrdiff_t i;
register Lisp_Object tail;
CHECK_VECTOR (obarray);
OBARRAY defaults to the value of `obarray'. */)
(Lisp_Object function, Lisp_Object obarray)
{
- pkg_map_symbols (function, obarray);
+ pkg_map_package_symbols (function, obarray);
return Qnil;
}
initial_obarray = Vobarray;
staticpro (&initial_obarray);
- for (int i = 0; i < ARRAYELTS (lispsym); i++)
- define_symbol (builtin_lisp_symbol (i), defsym_name[i]);
-
DEFSYM (Qunbound, "unbound");
DEFSYM (Qnil, "nil");
#include "lisp.h"
#include "character.h"
-bool package_system_ready = false;
-
/* Lists of keywords and other symbols that are defined before
packages are ready to use. These are fixed up and the lists set
to nil when the package system is ready. */
static Lisp_Object early_keywords, early_symbols;
+Lisp_Object Vpackage_registry;
+Lisp_Object Vemacs_package, Vkeyword_package;
+Lisp_Object Vearmuffs_package;
+Lisp_Object Vpackage_prefixes;
+
/***********************************************************************
Useless tools
***********************************************************************/
pkg_add_symbol (Lisp_Object symbol, Lisp_Object package)
{
eassert (SYMBOLP (symbol));
- eassert (!package_system_ready || PACKAGEP (package));
+ eassert (PACKAGEP (package));
eassert (NILP (SYMBOL_PACKAGE (symbol)));
- /* IF we are not ready yet to do the right thing, remember
- the symbol for later. There is only one candidate package
- to add it to later: the emacs package. */
- if (!package_system_ready)
- {
- add_new_to_list (symbol, &early_symbols);
- return symbol;
- }
-
XSYMBOL (symbol)->u.s.package = package;
XSYMBOL (symbol)->u.s.external = EQ (package, Vkeyword_package);
in lexically bound elisp signal an error, as documented. */
XSYMBOL (symbol)->u.s.declared_special = true;
- if (package_system_ready)
- pkg_add_symbol (symbol, Vkeyword_package);
- else
- early_keywords = Fcons (symbol, early_keywords);
+ pkg_add_symbol (symbol, Vkeyword_package);
return symbol;
}
static Lisp_Object
pkg_intern_symbol (const Lisp_Object symbol_or_name, Lisp_Object package)
{
- eassert (package_system_ready);
eassert (PACKAGEP (package));
const Lisp_Object name
bool
pkg_intern_name_c_string (const char *p, ptrdiff_t len, Lisp_Object *symbol)
{
- if (!package_system_ready)
- return false;
Lisp_Object name = make_unibyte_string (p, len);
*symbol = pkg_intern_symbol (name, Vearmuffs_package);
return true;
Lisp_Object
pkg_lookup_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes)
{
- if (!package_system_ready)
- return Qunbound;
const Lisp_Object name = make_string_from_bytes (ptr, nchars, nbytes);
return lookup_symbol (name, Vearmuffs_package);
}
void
pkg_early_intern_symbol (Lisp_Object symbol)
{
- if (package_system_ready)
- pkg_intern_symbol (symbol, Vemacs_package);
- else
- pkg_add_symbol (symbol, Qnil);
+ pkg_intern_symbol (symbol, Vemacs_package);
}
static Lisp_Object
pkg_unintern_symbol (Lisp_Object symbol, Lisp_Object package)
{
- eassert (package_system_ready);
CHECK_SYMBOL (symbol);
remove_shadowing_symbol (symbol, package);
package = package_or_default (package);
Lisp_Object
pkg_emacs_intern (Lisp_Object name, Lisp_Object package)
{
- eassert (package_system_ready);
CHECK_STRING (name);
+ eassert (SREF (name, 0) != ':');
+
/* This is presumable an obarray, and we are intending
to intern into the default pacakge. */
if (VECTORP (package))
Lisp_Object
pkg_emacs_intern_soft (Lisp_Object symbol, Lisp_Object package)
{
- eassert (package_system_ready);
-
const Lisp_Object name = SYMBOLP (symbol) ? SYMBOL_NAME (symbol) : symbol;
CHECK_STRING (name);
Lisp_Object
pkg_emacs_unintern (Lisp_Object name, Lisp_Object package)
{
- eassert (package_system_ready);
package = package_or_default (package);
return pkg_unintern_symbol (name, package);
}
{
if (!SYMBOLP (obj))
return false;
- if (package_system_ready)
- return EQ (SYMBOL_PACKAGE (obj), Vkeyword_package);
- return !NILP (Fmemq (obj, early_keywords));
+ return EQ (SYMBOL_PACKAGE (obj), Vkeyword_package);
}
+void
+pkg_map_package_symbols (Lisp_Object fn, Lisp_Object package)
+{
+ package = check_package (package);
+ FOR_EACH_KEY_VALUE (it_symbol, PACKAGE_SYMBOLS (package))
+ call1 (fn, it_symbol.value);
+
+}
/* Map FUNCTION over all symbols in PACKAGE. */
void
-pkg_map_symbols (Lisp_Object function, Lisp_Object package)
+pkg_map_symbols (Lisp_Object function)
{
- eassert (package_system_ready);
- package = package_or_default (package);
- FOR_EACH_KEY_VALUE (it, XPACKAGE (package)->symbols)
- call1 (function, it.key);
+ FOR_EACH_KEY_VALUE (it_package, Vpackage_registry)
+ pkg_map_package_symbols (function, it_package.value);
+}
+
+void
+pkg_map_symbols_c_fn (void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
+{
+ FOR_EACH_KEY_VALUE (it_package, Vpackage_registry)
+ FOR_EACH_KEY_VALUE (it_symbol, PACKAGE_SYMBOLS (it_package.value))
+ fn (it_symbol.value, arg);
}
\f
Initialization
***********************************************************************/
-/* Loop over early-defined symbols and fix their packages. */
-
-static void
-fix_symbol_packages (void)
-{
- int len_keywords = 0, len_symbols = 0;
-
- Lisp_Object tail = early_keywords;
- FOR_EACH_TAIL (tail)
- {
-
- /* Fix symbol names of keywords by removing the leading colon. */
- Lisp_Object symbol = XCAR (tail);
- Lisp_Object name = SYMBOL_NAME (symbol);
- struct Lisp_String *s = XSTRING (name);
- if (s->u.s.size > 0 && *s->u.s.data == ':')
- {
- eassume (s->u.s.size_byte == -2);
- ++s->u.s.data;
- --s->u.s.size;
- }
- pkg_add_symbol (symbol, Vkeyword_package);
- ++len_keywords;
- }
-
- tail = early_symbols;
- FOR_EACH_TAIL (tail)
- {
- ++len_symbols;
- pkg_add_symbol (XCAR (tail), Vemacs_package);
- }
-
- fprintf (stderr, "Early keywords = %d, symbols = %d\n", len_keywords, len_symbols);
-
- early_keywords = early_symbols = Qnil;
-
-#ifdef ENABLE_CHECKING
- const Lisp_Object nil = lookup_symbol (SYMBOL_NAME (Qnil), Vemacs_package);
- eassert (EQ (nil, Qnil));
- eassert (NILP (nil));
- eassert (NILP (XSYMBOL (nil)->u.s.val.value));
-
- const Lisp_Object t = lookup_symbol (SYMBOL_NAME (Qt), Vemacs_package);
- eassert (EQ (t, Qt));
- eassert (EQ (XSYMBOL (t)->u.s.val.value, Qt));
-#endif
-}
-
/* Called very early, after init_alloc_once and init_obarray_once.
Not called when starting a dumped Emacs. */
void
init_pkg_once (void)
{
+ DEFSYM (QCexternal, ":external");
+ DEFSYM (QCinherited, ":inherited");
+ DEFSYM (QCinternal, ":internal");
+ DEFSYM (QCnicknames, ":nicknames");
+ DEFSYM (QCuse, ":use");
+
+ DEFSYM (Qearmuffs_package, "*package*");
+ DEFSYM (Qemacs_package, "emacs-package");
+ DEFSYM (Qkeyword, "keyword");
+ DEFSYM (Qkeyword_package, "keyword-package");
+ DEFSYM (Qpackage, "package");
+ DEFSYM (Qpackage_prefixes, "package-prefixes");
+ DEFSYM (Qpackage_registry, "package-registry");
+ DEFSYM (Qpackagep, "packagep");
+
staticpro (&early_symbols);
early_keywords = Qnil;
staticpro (&early_keywords);
early_keywords = Qnil;
+
+ staticpro (&Vpackage_registry);
+ /* PKG-FIXME: Not sure about the purecopy (last arg). */
+ Vpackage_registry = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE,
+ DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
+ Qnil, false);
+
+ Vemacs_package = make_package (build_string ("emacs"));
+ staticpro (&Vemacs_package);
+ Vkeyword_package = make_package (build_string ("keyword"));
+ register_package (Vemacs_package);
+
+ staticpro (&Vkeyword_package);
+ XPACKAGE (Vkeyword_package)->nicknames = Fcons (build_string (""), Qnil);
+ register_package (Vkeyword_package);
+
+ staticpro (&Vearmuffs_package);
+ Vearmuffs_package = Vemacs_package;
+ XSYMBOL (Qearmuffs_package)->u.s.declared_special = true;
+
+ DEFSYM (Qpackage_prefixes, "package-prefixes");
+ staticpro (&Vpackage_prefixes);
+ Vpackage_prefixes = Qnil;
+
+ pkg_define_builtin_symbols ();
}
/* Not called when starting a dumped Emacs. */
defsubr (&Sunuse_package);
defsubr (&Suse_package);
- DEFSYM (QCexternal, ":external");
- DEFSYM (QCinherited, ":inherited");
- DEFSYM (QCinternal, ":internal");
- DEFSYM (QCnicknames, ":nicknames");
- DEFSYM (QCuse, ":use");
-
- DEFSYM (Qearmuffs_package, "*package*");
- DEFSYM (Qemacs_package, "emacs-package");
- DEFSYM (Qkeyword, "keyword");
- DEFSYM (Qkeyword_package, "keyword-package");
- DEFSYM (Qpackage, "package");
- DEFSYM (Qpackage_prefixes, "package-prefixes");
- DEFSYM (Qpackage_registry, "package-registry");
- DEFSYM (Qpackagep, "packagep");
-
- DEFVAR_LISP ("package-registry", Vpackage_registry,
- doc: "A map of names to packages.");
- Vpackage_registry = CALLN (Fmake_hash_table, QCtest, Qequal);
-
- DEFVAR_LISP ("emacs-package", Vemacs_package, doc: "The emacs package.");
- Vemacs_package = CALLN (Fmake_package, Qemacs);
- make_symbol_constant (Qemacs_package);
- register_package (Vemacs_package);
-
- DEFVAR_LISP ("keyword-package", Vkeyword_package, doc: "The keyword package.");
- Vkeyword_package = CALLN (Fmake_package, Qkeyword,
- QCnicknames, list1 (make_string ("", 0)));
- make_symbol_constant (Qkeyword_package);
- register_package (Vkeyword_package);
-
- DEFVAR_LISP ("*package*", Vearmuffs_package, doc: "The current package.");
- Vearmuffs_package = Vemacs_package;
- XSYMBOL (Qearmuffs_package)->u.s.declared_special = true;
-
- DEFSYM (Qpackage_prefixes, "package-prefixes");
- DEFVAR_LISP ("package-prefixes", Vpackage_prefixes,
- doc: /* Whether to read package prefixes in symbol names. */);
- Vpackage_prefixes = Qnil;
Fmake_variable_buffer_local (Qpackage_prefixes);
-
- package_system_ready = true;
- fix_symbol_packages ();
}
/* Called when starting a dumped Emacs. */
void
init_pkg (void)
{
- package_system_ready = true;
}
projects / emacs.git / commitdiff