(*
 * 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! Utils

open Javalib_pack
open Sawja_pack

module L = Logging

type invoke_kind =
  | I_Virtual
  | I_Interface
  | I_Special
  | I_Static

exception Frontend_error of string

let constr_loc_map : Location.t JBasics.ClassMap.t ref = ref JBasics.ClassMap.empty

let init_loc_map : Location.t JBasics.ClassMap.t ref = ref JBasics.ClassMap.empty

(** Fix the line associated to a method definition.
    Since Sawja often reports a method off by a few lines, we search
    backwards for a line where the method name is. *)
let fix_method_definition_line linereader proc_name_java loc =
  let proc_name = Procname.Java proc_name_java in
  let method_name =
    if Procname.is_constructor proc_name then
      let inner_class_name cname = snd (string_split_character cname '$') in
      inner_class_name (Procname.java_get_simple_class_name proc_name_java)
    else Procname.java_get_method proc_name_java in
  let regex = Str.regexp (Str.quote method_name) in
  let method_is_defined_here linenum =
    match Printer.LineReader.from_file_linenum_original linereader loc.Location.file linenum with
    | None -> raise Not_found
    | Some line ->
        (try ignore (Str.search_forward regex line 0); true
         with Not_found -> false) in
  let line = ref loc.Location.line in
  try
    while not (method_is_defined_here !line) do
      line := !line -1;
      if !line < 0 then raise Not_found
    done;
    { loc with Location.line = !line }
  with Not_found -> loc

let get_location source_file impl pc meth_kind cn =
  if meth_kind = JContext.Init then
    try
      JBasics.ClassMap.find cn !init_loc_map
    with Not_found -> Location.dummy
  else
    let line_number =
      let ln =
        try JBir.get_source_line_number pc impl
        with Invalid_argument _ -> None in
      match ln with
      | None -> 0
      | Some n -> n in
    { Location.line = line_number;
      col = -1;
      file = source_file;
      nLOC = !Config.nLOC }

let get_undefined_method_call ovt =
  let get_undefined_method ovt =
    match ovt with
    | None -> JConfig.void^"_undefined"
    | Some vt ->
        match vt with
        | JBasics.TBasic bt -> (JTransType.string_of_basic_type bt)^"_undefined"
        | JBasics.TObject ot ->
            begin
              match ot with
              | JBasics.TArray _ -> assert false
              | JBasics.TClass cn ->
                  if JBasics.cn_name cn = JConfig.string_cl then
                    "string_undefined"
                  else
                  if JBasics.cn_equal cn JBasics.java_lang_object then
                    "object_undefined"
                  else assert false
            end in
  let undef_cn = JBasics.make_cn JConfig.infer_undefined_cl in
  let undef_name = get_undefined_method ovt in
  let undef_ms = JBasics.make_ms undef_name [] ovt in
  (undef_cn, undef_ms)


let retrieve_fieldname fieldname =
  try
    let subs = Str.split (Str.regexp (Str.quote ".")) (Ident.fieldname_to_string fieldname) in
    if IList.length subs = 0 then
      assert false
    else
      IList.hd (IList.rev subs)
  with _ -> assert false


let get_field_name program static tenv cn fs =
  let { StructTyp.fields; statics; } = JTransType.get_class_struct_typ program tenv cn in
  match
    IList.find
      (fun (fieldname, _, _) -> retrieve_fieldname fieldname = JBasics.fs_name fs)
      (if static then statics else fields)
  with
  | fieldname, _, _ ->
      fieldname
  | exception Not_found ->
      (* TODO: understand why fields cannot be found here *)
      JUtils.log "cannot find %s.%s@." (JBasics.cn_name cn) (JBasics.fs_name fs);
      raise (Frontend_error "Cannot find fieldname")


let formals_from_signature program tenv cn ms kind =
  let counter = ref 0 in
  let method_name = JBasics.ms_name ms in
  let get_arg_name () =
    let arg = method_name^"_arg_"^(string_of_int !counter) in
    incr counter;
    Mangled.from_string arg in
  let collect l vt =
    let arg_name = get_arg_name () in
    let arg_type = JTransType.value_type program tenv vt in
    (arg_name, arg_type):: l in
  let init_arg_list = match kind with
    | Procname.Static -> []
    | Procname.Non_Static -> [(JConfig.this, JTransType.get_class_type program tenv cn)] in
  IList.rev (IList.fold_left collect init_arg_list (JBasics.ms_args ms))

let formals program tenv cn impl =
  let collect l (vt, var) =
    let name = Mangled.from_string (JBir.var_name_g var) in
    let typ = JTransType.param_type program tenv cn var vt in
    (name, typ):: l in
  IList.rev (IList.fold_left collect [] (JBir.params impl))

(** Creates the local and formal variables from a procedure based on the
    impl argument. If the meth_kind is Init, we add a parameter field to
    the initialiser method. *)
let locals_formals program tenv cn impl meth_kind =
  let form_list =
    if meth_kind = JContext.Init then
      let string_type = (JTransType.get_class_type program tenv (JBasics.make_cn JConfig.string_cl)) in
      [(JConfig.field_st, string_type) ]
    else formals program tenv cn impl in
  let is_formal p =
    IList.exists (fun (p', _) -> Mangled.equal p p') form_list in
  let collect l var =
    let vname = Mangled.from_string (JBir.var_name_g var) in
    let names = (fst (IList.split l)) in
    if not (is_formal vname) && (not (IList.mem Mangled.equal vname names)) then
      (vname, Typ.Tvoid):: l
    else
      l in
  let vars = JBir.vars impl in
  let loc_list = IList.rev (Array.fold_left collect [] vars) in
  (loc_list, form_list)

let get_constant (c : JBir.const) =
  match c with
  | `Int i -> Const.Cint (IntLit.of_int32 i)
  | `ANull -> Const.Cint IntLit.null
  | `Class ot -> Const.Cclass (Ident.string_to_name (JTransType.object_type_to_string ot))
  | `Double f -> Const.Cfloat f
  | `Float f -> Const.Cfloat f
  | `Long i64 -> Const.Cint (IntLit.of_int64 i64)
  | `String jstr -> Const.Cstr (JBasics.jstr_pp jstr)

let get_binop binop =
  match binop with
  | JBir.Add _ -> Binop.PlusA
  | JBir.Sub _ -> Binop.MinusA
  | JBir.Mult _ -> Binop.Mult
  | JBir.Div _ -> Binop.Div
  | JBir.Rem _ -> Binop.Mod
  | JBir.IAnd -> Binop.BAnd
  | JBir.IShl -> Binop.Shiftlt
  | JBir.IShr -> Binop.Shiftrt
  | JBir.IOr -> Binop.BOr
  | JBir.IXor -> Binop.BXor
  | JBir.IUshr ->
      raise (Frontend_error "Unsigned right shift operator")
  | JBir.LShl -> Binop.Shiftlt
  | JBir.LShr -> Binop.Shiftrt
  | JBir.LAnd -> Binop.BAnd
  | JBir.LOr -> Binop.BOr
  | JBir.LXor -> Binop.BXor
  | JBir.LUshr ->
      raise (Frontend_error "Unsigned right shift operator")
  | JBir.CMP _ ->
      raise (Frontend_error "Unsigned right shift operator")
  | JBir.ArrayLoad _ ->
      raise (Frontend_error "Array load operator")

let get_test_operator op =
  match op with
  | `Eq -> Binop.Eq
  | `Ge -> Binop.Ge
  | `Gt -> Binop.Gt
  | `Le -> Binop.Le
  | `Lt -> Binop.Lt
  | `Ne -> Binop.Ne

type defined_status =
  | Defined of Cfg.Procdesc.t
  | Called of Cfg.Procdesc.t

type translation_status =
  | Created of defined_status
  | Unknown

let lookup_procdesc cfg procname =
  match Cfg.Procdesc.find_from_name cfg procname with
  | Some procdesc ->
      if Cfg.Procdesc.is_defined procdesc then
        Created (Defined procdesc)
      else
        Created (Called procdesc)
  | None -> Unknown

let is_java_native cm =
  (cm.Javalib.cm_implementation = Javalib.Native)

let is_clone ms =
  JBasics.ms_name ms = JConfig.clone_name

let get_implementation cm =
  match cm.Javalib.cm_implementation with
  | Javalib.Native ->
      let cms = cm.Javalib.cm_class_method_signature in
      let cn, ms = JBasics.cms_split cms in
      JUtils.log "native method %s found in %s@." (JBasics.ms_name ms) (JBasics.cn_name cn);
      assert false
  | Javalib.Java t ->
      JBir.transform ~bcv: false ~ch_link: false ~formula: false ~formula_cmd:[] cm (Lazy.force t)

let update_constr_loc cn ms loc_start =
  if (JBasics.ms_name ms) = JConfig.constructor_name then
    try ignore(JBasics.ClassMap.find cn !constr_loc_map)
    with Not_found -> constr_loc_map := (JBasics.ClassMap.add cn loc_start !constr_loc_map)

let update_init_loc cn ms loc_start =
  if JBasics.ms_equal ms JBasics.clinit_signature then
    try ignore(JBasics.ClassMap.find cn !init_loc_map)
    with Not_found -> init_loc_map := (JBasics.ClassMap.add cn loc_start !init_loc_map)

(** Creates a procedure description. *)
let create_local_procdesc source_file program linereader cfg tenv node m =
  let cn, ms = JBasics.cms_split (Javalib.get_class_method_signature m) in
  let meth_kind =
    if JBasics.ms_equal ms JBasics.clinit_signature then JContext.Init
    else JContext.Normal in
  if not (
      Config.no_static_final = false &&
      meth_kind = JContext.Init &&
      not (JTransStaticField.has_static_final_fields node))
  then
    let proc_name_java = JTransType.get_method_procname cn ms (JTransType.get_method_kind m) in
    let proc_name = Procname.Java proc_name_java in
    let create_new_procdesc () =
      let trans_access = function
        | `Default -> PredSymb.Default
        | `Public -> PredSymb.Public
        | `Private -> PredSymb.Private
        | `Protected -> PredSymb.Protected in
      try
        match m with
        | Javalib.AbstractMethod am -> (* create a procdesc with empty body *)
            let formals =
              formals_from_signature program tenv cn ms (JTransType.get_method_kind m) in
            let method_annotation =
              JAnnotation.translate_method proc_name_java am.Javalib.am_annotations in
            let procdesc =
              let proc_attributes =
                { (ProcAttributes.default proc_name Config.Java) with
                  ProcAttributes.access = trans_access am.Javalib.am_access;
                  exceptions = IList.map JBasics.cn_name am.Javalib.am_exceptions;
                  formals;
                  is_abstract = true;
                  is_bridge_method = am.Javalib.am_bridge;
                  is_defined = true;
                  is_synthetic_method = am.Javalib.am_synthetic;
                  method_annotation;
                  ret_type = JTransType.return_type program tenv ms meth_kind;
                } in
              Cfg.Procdesc.create cfg proc_attributes in
            let start_kind = Cfg.Node.Start_node procdesc in
            let start_node = Cfg.Node.create cfg Location.dummy start_kind [] procdesc in
            let exit_kind = (Cfg.Node.Exit_node procdesc) in
            let exit_node = Cfg.Node.create cfg Location.dummy exit_kind [] procdesc in
            Cfg.Node.set_succs_exn cfg start_node [exit_node] [exit_node];
            Cfg.Procdesc.set_start_node procdesc start_node;
            Cfg.Procdesc.set_exit_node procdesc exit_node
        | Javalib.ConcreteMethod cm when is_java_native cm ->
            let formals = formals_from_signature program tenv cn ms (JTransType.get_method_kind m) in
            let method_annotation =
              JAnnotation.translate_method proc_name_java cm.Javalib.cm_annotations in
            let proc_attributes =
              { (ProcAttributes.default proc_name Config.Java) with
                ProcAttributes.access = trans_access cm.Javalib.cm_access;
                exceptions = IList.map JBasics.cn_name cm.Javalib.cm_exceptions;
                formals;
                is_bridge_method = cm.Javalib.cm_bridge;
                is_synthetic_method = cm.Javalib.cm_synthetic;
                method_annotation;
                ret_type = JTransType.return_type program tenv ms meth_kind;
              } in
            ignore (Cfg.Procdesc.create cfg proc_attributes)
        | Javalib.ConcreteMethod cm ->
            let impl = get_implementation cm in
            let locals, formals = locals_formals program tenv cn impl meth_kind in
            let loc_start =
              let loc = (get_location source_file impl 0 JContext.Normal cn) in
              fix_method_definition_line linereader proc_name_java loc in
            let loc_exit =
              get_location
                source_file impl (Array.length (JBir.code impl) - 1) JContext.Normal cn in
            let method_annotation =
              JAnnotation.translate_method proc_name_java cm.Javalib.cm_annotations in
            update_constr_loc cn ms loc_start;
            update_init_loc cn ms loc_exit;
            let procdesc =
              let proc_attributes =
                { (ProcAttributes.default proc_name Config.Java) with
                  ProcAttributes.access = trans_access cm.Javalib.cm_access;
                  exceptions = IList.map JBasics.cn_name cm.Javalib.cm_exceptions;
                  formals;
                  is_bridge_method = cm.Javalib.cm_bridge;
                  is_defined = true;
                  is_synthetic_method = cm.Javalib.cm_synthetic;
                  is_java_synchronized_method = cm.Javalib.cm_synchronized;
                  loc = loc_start;
                  locals;
                  method_annotation;
                  ret_type = JTransType.return_type program tenv ms meth_kind;
                } in
              Cfg.Procdesc.create cfg proc_attributes in
            let start_kind = Cfg.Node.Start_node procdesc in
            let start_node = Cfg.Node.create cfg loc_start start_kind [] procdesc in
            let exit_kind = (Cfg.Node.Exit_node procdesc) in
            let exit_node = Cfg.Node.create cfg loc_exit exit_kind [] procdesc in
            let exn_kind = Cfg.Node.exn_sink_kind in
            let exn_node = Cfg.Node.create cfg loc_exit exn_kind [] procdesc in
            JContext.add_exn_node proc_name exn_node;
            Cfg.Procdesc.set_start_node procdesc start_node;
            Cfg.Procdesc.set_exit_node procdesc exit_node;
            Cfg.Node.add_locals_ret_declaration start_node locals;
      with JBir.Subroutine | JBasics.Class_structure_error _ ->
        L.err
          "create_local_procdesc raised JBir.Subroutine or JBasics.Class_structure_error on %a@."
          Procname.pp proc_name in
    match lookup_procdesc cfg proc_name with
    | Unknown ->
        create_new_procdesc ()
    | Created defined_status ->
        begin
          match defined_status with
          | Defined _ -> assert false
          | Called procdesc ->
              Cfg.Procdesc.remove cfg (Cfg.Procdesc.get_proc_name procdesc) false;
              create_new_procdesc ()
        end

let create_external_procdesc program cfg tenv cn ms kind =
  let return_type =
    match JBasics.ms_rtype ms with
    | None -> Typ.Tvoid
    | Some vt -> JTransType.value_type program tenv vt in
  let formals = formals_from_signature program tenv cn ms kind in
  let proc_name_java = JTransType.get_method_procname cn ms kind in
  ignore (
    let proc_attributes =
      { (ProcAttributes.default (Procname.Java proc_name_java) Config.Java) with
        ProcAttributes.formals;
        ret_type = return_type;
      } in
    Cfg.Procdesc.create cfg proc_attributes)

(** returns the procedure description of the given method and creates it if it hasn't been created before *)
let rec get_method_procdesc program cfg tenv cn ms kind =
  let procname_java = JTransType.get_method_procname cn ms kind in
  match lookup_procdesc cfg (Procname.Java procname_java) with
  | Unknown ->
      create_external_procdesc program cfg tenv cn ms kind;
      get_method_procdesc program cfg tenv cn ms kind
  | Created status -> status

let use_static_final_fields (context : JContext.t) =
  (not Config.no_static_final) && context.meth_kind <> JContext.Init

let builtin_new =
  Exp.Const (Const.Cfun ModelBuiltins.__new)

let builtin_get_array_length =
  Exp.Const (Const.Cfun ModelBuiltins.__get_array_length)

let create_sil_deref exp typ loc =
  let no_id = Ident.create_none () in
  Sil.Load (no_id, exp, typ, loc)

(** translate an expression used as an r-value *)
let rec expression (context : JContext.t) pc expr =
  (* JUtils.log "\t\t\t\texpr: %s@." (JBir.print_expr expr); *)
  let cn = context.cn in
  let program = context.program in
  let loc =
    get_location
      context.source_file
      context.impl
      pc
      context.meth_kind
      cn in
  let tenv = JContext.get_tenv context in
  let type_of_expr = JTransType.expr_type context expr in
  let trans_var pvar =
    let id = Ident.create_fresh Ident.knormal in
    let sil_instr = Sil.Load (id, Exp.Lvar pvar, type_of_expr, loc) in
    ([sil_instr], Exp.Var id, type_of_expr) in
  match expr with
  | JBir.Var (_, var) ->
      let pvar = (JContext.set_pvar context var type_of_expr) in
      trans_var pvar
  | JBir.Const c ->
      begin
        match c with (* We use the constant <field> internally to mean a variable. *)
        | `String s when (JBasics.jstr_pp s) = JConfig.field_cst ->
            let varname = JConfig.field_st in
            let procname = (Cfg.Procdesc.get_proc_name context.procdesc) in
            let pvar = Pvar.mk varname procname in
            trans_var pvar
        | _ -> ([], Exp.Const (get_constant c), type_of_expr)
      end
  | JBir.Unop (unop, ex) ->
      let type_of_ex = JTransType.expr_type context ex in
      let (instrs, sil_ex, _) = expression context pc ex in
      begin
        match unop with
        | JBir.Neg _ -> (instrs, Exp.UnOp (Unop.Neg, sil_ex, Some type_of_expr), type_of_expr)
        | JBir.ArrayLength ->
            let array_typ_no_ptr =
              match type_of_ex with
              | Typ.Tptr (typ, _) -> typ
              | _ -> type_of_ex in
            let deref = create_sil_deref sil_ex array_typ_no_ptr loc in
            let args = [(sil_ex, type_of_ex)] in
            let ret_id = Ident.create_fresh Ident.knormal in
            let ret_typ = Typ.Tint IInt in
            let call_instr =
              Sil.Call
                (Some (ret_id, ret_typ), builtin_get_array_length, args, loc, CallFlags.default) in
            (instrs @ [deref; call_instr], Exp.Var ret_id, type_of_expr)
        | JBir.Conv conv ->
            let cast_ex = Exp.Cast (JTransType.cast_type conv, sil_ex) in
            (instrs, cast_ex, type_of_expr)
        | JBir.InstanceOf ot | JBir.Cast ot ->
            let subtypes =
              (match unop with
               | JBir.InstanceOf _ -> Subtype.subtypes_instof
               | JBir.Cast _ -> Subtype.subtypes_cast
               | _ -> assert false) in
            let sizeof_expr =
              JTransType.sizeof_of_object_type program tenv ot subtypes in
            let builtin =
              (match unop with
               | JBir.InstanceOf _ -> Exp.Const (Const.Cfun ModelBuiltins.__instanceof)
               | JBir.Cast _ -> Exp.Const (Const.Cfun ModelBuiltins.__cast)
               | _ -> assert false) in
            let args = [(sil_ex, type_of_ex); (sizeof_expr, Typ.Tvoid)] in
            let ret_id = Ident.create_fresh Ident.knormal in
            let call =
              Sil.Call (Some (ret_id, Tint IBool), builtin, args, loc, CallFlags.default) in
            let res_ex = Exp.Var ret_id in
            (instrs @ [call], res_ex, type_of_expr)
      end
  | JBir.Binop (binop, ex1, ex2) ->
      let (instrs1, sil_ex1, _) = expression context pc ex1
      and (instrs2, sil_ex2, _) = expression context pc ex2 in
      begin
        match binop with
        | JBir.ArrayLoad _ ->
            (* add an instruction that dereferences the array *)
            let array_typ = Typ.Tarray (type_of_expr, None) in
            let deref_array_instr = create_sil_deref sil_ex1 array_typ loc in
            let id = Ident.create_fresh Ident.knormal in
            let load_instr =
              Sil.Load (id, Exp.Lindex (sil_ex1, sil_ex2), type_of_expr, loc) in
            let instrs = (instrs1 @ (deref_array_instr :: instrs2)) @ [load_instr] in
            instrs, Exp.Var id, type_of_expr
        | other_binop ->
            let sil_binop = get_binop other_binop in
            let sil_expr = Exp.BinOp (sil_binop, sil_ex1, sil_ex2) in
            ((instrs1 @ instrs2), sil_expr, type_of_expr)
      end
  | JBir.Field (ex, cn, fs) ->
      let (instrs, sil_expr, _) = expression context pc ex in
      let field_name = get_field_name program false tenv cn fs in
      let sil_type = JTransType.get_class_type_no_pointer program tenv cn in
      let sil_expr = Exp.Lfield (sil_expr, field_name, sil_type) in
      let tmp_id = Ident.create_fresh Ident.knormal in
      let lderef_instr = Sil.Load (tmp_id, sil_expr, sil_type, loc) in
      (instrs @ [lderef_instr], Exp.Var tmp_id, type_of_expr)
  | JBir.StaticField (cn, fs) ->
      let class_exp =
        let classname = Mangled.from_string (JBasics.cn_name cn) in
        let var_name = Pvar.mk_global classname in
        Exp.Lvar var_name in
      let (instrs, sil_expr) = [], class_exp in
      let field_name = get_field_name program true tenv cn fs in
      let sil_type = JTransType.get_class_type_no_pointer program tenv cn in
      if JTransStaticField.is_static_final_field context cn fs && use_static_final_fields context
      then
        (* when accessing a static final field, we call the initialiser method. *)
        let cfg = JContext.get_cfg context in
        let callee_procdesc =
          match get_method_procdesc program cfg tenv cn JBasics.clinit_signature Procname.Static with
          | Called p | Defined p -> p in
        let field_type =
          JTransType.get_class_type program tenv (JBasics.make_cn JConfig.string_cl) in
        let instrs', expr' =
          JTransStaticField.translate_instr_static_field
            context callee_procdesc fs field_type loc in
        instrs', expr', type_of_expr
      else
      if JTransType.is_autogenerated_assert_field field_name
      then
        (* assume that reading from C.$assertionsDisabled always yields "false". this allows *)
        (* Infer to understand the assert keyword in the expected way *)
        (instrs, Exp.zero, type_of_expr)
      else
        let sil_expr = Exp.Lfield (sil_expr, field_name, sil_type) in
        let tmp_id = Ident.create_fresh Ident.knormal in
        let lderef_instr = Sil.Load (tmp_id, sil_expr, sil_type, loc) in
        (instrs @ [lderef_instr], Exp.Var tmp_id, type_of_expr)

let method_invocation
    (context : JContext.t) loc pc var_opt cn ms sil_obj_opt expr_list invoke_code method_kind =
  (* This function tries to recursively search for the classname of the class *)
  (* where the method is defined. It returns the classname given as argument*)
  (* when this classname cannot be found *)
  let resolve_method (context : JContext.t) cn ms =
    let rec loop fallback_cn cn =
      match JClasspath.lookup_node cn context.program with
      | None -> fallback_cn
      | Some node ->
          if Javalib.defines_method node ms then cn
          else
            match node with
            | Javalib.JInterface _ -> fallback_cn
            | Javalib.JClass jclass ->
                begin
                  match jclass.Javalib.c_super_class with
                  | None -> fallback_cn
                  | Some super_cn -> loop fallback_cn super_cn
                end in
    loop cn cn in
  let cn' = resolve_method context cn ms in
  let tenv = JContext.get_tenv context in
  let program = context.program in
  let cf_virtual, cf_interface = match invoke_code with
    | I_Virtual -> (true, false)
    | I_Interface -> (true, true)
    | _ -> (false, false) in
  let call_flags = { CallFlags.default with cf_virtual; cf_interface; } in
  let init =
    match sil_obj_opt with
    | None -> [], []
    | Some (sil_obj_expr, sil_obj_type) ->
        (* for non-constructors, add an instruction that dereferences the receiver *)
        let instrs =
          let is_non_constructor_call =
            match invoke_code with
            | I_Special -> false
            | _ -> true in
          match sil_obj_expr with
          | Exp.Var _ when is_non_constructor_call && not Config.report_runtime_exceptions ->
              let obj_typ_no_ptr =
                match sil_obj_type with
                | Typ.Tptr (typ, _) -> typ
                | _ -> sil_obj_type in
              [create_sil_deref sil_obj_expr obj_typ_no_ptr loc]
          | _ -> [] in
        (instrs, [(sil_obj_expr, sil_obj_type)]) in
  let (instrs, call_args) =
    IList.fold_left
      (fun (instrs_accu, args_accu) expr ->
         let (instrs, sil_expr, sil_expr_type) = expression context pc expr in
         (instrs_accu @ instrs, args_accu @ [(sil_expr, sil_expr_type)]))
      init
      expr_list in
  let callee_procname =
    let proc = Procname.from_string_c_fun (JBasics.ms_name ms) in
    if JBasics.cn_equal cn' (JBasics.make_cn JConfig.infer_builtins_cl) &&
       Builtin.is_registered proc
    then proc
    else Procname.Java (JTransType.get_method_procname cn' ms method_kind) in
  let call_instrs =
    let callee_fun = Exp.Const (Const.Cfun callee_procname) in
    let return_type =
      match JBasics.ms_rtype ms with
      | None -> Typ.Tvoid
      | Some vt -> JTransType.value_type program tenv vt in
    let call_ret_instrs sil_var =
      let ret_id = Ident.create_fresh Ident.knormal in
      let call_instr =
        Sil.Call (Some (ret_id, return_type), callee_fun, call_args, loc, call_flags) in
      let set_instr = Sil.Store (Exp.Lvar sil_var, return_type, Exp.Var ret_id, loc) in
      (instrs @ [call_instr; set_instr]) in
    match var_opt with
    | None ->
        let call_instr = Sil.Call (None, callee_fun, call_args, loc, call_flags) in
        instrs @ [call_instr]
    | Some var ->
        let sil_var = JContext.set_pvar context var return_type in
        call_ret_instrs sil_var in
  let instrs =
    match call_args with
    (* modeling a class bypasses the treatment of Closeable *)
    | _ when Config.analyze_models || JClasspath.is_model callee_procname -> call_instrs

    (* add a file attribute when calling the constructor of a subtype of Closeable *)
    | (_, typ) as exp :: _
      when Procname.is_constructor callee_procname && JTransType.is_closeable program tenv typ ->
        let set_file_attr =
          let set_builtin = Exp.Const (Const.Cfun ModelBuiltins.__set_file_attribute) in
          Sil.Call (None, set_builtin, [exp], loc, CallFlags.default) in
        (* Exceptions thrown in the constructor should prevent adding the resource attribute *)
        call_instrs @ [set_file_attr]

    (* remove file attribute when calling the close method of a subtype of Closeable *)
    | (_, typ) as exp :: []
      when Procname.java_is_close callee_procname && JTransType.is_closeable program tenv typ ->
        let set_mem_attr =
          let set_builtin = Exp.Const (Const.Cfun ModelBuiltins.__set_mem_attribute) in
          Sil.Call (None, set_builtin, [exp], loc, CallFlags.default) in
        (* Exceptions thrown in the close method should not prevent the resource from being *)
        (* considered as closed *)
        [set_mem_attr] @ call_instrs

    | _ -> call_instrs in

  (callee_procname, instrs)

let get_array_length context pc expr_list content_type =
  let get_expr_instr expr other_instrs =
    let (instrs, sil_len_expr, _) = expression context pc expr in
    match other_instrs with
    | (other_instrs, other_exprs) ->
        (instrs @ other_instrs, sil_len_expr :: other_exprs) in
  let (instrs, sil_len_exprs) = (IList.fold_right get_expr_instr expr_list ([],[])) in
  let get_array_type_len sil_len_expr (content_type, _) =
    (Typ.Tarray (content_type, None), Some sil_len_expr) in
  let array_type, array_len =
    IList.fold_right get_array_type_len sil_len_exprs (content_type, None) in
  let array_size = Exp.Sizeof (array_type, array_len, Subtype.exact) in
  (instrs, array_size)

let detect_loop entry_pc impl =
  let code = (JBir.code impl) in
  let pc_bound = Array.length code in
  let empty = IntSet.empty in
  let rec loop visited pc =
    if (IntSet.mem pc visited) || pc >= pc_bound then
      (false, visited)
    else
      begin
        let visited_updated = IntSet.add pc visited in
        match code.(pc) with
        | JBir.Goto goto_pc when goto_pc = entry_pc -> (true, empty)
        | JBir.Goto goto_pc -> loop visited_updated goto_pc
        | JBir.Ifd (_, if_pc) when if_pc = entry_pc -> (true, empty)
        | JBir.Ifd (_, if_pc) ->
            let (loop_detected, visited_after) = loop visited_updated (pc + 1) in
            if loop_detected then
              (true, empty)
            else
              loop visited_after if_pc
        | _ ->
            if (pc + 1) = entry_pc then
              (true, empty)
            else
              loop visited_updated (pc + 1)
      end in
  fst (loop empty entry_pc)

type translation =
  | Skip
  | Instr of Cfg.Node.t
  | Prune of Cfg.Node.t * Cfg.Node.t
  | Loop of Cfg.Node.t * Cfg.Node.t * Cfg.Node.t

(* TODO: unclear if this corresponds to what JControlFlow.resolve_method'*)
(* is trying to do. Normally, this implementation below goes deeper into *)
(* the type hierarchy and it is not clear why we should not do that *)
let extends (context : JContext.t) node1 node2 =
  let is_matching cn =
    JBasics.cn_equal cn (Javalib.get_name node2) in
  let rec check cn_list =
    if IList.exists is_matching cn_list then true
    else
      iterate cn_list
  and iterate cn_list =
    let per_classname cn =
      match JClasspath.lookup_node cn context.program with
      | None -> false (* TODO: should capture the class instead of returning false *)
      | Some node ->
          let super_cn_list =
            match node with
            | Javalib.JInterface jinterface ->
                jinterface.Javalib.i_interfaces
            | Javalib.JClass jclass ->
                let cn_interfaces = jclass.Javalib.c_interfaces in
                begin
                  match jclass.Javalib.c_super_class with
                  | None -> cn_interfaces
                  | Some super_cn -> super_cn :: cn_interfaces
                end in
          match super_cn_list with
          | [] -> false
          | l -> check l in
    IList.exists per_classname cn_list in
  check [Javalib.get_name node1]

let instruction_array_call ms obj_type obj args var_opt =
  if is_clone ms then
    (let cn = JBasics.make_cn JConfig.infer_array_cl in
     let vt = (JBasics.TObject obj_type) in
     let ms = JBasics.make_ms JConfig.clone_name [vt] (Some vt) in
     JBir.InvokeStatic (var_opt, cn, ms, obj:: args))
  else
    (let undef_cn, undef_ms = get_undefined_method_call (JBasics.ms_rtype ms) in
     JBir.InvokeStatic (var_opt, undef_cn, undef_ms, []))

(* special translation of the method start() of a Thread or a Runnable object.
   We translate it directly as the run() method *)
let instruction_thread_start (context : JContext.t) cn ms obj args var_opt =
  match JClasspath.lookup_node cn context.program with
  | None ->
      let () = JUtils.log "\t\t\tWARNING: %s should normally be found@." (JBasics.cn_name cn) in
      None
  | Some node ->
      begin
        match JClasspath.lookup_node (JBasics.make_cn JConfig.thread_class) context.program with
        | None -> None (* TODO: should load the class instead of returning None *)
        | Some thread_node ->
            if ((JBasics.ms_name ms) = JConfig.start_method) && (extends context node thread_node) then
              let ms = JBasics.make_ms JConfig.run_method [] None in
              Some (JBir.InvokeNonVirtual (var_opt, obj, cn, ms, args))
            else None
      end


let is_this expr =
  match expr with
  | JBir.Var (_, var) ->
      begin
        match JBir.var_name_debug var with
        | None -> false
        | Some name_opt -> Mangled.to_string JConfig.this = name_opt
      end
  | _ -> false


let assume_not_null loc sil_expr =
  let builtin_infer_assume = Exp.Const (Const.Cfun ModelBuiltins.__infer_assume) in
  let not_null_expr =
    Exp.BinOp (Binop.Ne, sil_expr, Exp.null) in
  let assume_call_flag = { CallFlags.default with CallFlags.cf_noreturn = true; } in
  let call_args = [(not_null_expr, Typ.Tint Typ.IBool)] in
  Sil.Call (None, builtin_infer_assume, call_args, loc, assume_call_flag)

let rec instruction (context : JContext.t) pc instr : translation =
  let cfg = JContext.get_cfg context in
  let tenv = JContext.get_tenv context in
  let cg = JContext.get_cg context in
  let cn = context.cn in
  let program = context.program in
  let meth_kind = context.meth_kind in
  let proc_name = Cfg.Procdesc.get_proc_name context.procdesc in
  let ret_var = Pvar.get_ret_pvar proc_name in
  let ret_type = Cfg.Procdesc.get_ret_type context.procdesc in
  let loc =
    get_location context.source_file context.impl pc meth_kind cn in
  let match_never_null = Inferconfig.never_return_null_matcher in
  let create_node node_kind sil_instrs =
    Cfg.Node.create
      cfg
      (get_location context.source_file context.impl pc meth_kind cn)
      node_kind
      sil_instrs
      context.procdesc in
  let return_not_null () =
    match_never_null loc.Location.file proc_name
    ||
    IList.exists
      (fun pnj -> Procname.equal (Procname.Java pnj) proc_name)
      JTransType.never_returning_null in
  let trans_monitor_enter_exit context expr pc loc builtin node_desc =
    let instrs, sil_expr, sil_type = expression context pc expr in
    let builtin_const = Exp.Const (Const.Cfun builtin) in
    let instr = Sil.Call (None, builtin_const, [(sil_expr, sil_type)], loc, CallFlags.default) in
    let typ_no_ptr = match sil_type with
      | Typ.Tptr (typ, _) -> typ
      | _ -> sil_type in
    let deref_instr = create_sil_deref sil_expr typ_no_ptr loc in
    let node_kind = Cfg.Node.Stmt_node node_desc in
    Instr (create_node node_kind (instrs @ [deref_instr; instr] )) in
  try
    match instr with
    | JBir.AffectVar (var, expr) ->
        let (stml, sil_expr, sil_type) = expression context pc expr in
        let pvar = (JContext.set_pvar context var sil_type) in
        let sil_instr = Sil.Store (Exp.Lvar pvar, sil_type, sil_expr, loc) in
        let node_kind = Cfg.Node.Stmt_node "method_body" in
        let node = create_node node_kind (stml @ [sil_instr]) in
        Instr node
    | JBir.Return expr_option ->
        let node_kind = Cfg.Node.Stmt_node "method_body" in
        let node =
          match expr_option with
          | None ->
              create_node node_kind []
          | Some expr ->
              let (stml, sil_expr, _) = expression context pc expr in
              let sil_instrs =
                let return_instr = Sil.Store (Exp.Lvar ret_var, ret_type, sil_expr, loc) in
                if return_not_null () then
                  [assume_not_null loc sil_expr; return_instr]
                else
                  [return_instr] in
              create_node node_kind (stml @ sil_instrs) in
        JContext.add_goto_jump context pc JContext.Exit;
        Instr node
    | JBir.AffectArray (array_ex, index_ex, value_ex) ->
        let (instrs_array, sil_expr_array, _) = expression context pc array_ex
        and (instrs_index, sil_expr_index, _) = expression context pc index_ex
        and (instrs_value, sil_expr_value, value_typ) = expression context pc value_ex in
        let sil_instr =
          Sil.Store (
            Exp.Lindex (sil_expr_array, sil_expr_index), value_typ, sil_expr_value, loc) in
        let final_instrs = instrs_array @ instrs_index @ instrs_value @ [sil_instr] in
        let node_kind = Cfg.Node.Stmt_node "method_body" in
        let node = create_node node_kind final_instrs in
        Instr node
    | JBir.AffectField (e_lhs, cn, fs, e_rhs) ->
        let (stml1, sil_expr_lhs, _) = expression context pc e_lhs in
        let (stml2, sil_expr_rhs, _) = expression context pc e_rhs in
        let field_name = get_field_name program false tenv cn fs in
        let type_of_the_surrounding_class = JTransType.get_class_type_no_pointer program tenv cn in
        let type_of_the_root_of_e_lhs = type_of_the_surrounding_class in
        let expr_off = Exp.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in
        let sil_instr = Sil.Store (expr_off, type_of_the_root_of_e_lhs, sil_expr_rhs, loc) in
        let node_kind = Cfg.Node.Stmt_node "method_body" in
        let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in
        Instr node
    | JBir.AffectStaticField (cn, fs, e_rhs) ->
        let class_exp =
          let classname = Mangled.from_string (JBasics.cn_name cn) in
          let var_name = Pvar.mk_global classname in
          Exp.Lvar var_name in
        let (stml1, sil_expr_lhs) = [], class_exp in
        let (stml2, sil_expr_rhs, _) = expression context pc e_rhs in
        let field_name = get_field_name program true tenv cn fs in
        let type_of_the_surrounding_class = JTransType.get_class_type_no_pointer program tenv cn in
        let type_of_the_root_of_e_lhs = type_of_the_surrounding_class in
        let expr_off = Exp.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in
        let sil_instr = Sil.Store (expr_off, type_of_the_root_of_e_lhs, sil_expr_rhs, loc) in
        let node_kind = Cfg.Node.Stmt_node "method_body" in
        let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in
        Instr node
    | JBir.Goto goto_pc ->
        JContext.reset_pvar_type context;
        JContext.add_goto_jump context pc (JContext.Jump goto_pc);
        Skip
    | JBir.Ifd ((op, e1, e2), if_pc) -> (* Note: JBir provides the condition for the false branch, under which to jump *)
        JContext.reset_pvar_type context;
        let (instrs1, sil_ex1, _) = expression context pc e1
        and (instrs2, sil_ex2, _) = expression context pc e2 in
        let sil_op = get_test_operator op in
        let sil_test_false = Exp.BinOp (sil_op, sil_ex1, sil_ex2) in
        let sil_test_true = Exp.UnOp(Unop.LNot, sil_test_false, None) in
        let sil_instrs_true = Sil.Prune (sil_test_true, loc, true, Sil.Ik_if) in
        let sil_instrs_false = Sil.Prune (sil_test_false, loc, false, Sil.Ik_if) in
        let node_kind_true = Cfg.Node.Prune_node (true, Sil.Ik_if, "method_body") in
        let node_kind_false = Cfg.Node.Prune_node (false, Sil.Ik_if, "method_body") in
        let prune_node_true = create_node node_kind_true (instrs1 @ instrs2 @ [sil_instrs_true])
        and prune_node_false =
          create_node node_kind_false (instrs1 @ instrs2 @ [sil_instrs_false]) in
        JContext.add_if_jump context prune_node_false if_pc;
        if detect_loop pc context.impl then
          let join_node_kind = Cfg.Node.Join_node in
          let join_node = create_node join_node_kind [] in
          Loop (join_node, prune_node_true, prune_node_false)
        else
          Prune (prune_node_true, prune_node_false)
    | JBir.Throw expr ->
        let (instrs, sil_expr, _) = expression context pc expr in
        let sil_exn = Exp.Exn sil_expr in
        let sil_instr = Sil.Store (Exp.Lvar ret_var, ret_type, sil_exn, loc) in
        let node = create_node Cfg.Node.throw_kind (instrs @ [sil_instr]) in
        JContext.add_goto_jump context pc JContext.Exit;
        Instr node
    | JBir.New (var, cn, constr_type_list, constr_arg_list) ->
        let builtin_new = Exp.Const (Const.Cfun ModelBuiltins.__new) in
        let class_type = JTransType.get_class_type program tenv cn in
        let class_type_np = JTransType.get_class_type_no_pointer program tenv cn in
        let sizeof_exp = Exp.Sizeof (class_type_np, None, Subtype.exact) in
        let args = [(sizeof_exp, class_type)] in
        let ret_id = Ident.create_fresh Ident.knormal in
        let new_instr =
          Sil.Call (Some (ret_id, class_type), builtin_new, args, loc, CallFlags.default) in
        let constr_ms = JBasics.make_ms JConfig.constructor_name constr_type_list None in
        let constr_procname, call_instrs =
          let ret_opt = Some (Exp.Var ret_id, class_type) in
          method_invocation
            context loc pc None cn constr_ms ret_opt constr_arg_list I_Special Procname.Non_Static in
        let pvar = JContext.set_pvar context var class_type in
        let set_instr = Sil.Store (Exp.Lvar pvar, class_type, Exp.Var ret_id, loc) in
        let instrs = (new_instr :: call_instrs) @ [set_instr] in
        let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string constr_procname)) in
        let node = create_node node_kind instrs in
        let caller_procname = (Cfg.Procdesc.get_proc_name context.procdesc) in
        Cg.add_edge cg caller_procname constr_procname;
        Instr node
    | JBir.NewArray (var, vt, expr_list) ->
        let builtin_new_array = Exp.Const (Const.Cfun ModelBuiltins.__new_array) in
        let content_type = JTransType.value_type program tenv vt in
        let array_type = JTransType.create_array_type content_type (IList.length expr_list) in
        let array_name = JContext.set_pvar context var array_type in
        let (instrs, array_size) = get_array_length context pc expr_list content_type in
        let call_args = [(array_size, array_type)] in
        let ret_id = Ident.create_fresh Ident.knormal in
        let call_instr =
          Sil.Call
            (Some (ret_id, array_type), builtin_new_array, call_args, loc, CallFlags.default) in
        let set_instr = Sil.Store (Exp.Lvar array_name, array_type, Exp.Var ret_id, loc) in
        let node_kind = Cfg.Node.Stmt_node "method_body" in
        let node = create_node node_kind (instrs @ [call_instr; set_instr]) in
        Instr node
    | JBir.InvokeStatic (var_opt, cn, ms, args) ->
        let sil_obj_opt, args, instrs =
          match args with
          | [arg] when is_clone ms ->
              (* hack to null check the receiver of clone when clone is an array. in the array.clone()
                 case, clone is a virtual call that we translate as a static call *)
              let (instrs, sil_arg_expr, arg_typ) = expression context pc arg in
              Some (sil_arg_expr, arg_typ), [], instrs
          | _ -> None, args, [] in
        let callee_procname, call_instrs =
          method_invocation context loc pc var_opt cn ms sil_obj_opt args I_Static Procname.Static in
        let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in
        let call_node = create_node node_kind (instrs @ call_instrs) in
        let caller_procname = (Cfg.Procdesc.get_proc_name context.procdesc) in
        Cg.add_edge cg caller_procname callee_procname;
        Instr call_node
    | JBir.InvokeVirtual (var_opt, obj, call_kind, ms, args) ->
        let caller_procname = (Cfg.Procdesc.get_proc_name context.procdesc) in
        let (instrs, sil_obj_expr, sil_obj_type) = expression context pc obj in
        let create_call_node cn invoke_kind =
          let callee_procname, call_instrs =
            let ret_opt = Some (sil_obj_expr, sil_obj_type) in
            method_invocation
              context loc pc var_opt cn ms ret_opt args invoke_kind Procname.Non_Static in
          let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in
          let call_node = create_node node_kind (instrs @ call_instrs) in
          Cg.add_edge cg caller_procname callee_procname;
          call_node in
        let trans_virtual_call original_cn invoke_kind =
          match instruction_thread_start context original_cn ms obj args var_opt with
          | Some start_call -> instruction context pc start_call
          | None ->
              let cn' = match JTransType.extract_cn_no_obj sil_obj_type with
                | Some cn -> cn
                | None -> original_cn in
              let call_node = create_call_node cn' invoke_kind in
              Instr call_node in
        begin
          match call_kind with
          | JBir.VirtualCall obj_type ->
              begin
                match obj_type with
                | JBasics.TClass cn -> trans_virtual_call cn I_Virtual
                | JBasics.TArray _ ->
                    let instr = instruction_array_call ms obj_type obj args var_opt in
                    instruction context pc instr
              end
          | JBir.InterfaceCall cn ->
              trans_virtual_call cn I_Interface
        end
    | JBir.InvokeNonVirtual (var_opt, obj, cn, ms, args) ->
        let (instrs, sil_obj_expr, sil_obj_type) = expression context pc obj in
        let callee_procname, call_instrs =
          method_invocation context loc pc var_opt cn ms (Some (sil_obj_expr, sil_obj_type)) args I_Special Procname.Non_Static in
        let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in
        let call_node = create_node node_kind (instrs @ call_instrs) in
        let procdesc = context.procdesc in
        let caller_procname = (Cfg.Procdesc.get_proc_name procdesc) in
        Cg.add_edge cg caller_procname callee_procname;
        Instr call_node

    | JBir.Check (JBir.CheckNullPointer expr)
      when Config.report_runtime_exceptions && is_this expr ->
        (* TODO #6509339: refactor the boilerplate code in the translation of JVM checks *)
        let (instrs, sil_expr, _) = expression context pc expr in
        let this_not_null_node =
          create_node
            (Cfg.Node.Stmt_node "this not null") (instrs @ [assume_not_null loc sil_expr]) in
        Instr this_not_null_node

    | JBir.Check (JBir.CheckNullPointer expr) when Config.report_runtime_exceptions ->
        let (instrs, sil_expr, _) = expression context pc expr in
        let not_null_node =
          let sil_not_null = Exp.BinOp (Binop.Ne, sil_expr, Exp.null) in
          let sil_prune_not_null = Sil.Prune (sil_not_null, loc, true, Sil.Ik_if)
          and not_null_kind = Cfg.Node.Prune_node (true, Sil.Ik_if, "Not null") in
          create_node not_null_kind (instrs @ [sil_prune_not_null]) in
        let throw_npe_node =
          let sil_is_null = Exp.BinOp (Binop.Eq, sil_expr, Exp.null) in
          let sil_prune_null = Sil.Prune (sil_is_null, loc, true, Sil.Ik_if)
          and npe_kind = Cfg.Node.Stmt_node "Throw NPE"
          and npe_cn = JBasics.make_cn JConfig.npe_cl in
          let class_type = JTransType.get_class_type program tenv npe_cn
          and class_type_np = JTransType.get_class_type_no_pointer program tenv npe_cn in
          let sizeof_exp = Exp.Sizeof (class_type_np, None, Subtype.exact) in
          let args = [(sizeof_exp, class_type)] in
          let ret_id = Ident.create_fresh Ident.knormal in
          let new_instr =
            Sil.Call (Some (ret_id, class_type), builtin_new, args, loc, CallFlags.default) in
          let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in
          let _, call_instrs =
            let ret_opt = Some (Exp.Var ret_id, class_type) in
            method_invocation context loc pc None npe_cn constr_ms ret_opt [] I_Special Procname.Static in
          let sil_exn = Exp.Exn (Exp.Var ret_id) in
          let set_instr = Sil.Store (Exp.Lvar ret_var, ret_type, sil_exn, loc) in
          let npe_instrs = instrs @ [sil_prune_null] @ (new_instr :: call_instrs) @ [set_instr] in
          create_node npe_kind npe_instrs in
        Prune (not_null_node, throw_npe_node)

    | JBir.Check (JBir.CheckArrayBound (array_expr, index_expr))
      when Config.report_runtime_exceptions ->
        let instrs, _, sil_length_expr, sil_index_expr =
          let array_instrs, sil_array_expr, _ =
            expression context pc array_expr
          and length_instrs, sil_length_expr, _ =
            expression context pc (JBir.Unop (JBir.ArrayLength, array_expr))
          and index_instrs, sil_index_expr, _ =
            expression context pc index_expr in
          let instrs = array_instrs @ index_instrs @ length_instrs in
          (instrs, sil_array_expr, sil_length_expr, sil_index_expr) in

        let in_bound_node =
          let in_bound_node_kind =
            Cfg.Node.Prune_node (true, Sil.Ik_if, "In bound") in
          let sil_assume_in_bound =
            let sil_in_bound =
              let sil_positive_index =
                Exp.BinOp (Binop.Ge, sil_index_expr, Exp.Const (Const.Cint IntLit.zero))
              and sil_less_than_length =
                Exp.BinOp (Binop.Lt, sil_index_expr, sil_length_expr) in
              Exp.BinOp (Binop.LAnd, sil_positive_index, sil_less_than_length) in
            Sil.Prune (sil_in_bound, loc, true, Sil.Ik_if) in
          create_node in_bound_node_kind (instrs @ [sil_assume_in_bound])

        and throw_out_of_bound_node =
          let out_of_bound_node_kind =
            Cfg.Node.Stmt_node "Out of bound" in
          let sil_assume_out_of_bound =
            let sil_out_of_bound =
              let sil_negative_index =
                Exp.BinOp (Binop.Lt, sil_index_expr, Exp.Const (Const.Cint IntLit.zero))
              and sil_greater_than_length =
                Exp.BinOp (Binop.Gt, sil_index_expr, sil_length_expr) in
              Exp.BinOp (Binop.LOr, sil_negative_index, sil_greater_than_length) in
            Sil.Prune (sil_out_of_bound, loc, true, Sil.Ik_if) in
          let out_of_bound_cn = JBasics.make_cn JConfig.out_of_bound_cl in
          let class_type = JTransType.get_class_type program tenv out_of_bound_cn
          and class_type_np = JTransType.get_class_type_no_pointer program tenv out_of_bound_cn in
          let sizeof_exp = Exp.Sizeof (class_type_np, None, Subtype.exact) in
          let args = [(sizeof_exp, class_type)] in
          let ret_id = Ident.create_fresh Ident.knormal in
          let new_instr =
            Sil.Call (Some (ret_id, ret_type), builtin_new, args, loc, CallFlags.default) in
          let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in
          let _, call_instrs =
            method_invocation
              context loc pc None out_of_bound_cn constr_ms
              (Some (Exp.Var ret_id, class_type)) [] I_Special Procname.Static in
          let sil_exn = Exp.Exn (Exp.Var ret_id) in
          let set_instr = Sil.Store (Exp.Lvar ret_var, ret_type, sil_exn, loc) in
          let out_of_bound_instrs =
            instrs @ [sil_assume_out_of_bound] @ (new_instr :: call_instrs) @ [set_instr] in
          create_node out_of_bound_node_kind out_of_bound_instrs in

        Prune (in_bound_node, throw_out_of_bound_node)

    | JBir.Check (JBir.CheckCast (expr, object_type)) when Config.report_runtime_exceptions ->
        let sil_type = JTransType.expr_type context expr
        and instrs, sil_expr, _ = expression context pc expr
        and ret_id = Ident.create_fresh Ident.knormal
        and sizeof_expr =
          JTransType.sizeof_of_object_type program tenv object_type Subtype.subtypes_instof in
        let check_cast = Exp.Const (Const.Cfun ModelBuiltins.__instanceof) in
        let args = [(sil_expr, sil_type); (sizeof_expr, Typ.Tvoid)] in
        let call = Sil.Call (Some (ret_id, ret_type), check_cast, args, loc, CallFlags.default) in
        let res_ex = Exp.Var ret_id in
        let is_instance_node =
          let check_is_false = Exp.BinOp (Binop.Ne, res_ex, Exp.zero) in
          let asssume_instance_of = Sil.Prune (check_is_false, loc, true, Sil.Ik_if)
          and instance_of_kind = Cfg.Node.Prune_node (true, Sil.Ik_if, "Is instance") in
          create_node instance_of_kind (instrs @ [call; asssume_instance_of])
        and throw_cast_exception_node =
          let check_is_true = Exp.BinOp (Binop.Ne, res_ex, Exp.one) in
          let asssume_not_instance_of = Sil.Prune (check_is_true, loc, true, Sil.Ik_if)
          and throw_cast_exception_kind = Cfg.Node.Stmt_node "Class cast exception"
          and cce_cn = JBasics.make_cn JConfig.cce_cl in
          let class_type = JTransType.get_class_type program tenv cce_cn
          and class_type_np = JTransType.get_class_type_no_pointer program tenv cce_cn in
          let sizeof_exp = Exp.Sizeof (class_type_np, None, Subtype.exact) in
          let args = [(sizeof_exp, class_type)] in
          let ret_id = Ident.create_fresh Ident.knormal in
          let new_instr =
            Sil.Call (Some (ret_id, ret_type), builtin_new, args, loc, CallFlags.default) in
          let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in
          let _, call_instrs =
            method_invocation context loc pc None cce_cn constr_ms
              (Some (Exp.Var ret_id, class_type)) [] I_Special Procname.Static in
          let sil_exn = Exp.Exn (Exp.Var ret_id) in
          let set_instr = Sil.Store (Exp.Lvar ret_var, ret_type, sil_exn, loc) in
          let cce_instrs =
            instrs @ [call; asssume_not_instance_of] @ (new_instr :: call_instrs) @ [set_instr] in
          create_node throw_cast_exception_kind cce_instrs in

        Prune (is_instance_node, throw_cast_exception_node)
    | JBir.MonitorEnter expr ->
        trans_monitor_enter_exit
          context expr pc loc ModelBuiltins.__set_locked_attribute "MonitorEnter"

    | JBir.MonitorExit expr ->
        trans_monitor_enter_exit
          context expr pc loc ModelBuiltins.__delete_locked_attribute "MonitorExit"

    | _ -> Skip
  with Frontend_error s ->
    JUtils.log "Skipping because of: %s@." s;
    Skip

(*
let static_field_name cn fs =
  let classname = JBasics.cn_name cn in
  let fieldname = JBasics.fs_name fs in
  Mangled.from_string (classname^"."^fieldname)
*)
