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.

8 files changed, 398 insertions, 124 deletions

diff --git a/src/.gdbinit b/src/.gdbinit
index f74e295f7ea..9f2a86b779d 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -746,6 +746,15 @@ Print $ as a overlay pointer.
 This command assumes that $ is an Emacs Lisp overlay value.
 end
 
+define xsymwithpos
+  xgetptr $
+  print (struct Lisp_Symbol_With_Pos *) $ptr
+end
+document xsymwithpos
+Print $ as a symbol with position.
+This command assumes that $ is an Emacs Lisp symbol with position value.
+end
+
 define xsymbol
   set $sym = $
   xgetsym $sym
@@ -1011,6 +1020,9 @@ define xpr
       if $vec == PVEC_OVERLAY
         xoverlay
       end
+      if $vec == PVEC_SYMBOL_WITH_POS
+        xsymwithpos
+      end
       if $vec == PVEC_PROCESS
         xprocess
       end
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)
diff --git a/src/data.c b/src/data.c
index 0d3376f0903..b3b157a7f39 100644
--- a/src/data.c
+++ b/src/data.c
@@ -216,6 +216,7 @@ for example, (type-of 1) returns `integer'.  */)
         case PVEC_NORMAL_VECTOR: return Qvector;
         case PVEC_BIGNUM: return Qinteger;
         case PVEC_MARKER: return Qmarker;
+        case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos;
         case PVEC_OVERLAY: return Qoverlay;
         case PVEC_FINALIZER: return Qfinalizer;
         case PVEC_USER_PTR: return Quser_ptr;
@@ -316,6 +317,26 @@ DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
   return Qt;
 }
 
+DEFUN ("bare-symbol-p", Fbare_symbol_p, Sbare_symbol_p, 1, 1, 0,
+       doc: /* Return t if OBJECT is a symbol, but not a symbol together with position.  */
+       attributes: const)
+  (Lisp_Object object)
+{
+  if (BARE_SYMBOL_P (object))
+    return Qt;
+  return Qnil;
+}
+
+DEFUN ("symbol-with-pos-p", Fsymbol_with_pos_p, Ssymbol_with_pos_p, 1, 1, 0,
+       doc: /* Return t if OBJECT is a symbol together with position.  */
+       attributes: const)
+  (Lisp_Object object)
+{
+  if (SYMBOL_WITH_POS_P (object))
+    return Qt;
+  return Qnil;
+}
+
 DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
        doc: /* Return t if OBJECT is a symbol.  */
        attributes: const)
@@ -753,6 +774,51 @@ DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
   return name;
 }
 
+DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0,
+       doc: /* Extract, if need be, the bare symbol from SYM, a symbol.  */)
+       (register Lisp_Object sym)
+{
+  if (BARE_SYMBOL_P (sym))
+    return sym;
+  /* Type checking is done in the following macro. */
+  return SYMBOL_WITH_POS_SYM (sym);
+}
+
+DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0,
+       doc: /* Extract the position from a symbol with position.  */)
+       (register Lisp_Object ls)
+{
+  /* Type checking is done in the following macro. */
+  return SYMBOL_WITH_POS_POS (ls);
+}
+
+DEFUN ("position-symbol", Fposition_symbol, Sposition_symbol, 2, 2, 0,
+       doc: /* Create a new symbol with position.
+SYM is a symbol, with or without position, the symbol to position.
+POS, the position, is either a fixnum or a symbol with position from which
+the position will be taken.  */)
+     (register Lisp_Object sym, register Lisp_Object pos)
+{
+  Lisp_Object bare;
+  Lisp_Object position;
+
+  if (BARE_SYMBOL_P (sym))
+    bare = sym;
+  else if (SYMBOL_WITH_POS_P (sym))
+    bare = XSYMBOL_WITH_POS (sym)->sym;
+  else
+    wrong_type_argument (Qsymbolp, sym);
+
+  if (FIXNUMP (pos))
+    position = pos;
+  else if (SYMBOL_WITH_POS_P (pos))
+    position = XSYMBOL_WITH_POS (pos)->pos;
+  else
+    wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos);
+
+  return build_symbol_with_pos (bare, position);
+}
+
 DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
        doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.  */)
   (register Lisp_Object symbol, Lisp_Object definition)
@@ -3929,6 +3995,8 @@ syms_of_data (void)
 
   DEFSYM (Qlistp, "listp");
   DEFSYM (Qconsp, "consp");
+  DEFSYM (Qbare_symbol_p, "bare-symbol-p");
+  DEFSYM (Qsymbol_with_pos_p, "symbol-with-pos-p");
   DEFSYM (Qsymbolp, "symbolp");
   DEFSYM (Qfixnump, "fixnump");
   DEFSYM (Qintegerp, "integerp");
@@ -3954,6 +4022,7 @@ syms_of_data (void)
 
   DEFSYM (Qchar_table_p, "char-table-p");
   DEFSYM (Qvector_or_char_table_p, "vector-or-char-table-p");
+  DEFSYM (Qfixnum_or_symbol_with_pos_p, "fixnum-or-symbol-with-pos-p");
 
   DEFSYM (Qsubrp, "subrp");
   DEFSYM (Qunevalled, "unevalled");
@@ -4038,6 +4107,7 @@ syms_of_data (void)
   DEFSYM (Qstring, "string");
   DEFSYM (Qcons, "cons");
   DEFSYM (Qmarker, "marker");
+  DEFSYM (Qsymbol_with_pos, "symbol-with-pos");
   DEFSYM (Qoverlay, "overlay");
   DEFSYM (Qfinalizer, "finalizer");
   DEFSYM (Qmodule_function, "module-function");
@@ -4089,6 +4159,8 @@ syms_of_data (void)
   defsubr (&Snumber_or_marker_p);
   defsubr (&Sfloatp);
   defsubr (&Snatnump);
+  defsubr (&Sbare_symbol_p);
+  defsubr (&Ssymbol_with_pos_p);
   defsubr (&Ssymbolp);
   defsubr (&Skeywordp);
   defsubr (&Sstringp);
@@ -4119,6 +4191,9 @@ syms_of_data (void)
   defsubr (&Sindirect_function);
   defsubr (&Ssymbol_plist);
   defsubr (&Ssymbol_name);
+  defsubr (&Sbare_symbol);
+  defsubr (&Ssymbol_with_pos_pos);
+  defsubr (&Sposition_symbol);
   defsubr (&Smakunbound);
   defsubr (&Sfmakunbound);
   defsubr (&Sboundp);
@@ -4201,6 +4276,12 @@ This variable cannot be set; trying to do so will signal an error.  */);
   Vmost_negative_fixnum = make_fixnum (MOST_NEGATIVE_FIXNUM);
   make_symbol_constant (intern_c_string ("most-negative-fixnum"));
 
+  DEFSYM (Qsymbols_with_pos_enabled, "symbols-with-pos-enabled");
+  DEFVAR_BOOL ("symbols-with-pos-enabled", symbols_with_pos_enabled,
+               doc: /* Non-nil when "symbols with position" can be used as symbols.
+Bind this to non-nil in applications such as the byte compiler.  */);
+  symbols_with_pos_enabled = false;
+
   DEFSYM (Qwatchers, "watchers");
   DEFSYM (Qmakunbound, "makunbound");
   DEFSYM (Qunlet, "unlet");
diff --git a/src/fns.c b/src/fns.c
index 76c76c92ba9..43df40aa9ed 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2569,6 +2569,13 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
         }
     }
 
+  /* A symbol with position compares the contained symbol, and is
+     `equal' to the corresponding ordinary symbol.  */
+  if (SYMBOL_WITH_POS_P (o1))
+    o1 = SYMBOL_WITH_POS_SYM (o1);
+  if (SYMBOL_WITH_POS_P (o2))
+    o2 = SYMBOL_WITH_POS_SYM (o2);
+
   if (EQ (o1, o2))
     return true;
   if (XTYPE (o1) != XTYPE (o2))
