Drop slots on block exits even when blocks have no statements. Part way to fixing bind leakage in rustc.

5 files changed, 144 insertions, 90 deletions

diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index 46a87dfe..78b3ac51 100644
--- a/src/boot/fe/ast.ml
+++ b/src/boot/fe/ast.ml
@@ -1545,6 +1545,7 @@ and fmt_pat (ff:Format.formatter) (pat:pat) : unit =
         fmt_lval ff ctor;
         fmt_bracketed_arr_sep "(" ")" "," fmt_pat ff pats
     | PAT_slot (_, ident) ->
+        fmt ff "?";
         fmt_ident ff ident
     | PAT_wild ->
         fmt ff "_"
diff --git a/src/boot/me/loop.ml b/src/boot/me/loop.ml
index 1fbb8223..b5548e2c 100644
--- a/src/boot/me/loop.ml
+++ b/src/boot/me/loop.ml
@@ -114,6 +114,8 @@ let loop_depth_visitor
   let visit_block_pre b =
     if Hashtbl.mem cx.ctxt_block_is_loop_body b.id
     then push_loop ();
+    let fcx = Stack.top fcxs in
+      htab_put cx.ctxt_block_loop_depths b.id fcx.current_depth;
     inner.Walk.visit_block_pre b
   in
 
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 945155b0..7f5e4cda 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -131,6 +131,7 @@ type ctxt =
       (* Typestate-y stuff. *)
       ctxt_stmt_is_init: (node_id,unit) Hashtbl.t;
       ctxt_post_stmt_slot_drops: (node_id,node_id list) Hashtbl.t;
+      ctxt_post_block_slot_drops: (node_id,node_id list) Hashtbl.t;
 
       (* Layout-y stuff. *)
       ctxt_slot_aliased: (node_id,unit) Hashtbl.t;
@@ -141,6 +142,7 @@ type ctxt =
       ctxt_call_sizes: (node_id,size) Hashtbl.t;
       ctxt_block_is_loop_body: (node_id,unit) Hashtbl.t;
       ctxt_stmt_loop_depths: (node_id,int) Hashtbl.t;
+      ctxt_block_loop_depths: (node_id,int) Hashtbl.t;
       ctxt_slot_loop_depths: (node_id,int) Hashtbl.t;
 
       (* Translation-y stuff. *)
@@ -216,6 +218,7 @@ let new_ctxt sess abi crate =
 
     ctxt_stmt_is_init = Hashtbl.create 0;
     ctxt_post_stmt_slot_drops = Hashtbl.create 0;
+    ctxt_post_block_slot_drops = Hashtbl.create 0;
 
     ctxt_slot_aliased = Hashtbl.create 0;
     ctxt_slot_is_obj_state = Hashtbl.create 0;
@@ -227,6 +230,7 @@ let new_ctxt sess abi crate =
     ctxt_block_is_loop_body = Hashtbl.create 0;
     ctxt_slot_loop_depths = Hashtbl.create 0;
     ctxt_stmt_loop_depths = Hashtbl.create 0;
+    ctxt_block_loop_depths = Hashtbl.create 0;
 
     ctxt_fn_fixups = Hashtbl.create 0;
     ctxt_block_fixups = Hashtbl.create 0;
@@ -399,6 +403,10 @@ let get_stmt_depth (cx:ctxt) (id:node_id) : int =
   Hashtbl.find cx.ctxt_stmt_loop_depths id
 ;;
 
+let get_block_depth (cx:ctxt) (id:node_id) : int =
+  Hashtbl.find cx.ctxt_block_loop_depths id
+;;
+
 let get_slot_depth (cx:ctxt) (id:node_id) : int =
   Hashtbl.find cx.ctxt_slot_loop_depths id
 ;;
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index 1161b58e..d8be85bf 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -826,10 +826,51 @@ let trans_visitor
       out diff current_fp
   in
 
+  let curr_stmt_depth _ =
+    if (Stack.is_empty curr_stmt)
+    then None
+    else
+      Some
+        (get_stmt_depth cx (Stack.top curr_stmt))
+  in
+
   let cell_of_block_slot
+      ?access_depth:(access_depth=curr_stmt_depth())
       (slot_id:node_id)
       : Il.cell =
+
     let referent_type = slot_id_referent_type slot_id in
+
+    let local_access off =
+      Il.Mem (fp_off_sz off, referent_type)
+    in
+
+    let outer_access off slot_depth depth =
+      let _ = assert (slot_depth < depth) in
+        let _ =
+          iflog
+            begin
+              fun _ ->
+                let k =
+                  Hashtbl.find cx.ctxt_slot_keys slot_id
+                in
+                  annotate (Printf.sprintf
+                              "access outer frame slot #%d = %s"
+                              (int_of_node slot_id)
+                              (Fmt.fmt_to_str Ast.fmt_slot_key k))
+            end
+        in
+        let diff = depth - slot_depth in
+        let _ = annotate "get outer frame pointer" in
+        let fp = get_nth_outer_frame_ptr diff in
+        let _ = annotate "calculate size" in
+        let p =
+          based_sz (get_ty_params_of_current_frame())
+            (fst (force_to_reg (Il.Cell fp))) off
+        in
+          Il.Mem (p, referent_type)
+    in
+
       match htab_search cx.ctxt_slot_vregs slot_id with
           Some vr ->
             begin
