emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

pkg 513f5a0b90 21/76: Remove obarrays


From: Gerd Moellmann
Subject: pkg 513f5a0b90 21/76: Remove obarrays
Date: Fri, 21 Oct 2022 00:16:10 -0400 (EDT)

branch: pkg
commit 513f5a0b90ffbf6f3f4f5645889d6465e1d808ab
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>

    Remove obarrays
    
    * lisp/emacs-lisp/eldoc.el (eldoc-message-commands): Make a package
    instead of an obarray-vector.
    * src/doc.c (Fsnarf_documentation): Don't use oblookup.
    * src/eval.c (Fsignal): Debuggin helper code.
    * src/font.c (font_intern_prop):  Don't use oblookup.
    * src/lisp.h (intern_c_string): Delete inline function, use the one
    in fread.c.
    * src/lread.c: Remove everything realted to obarray, except Vobarray,
    which is now set to Vemacs_package.
    * src/minibuf.c (Ftry_completion, Fall_completions, Ftest_completion):
    Accept packages.
    * src/pkg.c: Adapted to other changes.
---
 lisp/emacs-lisp/eldoc.el |   2 +-
 src/doc.c                |  21 +++---
 src/eval.c               |   3 +
 src/font.c               |  18 ++---
 src/lisp.h               |  23 +++---
 src/lread.c              | 183 +++++------------------------------------------
 src/minibuf.c            | 145 +++++++++----------------------------
 src/pkg.c                | 144 ++++++++++++++++++++++++-------------
 8 files changed, 177 insertions(+), 362 deletions(-)

diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 6fd89a690d..c80a872e97 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -146,7 +146,7 @@ Remember to keep it a prime number to improve hash 
performance.")
 
 (defvar eldoc-message-commands
   ;; Don't define as `defconst' since it would then go to (read-only) 
purespace.
-  (make-vector eldoc-message-commands-table-size 0)
+  (make-package "eldoc-message-commands")
   "Commands after which it is appropriate to print in the echo area.
 ElDoc does not try to print function arglists, etc., after just any command,
 because some commands print their own messages in the echo area and these
diff --git a/src/doc.c b/src/doc.c
index 67a5f845b9..1b74e62950 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -501,7 +501,6 @@ the same file name is found in the `doc-directory'.  */)
   char buf[1024 + 1];
   int filled;
   EMACS_INT pos;
-  Lisp_Object sym;
   char *p, *name;
   char const *dirname;
   ptrdiff_t dirlen;
@@ -580,20 +579,18 @@ the same file name is found in the `doc-directory'.  */)
             But this meant the doc had to be kept and updated in
             multiple files.  Nowadays we keep the doc only in eg xterm.
             The (f)boundp checks below ensure we don't report
-            docs for eg w32-specific items on X.
-         */
-
-         sym = oblookup (Vobarray, p + 2,
-                         multibyte_chars_in_text ((unsigned char *) p + 2,
-                                                  end - p - 2),
-                         end - p - 2);
-          /* Ignore docs that start with SKIP.  These mark
-             placeholders where the real doc is elsewhere.  */
-         if (SYMBOLP (sym))
+            docs for eg w32-specific items on X. */
+
+         const ptrdiff_t nbytes = end - p - 2;
+         const ptrdiff_t nchars = multibyte_chars_in_text ((unsigned char *) p 
+ 2, nbytes);
+         const Lisp_Object sym = pkg_lookup_non_keyword_c_string (p + 2, 
nchars, nbytes);
+         if (!EQ (sym, Qunbound))
            {
              /* Attach a docstring to a variable?  */
              if (p[1] == 'V')
                {
+                 /* Ignore docs that start with SKIP.  These mark
+                    placeholders where the real doc is elsewhere.  */
                  /* Install file-position as variable-documentation property
                     and make it negative for a user-variable
                     (doc starts with a `*').  */
@@ -604,7 +601,6 @@ the same file name is found in the `doc-directory'.  */)
                           make_fixnum ((pos + end + 1 - buf)
                                        * (end[1] == '*' ? -1 : 1)));
                }
-
              /* Attach a docstring to a function?  */
              else if (p[1] == 'F')
                 {
@@ -613,7 +609,6 @@ the same file name is found in the `doc-directory'.  */)
                 }
              else if (p[1] == 'S')
                ; /* Just a source file name boundary marker.  Ignore it.  */
-
              else
                error ("DOC file invalid at position %"pI"d", pos);
            }
diff --git a/src/eval.c b/src/eval.c
index 8810136c04..9945e37ef1 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1676,6 +1676,9 @@ See also the function `condition-case'.  */
        attributes: noreturn)
   (Lisp_Object error_symbol, Lisp_Object data)
 {
+  if (EQ (error_symbol, Qwrong_type_argument))
+    pkg_break ();
+
   /* If they call us with nonsensical arguments, produce "peculiar error".  */
   if (NILP (error_symbol) && NILP (data))
     error_symbol = Qerror;
diff --git a/src/font.c b/src/font.c
index 6e720bc285..997f86b862 100644
--- a/src/font.c
+++ b/src/font.c
@@ -261,8 +261,7 @@ static int num_font_drivers;
 Lisp_Object
 font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
 {
-  ptrdiff_t i, nbytes, nchars;
-  Lisp_Object tem, name, obarray;
+  ptrdiff_t i;
 
   if (len == 1 && *str == '*')
     return Qnil;
@@ -287,16 +286,13 @@ font_intern_prop (const char *str, ptrdiff_t len, bool 
force_symbol)
        }
     }
 
-  /* This code is similar to intern function from lread.c.  */
-  obarray = check_obarray (Vobarray);
+  /* PKG-FIXME: These many make_xyz_string variants are confusing.
+     Simplify.  */
+  ptrdiff_t nbytes, nchars;
   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;
-  name = make_specified_string (str, nchars, len,
-                               len != nchars && len == nbytes);
-  return intern_driver (name, obarray, tem);
+  Lisp_Object name = make_specified_string (str, nchars, len,
+                                           len != nchars && len == nbytes);
+  return pkg_intern_maybe_keyword (name);
 }
 
 /* Return a pixel size of font-spec SPEC on frame F.  */
diff --git a/src/lisp.h b/src/lisp.h
index becf12abd8..c1c0e29a3d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2260,14 +2260,17 @@ extern Lisp_Object pkg_qualified_symbol (Lisp_Object 
name, Lisp_Object package,
 extern void pkg_error (const char *fmt, ...);
 extern Lisp_Object pkg_unqualified_symbol (Lisp_Object name);
 extern bool pkg_keywordp (Lisp_Object obj);
-extern Lisp_Object pkg_add_keyword (Lisp_Object sym);
-extern Lisp_Object pkg_add_symbol (Lisp_Object symbol, Lisp_Object package);
+extern Lisp_Object pkg_intern_keyword (Lisp_Object sym);
+extern Lisp_Object pkg_define_keyword (Lisp_Object sym);
+extern Lisp_Object pkg_define_non_keyword (Lisp_Object sym);
+extern Lisp_Object pkg_intern_symbol (Lisp_Object sym, Lisp_Object package);
 extern Lisp_Object pkg_emacs_intern (Lisp_Object name, Lisp_Object package);
 extern Lisp_Object pkg_emacs_intern_soft (Lisp_Object name, Lisp_Object 
package);
 extern Lisp_Object pkg_emacs_unintern (Lisp_Object name, Lisp_Object package);
-extern bool pkg_intern_name_c_string (const char *p, ptrdiff_t len, 
Lisp_Object *symbol);
-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 Lisp_Object pkg_intern_non_keyword (Lisp_Object name);
+extern Lisp_Object pkg_intern_non_keyword_c_string (const char *p, ptrdiff_t 
len);
+extern Lisp_Object pkg_lookup_non_keyword_c_string (const char *ptr, ptrdiff_t 
nchars, ptrdiff_t nbytes);
+extern Lisp_Object pkg_intern_maybe_keyword (Lisp_Object name);
 extern void pkg_break (void);
 extern void pkg_define_builtin_symbols (void);
 extern void pkg_map_package_symbols (Lisp_Object fn, Lisp_Object package);
@@ -4574,9 +4577,7 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char *, 
ptrdiff_t,
   ATTRIBUTE_FORMAT_PRINTF (5, 0);
 
 /* Defined in lread.c.  */
-extern Lisp_Object check_obarray (Lisp_Object);
 extern void init_symbol (Lisp_Object, Lisp_Object);
-extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
 INLINE void
 LOADHIST_ATTACH (Lisp_Object x)
 {
@@ -4590,16 +4591,14 @@ extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
                   Lisp_Object *, Lisp_Object, bool, bool);
 enum { S2N_IGNORE_TRAILING = 1 };
 extern Lisp_Object string_to_number (char const *, int, ptrdiff_t *);
-extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
-                         Lisp_Object);
 extern void dir_warning (const char *, Lisp_Object);
 extern void init_obarray_once (void);
 extern void init_lread (void);
 extern void syms_of_lread (void);
 extern void mark_lread (void);
 extern Lisp_Object intern_1 (const char *str, ptrdiff_t len);
-extern Lisp_Object intern_c_string_1 (const char *str, ptrdiff_t len);
-extern Lisp_Object intern_driver (Lisp_Object string, Lisp_Object obarray, 
Lisp_Object index);
+extern Lisp_Object intern_c_string_1 (const char *str, ptrdiff_t len,
+                                     bool allow_pure_p);
 
 INLINE Lisp_Object
 intern (const char *str)
@@ -4610,7 +4609,7 @@ intern (const char *str)
 INLINE Lisp_Object
 intern_c_string (const char *str)
 {
-  return intern_c_string_1 (str, strlen (str));
+  return intern_c_string_1 (str, strlen (str), true);
 }
 
 /* Defined in eval.c.  */
diff --git a/src/lread.c b/src/lread.c
index a997605516..ba398122bd 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4726,107 +4726,28 @@ string_to_number (char const *string, int base, 
ptrdiff_t *plen)
 }
 
 
-static Lisp_Object initial_obarray;
-
-/* `oblookup' stores the bucket number here, for the sake of Funintern.  */
-
-static size_t oblookup_last_bucket_number;
-
-/* Get an error if OBARRAY is not an obarray.
-   If it is one, return it.  */
+/* Intern symbol with name given by STR and LEN.  ALLOW_PURE_P means
+   that the symbol name may be allocated from pure space if necessary.
+   If STR starts with a colon, consider it a keyword.  */
 
 Lisp_Object
-check_obarray (Lisp_Object obarray)
+intern_c_string_1 (const char *str, ptrdiff_t len, bool allow_pure_p)
 {
-  /* We don't want to signal a wrong-type-argument error when we are
-     shutting down due to a fatal error, and we don't want to hit
-     assertions in VECTORP and ASIZE if the fatal error was during GC.  */
-  if (!fatal_error_in_progress
-      && (!VECTORP (obarray) || ASIZE (obarray) == 0))
-    {
-      /* If Vobarray is now invalid, force it to be valid.  */
-      if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
-      wrong_type_argument (Qvectorp, obarray);
-    }
-  return obarray;
-}
-
-/* Intern symbol SYM in OBARRAY using bucket INDEX.  */
-
-static Lisp_Object
-intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
-{
-  Lisp_Object *ptr;
-
-  if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
-    {
-      make_symbol_constant (sym);
-      XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL;
-      /* Mark keywords as special.  This makes (let ((:key 'foo)) ...)
-        in lexically bound elisp signal an error, as documented.  */
-      XSYMBOL (sym)->u.s.declared_special = true;
-      SET_SYMBOL_VAL (XSYMBOL (sym), sym);
-      pkg_add_keyword (sym);
-    }
-  else
-    pkg_early_intern_symbol (sym);
-
-  ptr = aref_addr (obarray, XFIXNUM (index));
-  set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL);
-  *ptr = sym;
-  return sym;
-}
-
-/* Intern a symbol with name STRING in OBARRAY using bucket INDEX.  */
-
-Lisp_Object
-intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index)
-{
-  SET_SYMBOL_VAL (XSYMBOL (Qobarray_cache), Qnil);
-  return intern_sym (Fmake_symbol (string), obarray, index);
+  const bool keyword = *str == ':';
+  const char *name_start = keyword ? str + 1 : str;
+  const ptrdiff_t name_len = keyword ? len - 1 : len;
+  const Lisp_Object name = ((!allow_pure_p || NILP (Vpurify_flag))
+                           ? make_string (name_start, name_len)
+                           : make_pure_c_string (name_start, name_len));
+  if (keyword)
+    return pkg_intern_keyword (name);
+  return pkg_intern_non_keyword (name);
 }
 
