diff options
| -rw-r--r-- | bytecomp/bytegen.ml | 9 | ||||
| -rw-r--r-- | bytecomp/emitcode.ml | 2 | ||||
| -rw-r--r-- | bytecomp/instruct.ml | 2 | ||||
| -rw-r--r-- | bytecomp/instruct.mli | 1 | ||||
| -rw-r--r-- | bytecomp/printinstr.ml | 1 | ||||
| -rw-r--r-- | bytecomp/translcore.ml | 10 | ||||
| -rw-r--r-- | tools/dumpobj.ml | 1 |
7 files changed, 21 insertions, 5 deletions
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index 3b7541e92..26b93d7e8 100644 --- a/bytecomp/bytegen.ml +++ b/bytecomp/bytegen.ml @@ -76,6 +76,7 @@ let make_branch cont = (Kbranch _ as branch) :: _ -> (branch, cont) | (Kreturn _ as return) :: _ -> (return, cont) | Kraise :: _ -> (Kraise, cont) + | Kreraise :: _ -> (Kreraise, cont) | Klabel lbl :: _ -> make_branch_2 (Some lbl) 0 cont cont | _ -> make_branch_2 (None) 0 cont cont @@ -110,6 +111,7 @@ let rec add_pop n cont = Kpop m :: cont -> add_pop (n + m) cont | Kreturn m :: cont -> Kreturn(n + m) :: cont | Kraise :: _ -> cont + | Kreraise :: _ -> cont | _ -> Kpop n :: cont (* Translates the accumulator + n-1 positions, m places down on the stack *) @@ -534,7 +536,12 @@ let rec comp_expr env exp sz cont = comp_expr env exp2 sz cont1) end | Lprim(Praise, [arg]) -> - comp_expr env arg sz (Kraise :: discard_dead_code cont) + let raise_op = + match arg with + Lvar v -> Kreraise + | Levent(Lvar v, ev) -> Kreraise + | _ -> Kraise in + comp_expr env arg sz (raise_op :: discard_dead_code cont) | Lprim(Paddint, [arg; Lconst(Const_base(Const_int n))]) when is_immed n -> comp_expr env arg sz (Koffsetint n :: cont) diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml index 7913e5482..64da57469 100644 --- a/bytecomp/emitcode.ml +++ b/bytecomp/emitcode.ml @@ -275,6 +275,7 @@ let emit_instr = function | Kpushtrap lbl -> out opPUSHTRAP; out_label lbl | Kpoptrap -> out opPOPTRAP | Kraise -> out opRAISE + | Kreraise -> out opRERAISE | Kcheck_signals -> out opCHECK_SIGNALS | Kccall(name, n) -> if n <= 5 @@ -326,7 +327,6 @@ let rec emit = function out_const k ; out_label lbl ; emit rem - | Kpush :: Kacc n :: c -> if n < 8 then out(opPUSHACC0 + n) else (out opPUSHACC; out_int n); emit c diff --git a/bytecomp/instruct.ml b/bytecomp/instruct.ml index 7aed995ad..bf1ad16e6 100644 --- a/bytecomp/instruct.ml +++ b/bytecomp/instruct.ml @@ -86,7 +86,7 @@ type instruction = | Kboolnot | Kpushtrap of label | Kpoptrap - | Kraise + | Kraise | Kreraise | Kcheck_signals | Kccall of string * int | Knegint | Kaddint | Ksubint | Kmulint | Kdivint | Kmodint diff --git a/bytecomp/instruct.mli b/bytecomp/instruct.mli index 6fb979f4d..7bf4c60f0 100644 --- a/bytecomp/instruct.mli +++ b/bytecomp/instruct.mli @@ -106,6 +106,7 @@ type instruction = | Kpushtrap of label | Kpoptrap | Kraise + | Kreraise | Kcheck_signals | Kccall of string * int | Knegint | Kaddint | Ksubint | Kmulint | Kdivint | Kmodint diff --git a/bytecomp/printinstr.ml b/bytecomp/printinstr.ml index d175cf185..31737913a 100644 --- a/bytecomp/printinstr.ml +++ b/bytecomp/printinstr.ml @@ -70,6 +70,7 @@ let instruction ppf = function | Kpushtrap lbl -> fprintf ppf "\tpushtrap L%i" lbl | Kpoptrap -> fprintf ppf "\tpoptrap" | Kraise -> fprintf ppf "\traise" + | Kreraise -> fprintf ppf "\treraise" | Kcheck_signals -> fprintf ppf "\tcheck_signals" | Kccall(s, n) -> fprintf ppf "\tccall %s, %i" s n diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 67417b4d1..5a34ee6d6 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -467,8 +467,14 @@ let rec transl_exp e = && List.for_all (fun (arg,_) -> arg <> None) args -> let args = List.map (function Some x, _ -> x | _ -> assert false) args in let prim = transl_prim p args in - let lam = Lprim(prim, transl_list args) in - begin match prim with Pccall _ -> event_after e lam | _ -> lam end + begin match (prim, args) with + (Praise, [arg1]) -> + Lprim(Praise, [event_after arg1 (transl_exp arg1)]) + | (Pccall _, _) -> + event_after e (Lprim(prim, transl_list args)) + | (_, _) -> + Lprim(prim, transl_list args) + end | Texp_apply(funct, oargs) -> event_after e (transl_apply (transl_exp funct) oargs) | Texp_match({exp_desc = Texp_tuple argl} as arg, pat_expr_list, partial) -> diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml index f12e78cdb..1f08490c7 100644 --- a/tools/dumpobj.ml +++ b/tools/dumpobj.ml @@ -378,6 +378,7 @@ let op_shapes = [ opUGEINT, Nothing; opBULTINT, Uint_Disp; opBUGEINT, Uint_Disp; + opRERAISE, Nothing; opSTOP, Nothing; opEVENT, Nothing; opBREAK, Nothing; |