diff options
Diffstat (limited to 'src/boot/me')
| -rw-r--r-- | src/boot/me/trans.ml | 33 | ||||
| -rw-r--r-- | src/boot/me/typestate.ml | 50 |
2 files changed, 65 insertions, 18 deletions
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index f77386a9..85dd5265 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -2453,9 +2453,8 @@ let trans_visitor note_drop_step ty "drop_ty: obj path"; let binding = get_element_ptr cell Abi.binding_field_binding in let null_jmp = null_check binding in + let rc_jmp = drop_refcount_and_cmp binding in let obj = deref binding in - let rc = get_element_ptr obj 0 in - let rc_jmp = drop_refcount_and_cmp rc in let tydesc = get_element_ptr obj 1 in let body = get_element_ptr obj 2 in let ty_params = @@ -2505,8 +2504,7 @@ let trans_visitor let _ = check_box_rty cell in let null_jmp = null_check cell in - let rc = box_rc_cell cell in - let j = drop_refcount_and_cmp rc in + let j = drop_refcount_and_cmp cell in (* FIXME (issue #25): check to see that the box has * further box members; if it doesn't we can elide the @@ -2525,7 +2523,7 @@ let trans_visitor note_drop_step ty "drop_ty: done box-drop path"; | MEM_interior when type_is_structured ty -> - note_drop_step ty "drop:ty structured-interior path"; + note_drop_step ty "drop_ty structured-interior path"; iter_ty_parts ty_params cell ty (drop_ty ty_params) curr_iso; note_drop_step ty "drop_ty: done structured-interior path"; @@ -2740,14 +2738,35 @@ let trans_visitor emit (Il.jmp Il.JE Il.CodeNone); j - and drop_refcount_and_cmp (rc:Il.cell) : quad_idx = + and drop_refcount_and_cmp (boxed:Il.cell) : quad_idx = iflog (fun _ -> annotate "drop refcount and maybe free"); + let rc = box_rc_cell boxed in + if cx.ctxt_sess.Session.sess_trace_gc || + cx.ctxt_sess.Session.sess_trace_drop + then + begin + trace_str true "refcount--"; + trace_word true boxed; + trace_word true rc + end; emit (Il.binary Il.SUB rc (Il.Cell rc) one); emit (Il.cmp (Il.Cell rc) zero); let j = mark () in emit (Il.jmp Il.JNE Il.CodeNone); j + and incr_refcount (boxed:Il.cell) : unit = + let rc = box_rc_cell boxed in + if cx.ctxt_sess.Session.sess_trace_gc || + cx.ctxt_sess.Session.sess_trace_drop + then + begin + trace_str true "refcount++"; + trace_word true boxed; + trace_word true rc + end; + add_to rc one + and drop_slot (ty_params:Il.cell) (cell:Il.cell) @@ -2917,7 +2936,7 @@ let trans_visitor | (MEM_rc_struct, MEM_rc_struct) -> (* Lightweight copy: twiddle refcounts, move pointer. *) anno "refcounted light"; - add_to (box_rc_cell src) one; + incr_refcount src; if not initializing then drop_ty ty_params dst dst_ty None; diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml index 3a13561a..6e0b57e1 100644 --- a/src/boot/me/typestate.ml +++ b/src/boot/me/typestate.ml @@ -988,23 +988,30 @@ let lifecycle_visitor * used later on in translation. *) - let (live_block_slots:(node_id Stack.t) Stack.t) = Stack.create () in + let (live_block_slots:(node_id, unit) Hashtbl.t) = Hashtbl.create 0 in + let (block_slots:(node_id Stack.t) Stack.t) = Stack.create () in let (implicit_init_block_slots:(node_id,node_id) Hashtbl.t) = Hashtbl.create 0 in + let push_slot sl = + Stack.push sl (Stack.top block_slots) + in + let mark_slot_init sl = - Stack.push sl (Stack.top live_block_slots) + Hashtbl.replace live_block_slots sl () in let visit_block_pre b = - Stack.push (Stack.create()) live_block_slots; + Stack.push (Stack.create()) block_slots; begin match htab_search implicit_init_block_slots b.id with None -> () - | Some slot -> mark_slot_init slot + | Some slot -> + push_slot slot; + mark_slot_init slot end; inner.Walk.visit_block_pre b in @@ -1026,7 +1033,7 @@ let lifecycle_visitor let visit_block_post b = inner.Walk.visit_block_post b; - let blk_live = Stack.pop live_block_slots in + let blk_slots = Stack.pop block_slots in let stmts = b.node in let len = Array.length stmts in if len > 0 @@ -1037,9 +1044,22 @@ let lifecycle_visitor Ast.STMT_ret _ | Ast.STMT_be _ -> () (* Taken care of in visit_stmt_post below. *) - | _ -> - let slots = stk_elts_from_top blk_live in - note_drops s slots + | _ -> + (* 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 blk_slots in + let live = + List.filter + (fun i -> Hashtbl.mem live_block_slots i) + slots + in + note_drops s live end; in @@ -1081,6 +1101,9 @@ let lifecycle_visitor init_lval lv_dst end; + | Ast.STMT_decl (Ast.DECL_slot (_, sloti)) -> + push_slot sloti.id + | Ast.STMT_init_rec (lv_dst, _, _) | Ast.STMT_init_tup (lv_dst, _) | Ast.STMT_init_vec (lv_dst, _) @@ -1107,7 +1130,7 @@ let lifecycle_visitor (fst f.Ast.for_each_slot).id - | _ -> () + | _ -> () end; inner.Walk.visit_stmt_pre s in @@ -1117,9 +1140,14 @@ let lifecycle_visitor match s.node with Ast.STMT_ret _ | Ast.STMT_be _ -> - let stks = stk_elts_from_top live_block_slots in + let stks = stk_elts_from_top block_slots in let slots = List.concat (List.map stk_elts_from_top stks) in - note_drops s slots + let live = + List.filter + (fun i -> Hashtbl.mem live_block_slots i) + slots + in + note_drops s live | _ -> () in |