Several amendments to scratch/correct-warning-pos.

The position return by read-positioning-symbols is now the position in the
buffer, rather than the offset from the start of a form, enabling warning
positions in other parts of the buffer to be output.

* src/lisp.h (lisp_h_EQ): Add XLI casts so that it compiles cleanly.

* src/data.c (Fremove_pos_from_symbol): New DEFUN.

* src/lread.c (readchar_count): renamed to readchar_offset.
(read_internal_start) Initialize readchar_offset to the buffer's point when
STREAM is a buffer.

* lisp/emacs-lisp/bytecomp.el (byte-compile-warning-prefix): Amend to use
OFFSET as a buffer position, not an offset from the start of a form.
(byte-compile-warn): Remove symbol positions from any shape of ARGS, not just
a symbol with position.

* lisp/emacs-lisp/cconv.c (cconv-convert): In the :unused case, position the
new IGNORE symbol with the VAR it has replaced.

* lisp/emacs-lisp/macroexp.el (macroexp--warn-wrap, macroexp-warn-and-return):
Add an extra position parameter to each.

* lisp/emacs-lisp/bindat.el (bindat-type), lisp/emacs-lisp/byte-run.el
(defmacro, defun), lisp/emacs-lisp/cconv.el (cconv--convert-func-body)
(cconv-convert), lisp/emacs-lisp/cl-generic.el (cl-defmethod),
lisp/emacs-lisp/cl-macs.el (cl-symbol-macrolet, cl-defstruct),
lisp/emacs-lisp/easy-mmode.el (define-minor-mode),
lisp/emacs-lisp/eieio-core.el (eieio-oref, eieio-oref-default)
(eieio-oset-default), lisp/emacs-lisp/eieio.el (defclass),
lisp/emacs-lisp/gv.el (gv-ref), lisp/emacs-lisp/macroexp.el
(macroexp-macroexpand, macroexp--unfold-lambda, macroexp--expand-all),
lisp/emacs-lisp/pcase.el (pcase-compile-patterns, pcase--u1): Add an extra
position argument to each call of macroexp-warn-and-return.

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 76c2e80fda808c1ae325a8aec9f3b14b72902719..17a55c7dbaab5919e92a8dfc6aa0ef5baa5a2e4d 100644 (file)
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -804,6 +804,7 @@ is the name of a variable that will hold the value we need to pack.")
               (if (or (eq label '_) (not (assq label labels)))
                   code
                 (macroexp-warn-and-return
+                 code
                  (format "Duplicate label: %S" label)
                  code))))
            (`(,_ ,val)

diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index d82d9454e84bc0d6fa13d0d04eda0df07b708622..813ff53ea730cac9d1a624c2bca97c4d73f604bb 100644 (file)
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -253,7 +253,8 @@ The return value is undefined.
                  #'(lambda (x)
                      (let ((f (cdr (assq (car x) macro-declarations-alist))))
                        (if f (apply (car f) name arglist (cdr x))
-                         (macroexp-warn-and-return
+                          (macroexp-warn-and-return
+                          (car x)
                           (format-message
                            "Unknown macro property %S in %S"
                            (car x) name)
@@ -327,6 +328,7 @@ The return value is undefined.
                     nil)
                    (t
                     (macroexp-warn-and-return
+                     (car x)
                      (format-message "Unknown defun property `%S' in %S"
                                      (car x) name)
                      nil)))))

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 869b6c01b8a6690ffbed8d8e382ecd2344aa7d1f..2f23fe743ec582a17f064005d278bd421fbfb949 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1326,7 +1326,7 @@ Return nil if such is not found."
                         (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))
