First commit of scratch/correct-warning-pos.

This branch is intended to generate correct position information in warning
and error messages from the byte compiler, and is intended thereby to fix bugs

It introduces a new mechanism, the symbol with position.  This is taken over
from the previous git branch scratch/accurate-warning-pos which was abandoned
for being too slow.  The main difference in the current branch is that the
symbol `nil' is never given a position, thus speeding up NILP markedly.

* lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand)
(byte-optimize-form-code-walker, byte-optimize-let-form, byte-optimize-while)
(byte-optimize-apply): Use byte-compile-warn-x in place of byte-compile-warn.

* lisp/emacs-lisp/bytecomp.el (byte-compile--form-stack): New variable.
(byte-compile-strip-s-p-1, byte-compile-strip-symbol-positions): New
functions.
(byte-compile-recurse-toplevel, byte-compile-initial-macro-environment)
(byte-compile-preprocess, byte-compile-macroexpand-declare-function): Bind
print-symbols-bare to non-nil.
(byte-compile--first-symbol, byte-compile--warning-source-offset): New
functions.
(byte-compile-warning-prefix): Modify to output two sets of position
information, the old (incorrect) set and the new set.
(byte-compile-warn): Strip positions from symbols before outputting.
(byte-compile-warn-x): New function which outputs a correct position supplied
in an argument.
(byte-compile-warn-obsolete, byte-compile-emit-callargs-warn)
(byte-compile-format-warn, byte-compile-nogroup-warn)
(byte-compile-arglist-warn, byte-compile-docstring-length-warn)
(byte-compile-warn-about-unresolved-functions, byte-compile-file)
(byte-compile--check-prefixed-var, byte-compile--declare-var)
(byte-compile-file-form-defvar-function, byte-compile-file-form-defmumble)
(byte-compile-check-lambda-list, byte-compile--warn-lexical-dynamic)
(byte-compile-lambda, byte-compile-form, byte-compile-normal-call)
(byte-compile-check-variable, byte-compile-free-vars-warn)
(byte-compile-subr-wrong-args, byte-compile-fset, byte-compile-set-default)
(byte-compile-condition-case, byte-compile-save-excursion)
(byte-compile-defvar, byte-compile-autoload)
(byte-compile-make-variable-buffer-local, byte-compile-define-symbol-prop)
(byte-compile-define-keymap): Replace byte-compile-warn with
byte-compile-warn-x.
(byte-compile-file, compile-defun): Bind symbols-with-pos-enabled to non-nil.
(compile-defun, byte-compile-from-buffer): Use `read-positioning-symbols'
rather than plain `read'.
(byte-compile-toplevel-file-form, byte-compile-form): Dynamically bind
byte-compile--form-stack.
(byte-compile-file-form-autoload, byte-compile-file-form-defvar)
(byte-compile-file-form-make-obsolete, byte-compile-lambda)
(byte-compile-push-constant, byte-compile-cond-jump-table)
(byte-compile-define-keymap, byte-compile-annotate-call-tree):
Strip positions from symbols where they are unwanted.
(byte-compile-file-form-defvar): Strip positions from symbols using
`bare-symbol'.
(byte-compile-file-form-defmumble): New variable bare-name, a version of name
without its position.
(byte-compile-lambda): Similarly, new variable bare-arglist.
(byte-compile-free-vars-warn): New argument arg supplying position information
to byte-compile-warn-x.
(byte-compile-push-constant): Manipulation of symbol positions.
(display-call-tree): Strip positions from symbols.

* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use)
(cconv--analyze-function, cconv-analyze-form): Replace use of
byte-compile-warn with byte-compile-warn-x.

* lisp/emacs-lisp/cl-generic.el (cl-defmethod): New variable org-name which
  will supply position information to a new macroexp-warn-and-return.

  * lisp/emacs-lisp/cl-macs.el (cl-macs--strip-s-p-1)
  (cl-macs--strip-symbol-positions): New functions to strip positions from
  symbols in an expression.  These duplicaate similarly named functions in
  bytecomp.el.

  * lisp/emacs-lisp/macroexpand.el (macroexp--warn-wrap): Calls
  byte-compile-warn-x in place of byte-compile-warn.
  (macroexp-warn-and-return): Commented out new position parameter _arg.