-/* Intern the C string STR: return a symbol with that name,
-   interned in the current obarray.  */
-
 Lisp_Object
 intern_1 (const char *str, ptrdiff_t len)
 {
-  /* If we can find a symbol with that name "normally", return that
-     symbol.  */
-  Lisp_Object symbol;
-  if (pkg_intern_name_c_string (str, len, &symbol))
-    return symbol;
-
-  /* Not found: Do the obarray dance.  */
-  Lisp_Object obarray = check_obarray (Vobarray);
-  Lisp_Object tem = oblookup (obarray, str, len, len);
-
-  return (SYMBOLP (tem) ? tem
-         /* The above `oblookup' was done on the basis of nchars==nbytes, so
-            the string has to be unibyte.  */
-         : intern_driver (make_unibyte_string (str, len),
-                          obarray, tem));
-}
-
-Lisp_Object
-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))
-    {
-      Lisp_Object string;
-
-      if (NILP (Vpurify_flag))
-       string = make_string (str, len);
-      else
-       string = make_pure_c_string (str, len);
-
-      tem = intern_driver (string, obarray, tem);
-    }
-  return tem;
+  return intern_c_string_1 (str, len, false);
 }
 
 static void
@@ -4844,9 +4765,9 @@ define_symbol (Lisp_Object sym, char const *str)
   if (!BASE_EQ (sym, Qunbound))
     {
       if (keyword)
-       pkg_add_keyword (sym);
+       pkg_define_keyword (sym);
       else
-       pkg_add_symbol (sym, Vemacs_package);
+       pkg_define_non_keyword (sym);
     }
 }
 
@@ -4892,72 +4813,6 @@ usage: (unintern NAME OBARRAY)  */)
   return pkg_emacs_unintern (name, obarray);
 }
 
-/* Return the symbol in OBARRAY whose names matches the string
-   of SIZE characters (SIZE_BYTE bytes) at PTR.
-   If there is no such symbol, return the integer bucket number of
-   where the symbol would be if it were present.
-
-   Also store the bucket number in oblookup_last_bucket_number.  */
-
-Lisp_Object
-oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, 
ptrdiff_t size_byte)
-{
-  const Lisp_Object found = pkg_lookup_c_string (ptr, size, size_byte);
-  if (!EQ (found, Qunbound))
-    return found;
-
-  size_t hash;
-  size_t obsize;
-  register Lisp_Object tail;
-  Lisp_Object bucket, tem;
-
-  obarray = check_obarray (obarray);
-  /* This is sometimes needed in the middle of GC.  */
-  obsize = gc_asize (obarray);
-  hash = hash_string (ptr, size_byte) % obsize;
-  bucket = AREF (obarray, hash);
-  oblookup_last_bucket_number = hash;
-  if (BASE_EQ (bucket, make_fixnum (0)))
-    ;
-  else if (!SYMBOLP (bucket))
-    /* Like CADR error message.  */
-    xsignal2 (Qwrong_type_argument, Qobarrayp,
-             build_string ("Bad data in guts of obarray"));
-  else
-    for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next))
-      {
-       if (SBYTES (SYMBOL_NAME (tail)) == size_byte
-           && SCHARS (SYMBOL_NAME (tail)) == size
-           && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
-         return tail;
-       else if (XSYMBOL (tail)->u.s.next == 0)
-         break;
-      }
-  XSETINT (tem, hash);
-  return tem;
-}
-
-
-void
-map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), 
Lisp_Object arg)
-{
-  eassert (false);
-  ptrdiff_t i;
-  register Lisp_Object tail;
-  CHECK_VECTOR (obarray);
-  for (i = ASIZE (obarray) - 1; i >= 0; i--)
-    {
-      tail = AREF (obarray, i);
-      if (SYMBOLP (tail))
-       while (1)
-         {
-           (*fn) (tail, arg);
-           if (XSYMBOL (tail)->u.s.next == 0)
-             break;
-           XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
-         }
-    }
-}
 
 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
        doc: /* Call FUNCTION on every symbol in OBARRAY.
@@ -4968,14 +4823,10 @@ OBARRAY defaults to the value of `obarray'.  */)
   return Qnil;
 }
 
