From: Alan Mackenzie <acm@muc.de>
Date: Fri, 23 Nov 2018 12:32:31 +0000 (+0000)
Subject: Bring the scratch/accurate-warning-pos branch to full functionality.
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=75b18e07e57da7ee4362db800352d6650f5f7290;p=emacs.git

Bring the scratch/accurate-warning-pos branch to full functionality.

The branch will now make bootstrap.

* src/lisp.h (lisp_h_EQ, etc.): Replace use of lisp_h_FOO by plain FOO.  To
enable this, some definitions have been moved in the file.
(XBARE_SYMBOL): Renamed from XSYMBOL.  Create a new XSYMBOL.
(BASE_EQ): New function.

* src/alloc.c (Fgarbage_collect): Bind symbols-with-pos-enabled to nil.

* src/data.c (Fbare_symbol): Renamed from Fsymbol_with_pos_sym.  It now
accepts a bare symbol as argument.
(syms_of_data): Declare Qsymbols_with_pos_enabled as a symbol.

* src/fns.c (hash_lookup): If the key is a symbol with position, replace it by
its bare symbol before proceding.

* src/lread.c (read1): In recursive calls to read1, and calls to other reading
function, use an argument of false for locate_syms when symbols with positions
are decidedly unwanted.

* src/print.c (Vprint_symbols_bare): New variable.
(print_vectorlike): Strip the position from a symbol with position before
printing it when Vprint_symbols_bare is non-nil.