* src/.gdbinit: Add in code to handle symbols with position.

* src/alloc.c (XPNTR, set_symbol_name, valid_lisp_object_p, purecopy)
(mark_char_table, mark_object, survives_gc_p, symbol_uses_obj): Use
BARE_SYMBOL_P and XBARE_SYMBOL in place of the former SYMBOLP and XSYMBOL.
(build_symbol_with_pos): New function.
(Fgarbage_collect): Bind Qsymbols_with_pos_enabled to nil around the call to
garbage_collect.

* src/data.c (Ftype_of): Add case for PVEC_SYMBOL_WITH_POS.
(Fbare_symbol_p, Fsymbol_with_pos_p, Fbare_symbol, Fsymbol_with_pos_pos)
(Fposition_symbol): New functions.
(symbols_with_pos_enabled): New boolean variable.

* src/fns.c (internal_equal, hash_lookup): Handle symbols with position.

* src/keyboard.c (recursive_edit_1): Bind Qsymbols_with_pos_enabled and
Qprint_symbols_bare to nil.

* src/lisp.h (lisp_h_PSEUDOVECTORP): New macro.
(lisp_h_BASE_EQ): New name for the former lisp_h_EQ.
(lisp_h_EQ): Extended to handle symbols with position.
(lisp_h_NILP): Now uses BASE_EQ rather than EQ.
(lisp_h_SYMBOL_WITH_POS_P, lisp_h_BARE_SYMBOL_P): New macros.
(lisp_h_SYMBOLP): Redefined to handle symbols with position.
(BARE_SYMBOL_P, BASE_EQ): New macros.
(SYMBOLP (macro)): Removed.
(SYMBOLP (function), XSYMBOL, make_lisp_symbol, builtin_lisp_symbol)
(c_symbol_p): Moved to later in file.
(struct Lisp_Symbol_With_Pos): New data type.
(pvec_type): PVEC_SYMBOL_WITH_POS: New type code.
(PSEUDOVECTORP): Redefined to use the lisp_h_PSEUDOVECTORP.
(BARE_SYMBOL_P, SYMBOL_WITH_POS_P, SYMBOLP, XSYMBOL_WITH_POS, XBARE_SYMBOL)
(XSYMBOL, make_lisp_symbol, builtin_lisp_symbol, c_symbol_p, CHECK_SYMBOL)
(BASE_EQ): New functions, or functions moved from earlier in the file.
(SYMBOL_WITH_POS_SYM, SYMBOL_WITH_POS_POS): New INLINE functions.

* src/lread.c (read0, read1, read_list, read_vector, read_internal_start)
(list2): Add a new bool parameter locate_syms.
(Fread_positioning_symbols): New function.
(Fread_from_string, read_internal_start, read0, read1, read_list): Pass around
suitable values for locate_syms.
(read1): Build symbols with position when locate_syms is true.

* src/print.c (print_vectorlike): Add handling for PVEC_SYMBOL_WITH_POS.
(print_object): Replace EQ with BASE_EQ.
(print_symbols_bare): New boolean variable.

1 files changed, 29 insertions, 11 deletions