@@ -865,43 +906,15 @@ let trans_visitor
                           Il.Mem (slot_mem, referent_type)
                       end
                     else
-                      if (Stack.is_empty curr_stmt)
-                      then
-                        Il.Mem (fp_off_sz off, referent_type)
-                      else
-                        let slot_depth = get_slot_depth cx slot_id in
-                        let stmt_depth =
-                          get_stmt_depth cx (Stack.top curr_stmt)
-                        in
-                          if slot_depth <> stmt_depth
-                          then
-                            let _ = assert (slot_depth < stmt_depth) in
-                            let _ =
-                              iflog
-                                begin
-                                  fun _ ->
-                                    let k =
-                                      Hashtbl.find cx.ctxt_slot_keys slot_id
-                                    in
-                                      annotate
-                                        (Printf.sprintf
-                                           "access outer frame slot #%d = %s"
-                                           (int_of_node slot_id)
-                                           (Fmt.fmt_to_str
-                                              Ast.fmt_slot_key k))
-                                end
-                            in
-                            let diff = stmt_depth - slot_depth in
-                            let _ = annotate "get outer frame pointer" in
-                            let fp = get_nth_outer_frame_ptr diff in
-                            let _ = annotate "calculate size" in
-                            let p =
-                              based_sz (get_ty_params_of_current_frame())
-                                (fst (force_to_reg (Il.Cell fp))) off
-                            in
-                              Il.Mem (p, referent_type)
-                          else
-                            Il.Mem (fp_off_sz off, referent_type)
+                      match access_depth with
+                          None -> local_access off
+                        | Some depth ->
+                            let slot_depth = get_slot_depth cx slot_id in
+                              if slot_depth <> depth
+                              then
+                                outer_access off slot_depth depth
+                              else
+                                local_access off
             end
   in
 
@@ -2434,12 +2447,35 @@ let trans_visitor
         | Ast.EXPR_atom a ->
             trans_atom a
 
+  and drop_slots_after_block bid : unit =
+    match htab_search cx.ctxt_post_block_slot_drops bid with
+        None -> ()
+      | Some slots ->
+          List.iter
+            begin
+              fun slot_id ->
+                let slot = get_slot cx slot_id in
+                let k = Hashtbl.find cx.ctxt_slot_keys slot_id in
+                let depth = Hashtbl.find cx.ctxt_block_loop_depths bid in
+                  iflog (fun _ ->
+                           annotate
+                             (Printf.sprintf
+                                "post-block, drop_slot %d = %s "
+                                (int_of_node slot_id)
+                                (Fmt.fmt_to_str Ast.fmt_slot_key k)));
+                  drop_slot_in_current_frame
+                    (cell_of_block_slot
+                       ~access_depth:(Some depth) slot_id) slot
+            end
+            slots
+
   and trans_block (block:Ast.block) : unit =
     flush_emitter_size_cache();
     trace_str cx.ctxt_sess.Session.sess_trace_block
       "entering block";
     emit (Il.Enter (Hashtbl.find cx.ctxt_block_fixups block.id));
     Array.iter trans_stmt block.node;
+    drop_slots_after_block block.id;
     trace_str cx.ctxt_sess.Session.sess_trace_block
       "exiting block";
     emit Il.Leave;
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index 12454191..81781d34 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -449,9 +449,12 @@ type slots_stack = node_id Stack.t;;
 type block_slots_stack = slots_stack Stack.t;;
 type frame_block_slots_stack = block_slots_stack Stack.t;;
 type loop_block_slots_stack = block_slots_stack option Stack.t;;
-(* like ret drops slots from all blocks in the frame
- * break from a simple loo drops slots from all block in a loop *)
-let (loop_blocks:loop_block_slots_stack) = 
+
+(* Like ret drops slots from all blocks in the frame
+ * break from a simple loop drops slots from all block in a loop
+ *)
+
+let (loop_blocks:loop_block_slots_stack) =
   let s = Stack.create() in Stack.push None s; s
 
 let condition_assigning_visitor
@@ -583,7 +586,7 @@ let condition_assigning_visitor
           let precond = slot_inits (lval_slots cx lval) in
             raise_precondition sid precond;
   in
-    
+
   let visit_stmt_pre s =
     begin
       match s.node with
@@ -1317,11 +1320,12 @@ let lifecycle_visitor
 
 
   let visit_block_pre b =
-   
+
     let s = Stack.create() in
       begin