@@ -4479,7 +4486,10 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash)
 {
   ptrdiff_t start_of_bucket, i;
 
-  Lisp_Object hash_code = h->test.hashfn (key, h);
+  Lisp_Object hash_code;
+  if (SYMBOL_WITH_POS_P (key))
+    key = SYMBOL_WITH_POS_SYM (key);
+  hash_code = h->test.hashfn (key, h);
   if (hash)
     *hash = hash_code;
 
diff --git a/src/keyboard.c b/src/keyboard.c
index c98175aea0d..050537b95cf 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -688,6 +688,8 @@ recursive_edit_1 (void)
     {
       specbind (Qstandard_output, Qt);
       specbind (Qstandard_input, Qt);
+      specbind (Qsymbols_with_pos_enabled, Qnil);
+      specbind (Qprint_symbols_bare, Qnil);
     }
 
 #ifdef HAVE_WINDOW_SYSTEM
diff --git a/src/lisp.h b/src/lisp.h
index 19caba40014..08013e94d16 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -364,18 +364,38 @@ typedef EMACS_INT Lisp_Word;
 # endif
 #endif
 
+#define lisp_h_PSEUDOVECTORP(a,code)                            \
+  (lisp_h_VECTORLIKEP((a)) &&                                   \
+   ((XUNTAG ((a), Lisp_Vectorlike, union vectorlike_header)->size       \
+     & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))                    \
+    == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))))
+
 #define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x)
 #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
 #define lisp_h_CHECK_TYPE(ok, predicate, x) \
    ((ok) ? (void) 0 : wrong_type_argument (predicate, x))
 #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons)
