diff options
author | Vibhav Pant <vibhavp@gmail.com> | 2017-02-05 18:49:24 +0530 |
---|---|---|
committer | Vibhav Pant <vibhavp@gmail.com> | 2017-02-05 18:49:24 +0530 |
commit | 84eef501554324b22c7a838aabed77aa79315121 (patch) | |
tree | 359db36a7c46b57ee6d55016edf522a8edf7f5be /lisp/emacs-lisp | |
parent | 44c95c58b26b7b9d75965a83930ec3d77ffae28f (diff) | |
download | emacs-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.el | 39 |
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) |