You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
111 lines
4.2 KiB
111 lines
4.2 KiB
(*
|
|
* Copyright (c) Facebook, Inc. and its affiliates.
|
|
*
|
|
* This source code is licensed under the MIT license found in the
|
|
* LICENSE file in the root directory of this source tree.
|
|
*)
|
|
open! IStd
|
|
module L = Logging
|
|
module IdMap = Typ.Procname.Hash
|
|
|
|
let build_from_captured_procs g =
|
|
let hashcons_pname =
|
|
let pname_tbl : Typ.Procname.t IdMap.t = IdMap.create 1001 in
|
|
fun pname ->
|
|
match IdMap.find_opt pname_tbl pname with
|
|
| Some pname' ->
|
|
pname'
|
|
| None ->
|
|
IdMap.add pname_tbl pname pname ; pname
|
|
in
|
|
let db = ResultsDatabase.get_database () in
|
|
let stmt = Sqlite3.prepare db "SELECT proc_name, callees FROM procedures" in
|
|
SqliteUtils.result_fold_rows db ~log:"creating call graph" stmt ~init:() ~f:(fun () stmt ->
|
|
let proc_name = Sqlite3.column stmt 0 |> Typ.Procname.SQLite.deserialize |> hashcons_pname in
|
|
let callees =
|
|
Sqlite3.column stmt 1 |> Typ.Procname.SQLiteList.deserialize |> List.map ~f:hashcons_pname
|
|
in
|
|
CallGraph.create_node g proc_name callees )
|
|
|
|
|
|
let build_from_sources g sources =
|
|
let time0 = Mtime_clock.counter () in
|
|
L.progress "Building call graph...@\n%!" ;
|
|
build_from_captured_procs g ;
|
|
let n_captured = CallGraph.n_procs g in
|
|
List.iter sources ~f:(fun sf ->
|
|
SourceFiles.proc_names_of_source sf |> List.iter ~f:(CallGraph.flag_reachable g) ) ;
|
|
CallGraph.remove_unflagged_and_unflag_all g ;
|
|
CallGraph.trim_id_map g ;
|
|
if Config.debug_level_analysis > 0 then CallGraph.to_dotty g "syntactic_callgraph.dot" ;
|
|
L.progress
|
|
"Built call graph in %a, from %d total procs, %d reachable defined procs and takes %d bytes@."
|
|
Mtime.Span.pp (Mtime_clock.count time0) n_captured (CallGraph.n_procs g)
|
|
(Obj.(reachable_words (repr g)) * (Sys.word_size / 8))
|
|
|
|
|
|
let count_procedures () =
|
|
let db = ResultsDatabase.get_database () in
|
|
let stmt = Sqlite3.prepare db "SELECT COUNT(rowid) FROM procedures" in
|
|
let count =
|
|
match SqliteUtils.result_single_column_option db ~log:"counting procedures" stmt with
|
|
| Some (Sqlite3.Data.INT i64) ->
|
|
Int64.to_int i64 |> Option.value ~default:Int.max_value
|
|
| _ ->
|
|
L.die InternalError "Got no result trying to count procedures"
|
|
in
|
|
L.debug Analysis Quiet "Found %d procedures in procedures table.@." count ;
|
|
count
|
|
|
|
|
|
let bottom_up sources : SchedulerTypes.target ProcessPool.TaskGenerator.t =
|
|
let open SchedulerTypes in
|
|
(* this will potentially grossly overapproximate the tasks *)
|
|
let remaining = ref (count_procedures ()) in
|
|
let remaining_tasks () = !remaining in
|
|
let syntactic_call_graph = CallGraph.create CallGraph.default_initial_capacity in
|
|
let initialized = ref false in
|
|
let pending : CallGraph.Node.t list ref = ref [] in
|
|
let scheduled = ref Typ.Procname.Set.empty in
|
|
let is_empty () =
|
|
let empty = !initialized && List.is_empty !pending && Typ.Procname.Set.is_empty !scheduled in
|
|
if empty then (
|
|
remaining := 0 ;
|
|
L.progress "Finished call graph scheduling, %d procs remaining (in, or reaching, cycles).@."
|
|
(CallGraph.n_procs syntactic_call_graph) ;
|
|
if Config.debug_level_analysis > 0 then CallGraph.to_dotty syntactic_call_graph "cycles.dot" ;
|
|
(* save some memory *)
|
|
CallGraph.reset syntactic_call_graph ) ;
|
|
empty
|
|
in
|
|
let rec next_aux () =
|
|
match !pending with
|
|
| [] ->
|
|
pending := CallGraph.get_unflagged_leaves syntactic_call_graph ;
|
|
if List.is_empty !pending then None else next_aux ()
|
|
| n :: ns when n.flag || not (CallGraph.mem syntactic_call_graph n.id) ->
|
|
pending := ns ;
|
|
next_aux ()
|
|
| n :: ns ->
|
|
pending := ns ;
|
|
scheduled := Typ.Procname.Set.add n.pname !scheduled ;
|
|
CallGraph.flag syntactic_call_graph n.pname ;
|
|
Some (Procname n.pname)
|
|
in
|
|
let finished = function
|
|
| File _ ->
|
|
assert false
|
|
| Procname pname ->
|
|
decr remaining ;
|
|
scheduled := Typ.Procname.Set.remove pname !scheduled ;
|
|
CallGraph.remove syntactic_call_graph pname
|
|
in
|
|
let next () =
|
|
(* do construction here, to avoid having the call graph into forked workers *)
|
|
if not !initialized then (
|
|
build_from_sources syntactic_call_graph sources ;
|
|
initialized := true ) ;
|
|
next_aux ()
|
|
in
|
|
{remaining_tasks; is_empty; finished; next}
|