bug#54098: 29.0.50; Unexec build broken

[Alan Mackenzie <acm@muc.de>]

Hello, Po.

On Tue, Feb 22, 2022 at 19:17:25 +0800, Po Lu wrote:
> Alan Mackenzie <acm@muc.de> writes:

> >> It should return a copy of the form instead, but I don't know if the
> >> rest of the byte compiler relies on the side effects symbol position
> >> stripping.
> >
> > There are no such dependencies.  It's just that copying a Lisp structure
> > is difficult.  For example, copy-tree doesn't work when there are
> > circular lists.
> >
> > But making a copy would indeed be better.  Maybe I can hack something
> > together from first principles, that would handle circular structures
> > correctly.
> >
> >> Alan, WDYT?
> >
> > I'll look at it.  I think I should be able to fix it.

> Thanks.

I've changed approach.  The previous code was continually overwriting
Lisp objects with themselves, particularly where it didn't need doing.
This is surely (??) what was happening in the pure storage.

I've rewritten byte-run-strip-symbol-positions, so that changes are only
attempted where they're needed, i.e. where a symbol with position gets
replaced by its bare symbol.

I'm hoping that this will now work OK, though I don't have a setup using
unexec to test it with.  Would you please test it.

I'm tending to the view that we need to make this function available to
Lisp hackers.  I think we need both varieties of the function (the one
that makes a copy, and the one that modifies in situ), and that they
should be called simply strip-symbol-positions and
n-strip-symbol-positions (like reverse and nreverse).

Anyhow, here's the patch:



diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index c542c55016..d7a2d8ceca 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -37,53 +37,69 @@ byte-run--ssp-seen
 
 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 @@ 'function-put
       "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 c59bb292f8..6f83429dd4 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -5099,7 +5099,7 @@ byte-compile-stack-adjustment
 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 @@ byte-compile-stack-adjustment
 	(- 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



-- 
Alan Mackenzie (Nuremberg, Germany).