-#define OBARRAY_SIZE 15121
-
 void
 init_obarray_once (void)
 {
-  Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0));
-  initial_obarray = Vobarray;
-  staticpro (&initial_obarray);
+  Vobarray = Vemacs_package;
 
   DEFSYM (Qunbound, "unbound");
 
diff --git a/src/minibuf.c b/src/minibuf.c
index bedc564480..02bbb0df35 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1616,31 +1616,26 @@ or from one of the possible completions.  */)
   ptrdiff_t bestmatchsize = 0;
   /* These are in bytes, too.  */
   ptrdiff_t compare, matchsize;
-  enum { function_table, list_table, obarray_table, hash_table}
-    type = (HASH_TABLE_P (collection) ? hash_table
-           : VECTORP (collection) ? obarray_table
-           : ((NILP (collection)
-               || (CONSP (collection) && !FUNCTIONP (collection)))
-              ? list_table : function_table));
-  ptrdiff_t idx = 0, obsize = 0;
-  int matchcount = 0;
-  Lisp_Object bucket, zero, end, tem;
 
   CHECK_STRING (string);
-  if (type == function_table)
+
+  if (FUNCTIONP (collection))
     return call3 (collection, string, predicate, Qnil);
 
+  if (PACKAGEP (collection))
+    collection = PACKAGE_SYMBOLS (collection);
+
+  ptrdiff_t idx = 0;
+  int matchcount = 0;
+  Lisp_Object bucket, zero, end, tem;
+
   bestmatch = bucket = Qnil;
   zero = make_fixnum (0);
 
+  eassert (HASH_TABLE_P (collection) || NILP (collection) || CONSP 
(collection));
+
   /* If COLLECTION is not a list, set TAIL just for gc pro.  */
   tail = collection;
-  if (type == obarray_table)
-    {
-      collection = check_obarray (collection);
-      obsize = ASIZE (collection);
-      bucket = AREF (collection, idx);
-    }
 
   while (1)
     {
@@ -1649,36 +1644,7 @@ or from one of the possible completions.  */)
       /* elt gets the alist element or symbol.
         eltstring gets the name to check as a completion.  */
 
-      if (type == list_table)
-       {
-         if (!CONSP (tail))
-           break;
-         elt = XCAR (tail);
-         eltstring = CONSP (elt) ? XCAR (elt) : elt;
-         tail = XCDR (tail);
-       }
-      else if (type == obarray_table)
-       {
-         if (!EQ (bucket, zero))
-           {
-             if (!SYMBOLP (bucket))
-               error ("Bad data in guts of obarray");
-             elt = bucket;
-             eltstring = elt;
-             if (XSYMBOL (bucket)->u.s.next)
-               XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
-             else
-               XSETFASTINT (bucket, 0);
-           }
-         else if (++idx >= obsize)
-           break;
-         else
-           {
-             bucket = AREF (collection, idx);
-             continue;
-           }
-       }
-      else /* if (type == hash_table) */
+      if (HASH_TABLE_P (collection))
        {
          while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
                 && BASE_EQ (HASH_KEY (XHASH_TABLE (collection), idx),
@@ -1689,6 +1655,14 @@ or from one of the possible completions.  */)
          else
            elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
        }
+      else
+       {
+         if (!CONSP (tail))
+           break;
+         elt = XCAR (tail);
+         eltstring = CONSP (elt) ? XCAR (elt) : elt;
+         tail = XCDR (tail);
+       }
 
       /* Is this element a possible completion?  */
 
