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.

250 lines
9.7 KiB

(*
* Copyright (c) 2009 - 2013 Monoidics ltd.
* Copyright (c) 2013 - present Facebook, Inc.
* All rights reserved.
*
* This source code is licensed under the BSD style license found in the
* LICENSE file in the root directory of this source tree. An additional grant
* of patent rights can be found in the PATENTS file in the same directory.
*)
open Javalib_pack
open Sawja_pack
open Utils
module L = Logging
let add_edges context start_node exn_node exit_nodes method_body_nodes impl super_call =
let pc_nb = Array.length method_body_nodes in
let last_pc = pc_nb - 1 in
let is_last pc = (pc = last_pc) in
let rec get_body_nodes pc =
let current_nodes = method_body_nodes.(pc) in
match current_nodes with
| JTrans.Skip when (is_last pc) && not (JContext.is_goto_jump context pc) ->
exit_nodes
| JTrans.Skip -> direct_successors pc
| JTrans.Instr node -> [node]
| JTrans.Prune (node_true, node_false) -> [node_true; node_false]
| JTrans.Loop (join_node, _, _) -> [join_node]
and direct_successors pc =
if is_last pc && not (JContext.is_goto_jump context pc) then
exit_nodes
else
match JContext.get_goto_jump context pc with
| JContext.Next -> get_body_nodes (pc + 1)
| JContext.Jump goto_pc ->
if pc = goto_pc then [] (* loop in goto *)
else get_body_nodes goto_pc
| JContext.Exit -> exit_nodes in
let get_succ_nodes node pc =
match JContext.get_if_jump context node with
| None -> direct_successors pc
| Some jump_pc -> get_body_nodes jump_pc in
let get_exn_nodes =
if super_call then (fun x -> exit_nodes)
else JTransExn.create_exception_handlers context [exn_node] get_body_nodes impl in
let connect node pc =
Cfg.Node.set_succs_exn node (get_succ_nodes node pc) (get_exn_nodes pc) in
let connect_nodes pc translated_instruction =
match translated_instruction with
| JTrans.Skip -> ()
| JTrans.Instr node -> connect node pc
| JTrans.Prune (node_true, node_false) ->
connect node_true pc;
connect node_false pc
| JTrans.Loop (join_node, node_true, node_false) ->
Cfg.Node.set_succs_exn join_node [node_true; node_false] [];
connect node_true pc;
connect node_false pc in
let first_nodes = direct_successors (-1) in (* deals with the case of an empty array *)
Cfg.Node.set_succs_exn start_node first_nodes exit_nodes; (* the exceptions edges here are going directly to the exit node *)
if not super_call then
Cfg.Node.set_succs_exn exn_node exit_nodes exit_nodes; (* the exceptions node is just before the exit node *)
Array.iteri connect_nodes method_body_nodes
(** Add a concrete method. *)
let add_cmethod never_null_matcher program icfg node cm is_static =
let cfg = icfg.JContext.cfg in
let tenv = icfg.JContext.tenv in
let cn, ms = JBasics.cms_split cm.Javalib.cm_class_method_signature in
let is_clinit = JBasics.ms_equal ms JBasics.clinit_signature in
if !JTrans.no_static_final = false
&& is_clinit
&& not (JTransStaticField.has_static_final_fields node) then
JUtils.log "\t\tskipping class initializer: %s@." (JBasics.ms_name ms)
else
match JTrans.get_method_procdesc program cfg tenv cn ms is_static with
| JTrans.Defined procdesc when JClasspath.is_model (Cfg.Procdesc.get_proc_name procdesc) ->
(* do not capture the method if there is a model for it *)
JUtils.log "Skipping method with a model: %s@." (Procname.to_string (Cfg.Procdesc.get_proc_name procdesc));
| JTrans.Defined procdesc ->
let start_node = Cfg.Procdesc.get_start_node procdesc in
let exit_node = Cfg.Procdesc.get_exit_node procdesc in
let exn_node =
match JContext.get_exn_node procdesc with
| Some node -> node
| None -> assert false in
let impl = JTrans.get_implementation cm in
let instrs, meth_kind =
if is_clinit && not !JTrans.no_static_final then
let instrs = JTransStaticField.static_field_init node cn (JBir.code impl) in
(instrs, JContext.Init)
else (JBir.code impl), JContext.Normal in
let context =
JContext.create_context
never_null_matcher icfg procdesc impl cn meth_kind node program in
let method_body_nodes = Array.mapi (JTrans.instruction context) instrs in
let procname = Cfg.Procdesc.get_proc_name procdesc in
add_edges context start_node exn_node [exit_node] method_body_nodes impl false;
Cg.add_defined_node icfg.JContext.cg procname;
if Procname.is_constructor procname then Cfg.set_procname_priority cfg procname
| JTrans.Called _ -> ()
(** Add an abstract method. *)
let add_amethod program icfg node am is_static =
let cfg = icfg.JContext.cfg in
let tenv = icfg.JContext.tenv in
let cn, ms = JBasics.cms_split am.Javalib.am_class_method_signature in
match JTrans.get_method_procdesc program cfg tenv cn ms is_static with
| JTrans.Defined procdesc when (JClasspath.is_model (Cfg.Procdesc.get_proc_name procdesc)) ->
(* do not capture the method if there is a model for it *)
JUtils.log "Skipping method with a model: %s@." (Procname.to_string (Cfg.Procdesc.get_proc_name procdesc));
| JTrans.Defined procdesc ->
Cg.add_defined_node icfg.JContext.cg (Cfg.Procdesc.get_proc_name procdesc)
| JTrans.Called _ -> ()
let path_of_cached_classname cn =
let root_path = Filename.concat !Config.results_dir "classnames" in
let package_path = IList.fold_left Filename.concat root_path (JBasics.cn_package cn) in
Filename.concat package_path ((JBasics.cn_simple_name cn)^".java")
let cache_classname cn =
let path = path_of_cached_classname cn in
let splitted_root_dir =
let rec split l p =
match p with
| p when p = Filename.current_dir_name -> l
| p when p = Filename.dir_sep -> l
| p -> split ((Filename.basename p):: l) (Filename.dirname p) in
split [] (Filename.dirname path) in
let rec mkdir l p =
let () =
if not (Sys.file_exists p) then
Unix.mkdir p 493 in
match l with
| [] -> ()
| d:: tl -> mkdir tl (Filename.concat p d) in
mkdir splitted_root_dir Filename.dir_sep;
let file_out = open_out(path) in
output_string file_out (string_of_float (Unix.time ()));
close_out file_out
let is_classname_cached cn =
Sys.file_exists (path_of_cached_classname cn)
(* Given a source file and a class, translates the code of this class.
In init - mode, finds out whether this class contains initializers at all,
in this case translates it. In standard mode, all methods are translated *)
let create_icfg never_null_matcher linereader program icfg cn node =
JUtils.log "\tclassname: %s@." (JBasics.cn_name cn);
cache_classname cn;
let cfg = icfg.JContext.cfg in
let tenv = icfg.JContext.tenv in
begin
Javalib.m_iter (JTrans.create_local_procdesc program linereader cfg tenv node) node;
Javalib.m_iter (fun m ->
(* each procedure has different scope: start names from id 0 *)
Ident.NameGenerator.reset ();
let method_kind = JTransType.get_method_kind m in
match m with
| Javalib.ConcreteMethod cm ->
add_cmethod never_null_matcher program icfg node cm method_kind
| Javalib.AbstractMethod am ->
add_amethod program icfg node am method_kind
) node
end
(*
This type definition is for a future improvement of the capture where in one pass, the frontend will
translate things differently whether a source file is found for a given class
*)
type capture_status =
| With_source of string
| Library of string
| Unknown
(* returns true for the set of classes that are selected to be translated *)
let should_capture classes package_opt source_basename node =
let classname = Javalib.get_name node in
let temporary_skip =
(* TODO (#6341744): remove this *)
IList.exists
(fun part -> part = "graphschema")
(JBasics.cn_package classname) in
let match_package pkg cn =
match JTransType.package_to_string (JBasics.cn_package cn) with
| None -> pkg = ""
| Some found_pkg -> found_pkg = pkg in
if JBasics.ClassSet.mem classname classes && not temporary_skip then
begin
match Javalib.get_sourcefile node with
| None -> false
| Some found_basename ->
begin
match package_opt with
| None -> found_basename = source_basename
| Some pkg ->
match_package pkg classname
&& found_basename = source_basename
end
end
else false
(* Computes the control - flow graph and call - graph of a given source file.
In the standard - mode, it translated all the classes that correspond to this
source file. *)
let compute_source_icfg
never_null_matcher linereader classes program tenv
source_basename package_opt =
let icfg =
{ JContext.cg = Cg.create ();
JContext.cfg = Cfg.Node.create_cfg ();
JContext.tenv = tenv } in
let select test procedure cn node =
if test node then
try
procedure cn node
with
| Bir.Subroutine -> ()
| e -> raise e in
let () =
JBasics.ClassMap.iter
(select
(should_capture classes package_opt source_basename)
(create_icfg never_null_matcher linereader program icfg))
(JClasspath.get_classmap program) in
(icfg.JContext.cg, icfg.JContext.cfg)
let compute_class_icfg never_null_matcher linereader program tenv node fake_source_file =
let icfg =
{ JContext.cg = Cg.create ();
JContext.cfg = Cfg.Node.create_cfg ();
JContext.tenv = tenv } in
begin
try
create_icfg
never_null_matcher linereader program icfg (Javalib.get_name node) node
with
| Bir.Subroutine -> ()
| e -> raise e
end;
(icfg.JContext.cg, icfg.JContext.cfg)