-#define lisp_h_EQ(x, y) (XLI (x) == XLI (y))
+#define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y))
+/* #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) */
+
+#define lisp_h_EQ(x, y) ((XLI ((x)) == XLI ((y)))       \
+  || (symbols_with_pos_enabled    \
+  && (SYMBOL_WITH_POS_P ((x))                        \
+      ? BARE_SYMBOL_P ((y))                               \
+        ? (XSYMBOL_WITH_POS((x)))->sym == (y)          \
+        : SYMBOL_WITH_POS_P((y))                       \
+          && ((XSYMBOL_WITH_POS((x)))->sym                   \
+              == (XSYMBOL_WITH_POS((y)))->sym)               \
+      : (SYMBOL_WITH_POS_P ((y))                     \
+         && BARE_SYMBOL_P ((x))                           \
+         && ((x) == ((XSYMBOL_WITH_POS ((y)))->sym))))))
+
 #define lisp_h_FIXNUMP(x) \
    (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \
         - (unsigned) (Lisp_Int0 >> !USE_LSB_TAG)) \
        & ((1 << INTTYPEBITS) - 1)))
 #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float)
-#define lisp_h_NILP(x) EQ (x, Qnil)
+#define lisp_h_NILP(x) /* x == Qnil */ /* ((XLI (x) == XLI (Qnil))) */ /* EQ (x, Qnil) */ BASE_EQ (x, Qnil)
 #define lisp_h_SET_SYMBOL_VAL(sym, v) \
    (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \
     (sym)->u.s.val.value = (v))
@@ -384,7 +404,10 @@ typedef EMACS_INT Lisp_Word;
 #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
 #define lisp_h_SYMBOL_VAL(sym) \
    (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
-#define lisp_h_SYMBOLP(x) TAGGEDP (x, Lisp_Symbol)
+#define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP ((x), PVEC_SYMBOL_WITH_POS)
+#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP ((x), Lisp_Symbol)
+#define lisp_h_SYMBOLP(x) ((BARE_SYMBOL_P ((x)) ||               \
+                            (symbols_with_pos_enabled && (SYMBOL_WITH_POS_P ((x))))))
 #define lisp_h_TAGGEDP(a, tag) \
    (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
         - (unsigned) (tag)) \
@@ -429,11 +452,12 @@ typedef EMACS_INT Lisp_Word;
 # define XLI(o) lisp_h_XLI (o)
 # define XIL(i) lisp_h_XIL (i)
 # define XLP(o) lisp_h_XLP (o)
+# define BARE_SYMBOL_P(x) lisp_h_BARE_SYMBOL_P (x)
 # define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x)
 # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
 # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
 # define CONSP(x) lisp_h_CONSP (x)
-# define EQ(x, y) lisp_h_EQ (x, y)
+# define BASE_EQ(x, y) lisp_h_BASE_EQ (x, y)
 # define FLOATP(x) lisp_h_FLOATP (x)
 # define FIXNUMP(x) lisp_h_FIXNUMP (x)
 # define NILP(x) lisp_h_NILP (x)
@@ -441,7 +465,7 @@ typedef EMACS_INT Lisp_Word;
 # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
 # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
 # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
-# define SYMBOLP(x) lisp_h_SYMBOLP (x)
+/* # define SYMBOLP(x) lisp_h_SYMBOLP (x) */ /* X is accessed more than once. */
 # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag)
 # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
 # define XCAR(c) lisp_h_XCAR (c)
@@ -600,6 +624,7 @@ extern Lisp_Object char_table_ref (Lisp_Object, int) ATTRIBUTE_PURE;
 extern void char_table_set (Lisp_Object, int, Lisp_Object);
 
 /* Defined in data.c.  */
+extern bool symbols_with_pos_enabled;
 extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
 extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object);
 extern Lisp_Object default_value (Lisp_Object symbol);
@@ -984,57 +1009,12 @@ union vectorlike_header
     ptrdiff_t size;
   };
 