@@ -1717,7 +1691,7 @@ or from one of the possible completions.  */)
                tem = Fcommandp (elt, Qnil);
              else
                {
-                 tem = (type == hash_table
+                 tem = (HASH_TABLE_P (collection)
                         ? call2 (predicate, elt,
                                  HASH_VALUE (XHASH_TABLE (collection),
                                              idx - 1))
@@ -1860,25 +1834,26 @@ with a space are ignored unless STRING itself starts 
with a space.  */)
   Lisp_Object tail, elt, eltstring;
   Lisp_Object allmatches;
   int type = HASH_TABLE_P (collection) ? 3
-    : VECTORP (collection) ? 2
+    : PACKAGEP (collection) ? 2
     : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection));
-  ptrdiff_t idx = 0, obsize = 0;
+  ptrdiff_t idx = 0;
   Lisp_Object bucket, tem, zero;
 
   CHECK_STRING (string);
   if (type == 0)
     return call3 (collection, string, predicate, Qt);
+
+  if (type == 2)
+    {
+      collection = PACKAGE_SYMBOLS (collection);
+      type = 3;
+    }
+
   allmatches = bucket = Qnil;
   zero = make_fixnum (0);
 
   /* If COLLECTION is not a list, set TAIL just for gc pro.  */
   tail = collection;
-  if (type == 2)
-    {
-      collection = check_obarray (collection);
-      obsize = ASIZE (collection);
-      bucket = AREF (collection, idx);
-    }
 
   while (1)
     {
@@ -1895,27 +1870,6 @@ with a space are ignored unless STRING itself starts 
with a space.  */)
          eltstring = CONSP (elt) ? XCAR (elt) : elt;
          tail = XCDR (tail);
        }
