124 lines
3.6 KiB
OCaml
124 lines
3.6 KiB
OCaml
(** Basic Pre-DWARF generation, only for unwinding data. Tracks only CFA,
|
|
and RA. *)
|
|
|
|
open Std
|
|
module CFG = BStd.Graphs.Ir
|
|
|
|
module BlkMap = Map.Make(BStd.Blk)
|
|
|
|
(** Add a new row (ie. register change) to a PreDwarf.reg_data table *)
|
|
let add_fde_row reg row (data: PreDwarf.reg_data) =
|
|
let prev_data = match Regs.RegMap.find_opt reg data with
|
|
| None -> []
|
|
| Some l -> l
|
|
in
|
|
let new_data = row :: prev_data in
|
|
Regs.RegMap.add reg new_data data
|
|
|
|
let fold_sub init fct_phi fct_def fct_jmp term =
|
|
(** Fold over the addresses of encountered subterms in `term`, a `sub` *)
|
|
let fold_term cls init fct cterm =
|
|
BStd.Seq.fold ~init:init ~f:fct @@ BStd.Term.enum cls cterm
|
|
in
|
|
|
|
fold_term BStd.blk_t init (fun accu -> fun blk ->
|
|
let accu_phi = fold_term BStd.phi_t accu fct_phi blk in
|
|
let accu_def = fold_term BStd.def_t accu_phi fct_def blk in
|
|
let accu_jmp = fold_term BStd.jmp_t accu_def fct_jmp blk in
|
|
accu_jmp) term
|
|
|
|
exception No_address
|
|
|
|
let get_term_addr term = match (BStd.Term.get_attr term BStd.address) with
|
|
(** Get the address of a given term *)
|
|
| None -> raise No_address
|
|
| Some addr -> addr
|
|
|
|
let extract_addr extractor term =
|
|
let examine_addr paddr cterm =
|
|
let naddr = get_term_addr cterm in extractor paddr naddr
|
|
in
|
|
let start_addr = get_term_addr term in
|
|
fold_sub start_addr examine_addr examine_addr examine_addr term
|
|
|
|
let low_addr term =
|
|
(** Find the low addr of some `BStd.term` *)
|
|
extract_addr min term
|
|
|
|
let high_addr term =
|
|
(** Find the high addr of some `BStd.term` (inclusive) *)
|
|
extract_addr max term
|
|
|
|
let addr_to_int addr =
|
|
(** Transforms an address (BStd.addr) into an int *)
|
|
try CKStd.Or_error.ok_exn @@ BStd.Word.to_int addr
|
|
with _ -> raise No_address
|
|
|
|
let fde_of_subroutine (sub: BStd.sub BStd.term): PreDwarf.fde =
|
|
PreDwarf.({
|
|
start_pc = addr_to_int @@ low_addr sub;
|
|
end_pc = addr_to_int @@ high_addr sub;
|
|
name = BStd.Term.name sub
|
|
})
|
|
|
|
let symbolic_predwarf_of_blk (blk: BStd.blk BStd.term) =
|
|
(** Analyze a block of code, and return its predwarf based on RSP, assuming
|
|
that at the beginning of the block, CFA = %rsp.
|
|
|
|
This will be then adjusted to be offseted by the actual CFA value upon
|
|
entrance in this block.
|
|
|
|
This function returns its offset by the end of its block.
|
|
*)
|
|
|
|
let fold_def accu elt =
|
|
let var = BStd.Def.lhs elt in
|
|
|
|
match Regs.X86_64.get_register var with
|
|
| None -> accu
|
|
| Some reg ->
|
|
accu (* TODO *)
|
|
in
|
|
|
|
let fold_elt accu elt = match elt with
|
|
| `Def(def) -> fold_def accu def
|
|
| _ -> accu
|
|
in
|
|
|
|
BStd.Seq.fold (BStd.Blk.elts blk)
|
|
~init:Regs.RegMap.empty
|
|
~f:fold_elt
|
|
|
|
let predwarf_of_sub
|
|
(fde:PreDwarf.fde)
|
|
(sub: BStd.sub BStd.term)
|
|
: PreDwarf.reg_data =
|
|
(** Compute the pre-dwarf data for a single subroutine/FDE *)
|
|
|
|
(* A `call` always result in %rsp pointing to the RA *)
|
|
let init_cfa =
|
|
[(PreDwarf.(fde.start_pc), Regs.(RegOffset(X86_64.rsp, 8)))] in
|
|
let init_ra =
|
|
[(PreDwarf.(fde.start_pc), Regs.(RegOffset(DwRegCFA, -8)))] in
|
|
let init_reg_data = Regs.(RegMap.(
|
|
add DwRegRA init_ra
|
|
@@ add DwRegCFA init_cfa
|
|
@@ empty
|
|
))
|
|
in
|
|
|
|
let sub_cfg = BStd.Sub.to_cfg sub in
|
|
|
|
assert false
|
|
|
|
let compute_pre_dwarf proj: PreDwarf.pre_dwarf_data =
|
|
let prog = BStd.Project.program proj in
|
|
let subroutines = BStd.Term.enum BStd.sub_t prog in
|
|
let subdwarf = BStd.Seq.fold subroutines
|
|
~init:PreDwarf.FdeMap.empty
|
|
~f:(fun accu sub ->
|
|
let fde = fde_of_subroutine sub in
|
|
let predwarf = predwarf_of_sub fde sub in
|
|
PreDwarf.FdeMap.add fde predwarf accu) in
|
|
subdwarf
|