-INLINE bool
-(SYMBOLP) (Lisp_Object x)
-{
-  return lisp_h_SYMBOLP (x);
-}
-
-INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
-XSYMBOL (Lisp_Object a)
-{
-  eassert (SYMBOLP (a));
-  intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol);
-  void *p = (char *) lispsym + i;
-  return p;
-}
-
-INLINE Lisp_Object
-make_lisp_symbol (struct Lisp_Symbol *sym)
-{
-  /* GCC 7 x86-64 generates faster code if lispsym is
-     cast to char * rather than to intptr_t.  */
-  char *symoffset = (char *) ((char *) sym - (char *) lispsym);
-  Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset);
-  eassert (XSYMBOL (a) == sym);
-  return a;
-}
-
-INLINE Lisp_Object
-builtin_lisp_symbol (int index)
-{
-  return make_lisp_symbol (&lispsym[index]);
-}
-
-INLINE bool
-c_symbol_p (struct Lisp_Symbol *sym)
+struct Lisp_Symbol_With_Pos
 {
-  char *bp = (char *) lispsym;
-  char *sp = (char *) sym;
-  if (PTRDIFF_MAX < INTPTR_MAX)
-    return bp <= sp && sp < bp + sizeof lispsym;
-  else
-    {
-      ptrdiff_t offset = sp - bp;
-      return 0 <= offset && offset < sizeof lispsym;
-    }
-}
-
-INLINE void
-(CHECK_SYMBOL) (Lisp_Object x)
-{
-  lisp_h_CHECK_SYMBOL (x);
-}
+  union vectorlike_header header;
+  Lisp_Object sym;              /* A symbol */
+  Lisp_Object pos;              /* A fixnum */
+} GCALIGNED_STRUCT;
 
 /* In the size word of a vector, this bit means the vector has been marked.  */
 
@@ -1059,6 +1039,7 @@ enum pvec_type
   PVEC_MARKER,
   PVEC_OVERLAY,
   PVEC_FINALIZER,
+  PVEC_SYMBOL_WITH_POS,
   PVEC_MISC_PTR,
   PVEC_USER_PTR,
   PVEC_PROCESS,
@@ -1117,6 +1098,92 @@ enum More_Lisp_Bits
    values.  They are macros for use in #if and static initializers.  */
 #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
 #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
+
+INLINE bool
+PSEUDOVECTORP (Lisp_Object a, int code)
+{
+  return lisp_h_PSEUDOVECTORP (a, code);
+}
+
+INLINE bool
+(BARE_SYMBOL_P) (Lisp_Object x)
+{
+  return lisp_h_BARE_SYMBOL_P (x);
+}
+
+INLINE bool
+(SYMBOL_WITH_POS_P) (Lisp_Object x)
+{
+  return lisp_h_SYMBOL_WITH_POS_P (x);
+}
+
+INLINE bool
+(SYMBOLP) (Lisp_Object x)
+{
+  return lisp_h_SYMBOLP (x);
+}
+
+INLINE struct Lisp_Symbol_With_Pos *
+XSYMBOL_WITH_POS (Lisp_Object a)
+{
+    eassert (SYMBOL_WITH_POS_P (a));
+    return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos);
+}
+
+INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
+(XBARE_SYMBOL) (Lisp_Object a)
+{
+  eassert (BARE_SYMBOL_P (a));
+  intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol);
+  void *p = (char *) lispsym + i;
+  return p;
+}
+
+INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
+(XSYMBOL) (Lisp_Object a)
+{
+  eassert (SYMBOLP ((a)));
+  if (!symbols_with_pos_enabled || BARE_SYMBOL_P (a))
+    return XBARE_SYMBOL (a);
+  return XBARE_SYMBOL (XSYMBOL_WITH_POS (a)->sym);
+}
+
+INLINE Lisp_Object
+make_lisp_symbol (struct Lisp_Symbol *sym)
+{
+  /* GCC 7 x86-64 generates faster code if lispsym is
+     cast to char * rather than to intptr_t.  */
+  char *symoffset = (char *) ((char *) sym - (char *) lispsym);
+  Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset);
+  eassert (XSYMBOL (a) == sym);
+  return a;
+}
+
+INLINE Lisp_Object
+builtin_lisp_symbol (int index)
+{
+  return make_lisp_symbol (&lispsym[index]);
+}
+
+INLINE bool
+c_symbol_p (struct Lisp_Symbol *sym)
+{
+  char *bp = (char *) lispsym;
+  char *sp = (char *) sym;
+  if (PTRDIFF_MAX < INTPTR_MAX)
+    return bp <= sp && sp < bp + sizeof lispsym;
+  else
+    {
+      ptrdiff_t offset = sp - bp;
+      return 0 <= offset && offset < sizeof lispsym;
+    }
+}
+
+INLINE void
+(CHECK_SYMBOL) (Lisp_Object x)
+{
+  lisp_h_CHECK_SYMBOL (x);
+}
 
 /* True if the possibly-unsigned integer I doesn't fit in a fixnum.  */
 
