diff options
| author | Vibhav Pant <vibhavp@gmail.com> | 2017-01-26 00:54:59 +0530 |
|---|---|---|
| committer | Vibhav Pant <vibhavp@gmail.com> | 2017-01-26 00:54:59 +0530 |
| commit | 0d3c57dcf3187864c0b6fd6115ee80ad33faf553 (patch) | |
| tree | 752a3596b063d3810b8c192adb643a0864c617d7 /lisp/emacs-lisp | |
| parent | 23a130ee0d61fc39cee157921679809017a02b39 (diff) | |
| download | emacs-0d3c57dcf3187864c0b6fd6115ee80ad33faf553.tar.gz emacs-0d3c57dcf3187864c0b6fd6115ee80ad33faf553.tar.bz2 emacs-0d3c57dcf3187864c0b6fd6115ee80ad33faf553.zip | |
* lisp/emacs-lisp/byte-opt.el: Add support for decompiling switch
* lisp/emacs-lisp/byte-opt.el: (byte-decompile-bytecode-1) When the
constant encountered precedes a byte-switch op, replace all the
addresses in the jump table with tags.
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 27 |
1 files changed, 24 insertions, 3 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index c774d26c04b..b775976efb2 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1357,7 +1357,7 @@ (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) (let ((length (length bytes)) (bytedecomp-ptr 0) optr tags bytedecomp-op offset - lap tmp) + lap tmp last-constant) (while (not (= bytedecomp-ptr length)) (or make-spliceable (push bytedecomp-ptr lap)) @@ -1386,7 +1386,8 @@ (or (assq tmp byte-compile-variables) (let ((new (list tmp))) (push new byte-compile-variables) - new))))) + new))) + last-constant tmp)) ((eq bytedecomp-op 'byte-stack-set2) (setq bytedecomp-op 'byte-stack-set)) ((and (eq bytedecomp-op 'byte-discardN) (>= offset #x80)) @@ -1395,7 +1396,27 @@ ;; lapcode, we represent this by using a different opcode ;; (with the flag removed from the operand). (setq bytedecomp-op 'byte-discardN-preserve-tos) - (setq offset (- offset #x80)))) + (setq offset (- offset #x80))) + ((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))) ;; lap = ( [ (pc . (op . arg)) ]* ) (push (cons optr (cons bytedecomp-op (or offset 0))) lap) |