emacs-diffs
[Top][All Lists]
Advanced

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

scratch/correct-warning-pos 368570b: First commit of scratch/correct-war


From: Alan Mackenzie
Subject: scratch/correct-warning-pos 368570b: First commit of scratch/correct-warning-pos.
Date: Mon, 29 Nov 2021 06:27:01 -0500 (EST)

branch: scratch/correct-warning-pos
commit 368570b3fd09d03ac5b9276d1ca85ae813c3f385
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>

    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.
---
 lisp/emacs-lisp/byte-opt.el   |  38 ++--
 lisp/emacs-lisp/bytecomp.el   | 476 ++++++++++++++++++++++++++++--------------
 lisp/emacs-lisp/cconv.el      |  22 +-
 lisp/emacs-lisp/cl-generic.el |   4 +-
 lisp/emacs-lisp/cl-macs.el    |  42 +++-
 lisp/emacs-lisp/eieio-core.el |   1 +
 lisp/emacs-lisp/eieio.el      |   1 +
 lisp/emacs-lisp/gv.el         |   5 +-
 lisp/emacs-lisp/macroexp.el   |   8 +-
 lisp/emacs-lisp/pcase.el      |   1 +
 src/.gdbinit                  |  12 ++
 src/alloc.c                   |  40 +++-
 src/data.c                    |  81 +++++++
 src/fns.c                     |  12 +-
 src/keyboard.c                |   2 +
 src/lisp.h                    | 216 ++++++++++++-------
 src/lread.c                   | 126 +++++++----
 src/print.c                   |  33 ++-
 18 files changed, 809 insertions(+), 311 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index f6db803..7750f72 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -264,8 +264,9 @@ Earlier variables shadow later ones with the same name.")
                    (cdr (assq name byte-compile-function-environment)))))
     (pcase fn
       ('nil
-       (byte-compile-warn "attempt to inline `%s' before it was defined"
-                          name)
+       (byte-compile-warn-x name
+                            "attempt to inline `%s' before it was defined"
+                            name)
        form)
       (`(autoload . ,_)
        (error "File `%s' didn't define `%s'" (nth 1 fn) name))
@@ -417,8 +418,8 @@ for speeding up processing.")
         (t form)))
       (`(quote . ,v)
        (if (or (not v) (cdr v))
-          (byte-compile-warn "malformed quote form: `%s'"
-                             (prin1-to-string form)))
+          (byte-compile-warn-x form "malformed quote form: `%s'"
+                               form))
        ;; Map (quote nil) to nil to simplify optimizer logic.
        ;; Map quoted constants to nil if for-effect (just because).
        (and (car v)
@@ -436,8 +437,9 @@ for speeding up processing.")
                            (cons
                             (byte-optimize-form (car clause) nil)
                             (byte-optimize-body (cdr clause) for-effect))
-                         (byte-compile-warn "malformed cond form: `%s'"
-                                            (prin1-to-string clause))
+                         (byte-compile-warn-x
+                          clause "malformed cond form: `%s'"
+                          clause)
                          clause))
                      clauses)))
       (`(progn . ,exps)
@@ -513,8 +515,7 @@ for speeding up processing.")
          `(while ,condition . ,body)))
 
       (`(interactive . ,_)
-       (byte-compile-warn "misplaced interactive spec: `%s'"
-                         (prin1-to-string form))
+       (byte-compile-warn-x form "misplaced interactive spec: `%s'" form)
        nil)
 
       (`(function . ,_)
@@ -582,7 +583,7 @@ for speeding up processing.")
          (while args
            (unless (and (consp args)
                         (symbolp (car args)) (consp (cdr args)))
-             (byte-compile-warn "malformed setq form: %S" form))
+             (byte-compile-warn-x form "malformed setq form: %S" form))
            (let* ((var (car args))
                   (expr (cadr args))
                   (lexvar (assq var byte-optimize--lexvars))
@@ -615,8 +616,7 @@ for speeding up processing.")
        (cons fn (mapcar #'byte-optimize-form exps)))
 
       (`(,(pred (not symbolp)) . ,_)
-       (byte-compile-warn "`%s' is a malformed function"
-                         (prin1-to-string fn))
+       (byte-compile-warn-x fn "`%s' is a malformed function" fn)
        form)
 
       ((guard (when for-effect
@@ -624,8 +624,10 @@ for speeding up processing.")
                    (or byte-compile-delete-errors
                        (eq tmp 'error-free)
                        (progn
-                         (byte-compile-warn "value returned from %s is unused"
-                                            (prin1-to-string form))
+                         (byte-compile-warn-x
+                           form
+                           "value returned from %s is unused"
+                          form)
                          nil)))))
        (byte-compile-log "  %s called for effect; deleted" fn)
        ;; appending a nil here might not be necessary, but it can't hurt.
@@ -821,7 +823,8 @@ for speeding up processing.")
                 (if (symbolp binding)
                     binding
                   (when (or (atom binding) (cddr binding))
-                    (byte-compile-warn "malformed let binding: `%S'" binding))
+                    (byte-compile-warn-x
+                      binding "malformed let binding: `%S'" binding))
                   (list (car binding)
                         (byte-optimize-form (nth 1 binding) nil))))
               (car form))
@@ -1304,7 +1307,7 @@ See Info node `(elisp) Integer Basics'."
 
 (defun byte-optimize-while (form)
   (when (< (length form) 2)
-    (byte-compile-warn "too few arguments for `while'"))
+    (byte-compile-warn-x form "too few arguments for `while'"))
   (if (nth 1 form)
       form))
 
@@ -1342,9 +1345,10 @@ See Info node `(elisp) Integer Basics'."
                  (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
                    (nconc (list 'funcall fn) butlast
                           (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
-               (byte-compile-warn
+               (byte-compile-warn-x
+                 last
                 "last arg to apply can't be a literal atom: `%s'"
