154 lines
4.8 KiB
OCaml
154 lines
4.8 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 addr_range_tag_t = int
|
|
type tag_addr_range_t = TaggedRange of addr_range_tag_t * addr_range_t
|
|
|
|
type render_data_t = {
|
|
render_prog : RawAsm.asm_info_t ;
|
|
render_boxes : tag_addr_range_t list ;
|
|
}
|
|
|
|
type render_box_event_t =
|
|
BoxStart of addr_range_tag_t * RawAsm.addr_t
|
|
| BoxEnd of addr_range_tag_t * RawAsm.addr_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)
|
|
|
|
(** Initializes a rendering data structure on the given program *)
|
|
let init_render_data prog =
|
|
{ render_prog = prog ;
|
|
render_boxes = []
|
|
}
|
|
|
|
(** [add_box render_data range] adds a box around an address range in
|
|
[render_data] and returns the new render data and the newly inserted
|
|
element's id *)
|
|
let add_box render_data range : render_data_t * int =
|
|
let elt_id = (match render_data.render_boxes with
|
|
| [] -> 0
|
|
| TaggedRange(prev_id, _)::_ -> prev_id + 1) in
|
|
|
|
{
|
|
render_data with
|
|
render_boxes = (TaggedRange(elt_id, range)) :: render_data.render_boxes
|
|
}, elt_id
|
|
|
|
(** [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 render_data] renders the given [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 render_data =
|
|
renderer 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))) ->
|
|
(BoxStart(elt_id, range_beg))
|
|
:: (BoxEnd(elt_id, range_end))
|
|
:: 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
|