@@ -1248,7 +1315,14 @@ make_fixed_natnum (EMACS_INT n)
 }
 
 /* Return true if X and Y are the same object.  */
+INLINE bool
+(BASE_EQ) (Lisp_Object x, Lisp_Object y)
+{
+  return lisp_h_BASE_EQ (x, y);
+}
 
+/* Return true if X and Y are the same object, reckoning a symbol with
+   position as being the same as the bare symbol.  */
 INLINE bool
 (EQ) (Lisp_Object x, Lisp_Object y)
 {
@@ -1714,21 +1788,6 @@ PSEUDOVECTOR_TYPEP (const union vectorlike_header *a, enum pvec_type code)
           == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)));
 }
 
-/* True if A is a pseudovector whose code is CODE.  */
-INLINE bool
-PSEUDOVECTORP (Lisp_Object a, int code)
-{
-  if (! VECTORLIKEP (a))
-    return false;
-  else
-    {
-      /* Converting to union vectorlike_header * avoids aliasing issues.  */
-      return PSEUDOVECTOR_TYPEP (XUNTAG (a, Lisp_Vectorlike,
-                                         union vectorlike_header),
-                                 code);
-    }
-}
-
 /* A boolvector is a kind of vectorlike, with contents like a string.  */
 
 struct Lisp_Bool_Vector
@@ -2627,6 +2686,22 @@ XOVERLAY (Lisp_Object a)
   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay);
 }
 
+INLINE Lisp_Object
+SYMBOL_WITH_POS_SYM (Lisp_Object a)
+{
+  if (!SYMBOL_WITH_POS_P (a))
+    wrong_type_argument (Qsymbol_with_pos_p, a);
+  return XSYMBOL_WITH_POS (a)->sym;
+}
+
+INLINE Lisp_Object
+SYMBOL_WITH_POS_POS (Lisp_Object a)
+{
+  if (!SYMBOL_WITH_POS_P (a))
+    wrong_type_argument (Qsymbol_with_pos_p, a);
+  return XSYMBOL_WITH_POS (a)->pos;
+}
+
 INLINE bool
 USER_PTRP (Lisp_Object x)
 {
@@ -4030,6 +4105,7 @@ extern bool gc_in_progress;
 extern Lisp_Object make_float (double);
 extern void display_malloc_warning (void);
 extern ptrdiff_t inhibit_garbage_collection (void);
+extern Lisp_Object build_symbol_with_pos (Lisp_Object, Lisp_Object);
 extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
 extern void free_cons (struct Lisp_Cons *);
 extern void init_alloc_once (void);
diff --git a/src/lread.c b/src/lread.c
index 2e63ec48912..7775911c1d3 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -647,12 +647,12 @@ struct subst
 };
 
 static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
-                                        Lisp_Object);
-static Lisp_Object read0 (Lisp_Object);
-static Lisp_Object read1 (Lisp_Object, int *, bool);
+                                        Lisp_Object, bool);
+static Lisp_Object read0 (Lisp_Object, bool);
+static Lisp_Object read1 (Lisp_Object, int *, bool, bool);
 
-static Lisp_Object read_list (bool, Lisp_Object);
-static Lisp_Object read_vector (Lisp_Object, bool);
+static Lisp_Object read_list (bool, Lisp_Object, bool);
+static Lisp_Object read_vector (Lisp_Object, bool, bool);
 
 static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
 static void substitute_in_interval (INTERVAL, void *);
