Bring the scratch/accurate-warning-pos up to tentative functionality.

To exercise it,
M-: (let ((symbols-with-pos-enabled t)) (byte-compile-file "foo.el")).

* src/.gdbinit (xsymwithpos): New function.
(xpr): Call the above for a PVEC_SYMBOL_WITH_POS.

* src/lisp.h (several macros): Put parentheses around uses of parameters.
(lisp_h_BASE_EQ, BASE_EQ): New macros with the functionality of former EQ.
(lisp_h_EQ): Modify such that a symbol with position EQ the "same" bare
symbol.
(#define EQ, #define SYMBOLP): Comment out.

* src/alloc.c (macro_XPNTR, valid_lisp_object_p, mark_char_table): Replace
SYMBOLP with BARE_SYMBOLP in places where the bit pattern, not the meaning, is
important.

* src/data.c (Vsymbols_with_pos_enabled): Amend doc string.

* src/lread.c ("read-positiong-symbols"): Correct the spelling to
"read-positionINg-symbols".

* src/print.c (print_preprocess, print_object): Use BASE_EQ rather than EQ to
avoid unwanted equivalence of a symbol with pos and its base symbol.

* lisp/emacs-lisp/bytecomp.el (byte-compile--form-stack): New variable.
(byte-compile--first-symbol, byte-compile--warning-source-offset): New
functions.
(byte-compile-warning-prefix): Amend to use also the new source position
strategy.
(byte-compile-warn): Substitute bare symbols for symbols with position before
printing them.
(byte-compile--warn-x): New function.
(compile-defun, byte-compile-from-buffer): Call read-positiong-symbols rather
than plain read when symbols-with-pos-enabled is non-nil.
(byte-compile-form): Bind byte-compile--form-stack to itself with the current
`form' pushed onto it.  This will supply position information for warning
messages.
(Many functions): Replace byte-compile-warn with byte-compile--warn-x.

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 0b8f8824b4c61703348de252dedc6d11c93a152e..891f3fdae377fa95e4425492594e30c3c27f0b61 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -447,6 +447,12 @@ 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-recurse-toplevel (form non-toplevel-case)
   "Implement `eval-when-compile' and `eval-and-compile'.
 Return the compile-time value of FORM."
@@ -1104,6 +1110,41 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
         (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)
@@ -1121,15 +1162,23 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
                      (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)
+                             (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 byte-compile-last-position)
+                             (goto-char (if symbols-with-pos-enabled
+                                             (+ byte-compile-read-position offset)
+                                           byte-compile-last-position)
+                                         )
                              (1+ (current-column)))))
                ""))
         (form (if (eq byte-compile-current-form :end) "end of data"
@@ -1232,11 +1281,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 (symbol-with-pos-p arg)
+                      (symbol-with-pos-sym 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 (push 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)
@@ -1246,7 +1309,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.
@@ -1382,7 +1445,7 @@ when printing the error message."
        (when (or (< ncall (car sig))
                (and (cdr sig) (> ncall (cdr sig))))
          (byte-compile-set-symbol-position (car form))
-         (byte-compile-warn
+         (byte-compile--warn-x (car form)
           "%s called with %d argument%s, but %s %s"
           (car form) ncall
           (if (= 1 ncall) "" "s")
@@ -1417,7 +1480,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)))))
 
@@ -1431,7 +1494,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)
@@ -1440,7 +1503,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)
@@ -1459,7 +1522,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.
@@ -1467,7 +1530,7 @@ 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"
+        (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 (cdr calls)) (function <))
@@ -1476,7 +1539,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)
@@ -1495,7 +1559,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
@@ -1538,8 +1603,10 @@ extra args."
                          ;; so don't warn about them.
                          macroexpand
                          cl--compiling-file))))
