flambda-backend: CMM traps (oxcaml#72)

Author: xclerc

testsuite/tests/asmgen/catch-try-float.cmm

@@ -7,6 +7,6 @@ arguments = "-DFLOAT_CATCH -DFUN=catch_try_float main.c"
 (function "catch_try_float" (b:float)
   (+f 10.0
   (catch
-    (try (exit lbl 100.0)
+    (try (exit(1) lbl 100.0)
      with var 456.0)
    with (lbl x:float) (+f x 1000.0))))

testsuite/tests/asmgen/catch-try.cmm

@@ -7,6 +7,6 @@ arguments = "-DINT_INT -DFUN=catch_exit main.c"
 (function "catch_exit" (b:int)
   (+ 33
   (catch
-    (try (exit lbl 12)
+    (try (exit(1) lbl 12)
      with var 456)
    with (lbl x:val) (+ x 789))))

testsuite/tools/parsecmm.mly

@@ -37,7 +37,7 @@ let make_switch n selector caselist =
   let index = Array.make n 0 in
   let casev = Array.of_list caselist in
   let dbg = Debuginfo.none in
-  let actv = Array.make (Array.length casev) (Cexit(0,[]), dbg) in
+  let actv = Array.make (Array.length casev) (Cexit(Cmm.Lbl 0,[],[]), dbg) in
   for i = 0 to Array.length casev - 1 do
     let (posl, e) = casev.(i) in
     List.iter (fun pos -> index.(pos) <- i) posl;
@@ -206,6 +206,9 @@ componentlist:
     component                    { [$1] }
   | componentlist STAR component { $3 :: $1 }
 ;
+traps:
+    LPAREN INTCONST RPAREN       { List.init $2 (fun _ -> Pop) }
+  | /**/                         { [] }
 expr:
     INTCONST    { Cconst_int ($1, debuginfo ()) }
   | FLOATCONST  { Cconst_float (float_of_string $1, debuginfo ()) }
@@ -241,22 +244,22 @@ expr:
           match $3 with
             Cconst_int (x, _) when x <> 0 -> $4
           | _ -> Cifthenelse($3, debuginfo (), $4, debuginfo (),
-                             (Cexit(lbl0,[])),
+                             (Cexit(Cmm.Lbl lbl0,[],[])),
                              debuginfo ()) in
         Ccatch(Nonrecursive, [lbl0, [], Ctuple [], debuginfo ()],
           Ccatch(Recursive,
-            [lbl1, [], Csequence(body, Cexit(lbl1, [])), debuginfo ()],
-            Cexit(lbl1, []))) }
-  | LPAREN EXIT IDENT exprlist RPAREN
-    { Cexit(find_label $3, List.rev $4) }
+            [lbl1, [], Csequence(body, Cexit(Cmm.Lbl lbl1, [], [])), debuginfo ()],
+            Cexit(Cmm.Lbl lbl1, [], []))) }
+  | LPAREN EXIT traps IDENT exprlist RPAREN
+    { Cexit(Cmm.Lbl (find_label $4), List.rev $5, $3) }
   | LPAREN CATCH sequence WITH catch_handlers RPAREN
     { let handlers = $5 in
       List.iter (fun (_, l, _, _) ->
         List.iter (fun (x, _) -> unbind_ident x) l) handlers;
       Ccatch(Recursive, handlers, $3) }
-  | EXIT        { Cexit(0,[]) }
+  | EXIT        { Cexit(Cmm.Lbl 0,[],[]) }
   | LPAREN TRY sequence WITH bind_ident sequence RPAREN
-                { unbind_ident $5; Ctrywith($3, $5, $6, debuginfo ()) }
+                { unbind_ident $5; Ctrywith($3, Regular, $5, $6, debuginfo ()) }
   | LPAREN VAL expr expr RPAREN
       { let open Asttypes in
         Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr],