mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 18:40:39 -08:00
Code Issues Projects Releases Wiki Activity

fix jump table emission when test fn is not eq

Browse source
This commit is contained in:
Andrea Corallo 2019-11-18 00:05:55 +01:00
parent 42b08f8a9a
commit a99a3fbc40
2 changed files with 35 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

33
lisp/emacs-lisp/comp.el
View file

@ -256,7 +256,8 @@ structure.")
(cl-defstruct (comp-mvar (:constructor make--comp-mvar))
"A meta-variable being a slot in the meta-stack."
(slot nil :type fixnum
:documentation "Slot number.")
:documentation "Slot number.
-1 is a special value and indicates the scratch slot.")
(id nil :type (or null number)
:documentation "SSA number.")
(const-vld nil :type boolean
@ -712,12 +713,15 @@ Return value is the fall through block name."
(defun comp-emit-switch (var last-insn)
"Emit a limple for a lap jump table given VAR and LAST-INSN."
;; FIXME this not efficent for big jump tables. We should have a second
;; strategy for this case.
(pcase last-insn
(`(setimm ,_ ,_ ,const)
(`(setimm ,_ ,_ ,jmp-table)
(cl-loop
for test being each hash-keys of const
for test being each hash-keys of jmp-table
using (hash-value target-label)
with len = (hash-table-count const)
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)
@ -730,12 +734,21 @@ Return value is the fall through block name."
(comp-sp)
(comp-new-block-sym)))
for ff-bb-name = (comp-block-name ff-bb)
do
(comp-emit (list 'cond-jump var m-test ff-bb-name target-name))
(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))))
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 -1)
(comp-call test-func var m-test)))
(comp-emit (list 'cond-jump
(make-comp-mvar :slot -1)
(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))))
(_ (error "Missing previous setimm while creating a switch"))))
(defun comp-emit-set-call-subr (subr-name sp-delta)

12
src/comp.c
View file

@ -146,6 +146,7 @@ typedef struct {
gcc_jit_block *block; /* Current basic block being compiled. */
gcc_jit_lvalue **frame; /* Frame for the current function. */
gcc_jit_lvalue **f_frame; /* "Floating" frame for the current function. */
gcc_jit_lvalue *scratch; /* Used as scratch slot for some code sequence (switch). */
gcc_jit_rvalue *most_positive_fixnum;
gcc_jit_rvalue *most_negative_fixnum;
gcc_jit_rvalue *one;
@ -301,6 +302,15 @@ static gcc_jit_lvalue *
get_slot (Lisp_Object mvar)
{
EMACS_INT slot_n = XFIXNUM (CALL1I (comp-mvar-slot, mvar));
if (slot_n == -1)
{
if (!comp.scratch)
comp.scratch = gcc_jit_function_new_local (comp.func,
NULL,
comp.lisp_obj_type,
"scratch");
return comp.scratch;
}
gcc_jit_lvalue **frame =
(CALL1I (comp-mvar-ref, mvar) || SPEED < 2)
? comp.frame : comp.f_frame;
@ -2823,6 +2833,8 @@ compile_function (Lisp_Object func)
format_string ("local%u", i));
}
comp.scratch = NULL;
comp.loc_handler = gcc_jit_function_new_local (comp.func,
NULL,
comp.handler_ptr_type,