summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorVibhav Pant <vibhavp@gmail.com>2017-02-05 18:49:24 +0530
committerVibhav Pant <vibhavp@gmail.com>2017-02-05 18:49:24 +0530
commit84eef501554324b22c7a838aabed77aa79315121 (patch)
tree359db36a7c46b57ee6d55016edf522a8edf7f5be /lisp/emacs-lisp
parent44c95c58b26b7b9d75965a83930ec3d77ffae28f (diff)
downloademacs-84eef501554324b22c7a838aabed77aa79315121.tar.gz
emacs-84eef501554324b22c7a838aabed77aa79315121.tar.bz2
emacs-84eef501554324b22c7a838aabed77aa79315121.zip
byte-opt.el: Replace jump tables while decompiling correctly.
* lisp/emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): Don't make a copy of the constant vector, as it isn't used with the decompiled lapcode. Make sure that the correct lapcode pair/list is being modified while replacing the jump table.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/byte-opt.el39
1 files changed, 22 insertions, 17 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index b775976efb2..b962916e67a 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1400,23 +1400,28 @@
((eq bytedecomp-op 'byte-switch)
(cl-assert (hash-table-p last-constant) nil
"byte-switch used without preceeding hash table")
- ;; make a copy of constvec to avoid making changes to the
- ;; original jump table for the compiled function.
- (setq constvec (cl-map 'vector
- #'(lambda (e)
- (if (eq last-constant e)
- (setq last-constant (copy-hash-table e))
- e))
- constvec))
- (maphash #'(lambda (value tag)
- (let (newtag)
- (cl-assert (consp tag)
- nil "Invalid address for byte-switch")
- (setq newtag (byte-compile-make-tag))
- (push (cons (+ (car tag) (lsh (cdr tag) 8)) newtag) tags)
- (puthash value newtag last-constant)))
- last-constant)
- (setf (nth 2 (cadr lap)) last-constant)))
+ ;; We cannot use the original hash table referenced in the op,
+ ;; so we create a copy of it, and replace the addresses with
+ ;; TAGs.
+ (let ((orig-table last-constant))
+ (cl-loop for e across constvec
+ when (= e last-constant)
+ do (setq last-constant (copy-hash-table e))
+ and return nil)
+ ;; Replace all addresses with TAGs.
+ (maphash #'(lambda (value tag)
+ (let (newtag)
+ (cl-assert (consp tag)
+ nil "Invalid address for byte-switch")
+ (setq newtag (byte-compile-make-tag))
+ (push (cons (+ (car tag) (lsh (cdr tag) 8)) newtag) tags)
+ (puthash value newtag last-constant)))
+ last-constant)
+ (cl-loop for el in-ref lap
+ when (and (listp el)
+ (eq (nth 1 el) 'byte-constant)
+ (eq (nth 2 el) orig-table))
+ do (setf (nth 2 el) last-constant) and return nil))))
;; lap = ( [ (pc . (op . arg)) ]* )
(push (cons optr (cons bytedecomp-op (or offset 0)))
lap)