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

fix push handler propagation

Browse source
This commit is contained in:
Andrea Corallo 2019-09-22 20:58:26 +02:00
parent 84caa1a404
commit 59d53e1fde
2 changed files with 19 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -644,7 +644,9 @@ If NEGATED non nil negate the tested condition."
(let ((guarded-bb (comp-new-block-sym)))
(comp-block-maybe-add :name guarded-bb :sp (comp-sp))
(let ((handler-bb (comp-lap-to-limple-bb guarded-label)))
(comp-emit (list 'push-handler (comp-slot+1)
(comp-emit (list 'push-handler
(comp-slot+1)
(comp-slot+1)
handler-type
handler-bb
guarded-bb))
@ -1022,7 +1024,7 @@ Top level forms for the current context are rendered too."
(cl-loop with blocks = (comp-func-blocks comp-func)
for bb being each hash-value of blocks
for last-insn = (car (last (comp-block-insns bb)))
for (op first second third forth) = last-insn
for (op first second third forth fifth) = last-insn
do (cl-case op
(jump
(edge-add :src bb :dst (gethash first blocks)))
@ -1033,8 +1035,8 @@ Top level forms for the current context are rendered too."
(edge-add :src bb :dst (gethash second blocks))
(edge-add :src bb :dst (gethash third blocks)))
(push-handler
(edge-add :src bb :dst (gethash third blocks))
(edge-add :src bb :dst (gethash forth blocks)))
(edge-add :src bb :dst (gethash forth blocks))
(edge-add :src bb :dst (gethash fifth blocks)))
(return)
(otherwise
(error "Block %s does not end with a branch in func %s"

20
src/comp.c
View file

@ -62,6 +62,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
XCAR (XCDR (XCDR (x)))
#define FORTH(x) \
XCAR (XCDR (XCDR (XCDR (x))))
#define FIFTH(x) \
XCAR (XCDR (XCDR (XCDR (XCDR (x)))))
#define FUNCALL1(fun, arg) \
CALLN (Ffuncall, intern_c_string (STR(fun)), arg)
@ -1149,7 +1151,11 @@ emit_limple_push_handler (gcc_jit_rvalue *handler, gcc_jit_rvalue *handler_type,
gcc_jit_block *handler_bb, gcc_jit_block *guarded_bb,
Lisp_Object clobbered_mvar)
{
/* Ex: (push-handler #s(comp-mvar 6 0 t (arith-error) nil) 1 bb_3 bb_2). */
/*
Ex: (push-handler #s(comp-mvar 1 8 nil nil nil nil)
#s(comp-mvar 1 7 t done symbol nil)
catcher bb_2 bb_1).
*/
static unsigned pushhandler_n; /* FIXME move at ctxt or func level. */
@ -1158,8 +1164,7 @@ emit_limple_push_handler (gcc_jit_rvalue *handler, gcc_jit_rvalue *handler_type,
gcc_jit_function_new_local (comp.func,
NULL,
comp.handler_ptr_type,
format_string ("c_%u",
pushhandler_n));
format_string ("c_%u", pushhandler_n));
gcc_jit_rvalue *args[] = { handler, handler_type };
gcc_jit_block_add_assignment (
@ -1263,9 +1268,10 @@ emit_limple_insn (Lisp_Object insn)
{
gcc_jit_rvalue *handler = emit_mvar_val (arg0);
int h_num UNINIT;
if (EQ (SECOND (args), Qcatcher))
Lisp_Object handler_spec = THIRD (args);
if (EQ (handler_spec, Qcatcher))
h_num = CATCHER;
else if (EQ (SECOND (args), Qcondition_case))
else if (EQ (handler_spec, Qcondition_case))
h_num = CONDITION_CASE;
else
ice ("incoherent insn");
@ -1273,8 +1279,8 @@ emit_limple_insn (Lisp_Object insn)
gcc_jit_context_new_rvalue_from_int (comp.ctxt,
comp.int_type,
h_num);
gcc_jit_block *handler_bb = retrive_block (THIRD (args));
gcc_jit_block *guarded_bb = retrive_block (FORTH (args));
gcc_jit_block *handler_bb = retrive_block (FORTH (args));
gcc_jit_block *guarded_bb = retrive_block (FIFTH (args));
emit_limple_push_handler (handler, handler_type, handler_bb, guarded_bb,
arg0);
}