218 lines
6.5 KiB
OCaml
218 lines
6.5 KiB
OCaml
(** Abstract Renderer
|
|
|
|
Abstract generic renderer, with tools to ease and unify the output of
|
|
computations on a given program in any chosen format.
|
|
*)
|
|
|
|
module RawAsm = Asm_info.NoAnnot
|
|
|
|
type addr_range_t = RawAsm.addr_t * RawAsm.addr_t
|
|
type box_data_t = {
|
|
box_file : string;
|
|
box_line : int;
|
|
box_col : int;
|
|
box_class_id : int;
|
|
}
|
|
type addr_range_tag_t = int
|
|
type tag_addr_range_t = TaggedRange of addr_range_tag_t * addr_range_t *
|
|
box_data_t
|
|
|
|
module RangeTagMap = Map.Make(struct
|
|
type t = addr_range_tag_t
|
|
let compare = compare
|
|
end)
|
|
|
|
type render_data_t = {
|
|
render_prog_path : string ;
|
|
render_prog : RawAsm.asm_info_t ;
|
|
render_boxes : tag_addr_range_t list ;
|
|
render_prev_address : RawAsm.addr_t RawAsm.AddrMap.t ;
|
|
}
|
|
|
|
type multi_render_data_t = render_data_t list
|
|
|
|
type render_box_event_t =
|
|
BoxStart of addr_range_tag_t * RawAsm.addr_t * box_data_t
|
|
| BoxEnd of addr_range_tag_t * RawAsm.addr_t * box_data_t
|
|
|
|
type asm_annot_type = {
|
|
events : render_box_event_t list
|
|
}
|
|
module AnnotAsm = Asm_info.S(struct type instr_annot_t = asm_annot_type end)
|
|
|
|
(** Make a map mapping addresses to the preceding instruction address appearing
|
|
in `prog` *)
|
|
let make_prev_address prog =
|
|
let _, addr_map =
|
|
List.fold_left (fun (prev_addr, cmap) sub ->
|
|
List.fold_left (fun (prev_addr, cmap) instr ->
|
|
(instr.RawAsm.instr_addr,
|
|
RawAsm.AddrMap.add instr.RawAsm.instr_addr prev_addr cmap)
|
|
)
|
|
(prev_addr, cmap)
|
|
sub.RawAsm.sub_asm
|
|
)
|
|
(0, RawAsm.AddrMap.empty)
|
|
prog
|
|
in
|
|
addr_map
|
|
|
|
(** Initializes a rendering data structure on the given program *)
|
|
let init_render_data prog path =
|
|
{
|
|
render_prog_path = path ;
|
|
render_prog = prog ;
|
|
render_boxes = [] ;
|
|
render_prev_address = make_prev_address prog ;
|
|
}
|
|
|
|
let fresh_box_id =
|
|
let next_id = ref 0 in
|
|
fun () ->
|
|
let out = !next_id in
|
|
incr next_id;
|
|
out
|
|
|
|
(** [add_box render_data range] adds a box around an address range, inclusive
|
|
of both bounds, in [render_data] and returns the new render data and the
|
|
newly inserted element's id *)
|
|
let add_box render_data range opt_data : render_data_t * int =
|
|
let elt_id = fresh_box_id () in
|
|
|
|
let data = (match opt_data with
|
|
| Some data -> data
|
|
| None -> {
|
|
box_file = "";
|
|
box_line = 0;
|
|
box_col = 0;
|
|
box_class_id = 0;
|
|
})
|
|
in
|
|
{
|
|
render_data with
|
|
render_boxes =
|
|
(TaggedRange(elt_id, range, data)) :: render_data.render_boxes
|
|
}, elt_id
|
|
|
|
|
|
(** Same as [add_box], with an included start, excluded end for range. *)
|
|
let add_box_excl render_data (addr_beg, addr_end) opt_data =
|
|
let lower_than_end addr = addr <= addr_end in
|
|
(match RawAsm.AddrMap.find_last_opt
|
|
lower_than_end render_data.render_prev_address with
|
|
| None ->
|
|
Format.eprintf "Box end address %x not found, ignoring box.@."
|
|
addr_end ;
|
|
raise Not_found
|
|
| Some (_, end_bound) -> add_box render_data (addr_beg, end_bound) opt_data
|
|
)
|
|
|
|
(** [to_file renderer render_data path] renders the given [render_data] to a
|
|
file at [path] using the provided specific renderer *)
|
|
let to_file renderer render_data path =
|
|
let handle = open_out path in
|
|
render_data
|
|
|> renderer
|
|
|> output_string handle ;
|
|
close_out handle
|
|
|
|
(** [to_string renderer multi_render_data] renders the given
|
|
[multi_render_data] to a returned string using the provided specific
|
|
renderer. This function is provided for unification and clarity, but is an
|
|
alias for [renderer].
|
|
*)
|
|
let to_string renderer multi_render_data =
|
|
renderer multi_render_data
|
|
|
|
let extract_event_addr box_event = match box_event with
|
|
| BoxStart(_, addr, _) -> addr
|
|
| BoxEnd(_, addr, _) -> addr
|
|
|
|
(** [boxes_to_events render_data] converts the list of boxes of `render_data`
|
|
to a list of events, that is, an address-ordered list of
|
|
`render_box_event_t`
|
|
*)
|
|
let boxes_to_events render_data =
|
|
let compare_events e1 e2 =
|
|
match (compare (extract_event_addr e1) (extract_event_addr e2)) with
|
|
| 0 -> (match e1, e2 with
|
|
| BoxEnd(_), BoxStart(_) -> -1
|
|
| BoxStart(_), BoxEnd(_) -> 1
|
|
| BoxStart(id1, _, _), BoxStart(id2, _, _) -> compare id1 id2
|
|
| BoxEnd(id1, _, _), BoxEnd(id2, _, _) -> compare id1 id2
|
|
)
|
|
| n -> n
|
|
in
|
|
|
|
let unordered_events = List.fold_left
|
|
(fun accu (TaggedRange(elt_id, (range_beg, range_end), data)) ->
|
|
(BoxStart(elt_id, range_beg, data))
|
|
:: (BoxEnd(elt_id, range_end, data))
|
|
:: accu
|
|
)
|
|
[]
|
|
render_data.render_boxes
|
|
in
|
|
let ordered_events = List.sort
|
|
compare_events
|
|
unordered_events
|
|
in
|
|
ordered_events
|
|
|
|
(** Transforms `render_data` into an `asm_info_t` whose asm lines are annotated
|
|
with events, for ease of rendering *)
|
|
let render_data_to_annotated_asm render_data : AnnotAsm.asm_info_t =
|
|
let render_events = boxes_to_events render_data in
|
|
|
|
(* Splits `events` into two lists: a list of events whose addresses match
|
|
`addr` and the remaining tail list. *)
|
|
let extract_current_events events addr =
|
|
let reached_stop event = (extract_event_addr event) > addr in
|
|
let rec fold_until accu l = match l with
|
|
| (hd::_) as cur_l when reached_stop hd -> (List.rev accu), cur_l
|
|
| hd::tl -> fold_until (hd::accu) tl
|
|
| [] -> (List.rev accu), []
|
|
in
|
|
fold_until [] events
|
|
in
|
|
|
|
let map_asm render_events lst =
|
|
let asm, leftover_events = List.fold_left
|
|
(fun (accu, render_events) asm_instr ->
|
|
let current_events, future_events =
|
|
extract_current_events render_events RawAsm.(asm_instr.instr_addr)
|
|
in
|
|
(
|
|
{
|
|
AnnotAsm.instr_addr = RawAsm.(asm_instr.instr_addr) ;
|
|
AnnotAsm.instr_bytes = RawAsm.(asm_instr.instr_bytes) ;
|
|
AnnotAsm.instr_asm = RawAsm.(asm_instr.instr_asm) ;
|
|
AnnotAsm.instr_annot = {
|
|
events = current_events
|
|
}
|
|
}::accu
|
|
), future_events
|
|
)
|
|
([], render_events)
|
|
lst
|
|
in
|
|
(List.rev asm, leftover_events)
|
|
in
|
|
let annotated_asm, _ =
|
|
List.fold_left (fun (accu, render_events) sub ->
|
|
let mapped_asm, n_render_events =
|
|
map_asm render_events RawAsm.(sub.sub_asm) in
|
|
(
|
|
{
|
|
AnnotAsm.sub_section = RawAsm.(sub.sub_section) ;
|
|
AnnotAsm.sub_name = RawAsm.(sub.sub_name) ;
|
|
AnnotAsm.sub_addr = RawAsm.(sub.sub_addr) ;
|
|
AnnotAsm.sub_asm = mapped_asm ;
|
|
} :: accu
|
|
), n_render_events
|
|
)
|
|
([], render_events)
|
|
render_data.render_prog
|
|
in
|
|
List.rev annotated_asm
|