@@ -449,9 +449,12 @@ type slots_stack = node_id Stack.t;;
449
449
type block_slots_stack = slots_stack Stack .t ;;
450
450
type frame_block_slots_stack = block_slots_stack Stack .t ;;
451
451
type loop_block_slots_stack = block_slots_stack option Stack .t ;;
452
- (* like ret drops slots from all blocks in the frame
453
- * break from a simple loo drops slots from all block in a loop *)
454
- let (loop_blocks:loop_block_slots_stack ) =
452
+
453
+ (* Like ret drops slots from all blocks in the frame
454
+ * break from a simple loop drops slots from all block in a loop
455
+ *)
456
+
457
+ let (loop_blocks:loop_block_slots_stack ) =
455
458
let s = Stack. create() in Stack. push None s; s
456
459
457
460
let condition_assigning_visitor
@@ -583,7 +586,7 @@ let condition_assigning_visitor
583
586
let precond = slot_inits (lval_slots cx lval) in
584
587
raise_precondition sid precond;
585
588
in
586
-
589
+
587
590
let visit_stmt_pre s =
588
591
begin
589
592
match s.node with
@@ -1317,11 +1320,12 @@ let lifecycle_visitor
1317
1320
1318
1321
1319
1322
let visit_block_pre b =
1320
-
1323
+
1321
1324
let s = Stack. create() in
1322
1325
begin
1323
- match Stack. top loop_blocks with
1324
- Some loop -> Stack. push s loop | None -> ()
1326
+ match Stack. top loop_blocks with
1327
+ Some loop -> Stack. push s loop
1328
+ | None -> ()
1325
1329
end ;
1326
1330
Stack. push s (Stack. top frame_blocks);
1327
1331
begin
@@ -1337,7 +1341,7 @@ let lifecycle_visitor
1337
1341
inner.Walk. visit_block_pre b
1338
1342
in
1339
1343
1340
- let note_drops stmt slots =
1344
+ let note_stmt_drops stmt slots =
1341
1345
iflog cx
1342
1346
begin
1343
1347
fun _ ->
@@ -1352,6 +1356,21 @@ let lifecycle_visitor
1352
1356
htab_put cx.ctxt_post_stmt_slot_drops stmt.id slots
1353
1357
in
1354
1358
1359
+ let note_block_drops bid slots =
1360
+ iflog cx
1361
+ begin
1362
+ fun _ ->
1363
+ log cx " implicit drop of %d slots after block %d: "
1364
+ (List. length slots)
1365
+ (int_of_node bid);
1366
+ List. iter (fun s -> log cx " drop: %a"
1367
+ Ast. sprintf_slot_key
1368
+ (Hashtbl. find cx.ctxt_slot_keys s))
1369
+ slots
1370
+ end;
1371
+ htab_put cx.ctxt_post_block_slot_drops bid slots
1372
+ in
1373
+
1355
1374
let filter_live_block_slots slots =
1356
1375
List. filter (fun i -> Hashtbl. mem live_block_slots i) slots
1357
1376
in
@@ -1360,37 +1379,24 @@ let lifecycle_visitor
1360
1379
inner.Walk. visit_block_post b;
1361
1380
begin
1362
1381
match Stack. top loop_blocks with
1363
- Some loop ->
1364
- ignore(Stack. pop loop);
1365
- if Stack. is_empty loop then
1366
- ignore(Stack. pop loop_blocks);
1382
+ Some loop ->
1383
+ ignore (Stack. pop loop);
1384
+ if Stack. is_empty loop
1385
+ then ignore (Stack. pop loop_blocks);
1367
1386
| None -> ()
1368
1387
end ;
1369
1388
let block_slots = Stack. pop (Stack. top frame_blocks) in
1370
- let stmts = b.node in
1371
- let len = Array. length stmts in
1372
- if len > 0
1373
- then
1374
- begin
1375
- let s = stmts.(len-1 ) in
1376
- match s.node with
1377
- Ast. STMT_ret _
1378
- | Ast. STMT_be _
1379
- | Ast. STMT_break ->
1380
- () (* Taken care of in visit_stmt_post below. *)
1381
- | _ ->
1382
- (* The blk_slots stack we have has accumulated slots in
1383
- * declaration order as we walked the block; the top of the
1384
- * stack is the last-declared slot. We want to generate
1385
- * slot-drop obligations here for the slots in top-down order
1386
- * (starting with the last-declared) but only hitting those
1387
- * slots that actually got initialized (went live) at some
1388
- * point in the block.
1389
- *)
1390
- let slots = stk_elts_from_top block_slots in
1391
- let live = filter_live_block_slots slots in
1392
- note_drops s live
1393
- end ;
1389
+ (* The blk_slots stack we have has accumulated slots in
1390
+ * declaration order as we walked the block; the top of the
1391
+ * stack is the last-declared slot. We want to generate
1392
+ * slot-drop obligations here for the slots in top-down order
1393
+ * (starting with the last-declared) but only hitting those
1394
+ * slots that actually got initialized (went live) at some
1395
+ * point in the block.
1396
+ *)
1397
+ let slots = stk_elts_from_top block_slots in
1398
+ let live = filter_live_block_slots slots in
1399
+ note_block_drops b.id live
1394
1400
in
1395
1401
1396
1402
let visit_stmt_pre s =
@@ -1499,33 +1505,34 @@ let lifecycle_visitor
1499
1505
1500
1506
let visit_stmt_post s =
1501
1507
inner.Walk. visit_stmt_post s;
1502
- let handle_ret_like_stmt block_stack =
1508
+
1509
+ let handle_outward_jump_stmt block_stack =
1503
1510
let blocks = stk_elts_from_top block_stack in
1504
1511
let slots = List. concat (List. map stk_elts_from_top blocks) in
1505
1512
let live = filter_live_block_slots slots in
1506
- note_drops s live
1513
+ note_stmt_drops s live
1507
1514
in
1508
- match s.node with
1509
- Ast. STMT_ret _
1510
- | Ast. STMT_be _ ->
1511
- handle_ret_like_stmt ( Stack. top frame_blocks)
1512
- | Ast. STMT_break ->
1513
- begin
1514
- match ( Stack. top loop_blocks) with
1515
- Some loop -> handle_ret_like_stmt loop
1516
- | None ->
1517
- iflog cx ( fun _ ->
1518
- log cx " break statement outside of a loop " );
1519
- err (Some s.id) " break statement outside of a loop"
1520
- end
1521
- | _ -> ()
1515
+
1516
+ match s.node with
1517
+ Ast. STMT_ret _
1518
+ | Ast. STMT_be _ ->
1519
+ handle_outward_jump_stmt ( Stack. top frame_blocks)
1520
+
1521
+ | Ast. STMT_break ->
1522
+ begin
1523
+ match ( Stack. top loop_blocks) with
1524
+ Some loop -> handle_outward_jump_stmt loop
1525
+ | None ->
1526
+ err (Some s.id) " break statement outside of a loop"
1527
+ end
1528
+ | _ -> ()
1522
1529
in
1523
1530
1524
1531
let enter_frame _ =
1525
1532
Stack. push (Stack. create() ) frame_blocks;
1526
1533
Stack. push None loop_blocks
1527
1534
in
1528
-
1535
+
1529
1536
let leave_frame _ =
1530
1537
ignore (Stack. pop frame_blocks);
1531
1538
match Stack. pop loop_blocks with
0 commit comments