diff options
author | Alan Mackenzie <acm@muc.de> | 2022-02-24 17:30:39 +0000 |
---|---|---|
committer | Alan Mackenzie <acm@muc.de> | 2022-02-24 17:30:39 +0000 |
commit | 6092ee1c3ff503fbe8087e13b7eae2f904c4af3b (patch) | |
tree | 1486437e4446aadebfb6a6b7ec06299f9ba96c9e | |
parent | 2db149539bc7f9720856f1d17f0e7fa9bf735ea1 (diff) | |
download | emacs-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.el | 98 | ||||
-rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 3 |
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 |