Reset the local stack pointer in exception handlers (#56)

Author: stedolan

asmcomp/selectgen.ml

@@ -850,14 +850,16 @@ method emit_expr (env:environment) exp =
           None
       end
   | Ctrywith(e1, v, e2, _dbg) ->
+      let reg = self#regs_for typ_int in
+      self#insert env (Iop Ibeginregion) [| |] reg;
       let (r1, s1) = self#emit_sequence env e1 in
       let rv = self#regs_for typ_val in
       let (r2, s2) = self#emit_sequence (env_add v rv env) e2 in
       let r = join env r1 s1 r2 s2 in
       self#insert env
         (Itrywith(s1#extract,
                   instr_cons (Iop Imove) [|Proc.loc_exn_bucket|] rv
-                             (s2#extract)))
+                    (instr_cons (Iop Iendregion) reg [| |] s2#extract)))
         [||] [||];
       r
   | Cregion e when env.region_tail ->
@@ -1197,12 +1199,15 @@ method emit_tail (env:environment) exp =
       self#insert env (Icatch(rec_flag, List.map aux handlers, s_body))
         [||] [||]
   | Ctrywith(e1, v, e2, _dbg) ->
+      let reg = self#regs_for typ_int in
+      self#insert env (Iop Ibeginregion) [| |] reg;
       let (opt_r1, s1) = self#emit_sequence env e1 in
       let rv = self#regs_for typ_val in
       let s2 = self#emit_tail_sequence (env_add v rv env) e2 in
       self#insert env
         (Itrywith(s1#extract,
-                  instr_cons (Iop Imove) [|Proc.loc_exn_bucket|] rv s2))
+                  instr_cons (Iop Imove) [|Proc.loc_exn_bucket|] rv
+                    (instr_cons (Iop Iendregion) reg [| |] s2)))
         [||] [||];
       begin match opt_r1 with
         None -> ()

testsuite/tests/typing-local/exceptions.ml

@@ -0,0 +1,36 @@
+(* TEST
+   * native *)
+
+external local_stack_offset : unit -> int = "caml_local_stack_offset"
+
+let leak () =
+  let r = local_ ref 42 in
+  let[@inline never] f () = incr r in
+  f ();
+  f ();
+  raise Exit
+
+let count_leak f =
+  let before = local_stack_offset () in
+  f ();
+  let after = local_stack_offset () in
+  after - before
+
+let glob = ref 0
+
+let tests =
+  [ "try", (fun () ->
+      begin try leak () with Exit -> () end;
+      incr glob);
+    "tailtry", (fun () ->
+      try leak () with Exit -> ());
+    "match", (fun () ->
+      let g = match leak () with exception Exit -> glob | () -> glob in
+      incr g);
+    "tailmatch", (fun () ->
+      match leak () with exception Exit -> () | () -> ())
+  ]
+
+let () =
+  Sys.opaque_identity tests |> List.iter (fun (s,f) ->
+    Printf.printf "%15s: %d\n" s (count_leak f))

testsuite/tests/typing-local/exceptions.reference

@@ -0,0 +1,4 @@
+            try: 0
+        tailtry: 0
+          match: 0
+      tailmatch: 0