@@ -2280,7 +2280,7 @@ readevalloop (Lisp_Object readcharfun,
                              Qnil, false);
       if (!NILP (Vpurify_flag) && c == '(')
         {
-          val = read_list (0, readcharfun);
+          val = read_list (0, readcharfun, false);
         }
       else
         {
@@ -2302,7 +2302,7 @@ readevalloop (Lisp_Object readcharfun,
           else if (! NILP (Vload_read_function))
             val = call1 (Vload_read_function, readcharfun);
           else
-            val = read_internal_start (readcharfun, Qnil, Qnil);
+            val = read_internal_start (readcharfun, Qnil, Qnil, false);
         }
       /* Empty hashes can be reused; otherwise, reset on next call.  */
       if (HASH_TABLE_P (read_objects_map)
@@ -2460,7 +2460,35 @@ STREAM or the value of `standard-input' may be:
     return call1 (intern ("read-minibuffer"),
                   build_string ("Lisp expression: "));
 
-  return read_internal_start (stream, Qnil, Qnil);
+  return read_internal_start (stream, Qnil, Qnil, false);
+}
+
+DEFUN ("read-positioning-symbols", Fread_positioning_symbols,
+       Sread_positioning_symbols, 0, 1, 0,
+       doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
+Convert each occurrence of a symbol into a "symbol with pos" object.
+
+If STREAM is nil, use the value of `standard-input' (which see).
+STREAM or the value of `standard-input' may be:
+ a buffer (read from point and advance it)
+ a marker (read from where it points and advance it)
+ a function (call it with no arguments for each character,
+     call it with a char as argument to push a char back)
+ a string (takes text from string, starting at the beginning)
+ t (read text line using minibuffer and use it, or read from
+    standard input in batch mode).  */)
+  (Lisp_Object stream)
+{
+  if (NILP (stream))
+    stream = Vstandard_input;
+  if (EQ (stream, Qt))
+    stream = Qread_char;
+  if (EQ (stream, Qread_char))
+    /* FIXME: ?! When is this used !?  */
+    return call1 (intern ("read-minibuffer"),
+                  build_string ("Lisp expression: "));
+
+  return read_internal_start (stream, Qnil, Qnil, true);
 }
 
 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
@@ -2476,14 +2504,17 @@ the end of STRING.  */)
   Lisp_Object ret;
   CHECK_STRING (string);
   /* `read_internal_start' sets `read_from_string_index'.  */
-  ret = read_internal_start (string, start, end);
+  ret = read_internal_start (string, start, end, false);
   return Fcons (ret, make_fixnum (read_from_string_index));
 }
 
 /* Function to set up the global context we need in toplevel read
-   calls.  START and END only used when STREAM is a string.  */
+   calls.  START and END only used when STREAM is a string.
+   LOCATE_SYMS true means read symbol occurrences as symbols with
+   position.  */
 static Lisp_Object
-read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
+read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
+                     bool locate_syms)
 {
   Lisp_Object retval;
 
@@ -2523,7 +2554,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
       read_from_string_limit = endval;
     }
 
-  retval = read0 (stream);
+  retval = read0 (stream, locate_syms);
   if (EQ (Vread_with_symbol_positions, Qt)
       || EQ (Vread_with_symbol_positions, stream))
     Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
@@ -2542,12 +2573,12 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
    are not allowed.  */
 
 static Lisp_Object