-        match Stack.top loop_blocks with 
-            Some loop -> Stack.push s loop | None -> ()
+        match Stack.top loop_blocks with
+            Some loop -> Stack.push s loop
+          | None -> ()
       end;
       Stack.push s (Stack.top frame_blocks);
       begin
@@ -1337,7 +1341,7 @@ let lifecycle_visitor
       inner.Walk.visit_block_pre b
   in
 
-  let note_drops stmt slots =
+  let note_stmt_drops stmt slots =
     iflog cx
       begin
         fun _ ->
@@ -1352,6 +1356,21 @@ let lifecycle_visitor
     htab_put cx.ctxt_post_stmt_slot_drops stmt.id slots
   in
 
+  let note_block_drops bid slots =
+    iflog cx
+      begin
+        fun _ ->
+          log cx "implicit drop of %d slots after block %d: "
+            (List.length slots)
+            (int_of_node bid);
+          List.iter (fun s -> log cx "drop: %a"
+                       Ast.sprintf_slot_key
+                       (Hashtbl.find cx.ctxt_slot_keys s))
+            slots
+      end;
+    htab_put cx.ctxt_post_block_slot_drops bid slots
+  in
+
   let filter_live_block_slots slots =
     List.filter (fun i -> Hashtbl.mem live_block_slots i) slots
   in
@@ -1360,37 +1379,24 @@ let lifecycle_visitor
     inner.Walk.visit_block_post b;
     begin
       match Stack.top loop_blocks with
-          Some loop -> 
-            ignore(Stack.pop loop);
-            if Stack.is_empty loop then
-              ignore(Stack.pop loop_blocks);
+          Some loop ->
+            ignore (Stack.pop loop);
+            if Stack.is_empty loop
+            then ignore (Stack.pop loop_blocks);
         | None -> ()
     end;
     let block_slots = Stack.pop (Stack.top frame_blocks) in
-    let stmts = b.node in
-    let len = Array.length stmts in
-      if len > 0
-      then
-        begin
-          let s = stmts.(len-1) in
-            match s.node with
-                Ast.STMT_ret _
-              | Ast.STMT_be _ 
-              | Ast.STMT_break ->
-                  () (* Taken care of in visit_stmt_post below. *)
-              | _ ->
-                (* The blk_slots stack we have has accumulated slots in
-                 * declaration order as we walked the block; the top of the
-                 * stack is the last-declared slot. We want to generate
-                 * slot-drop obligations here for the slots in top-down order
-                 * (starting with the last-declared) but only hitting those
-                 * slots that actually got initialized (went live) at some
-                 * point in the block.
-                 *)
-                let slots = stk_elts_from_top block_slots in
-                let live = filter_live_block_slots slots in
-                  note_drops s live
-        end;
+      (* The blk_slots stack we have has accumulated slots in
+       * declaration order as we walked the block; the top of the
+       * stack is the last-declared slot. We want to generate
+       * slot-drop obligations here for the slots in top-down order
+       * (starting with the last-declared) but only hitting those
+       * slots that actually got initialized (went live) at some
+       * point in the block.
+       *)
+    let slots = stk_elts_from_top block_slots in
+    let live = filter_live_block_slots slots in
+      note_block_drops b.id live
   in
 
   let visit_stmt_pre s =
@@ -1499,33 +1505,34 @@ let lifecycle_visitor
 
   let visit_stmt_post s =
     inner.Walk.visit_stmt_post s;
-    let handle_ret_like_stmt block_stack =
+
+    let handle_outward_jump_stmt block_stack =
       let blocks = stk_elts_from_top block_stack in
           let slots = List.concat (List.map stk_elts_from_top blocks) in
           let live = filter_live_block_slots slots in
-            note_drops s live
+            note_stmt_drops s live
     in
-    match s.node with
-        Ast.STMT_ret _
-      | Ast.STMT_be _ ->
-          handle_ret_like_stmt (Stack.top frame_blocks)
-      | Ast.STMT_break ->
-          begin
-            match (Stack.top loop_blocks) with
-                Some loop -> handle_ret_like_stmt loop
-              | None -> 
-                  iflog cx (fun _ ->
-                              log cx "break statement outside of a loop");
-                  err (Some s.id) "break statement outside of a loop"
-          end
-      | _ -> ()
+
+      match s.node with
+          Ast.STMT_ret _
+        | Ast.STMT_be _ ->
+            handle_outward_jump_stmt (Stack.top frame_blocks)
+
+        | Ast.STMT_break ->
+            begin
+              match (Stack.top loop_blocks) with
+                  Some loop -> handle_outward_jump_stmt loop
+                | None ->
+                    err (Some s.id) "break statement outside of a loop"
+            end
+        | _ -> ()
   in
 
   let enter_frame _ =
     Stack.push (Stack.create()) frame_blocks;
     Stack.push None loop_blocks
   in
-    
+
   let leave_frame _ =
     ignore (Stack.pop frame_blocks);
     match Stack.pop loop_blocks with