-                (prin1-to-string last))
+                last)
                nil))
          form))))
 
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 566a3fd..869b6c0 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -459,6 +459,42 @@ Filled in `cconv-analyze-form' but initialized and 
consulted here.")
 
 (defvar byte-compiler-error-flag)
 
+(defvar byte-compile--form-stack nil
+  "Dynamic list of successive enclosing forms.
+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 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."
@@ -467,7 +503,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)
@@ -508,7 +545,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)))
@@ -1212,6 +1250,41 @@ message buffer `default-directory'."
         (f2 (file-relative-name file dir)))
     (if (< (length f2) (length f1)) f2 f1)))
 
+(defun byte-compile--first-symbol (form)
+  "Return the \"first\" symbol found in form, or 0 if there is none.
+Here, \"first\" is by a depth first search."
+  (let (sym)
+    (cond
+     ((symbolp form) form)
+     ((consp form)
+      (or (and (symbolp (setq sym (byte-compile--first-symbol (car form))))
+               sym)
+          (and (symbolp (setq sym (byte-compile--first-symbol (cdr form))))
+               sym)
+          0))
+     ((and (vectorp form)
+           (> (length form) 0))
+      (let ((i 0)
+            (len (length form))
+            elt)
+        (catch 'sym
+          (while (< i len)
+            (when (symbolp
+                   (setq elt (byte-compile--first-symbol (aref form i))))
+              (throw 'sym elt))
+            (setq i (1+ i)))
+          0)))
+     (t 0))))
+
+(defun byte-compile--warning-source-offset ()
+  "Return a source offset from `byte-compile--form-stack'.
+Return nil if such is not found."
+  (catch 'offset
+    (dolist (form byte-compile--form-stack)
+      (let ((s (byte-compile--first-symbol form)))
+        (if (symbol-with-pos-p s)
+            (throw 'offset (symbol-with-pos-pos s)))))))
+
 ;; This is used as warning-prefix for the compiler.
 ;; It is always called with the warnings buffer current.
 (defun byte-compile-warning-prefix (level entry)
@@ -1229,16 +1302,36 @@ message buffer `default-directory'."
                      (format "%s:" (byte-compile-abbreviate-file
                                      load-file-name dir)))
                     (t "")))
+         (offset (byte-compile--warning-source-offset))
         (pos (if (and byte-compile-current-file
-                      (integerp byte-compile-read-position))
+                      (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 byte-compile-last-position)
-                             (1+ (count-lines (point-min) (point-at-bol))))
-                           (save-excursion
-                             (goto-char 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"))))
@@ -1342,11 +1435,25 @@ function directly; use `byte-compile-warn' or
 
 (defun byte-compile-warn (format &rest args)
   "Issue a byte compiler warning; use (format-message FORMAT ARGS...) for 
message."
+  (setq args
+        (mapcar (lambda (arg)
+                  (if (symbolp arg)
+                      (bare-symbol arg)
+                    arg))
+                args))
   (setq format (apply #'format-message format args))
   (if byte-compile-error-on-warn
       (error "%s" format)              ; byte-compile-file catches and logs it
     (byte-compile-log-warning format t :warning)))
 
+(defun byte-compile-warn-x (arg format &rest args)
+  "Issue a byte compiler warning.
+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 (cons arg byte-compile--form-stack)))
+    (apply #'byte-compile-warn format args)))
+
 (defun byte-compile-warn-obsolete (symbol)
   "Warn that SYMBOL (a variable or function) is obsolete."
   (when (byte-compile-warning-enabled-p 'obsolete symbol)
@@ -1356,7 +1463,7 @@ function directly; use `byte-compile-warn' or
                  (or funcp (get symbol 'byte-obsolete-variable))
                  (if funcp "function" "variable"))))
       (unless (and funcp (memq symbol byte-compile-not-obsolete-funcs))
-       (byte-compile-warn "%s" msg)))))
+       (byte-compile-warn-x symbol "%s" msg)))))
 
 (defun byte-compile-report-error (error-info &optional fill)
   "Report Lisp error in compilation.
@@ -1481,7 +1588,8 @@ when printing the error message."
 
 (defun byte-compile-emit-callargs-warn (name actual-args min-args max-args)
   (byte-compile-set-symbol-position name)
-  (byte-compile-warn
+  (byte-compile-warn-x
+   name
    "%s called with %d argument%s, but %s %s"
    name actual-args
    (if (= 1 actual-args) "" "s")
@@ -1547,7 +1655,7 @@ extra args."
                       n)))
          (nargs (- (length form) 2)))
       (unless (= nargs nfields)
-       (byte-compile-warn
+       (byte-compile-warn-x (car form)
         "`%s' called with %d args to fill %d format field(s)" (car form)
         nargs nfields)))))
 
@@ -1561,7 +1669,7 @@ extra args."
     (when (eq (car-safe name) 'quote)
       (or (not (eq (car form) 'custom-declare-variable))
          (plist-get keyword-args :type)
-         (byte-compile-warn
+         (byte-compile-warn-x (cadr name)
           "defcustom for `%s' fails to specify type" (cadr name)))
       (if (and (memq (car form) '(custom-declare-face custom-declare-variable))
               byte-compile-current-group)
@@ -1570,7 +1678,7 @@ extra args."
        (or (and (eq (car form) 'custom-declare-group)
                 (equal name ''emacs))
            (plist-get keyword-args :group)
-           (byte-compile-warn
+           (byte-compile-warn-x (cadr name)
             "%s for `%s' fails to specify containing group"
             (cdr (assq (car form)
                        '((custom-declare-group . defgroup)
@@ -1589,7 +1697,7 @@ extra args."
   (let ((calls (assq name byte-compile-unresolved-functions))
         nums sig min max)
     (when (and calls macrop)
-      (byte-compile-warn "macro `%s' defined too late" name))
+      (byte-compile-warn-x name "macro `%s' defined too late" name))
     (setq byte-compile-unresolved-functions
           (delq calls byte-compile-unresolved-functions))
     (setq calls (delq t calls))      ;Ignore higher-order uses of the function.
@@ -1597,8 +1705,8 @@ extra args."
       (when (and (symbolp name)
                  (eq (function-get name 'byte-optimizer)
                      'byte-compile-inline-expand))
-        (byte-compile-warn "defsubst `%s' was used before it was defined"
-                           name))
+        (byte-compile-warn-x name "defsubst `%s' was used before it was 
defined"
+                             name))
       (setq sig (byte-compile-arglist-signature arglist)
             nums (sort (copy-sequence (cddr calls)) (function <))
             min (car nums)
@@ -1606,7 +1714,8 @@ extra args."
       (when (or (< min (car sig))
                 (and (cdr sig) (> max (cdr sig))))
         (byte-compile-set-symbol-position name)
-        (byte-compile-warn
+        (byte-compile-warn-x
+         name
          "%s being defined to take %s%s, but was previously called with %s"
          name
          (byte-compile-arglist-signature-string sig)
@@ -1625,7 +1734,8 @@ extra args."
             (sig2 (byte-compile-arglist-signature arglist)))
         (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
           (byte-compile-set-symbol-position name)
-          (byte-compile-warn
+          (byte-compile-warn-x
+           name
            "%s %s used to take %s %s, now takes %s"
            (if macrop "macro" "function")
            name
@@ -1714,8 +1824,10 @@ It is too wide if it has any lines longer than the 
largest of
       (setq name (if name (format " `%s'" name) ""))
       (when (and kind docs (stringp docs)
                  (byte-compile--wide-docstring-p docs col))
-        (byte-compile-warn "%s%s docstring wider than %s characters"
-                           kind name col))))
+        (byte-compile-warn-x
+         name
+         "%s%s docstring wider than %s characters"
+         kind name col))))
   form)
 
 ;; If we have compiled any calls to functions which are not known to be
@@ -1730,7 +1842,8 @@ It is too wide if it has any lines longer than the 
largest of
         (let ((f (car urf)))
           (when (not (memq f byte-compile-new-defuns))
             (let ((byte-compile-last-position (cadr urf)))
-              (byte-compile-warn
+              (byte-compile-warn-x
+               f
                (if (fboundp f) "the function `%s' might not be defined at 
runtime." "the function `%s' is not known to be defined.")
                (car urf))))))))
   nil)
@@ -2083,7 +2196,8 @@ See also `emacs-lisp-byte-compile-and-load'."
       ;; 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
@@ -2195,11 +2309,12 @@ With argument ARG, insert value in current buffer after 
the form."
           (byte-compile-last-warned-form 'nothing)
           (value (eval
                   (let ((read-with-symbol-positions (current-buffer))
-                        (read-symbol-positions-list nil))
+                        (read-symbol-positions-list nil)
+                         (symbols-with-pos-enabled t))
                     (displaying-byte-compile-warnings
                      (byte-compile-sexp
                        (eval-sexp-add-defvars
-                        (read (current-buffer))
+                        (read-positioning-symbols (current-buffer))
                         byte-compile-read-position))))
                    lexical-binding)))
       (cond (arg
@@ -2284,9 +2399,9 @@ With argument ARG, insert value in current buffer after 
the form."
          (setq byte-compile-read-position (point)
                byte-compile-last-position byte-compile-read-position)
           (let* ((lread--unescaped-character-literals nil)
-                 (form (read inbuffer))
+                 (form (read-positioning-symbols inbuffer))
                  (warning (byte-run--unescaped-character-literals-warning)))
-            (when warning (byte-compile-warn "%s" warning))
+            (when warning (byte-compile-warn-x form "%s" warning))
            (byte-compile-toplevel-file-form form)))
        ;; Compile pending forms at end of file.
        (byte-compile-flush-pending)
@@ -2496,7 +2611,8 @@ list that represents a doc string reference.
               byte-compile-jump-tables 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
@@ -2509,11 +2625,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)
@@ -2546,7 +2664,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
@@ -2562,7 +2681,7 @@ list that represents a doc string reference.
              (delq (assq funsym byte-compile-unresolved-functions)
                    byte-compile-unresolved-functions)))))
   (if (stringp (nth 3 form))
-      (prog1 form
+      (prog1 (byte-compile-strip-symbol-positions form)
         (byte-compile-docstring-length-warn form))
     ;; No doc string, so we can compile this as a normal form.
     (byte-compile-keep-pending form 'byte-compile-normal-call)))
@@ -2574,7 +2693,8 @@ list that represents a doc string reference.
   (when (and (symbolp sym)
              (not (string-match "[-*/:$]" (symbol-name sym)))
              (byte-compile-warning-enabled-p 'lexical sym))
-    (byte-compile-warn "global/dynamic var `%s' lacks a prefix" sym)))
+    (byte-compile-warn-x
+     sym "global/dynamic var `%s' lacks a prefix" sym)))
 
 (defun byte-compile--declare-var (sym)
   (byte-compile--check-prefixed-var sym)
@@ -2582,7 +2702,7 @@ list that represents a doc string reference.
     (setq byte-compile-lexical-variables
           (delq sym byte-compile-lexical-variables))
     (when (byte-compile-warning-enabled-p 'lexical sym)
-      (byte-compile-warn "Variable `%S' declared after its first use" sym)))
+      (byte-compile-warn-x sym "Variable `%S' declared after its first use" 
sym)))
   (push sym byte-compile-bound-variables)
   (push sym byte-compile--seen-defvars))
 
@@ -2595,10 +2715,17 @@ list that represents a doc string reference.
            (eq (car form) 'defvar))     ;Just a declaration.
       nil
     (byte-compile-docstring-length-warn form)
+    (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
@@ -2616,7 +2743,8 @@ list that represents a doc string reference.
     (`(defvaralias ,_ ',newname . ,_)
      (when (memq newname byte-compile-bound-variables)
        (if (byte-compile-warning-enabled-p 'suspicious)
-           (byte-compile-warn
+           (byte-compile-warn-x
+            newname
             "Alias for `%S' should be declared before its referent" 
newname)))))
   (byte-compile-docstring-length-warn form)
   (byte-compile-keep-pending form))
@@ -2675,7 +2803,9 @@ list that represents a doc string reference.
 (put 'make-obsolete 'byte-hunk-handler 'byte-compile-file-form-make-obsolete)
 (defun byte-compile-file-form-make-obsolete (form)
   (prog1 (byte-compile-keep-pending form)
-    (apply 'make-obsolete (mapcar 'eval (cdr form)))))
+    (apply 'make-obsolete
+           (mapcar 'eval
+                   (byte-compile-strip-symbol-positions (cdr form))))))
 
 ;; This handler is not necessary, but it makes the output from dont-compile
 ;; and similar macros cleaner.
@@ -2699,23 +2829,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 name)
         (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.
@@ -2724,29 +2855,34 @@ not to take responsibility for the actual compilation 
of the code."
           (that-one
            (if (and (byte-compile-warning-enabled-p 'redefine name)
                     ;; Don't warn when compiling the stubs in byte-run...
-                    (not (assq name byte-compile-initial-macro-environment)))
-               (byte-compile-warn
+                    (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 name)
                       ;; Hack: Don't warn when compiling the magic internal
                       ;; byte-compiler macros in byte-run.el...
-                      (not (assq name byte-compile-initial-macro-environment)))
-             (byte-compile-warn "%s `%s' defined multiple times in this file"
-                                (if macro "macro" "function")
-                                name)))
-          ((eq (car-safe (symbol-function name))
+                      (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")
+              bare-name)))
+          ((eq (car-safe (symbol-function bare-name))
                (if macro 'lambda 'macro))
-           (when (byte-compile-warning-enabled-p 'redefine name)
-             (byte-compile-warn "%s `%s' being redefined as a %s"
-                                (if macro "function" "macro")
-                                name
-                                (if macro "macro" "function")))
+           (when (byte-compile-warning-enabled-p 'redefine bare-name)
+             (byte-compile-warn-x
+              name
+              "%s `%s' being redefined as a %s"
+              (if macro "function" "macro")
+              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))))
           )
 
@@ -2757,8 +2893,8 @@ not to take responsibility for the actual compilation of 
the code."
                (stringp (car-safe (cdr-safe (cdr-safe body)))))
       ;; FIXME: We've done that already just above, so this looks wrong!
       ;;(byte-compile-set-symbol-position name)
-      (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
-                         name))
+      (byte-compile-warn-x
+       name "probable `\"' without `\\' in doc string of %s" bare-name))
 
     (if (not (listp body))
         ;; The precise definition requires evaluation to find out, so it
@@ -2766,7 +2902,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)
@@ -2776,10 +2912,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
@@ -2806,7 +2942,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
@@ -2950,7 +3086,8 @@ If FORM is a lambda or a macro, byte-compile it as a 
function."
              ((and (memq arg vars)
                    ;; Allow repetitions for unused args.
                    (not (string-match "\\`_" (symbol-name arg))))
-              (byte-compile-warn "repeated variable %s in lambda-list" arg))
+              (byte-compile-warn-x
+                arg "repeated variable %s in lambda-list" arg))
              (t
               (push arg vars))))
       (setq list (cdr list)))))
@@ -2993,7 +3130,8 @@ If FORM is a lambda or a macro, byte-compile it as a 
function."
 
 (defun byte-compile--warn-lexical-dynamic (var context)
   (when (byte-compile-warning-enabled-p 'lexical-dynamic var)
-    (byte-compile-warn
+    (byte-compile-warn-x
+     var
      "`%s' lexically bound in %s here but declared dynamic in: %s"
      var context
      (mapconcat #'identity
@@ -3045,8 +3183,8 @@ for symbols generated by the byte compiler itself."
              ;; Check that the bit after the `interactive' spec is
              ;; just a list of symbols (i.e., modes).
             (unless (seq-every-p #'symbolp (cdr (cdr int)))
-              (byte-compile-warn "malformed interactive specc: %s"
-                                 (prin1-to-string int)))
+              (byte-compile-warn-x int "malformed interactive specc: %s"
+                                   int))
              (setq command-modes (cdr (cdr int)))
             ;; If the interactive spec is a call to `list', don't
             ;; compile it, because `call-interactively' looks at the
@@ -3058,16 +3196,17 @@ for symbols generated by the byte compiler itself."
                 (while (consp (cdr form))
                   (setq form (cdr form)))
                 (setq form (car form)))
-              (when (or (not (eq (car-safe form) 'list))
-                         ;; For code using lexical-binding, form is not
-                         ;; valid lisp, but rather an intermediate form
-                         ;; which may include "calls" to
-                         ;; internal-make-closure (Bug#29988).
-                         lexical-binding)
-                 (setq int `(interactive ,newform)))))
+              (if (or (not (eq (car-safe form) 'list))
+                       ;; For code using lexical-binding, form is not
+                       ;; valid lisp, but rather an intermediate form
+                       ;; which may include "calls" to
+                       ;; internal-make-closure (Bug#29988).
+                       lexical-binding)
+                   (setq int (byte-compile-strip-symbol-positions 
`(interactive ,newform)))
+                 (setq int (byte-compile-strip-symbol-positions int)))))
             ((cdr int)                  ; Invalid (interactive . something).
-            (byte-compile-warn "malformed interactive spec: %s"
-                               (prin1-to-string int)))))
+            (byte-compile-warn-x int "malformed interactive spec: %s"
+                                 int))))
     ;; Process the body.
     (let ((compiled
            (byte-compile-top-level (cons 'progn body) nil 'lambda
@@ -3078,14 +3217,15 @@ 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)))
       (let ((out
             (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)
@@ -3093,7 +3233,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 (and the modes the
@@ -3101,7 +3241,9 @@ for symbols generated by the byte compiler itself."
                     (cond
                      ;; We have some command modes, so use the vector form.
                      (command-modes
-                       (list (vector (nth 1 int) command-modes)))
+                       (list (vector (nth 1 int)
+                                     (byte-compile-strip-symbol-positions
+                                      command-modes))))
                      ;; No command modes, use the simple form with just the
                      ;; interactive spec.
                      (int
@@ -3298,7 +3440,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
@@ -3315,19 +3458,21 @@ for symbols generated by the byte compiler itself."
 ;; byte-compile--for-effect flag too.)
 ;;
 (defun byte-compile-form (form &optional for-effect)
-  (let ((byte-compile--for-effect for-effect))
+  (let ((byte-compile--for-effect for-effect)
+        (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))
@@ -3350,20 +3495,20 @@ for symbols generated by the byte compiler itself."
                   (byte-compile-check-variable (cadr hook) nil))))
         (when (and (byte-compile-warning-enabled-p 'suspicious)
                    (macroexp--const-symbol-p fn))
-          (byte-compile-warn "`%s' called as a function" fn))
+          (byte-compile-warn-x fn "`%s' called as a function" fn))
        (when (and (byte-compile-warning-enabled-p 'interactive-only fn)
                   interactive-only)
-         (byte-compile-warn "`%s' is for interactive use only%s"
-                            fn
-                            (cond ((stringp interactive-only)
-                                   (format "; %s"
-                                           (substitute-command-keys
-                                            interactive-only)))
-                                  ((and (symbolp 'interactive-only)
-                                        (not (eq interactive-only t)))
-                                   (format-message "; use `%s' instead."
-                                                    interactive-only))
-                                  (t "."))))
+         (byte-compile-warn-x fn "`%s' is for interactive use only%s"
+                              fn
+                              (cond ((stringp interactive-only)
+                                     (format "; %s"
+                                             (substitute-command-keys
+                                              interactive-only)))
+                                    ((and (symbolp 'interactive-only)
+                                          (not (eq interactive-only t)))
+                                     (format-message "; use `%s' instead."
+                                                      interactive-only))
+                                    (t "."))))
         (if (eq (car-safe (symbol-function (car form))) 'macro)
             (byte-compile-report-error
              (format "`%s' defined after use in %S (missing `require' of a 
library file?)"
@@ -3403,7 +3548,8 @@ for symbols generated by the byte compiler itself."
   (when (and byte-compile--for-effect (eq (car form) 'mapcar)
              (byte-compile-warning-enabled-p 'mapcar 'mapcar))
     (byte-compile-set-symbol-position 'mapcar)
-    (byte-compile-warn
+    (byte-compile-warn-x
+     (car form)
      "`mapcar' called for effect; use `mapc' or `dolist' instead"))
   (byte-compile-push-constant (car form))
   (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
@@ -3539,11 +3685,13 @@ for symbols generated by the byte compiler itself."
   (cond ((or (not (symbolp var)) (macroexp--const-symbol-p var))
         (when (byte-compile-warning-enabled-p 'constants
                                                (and (symbolp var) var))
-          (byte-compile-warn (if (eq access-type 'let-bind)
-                                 "attempt to let-bind %s `%s'"
-                               "variable reference to %s `%s'")
-                             (if (symbolp var) "constant" "nonvariable")
-                             (prin1-to-string var))))
+          (byte-compile-warn-x
+            var
+            (if (eq access-type 'let-bind)
+               "attempt to let-bind %s `%s'"
+             "variable reference to %s `%s'")
+           (if (symbolp var) "constant" "nonvariable")
+           var)))
        ((let ((od (get var 'byte-obsolete-variable)))
            (and od
                 (not (memq var byte-compile-not-obsolete-vars))
@@ -3556,6 +3704,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))
@@ -3568,9 +3717,10 @@ for symbols generated by the byte compiler itself."
   (push var byte-compile-bound-variables)
   (byte-compile-dynamic-variable-op 'byte-varbind var))
 
-(defun byte-compile-free-vars-warn (var &optional assignment)
+(defun byte-compile-free-vars-warn (arg var &optional assignment)
   "Warn if symbol VAR refers to a free variable.
 VAR must not be lexically bound.
+ARG is a position argument, used by byte-compile-warn-x.
 If optional argument ASSIGNMENT is non-nil, this is treated as an
 assignment (i.e. `setq')."
   (unless (or (not (byte-compile-warning-enabled-p 'free-vars var))
@@ -3582,9 +3732,9 @@ assignment (i.e. `setq')."
     (let* ((varname (prin1-to-string var))
            (desc (if assignment "assignment" "reference"))
            (suggestions (help-uni-confusable-suggestions varname)))
-      (byte-compile-warn "%s to free variable `%s'%s"
-                         desc varname
-                         (if suggestions (concat "\n  " suggestions) "")))
+      (byte-compile-warn-x arg "%s to free variable `%s'%s"
+                           desc var
+                           (if suggestions (concat "\n  " suggestions) "")))
     (push var (if assignment
                   byte-compile-free-assignments
                 byte-compile-free-references))))
@@ -3597,7 +3747,7 @@ assignment (i.e. `setq')."
        ;; VAR is lexically bound
         (byte-compile-stack-ref (cdr lex-binding))
       ;; VAR is dynamically bound
-      (byte-compile-free-vars-warn var)
+      (byte-compile-free-vars-warn var var)
       (byte-compile-dynamic-variable-op 'byte-varref var))))
 
 (defun byte-compile-variable-set (var)
@@ -3608,7 +3758,7 @@ assignment (i.e. `setq')."
        ;; VAR is lexically bound.
         (byte-compile-stack-set (cdr lex-binding))
       ;; VAR is dynamically bound.
-      (byte-compile-free-vars-warn var t)
+      (byte-compile-free-vars-warn var var t)
       (byte-compile-dynamic-variable-op 'byte-varset var))))
 
 (defmacro byte-compile-get-constant (const)
@@ -3628,14 +3778,19 @@ assignment (i.e. `setq')."
 (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.
@@ -3788,9 +3943,10 @@ If it is nil, then the handler is 
\"byte-compile-SYMBOL.\""
 
 (defun byte-compile-subr-wrong-args (form n)
   (byte-compile-set-symbol-position (car form))
-  (byte-compile-warn "`%s' called with %d arg%s, but requires %s"
-                    (car form) (length (cdr form))
-                    (if (= 1 (length (cdr form))) "" "s") n)
+  (byte-compile-warn-x (car form)
+                        "`%s' called with %d arg%s, but requires %s"
+                        (car form) (length (cdr form))
+                        (if (= 1 (length (cdr form))) "" "s") n)
   ;; Get run-time wrong-number-of-args error.
   (byte-compile-normal-call form))
 
@@ -4099,7 +4255,8 @@ discarding."
          (if (eq 'interactive (car-safe (car body))) (setq body (cdr body)))
          (if (and (consp (car body))
                   (not (eq 'byte-code (car (car body)))))
-             (byte-compile-warn
+             (byte-compile-warn-x
+               (nth 2 form)
       "A quoted lambda form is the second argument of `fset'.  This is probably
      not what you want, as that lambda cannot be compiled.  Consider using
      the syntax #'(lambda (...) ...) instead.")))))
@@ -4184,10 +4341,11 @@ discarding."
                   (macroexp--const-symbol-p var t))
                (byte-compile-warning-enabled-p 'constants
                                                (and (symbolp var) var))
-               (byte-compile-warn
+               (byte-compile-warn-x
+                var
                "variable assignment to %s `%s'"
                (if (symbolp var) "constant" "nonvariable")
-               (prin1-to-string var)))))
+               var))))
     (byte-compile-normal-call form)))
 
 (defun byte-compile-quote (form)
@@ -4466,7 +4624,7 @@ Return (TAIL VAR TEST CASES), where:
 
     (dolist (case cases)
       (setq tag (byte-compile-make-tag)
-            test-objects (car case)
+            test-objects (byte-compile-strip-symbol-positions (car case))
             body (cdr case))
       (byte-compile-out-tag tag)
       (dolist (value test-objects)
@@ -4772,16 +4930,16 @@ binding slots have been popped."
          (endtag (byte-compile-make-tag)))
     (byte-compile-set-symbol-position 'condition-case)
     (unless (symbolp var)
-      (byte-compile-warn
-       "`%s' is not a variable-name or nil (in condition-case)" var))
+      (byte-compile-warn-x
+       var "`%s' is not a variable-name or nil (in condition-case)" var))
 
     (dolist (clause (reverse clauses))
       (let ((condition (nth 1 clause)))
         (unless (consp condition) (setq condition (list condition)))
         (dolist (c condition)
           (unless (and c (symbolp c))
-            (byte-compile-warn
-             "`%S' is not a condition name (in condition-case)" c))
+            (byte-compile-warn-x
+             c "`%S' is not a condition name (in condition-case)" c))
           ;; In reality, the `error-conditions' property is only required
           ;; for the argument to `signal', not to `condition-case'.
           ;;(unless (consp (get c 'error-conditions))
@@ -4832,7 +4990,8 @@ binding slots have been popped."
 (defun byte-compile-save-excursion (form)
   (if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))
            (byte-compile-warning-enabled-p 'suspicious 'set-buffer))
-      (byte-compile-warn
+      (byte-compile-warn-x
+       form
        "Use `with-current-buffer' rather than save-excursion+set-buffer"))
   (byte-compile-out 'byte-save-excursion 0)
   (byte-compile-body-do-effect (cdr form))
@@ -4873,8 +5032,10 @@ binding slots have been popped."
   (when (and (symbolp (nth 1 form))
              (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
              (byte-compile-warning-enabled-p 'lexical (nth 1 form)))
-    (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
-                       (nth 1 form)))
+    (byte-compile-warn-x
+     (nth 1 form)
+     "global/dynamic var `%s' lacks a prefix"
+     (nth 1 form)))
   (byte-compile-docstring-length-warn form)
   (let ((fun (nth 0 form))
        (var (nth 1 form))
@@ -4884,7 +5045,8 @@ binding slots have been popped."
     (when (or (> (length form) 4)
              (and (eq fun 'defconst) (null (cddr form))))
       (let ((ncall (length (cdr form))))
-       (byte-compile-warn
+       (byte-compile-warn-x
+         fun
         "`%s' called with %d argument%s, but %s %s"
         fun ncall
         (if (= 1 ncall) "" "s")
@@ -4894,8 +5056,10 @@ binding slots have been popped."
     (if (eq fun 'defconst)
        (push var byte-compile-const-variables))
     (when (and string (not (stringp string)))
-      (byte-compile-warn "third arg to `%s %s' is not a string: %s"
-                         fun var string))
+      (byte-compile-warn-x
+       string
+       "third arg to `%s %s' is not a string: %s"
+       fun var string))
     (byte-compile-form-do-effect
      (if (cddr form)  ; `value' provided
          ;; Quote with `quote' to prevent byte-compiling the body,
@@ -4915,7 +5079,8 @@ binding slots have been popped."
        (macroexp-const-p (nth 5 form))
        (memq (eval (nth 5 form)) '(t macro))  ; macro-p
        (not (fboundp (eval (nth 1 form))))
-       (byte-compile-warn
+       (byte-compile-warn-x
+        form
        "The compiler ignores `autoload' except at top level.  You should
      probably put the autoload of the macro `%s' at top-level."
        (eval (nth 1 form))))
@@ -5004,7 +5169,8 @@ binding slots have been popped."
 (defun byte-compile-make-variable-buffer-local (form)
   (if (and (eq (car-safe (car-safe (cdr-safe form))) 'quote)
            (byte-compile-warning-enabled-p 'make-local))
-      (byte-compile-warn
+      (byte-compile-warn-x
+       form
        "`make-variable-buffer-local' not called at toplevel"))
   (byte-compile-normal-call form))
 (put 'make-variable-buffer-local
@@ -5062,7 +5228,7 @@ binding slots have been popped."
               (when (or (vectorp key)
                         (and (stringp key)
                              (not (key-valid-p key))))
-                (byte-compile-warn "Invalid `kbd' syntax: %S" key))))
+                (byte-compile-warn-x form "Invalid `kbd' syntax: %S" key))))
           form)))
  ;; Functions and the place(s) for the key definition(s).
  '((keymap-set 2)
@@ -5088,23 +5254,23 @@ binding slots have been popped."
                 (not (eq (car form) :menu)))
       (unless (memq (car form)
                     '(:full :keymap :parent :suppress :name :prefix))
-        (byte-compile-warn "Invalid keyword: %s" (car form)))
+        (byte-compile-warn-x (car form) "Invalid keyword: %s" (car form)))
       (push (pop form) result)
       (when (null form)
-        (byte-compile-warn "Uneven number of keywords in %S" form))
+        (byte-compile-warn-x orig-form "Uneven number of keywords in %S" form))
       (push (pop form) result))
     ;; Bindings.
     (while form
       (let ((key (pop form)))
         (when (stringp key)
           (unless (key-valid-p key)
-            (byte-compile-warn "Invalid `kbd' syntax: %S" key)))
+            (byte-compile-warn-x form "Invalid `kbd' syntax: %S" key)))
           ;; No improvement.
         (push key result))
       (when (null form)
-        (byte-compile-warn "Uneven number of key bindings in %S" form))
+        (byte-compile-warn-x form "Uneven number of key bindings in %S" form))
       (push (pop form) result))
-    orig-form))
+    (byte-compile-strip-symbol-positions orig-form)))
 
 (put 'define-keymap--define 'byte-hunk-handler
      #'byte-compile-define-keymap--define)
@@ -5171,24 +5337,26 @@ OP and OPERAND are as passed to `byte-compile-out'."
 ;;; call tree stuff
 
 (defun byte-compile-annotate-call-tree (form)
-  (let (entry)
+  (let ((current-form (byte-compile-strip-symbol-positions
+                       byte-compile-current-form))
+        (bare-car-form (byte-compile-strip-symbol-positions (car form)))
+        entry)
     ;; annotate the current call
-    (if (setq entry (assq (car form) byte-compile-call-tree))
-       (or (memq byte-compile-current-form (nth 1 entry)) ;callers
+    (if (setq entry (assq bare-car-form byte-compile-call-tree))
+       (or (memq current-form (nth 1 entry)) ;callers
            (setcar (cdr entry)
-                   (cons byte-compile-current-form (nth 1 entry))))
+                   (cons current-form (nth 1 entry))))
       (setq byte-compile-call-tree
-           (cons (list (car form) (list byte-compile-current-form) nil)
+           (cons (list bare-car-form (list current-form) nil)
                  byte-compile-call-tree)))
     ;; annotate the current function
-    (if (setq entry (assq byte-compile-current-form byte-compile-call-tree))
-       (or (memq (car form) (nth 2 entry)) ;called
+    (if (setq entry (assq current-form byte-compile-call-tree))
+       (or (memq bare-car-form (nth 2 entry)) ;called
            (setcar (cdr (cdr entry))
-                   (cons (car form) (nth 2 entry))))
+                   (cons bare-car-form (nth 2 entry))))
       (setq byte-compile-call-tree
-           (cons (list byte-compile-current-form nil (list (car form)))
-                 byte-compile-call-tree)))
-    ))
+           (cons (list current-form nil (list bare-car-form))
+                 byte-compile-call-tree)))))
 
 ;; Renamed from byte-compile-report-call-tree
 ;; to avoid interfering with completion of byte-compile-file.
@@ -5213,14 +5381,15 @@ invoked interactively."
     (set-buffer "*Call-Tree*")
     (erase-buffer)
     (message "Generating call tree... (sorting on %s)"
-            byte-compile-call-tree-sort)
+            (remove-pos-from-symbol byte-compile-call-tree-sort))
     (insert "Call tree for "
            (cond ((null byte-compile-current-file) (or filename "???"))
                  ((stringp byte-compile-current-file)
                   byte-compile-current-file)
                  (t (buffer-name byte-compile-current-file)))
            " sorted on "
-           (prin1-to-string byte-compile-call-tree-sort)
+           (prin1-to-string (remove-pos-from-symbol
+                              byte-compile-call-tree-sort))
            ":\n\n")
     (if byte-compile-call-tree-sort
        (setq byte-compile-call-tree
@@ -5240,7 +5409,8 @@ invoked interactively."
                       ('name
                        (lambda (x y) (string< (car x) (car y))))
                       (_ (error "`byte-compile-call-tree-sort': `%s' - unknown 
sort mode"
-                                byte-compile-call-tree-sort))))))
+                                (remove-pos-from-symbol
+                                 byte-compile-call-tree-sort)))))))
     (message "Generating call tree...")
     (let ((rest byte-compile-call-tree)
          (b (current-buffer))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 03e109f..9c9ebe1 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -353,7 +353,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))
@@ -361,9 +362,9 @@ places where they originally did not directly appear."
            (cond
             ;; Ignore bindings without a valid name.
             ((not (symbolp var))
-             (byte-compile-warn "attempt to let-bind nonvariable `%S'" var))
+             (byte-compile-warn-x var "attempt to let-bind nonvariable `%S'" 
var))
             ((or (booleanp var) (keywordp var))
-             (byte-compile-warn "attempt to let-bind constant `%S'" var))
+             (byte-compile-warn-x var "attempt to let-bind constant `%S'" var))
             (t
              (let ((new-val
                    (pcase (cconv--var-classification binder form)
@@ -610,7 +611,8 @@ FORM is the parent form that binds this var."
      ;; FIXME: Convert this warning to use `macroexp--warn-wrap'
      ;; so as to give better position information.
      (when (byte-compile-warning-enabled-p 'not-unused var)
-       (byte-compile-warn "%s `%S' not left unused" varkind var)))
+       (byte-compile-warn-x
+        var "%s `%S' not left unused" varkind var)))
     ((and (let (or 'let* 'let) (car form))
           `((,var) ;; (or `(,var nil) : Too many false positives: bug#47080
             t nil ,_ ,_))
@@ -618,7 +620,7 @@ FORM is the parent form that binds this var."
      ;; so as to give better position information and obey
      ;; `byte-compile-warnings'.
      (unless (not (intern-soft var))
-       (byte-compile-warn "Variable `%S' left uninitialized" var))))
+       (byte-compile-warn-x var "Variable `%S' left uninitialized" var))))
   (pcase vardata
     (`(,binder nil ,_ ,_ nil)
      (push (cons (cons binder form) :unused) cconv-var-classification))
@@ -647,7 +649,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, ...
@@ -730,7 +733,8 @@ This function does not return anything but instead fills the
        (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)))
@@ -749,8 +753,8 @@ This function does not return anything but instead fills the
     (`(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 9de47e4..b94737e 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -496,7 +496,8 @@ The set of acceptable TYPEs (also called \"specializers\") 
is defined
                     cl--generic-edebug-make-name nil]
              lambda-doc                 ; documentation string
              def-body)))                ; part to be debugged
-  (let ((qualifiers nil))
+  (let ((qualifiers nil)
+        (org-name name))
     (while (cl-generic--method-qualifier-p args)
       (push args qualifiers)
       (setq args (pop body)))
@@ -511,6 +512,7 @@ The set of acceptable TYPEs (also called \"specializers\") 
is defined
                    (byte-compile-warning-enabled-p 'obsolete name))
                (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 1852471..dbe0eb1 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)
 
@@ -2417,10 +2447,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)))))
@@ -3104,6 +3136,7 @@ To see the documentation for a defined struct type, use
               (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)
@@ -3113,6 +3146,7 @@ To see the documentation for a defined struct type, use
                   (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 7c5babc..4e9357c 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -744,6 +744,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 nil 'compile-only))
                 (_ exp))))
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 3fbfe01..76f7b66 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -292,6 +292,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 ebcc63c..ed33524 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -581,7 +581,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))))))
@@ -593,6 +595,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 1e4fdd1..6d114a8 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -138,14 +138,15 @@ Other uses risk returning non-nil value that point to the 
wrong file."
 (defun macroexp--warn-wrap (msg form category)
   (let ((when-compiled (lambda ()
                          (when (byte-compile-warning-enabled-p category)
-                           (byte-compile-warn "%s" msg)))))
+                           (byte-compile-warn-x form "%s" msg)))))
     `(progn
        (macroexp--funcall-if-compiled ',when-compiled)
        ,form)))
 
 (define-obsolete-function-alias 'macroexp--warn-and-return
   #'macroexp-warn-and-return "28.1")
-(defun macroexp-warn-and-return (msg form &optional category compile-only)
+(defun macroexp-warn-and-return (;; _arg
+                                 msg form &optional category compile-only)
   "Return code equivalent to FORM labeled with warning MSG.
 CATEGORY is the category of the warning, like the categories that
 can appear in `byte-compile-warnings'.
@@ -216,6 +217,7 @@ is executed without being compiled first."
         (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))
@@ -330,6 +332,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
          (if (null body)
              (macroexp-unprogn
               (macroexp-warn-and-return
+               ;; fun
                (format "Empty %s body" fun)
                nil nil 'compile-only))
            (macroexp--all-forms body))
@@ -367,6 +370,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
                         (eq 'lambda (car-safe (cadr arg))))
                (setcar (nthcdr funarg form)
                        (macroexp-warn-and-return
+                        ;; (nth 1 f)
                         (format "%S quoted with ' rather than with #'"
                                 (let ((f (cadr arg)))
                                   (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index a3498d2..430ae97 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -940,6 +940,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/.gdbinit b/src/.gdbinit
index f74e295..9f2a86b 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 f8908c9..0d69f23 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 0d3376f..b3b157a 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 76c76c9..43df40a 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 c98175a..050537b 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 19caba4..08013e9 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 2e63ec4..7775911 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 adadb28..eb0fe59 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);
 



reply via email to

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