Amend byte-run-strip-symbol-positions so that an unexec build builds

This fixes bug #54098.

* lisp/emacs-lisp/byte-run.el (byte-run--strip-list)
(byte-run--strip-vector/record): New functions.  These alter a list or
vector/record structure only where a symbol with position gets replaced by a
bare symbol.
(byte-run-strip-symbol-positions): Reformulate to use the two new functions.
(function-put): No longer strip positions from the second and third arguments.

* lisp/emacs-lisp/bytecomp.el (byte-compile-out): Remove the senseless
"stripping" of putative symbol positions from OPERAND, which is nil or a
number.

diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index c542c55016968089cb122bb92340d114161a8242..d7a2d8cecaf08a23bb230f3b91994b8750fb7db4 100644 (file)
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -37,53 +37,69 @@ the corresponding new element of the same type.
 
 The purpose of this is to detect circular structures.")
 
-(defalias 'byte-run--strip-s-p-1
+(defalias 'byte-run--strip-list
   #'(lambda (arg)
-      "Strip all positions from symbols in ARG, modifying ARG.
-Return the modified ARG."
+      "Strip the positions from symbols with position in the list ARG.
+This is done by destructively modifying ARG.  Return ARG."
+      (let ((a arg))
+        (while
+            (and
+             (not (gethash a byte-run--ssp-seen))
+             (progn
+               (puthash a t byte-run--ssp-seen)
+               (cond
+                ((symbol-with-pos-p (car a))
+                 (setcar a (bare-symbol (car a))))
+                ((consp (car a))
+                 (byte-run--strip-list (car a)))
+                ((or (vectorp (car a)) (recordp (car a)))
+                 (byte-run--strip-vector/record (car a))))
+               (consp (cdr a))))
+          (setq a (cdr a)))
+        (cond
+         ((symbol-with-pos-p (cdr a))
+          (setcdr a (bare-symbol (cdr a))))
+         ((or (vectorp (cdr a)) (recordp (cdr a)))
+          (byte-run--strip-vector/record (cdr a))))
+        arg)))
+
+(defalias 'byte-run--strip-vector/record
+  #'(lambda (arg)
+      "Strip the positions from symbols with position in the vector/record ARG.
+This is done by destructively modifying ARG.  Return ARG."
+      (unless (gethash arg byte-run--ssp-seen)
+        (let ((len (length arg))
+              (i 0)
+              elt)
+          (puthash arg t byte-run--ssp-seen)
+          (while (< i len)
+            (setq elt (aref arg i))
+            (cond
+             ((symbol-with-pos-p elt)
+              (aset arg i elt))
+             ((consp elt)
+              (byte-run--strip-list elt))
+             ((or (vectorp elt) (recordp elt))
+              (byte-run--strip-vector/record elt))))))
+      arg))
+
+(defalias 'byte-run-strip-symbol-positions
+  #'(lambda (arg)
+      "Strip all positions from symbols in ARG.
+This modifies destructively then returns ARG.
+
+ARG is any Lisp object, but is usually a list or a vector or a
+record, containing symbols with position."
+      (setq byte-run--ssp-seen (make-hash-table :test 'eq))
       (cond
        ((symbol-with-pos-p arg)
         (bare-symbol arg))
-
        ((consp arg)
-        (let* ((hash (gethash arg byte-run--ssp-seen)))
-          (if hash                      ; Already processed this node.
-              arg
-            (let ((a arg) new)
-              (while
-                  (progn
-                    (puthash a t byte-run--ssp-seen)
-                    (setq new (byte-run--strip-s-p-1 (car a)))
-                    (setcar a new)
-                    (and (consp (cdr a))
-                         (not
-                          (setq hash (gethash (cdr a) byte-run--ssp-seen)))))
-                (setq a (cdr a)))
-              (setq new (byte-run--strip-s-p-1 (cdr a)))
-              (setcdr a new)
-              arg))))
-
+        (byte-run--strip-list arg))
        ((or (vectorp arg) (recordp arg))
-        (let ((hash (gethash arg byte-run--ssp-seen)))
-          (if hash
-              arg
-            (let* ((len (length arg))
-                   (i 0)
-                   new)
-              (puthash arg t byte-run--ssp-seen)
-              (while (< i len)
-                (setq new (byte-run--strip-s-p-1 (aref arg i)))
-                (aset arg i new)
-                (setq i (1+ i)))
-              arg))))
-
+        (byte-run--strip-vector/record arg))
        (t arg))))
 
-(defalias 'byte-run-strip-symbol-positions
-  #'(lambda (arg)
-      (setq byte-run--ssp-seen (make-hash-table :test 'eq))
-      (byte-run--strip-s-p-1 arg)))
-
 (defalias 'function-put
   ;; We don't want people to just use `put' because we can't conveniently
   ;; hook into `put' to remap old properties to new ones.  But for now, there's
@@ -92,9 +108,7 @@ Return the modified ARG."
       "Set FUNCTION's property PROP to VALUE.
 The namespace for PROP is shared with symbols.
 So far, FUNCTION can only be a symbol, not a lambda expression."
-      (put (bare-symbol function)
-           (byte-run-strip-symbol-positions prop)
-           (byte-run-strip-symbol-positions value))))
+      (put (bare-symbol function) prop value)))
 (function-put 'defmacro 'doc-string-elt 3)
 (function-put 'defmacro 'lisp-indent-function 2)
 

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c59bb292f8f65d8aafea07757c8554599c22faa8..6f83429dd4b6473ae6b80717fa1ccc183a7a53d2 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -5099,7 +5099,7 @@ binding slots have been popped."
 OP and OPERAND are as passed to `byte-compile-out'."
   (if (memq op '(byte-call byte-discardN byte-discardN-preserve-tos))
       ;; For calls, OPERAND is the number of args, so we pop OPERAND + 1
-      ;; elements, and the push the result, for a total of -OPERAND.
+      ;; elements, and then push the result, for a total of -OPERAND.
       ;; For discardN*, of course, we just pop OPERAND elements.
       (- operand)
     (or (aref byte-stack+-info (symbol-value op))
@@ -5109,7 +5109,6 @@ OP and OPERAND are as passed to `byte-compile-out'."
        (- 1 operand))))
 
 (defun byte-compile-out (op &optional operand)
-  (setq operand (byte-run-strip-symbol-positions operand))
   (push (cons op operand) byte-compile-output)
   (if (eq op 'byte-return)
       ;; This is actually an unnecessary case, because there should be no