-       (byte-compile-warn "function `%s' from cl package called at runtime"
-                          func)))
+       (byte-compile--warn-x
+         func
+         "function `%s' from cl package called at runtime"
+        func)))
   form)
 
 (defun byte-compile-print-syms (str1 strn syms)
@@ -1992,7 +2059,9 @@ With argument ARG, insert value in current buffer after the form."
                     (displaying-byte-compile-warnings
                      (byte-compile-sexp
                        (eval-sexp-add-defvars
-                        (read (current-buffer))
+                        (if symbols-with-pos-enabled
+                            (read-positioning-symbols (current-buffer))
+                          (read (current-buffer)))
                         byte-compile-read-position))))
                    lexical-binding)))
       (cond (arg
@@ -2063,7 +2132,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 (if symbols-with-pos-enabled
+                           (read-positioning-symbols inbuffer)
+                         (read inbuffer))))
             (when lread--unescaped-character-literals
               (byte-compile-warn
                "unescaped character literals %s detected!"
@@ -2397,12 +2468,12 @@ list that represents a doc string reference.
   (when (and (symbolp sym)
              (not (string-match "[-*/:$]" (symbol-name sym)))
              (byte-compile-warning-enabled-p 'lexical))
-    (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
-                       sym))
+    (byte-compile--warn-x
+     sym "global/dynamic var `%s' lacks a prefix" sym))
   (when (memq sym byte-compile-lexical-variables)
     (setq byte-compile-lexical-variables
           (delq sym byte-compile-lexical-variables))
-    (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))
 
 (defun byte-compile-file-form-defvar (form)
@@ -2434,7 +2505,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-keep-pending form))
 
@@ -2468,7 +2540,7 @@ list that represents a doc string reference.
       ;; Detect (require 'cl) in a way that works even if cl is already loaded.
       (if (member (car args) '("cl" cl))
          (progn
-           (byte-compile-warn "cl package required at runtime")
+           (byte-compile--warn-x form "cl package required at runtime")
            (byte-compile-disable-warning 'cl-functions))
        ;; We may have required something that causes cl to be loaded, eg
        ;; the uncompiled version of a file that requires cl when compiling.
@@ -2548,7 +2620,8 @@ not to take responsibility for the actual compilation of the code."
            (if (and (byte-compile-warning-enabled-p 'redefine)
                     ;; Don't warn when compiling the stubs in byte-run...
                     (not (assq name byte-compile-initial-macro-environment)))
-               (byte-compile-warn
+               (byte-compile--warn-x
+                name
                 "`%s' defined multiple times, as both function and macro"
                 name))
            (setcdr that-one nil))
@@ -2557,16 +2630,20 @@ not to take responsibility for the actual compilation of the code."
                       ;; 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)))
+             (byte-compile--warn-x
+              name
+              "%s `%s' defined multiple times in this file"
+              (if macro "macro" "function")
+              name)))
           ((eq (car-safe (symbol-function name))
                (if macro 'lambda 'macro))
            (when (byte-compile-warning-enabled-p 'redefine)
-             (byte-compile-warn "%s `%s' being redefined as a %s"
-                                (if macro "function" "macro")
-                                name
-                                (if macro "macro" "function")))
+             (byte-compile--warn-x
+              name
+              "%s `%s' being redefined as a %s"
+              (if macro "function" "macro")
+              name
+              (if macro "macro" "function")))
            ;; Shadow existing definition.
            (set this-kind
                 (cons (cons name nil)
@@ -2580,8 +2657,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" name))
 
     (if (not (listp body))
         ;; The precise definition requires evaluation to find out, so it
@@ -2755,7 +2832,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                (when (memq '&optional (cdr list))
                  (error "Duplicate &optional")))
              ((memq arg vars)
-              (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)))))
@@ -3091,7 +3169,8 @@ 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 (push form byte-compile--form-stack)))
     (cond
      ((not (consp form))
       (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
@@ -3126,20 +3205,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)
                   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 "Forgot to expand macro %s in %S" (car form) form)))
@@ -3180,7 +3259,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))
     (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.
@@ -3315,11 +3395,13 @@ for symbols generated by the byte compiler itself."
     (byte-compile-set-symbol-position var))
   (cond ((or (not (symbolp var)) (macroexp--const-symbol-p var))
         (when (byte-compile-warning-enabled-p 'constants)
-          (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")
+           (prin1-to-string var))))
        ((let ((od (get var 'byte-obsolete-variable)))
            (and od
                 (not (memq var byte-compile-not-obsolete-vars))
@@ -3355,7 +3437,7 @@ for symbols generated by the byte compiler itself."
                  (boundp var)
                  (memq var byte-compile-bound-variables)
                  (memq var byte-compile-free-references))
-       (byte-compile-warn "reference to free variable `%S'" var)
+       (byte-compile--warn-x var "reference to free variable `%S'" var)
        (push var byte-compile-free-references))
       (byte-compile-dynamic-variable-op 'byte-varref var))))
 
@@ -3371,7 +3453,7 @@ for symbols generated by the byte compiler itself."
                  (boundp var)
                  (memq var byte-compile-bound-variables)
                  (memq var byte-compile-free-assignments))
-       (byte-compile-warn "assignment to free variable `%s'" var)
+       (byte-compile--warn-x var "assignment to free variable `%s'" var)
        (push var byte-compile-free-assignments))
       (byte-compile-dynamic-variable-op 'byte-varset var))))
 
@@ -3551,9 +3633,10 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
 \f
 (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))
 
@@ -3839,7 +3922,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.")))))
@@ -3928,7 +4012,8 @@ discarding."
        (and (or (not (symbolp var))
                 (macroexp--const-symbol-p var t))
             (byte-compile-warning-enabled-p 'constants)
-            (byte-compile-warn
+            (byte-compile--warn-x
+              var
              "variable assignment to %s `%s'"
              (if (symbolp var) "constant" "nonvariable")
              (prin1-to-string var)))
@@ -4504,7 +4589,8 @@ binding slots have been popped."
            byte-compile-bound-variables)))
     (byte-compile-set-symbol-position 'condition-case)
     (unless (symbolp var)
-      (byte-compile-warn
+      (byte-compile--warn-x
+       var
        "`%s' is not a variable-name or nil (in condition-case)" var))
     (if fun-bodies (setq var (make-symbol "err")))
     (byte-compile-push-constant var)
@@ -4523,7 +4609,8 @@ binding slots have been popped."
                                          (if (not (symbolp sym))
                                              (setq ok nil)))
                                        ok))))
-                       (byte-compile-warn
+                       (byte-compile--warn-x
+                        condition
                         "`%S' is not a condition name or list of such (in condition-case)"
                         condition))
                       ;; (not (or (eq condition 't)
@@ -4556,16 +4643,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))
@@ -4606,7 +4693,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))
-      (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))
@@ -4647,8 +4735,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))
-    (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)))
   (let ((fun (nth 0 form))
        (var (nth 1 form))
        (value (nth 2 form))
@@ -4657,7 +4747,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")
@@ -4667,8 +4758,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,
@@ -4688,7 +4781,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))))
@@ -4769,7 +4863,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