-      else if (type == 2)
-       {
-         if (!EQ (bucket, zero))
-           {
-             if (!SYMBOLP (bucket))
-               error ("Bad data in guts of obarray");
-             elt = bucket;
-             eltstring = elt;
-             if (XSYMBOL (bucket)->u.s.next)
-               XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
-             else
-               XSETFASTINT (bucket, 0);
-           }
-         else if (++idx >= obsize)
-           break;
-         else
-           {
-             bucket = AREF (collection, idx);
-             continue;
-           }
-       }
       else /* if (type == 3) */
        {
          while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
@@ -2060,51 +2014,20 @@ If COLLECTION is a function, it is called with three 
arguments:
 the values STRING, PREDICATE and `lambda'.  */)
   (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
 {
-  Lisp_Object tail, tem = Qnil;
+  Lisp_Object tem = Qnil;
   ptrdiff_t i = 0;
 
   CHECK_STRING (string);
 
+  if (PACKAGEP (collection))
+    collection = PACKAGE_SYMBOLS (collection);
+
   if (NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)))
     {
       tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : 
Qnil);
       if (NILP (tem))
        return Qnil;
     }
-  else if (VECTORP (collection))
-    {
-      /* Bypass intern-soft as that loses for nil.  */
-      tem = oblookup (collection,
-                     SSDATA (string),
-                     SCHARS (string),
-                     SBYTES (string));
-      if (completion_ignore_case && !SYMBOLP (tem))
-       {
-         for (i = ASIZE (collection) - 1; i >= 0; i--)
-           {
-             tail = AREF (collection, i);
-             if (SYMBOLP (tail))
-               while (1)
-                 {
-                   if (BASE_EQ (Fcompare_strings (string, make_fixnum (0),
-                                                  Qnil,
-                                                  Fsymbol_name (tail),
-                                                  make_fixnum (0) , Qnil, Qt),
-                                Qt))
-                     {
-                       tem = tail;
-                       break;
-                     }
-                   if (XSYMBOL (tail)->u.s.next == 0)
-                     break;
-                   XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
-                 }
-           }
-       }
-
-      if (!SYMBOLP (tem))
-       return Qnil;
-    }
   else if (HASH_TABLE_P (collection))
     {
       struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
diff --git a/src/pkg.c b/src/pkg.c
index 9acc68879e..7ae294fa83 100644
--- a/src/pkg.c
+++ b/src/pkg.c
@@ -30,15 +30,21 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
 #include "lisp.h"
 #include "character.h"
 
-/* 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;
+/* The package registry, a hash-table of package names to package
+   objects.  */
 
 Lisp_Object Vpackage_registry;
+
+/* The two standard packages.  */
+
 Lisp_Object Vemacs_package, Vkeyword_package;
+
+/* The current package.  */
+
 Lisp_Object Vearmuffs_package;
+
+/* If nil, */
+
 Lisp_Object Vpackage_prefixes;
 
 /***********************************************************************
@@ -398,6 +404,12 @@ lookup_symbol1 (Lisp_Object name, Lisp_Object package, 
Lisp_Object seen)
   return symbol;
 }
 
+static Lisp_Object
+lookup_symbol (Lisp_Object name, Lisp_Object package)
+{
+  return lookup_symbol1(name, package, Qnil);
+}
+
 static Lisp_Object
 add_to_package_symbols (Lisp_Object symbol, Lisp_Object package)
 {
@@ -418,17 +430,11 @@ remove_from_package_symbols (Lisp_Object symbol, 
Lisp_Object package)
   Fremhash (SYMBOL_NAME (symbol), XPACKAGE (package)->symbols);
 }
 
-static Lisp_Object
-lookup_symbol (Lisp_Object name, Lisp_Object package)
-{
-  return lookup_symbol1(name, package, Qnil);
-}
-
 /* Add a new SYMBOL to package PACKAGE.  Value is SYMBOL.  The symbol
    is made external if PACKAGE is the keyword package.  Otherwise it
    is internal.  */
 
-Lisp_Object
+static Lisp_Object
 pkg_add_symbol (Lisp_Object symbol, Lisp_Object package)
 {
   eassert (SYMBOLP (symbol));
@@ -448,24 +454,6 @@ pkg_add_symbol (Lisp_Object symbol, Lisp_Object package)
   return add_to_package_symbols (symbol, package);
 }
 
-/* Add a new keyword by adding SYMBOL to the keyword package.  */
-
-Lisp_Object
-pkg_add_keyword (Lisp_Object symbol)
-{
-  /* Symbol-value of a keyword is itself, and cannot be set.  */
-  XSYMBOL (symbol)->u.s.redirect = SYMBOL_PLAINVAL;
-  XSYMBOL (symbol)->u.s.val.value = symbol;
-  make_symbol_constant (symbol);
-
-  /* Mark keywords as special.  This makes (let ((:key 'foo)) ...)
-     in lexically bound elisp signal an error, as documented.  */
-  XSYMBOL (symbol)->u.s.declared_special = true;
-
-  pkg_add_symbol (symbol, Vkeyword_package);
-  return symbol;
-}
-
 /* Add SYMBOL to PACKAGE's shadowing symbols, if not already
    present.  */
 
@@ -505,9 +493,10 @@ symbol_and_status (Lisp_Object symbol, Lisp_Object package)
    Otherwise, add a new symbol to PACKAGE.  Value is the symbol found
    or newly inserted.  */
 
-static Lisp_Object
+Lisp_Object
 pkg_intern_symbol (const Lisp_Object symbol_or_name, Lisp_Object package)
 {
+  /* PKG-FIXME this symbol_or_name is shit.  */
   eassert (PACKAGEP (package));
 
   const Lisp_Object name
@@ -525,7 +514,7 @@ pkg_intern_symbol (const Lisp_Object symbol_or_name, 
Lisp_Object package)
 
   /* Not found.  If intended as a keyword, add it there. */
   if (EQ (package, Vkeyword_package))
-    return pkg_add_keyword (Fmake_symbol (name));
+    return pkg_intern_keyword (name);
 
   /* Not found, and we have already a symbol, use that symbol.  */
   if (SYMBOLP (symbol_or_name))
@@ -535,25 +524,89 @@ pkg_intern_symbol (const Lisp_Object symbol_or_name, 
Lisp_Object package)
   return pkg_add_symbol (Fmake_symbol (name), package);
 }
 
-bool
-pkg_intern_name_c_string (const char *p, ptrdiff_t len, Lisp_Object *symbol)
+/* Lookup or create a new keyword with name NAME.  */
+
+Lisp_Object
+pkg_intern_keyword (Lisp_Object name)
 {
-  Lisp_Object name = make_unibyte_string (p, len);
-  *symbol = pkg_intern_symbol (name, Vearmuffs_package);
-  return true;
+  eassert (STRINGP (name));
+  eassert (SREF (name, 0) != ':');
+  Lisp_Object keyword = lookup_symbol (name, Vkeyword_package);
+  if (EQ (keyword, Qunbound))
+    {
+      keyword = Fmake_symbol (name);
+      /* Symbol-value of a keyword is itself, and cannot be set.  */
+      XSYMBOL (keyword)->u.s.redirect = SYMBOL_PLAINVAL;
+      XSYMBOL (keyword)->u.s.val.value = keyword;
+      make_symbol_constant (keyword);
+      /* Mark keywords as special.  This makes (let ((:key 'foo)) ...)
+        in lexically bound elisp signal an error, as documented.  */
+      XSYMBOL (keyword)->u.s.declared_special = true;
+      pkg_add_symbol (keyword, Vkeyword_package);
+    }
+  else
+    eassert (EQ (SYMBOL_PACKAGE (keyword), Vkeyword_package));
+
+  return keyword;
 }
 
+/* Define KEYWORD as keyword symbol.  */
+
 Lisp_Object
-pkg_lookup_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes)
+pkg_define_keyword (Lisp_Object keyword)
 {
-  const Lisp_Object name = make_string_from_bytes (ptr, nchars, nbytes);
-  return lookup_symbol (name, Vearmuffs_package);
+  eassert (SYMBOLP (keyword));
+  eassert (!EQ (keyword, Qunbound));
+  eassert (SREF (SYMBOL_NAME (keyword), 0) != ':');
+
+  /* Symbol-value of a keyword is itself, and cannot be set.  */
+  XSYMBOL (keyword)->u.s.redirect = SYMBOL_PLAINVAL;
+  XSYMBOL (keyword)->u.s.val.value = keyword;
+  make_symbol_constant (keyword);
+  /* Mark keywords as special.  This makes (let ((:key 'foo)) ...)
+     in lexically bound elisp signal an error, as documented.  */
+  XSYMBOL (keyword)->u.s.declared_special = true;
+  return pkg_add_symbol (keyword, Vkeyword_package);
 }
 
-void
-pkg_early_intern_symbol (Lisp_Object symbol)
+Lisp_Object
+pkg_define_non_keyword (Lisp_Object symbol)
+{
+  eassert (!EQ (symbol, Qunbound));
+  return pkg_add_symbol (symbol, Vemacs_package);
+}
+
+Lisp_Object
+pkg_intern_non_keyword (Lisp_Object name)
 {
-  pkg_intern_symbol (symbol, Vemacs_package);
+  return pkg_intern_symbol (name, Vearmuffs_package);
+}
+
+Lisp_Object
+pkg_intern_non_keyword_c_string (const char *p, ptrdiff_t len)
+{
+  const Lisp_Object name = make_unibyte_string (p, len);
+  return pkg_intern_non_keyword (name);
+}
+
+Lisp_Object
+pkg_intern_maybe_keyword (Lisp_Object name)
+{
+  CHECK_STRING (name);
+  if (SREF (name, 0) == ':')
+    {
+      const Lisp_Object keyword_name = Fsubstring (name, make_fixnum (1), 
Qnil);
+      return pkg_intern_keyword (keyword_name);
+    }
+  return pkg_intern_non_keyword (name);
+}
+
+Lisp_Object
+pkg_lookup_non_keyword_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t 
nbytes)
+{
+  eassert (*ptr != ':');
+  const Lisp_Object name = make_string_from_bytes (ptr, nchars, nbytes);
+  return lookup_symbol (name, Vearmuffs_package);
 }
 
 static Lisp_Object
@@ -1128,11 +1181,6 @@ init_pkg_once (void)
   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,



reply via email to

[Prev in Thread] Current Thread [Next in Thread]