* lisp/emacs-lisp/bytecomp.el (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 around macro
expansion.
(byte-compile-warning-prefix): Temporarily output source positions in both old
and new methods in warning messages.
(byte-compile-warn, ...): Use symbolp in place of symbol-with-pos-p.  Replace
symbol-with-pos-sym by bare-symbol.
(byte-compile--warn-x, byte-compile-form): Replace the erroneous push by cons
when binding
byte-compile--form-stack.
(byte-compile-file): Bind symbols-with-pos-enabled to non-nil to use the new
mechanism.
(byte-compile-toplevel-file-form): Bind and push a form onto
byte-compile--form-stack.
(byte-compile-file-form-autoload, byte-compile-file-form-defvar)
(byte-compile-file-form-eval, byte-compile-file-form-defmumble)
(byte-compile-lambda, byte-compile-form, byte-compile-dynamic-variable-op)
(byte-compile-constant, byte-compile-cond-jump-table): Strip positions from
symbols before compiling.

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

* lisp/emacs-lisp/macroexp.el (macroexp--warn-and-return): Add an extra
parameter, using it to call byte-compile--warn-x in place of
byte-compile-warn.
(macroexp-macroexpand, macroexp--expand-all): Add extra argument to call of
macroexp--warn-and-return.

* lisp/emacs-lisp/cl-macs.el (cl-macs--strip-s-p-1)
(cl-macs--strip-symbol-positions): New functions.  These are duplicates of
new functions in bytecomp.el, written to facilitate bootstrap, but this
duplication must be resolved somehow.
(cl-defstruct): Strip positions from symbols.

* lisp/emacs-lisp/cl-generic.el (cl-defmethod)
* lisp/emacs-lisp/cl-macs.el (cl-symbol-macrolet, cl-defstruct)
* lisp/emacs-lisp/eieio-core.el (eieio-oref)
* lisp/emacs-lisp/eieio.el (defclass)
* lisp/emacs-lisp/gv.el (gv-ref)
* lisp/emacs-lisp/pcase.el (pcase--u1): Add extra position arguments to the
calls of macroexp--warn-and-return.
---

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 891f3fdae37..cad9912822d 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -453,6 +453,36 @@ This is used by the warning message routines to determine a
 source code position.  The most accessible element is the current
 most deeply nested form.")
 
+(defun byte-compile-strip-s-p-1 (arg)
+  "Strip all positions from symbols with position in ARG, destructively modifying ARG
+Return the modified ARG."
+  (cond
+   ((symbolp arg)
+    (bare-symbol arg))
+   ((consp arg)
+    (let ((a arg))
+      (while (consp (cdr a))
+        (setcar a (byte-compile-strip-s-p-1 (car a)))
+        (setq a (cdr a)))
+      (setcar a (byte-compile-strip-s-p-1 (car a)))
+      ;; (if (cdr a)
+      (unless (bare-symbol-p (cdr a))   ; includes (unpositioned) nil.
+        (setcdr a (byte-compile-strip-s-p-1 (cdr a)))))
+    arg)
+   ((vectorp arg)
+    (let ((i 0)
+	  (len (length arg)))
+      (while (< i len)
+	(aset arg i (byte-compile-strip-s-p-1 (aref arg i)))
+	(setq i (1+ i))))
+    arg)
+   (t arg)))
+
+(defun byte-compile-strip-symbol-positions (arg)
+  "Strip all positions from symbols (recursively) in ARG.  Don't modify ARG."
+  (let ((arg1 (copy-tree arg t)))
+    (byte-compile-strip-s-p-1 arg1)))
+
 (defun byte-compile-recurse-toplevel (form non-toplevel-case)
   "Implement `eval-when-compile' and `eval-and-compile'.
 Return the compile-time value of FORM."
@@ -461,7 +491,8 @@ Return the compile-time value of FORM."
   ;; 3.2.3.1, "Processing of Top Level Forms".  The semantics are very
   ;; subtle: see test/lisp/emacs-lisp/bytecomp-tests.el for interesting
   ;; cases.
-  (setf form (macroexp-macroexpand form byte-compile-macro-environment))
+  (let ((print-symbols-bare t))
+    (setf form (macroexp-macroexpand form byte-compile-macro-environment)))
   (if (eq (car-safe form) 'progn)
       (cons 'progn
             (mapcar (lambda (subform)
@@ -502,7 +533,8 @@ Return the compile-time value of FORM."
                               ;; Don't compile here, since we don't know
                               ;; whether to compile as byte-compile-form
                               ;; or byte-compile-file-form.
-                              (let ((expanded
+                              (let* ((print-symbols-bare t)
+                                     (expanded
                                      (macroexpand-all
                                       form
                                       macroexpand-all-environment)))
@@ -1167,19 +1199,31 @@ Return nil if such is not found."
 		       (integerp byte-compile-read-position)
                        (or offset (not symbols-with-pos-enabled)))
 		  (with-current-buffer byte-compile-current-buffer
-		    (format "%d:%d:"
-			    (save-excursion
-			      (goto-char (if symbols-with-pos-enabled
-                                             (+ byte-compile-read-position offset)
-                                           byte-compile-last-position)
-                                         )
-			      (1+ (count-lines (point-min) (point-at-bol))))
-			    (save-excursion
-			      (goto-char (if symbols-with-pos-enabled
-                                             (+ byte-compile-read-position offset)
-                                           byte-compile-last-position)
-                                         )
-			      (1+ (current-column)))))
+		    ;; (format "%d:%d:"
+		    ;;         (save-excursion
+		    ;;           (goto-char (if symbols-with-pos-enabled
+                    ;;                          (+ byte-compile-read-position offset)
+                    ;;                        byte-compile-last-position)
+                    ;;                      )
+		    ;;           (1+ (count-lines (point-min) (point-at-bol))))
+		    ;;         (save-excursion
+		    ;;           (goto-char (if symbols-with-pos-enabled
+                    ;;                          (+ byte-compile-read-position offset)
+                    ;;                        byte-compile-last-position)
+                    ;;                      )
+		    ;;           (1+ (current-column))))
+;;;; EXPERIMENTAL STOUGH, 2018-11-22
+                    (let (old-l old-c new-l new-c)
+                      (save-excursion
+                        (goto-char byte-compile-last-position)
+                        (setq old-l (1+ (count-lines (point-min) (point-at-bol)))
+                              old-c (1+ (current-column)))
+                        (goto-char (+ byte-compile-read-position offset))
+                        (setq new-l (1+ (count-lines (point-min) (point-at-bol)))
+                              new-c (1+ (current-column)))
+                        (format "%d:%d:%d:%d:" old-l old-c new-l new-c)))
+;;;; END OF EXPERIMENTAL STOUGH
+                    )
 		""))
 	 (form (if (eq byte-compile-current-form :end) "end of data"
 		 (or byte-compile-current-form "toplevel form"))))
@@ -1283,8 +1327,8 @@ function directly; use `byte-compile-warn' or
   "Issue a byte compiler warning; use (format-message FORMAT ARGS...) for message."
   (setq args
         (mapcar (lambda (arg)
-                  (if (symbol-with-pos-p arg)
-                      (symbol-with-pos-sym arg)
+                  (if (symbolp arg)
+                      (bare-symbol arg)
                     arg))
                 args))
   (setq format (apply #'format-message format args))
@@ -1297,7 +1341,7 @@ function directly; use `byte-compile-warn' or
 ARG is the source element (likely a symbol with position) central to
   the warning, intended to supply source position information.
 FORMAT and ARGS are as in `byte-compile-warn'."
-  (let ((byte-compile--form-stack (push arg byte-compile--form-stack)))
+  (let ((byte-compile--form-stack (cons arg byte-compile--form-stack)))
     (apply #'byte-compile-warn format args)))
 
 (defun byte-compile-warn-obsolete (symbol)
@@ -1979,7 +2023,8 @@ The value is non-nil if there were no errors, nil if errors."
       ;; within byte-compile-from-buffer lingers in that buffer.
       (setq output-buffer
 	    (save-current-buffer
-	      (let ((byte-compile-level (1+ byte-compile-level)))
+	      (let ((symbols-with-pos-enabled t)
+                    (byte-compile-level (1+ byte-compile-level)))
                 (byte-compile-from-buffer input-buffer))))
       (if byte-compiler-error-flag
 	  nil
@@ -2390,7 +2435,8 @@ list that represents a doc string reference.
 (defvar byte-compile-force-lexical-warnings nil)
 
 (defun byte-compile-preprocess (form &optional _for-effect)
-  (setq form (macroexpand-all form byte-compile-macro-environment))
+  (let ((print-symbols-bare t))
+    (setq form (macroexpand-all form byte-compile-macro-environment)))
   ;; FIXME: We should run byte-optimize-form here, but it currently does not
   ;; recurse through all the code, so we'd have to fix this first.
   ;; Maybe a good fix would be to merge byte-optimize-form into
@@ -2404,11 +2450,13 @@ list that represents a doc string reference.
 
 ;; byte-hunk-handlers cannot call this!
 (defun byte-compile-toplevel-file-form (top-level-form)
-  (byte-compile-recurse-toplevel
-   top-level-form
-   (lambda (form)
-     (let ((byte-compile-current-form nil)) ; close over this for warnings.
-       (byte-compile-file-form (byte-compile-preprocess form t))))))
+  (let ((byte-compile--form-stack
+         (cons top-level-form byte-compile--form-stack)))
+    (byte-compile-recurse-toplevel
+     top-level-form
+     (lambda (form)
+       (let ((byte-compile-current-form nil)) ; close over this for warnings.
+         (byte-compile-file-form (byte-compile-preprocess form t)))))))
 
 ;; byte-hunk-handlers can call this.
 (defun byte-compile-file-form (form)
@@ -2441,7 +2489,8 @@ list that represents a doc string reference.
      ;; byte-compile-noruntime-functions, in case we have an autoload
      ;; of foo-func following an (eval-when-compile (require 'foo)).
      (unless (fboundp funsym)
-       (push (cons funsym (cons 'autoload (cdr (cdr form))))
+       (push (byte-compile-strip-symbol-positions
+              (cons funsym (cons 'autoload (cdr (cdr form)))))
              byte-compile-function-environment))
      ;; If an autoload occurs _before_ the first call to a function,
      ;; byte-compile-callargs-warn does not add an entry to
@@ -2457,7 +2506,7 @@ list that represents a doc string reference.
              (delq (assq funsym byte-compile-unresolved-functions)
                    byte-compile-unresolved-functions)))))
   (if (stringp (nth 3 form))
-      form
+      (byte-compile-strip-symbol-positions form)
     ;; No doc string, so we can compile this as a normal form.
     (byte-compile-keep-pending form 'byte-compile-normal-call)))
 
@@ -2484,10 +2533,17 @@ list that represents a doc string reference.
   (if (and (null (cddr form))		;No `value' provided.
            (eq (car form) 'defvar))     ;Just a declaration.
       nil
+    (setq form (copy-sequence form))
     (cond ((consp (nth 2 form))
-           (setq form (copy-sequence form))
            (setcar (cdr (cdr form))
-                   (byte-compile-top-level (nth 2 form) nil 'file))))
+                   (byte-compile-top-level (nth 2 form) nil 'file)))
+          ((symbolp (nth 2 form))
+           (setcar (cddr form) (bare-symbol (nth 2 form))))
+          (t (setcar (cddr form)
+                     (byte-compile-strip-symbol-positions (nth 2 form)))))
+    (setcar form (bare-symbol (car form)))
+    (if (symbolp (nth 1 form))
+        (setcar (cdr form) (bare-symbol (nth 1 form))))
     form))
 
 (put 'define-abbrev-table 'byte-hunk-handler
@@ -2578,7 +2634,7 @@ list that represents a doc string reference.
 (put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
 (defun byte-compile-file-form-eval (form)
   (if (eq (car-safe (nth 1 form)) 'quote)
-      (nth 1 (nth 1 form))
+      (byte-compile-strip-symbol-positions (nth 1 (nth 1 form)))
     (byte-compile-keep-pending form)))
 
 (defun byte-compile-file-form-defmumble (name macro arglist body rest)
@@ -2594,23 +2650,24 @@ not to take responsibility for the actual compilation of the code."
                       'byte-compile-macro-environment))
          (this-one (assq name (symbol-value this-kind)))
          (that-one (assq name (symbol-value that-kind)))
+         (bare-name (bare-symbol name))
          (byte-compile-current-form name)) ; For warnings.
 
     (byte-compile-set-symbol-position name)
-    (push name byte-compile-new-defuns)
+    (push bare-name byte-compile-new-defuns)
     ;; When a function or macro is defined, add it to the call tree so that
     ;; we can tell when functions are not used.
     (if byte-compile-generate-call-tree
-        (or (assq name byte-compile-call-tree)
+        (or (assq bare-name byte-compile-call-tree)
             (setq byte-compile-call-tree
-                  (cons (list name nil nil) byte-compile-call-tree))))
+                  (cons (list bare-name nil nil) byte-compile-call-tree))))
 
     (if (byte-compile-warning-enabled-p 'redefine)
         (byte-compile-arglist-warn name arglist macro))
 
     (if byte-compile-verbose
         (message "Compiling %s... (%s)"
-                 (or byte-compile-current-file "") name))
+                 (or byte-compile-current-file "") bare-name))
     (cond ((not (or macro (listp body)))
            ;; We do not know positively if the definition is a macro
            ;; or a function, so we shouldn't emit warnings.
@@ -2619,34 +2676,34 @@ not to take responsibility for the actual compilation of the code."
           (that-one
            (if (and (byte-compile-warning-enabled-p 'redefine)
                     ;; Don't warn when compiling the stubs in byte-run...
-                    (not (assq name byte-compile-initial-macro-environment)))
+                    (not (assq bare-name byte-compile-initial-macro-environment)))
                (byte-compile--warn-x
                 name
                 "`%s' defined multiple times, as both function and macro"
-                name))
+                bare-name))
            (setcdr that-one nil))
           (this-one
            (when (and (byte-compile-warning-enabled-p 'redefine)
                       ;; Hack: Don't warn when compiling the magic internal
                       ;; byte-compiler macros in byte-run.el...
-                      (not (assq name byte-compile-initial-macro-environment)))
+                      (not (assq bare-name byte-compile-initial-macro-environment)))
              (byte-compile--warn-x
               name
               "%s `%s' defined multiple times in this file"
               (if macro "macro" "function")
-              name)))
-          ((eq (car-safe (symbol-function name))
+              bare-name)))
+          ((eq (car-safe (symbol-function bare-name))
                (if macro 'lambda 'macro))
            (when (byte-compile-warning-enabled-p 'redefine)
              (byte-compile--warn-x
               name
               "%s `%s' being redefined as a %s"
               (if macro "function" "macro")
-              name
+              bare-name
               (if macro "macro" "function")))
            ;; Shadow existing definition.
            (set this-kind
-                (cons (cons name nil)
+                (cons (cons bare-name nil)
                       (symbol-value this-kind))))
           )
 
@@ -2658,7 +2715,7 @@ not to take responsibility for the actual compilation of the code."
       ;; FIXME: We've done that already just above, so this looks wrong!
       ;;(byte-compile-set-symbol-position name)
       (byte-compile--warn-x
-       name "probable `\"' without `\\' in doc string of %s" name))
+       name "probable `\"' without `\\' in doc string of %s" bare-name))
 
     (if (not (listp body))
         ;; The precise definition requires evaluation to find out, so it
@@ -2666,7 +2723,7 @@ not to take responsibility for the actual compilation of the code."
         ;; For a macro, that means we can't use that macro in the same file.
         (progn
           (unless macro
-            (push (cons name (if (listp arglist) `(declared ,arglist) t))
+            (push (cons bare-name (if (listp arglist) `(declared ,arglist) t))
                   byte-compile-function-environment))
           ;; Tell the caller that we didn't compile it yet.
           nil)
@@ -2676,10 +2733,10 @@ not to take responsibility for the actual compilation of the code."
             ;; A definition in b-c-initial-m-e should always take precedence
             ;; during compilation, so don't let it be redefined.  (Bug#8647)
             (or (and macro
-                     (assq name byte-compile-initial-macro-environment))
+                     (assq bare-name byte-compile-initial-macro-environment))
                 (setcdr this-one code))
           (set this-kind
-               (cons (cons name code)
+               (cons (cons bare-name code)
                      (symbol-value this-kind))))
 
         (if rest
@@ -2697,7 +2754,7 @@ not to take responsibility for the actual compilation of the code."
             ;; b-c-output-file-form analyze the defalias.
             (byte-compile-output-docform
              "\n(defalias '"
-             name
+             bare-name
              (if macro `(" '(macro . #[" ,index "])") `(" #[" ,index "]"))
              (append code nil)          ; Turn byte-code-function-p into list.
              (and (atom code) byte-compile-dynamic
@@ -2928,7 +2985,7 @@ for symbols generated by the byte compiler itself."
                         ;; which may include "calls" to
                         ;; internal-make-closure (Bug#29988).
                         (not lexical-binding))
-		   nil
+                   (setq int (byte-compile-strip-symbol-positions int))
 		 (setq int `(interactive ,newform)))))
 	    ((cdr int)
 	     (byte-compile-warn "malformed interactive spec: %s"
@@ -2943,13 +3000,14 @@ for symbols generated by the byte compiler itself."
                                    (and lexical-binding
                                         (byte-compile-make-lambda-lexenv
                                          arglistvars))
-                                   reserved-csts)))
+                                   reserved-csts))
+          (bare-arglist (byte-compile-strip-symbol-positions arglist)))
       ;; Build the actual byte-coded function.
       (cl-assert (eq 'byte-code (car-safe compiled)))
       (apply #'make-byte-code
              (if lexical-binding
                  (byte-compile-make-args-desc arglist)
-               arglist)
+               bare-arglist)
              (append
               ;; byte-string, constants-vector, stack depth
               (cdr compiled)
@@ -2957,7 +3015,7 @@ for symbols generated by the byte compiler itself."
               (cond ((and lexical-binding arglist)
                      ;; byte-compile-make-args-desc lost the args's names,
                      ;; so preserve them in the docstring.
-                     (list (help-add-fundoc-usage doc arglist)))
+                     (list (help-add-fundoc-usage doc bare-arglist)))
                     ((or doc int)
                      (list doc)))
               ;; optionally, the interactive spec.
@@ -3152,7 +3210,8 @@ for symbols generated by the byte compiler itself."
   (setq byte-compile-noruntime-functions
         (delq fn byte-compile-noruntime-functions))
   ;; Delegate the rest to the normal macro definition.
-  (macroexpand `(declare-function ,fn ,file ,@args)))
+  (let ((print-symbols-bare t))
+    (macroexpand `(declare-function ,fn ,file ,@args))))
 
 
 ;; This is the recursive entry point for compiling each subform of an
@@ -3170,19 +3229,20 @@ for symbols generated by the byte compiler itself."
 ;;
 (defun byte-compile-form (form &optional for-effect)
   (let ((byte-compile--for-effect for-effect)
-        (byte-compile--form-stack (push form byte-compile--form-stack)))
+        (byte-compile--form-stack (cons form byte-compile--form-stack)))
     (cond
      ((not (consp form))
       (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
              (when (symbolp form)
                (byte-compile-set-symbol-position form))
-             (byte-compile-constant form))
+             (byte-compile-constant
+              (if (symbolp form) (bare-symbol form) form)))
             ((and byte-compile--for-effect byte-compile-delete-errors)
              (when (symbolp form)
                (byte-compile-set-symbol-position form))
              (setq byte-compile--for-effect nil))
             (t
-             (byte-compile-variable-ref form))))
+             (byte-compile-variable-ref (bare-symbol form)))))
      ((symbolp (car form))
       (let* ((fn (car form))
              (handler (get fn 'byte-compile))
@@ -3413,6 +3473,7 @@ for symbols generated by the byte compiler itself."
 	 (byte-compile-warn-obsolete var))))
 
 (defsubst byte-compile-dynamic-variable-op (base-op var)
+  (if (symbolp var) (setq var (bare-symbol var)))
   (let ((tmp (assq var byte-compile-variables)))
     (unless tmp
       (setq tmp (list var))
@@ -3474,14 +3535,19 @@ for symbols generated by the byte compiler itself."
 (defun byte-compile-constant (const)
   (if byte-compile--for-effect
       (setq byte-compile--for-effect nil)
-    (inline (byte-compile-push-constant const))))
+    (inline (byte-compile-push-constant
+             (if (symbolp const) (bare-symbol const) const)))))
 
 ;; Use this for a constant that is not the value of its containing form.
 ;; This ignores byte-compile--for-effect.
 (defun byte-compile-push-constant (const)
   (when (symbolp const)
-    (byte-compile-set-symbol-position const))
-  (byte-compile-out 'byte-constant (byte-compile-get-constant const)))
+    (byte-compile-set-symbol-position const)
+    (setq const (bare-symbol const)))
+  (byte-compile-out
+   'byte-constant
+   (byte-compile-get-constant
+    (byte-compile-strip-symbol-positions const))))
 
 ;; Compile those primitive ordinary functions
 ;; which have special byte codes just for speed.
@@ -4272,7 +4338,7 @@ Return a list of the form ((TEST . VAR)  ((VALUE BODY) ...))"
 
       (dolist (case cases)
         (setq tag (byte-compile-make-tag)
-              test-obj (nth 0 case)
+              test-obj (byte-compile-strip-symbol-positions (nth 0 case))
               body (nth 1 case))
         (byte-compile-out-tag tag)
         (puthash test-obj tag jump-table)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 010026b4166..bfa6d738044 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -334,7 +334,8 @@ places where they originally did not directly appear."
 		(var (if (not (consp binder))
 			 (prog1 binder (setq binder (list binder)))
                        (when (cddr binder)
-                         (byte-compile-warn
+                         (byte-compile--warn-x
+                          binder
                           "Malformed `%S' binding: %S"
                           letsym binder))
 		       (setq value (cadr binder))
@@ -578,8 +579,8 @@ FORM is the parent form that binds this var."
     (`(,_ nil nil nil nil) nil)
     (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
        ,_ ,_ ,_ ,_)
-     (byte-compile-warn
-      "%s `%S' not left unused" varkind var)))
+     (byte-compile--warn-x
+      var "%s `%S' not left unused" varkind var)))
   (pcase vardata
     (`((,var . ,_) nil ,_ ,_ nil)
      ;; FIXME: This gives warnings in the wrong order, with imprecise line
@@ -591,8 +592,8 @@ FORM is the parent form that binds this var."
               (eq ?_ (aref (symbol-name var) 0))
 	      ;; As a special exception, ignore "ignore".
 	      (eq var 'ignored))
-       (byte-compile-warn "Unused lexical %s `%S'"
-                          varkind var)))
+       (byte-compile--warn-x var "Unused lexical %s `%S'"
+                             varkind var)))
     ;; If it's unused, there's no point converting it into a cons-cell, even if
     ;; it's captured and mutated.
     (`(,binder ,_ t t ,_)
@@ -616,7 +617,8 @@ FORM is the parent form that binds this var."
     (dolist (arg args)
       (cond
        ((byte-compile-not-lexical-var-p arg)
-        (byte-compile-warn
+        (byte-compile--warn-x
+         arg
          "Lexical argument shadows the dynamic variable %S"
          arg))
        ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
@@ -700,7 +702,8 @@ and updates the data stored in ENV."
        (setq forms (cddr forms))))
 
     (`((lambda . ,_) . ,_)             ; First element is lambda expression.
-     (byte-compile-warn
+     (byte-compile--warn-x
+      (nth 1 (car form))
       "Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form)))
      (dolist (exp `((function ,(car form)) . ,(cdr form)))
        (cconv-analyze-form exp env)))
@@ -728,8 +731,8 @@ and updates the data stored in ENV."
     (`(condition-case ,var ,protected-form . ,handlers)
      (cconv-analyze-form protected-form env)
      (when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
-       (byte-compile-warn
-        "Lexical variable shadows the dynamic variable %S" var))
+       (byte-compile--warn-x
+        var "Lexical variable shadows the dynamic variable %S" var))
      (let* ((varstruct (list var nil nil nil nil)))
        (if var (push varstruct env))
        (dolist (handler handlers)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index c7f0c48f85c..0da434d34e0 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -437,7 +437,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
              cl-generic-method-args     ; arguments
              lambda-doc                 ; documentation string
              def-body)))                ; part to be debugged
-  (let ((qualifiers nil))
+  (let ((qualifiers nil)
+        (org-name name))
     (while (not (listp args))
       (push args qualifiers)
       (setq args (pop body)))
@@ -451,6 +452,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
                    (byte-compile-warning-enabled-p 'obsolete))
                (let* ((obsolete (get name 'byte-obsolete-info)))
                  (macroexp--warn-and-return
+                  org-name
                   (macroexp--obsolete-warning name obsolete "generic function")
                   nil)))
          ;; You could argue that `defmethod' modifies rather than defines the
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 29ddd491af0..47afc72ef5f 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -53,6 +53,36 @@
   `(prog1 (car (cdr ,place))
      (setq ,place (cdr (cdr ,place)))))
 
+(defun cl-macs--strip-s-p-1 (arg)
+  "Strip all positions from symbols with position in ARG, destructively modifying ARG
+Return the modified ARG."
+  (cond
+   ((symbolp arg)
+    (bare-symbol arg))
+   ((consp arg)
+    (let ((a arg))
+      (while (consp (cdr a))
+        (setcar a (cl-macs--strip-s-p-1 (car a)))
+        (setq a (cdr a)))
+      (setcar a (cl-macs--strip-s-p-1 (car a)))
+      ;; (if (cdr a)
+      (unless (bare-symbol-p (cdr a))   ; includes (unpositioned) nil.
+          (setcdr a (cl-macs--strip-s-p-1 (cdr a)))))
+    arg)
+   ((vectorp arg)
+    (let ((i 0)
+	  (len (length arg)))
+      (while (< i len)
+	(aset arg i (cl-macs--strip-s-p-1 (aref arg i)))
+	(setq i (1+ i))))
+    arg)
+   (t arg)))
+
+(defun cl-macs--strip-symbol-positions (arg)
+  "Strip all positions from symbols (recursively) in ARG.  Don't modify ARG."
+  (let ((arg1 (copy-tree arg t)))
+    (cl-macs--strip-s-p-1 arg1)))
+
 (defvar cl--optimize-safety)
 (defvar cl--optimize-speed)
 
@@ -2280,10 +2310,12 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
                                                (append bindings venv))
                                          macroexpand-all-environment))))
             (if malformed-bindings
-                (macroexp--warn-and-return
-                 (format-message "Malformed `cl-symbol-macrolet' binding(s): %S"
-                                 (nreverse malformed-bindings))
-                 expansion)
+                (let ((rev-malformed-bindings (nreverse malformed-bindings)))
+                  (macroexp--warn-and-return
+                   rev-malformed-bindings
+                   (format-message "Malformed `cl-symbol-macrolet' binding(s): %S"
+                                   rev-malformed-bindings)
+                   expansion))
               expansion)))
       (unless advised
         (advice-remove 'macroexpand #'cl--sm-macroexpand)))))
@@ -2886,7 +2918,8 @@ non-nil value, that slot cannot be set via `setf'.
 	      ;; and pred-check, so changing it is not straightforward.
 	      (push `(cl-defsubst ,accessor (cl-x)
                        ,(format "Access slot \"%s\" of `%s' struct CL-X."
-                                slot struct)
+                                (cl-macs--strip-symbol-positions slot)
+                                (cl-macs--strip-symbol-positions struct))
                        (declare (side-effect-free t))
                        ,@(and pred-check
 			      (list `(or ,pred-check
@@ -2899,6 +2932,7 @@ non-nil value, that slot cannot be set via `setf'.
               (when (cl-oddp (length desc))
                 (push
                  (macroexp--warn-and-return
+                  (car (last desc))
                   (format "Missing value for option `%S' of slot `%s' in struct %s!"
                           (car (last desc)) slot name)
                   'nil)
@@ -2908,6 +2942,7 @@ non-nil value, that slot cannot be set via `setf'.
                   (let ((kw (car defaults)))
                     (push
                      (macroexp--warn-and-return
+                      kw
                       (format "  I'll take `%s' to be an option rather than a default value."
                               kw)
                       'nil)
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index e5c4f198f5b..1e9555ccf4e 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -721,6 +721,7 @@ Argument FN is the function calling this verifier."
                 ((and (or `',name (and name (pred keywordp)))
                       (guard (not (memq name eieio--known-slot-names))))
                  (macroexp--warn-and-return
+                  name
                   (format-message "Unknown slot `%S'" name) exp 'compile-only))
                 (_ exp)))))
   (cl-check-type slot symbol)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 98cdd4fd903..84804a0bda7 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -270,6 +270,7 @@ This method is obsolete."
                          (if (not (stringp (car slots)))
                              whole
                            (macroexp--warn-and-return
+                            (car slots)
                             (format "Obsolete name arg %S to constructor %S"
                                     (car slots) (car whole))
                             ;; Keep the name arg, for backward compatibility,
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 6bfc32c8356..704c7640e86 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -540,7 +540,9 @@ This is like the `&' operator of the C language.
 Note: this only works reliably with lexical binding mode, except for very
 simple PLACEs such as (symbol-function \\='foo) which will also work in dynamic
 binding mode."
-  (let ((code
+  (let ((org-place place) ; It's too difficult to determine by inspection whether
+                          ; the functions modify place.
+        (code
          (gv-letplace (getter setter) place
            `(cons (lambda () ,getter)
                   (lambda (gv--val) ,(funcall setter 'gv--val))))))
@@ -552,6 +554,7 @@ binding mode."
             (eq (car-safe code) 'cons))
         code
       (macroexp--warn-and-return
+       org-place
        "Use of gv-ref probably requires lexical-binding"
        code))))
 
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 93678bad7a6..e69f93c4eb9 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -121,8 +121,8 @@ and also to avoid outputting the warning during normal execution."
 
 (defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
 
-(defun macroexp--warn-and-return (msg form &optional compile-only)
-  (let ((when-compiled (lambda () (byte-compile-warn "%s" msg))))
+(defun macroexp--warn-and-return (arg msg form &optional compile-only)
+  (let ((when-compiled (lambda () (byte-compile--warn-x arg "%s" msg))))
     (cond
      ((null msg) form)
      ((macroexp--compiling-p)
@@ -190,6 +190,7 @@ and also to avoid outputting the warning during normal execution."
         (let* ((fun (car form))
                (obsolete (get fun 'byte-obsolete-info)))
           (macroexp--warn-and-return
+           fun
            (macroexp--obsolete-warning
             fun obsolete
             (if (symbolp (symbol-function fun))
@@ -252,12 +253,14 @@ Assumes the caller has bound `macroexpand-all-environment'."
       (`(,(and fun (or `funcall `apply `mapcar `mapatoms `mapconcat `mapc))
          ',(and f `(lambda . ,_)) . ,args)
        (macroexp--warn-and-return
+        (nth 1 f)
         (format "%s quoted with ' rather than with #'"
                 (list 'lambda (nth 1 f) '...))
         (macroexp--expand-all `(,fun ,f . ,args))))
       ;; Second arg is a function:
       (`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
        (macroexp--warn-and-return
+        (nth 1 f)
         (format "%s quoted with ' rather than with #'"
                 (list 'lambda (nth 1 f) '...))
         (macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 2746738d41a..826bafc312e 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -819,6 +819,7 @@ Otherwise, it defers to REST which is a list of branches of the form
         (let ((code (pcase--u1 matches code vars rest)))
           (if (eq upat '_) code
             (macroexp--warn-and-return
+             upat
              "Pattern t is deprecated.  Use `_' instead"
              code))))
        ((eq upat 'pcase--dontcare) :pcase--dontcare)
diff --git a/src/alloc.c b/src/alloc.c
index 1b4212f04ba..f37d7d48152 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6001,9 +6001,12 @@ See Info node `(elisp)Garbage Collection'.  */
        attributes: noinline)
   (void)
 {
+  ptrdiff_t count = SPECPDL_INDEX ();
   void *end;
+  specbind (Qsymbols_with_pos_enabled, Qnil);
   SET_STACK_TOP_ADDRESS (&end);
-  return garbage_collect_1 (end);
+  /* return garbage_collect_1 (end); */
+  return unbind_to (count, garbage_collect_1 (end));
 }
 
 /* Mark Lisp objects in glyph matrix MATRIX.  Currently the
diff --git a/src/data.c b/src/data.c
index d311cbaafc5..6c656250af9 100644
--- a/src/data.c
+++ b/src/data.c
@@ -772,12 +772,14 @@ DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
   return name;
 }
 
-DEFUN ("symbol-with-pos-sym", Fsymbol_with_pos_sym, Ssymbol_with_pos_sym, 1, 1, 0,
-       doc: /* Extract the symbol from a symbol with position.  */)
-       (register Lisp_Object ls)
+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 (ls);
+  return SYMBOL_WITH_POS_SYM (sym);
 }
 
 DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0,
@@ -4073,7 +4075,7 @@ syms_of_data (void)
   defsubr (&Sindirect_function);
   defsubr (&Ssymbol_plist);
   defsubr (&Ssymbol_name);
-  defsubr (&Ssymbol_with_pos_sym);
+  defsubr (&Sbare_symbol);
   defsubr (&Ssymbol_with_pos_pos);
   defsubr (&Sposition_symbol);
   defsubr (&Smakunbound);
@@ -4151,6 +4153,7 @@ 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_LISP ("symbols-with-pos-enabled", Vsymbols_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.  */);
diff --git a/src/fns.c b/src/fns.c
index 138cd085680..b5bf6ae76d5 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4141,6 +4141,8 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash)
   EMACS_UINT hash_code;
   ptrdiff_t start_of_bucket, i;
 
+  if (SYMBOL_WITH_POS_P (key))
+      key = SYMBOL_WITH_POS_SYM (key);
   hash_code = h->test.hashfn (&h->test, key);
   eassert ((hash_code & ~INTMASK) == 0);
   if (hash)
diff --git a/src/lisp.h b/src/lisp.h
index d2391aae662..4dfd0656293 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -398,13 +398,13 @@ typedef EMACS_INT Lisp_Word;
   || (Vsymbols_with_pos_enabled  \
   && (SYMBOL_WITH_POS_P ((x))                        \
       ? BARE_SYMBOL_P ((y))                               \
-        ? (lisp_h_XSYMBOL_WITH_POS((x)))->sym == (y)          \
+        ? (XSYMBOL_WITH_POS((x)))->sym == (y)          \
         : SYMBOL_WITH_POS_P((y))                       \
-          && ((lisp_h_XSYMBOL_WITH_POS((x)))->sym                   \
-              == (lisp_h_XSYMBOL_WITH_POS((y)))->sym)               \
+          && ((XSYMBOL_WITH_POS((x)))->sym                   \
+              == (XSYMBOL_WITH_POS((y)))->sym)               \
       : (SYMBOL_WITH_POS_P ((y))                     \
          && BARE_SYMBOL_P ((x))                           \
-         && ((x) == ((lisp_h_XSYMBOL_WITH_POS ((y)))->sym))))))
+         && ((x) == ((XSYMBOL_WITH_POS ((y)))->sym))))))
 
 #define lisp_h_FIXNUMP(x)                                       \
    (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \
@@ -420,11 +420,11 @@ 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_SYMBOL_WITH_POS_P(x) lisp_h_PSEUDOVECTORP (XIL((x)), PVEC_SYMBOL_WITH_POS)
+#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)
 /* verify (NIL_IS_ZERO) */
-#define lisp_h_SYMBOLP(x) ((lisp_h_BARE_SYMBOL_P ((x)) ||               \
-                            (Vsymbols_with_pos_enabled && (lisp_h_SYMBOL_WITH_POS_P ((x))))))
+#define lisp_h_SYMBOLP(x) ((BARE_SYMBOL_P ((x)) ||               \
+                            (Vsymbols_with_pos_enabled && (SYMBOL_WITH_POS_P ((x))))))
 #define lisp_h_TAGGEDP(a, tag) \
    (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
 	- (unsigned) (tag)) \
@@ -445,7 +445,7 @@ typedef EMACS_INT Lisp_Word;
 # define lisp_h_XFIXNUM(a) (XLI (a) >> INTTYPEBITS)
 # ifdef __CHKP__
 #  define lisp_h_XBARE_SYMBOL(a) \
-    (eassert (BARE_SYMBOL_P ((a))),                             \
+    (eassert (BARE_SYMBOL_P ((a))),                        \
      (struct Lisp_Symbol *) ((char *) XUNTAG ((a), Lisp_Symbol,   \
 					      struct Lisp_Symbol) \
 			     + (intptr_t) lispsym))
@@ -464,10 +464,10 @@ typedef EMACS_INT Lisp_Word;
 # define lisp_h_XSYMBOL(a)                      \
      (eassert (SYMBOLP ((a))),                      \
       (!Vsymbols_with_pos_enabled                \
-      ? (lisp_h_XBARE_SYMBOL ((a)))             \
-       : (lisp_h_BARE_SYMBOL_P ((a)))           \
-      ? (lisp_h_XBARE_SYMBOL ((a)))                                    \
-       : lisp_h_XBARE_SYMBOL (lisp_h_XSYMBOL_WITH_POS ((a))->sym)))
+      ? (XBARE_SYMBOL ((a)))             \
+       : (BARE_SYMBOL_P ((a)))           \
+      ? (XBARE_SYMBOL ((a)))                                    \
+       : XBARE_SYMBOL (XSYMBOL_WITH_POS ((a))->sym)))
 
 # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
 #endif
@@ -488,12 +488,13 @@ typedef EMACS_INT Lisp_Word;
 # define XIL(i) lisp_h_XIL (i)
 # define XLP(o) lisp_h_XLP (o)
 # define XPL(p) lisp_h_XPL (p)
+# 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 BASE_EQ(x, y) lisp_h_BASE_EQ (x, y)
-/* # define EQ(x, y) lisp_h_EQ (x, y) */
+/* # define EQ(x, y) lisp_h_EQ (x, y) */ /* X, Y are accessed more than once. */
 # define FLOATP(x) lisp_h_FLOATP (x)
 # define FIXNUMP(x) lisp_h_FIXNUMP (x)
 # define NILP(x) lisp_h_NILP (x)
@@ -501,8 +502,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 BARE_SYMBOL_P(x) lisp_h_BARE_SYMBOL_P (x)
-/* # 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)
@@ -514,10 +514,10 @@ typedef EMACS_INT Lisp_Word;
 # endif
 # if USE_LSB_TAG
 #  define make_fixnum(n) lisp_h_make_fixnum (n)
+#  define XBARE_SYMBOL(a)  lisp_h_XBARE_SYMBOL (a)
 #  define XFIXNAT(a) lisp_h_XFIXNAT (a)
 #  define XFIXNUM(a) lisp_h_XFIXNUM (a)
-#  define XBARE_SYMBOL(a)  lisp_h_XBARE_SYMBOL (a)
-/* #  define XSYMBOL(a) lisp_h_XSYMBOL (a) */
+/* #  define XSYMBOL(a) lisp_h_XSYMBOL (a) */ /* A is accessed more than once. */
 #  define XTYPE(a) lisp_h_XTYPE (a)
 # endif
 #endif
@@ -1028,6 +1028,18 @@ enum More_Lisp_Bits
 #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)
 {
@@ -1040,13 +1052,20 @@ INLINE bool
   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
-(XSYMBOL) (Lisp_Object a)
+(XBARE_SYMBOL) (Lisp_Object a)
 {
 #if USE_LSB_TAG
-  return lisp_h_XSYMBOL (a);
+  return lisp_h_XBARE_SYMBOL (a);
 #else
-  eassert (SYMBOLP (a));
+  eassert (BARE_SYMBOL_P (a));
   intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol);
   void *p = (char *) lispsym + i;
 # ifdef __CHKP__
@@ -1058,6 +1077,12 @@ INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
 #endif
 }
 
+INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED
+(XSYMBOL) (Lisp_Object a)
+{
+  return lisp_h_XSYMBOL (a);
+}
+
 INLINE Lisp_Object
 make_lisp_symbol (struct Lisp_Symbol *sym)
 {
@@ -1194,7 +1219,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)
 {
@@ -1640,12 +1672,6 @@ PSEUDOVECTOR_TYPEP (union vectorlike_header *a, enum pvec_type code)
 	  == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)));
 }
 
-INLINE bool
-PSEUDOVECTORP (Lisp_Object a, int code)
-{
-  return lisp_h_PSEUDOVECTORP (a, code);
-}
-
 /* A boolvector is a kind of vectorlike, with contents like a string.  */
 
 struct Lisp_Bool_Vector
@@ -2525,13 +2551,6 @@ XOVERLAY (Lisp_Object a)
   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay);
 }
 
-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 Lisp_Object
 SYMBOL_WITH_POS_SYM (Lisp_Object a)
 {
diff --git a/src/lread.c b/src/lread.c
index 38a7286deed..9609770cc32 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2813,7 +2813,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
 	      /* 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, locate_syms);
+	      Lisp_Object tmp = read_list (0, readcharfun, false);
 	      Lisp_Object head = CAR_SAFE (tmp);
 	      Lisp_Object data = Qnil;
 	      Lisp_Object val = Qnil;
@@ -2899,7 +2899,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
 	  if (c == '[')
 	    {
 	      Lisp_Object tmp;
-	      tmp = read_vector (readcharfun, 0, locate_syms);
+	      tmp = read_vector (readcharfun, 0, false);
 	      if (ASIZE (tmp) < CHAR_TABLE_STANDARD_SLOTS)
 		error ("Invalid size char-table");
 	      XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
@@ -2912,7 +2912,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
 		{
 		  /* 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, locate_syms);
+		  Lisp_Object tbl, tmp = read_list (1, readcharfun, false);
 		  ptrdiff_t size = XFIXNUM (Flength (tmp));
 		  int i, depth, min_char;
 		  struct Lisp_Cons *cell;
@@ -2950,7 +2950,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
       if (c == '&')
 	{
 	  Lisp_Object length;
-	  length = read1 (readcharfun, pch, first_in_list, locate_syms);
+	  length = read1 (readcharfun, pch, first_in_list, false);
 	  c = READCHAR;
 	  if (c == '"')
 	    {
@@ -2959,7 +2959,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
 	      unsigned char *data;
 
 	      UNREAD (c);
-	      tmp = read1 (readcharfun, pch, first_in_list, locate_syms);
+	      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
@@ -3000,7 +3000,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
 	  int ch;
 
 	  /* Read the string itself.  */
-	  tmp = read1 (readcharfun, &ch, 0, locate_syms);
+	  tmp = read1 (readcharfun, &ch, 0, false);
 	  if (ch != 0 || !STRINGP (tmp))
 	    invalid_syntax ("#");
 	  /* Read the intervals and their properties.  */
@@ -3008,14 +3008,14 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
 	    {
 	      Lisp_Object beg, end, plist;
 
-	      beg = read1 (readcharfun, &ch, 0, locate_syms);
+	      beg = read1 (readcharfun, &ch, 0, false);
 	      end = plist = Qnil;
 	      if (ch == ')')
 		break;
 	      if (ch == 0)
-		end = read1 (readcharfun, &ch, 0, locate_syms);
+		end = read1 (readcharfun, &ch, 0, false);
 	      if (ch == 0)
-		plist = read1 (readcharfun, &ch, 0, locate_syms);
+		plist = read1 (readcharfun, &ch, 0, false);
 	      if (ch)
 		invalid_syntax ("Invalid string property list");
 	      Fset_text_properties (beg, end, plist, tmp);
diff --git a/src/print.c b/src/print.c
index c8432a3ca89..fc5d93152dd 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1397,19 +1397,24 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
     case PVEC_SYMBOL_WITH_POS:
       {
         struct Lisp_Symbol_With_Pos *sp = XSYMBOL_WITH_POS (obj);
-        print_c_string ("#<symbol ", printcharfun);
-        if (BARE_SYMBOL_P (sp->sym))
+        if (!NILP (Vprint_symbols_bare))
           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);
+            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);
           }
-        else
-          print_c_string (" NOT A POSITION!!", printcharfun);
-        printchar ('>', printcharfun);
       }
       break;
 
@@ -2348,6 +2353,12 @@ priorities.  Values other than nil or t are also treated as
 `default'.  */);
   Vprint_charset_text_property = Qdefault;
 
+  DEFVAR_LISP ("print-symbols-bare", Vprint_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.  */);
+  Vprint_symbols_bare = Qnil;
+
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
   staticpro (&Vprin1_to_string_buffer);