Fill in source line numbers in SIL instructions.

master
Rohan Jacob-Rao 9 years ago
parent fcc0c72ecb
commit f8ed9b91f5

@ -6,9 +6,11 @@
* LICENSE file in the root directory of this source tree. An additional grant
* of patent rights can be found in the PATENTS file in the same directory.
*)
open LAst
exception ImproperTypeError of string
exception MalformedMetadata of string
exception Unimplemented of string
let ident_of_variable (var : LAst.variable) : Ident.t = (* TODO: use unique stamps *)
@ -34,27 +36,41 @@ let rec trans_typ : LAst.typ -> Sil.typ = function
| Tlabel -> raise (ImproperTypeError "Tried to generate Sil type from LLVM label type.")
| Tmetadata -> raise (ImproperTypeError "Tried to generate Sil type from LLVM metadata type.")
let location_of_annotation_option (metadata : LAst.metadata_map)
: LAst.annotation option -> Sil.location = function
| None -> Sil.dummy_location (* no annotation means no source location *)
| Some (Annotation i) ->
begin match MetadataMap.find i metadata with
| TypOperand (_, Const (Cint line_num)) :: _ -> let open Sil in
{ line = line_num; col = -1; file = DB.source_file_empty; nLOC = -1 }
| [] -> raise (MalformedMetadata "Instruction annotation refers to empty metadata node.")
| _ -> raise (MalformedMetadata ("Instruction annotation refers to metadata node " ^
"without line number as first component."))
end
(* Generate list of SIL instructions and list of local variables *)
let rec trans_annotated_instrs (cfg : Cfg.cfg) (procdesc : Cfg.Procdesc.t)
let rec trans_annotated_instrs
(cfg : Cfg.cfg) (procdesc : Cfg.Procdesc.t) (metadata : LAst.metadata_map)
: LAst.annotated_instr list -> Sil.instr list * (Mangled.t * Sil.typ) list = function
| [] -> ([], [])
| h :: t ->
let (sil_instrs, locals) = trans_annotated_instrs cfg procdesc t in
begin match fst h with
| (instr, anno) :: t ->
let (sil_instrs, locals) = trans_annotated_instrs cfg procdesc metadata t in
let location = location_of_annotation_option metadata anno in
begin match instr with
| Ret None -> (sil_instrs, locals)
| Ret (Some (tp, exp)) ->
let procname = Cfg.Procdesc.get_proc_name procdesc in
let ret_var = Sil.get_ret_pvar procname in
let new_sil_instr =
Sil.Set (Sil.Lvar ret_var, trans_typ tp, trans_operand exp, Sil.dummy_location) in
Sil.Set (Sil.Lvar ret_var, trans_typ tp, trans_operand exp, location) in
(new_sil_instr :: sil_instrs, locals)
| Load (var, tp, ptr) ->
let new_sil_instr =
Sil.Letderef (ident_of_variable var, trans_variable ptr, trans_typ tp, Sil.dummy_location) in
Sil.Letderef (ident_of_variable var, trans_variable ptr, trans_typ tp, location) in
(new_sil_instr :: sil_instrs, locals)
| Store (op, tp, var) ->
let new_sil_instr =
Sil.Set (trans_variable var, trans_typ tp, trans_operand op, Sil.dummy_location) in
Sil.Set (trans_variable var, trans_typ tp, trans_operand op, location) in
(new_sil_instr :: sil_instrs, locals)
| Alloc (var, tp, num_elems) ->
(* num_elems currently ignored *)
@ -68,7 +84,8 @@ let rec trans_annotated_instrs (cfg : Cfg.cfg) (procdesc : Cfg.Procdesc.t)
end
(* Update CFG and call graph with new function definition *)
let trans_func_def (cfg : Cfg.cfg) (cg: Cg.t) : LAst.func_def -> unit = function
let trans_func_def (cfg : Cfg.cfg) (cg: Cg.t) (metadata : LAst.metadata_map)
: LAst.func_def -> unit = function
FuncDef (func_name, ret_tp_opt, params, annotated_instrs) ->
let (proc_attrs : Sil.proc_attributes) =
let open Sil in
@ -92,7 +109,7 @@ let trans_func_def (cfg : Cfg.cfg) (cg: Cg.t) : LAst.func_def -> unit = function
ret_type = (match ret_tp_opt with
| None -> Sil.Tvoid
| Some ret_tp -> trans_typ ret_tp);
formals = List.map (fun (tp, name) -> (name, trans_typ tp)) params;
formals = Utils.list_map (fun (tp, name) -> (name, trans_typ tp)) params;
locals = []; (* TODO *)
captured = [];
loc = Sil.dummy_location
@ -110,7 +127,7 @@ let trans_func_def (cfg : Cfg.cfg) (cg: Cg.t) : LAst.func_def -> unit = function
(* link all nodes in a chain for now *)
| [] -> Cfg.Node.set_succs_exn start_node [exit_node] [exit_node]
| nd :: nds -> Cfg.Node.set_succs_exn start_node [nd] [exit_node]; link_nodes nd nds in
let (sil_instrs, locals) = trans_annotated_instrs cfg procdesc annotated_instrs in
let (sil_instrs, locals) = trans_annotated_instrs cfg procdesc metadata annotated_instrs in
let nodes = Utils.list_map (node_of_sil_instr cfg procdesc) sil_instrs in
Cfg.Procdesc.set_start_node procdesc start_node;
Cfg.Procdesc.set_exit_node procdesc exit_node;
@ -119,9 +136,9 @@ let trans_func_def (cfg : Cfg.cfg) (cg: Cg.t) : LAst.func_def -> unit = function
Cg.add_node cg procname
let trans_prog : LAst.prog -> Cfg.cfg * Cg.t * Sil.tenv = function
Prog (func_defs, _) ->
Prog (func_defs, metadata) ->
let cfg = Cfg.Node.create_cfg () in
let cg = Cg.create () in
let tenv = Sil.create_tenv () in
List.iter (trans_func_def cfg cg) func_defs;
Utils.list_iter (trans_func_def cfg cg metadata) func_defs;
(cfg, cg, tenv)

Loading…
Cancel
Save