@@ -10,6 +10,18 @@ let log cx = Session.log "trans"
10
10
cx.Semant. ctxt_sess.Session. sess_log_out
11
11
;;
12
12
13
+ (* Returns a new LLVM IRBuilder positioned at the end of llblock. If
14
+ debug_loc isn't None, the IRBuilder's debug location is set to its
15
+ contents, which should be a DILocation mdnode. (See
16
+ http://llvm.org/docs/SourceLevelDebugging.html, or get it from an existing
17
+ llbuilder with Llvm.current_debug_location.) *)
18
+ let llbuilder_at_end_with_debug_loc
19
+ (llctx :Llvm.llcontext ) (llblock :Llvm.llbasicblock )
20
+ (debug_loc :Llvm.llvalue option ) =
21
+ let llbuilder = Llvm. builder_at_end llctx llblock in
22
+ may (Llvm. set_current_debug_location llbuilder) debug_loc;
23
+ llbuilder
24
+
13
25
let trans_crate
14
26
(sem_cx :Semant.ctxt )
15
27
(llctx :Llvm.llcontext )
@@ -93,17 +105,22 @@ let trans_crate
93
105
md_node [| const_i32 line; const_i32 col; scope; const_i32 0 |]
94
106
in
95
107
108
+ let di_location_from_id (scope :Llvm.llvalue ) (id :node_id )
109
+ : Llvm.llvalue option =
110
+ match Session. get_span sess id with
111
+ None -> None
112
+ | Some {lo =(_ , line , col )} ->
113
+ Some (di_location line col scope)
114
+ in
115
+
96
116
(* Sets the 'llbuilder's current location (which it attaches to all
97
117
instructions) to the location of the start of the 'id' node within
98
118
'scope', usually a subprogram or lexical block. *)
99
119
let set_debug_location
100
120
(llbuilder :Llvm.llbuilder ) (scope :Llvm.llvalue ) (id :node_id )
101
121
: unit =
102
- match Session. get_span sess id with
103
- None -> ()
104
- | Some {lo =(_ , line , col )} ->
105
- Llvm. set_current_debug_location llbuilder
106
- (di_location line col scope)
122
+ may (Llvm. set_current_debug_location llbuilder)
123
+ (di_location_from_id scope id)
107
124
in
108
125
109
126
(* Translation of our node_ids into LLVM identifiers, which are strings. *)
@@ -445,9 +462,10 @@ let trans_crate
445
462
let llty = trans_slot None slot in
446
463
let ty = Semant. slot_ty slot in
447
464
448
- let new_block klass =
465
+ let new_block klass debug_loc =
449
466
let llblock = Llvm. append_block llctx (anon_llid klass) llfn in
450
- let llbuilder = Llvm. builder_at_end llctx llblock in
467
+ let llbuilder =
468
+ llbuilder_at_end_with_debug_loc llctx llblock debug_loc in
451
469
(llblock, llbuilder)
452
470
in
453
471
@@ -460,8 +478,9 @@ let trans_crate
460
478
let test =
461
479
Llvm. build_icmp Llvm.Icmp. Ne null ptr (anon_llid " nullp" ) llbuilder
462
480
in
463
- let (llthen, llthen_builder) = new_block " then" in
464
- let (llnext, llnext_builder) = new_block " next" in
481
+ let debug_loc = Llvm. current_debug_location llbuilder in
482
+ let (llthen, llthen_builder) = new_block " then" debug_loc in
483
+ let (llnext, llnext_builder) = new_block " next" debug_loc in
465
484
ignore (Llvm. build_cond_br test llthen llnext llbuilder);
466
485
let llthen_builder = inner ptr llthen_builder in
467
486
ignore (Llvm. build_br llnext llthen_builder);
@@ -483,8 +502,9 @@ let trans_crate
483
502
Llvm. build_icmp Llvm.Icmp. Eq
484
503
rc (imm 0L ) (anon_llid " zerop" ) llbuilder
485
504
in
486
- let (llthen, llthen_builder) = new_block " then" in
487
- let (llnext, llnext_builder) = new_block " next" in
505
+ let debug_loc = Llvm. current_debug_location llbuilder in
506
+ let (llthen, llthen_builder) = new_block " then" debug_loc in
507
+ let (llnext, llnext_builder) = new_block " next" debug_loc in
488
508
ignore (Llvm. build_cond_br test llthen llnext llbuilder);
489
509
let llthen_builder = inner ptr llthen_builder in
490
510
ignore (Llvm. build_br llnext llthen_builder);
@@ -588,16 +608,18 @@ let trans_crate
588
608
* a little trickery here to wrangle the statement sequence into LLVM's
589
609
* format. *)
590
610
591
- let new_block id_opt klass =
611
+ let new_block id_opt klass debug_loc =
592
612
let llblock = Llvm. append_block llctx (node_llid id_opt klass) llfn in
593
- let llbuilder = Llvm. builder_at_end llctx llblock in
594
- (llblock, llbuilder)
613
+ let llbuilder =
614
+ llbuilder_at_end_with_debug_loc llctx llblock debug_loc in
615
+ (llblock, llbuilder)
595
616
in
596
617
597
618
(* Build up the slot-to-llvalue mapping, allocating space along the
598
619
* way. *)
599
620
let slot_to_llvalue = Hashtbl. create 0 in
600
- let (_, llinitbuilder) = new_block None " init" in
621
+ let (_, llinitbuilder) =
622
+ new_block None " init" (di_location_from_id llsubprogram fn_id) in
601
623
602
624
(* Allocate space for arguments (needed because arguments are lvalues in
603
625
* Rust), and store them in the slot-to-llvalue mapping. *)
@@ -885,7 +907,9 @@ let trans_crate
885
907
886
908
| Ast. STMT_if sif ->
887
909
let llexpr = trans_expr sif.Ast. if_test in
888
- let (llnext, llnextbuilder) = new_block None " next" in
910
+ let (llnext, llnextbuilder) =
911
+ new_block None " next"
912
+ (Llvm. current_debug_location llbuilder) in
889
913
let branch_to_next llbuilder' _ =
890
914
ignore (Llvm. build_br llnext llbuilder')
891
915
in
@@ -931,10 +955,13 @@ let trans_crate
931
955
932
956
| Ast. STMT_check_expr expr ->
933
957
let llexpr = trans_expr expr in
934
- let (llfail, llfailbuilder) = new_block None " fail" in
958
+ let debug_loc = Llvm. current_debug_location llbuilder in
959
+ let (llfail, llfailbuilder) =
960
+ new_block None " fail" debug_loc in
935
961
let reason = Fmt. fmt_to_str Ast. fmt_expr expr in
936
962
trans_fail llfailbuilder lltask reason head.id;
937
- let (llok, llokbuilder) = new_block None " ok" in
963
+ let (llok, llokbuilder) =
964
+ new_block None " ok" debug_loc in
938
965
ignore (Llvm. build_cond_br llexpr llok llfail llbuilder);
939
966
trans_tail_with_builder llokbuilder
940
967
@@ -966,7 +993,8 @@ let trans_crate
966
993
({ node = (stmts :Ast.stmt array ); id = id } :Ast. block )
967
994
(terminate :Llvm.llbuilder -> node_id -> unit )
968
995
: Llvm.llbasicblock =
969
- let (llblock, llbuilder) = new_block (Some id) " bb" in
996
+ let (llblock, llbuilder) =
997
+ new_block (Some id) " bb" (di_location_from_id llsubprogram id) in
970
998
trans_stmts id llbuilder (Array. to_list stmts) terminate;
971
999
llblock
972
1000
in
0 commit comments