-read0 (Lisp_Object readcharfun)
+read0 (Lisp_Object readcharfun, bool locate_syms)
 {
   register Lisp_Object val;
   int c;
 
-  val = read1 (readcharfun, &c, 0);
+  val = read1 (readcharfun, &c, 0, locate_syms);
   if (!c)
     return val;
 
@@ -2971,10 +3002,12 @@ read_integer (Lisp_Object readcharfun, int radix,
    in *PCH and the return value is not interesting.  Else, we store
    zero in *PCH and we read and return one lisp object.
 
-   FIRST_IN_LIST is true if this is the first element of a list.  */
+   FIRST_IN_LIST is true if this is the first element of a list.
+   LOCATE_SYMS true means read symbol occurrences as symbols with
+   position.  */
 
 static Lisp_Object
-read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
+read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
 {
   int c;
   bool uninterned_symbol = false;
@@ -2994,10 +3027,10 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
   switch (c)
     {
     case '(':
-      return read_list (0, readcharfun);
+      return read_list (0, readcharfun, locate_syms);
 
     case '[':
-      return read_vector (readcharfun, 0);
+      return read_vector (readcharfun, 0, locate_syms);
 
     case ')':
     case ']':
@@ -3016,7 +3049,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
               /* Accept extended format for hash tables (extensible to
                  other types), e.g.
                  #s(hash-table size 2 test equal data (k1 v1 k2 v2))  */
-              Lisp_Object tmp = read_list (0, readcharfun);
+              Lisp_Object tmp = read_list (0, readcharfun, false);
               Lisp_Object head = CAR_SAFE (tmp);
               Lisp_Object data = Qnil;
               Lisp_Object val = Qnil;
@@ -3105,7 +3138,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
           if (c == '[')
             {
               Lisp_Object tmp;
-              tmp = read_vector (readcharfun, 0);
+              tmp = read_vector (readcharfun, 0, false);
               if (ASIZE (tmp) < CHAR_TABLE_STANDARD_SLOTS)
                 error ("Invalid size char-table");
               XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
@@ -3118,7 +3151,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
                 {
                   /* Sub char-table can't be read as a regular
                      vector because of a two C integer fields.  */
-                  Lisp_Object tbl, tmp = read_list (1, readcharfun);
+                  Lisp_Object tbl, tmp = read_list (1, readcharfun, false);
                   ptrdiff_t size = list_length (tmp);
                   int i, depth, min_char;
                   struct Lisp_Cons *cell;
@@ -3156,7 +3189,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
       if (c == '&')
         {
           Lisp_Object length;
-          length = read1 (readcharfun, pch, first_in_list);
+          length = read1 (readcharfun, pch, first_in_list, false);
           c = READCHAR;
           if (c == '"')
             {
@@ -3165,7 +3198,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
               unsigned char *data;
 
               UNREAD (c);
-              tmp = read1 (readcharfun, pch, first_in_list);
+              tmp = read1 (readcharfun, pch, first_in_list, false);
               if (STRING_MULTIBYTE (tmp)
                   || (size_in_chars != SCHARS (tmp)
                       /* We used to print 1 char too many
@@ -3193,7 +3226,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
              build them using function calls.  */
           Lisp_Object tmp;
           struct Lisp_Vector *vec;
-          tmp = read_vector (readcharfun, 1);
+          tmp = read_vector (readcharfun, 1, locate_syms);
           vec = XVECTOR (tmp);
           if (! (COMPILED_STACK_DEPTH < ASIZE (tmp)
                  && (FIXNUMP (AREF (tmp, COMPILED_ARGLIST))
@@ -3243,7 +3276,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
           int ch;
 
           /* Read the string itself.  */
-          tmp = read1 (readcharfun, &ch, 0);
+          tmp = read1 (readcharfun, &ch, 0, false);
           if (ch != 0 || !STRINGP (tmp))
             invalid_syntax ("#", readcharfun);
           /* Read the intervals and their properties.  */
@@ -3251,14 +3284,14 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
             {
               Lisp_Object beg, end, plist;
 
-              beg = read1 (readcharfun, &ch, 0);
+              beg = read1 (readcharfun, &ch, 0, false);
               end = plist = Qnil;
               if (ch == ')')
                 break;
               if (ch == 0)
-                end = read1 (readcharfun, &ch, 0);
+                end = read1 (readcharfun, &ch, 0, false);
               if (ch == 0)
-                plist = read1 (readcharfun, &ch, 0);
+                plist = read1 (readcharfun, &ch, 0, false);
               if (ch)
                 invalid_syntax ("Invalid string property list", readcharfun);
               Fset_text_properties (beg, end, plist, tmp);
@@ -3369,7 +3402,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
       if (c == '$')
         return Vload_file_name;
       if (c == '\'')
-        return list2 (Qfunction, read0 (readcharfun));
+        return list2 (Qfunction, read0 (readcharfun, locate_syms));
       /* #:foo is the uninterned symbol named foo.  */
       if (c == ':')
         {
@@ -3452,7 +3485,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
                         hash_put (h, number, placeholder, hash);
 
                       /* Read the object itself.  */
-                      Lisp_Object tem = read0 (readcharfun);
+                      Lisp_Object tem = read0 (readcharfun, locate_syms);
 
                       /* If it can be recursive, remember it for
                          future substitutions.  */
@@ -3508,6 +3541,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
       else if (c == 'b' || c == 'B')
         return read_integer (readcharfun, 2, stackbuf);
 
+      char acm_buf[15];         /* FIXME!!! 2021-11-27. */
+      sprintf (acm_buf, "#%c", c);
+      invalid_syntax (acm_buf, readcharfun);
       UNREAD (c);
       invalid_syntax ("#", readcharfun);
 
@@ -3516,10 +3552,10 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
       goto retry;
 
     case '\'':
-      return list2 (Qquote, read0 (readcharfun));
+      return list2 (Qquote, read0 (readcharfun, locate_syms));
 
     case '`':
-      return list2 (Qbackquote, read0 (readcharfun));
+      return list2 (Qbackquote, read0 (readcharfun, locate_syms));
 
     case ',':
       {
@@ -3535,7 +3571,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
             comma_type = Qcomma;
           }
 
-        value = read0 (readcharfun);
+        value = read0 (readcharfun, locate_syms);
         return list2 (comma_type, value);
       }
     case '?':
@@ -3842,6 +3878,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
                   result = intern_driver (name, obarray, tem);
                 }
             }
+          if (locate_syms
+              && !NILP (result)
+              )
+            result = build_symbol_with_pos (result,
+                                            make_fixnum (start_position));
 
           if (EQ (Vread_with_symbol_positions, Qt)
               || EQ (Vread_with_symbol_positions, readcharfun))
@@ -4100,9 +4141,9 @@ string_to_number (char const *string, int base, ptrdiff_t *plen)
 
 
 static Lisp_Object
-read_vector (Lisp_Object readcharfun, bool bytecodeflag)
+read_vector (Lisp_Object readcharfun, bool bytecodeflag, bool locate_syms)
 {
-  Lisp_Object tem = read_list (1, readcharfun);
+  Lisp_Object tem = read_list (1, readcharfun, locate_syms);
   ptrdiff_t size = list_length (tem);
   Lisp_Object vector = make_nil_vector (size);
 
@@ -4174,10 +4215,12 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag)
   return vector;
 }
 
-/* FLAG means check for ']' to terminate rather than ')' and '.'.  */
+/* FLAG means check for ']' to terminate rather than ')' and '.'.
+   LOCATE_SYMS true means read symbol occurrencess as symbols with
+   position. */
 
 static Lisp_Object
-read_list (bool flag, Lisp_Object readcharfun)
+read_list (bool flag, Lisp_Object readcharfun, bool locate_syms)
 {
   Lisp_Object val, tail;
   Lisp_Object elt, tem;
@@ -4195,7 +4238,7 @@ read_list (bool flag, Lisp_Object readcharfun)
   while (1)
     {
       int ch;
-      elt = read1 (readcharfun, &ch, first_in_list);
+      elt = read1 (readcharfun, &ch, first_in_list, locate_syms);
 
       first_in_list = 0;
 
@@ -4239,10 +4282,10 @@ read_list (bool flag, Lisp_Object readcharfun)
           if (ch == '.')
             {
               if (!NILP (tail))
-                XSETCDR (tail, read0 (readcharfun));
+                XSETCDR (tail, read0 (readcharfun, locate_syms));
               else
-                val = read0 (readcharfun);
-              read1 (readcharfun, &ch, 0);
+                val = read0 (readcharfun, locate_syms);
+              read1 (readcharfun, &ch, 0, locate_syms);
 
               if (ch == ')')
                 {
@@ -5120,6 +5163,7 @@ void
 syms_of_lread (void)
 {
   defsubr (&Sread);
+  defsubr (&Sread_positioning_symbols);
   defsubr (&Sread_from_string);
   defsubr (&Slread__substitute_object_in_subtree);
   defsubr (&Sintern);
diff --git a/src/print.c b/src/print.c
index adadb289de0..eb0fe591b85 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1416,6 +1416,30 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
       printchar ('>', printcharfun);
       break;
 
+    case PVEC_SYMBOL_WITH_POS:
+      {
+        struct Lisp_Symbol_With_Pos *sp = XSYMBOL_WITH_POS (obj);
+        if (print_symbols_bare)
+          print_object (sp->sym, printcharfun, escapeflag);
+        else
+          {
+            print_c_string ("#<symbol ", printcharfun);
+            if (BARE_SYMBOL_P (sp->sym))
+              print_object (sp->sym, printcharfun, escapeflag);
+            else
+              print_c_string ("NOT A SYMBOL!!", printcharfun);
+            if (FIXNUMP (sp->pos))
+              {
+                print_c_string (" at ", printcharfun);
+                print_object (sp->pos, printcharfun, escapeflag);
+              }
+            else
+              print_c_string (" NOT A POSITION!!", printcharfun);
+            printchar ('>', printcharfun);
+          }
+      }
+      break;
+
     case PVEC_OVERLAY:
       print_c_string ("#<overlay ", printcharfun);
       if (! XMARKER (OVERLAY_START (obj))->buffer)
@@ -1921,7 +1945,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
         error ("Apparently circular structure being printed");
 
       for (i = 0; i < print_depth; i++)
-        if (EQ (obj, being_printed[i]))
+        if (BASE_EQ (obj, being_printed[i]))
           {
             int len = sprintf (buf, "#%d", i);
             strout (buf, len, len, printcharfun);
@@ -2425,6 +2449,13 @@ priorities.  Values other than nil or t are also treated as
 `default'.  */);
   Vprint_charset_text_property = Qdefault;
 
+  DEFVAR_BOOL ("print-symbols-bare", print_symbols_bare,
+               doc: /* A flag to control printing of symbols with position.
+If the value is nil, print these objects complete with position.
+Otherwise print just the bare symbol.  */);
+  print_symbols_bare = false;
+  DEFSYM (Qprint_symbols_bare, "print-symbols-bare");
+
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
   staticpro (&Vprin1_to_string_buffer);