diff --git a/src/alloc.c b/src/alloc.c
index f8908c91dba..0d69f23048a 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -591,7 +591,7 @@ pointer_align (void *ptr, int alignment)
 static ATTRIBUTE_NO_SANITIZE_UNDEFINED void *
 XPNTR (Lisp_Object a)
 {
-  return (SYMBOLP (a)
+  return (BARE_SYMBOL_P (a)
           ? (char *) lispsym + (XLI (a) - LISP_WORD_TAG (Lisp_Symbol))
           : (char *) XLP (a) - (XLI (a) & ~VALMASK));
 }
@@ -3598,13 +3598,13 @@ static struct Lisp_Symbol *symbol_free_list;
 static void
 set_symbol_name (Lisp_Object sym, Lisp_Object name)
 {
-  XSYMBOL (sym)->u.s.name = name;
+  XBARE_SYMBOL (sym)->u.s.name = name;
 }
 
 void
 init_symbol (Lisp_Object val, Lisp_Object name)
 {
-  struct Lisp_Symbol *p = XSYMBOL (val);
+  struct Lisp_Symbol *p = XBARE_SYMBOL (val);
   set_symbol_name (val, name);
   set_symbol_plist (val, Qnil);
   p->u.s.redirect = SYMBOL_PLAINVAL;
@@ -3667,6 +3667,21 @@ make_misc_ptr (void *a)
   return make_lisp_ptr (p, Lisp_Vectorlike);
 }
 
+/* Return a new symbol with position with the specified SYMBOL and POSITION. */
+Lisp_Object
+build_symbol_with_pos (Lisp_Object symbol, Lisp_Object position)
+{
+  Lisp_Object val;
+  struct Lisp_Symbol_With_Pos *p
+    = (struct Lisp_Symbol_With_Pos *) allocate_vector (2);
+  XSETVECTOR (val, p);
+  XSETPVECTYPESIZE (XVECTOR (val), PVEC_SYMBOL_WITH_POS, 2, 0);
+  p->sym = symbol;
+  p->pos = position;
+
+  return val;
+}
+
 /* Return a new overlay with specified START, END and PLIST.  */
 
 Lisp_Object
@@ -5210,7 +5225,7 @@ valid_lisp_object_p (Lisp_Object obj)
   if (PURE_P (p))
     return 1;
 
-  if (SYMBOLP (obj) && c_symbol_p (p))
+  if (BARE_SYMBOL_P (obj) && c_symbol_p (p))
     return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0;
 
   if (p == &buffer_defaults || p == &buffer_local_symbols)
@@ -5638,12 +5653,12 @@ purecopy (Lisp_Object obj)
         vec->contents[i] = purecopy (vec->contents[i]);
       XSETVECTOR (obj, vec);
     }
-  else if (SYMBOLP (obj))
+  else if (BARE_SYMBOL_P (obj))
     {
-      if (!XSYMBOL (obj)->u.s.pinned && !c_symbol_p (XSYMBOL (obj)))
+      if (!XBARE_SYMBOL (obj)->u.s.pinned && !c_symbol_p (XBARE_SYMBOL (obj)))
         { /* We can't purify them, but they appear in many pure objects.
              Mark them as `pinned' so we know to mark them at every GC cycle.  */
-          XSYMBOL (obj)->u.s.pinned = true;
+          XBARE_SYMBOL (obj)->u.s.pinned = true;
           symbol_block_pinned = symbol_block;
         }
       /* Don't hash-cons it.  */
@@ -6268,7 +6283,10 @@ For further details, see Info node `(elisp)Garbage Collection'.  */)
   if (garbage_collection_inhibited)
     return Qnil;
 
+  ptrdiff_t count = SPECPDL_INDEX ();
+  specbind (Qsymbols_with_pos_enabled, Qnil);
   garbage_collect ();
+  unbind_to (count, Qnil);
   struct gcstat gcst = gcstat;
 
   Lisp_Object total[] = {
@@ -6407,7 +6425,7 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype)
       Lisp_Object val = ptr->contents[i];
 
       if (FIXNUMP (val) ||
-          (SYMBOLP (val) && symbol_marked_p (XSYMBOL (val))))
+          (BARE_SYMBOL_P (val) && symbol_marked_p (XBARE_SYMBOL (val))))
         continue;
       if (SUB_CHAR_TABLE_P (val))
         {
@@ -6809,7 +6827,7 @@ mark_object (Lisp_Object arg)
 
     case Lisp_Symbol:
       {
-        struct Lisp_Symbol *ptr = XSYMBOL (obj);
+        struct Lisp_Symbol *ptr = XBARE_SYMBOL (obj);
       nextsym:
         if (symbol_marked_p (ptr))
           break;
@@ -6930,7 +6948,7 @@ survives_gc_p (Lisp_Object obj)
       break;
 
     case Lisp_Symbol:
-      survives_p = symbol_marked_p (XSYMBOL (obj));
+      survives_p = symbol_marked_p (XBARE_SYMBOL (obj));
       break;
 
     case Lisp_String:
@@ -7347,7 +7365,7 @@ arenas.  */)
 static bool
 symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj)
 {
-  struct Lisp_Symbol *sym = XSYMBOL (symbol);
+  struct Lisp_Symbol *sym = XBARE_SYMBOL (symbol);
   Lisp_Object val = find_symbol_value (symbol);
   return (EQ (val, obj)
           || EQ (sym->u.s.function, obj)