aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAlan Mackenzie2022-02-24 17:30:39 +0000
committerAlan Mackenzie2022-02-24 17:30:39 +0000
commit6092ee1c3ff503fbe8087e13b7eae2f904c4af3b (patch)
tree1486437e4446aadebfb6a6b7ec06299f9ba96c9e
parent2db149539bc7f9720856f1d17f0e7fa9bf735ea1 (diff)
downloademacs-6092ee1c3ff503fbe8087e13b7eae2f904c4af3b.tar.gz
emacs-6092ee1c3ff503fbe8087e13b7eae2f904c4af3b.zip
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.
37 37
38The purpose of this is to detect circular structures.") 38The purpose of this is to detect circular structures.")
39 39
40(defalias 'byte-run--strip-s-p-1 40(defalias 'byte-run--strip-list
41 #'(lambda (arg) 41 #'(lambda (arg)
42 "Strip all positions from symbols in ARG, modifying ARG. 42 "Strip the positions from symbols with position in the list ARG.
43Return the modified ARG." 43This is done by destructively modifying ARG. Return ARG."
44 (let ((a arg))
45 (while
46 (and
47 (not (gethash a byte-run--ssp-seen))
48 (progn
49 (puthash a t byte-run--ssp-seen)
50 (cond
51 ((symbol-with-pos-p (car a))
52 (setcar a (bare-symbol (car a))))
53 ((consp (car a))
54 (byte-run--strip-list (car a)))
55 ((or (vectorp (car a)) (recordp (car a)))
56 (byte-run--strip-vector/record (car a))))
57 (consp (cdr a))))
58 (setq a (cdr a)))
59 (cond
60 ((symbol-with-pos-p (cdr a))
61 (setcdr a (bare-symbol (cdr a))))
62 ((or (vectorp (cdr a)) (recordp (cdr a)))
63 (byte-run--strip-vector/record (cdr a))))
64 arg)))
65
66(defalias 'byte-run--strip-vector/record
67 #'(lambda (arg)
68 "Strip the positions from symbols with position in the vector/record ARG.
69This is done by destructively modifying ARG. Return ARG."
70 (unless (gethash arg byte-run--ssp-seen)
71 (let ((len (length arg))
72 (i 0)
73 elt)
74 (puthash arg t byte-run--ssp-seen)
75 (while (< i len)
76 (setq elt (aref arg i))
77 (cond
78 ((symbol-with-pos-p elt)
79 (aset arg i elt))
80 ((consp elt)
81 (byte-run--strip-list elt))
82 ((or (vectorp elt) (recordp elt))
83 (byte-run--strip-vector/record elt))))))
84 arg))
85
86(defalias 'byte-run-strip-symbol-positions
87 #'(lambda (arg)
88 "Strip all positions from symbols in ARG.
89This modifies destructively then returns ARG.
90
91ARG is any Lisp object, but is usually a list or a vector or a
92record, containing symbols with position."
93 (setq byte-run--ssp-seen (make-hash-table :test 'eq))
44 (cond 94 (cond
45 ((symbol-with-pos-p arg) 95 ((symbol-with-pos-p arg)
46 (bare-symbol arg)) 96 (bare-symbol arg))
47
48 ((consp arg) 97 ((consp arg)
49 (let* ((hash (gethash arg byte-run--ssp-seen))) 98 (byte-run--strip-list arg))
50 (if hash ; Already processed this node.
51 arg
52 (let ((a arg) new)
53 (while
54 (progn
55 (puthash a t byte-run--ssp-seen)
56 (setq new (byte-run--strip-s-p-1 (car a)))
57 (setcar a new)
58 (and (consp (cdr a))
59 (not
60 (setq hash (gethash (cdr a) byte-run--ssp-seen)))))
61 (setq a (cdr a)))
62 (setq new (byte-run--strip-s-p-1 (cdr a)))
63 (setcdr a new)
64 arg))))
65
66 ((or (vectorp arg) (recordp arg)) 99 ((or (vectorp arg) (recordp arg))
67 (let ((hash (gethash arg byte-run--ssp-seen))) 100 (byte-run--strip-vector/record arg))
68 (if hash
69 arg
70 (let* ((len (length arg))
71 (i 0)
72 new)
73 (puthash arg t byte-run--ssp-seen)
74 (while (< i len)
75 (setq new (byte-run--strip-s-p-1 (aref arg i)))
76 (aset arg i new)
77 (setq i (1+ i)))
78 arg))))
79
80 (t arg)))) 101 (t arg))))
81 102
82(defalias 'byte-run-strip-symbol-positions
83 #'(lambda (arg)
84 (setq byte-run--ssp-seen (make-hash-table :test 'eq))
85 (byte-run--strip-s-p-1 arg)))
86
87(defalias 'function-put 103(defalias 'function-put
88 ;; We don't want people to just use `put' because we can't conveniently 104 ;; We don't want people to just use `put' because we can't conveniently
89 ;; hook into `put' to remap old properties to new ones. But for now, there's 105 ;; hook into `put' to remap old properties to new ones. But for now, there's
@@ -92,9 +108,7 @@ Return the modified ARG."
92 "Set FUNCTION's property PROP to VALUE. 108 "Set FUNCTION's property PROP to VALUE.
93The namespace for PROP is shared with symbols. 109The namespace for PROP is shared with symbols.
94So far, FUNCTION can only be a symbol, not a lambda expression." 110So far, FUNCTION can only be a symbol, not a lambda expression."
95 (put (bare-symbol function) 111 (put (bare-symbol function) prop value)))
96 (byte-run-strip-symbol-positions prop)
97 (byte-run-strip-symbol-positions value))))
98(function-put 'defmacro 'doc-string-elt 3) 112(function-put 'defmacro 'doc-string-elt 3)
99(function-put 'defmacro 'lisp-indent-function 2) 113(function-put 'defmacro 'lisp-indent-function 2)
100 114
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."
5099OP and OPERAND are as passed to `byte-compile-out'." 5099OP and OPERAND are as passed to `byte-compile-out'."
5100 (if (memq op '(byte-call byte-discardN byte-discardN-preserve-tos)) 5100 (if (memq op '(byte-call byte-discardN byte-discardN-preserve-tos))
5101 ;; For calls, OPERAND is the number of args, so we pop OPERAND + 1 5101 ;; For calls, OPERAND is the number of args, so we pop OPERAND + 1
5102 ;; elements, and the push the result, for a total of -OPERAND. 5102 ;; elements, and then push the result, for a total of -OPERAND.
5103 ;; For discardN*, of course, we just pop OPERAND elements. 5103 ;; For discardN*, of course, we just pop OPERAND elements.
5104 (- operand) 5104 (- operand)
5105 (or (aref byte-stack+-info (symbol-value op)) 5105 (or (aref byte-stack+-info (symbol-value op))
@@ -5109,7 +5109,6 @@ OP and OPERAND are as passed to `byte-compile-out'."
5109 (- 1 operand)))) 5109 (- 1 operand))))
5110 5110
5111(defun byte-compile-out (op &optional operand) 5111(defun byte-compile-out (op &optional operand)
5112 (setq operand (byte-run-strip-symbol-positions operand))
5113 (push (cons op operand) byte-compile-output) 5112 (push (cons op operand) byte-compile-output)
5114 (if (eq op 'byte-return) 5113 (if (eq op 'byte-return)
5115 ;; This is actually an unnecessary case, because there should be no 5114 ;; This is actually an unnecessary case, because there should be no