mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 10:30:25 -08:00
pushconditioncase working
This commit is contained in:
Andrea Corallo
Andrea Corallo
parent
868b6b454e
commit
8b22849a5c
3 changed files with 165 additions and 68 deletions
|
|
@ -488,21 +488,21 @@ the annotation emission."
|
|||
(comp-emit '(pop-handler)))
|
||||
(byte-pushconditioncase
|
||||
(let ((blocks (comp-func-blocks comp-func))
|
||||
(fall-bb (comp-new-block-sym))) ;; Fall through block
|
||||
(puthash fall-bb
|
||||
(guarded-bb (comp-new-block-sym)))
|
||||
(puthash guarded-bb
|
||||
(make-comp-block :sp (comp-sp))
|
||||
blocks)
|
||||
(let ((target (comp-lap-to-limple-bb (cl-third inst)))
|
||||
(let ((handler-bb (comp-lap-to-limple-bb (cl-third inst)))
|
||||
(handler-type (cdr (last inst))))
|
||||
(comp-emit (list 'push-handler (comp-slot-next)
|
||||
handler-type
|
||||
target
|
||||
fall-bb))
|
||||
(puthash target
|
||||
(make-comp-block :sp (comp-sp))
|
||||
handler-bb
|
||||
guarded-bb))
|
||||
(puthash handler-bb
|
||||
(make-comp-block :sp (1+ (comp-sp)))
|
||||
blocks)
|
||||
(comp-mark-block-closed))
|
||||
(comp-emit-block fall-bb)))
|
||||
(comp-mark-block-closed)
|
||||
(comp-emit-block guarded-bb))))
|
||||
(byte-pushcatch)
|
||||
(byte-nth auto)
|
||||
(byte-symbolp auto)
|
||||
|
|
@ -668,9 +668,9 @@ the annotation emission."
|
|||
do (progn
|
||||
(cl-incf (comp-sp))
|
||||
(comp-emit `(setpar ,(comp-slot) ,i))))
|
||||
(comp-emit-jump 'body)
|
||||
(comp-emit-jump 'bb_1)
|
||||
;; Body
|
||||
(comp-emit-block 'body)
|
||||
(comp-emit-block 'bb_1)
|
||||
(mapc #'comp-limplify-lap-inst (comp-func-lap func))
|
||||
;; Reverse insns into all basic blocks.
|
||||
(cl-loop for bb being the hash-value in (comp-func-blocks func)
|
||||
|
|
|
|||
121
src/comp.c
121
src/comp.c
|
|
@ -948,18 +948,6 @@ emit_PURE_P (gcc_jit_rvalue *ptr)
|
|||
PURESIZE));
|
||||
}
|
||||
|
||||
/* static gcc_jit_rvalue * */
|
||||
/* emit_call_n_ref (const char *f_name, unsigned nargs, */
|
||||
/* gcc_jit_lvalue *base_arg) */
|
||||
/* { */
|
||||
/* gcc_jit_rvalue *args[] = */
|
||||
/* { gcc_jit_context_new_rvalue_from_int(comp.ctxt, */
|
||||
/* comp.ptrdiff_type, */
|
||||
/* nargs), */
|
||||
/* gcc_jit_lvalue_get_address (base_arg, NULL) }; */
|
||||
/* return emit_call (f_name, comp.lisp_obj_type, 2, args); */
|
||||
/* } */
|
||||
|
||||
/* Emit an r-value from an mvar meta variable.
|
||||
In case this is a constant that was propagated return it otherwise load it
|
||||
from frame. */
|
||||
|
|
@ -1051,14 +1039,86 @@ emit_limple_call_ref (Lisp_Object arg1)
|
|||
return emit_call (calle, comp.lisp_obj_type, 2, gcc_args);
|
||||
}
|
||||
|
||||
/* Register an handler for a non local exit. */
|
||||
|
||||
static void
|
||||
emit_limple_push_handler (gcc_jit_rvalue *handler, gcc_jit_rvalue *handler_type,
|
||||
gcc_jit_block *handler_bb, gcc_jit_block *guarded_bb,
|
||||
EMACS_UINT clobber_slot)
|
||||
{
|
||||
/* Ex: (push-handler #s(comp-mvar 6 0 t (arith-error) nil) 1 bb_3 bb_2). */
|
||||
|
||||
static unsigned pushhandler_n; /* FIXME move at ctxt or func level. */
|
||||
gcc_jit_rvalue *args[2];
|
||||
|
||||
/* struct handler *c = push_handler (POP, type); */
|
||||
gcc_jit_lvalue *c =
|
||||
gcc_jit_function_new_local (comp.func,
|
||||
NULL,
|
||||
comp.handler_ptr_type,
|
||||
format_string ("c_%u",
|
||||
pushhandler_n));
|
||||
args[0] = handler;
|
||||
args[1] = handler_type;
|
||||
gcc_jit_block_add_assignment (
|
||||
comp.block,
|
||||
NULL,
|
||||
c,
|
||||
emit_call ("push_handler", comp.handler_ptr_type, 2, args));
|
||||
|
||||
args[0] =
|
||||
gcc_jit_lvalue_get_address (
|
||||
gcc_jit_rvalue_dereference_field (
|
||||
gcc_jit_lvalue_as_rvalue (c),
|
||||
NULL,
|
||||
comp.handler_jmp_field),
|
||||
NULL);
|
||||
|
||||
gcc_jit_rvalue *res;
|
||||
#ifdef HAVE__SETJMP
|
||||
res = emit_call ("_setjmp", comp.int_type, 1, args);
|
||||
#else
|
||||
res = emit_call ("setjmp", comp.int_type, 1, args);
|
||||
#endif
|
||||
emit_cond_jump (res, handler_bb, guarded_bb);
|
||||
|
||||
/* This emit the handler part. */
|
||||
|
||||
comp.block = handler_bb;
|
||||
gcc_jit_lvalue *m_handlerlist =
|
||||
gcc_jit_rvalue_dereference_field (comp.current_thread,
|
||||
NULL,
|
||||
comp.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_block_add_assignment (
|
||||
comp.block,
|
||||
NULL,
|
||||
comp.frame[clobber_slot],
|
||||
gcc_jit_lvalue_as_rvalue(
|
||||
gcc_jit_rvalue_dereference_field (gcc_jit_lvalue_as_rvalue (c),
|
||||
NULL,
|
||||
comp.handler_val_field)));
|
||||
++pushhandler_n;
|
||||
}
|
||||
|
||||
static void
|
||||
emit_limple_insn (Lisp_Object insn)
|
||||
{
|
||||
Lisp_Object op = XCAR (insn);
|
||||
Lisp_Object args = XCDR (insn);
|
||||
Lisp_Object arg0 = XCAR (args);
|
||||
Lisp_Object arg0;
|
||||
gcc_jit_rvalue *res;
|
||||
|
||||
if (CONSP (args))
|
||||
arg0 = XCAR (args);
|
||||
|
||||
if (EQ (op, Qjump))
|
||||
{
|
||||
/* Unconditional branch. */
|
||||
|
|
@ -1074,6 +1134,39 @@ emit_limple_insn (Lisp_Object insn)
|
|||
|
||||
emit_cond_jump (emit_NILP (test), target2, target1);
|
||||
}
|
||||
else if (EQ (op, Qpush_handler))
|
||||
{
|
||||
EMACS_UINT clobber_slot = XFIXNUM (FUNCALL1 (comp-mvar-slot, arg0));
|
||||
gcc_jit_rvalue *handler = emit_mvar_val (arg0);
|
||||
gcc_jit_rvalue *handler_type =
|
||||
gcc_jit_context_new_rvalue_from_int (comp.ctxt,
|
||||
comp.int_type,
|
||||
XFIXNUM (SECOND (args)));
|
||||
gcc_jit_block *handler_bb = retrive_block (THIRD (args));
|
||||
gcc_jit_block *guarded_bb = retrive_block (FORTH (args));
|
||||
emit_limple_push_handler (handler, handler_type, handler_bb, guarded_bb,
|
||||
clobber_slot);
|
||||
}
|
||||
else if (EQ (op, Qpop_handler))
|
||||
{
|
||||
/* current_thread->m_handlerlist =
|
||||
current_thread->m_handlerlist->next; */
|
||||
gcc_jit_lvalue *m_handlerlist =
|
||||
gcc_jit_rvalue_dereference_field (comp.current_thread,
|
||||
NULL,
|
||||
comp.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 (m_handlerlist),
|
||||
NULL,
|
||||
comp.handler_next_field)));
|
||||
|
||||
}
|
||||
else if (EQ (op, Qcall))
|
||||
{
|
||||
gcc_jit_block_add_eval (comp.block,
|
||||
|
|
@ -2129,6 +2222,8 @@ syms_of_comp (void)
|
|||
DEFSYM (Qreturn, "return");
|
||||
DEFSYM (Qcomp_mvar, "comp-mvar");
|
||||
DEFSYM (Qcond_jump, "cond-jump");
|
||||
DEFSYM (Qpush_handler, "push-handler");
|
||||
DEFSYM (Qpop_handler, "pop-handler");
|
||||
|
||||
defsubr (&Scomp_init_ctxt);
|
||||
defsubr (&Scomp_release_ctxt);
|
||||
|
|
|
|||
|
|
@ -416,56 +416,58 @@
|
|||
(buffer-string))
|
||||
"abcd")))
|
||||
|
||||
;; (ert-deftest comp-tests-non-locals ()
|
||||
;; "Test non locals."
|
||||
;; (defun comp-tests-err-arith-f ()
|
||||
;; (/ 1 0))
|
||||
;; (defun comp-tests-err-foo-f ()
|
||||
;; (error "foo"))
|
||||
(ert-deftest comp-tests-non-locals ()
|
||||
"Test non locals."
|
||||
(let ((gc-cons-threshold most-positive-fixnum)) ;; FIXME!!
|
||||
(defun comp-tests-err-arith-f ()
|
||||
(/ 1 0))
|
||||
(defun comp-tests-err-foo-f ()
|
||||
(error "foo"))
|
||||
|
||||
;; (defun comp-tests-condition-case-0-f ()
|
||||
;; ;; Bpushhandler Bpophandler
|
||||
;; (condition-case
|
||||
;; err
|
||||
;; (comp-tests-err-arith-f)
|
||||
;; (arith-error (concat "arith-error "
|
||||
;; (error-message-string err)
|
||||
;; " catched"))
|
||||
;; (error (concat "error "
|
||||
;; (error-message-string err)
|
||||
;; " catched"))))
|
||||
(defun comp-tests-condition-case-0-f ()
|
||||
;; Bpushhandler Bpophandler
|
||||
(condition-case
|
||||
err
|
||||
(comp-tests-err-arith-f)
|
||||
(arith-error (concat "arith-error "
|
||||
(error-message-string err)
|
||||
" catched"))
|
||||
(error (concat "error "
|
||||
(error-message-string err)
|
||||
" catched"))))
|
||||
|
||||
;; (defun comp-tests-condition-case-1-f ()
|
||||
;; ;; Bpushhandler Bpophandler
|
||||
;; (condition-case
|
||||
;; err
|
||||
;; (comp-tests-err-foo-f)
|
||||
;; (arith-error (concat "arith-error "
|
||||
;; (error-message-string err)
|
||||
;; " catched"))
|
||||
;; (error (concat "error "
|
||||
;; (error-message-string err)
|
||||
;; " catched"))))
|
||||
(defun comp-tests-condition-case-1-f ()
|
||||
;; Bpushhandler Bpophandler
|
||||
(condition-case
|
||||
err
|
||||
(comp-tests-err-foo-f)
|
||||
(arith-error (concat "arith-error "
|
||||
(error-message-string err)
|
||||
" catched"))
|
||||
(error (concat "error "
|
||||
(error-message-string err)
|
||||
" catched"))))
|
||||
|
||||
;; (defun comp-tests-catch-f (f)
|
||||
;; (catch 'foo
|
||||
;; (funcall f)))
|
||||
;; (defun comp-tests-catch-f (f)
|
||||
;; (catch 'foo
|
||||
;; (funcall f)))
|
||||
|
||||
;; (defun comp-tests-throw-f (x)
|
||||
;; (throw 'foo x))
|
||||
;; (defun comp-tests-throw-f (x)
|
||||
;; (throw 'foo x))
|
||||
|
||||
;; (native-compile #'comp-tests-condition-case-0-f)
|
||||
;; (native-compile #'comp-tests-condition-case-1-f)
|
||||
;; (native-compile #'comp-tests-catch-f)
|
||||
;; (native-compile #'comp-tests-throw-f)
|
||||
(native-compile #'comp-tests-condition-case-0-f)
|
||||
(native-compile #'comp-tests-condition-case-1-f)
|
||||
;; (native-compile #'comp-tests-catch-f)
|
||||
;; (native-compile #'comp-tests-throw-f)
|
||||
|
||||
;; (should (string= (comp-tests-condition-case-0-f)
|
||||
;; "arith-error Arithmetic error catched"))
|
||||
;; (should (string= (comp-tests-condition-case-1-f)
|
||||
;; "error foo catched"))
|
||||
;; (should (= (comp-tests-catch-f (lambda () (throw 'foo 3))) 3))
|
||||
;; (should (= (catch 'foo
|
||||
;; (comp-tests-throw-f 3)))))
|
||||
(should (string= (comp-tests-condition-case-0-f)
|
||||
"arith-error Arithmetic error catched"))
|
||||
(should (string= (comp-tests-condition-case-1-f)
|
||||
"error foo catched")))
|
||||
;; (should (= (comp-tests-catch-f (lambda () (throw 'foo 3))) 3))
|
||||
;; (should (= (catch 'foo
|
||||
;; (comp-tests-throw-f 3))))
|
||||
)
|
||||
|
||||
(ert-deftest comp-tests-gc ()
|
||||
"Try to do some longer computation to let the gc kick in."
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue