summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlan Mackenzie <acm@muc.de>2022-02-24 17:30:39 +0000
committerAlan Mackenzie <acm@muc.de>2022-02-24 17:30:39 +0000
commit6092ee1c3ff503fbe8087e13b7eae2f904c4af3b (patch)
tree1486437e4446aadebfb6a6b7ec06299f9ba96c9e
parent2db149539bc7f9720856f1d17f0e7fa9bf735ea1 (diff)
downloademacs-6092ee1c3ff503fbe8087e13b7eae2f904c4af3b.tar.gz
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.
-rw-r--r--lisp/emacs-lisp/byte-run.el98
-rw-r--r--lisp/emacs-lisp/bytecomp.el3
2 files changed, 57 insertions, 44 deletions
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index c542c550169..d7a2d8cecaf 100644
--- 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 c59bb292f8f..6f83429dd4b 100644
--- 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