open Simplest open Std exception InvalidPreDwarf of string type pre_c_pre_dwarf_entry = { location: int64; cfa_offset: int64; cfa_offset_reg: int; rbp_defined: bool; rbp_offset: int64 (* Assumed to be offset of CFA *) } type pre_c_pre_dwarf_fde = { num: int; initial_location: int64; end_location: int64; name: string; entries: pre_c_pre_dwarf_entry array } type pre_c_pre_dwarf = { num_fde: int; fdes: pre_c_pre_dwarf_fde array } (* OCAML -> C conversion *) (* external write_dwarf : string -> pre_c_pre_dwarf -> int = "caml__write_dwarf" *) (* ========================================================================= *) (** Empty default value for `pre_c_pre_dwarf_entry` *) let empty_entry = { location = Int64.zero; cfa_offset = Int64.zero; cfa_offset_reg = 0; rbp_defined = false; rbp_offset = Int64.zero } (** Empty default value for `pre_c_pre_dwarf_fde` *) let empty_fde = { num = 0; initial_location = Int64.zero; end_location = Int64.zero; name = ""; entries = Array.make 0 empty_entry } module MapTool (MapT: Map.S) = struct (** Folds a Map.S.t into an array *) let fold_map_to_array folder map any_elt = let out = Array.make (MapT.cardinal map) any_elt in MapT.fold (fun key elt pos -> Array.set out pos @@ folder key elt pos; pos + 1) map 0 |> ignore; out end let convert_pre_c_entry loc entry : pre_c_pre_dwarf_entry = let cfa_entry, rbp_entry = entry in let cfa_offset, cfa_offset_reg = (match cfa_entry with | RspOffset off -> off, 7 | RbpOffset off -> off, 6 | CfaLostTrack -> raise (InvalidPreDwarf ("CfaLostTrack should be filtered out beforehand")) ) in let rbp_defined, rbp_offset = (match rbp_entry with | RbpUndef -> false, Int64.zero | RbpCfaOffset off -> true, off ) in { location = loc; cfa_offset = cfa_offset; cfa_offset_reg = cfa_offset_reg; rbp_defined = rbp_defined; rbp_offset = rbp_offset } module AddrMapTool = MapTool(AddrMap) let convert_pre_c_entries entries : pre_c_pre_dwarf_entry array = AddrMapTool.fold_map_to_array (fun loc entry _ -> convert_pre_c_entry loc entry) entries empty_entry let convert_pre_c_fde name entry : pre_c_pre_dwarf_fde option = try Some { num = AddrMap.cardinal entry.reg_changes_fde; initial_location = entry.beg_pos; end_location = entry.end_pos; name = name; entries = convert_pre_c_entries entry.reg_changes_fde } with InvalidPreDwarf reason -> ( Format.eprintf "FAILED subroutine %s: %s@." name reason ; None ) module StrMapTool = MapTool(StrMap) let convert_pre_c (cfa_map: subroutine_cfa_map) : pre_c_pre_dwarf = (** Converts a `subroutine_cfa_map` to a `pre_c_pre_dwarf` type, in preparation for C coversion. *) let num_fde = StrMap.cardinal cfa_map in let fdes_list_with_none = StrMap.fold (fun name entry folded -> (convert_pre_c_fde name entry) :: folded) cfa_map [] in let fdes_list = List.fold_left (fun folded elt -> match elt with | Some x -> x::folded | None -> folded) [] fdes_list_with_none in let fdes = Array.of_list fdes_list in { num_fde = num_fde ; fdes = fdes }