+                        (goto-char 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)))
@@ -1435,12 +1435,7 @@ 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 args (mapcar #'byte-compile-strip-symbol-positions args))
   (setq format (apply #'format-message format args))
   (if byte-compile-error-on-warn
       (error "%s" format)              ; byte-compile-file catches and logs it

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 9c9ebe15d5d124acb51ce5b94c77d7ab23be8846..e12f0a1753bee6816df26a01da29d76432acd3a6 100644 (file)
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -258,11 +258,11 @@ Returns a form where all lambdas don't have any free variables."
               ;; unused vars.
               (not (intern-soft var))
               (eq ?_ (aref (symbol-name var) 0))
-             ;; As a special exception, ignore "ignore".
+             ;; As a special exception, ignore "ignored".
              (eq var 'ignored))
        (let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
          (format "Unused lexical %s `%S'%s"
-                 varkind var
+                 varkind (bare-symbol var)
                  (if suggestions (concat "\n  " suggestions) "")))))
 
 (define-inline cconv--var-classification (binder form)
@@ -286,7 +286,7 @@ of converted forms."
               (let (and (pred stringp) msg)
                 (cconv--warn-unused-msg arg "argument")))
          (if (assq arg env) (push `(,arg . nil) env)) ;FIXME: Is it needed?
-         (push (lambda (body) (macroexp--warn-wrap msg body 'lexical)) wrappers))
+         (push (lambda (body) (macroexp--warn-wrap body msg body 'lexical)) wrappers))
         (_
          (if (assq arg env) (push `(,arg . nil) env)))))
     (setq funcbody (mapcar (lambda (form)
@@ -414,11 +414,14 @@ places where they originally did not directly appear."
                        ;; Declared variable is unused.
                        (if (assq var new-env)
                            (push `(,var) new-env)) ;FIXME:Needed?
-                       (let ((newval
-                              `(ignore ,(cconv-convert value env extend)))
-                             (msg (cconv--warn-unused-msg var "variable")))
+                       (let* ((Ignore (if (symbol-with-pos-p var)
+                                          (position-symbol 'ignore var)
+                                        'ignore))
+                              (newval `(,Ignore
+                                        ,(cconv-convert value env extend)))
+                              (msg (cconv--warn-unused-msg var "variable")))
                          (if (null msg) newval
-                           (macroexp--warn-wrap msg newval 'lexical))))
+                           (macroexp--warn-wrap var msg newval 'lexical))))
 
                       ;; Normal default case.
                       (_
@@ -517,7 +520,7 @@ places where they originally did not directly appear."
             (newprotform (cconv-convert protected-form env extend)))
        `(condition-case ,var
             ,(if msg
-                 (macroexp--warn-wrap msg newprotform 'lexical)
+                 (macroexp--warn-wrap var msg newprotform 'lexical)
                newprotform)
           ,@(mapcar
              (lambda (handler)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b94737e0fee4bebb02aa719e80c75f057b62a472..43214aab30ce51bf95b41dece20fa6cf11a58b60 100644 (file)
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -512,7 +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
+                  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 dbe0eb1b0e2c7dee8301fdc378732c4eaa681a8d..3659a0c95a27381b9945e9169cac385faeae7304 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2449,7 +2449,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
             (if malformed-bindings
                 (let ((rev-malformed-bindings (nreverse malformed-bindings)))
                   (macroexp-warn-and-return
-                   ;; rev-malformed-bindings
+                   rev-malformed-bindings
                    (format-message "Malformed `cl-symbol-macrolet' binding(s): %S"
                                    rev-malformed-bindings)
                    expansion))
@@ -3136,7 +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))
+                  (car (last desc))
                   (format "Missing value for option `%S' of slot `%s' in struct %s!"
                           (car (last desc)) slot name)
                   'nil)
@@ -3146,7 +3146,7 @@ To see the documentation for a defined struct type, use
                   (let ((kw (car defaults)))
                     (push
                      (macroexp-warn-and-return
-                      ;; kw
+                      kw
                       (format "  I'll take `%s' to be an option rather than a default value."
                               kw)
                       'nil)

diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index db86e0e0292887282508819be71d684b4f81c1f7..59038f6e9b22a501eed4cde10493746f4e93a0c5 100644 (file)
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -230,6 +230,7 @@ INIT-VALUE LIGHTER KEYMAP.
          (warnwrap (if (or (null body) (keywordp (car body))) #'identity
                      (lambda (exp)
                        (macroexp-warn-and-return
+                        exp
                         "Use keywords rather than deprecated positional arguments to `define-minor-mode'"
                         exp))))
         keyw keymap-sym tmp)

diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 4e9357c2ada305ff0d6e31fcb0a0cb6e107539cd..b17ecd34d4d9ddaf876dab37fba501c24d2e7a94 100644 (file)
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -744,7 +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
+                  name
                   (format-message "Unknown slot `%S'" name)
                   exp nil 'compile-only))
                 (_ exp))))
@@ -781,11 +781,13 @@ Fills in CLASS's SLOT with its default value."
                 ((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))
                 ((and (or `',name (and name (pred keywordp)))
                       (guard (not (memq name eieio--known-class-slot-names))))
                  (macroexp-warn-and-return
+                  name
                   (format-message "Slot `%S' is not class-allocated" name)
                   exp nil 'compile-only))
                 (_ exp)))))
@@ -843,11 +845,13 @@ Fills in the default value in CLASS' in SLOT with VALUE."
                 ((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))
                 ((and (or `',name (and name (pred keywordp)))
                       (guard (not (memq name eieio--known-class-slot-names))))
                  (macroexp-warn-and-return
+                  name
                   (format-message "Slot `%S' is not class-allocated" name)
                   exp nil 'compile-only))
                 (_ exp)))))

diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 76f7b661a62c24d638760607945b51668ba88ba0..0d0dff6d68e256589f1989bf87f19f213e63e52b 100644 (file)
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -242,7 +242,8 @@ This method is obsolete."
 
     `(progn
        ,@(mapcar (lambda (w)
-                   (macroexp-warn-and-return w `(progn ',w) nil 'compile-only))
+                   (macroexp-warn-and-return w ; W is probably a poor choice for a position.
+                    w `(progn ',w) nil 'compile-only))
                  warnings)
        ;; This test must be created right away so we can have self-
        ;; referencing classes.  ei, a class whose slot can contain only
@@ -292,7 +293,7 @@ This method is obsolete."
                          (if (not (stringp (car slots)))
                              whole
                            (macroexp-warn-and-return
-                            ;; (car slots)
+                            (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 ed33524f2dc99a8f4b0d9a44f0056196d9dfbee1..eb65e5f1046a8793174be123a2a48ddc1cb8fc3c 100644 (file)
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -595,7 +595,7 @@ binding mode."
             (eq (car-safe code) 'cons))
         code
       (macroexp-warn-and-return
-       ;; org-place
+       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 6d114a8a5476e8f5bdccd33b60165a24af63b68a..60fac9813083c92087759e4e3948c5d6073b977b 100644 (file)
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -135,18 +135,17 @@ Other uses risk returning non-nil value that point to the wrong file."
 
 (defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
 
-(defun macroexp--warn-wrap (msg form category)
+(defun macroexp--warn-wrap (arg msg form category)
   (let ((when-compiled (lambda ()
                          (when (byte-compile-warning-enabled-p category)
-                           (byte-compile-warn-x form "%s" msg)))))
+                           (byte-compile-warn-x arg "%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 (;; _arg
-                                 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'.
@@ -161,7 +160,7 @@ is executed without being compiled first."
         ;; macroexpand-all gets right back to macroexpanding `form'.
         form
       (puthash form form macroexp--warned)
-      (macroexp--warn-wrap msg form category)))
+      (macroexp--warn-wrap arg msg form category)))
    (t
     (unless compile-only
       (message "%sWarning: %s"
@@ -217,7 +216,7 @@ is executed without being compiled first."
         (let* ((fun (car form))
                (obsolete (get fun 'byte-obsolete-info)))
           (macroexp-warn-and-return
-           ;; fun
+           fun
            (macroexp--obsolete-warning
             fun obsolete
             (if (symbolp (symbol-function fun))
@@ -273,6 +272,7 @@ is executed without being compiled first."
       (setq arglist (cdr arglist)))
     (if values
         (macroexp-warn-and-return
+         name
          (format (if (eq values 'too-few)
                      "attempt to open-code `%s' with too few arguments"
                    "attempt to open-code `%s' with too many arguments")
@@ -332,7 +332,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
          (if (null body)
              (macroexp-unprogn
               (macroexp-warn-and-return
-               ;; fun
+               fun
                (format "Empty %s body" fun)
                nil nil 'compile-only))
            (macroexp--all-forms body))
@@ -370,7 +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)
+                        (cadr arg)
                         (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 430ae97078c664aa151df0f88c696ce567ac63e0..81280d4e041f551b0be886b19a8621aa08932eba 100644 (file)
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -433,6 +433,7 @@ how many time this CODEGEN is called."
                     (memq (car case) pcase--dontwarn-upats))
           (setq main
                 (macroexp-warn-and-return
+                 (car case)
                  (format "pcase pattern %S shadowed by previous pcase pattern"
                          (car case))
                  main))))
@@ -940,7 +941,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
+             upat
              "Pattern t is deprecated.  Use `_' instead"
              code))))
        ((eq upat 'pcase--dontcare) :pcase--dontcare)

diff --git a/src/data.c b/src/data.c
index b3b157a7f39a79d1da43af6f97967f9c43bca37c..1f2af6f474351005b21a4671edad0f4f33adf43f 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -776,7 +776,7 @@ DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
 
 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)
+  (register Lisp_Object sym)
 {
   if (BARE_SYMBOL_P (sym))
     return sym;
@@ -786,12 +786,23 @@ DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0,
 
 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)
+  (register Lisp_Object ls)
 {
   /* Type checking is done in the following macro. */
   return SYMBOL_WITH_POS_POS (ls);
 }
 
+DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol,
+       Sremove_pos_from_symbol, 1, 1, 0,
+       doc: /* If ARG is a symbol with position, return it without the position.
+Otherwise, return ARG unchanged.  Compare with `bare-symbol'.  */)
+  (register Lisp_Object arg)
+{
+  if (SYMBOL_WITH_POS_P (arg))
+    return (SYMBOL_WITH_POS_SYM (arg));
+  return arg;
+}
+
 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.
@@ -4193,6 +4204,7 @@ syms_of_data (void)
   defsubr (&Ssymbol_name);
   defsubr (&Sbare_symbol);
   defsubr (&Ssymbol_with_pos_pos);
+  defsubr (&Sremove_pos_from_symbol);
   defsubr (&Sposition_symbol);
   defsubr (&Smakunbound);
   defsubr (&Sfmakunbound);

diff --git a/src/lisp.h b/src/lisp.h
index 08013e94d169adc247bf9b29540e17ffd6a1d539..00d9843d6a35c3546c4ef1daf80f4c942578c764 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -366,7 +366,7 @@ typedef EMACS_INT Lisp_Word;
 
 #define lisp_h_PSEUDOVECTORP(a,code)                            \
   (lisp_h_VECTORLIKEP((a)) &&                                   \
-   ((XUNTAG ((a), Lisp_Vectorlike, union vectorlike_header)->size       \
+   ((XUNTAG ((a), Lisp_Vectorlike, union vectorlike_header)->size     \
      & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))                    \
     == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))))
 
@@ -382,13 +382,13 @@ typedef EMACS_INT Lisp_Word;
   || (symbols_with_pos_enabled    \
   && (SYMBOL_WITH_POS_P ((x))                        \
       ? BARE_SYMBOL_P ((y))                               \
-        ? (XSYMBOL_WITH_POS((x)))->sym == (y)          \
+        ? XLI (XSYMBOL_WITH_POS((x))->sym) == XLI (y)           \
         : SYMBOL_WITH_POS_P((y))                       \
-          && ((XSYMBOL_WITH_POS((x)))->sym                   \
-              == (XSYMBOL_WITH_POS((y)))->sym)               \
+          && (XLI (XSYMBOL_WITH_POS((x))->sym)                   \
+              == XLI (XSYMBOL_WITH_POS((y))->sym))               \
       : (SYMBOL_WITH_POS_P ((y))                     \
          && BARE_SYMBOL_P ((x))                           \
-         && ((x) == ((XSYMBOL_WITH_POS ((y)))->sym))))))
+         && (XLI (x) == XLI ((XSYMBOL_WITH_POS ((y)))->sym))))))
 
 #define lisp_h_FIXNUMP(x) \
    (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \

diff --git a/src/lread.c b/src/lread.c
index 7775911c1d3cb41e6411e929310f5ad3c2a263a8..1cc5acc6d3a8169e9a05801adc2869a5bf1d8593 100644 (file)
--- a/src/lread.c
+++ b/src/lread.c
@@ -128,9 +128,8 @@ static ptrdiff_t read_from_string_index;
 static ptrdiff_t read_from_string_index_byte;
 static ptrdiff_t read_from_string_limit;
 
-/* Number of characters read in the current call to Fread or
-   Fread_from_string.  */
-static EMACS_INT readchar_count;
+/* Position in object from which characters are being read by `readchar'.  */
+static EMACS_INT readchar_offset;
 
 /* This contains the last string skipped with #@.  */
 static char *saved_doc_string;
@@ -213,7 +212,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
   if (multibyte)
     *multibyte = 0;
 
-  readchar_count++;
+  readchar_offset++;
 
   if (BUFFERP (readcharfun))
     {
@@ -424,7 +423,7 @@ skip_dyn_eof (Lisp_Object readcharfun)
 static void
 unreadchar (Lisp_Object readcharfun, int c)
 {
-  readchar_count--;
+  readchar_offset--;
   if (c == -1)
     /* Don't back up the pointer if we're unreading the end-of-input mark,
        since readchar didn't advance it when we read it.  */
@@ -2518,7 +2517,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
 {
   Lisp_Object retval;
 
-  readchar_count = 0;
+  readchar_offset = BUFFERP (stream) ? XBUFFER (stream)->pt : 0;
   /* We can get called from readevalloop which may have set these
      already.  */
   if (! HASH_TABLE_P (read_objects_map)
@@ -3773,7 +3772,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
        char *p = read_buffer;
        char *end = read_buffer + read_buffer_size;
        bool quoted = false;
-       EMACS_INT start_position = readchar_count - 1;
+       EMACS_INT start_position = readchar_offset - 1;
 
        do
          {