From: Gerd Möllmann <gerd@gnu.org>
Date: Fri, 14 Oct 2022 13:46:22 +0000 (+0200)
Subject: Initialize package system earlier
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=62c7059adca24afbf4d4be09f0b9198bd02caf20;p=emacs.git

Initialize package system earlier
---

diff --git a/src/data.c b/src/data.c
index 226440c2a59..34bdb9f4b43 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1816,7 +1816,7 @@ All writes to aliases of SYMBOL will call WATCH-FUNCTION too.  */)
   symbol = Findirect_variable (symbol);
   CHECK_SYMBOL (symbol);
   set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE);
-  map_obarray (Vobarray, harmonize_variable_watchers, symbol);
+  pkg_map_symbols_c_fn (harmonize_variable_watchers, symbol);
 
   Lisp_Object watchers = Fget (symbol, Qwatchers);
   Lisp_Object member = Fmember (watch_function, watchers);
@@ -1838,7 +1838,7 @@ SYMBOL (or its aliases) are set.  */)
   if (NILP (watchers))
     {
       set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
-      map_obarray (Vobarray, harmonize_variable_watchers, symbol);
+      pkg_map_symbols_c_fn (harmonize_variable_watchers, symbol);
     }
   Fput (symbol, Qwatchers, watchers);
   return Qnil;
diff --git a/src/lisp.h b/src/lisp.h
index 9bd66eaedca..becf12abd85 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2247,6 +2247,12 @@ XPACKAGE (Lisp_Object a)
   return &XUNTAG (a, Lisp_Vectorlike, union Aligned_Lisp_Package)->s;
 }
 
+INLINE Lisp_Object
+PACKAGE_SYMBOLS (Lisp_Object package)
+{
+  return XPACKAGE (package)->symbols;
+}
+
 extern void init_pkg_once (void);
 extern void init_pkg (void);
 extern void syms_of_pkg (void);
@@ -2263,9 +2269,16 @@ extern bool pkg_intern_name_c_string (const char *p, ptrdiff_t len, Lisp_Object
 extern void pkg_early_intern_symbol (Lisp_Object symbol);
 extern Lisp_Object pkg_lookup_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes);
 extern void pkg_break (void);
-extern void pkg_map_symbols (Lisp_Object function, Lisp_Object oackage);
+extern void pkg_define_builtin_symbols (void);
+extern void pkg_map_package_symbols (Lisp_Object fn, Lisp_Object package);
+extern void pkg_map_symbols (Lisp_Object function);
+extern void pkg_map_symbols_c_fn (void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg);
+
+extern Lisp_Object Vpackage_registry;
+extern Lisp_Object Vemacs_package, Vkeyword_package;
+extern Lisp_Object Vearmuffs_package;
+extern Lisp_Object Vpackage_prefixes;
 
-extern bool package_system_ready;
 
 
 /* Return whether a value might be a valid docstring.
diff --git a/src/lread.c b/src/lread.c
index d72fa3471fb..a9976055164 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4832,20 +4832,31 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
 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.
@@ -4853,8 +4864,8 @@ A second optional argument specifies the obarray to use;
 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);
 }
 
@@ -4930,7 +4941,7 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff
 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);
@@ -4953,7 +4964,7 @@ DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
 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;
 }
 
@@ -4966,9 +4977,6 @@ init_obarray_once (void)
   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");
diff --git a/src/pkg.c b/src/pkg.c
index fc11388f5d5..9acc68879e4 100644
--- a/src/pkg.c
+++ b/src/pkg.c
@@ -30,14 +30,17 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #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
  ***********************************************************************/
@@ -429,18 +432,9 @@ Lisp_Object
 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);
 
@@ -468,10 +462,7 @@ pkg_add_keyword (Lisp_Object symbol)
      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;
 }
 
@@ -517,7 +508,6 @@ symbol_and_status (Lisp_Object symbol, Lisp_Object package)
 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
@@ -548,8 +538,6 @@ pkg_intern_symbol (const Lisp_Object symbol_or_name, Lisp_Object package)
 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;
@@ -558,8 +546,6 @@ pkg_intern_name_c_string (const char *p, ptrdiff_t len, Lisp_Object *symbol)
 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);
 }
@@ -567,16 +553,12 @@ pkg_lookup_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes)
 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);
@@ -605,9 +587,10 @@ void pkg_break (void)
 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))
@@ -622,8 +605,6 @@ pkg_emacs_intern (Lisp_Object name, Lisp_Object 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);
 
@@ -649,7 +630,6 @@ pkg_emacs_intern_soft (Lisp_Object symbol, Lisp_Object package)
 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);
 }
@@ -716,21 +696,33 @@ pkg_keywordp (Lisp_Object obj)
 {
   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);
 }
 
 
@@ -1115,64 +1107,56 @@ DEFUN ("pkg-break", Fpkg_read, Spkg_read, 1, 1, 0,
 			    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.  */
@@ -1204,48 +1188,7 @@ syms_of_pkg (void)
   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.  */
@@ -1253,5 +1196,4 @@ syms_of_pkg (void)
 void
 init_pkg (void)
 {
-  package_system_ready = true;
 }