From 2ee2c67736cd76a52a2eb1002d0ec15e883082e0 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 10 Nov 2019 10:17:24 +0100 Subject: [PATCH] simplify non local exit handler mechanism --- lisp/emacs-lisp/comp.el | 17 ++++------- src/comp.c | 63 ++++++++++++++++++++--------------------- 2 files changed, 36 insertions(+), 44 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index cb001bc884c..377886996ea 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -221,9 +221,7 @@ structure.") (edge-cnt-gen (funcall #'comp-gen-counter) :type function :documentation "Generates edges numbers.") (ssa-cnt-gen (funcall #'comp-gen-counter) :type function - :documentation "Counter to create ssa limple vars.") - (handler-cnt 0 :type number - :documentation "Number of non local handler buffers.")) + :documentation "Counter to create ssa limple vars.")) (defun comp-func-reset-generators (func) "Reset unique id generators for FUNC." @@ -648,17 +646,14 @@ Return value is the fall through block name." (let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) (comp-sp))) (handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num) - (1+ (comp-sp)))) - (handler-buff-n (comp-func-handler-cnt comp-func))) + (1+ (comp-sp))))) (comp-emit (list 'push-handler handler-type (comp-slot+1) - handler-buff-n (comp-block-name handler-bb) (comp-block-name guarded-bb))) (setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t) - (comp-emit-as-head `(fetch-handler ,(comp-slot+1) ,handler-buff-n) handler-bb) - (cl-incf (comp-func-handler-cnt comp-func))))) + (comp-emit-as-head `(fetch-handler ,(comp-slot+1)) handler-bb)))) (defun comp-limplify-listn (n) "Limplify list N." @@ -1181,7 +1176,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 fifth) = last-insn + for (op first second third forth) = last-insn do (cl-case op (jump (edge-add :src bb :dst (gethash first blocks))) @@ -1192,8 +1187,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 forth blocks)) - (edge-add :src bb :dst (gethash fifth blocks))) + (edge-add :src bb :dst (gethash third blocks)) + (edge-add :src bb :dst (gethash forth blocks))) (return) (otherwise (error "Block %s does not end with a branch in func %s" diff --git a/src/comp.c b/src/comp.c index 07c35413dde..cce4f1d6e52 100644 --- a/src/comp.c +++ b/src/comp.c @@ -55,6 +55,7 @@ along with GNU Emacs. If not, see . */ #define THIRD(x) \ XCAR (XCDR (XCDR (x))) +/* FIXME with call1 */ #define FUNCALL1(fun, arg) \ CALLN (Ffuncall, intern_c_string (STR(fun)), arg) @@ -114,6 +115,7 @@ typedef struct { gcc_jit_field *handler_val_field; gcc_jit_field *handler_next_field; gcc_jit_type *handler_ptr_type; + gcc_jit_lvalue *loc_handler; /* struct thread_state. */ gcc_jit_struct *thread_state_s; gcc_jit_field *m_handlerlist; @@ -161,7 +163,6 @@ typedef struct { Lisp_Object func_blocks_h; /* blk_name -> gcc_block. */ Lisp_Object exported_funcs_h; /* subr_name -> gcc_jit_function *. */ Lisp_Object imported_funcs_h; /* subr_name -> reloc_field. */ - Lisp_Object buffer_handler_vec; /* All locals used to store non local exit values. */ Lisp_Object emitter_dispatcher; gcc_jit_rvalue *data_relocs; /* Synthesized struct holding data relocs. */ gcc_jit_lvalue *func_relocs; /* Synthesized struct holding func relocs. */ @@ -1145,25 +1146,23 @@ emit_limple_call_ref (Lisp_Object insn, bool direct) static void emit_limple_push_handler (gcc_jit_rvalue *handler, gcc_jit_rvalue *handler_type, - EMACS_UINT handler_buff_n, gcc_jit_block *handler_bb, - gcc_jit_block *guarded_bb, Lisp_Object clobbered_mvar) + gcc_jit_block *handler_bb, gcc_jit_block *guarded_bb, + Lisp_Object clobbered_mvar) { /* struct handler *c = push_handler (POP, type); */ - gcc_jit_lvalue *c = - xmint_pointer (AREF (comp.buffer_handler_vec, handler_buff_n)); gcc_jit_rvalue *args[] = { handler, handler_type }; gcc_jit_block_add_assignment ( comp.block, NULL, - c, + comp.loc_handler, emit_call (intern_c_string ("push_handler"), comp.handler_ptr_type, 2, args, false)); args[0] = gcc_jit_lvalue_get_address ( gcc_jit_rvalue_dereference_field ( - gcc_jit_lvalue_as_rvalue (c), + gcc_jit_lvalue_as_rvalue (comp.loc_handler), NULL, comp.handler_jmp_field), NULL); @@ -1236,10 +1235,9 @@ emit_limple_insn (Lisp_Object insn) else if (EQ (op, Qpush_handler)) { /* (push-handler condition-case #s(comp-mvar 0 3 t (arith-error) cons nil) 1 bb_2 bb_1) */ - gcc_jit_rvalue *handler = emit_mvar_val (arg[1]); int h_num UNINIT; Lisp_Object handler_spec = arg[0]; - EMACS_UINT handler_buff_n = XFIXNUM (arg[2]); + gcc_jit_rvalue *handler = emit_mvar_val (arg[1]); if (EQ (handler_spec, Qcatcher)) h_num = CATCHER; else if (EQ (handler_spec, Qcondition_case)) @@ -1250,10 +1248,10 @@ 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 (arg[3]); - gcc_jit_block *guarded_bb = retrive_block (arg[4]); - emit_limple_push_handler (handler, handler_type, handler_buff_n, - handler_bb, guarded_bb, arg[0]); + gcc_jit_block *handler_bb = retrive_block (arg[2]); + gcc_jit_block *guarded_bb = retrive_block (arg[3]); + emit_limple_push_handler (handler, handler_type, handler_bb, guarded_bb, + arg[0]); } else if (EQ (op, Qpop_handler)) { @@ -1281,29 +1279,33 @@ emit_limple_insn (Lisp_Object insn) } else if (EQ (op, Qfetch_handler)) { - EMACS_UINT handler_buff_n = XFIXNUM (arg[1]); - gcc_jit_lvalue *c = - xmint_pointer (AREF (comp.buffer_handler_vec, handler_buff_n)); gcc_jit_lvalue *m_handlerlist = gcc_jit_rvalue_dereference_field ( gcc_jit_lvalue_as_rvalue ( gcc_jit_rvalue_dereference (comp.current_thread_ref, NULL)), - NULL, - comp.m_handlerlist); + NULL, + comp.m_handlerlist); + gcc_jit_block_add_assignment (comp.block, + NULL, + comp.loc_handler, + gcc_jit_lvalue_as_rvalue (m_handlerlist)); + gcc_jit_block_add_assignment ( comp.block, NULL, m_handlerlist, gcc_jit_lvalue_as_rvalue( - gcc_jit_rvalue_dereference_field (gcc_jit_lvalue_as_rvalue (c), - NULL, - comp.handler_next_field))); + gcc_jit_rvalue_dereference_field ( + gcc_jit_lvalue_as_rvalue (comp.loc_handler), + NULL, + comp.handler_next_field))); emit_frame_assignment ( arg[0], gcc_jit_lvalue_as_rvalue( - gcc_jit_rvalue_dereference_field (gcc_jit_lvalue_as_rvalue (c), - NULL, - comp.handler_val_field))); + gcc_jit_rvalue_dereference_field ( + gcc_jit_lvalue_as_rvalue (comp.loc_handler), + NULL, + comp.handler_val_field))); } else if (EQ (op, Qcall)) { @@ -2802,15 +2804,10 @@ compile_function (Lisp_Object func) format_string ("local%u", i)); } - EMACS_UINT non_local_handlers = XFIXNUM (FUNCALL1 (comp-func-handler-cnt, func)); - comp.buffer_handler_vec = make_vector (non_local_handlers, Qnil); - for (unsigned i = 0; i < non_local_handlers; ++i) - ASET (comp.buffer_handler_vec, i, - make_mint_ptr ( - gcc_jit_function_new_local (comp.func, - NULL, - comp.handler_ptr_type, - format_string ("handler_%u", i)))); + comp.loc_handler = gcc_jit_function_new_local (comp.func, + NULL, + comp.handler_ptr_type, + "handler"); comp.func_blocks_h = CALLN (Fmake_hash_table); -- 2.39.5