mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-13 09:32:47 +00:00
Code Issues Releases Activity

* Fix bug#41112

Browse Source 
* lisp/emacs-lisp/comp.el (comp-jump-table-optimizable): New
	function.
	(comp-emit-switch): Make use of 'comp-jump-table-optimizable'.
This commit is contained in:
Andrea Corallo 2020-05-07 08:10:50 +01:00
parent 92cf4bb8cc
commit cf105f6044
1 changed files with 42 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
lisp/emacs-lisp/comp.el
View File

@ -850,44 +850,56 @@ Return value is the fall through block name."
(`(TAG ,label . ,_)
(puthash label addr (comp-limplify-label-to-addr comp-pass))))))
(defun comp-jump-table-optimizable (jmp-table)
"Return t if JMP-TABLE can be optimized out."
(cl-loop
with labels = (cl-loop for target-label being each hash-value of jmp-table
collect target-label)
with x = (car labels)
for l in (cdr-safe labels)
unless (= l x)
return nil
finally return t))
(defun comp-emit-switch (var last-insn)
"Emit a limple for a lap jump table given VAR and LAST-INSN."
;; FIXME this not efficient for big jump tables. We should have a second
;; strategy for this case.
(pcase last-insn
(`(setimm ,_ ,jmp-table)
(cl-loop
for test being each hash-keys of jmp-table
using (hash-value target-label)
with len = (hash-table-count jmp-table)
with test-func = (hash-table-test jmp-table)
for n from 1
for last = (= n len)
for m-test = (make-comp-mvar :constant test)
for target-name = (comp-block-name (comp-bb-maybe-add (comp-label-to-addr target-label)
(comp-sp)))
for ff-bb = (if last
(comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
(comp-sp))
(make--comp-block nil
(comp-sp)
(comp-new-block-sym)))
for ff-bb-name = (comp-block-name ff-bb)
if (eq test-func 'eq)
do (comp-emit (list 'cond-jump var m-test ff-bb-name target-name))
else
(unless (comp-jump-table-optimizable jmp-table)
(cl-loop
for test being each hash-keys of jmp-table
using (hash-value target-label)
with len = (hash-table-count jmp-table)
with test-func = (hash-table-test jmp-table)
for n from 1
for last = (= n len)
for m-test = (make-comp-mvar :constant test)
for target-name = (comp-block-name (comp-bb-maybe-add (comp-label-to-addr target-label)
(comp-sp)))
for ff-bb = (if last
(comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
(comp-sp))
(make--comp-block nil
(comp-sp)
(comp-new-block-sym)))
for ff-bb-name = (comp-block-name ff-bb)
if (eq test-func 'eq)
do (comp-emit (list 'cond-jump var m-test ff-bb-name target-name))
else
;; Store the result of the comparison into the scratch slot before
;; emitting the conditional jump.
do (comp-emit (list 'set (make-comp-mvar :slot 'scratch)
(comp-call test-func var m-test)))
(comp-emit (list 'cond-jump
(make-comp-mvar :slot 'scratch)
(make-comp-mvar :constant nil)
target-name ff-bb-name))
do (unless last
;; All fall through are artificially created here except the last one.
(puthash ff-bb-name ff-bb (comp-func-blocks comp-func))
(setf (comp-limplify-curr-block comp-pass) ff-bb))))
do (comp-emit (list 'set (make-comp-mvar :slot 'scratch)
(comp-call test-func var m-test)))
(comp-emit (list 'cond-jump
(make-comp-mvar :slot 'scratch)
(make-comp-mvar :constant nil)
target-name ff-bb-name))
unless last
;; All fall through are artificially created here except the last one.
do (puthash ff-bb-name ff-bb (comp-func-blocks comp-func))
(setf (comp-limplify-curr-block comp-pass) ff-bb))))
(_ (signal 'native-ice
"missing previous setimm while creating a switch"))))