[sledge] Do not represent function CFGs explicitly

Summary:
The CFG of a function is implicit in the blocks themselves, so it is
possible to remove the explicit represention as a vector of
blocks. The only uses are fold or iter, and since the cycles are
detected during construction, these can be simple depth-first
traversals.

Reviewed By: bennostein

Differential Revision: D17821845

fbshipit-source-id: fc7a02151
master
Josh Berdine 5 years ago committed by Facebook Github Bot
parent 2bbe7ff9f2
commit 6399c59861

@ -52,17 +52,13 @@ and block =
; mutable parent: func
; mutable sort_index: int }
and cfg = block vector
(* [entry] is not part of [cfg] since it cannot be jumped to, only called. *)
and func =
{ name: Global.t
; formals: Reg.t list
; freturn: Reg.t option
; fthrow: Reg.t
; locals: Reg.Set.t
; entry: block
; cfg: cfg }
; entry: block }
let sexp_cons (hd : Sexp.t) (tl : Sexp.t) =
match tl with
@ -105,17 +101,14 @@ let sexp_of_block {lbl; cmnd; term; parent; sort_index} =
; parent: Reg.t = parent.name.reg
; sort_index: int }]
let sexp_of_cfg v = [%sexp_of: block vector] v
let sexp_of_func {name; formals; freturn; fthrow; locals; entry; cfg} =
let sexp_of_func {name; formals; freturn; fthrow; locals; entry} =
[%sexp
{ name: Global.t
; formals: Reg.t list
; freturn: Reg.t option
; fthrow: Reg.t
; locals: Reg.Set.t
; entry: block
; cfg: cfg }]
; entry: block }]
(* blocks in a [t] are uniquely identified by [sort_index] *)
let compare_block x y = Int.compare x.sort_index y.sort_index
@ -226,8 +219,7 @@ and dummy_func =
; freturn= None
; fthrow= dummy_reg
; locals= Reg.Set.empty
; entry= dummy_block
; cfg= Vector.empty }
; entry= dummy_block }
(** Instructions *)
@ -385,6 +377,32 @@ module Block = struct
; sort_index= dummy_block.sort_index }
end
(* Blocks compared by label, which are unique within a function, used to
compute unique sort_index ids *)
module Block_label = struct
module T = struct
module T0 = struct
type t = block [@@deriving sexp_of]
let compare x y =
[%compare: string * Global.t] (x.lbl, x.parent.name)
(y.lbl, y.parent.name)
let hash b = [%hash: string * Global.t] (b.lbl, b.parent.name)
end
include T0
include Comparator.Make (T0)
end
include T
let empty_set = Set.empty (module T)
end
module BlockQ = Hash_queue.Make (Block_label)
module FuncQ = Hash_queue.Make (Reg)
(** Functions *)
module Func = struct
@ -394,14 +412,42 @@ module Func = struct
| {entry= {cmnd; term= Unreachable; _}; _} -> Vector.is_empty cmnd
| _ -> false
let fold_cfg ~init ~f func =
let seen = Hash_set.create (module Block_label) in
let rec fold_cfg_ s blk =
if Result.is_error (Hash_set.strict_add seen blk) then s
else
let s =
let f s j = fold_cfg_ s j.dst in
match blk.term with
| Switch {tbl; els; _} ->
let s = Vector.fold ~f:(fun s (_, j) -> f s j) ~init:s tbl in
f s els
| Iswitch {tbl; _} -> Vector.fold ~f ~init:s tbl
| Call {return; throw; _} ->
let s = f s return in
Option.fold ~f ~init:s throw
| Return _ | Throw _ | Unreachable -> s
in
f s blk
in
fold_cfg_ init func.entry
let fold_term func ~init ~f =
fold_cfg func ~init ~f:(fun s blk -> f s blk.term)
let iter_term func ~f =
fold_cfg func ~init:() ~f:(fun () blk -> f blk.term)
let entry_cfg func = fold_cfg ~init:[] ~f:(fun cfg blk -> blk :: cfg) func
let pp fs
( { name
; formals
; freturn
; fthrow= _
; locals= _
; entry= {cmnd; term; sort_index; _}
; cfg } as func ) =
; entry= {cmnd; term; sort_index; _} } as func ) =
let pp_if cnd str fs = if cnd then Format.fprintf fs str in
Format.fprintf fs "@[<v>@[<v>%a%a@[<2>%a%a@]%t@]"
(Option.pp "%a " Typ.pp)
@ -413,29 +459,24 @@ module Func = struct
(fun fs ->
if is_undefined func then Format.fprintf fs " #%i@]" sort_index
else
let cfg =
List.sort ~compare:Block.compare (List.tl_exn (entry_cfg func))
in
Format.fprintf fs " { #%i %a@;<1 4>@[<v>%a@ %a@]%t%a@]@ }"
sort_index Loc.pp name.loc pp_cmnd cmnd Term.pp term
(pp_if (not (Vector.is_empty cfg)) "@ @ ")
(Vector.pp "@\n@\n " Block.pp)
(pp_if (not (List.is_empty cfg)) "@ @ ")
(List.pp "@\n@\n " Block.pp)
cfg )
let fold_term {entry; cfg; _} ~init ~f =
Vector.fold cfg ~init:(f init entry.term) ~f:(fun a blk -> f a blk.term)
let iter_term {entry; cfg; _} ~f =
f entry.term ;
Vector.iter cfg ~f:(fun blk -> f blk.term)
let invariant func =
Invariant.invariant [%here] func [%sexp_of: t]
@@ fun () ->
assert (func == func.entry.parent) ;
let {name= {typ; _}; cfg; _} = func in
match typ with
match func.name.typ with
| Pointer {elt= Function {return; _}; _} ->
assert (
not
(Vector.contains_dup cfg ~compare:(fun b1 b2 ->
(List.contains_dup (entry_cfg func) ~compare:(fun b1 b2 ->
String.compare b1.lbl b2.lbl )) ) ;
assert (Bool.(Option.is_some return = Option.is_some func.freturn)) ;
iter_term func ~f:(fun term -> Term.invariant ~parent:func term)
@ -454,7 +495,7 @@ module Func = struct
let init = locals_block Reg.Set.empty entry in
Vector.fold ~f:locals_block cfg ~init
in
let func = {name; formals; freturn; fthrow; locals; entry; cfg} in
let func = {name; formals; freturn; fthrow; locals; entry} in
let resolve_parent_and_jumps block =
block.parent <- func ;
let lookup cfg lbl : block =
@ -485,32 +526,6 @@ end
(** Derived meta-data *)
(* Blocks compared by label, which are unique within a function, used to
compute unique sort_index ids *)
module Block_label = struct
module T = struct
module T0 = struct
type t = block [@@deriving sexp_of]
let compare x y =
[%compare: string * Global.t] (x.lbl, x.parent.name)
(y.lbl, y.parent.name)
let hash b = [%hash: string * Global.t] (b.lbl, b.parent.name)
end
include T0
include Comparator.Make (T0)
end
include T
let empty_set = Set.empty (module T)
end
module BlockQ = Hash_queue.Make (Block_label)
module FuncQ = Hash_queue.Make (Reg)
let set_derived_metadata functions =
let compute_roots functions =
let roots = FuncQ.create () in
@ -565,12 +580,6 @@ let set_derived_metadata functions =
block.sort_index <- !index ;
index := !index - 1 )
in
let sort_cfgs functions =
Map.iter functions ~f:(fun {cfg; _} ->
Array.sort
~compare:(fun x y -> Int.compare x.sort_index y.sort_index)
(Vector.to_array cfg) )
in
let functions =
List.fold functions
~init:(Map.empty (module String))
@ -580,7 +589,6 @@ let set_derived_metadata functions =
let roots = compute_roots functions in
let tips_to_roots = topsort functions roots in
set_sort_indices tips_to_roots ;
sort_cfgs functions ;
functions
let invariant pgm =

@ -83,8 +83,6 @@ and block = private
(** Position in a topological order, ignoring [retreating] edges. *)
}
and cfg
(** A function is a control-flow graph with distinguished entry block, whose
parameters are the function parameters. *)
and func = private
@ -93,8 +91,7 @@ and func = private
; freturn: Reg.t option
; fthrow: Reg.t
; locals: Reg.Set.t (** Local registers *)
; entry: block
; cfg: cfg }
; entry: block }
type functions

Loading…
Cancel
Save