diff --git a/src/.gdbinit b/src/.gdbinit
index ae6f13a103bcb207070c0adff1fbf92b3566fda5..1c6890850b713979c541bd57505402fa20cf1a22 100644 (file)
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -741,6 +741,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
@@ -1006,6 +1015,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 8c43a468ceb6767d53da31e7c3c73011827291a7..1b4212f04ba61837f335bbe4673c1f0493bf3aa1 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -527,10 +527,10 @@ PNTR_ADD (char *p, EMACS_UINT i)
 
 /* Extract the pointer hidden within O.  */
 
-#define macro_XPNTR(o)                                                 \
-  ((void *) \
-   (SYMBOLP (o)                                                               \
-    ? PNTR_ADD ((char *) lispsym,                                     \
+#define macro_XPNTR(o)                                                  \
+  ((void *)                                                             \
+   (BARE_SYMBOL_P (o)                                                   \
+    ? PNTR_ADD ((char *) lispsym,                                       \
                (XLI (o)                                                \
                 - ((EMACS_UINT) Lisp_Symbol << (USE_LSB_TAG ? 0 : VALBITS)))) \
     : (char *) XLP (o) - (XLI (o) & ~VALMASK)))
@@ -5091,7 +5091,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)
@@ -6078,7 +6078,8 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype)
     {
       Lisp_Object val = ptr->contents[i];
 
-      if (FIXNUMP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit))
+      if (FIXNUMP (val) || (BARE_SYMBOL_P (val)
+                            && XBARE_SYMBOL (val)->u.s.gcmarkbit))
        continue;
       if (SUB_CHAR_TABLE_P (val))
        {

diff --git a/src/data.c b/src/data.c
index dee55d44a94775df4e92dba110ade254c6732951..d311cbaafc500c2d2d7863017417ebbea8ff0b95 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -4152,7 +4152,7 @@ This variable cannot be set; trying to do so will signal an error.  */);
   make_symbol_constant (intern_c_string ("most-negative-fixnum"));
 
   DEFVAR_LISP ("symbols-with-pos-enabled", Vsymbols_with_pos_enabled,
-               doc: /* Non-nil when "located symbols" can be used in place of symbols.
+               doc: /* Non-nil when "symbols with position" can be used as symbols.
 Bind this to non-nil in applications such as the byte compiler.  */);
   Vsymbols_with_pos_enabled = Qnil;
 

diff --git a/src/lisp.h b/src/lisp.h
index 554307f914f2a3a4db4705c43fcf7a24923e1640..d2391aae662dafe665feb1e91dd28c42c9c13a36 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -380,18 +380,33 @@ typedef EMACS_INT Lisp_Word;
 #endif
 
 #define lisp_h_PSEUDOVECTORP(a,code)                            \
-  (lisp_h_VECTORLIKEP(a) &&                                     \
-   ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size \
+  (lisp_h_VECTORLIKEP((a)) &&                                   \
+   ((XUNTAG ((a), Lisp_Vectorlike, union vectorlike_header)->size       \
      & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))                    \
-    == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))))
+    == (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_FIXNUMP(x) \
+#define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y))
+/* #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) */
+
+/* verify (NIL_IS_ZERO) */
+#define lisp_h_EQ(x, y) ((XLI ((x)) == XLI ((y)))       \
+  || (Vsymbols_with_pos_enabled  \
+  && (SYMBOL_WITH_POS_P ((x))                        \
+      ? BARE_SYMBOL_P ((y))                               \
+        ? (lisp_h_XSYMBOL_WITH_POS((x)))->sym == (y)          \
+        : SYMBOL_WITH_POS_P((y))                       \
+          && ((lisp_h_XSYMBOL_WITH_POS((x)))->sym                   \
+              == (lisp_h_XSYMBOL_WITH_POS((y)))->sym)               \
+      : (SYMBOL_WITH_POS_P ((y))                     \
+         && BARE_SYMBOL_P ((x))                           \
+         && ((x) == ((lisp_h_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)))
@@ -405,11 +420,11 @@ typedef EMACS_INT Lisp_Word;
 #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
 #define lisp_h_SYMBOL_VAL(sym) \
    (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
-#define lisp_h_SYMBOL_WITH_POS_P(x) lisp_h_PSEUDOVECTORP (XIL(x), PVEC_SYMBOL_WITH_POS)
-#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol)
+#define lisp_h_SYMBOL_WITH_POS_P(x) lisp_h_PSEUDOVECTORP (XIL((x)), PVEC_SYMBOL_WITH_POS)
+#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP ((x), Lisp_Symbol)
 /* verify (NIL_IS_ZERO) */
-#define lisp_h_SYMBOLP(x) ((lisp_h_BARE_SYMBOL_P (x) || \
-                            (Vsymbols_with_pos_enabled && (lisp_h_SYMBOL_WITH_POS_P (x)))))
+#define lisp_h_SYMBOLP(x) ((lisp_h_BARE_SYMBOL_P ((x)) ||               \
+                            (Vsymbols_with_pos_enabled && (lisp_h_SYMBOL_WITH_POS_P ((x))))))
 #define lisp_h_TAGGEDP(a, tag) \
    (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
        - (unsigned) (tag)) \
@@ -430,29 +445,29 @@ typedef EMACS_INT Lisp_Word;
 # define lisp_h_XFIXNUM(a) (XLI (a) >> INTTYPEBITS)
 # ifdef __CHKP__
 #  define lisp_h_XBARE_SYMBOL(a) \
-    (eassert (BARE_SYMBOL_P (a)), \
-     (struct Lisp_Symbol *) ((char *) XUNTAG (a, Lisp_Symbol, \
+    (eassert (BARE_SYMBOL_P ((a))),                             \
+     (struct Lisp_Symbol *) ((char *) XUNTAG ((a), Lisp_Symbol,   \
                                              struct Lisp_Symbol) \
                             + (intptr_t) lispsym))
 # else
    /* If !__CHKP__ this is equivalent, and is a bit faster as of GCC 7.  */
 #  define lisp_h_XBARE_SYMBOL(a) \
-    (eassert (BARE_SYMBOL_P (a)), \
-     (struct Lisp_Symbol *) ((intptr_t) XLI (a) - Lisp_Symbol \
+    (eassert (BARE_SYMBOL_P ((a))),                             \
+     (struct Lisp_Symbol *) ((intptr_t) XLI ((a)) - Lisp_Symbol \
                             + (char *) lispsym))
 # endif
 # define lisp_h_XSYMBOL_WITH_POS(a)                      \
-    (eassert (SYMBOL_WITH_POS_P (a)),                    \
+  (eassert (SYMBOL_WITH_POS_P ((a))),                    \
      (struct Lisp_Symbol_With_Pos *) XUNTAG              \
-     (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos))
+     ((a), Lisp_Vectorlike, struct Lisp_Symbol_With_Pos))
 /* verify (NIL_IS_ZERO) */
 # define lisp_h_XSYMBOL(a)                      \
-    (eassert (SYMBOLP (a)),                     \
+     (eassert (SYMBOLP ((a))),                      \
       (!Vsymbols_with_pos_enabled                \
-      ? (lisp_h_XBARE_SYMBOL (a))               \
-       : (lisp_h_BARE_SYMBOL_P (a))             \
-      ? (lisp_h_XBARE_SYMBOL (a))               \
-       : lisp_h_XBARE_SYMBOL (lisp_h_XSYMBOL_WITH_POS (a)->sym)))
+      ? (lisp_h_XBARE_SYMBOL ((a)))             \
+       : (lisp_h_BARE_SYMBOL_P ((a)))           \
+      ? (lisp_h_XBARE_SYMBOL ((a)))                                    \
+       : lisp_h_XBARE_SYMBOL (lisp_h_XSYMBOL_WITH_POS ((a))->sym)))
 
 # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
 #endif
@@ -477,7 +492,8 @@ typedef EMACS_INT Lisp_Word;
 # 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 EQ(x, y) lisp_h_EQ (x, y) */
 # define FLOATP(x) lisp_h_FLOATP (x)
 # define FIXNUMP(x) lisp_h_FIXNUMP (x)
 # define NILP(x) lisp_h_NILP (x)
@@ -486,7 +502,7 @@ typedef EMACS_INT Lisp_Word;
 # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
 # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
 # define BARE_SYMBOL_P(x) lisp_h_BARE_SYMBOL_P (x)
-# define SYMBOLP(x) lisp_h_SYMBOLP (x)
+/* # define SYMBOLP(x) lisp_h_SYMBOLP (x) */
 # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag)
 # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
 # define XCAR(c) lisp_h_XCAR (c)
@@ -500,8 +516,8 @@ typedef EMACS_INT Lisp_Word;
 #  define make_fixnum(n) lisp_h_make_fixnum (n)
 #  define XFIXNAT(a) lisp_h_XFIXNAT (a)
 #  define XFIXNUM(a) lisp_h_XFIXNUM (a)
-#  define XBARE_SYMBOL(a)  lisp_h_XONLY_SYMBOL (a)
-#  define XSYMBOL(a) lisp_h_XSYMBOL (a)
+#  define XBARE_SYMBOL(a)  lisp_h_XBARE_SYMBOL (a)
+/* #  define XSYMBOL(a) lisp_h_XSYMBOL (a) */
 #  define XTYPE(a) lisp_h_XTYPE (a)
 # endif
 #endif

diff --git a/src/lread.c b/src/lread.c
index 9cfeac81326b0c4ef00a1ad67f4d4741750c57b0..38a7286deeda5d7b88b0d773f2dac84db2933cf8 100644 (file)
--- a/src/lread.c
+++ b/src/lread.c
@@ -2220,7 +2220,7 @@ STREAM or the value of `standard-input' may be:
   return read_internal_start (stream, Qnil, Qnil, false);
 }
 
-DEFUN ("read-positiong-symbols", Fread_positioning_symbols,
+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.

diff --git a/src/print.c b/src/print.c
index f4f95bbb5e0f0496c58e9bb01e162cbaa87e8ee4..c8432a3ca8986af98810507dd89f4c0761cef944 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -1181,7 +1181,7 @@ print_preprocess (Lisp_Object obj)
        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]))
          return;
       being_printed[print_depth] = obj;
     }
@@ -1868,7 +1868,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);