diff --git a/lib/bap_c/bap_c_abi.ml b/lib/bap_c/bap_c_abi.ml index 57cbb84b3..418d8a868 100644 --- a/lib/bap_c/bap_c_abi.ml +++ b/lib/bap_c/bap_c_abi.ml @@ -1,4 +1,5 @@ open Core_kernel[@@warning "-D"] +open Bap_core_theory open Bap.Std open Bap_c_type open Monads.Std @@ -184,10 +185,43 @@ let create_arg size i intent name t (data,exp) sub = let arg = Term.set_attr arg Attrs.layout layout in arg -let registry = Hashtbl.create (module String) -let register name abi = Hashtbl.set registry ~key:name ~data:abi + + +let models = Hashtbl.create (module Theory.Target) + +let register_model target model = + if Hashtbl.mem models target + then invalid_argf "A data model for target %s is already set" + (Theory.Target.to_string target) (); + Hashtbl.add_exn models target (model :> Bap_c_size.base) + +let model target = match Hashtbl.find models target with + | Some m -> m + | None -> if Theory.Target.bits target = 32 + then new Bap_c_size.base `LP32 + else new Bap_c_size.base `LP64 + +let registry = Hashtbl.create (module Theory.Target) + +let register name abi = + let target = match Theory.Target.lookup ~package:"bap" name with + | Some t -> t + | None -> invalid_argf + "The name of the abi should be a valid name. Got %s. \ + See `bap list targets` for the list valid names" name () in + Hashtbl.add registry ~key:target ~data:abi |> function + | `Ok -> () + | `Duplicate -> + invalid_argf "The processor for ABI %s is already registered. \ + Please pick a unique name" name () let register_abi = register -let get_processor name = Hashtbl.find registry name + +let get_processor name = + match Theory.Target.lookup ~package:"bap" name with + | None -> None + | Some t -> Hashtbl.find registry t + +let lookup = Hashtbl.find registry let get_prototype gamma name = match gamma name with @@ -212,6 +246,40 @@ let get_prototype gamma name = match gamma name with } } + +let apply_args abi size attrs t sub = + let t = decay_arrays t in + match abi.insert_args sub attrs t with + | None -> sub + | Some {return; hidden; params} -> + let params = List.mapi params ~f:(fun i a -> i,a) in + List.map2 params t.Bap_c_type.Proto.args ~f:(fun (i,a) (n,t) -> + create_arg size i (arg_intent t) n t a sub) |> + function + | Unequal_lengths -> + error "The ABI processor generated an incorrect number of \ + argument terms for the subroutine %s: %d <> %d" + (Sub.name sub) + (List.length params) + (List.length t.args); + sub + | Ok args -> + let ret = match return with + | None -> [] + | Some ret -> + let t = t.Bap_c_type.Proto.return in + [create_arg size 0 Out "result" t ret sub] in + let hid = List.mapi hidden ~f:(fun i (t,a) -> + let n = "hidden" ^ if i = 0 then "" else Int.to_string i in + create_arg size 0 Both n t a sub) in + List.fold (args@hid@ret) ~init:sub ~f:(Term.append arg_t) + +let apply abi size attrs t sub = + let sub = apply_args abi size attrs t sub in + let sub = Term.set_attr sub Attrs.proto t in + let sub = List.fold_right ~init:sub attrs ~f:Bap_c_attr.apply in + abi.apply_attrs attrs sub + let create_api_processor size abi : Bap_api.t = let stage1 gamma = object(self) inherit Term.mapper as super @@ -225,40 +293,7 @@ let create_api_processor size abi : Bap_api.t = else let name = Sub.name sub in let {Bap_c_type.Spec.t; attrs} = get_prototype gamma name in - let sub = self#apply_args sub attrs t in - let sub = Term.set_attr sub Attrs.proto t in - let sub = List.fold_right ~init:sub attrs ~f:Bap_c_attr.apply in - abi.apply_attrs attrs sub - - - method private apply_args sub attrs t = - let t = decay_arrays t in - match abi.insert_args sub attrs t with - | None -> - super#map_sub sub - | Some {return; hidden; params} -> - let params = List.mapi params ~f:(fun i a -> i,a) in - List.map2 params t.Bap_c_type.Proto.args ~f:(fun (i,a) (n,t) -> - create_arg size i (arg_intent t) n t a sub) |> - function - | Unequal_lengths -> - error "The ABI processor generated an incorrect number of \ - argument terms for the subroutine %s: %d <> %d" - (Sub.name sub) - (List.length params) - (List.length t.args); - sub - | Ok args -> - let ret = match return with - | None -> [] - | Some ret -> - let t = t.Bap_c_type.Proto.return in - [create_arg size 0 Out "result" t ret sub] in - let hid = List.mapi hidden ~f:(fun i (t,a) -> - let n = "hidden" ^ if i = 0 then "" else Int.to_string i in - create_arg size 0 Both n t a sub) in - List.fold (args@hid@ret) ~init:sub ~f:(Term.append arg_t) - + apply abi size attrs t sub end in let module Api = struct let language = "c" @@ -780,15 +815,14 @@ module Arg = struct let install target ruler pass = let open Bap_core_theory in - let abi = Theory.Target.abi target in - let abi_name = Format.asprintf "%s" - (KB.Name.unqualified (Theory.Abi.name abi)) in + let abi_name = KB.Name.unqualified (Theory.Target.name target) in let abi_processor = { apply_attrs = (fun _ x -> x); insert_args = fun _ attrs proto -> reify target ruler (pass attrs proto) } in register_abi abi_name abi_processor; + register_model target ruler; Bap_abi.register_pass @@ fun proj -> if Theory.Target.equal (Project.target proj) target then begin diff --git a/lib/bap_c/bap_c_abi.mli b/lib/bap_c/bap_c_abi.mli index e5ef97e84..39037b170 100644 --- a/lib/bap_c/bap_c_abi.mli +++ b/lib/bap_c/bap_c_abi.mli @@ -84,6 +84,24 @@ val data : #Bap_c_size.base -> Bap_c_type.t -> Bap_c_data.t val layout : #Bap_c_size.base -> Bap_c_type.t -> Bap_c_data.layout +(** [model target] returns the data model for the given target. + + @since 2.5.0 *) +val model : Theory.Target.t -> Bap_c_size.base + + +(** [apply processor attrs proto sub] applies the abi processor to the + subroutine [sub]. + + The function inserts arguments and attaches appropriate arguments + to the function and its subterms, such as strores the type of each + argument, the provided C attributes, stores the prototype, computes + and attaches data layouts, etc. + + @since 2.5.0 *) +val apply : t -> #Bap_c_size.base -> attr list -> proto -> sub term -> sub term + + (** [arg_intent t] infers argument intention based on its C type. If an argument is passed by value, i.e., it is a c basic type, then it is an input argument. If an argument is a reference, but not a @@ -95,12 +113,25 @@ val layout : #Bap_c_size.base -> Bap_c_type.t -> Bap_c_data.layout val arg_intent : Bap_c_type.t -> intent (** [register name t] registers an abi processor [t] named [name] that - may be used by subroutines in this project.*) + may be used by subroutines in this project. + + @after 2.5.0 fails if there is already a processor for the given [name]. + @after 2.5.0 the abi name should be a valid target name. +*) val register : string -> t -> unit +[@@deprecated "[since 2022-07] use the Arg module"] (** [get_processor name] is used to access an abi processor with its name.*) val get_processor : string -> t option +[@@deprecated "[since 2022-07] use [lookup]"] + + +(** [lookup t] the abi processor associated with the target [t]. + + @since 2.5.0 +*) +val lookup : Theory.Target.t -> t option (** An abstraction of a stack, commonly used in C compilers. *) @@ -403,10 +434,10 @@ module Arg : sig [arena] is empty; or if some other argument is already passed via memory. - @since 2.5.0 accepts the [rev] parameter. - @since 2.5.0 accepts the [limit] parameter. + @after 2.5.0 accepts the [rev] parameter. + @after 2.5.0 accepts the [limit] parameter. - @since 2.5.0 passes as much as possible (up to the limit) of the + @after 2.5.0 passes as much as possible (up to the limit) of the object via registers. @before 2.5.0 was passing at most one word via registers. diff --git a/lib/x86_cpu/x86_target.ml b/lib/x86_cpu/x86_target.ml index 329d2e9c1..299f0a029 100644 --- a/lib/x86_cpu/x86_target.ml +++ b/lib/x86_cpu/x86_target.ml @@ -544,14 +544,14 @@ module Abi = struct let calling_conventions = [ (* 16-bit ABI *) - [i286], [ + i286, [ Abi.cdecl, cdecl16; Abi.pascal, pascal16; Abi.fortran, pascal16; ]; (* 32-bit ABI *) - [i386; i486; i586; i686], [ + i386, [ Abi.sysv, cdecl; Abi.cdecl, cdecl; Abi.pascal, pascal; @@ -561,7 +561,7 @@ module Abi = struct ]; (* 64-bit ABI *) - [amd64], [ + amd64, [ Abi.ms, ms64; Abi.sysv, sysv; ] @@ -579,9 +579,8 @@ module Abi = struct ] let install_calling_conventions () = - List.iter calling_conventions ~f:(fun (targets,args) -> - List.cartesian_product targets args |> - List.iter ~f:(fun (parent,(abi,install)) -> + List.iter calling_conventions ~f:(fun (parent,abis) -> + List.iter abis ~f:(fun (abi,install) -> Theory.Target.filter ~parent ~abi () |> List.iter ~f:(fun t -> if Theory.Target.bits t = Theory.Target.bits parent diff --git a/plugins/arm/arm_gnueabi.ml b/plugins/arm/arm_gnueabi.ml index e94ee2ec4..4e02803a3 100644 --- a/plugins/arm/arm_gnueabi.ml +++ b/plugins/arm/arm_gnueabi.ml @@ -1,30 +1,26 @@ open Core_kernel[@@warning "-D"] open Bap.Std open Bap_c.Std - -include Self() +open Bap_core_theory + +module Arg = C.Abi.Arg +open Arg.Language + +let data model = object(self) + inherit C.Size.base model + method! enum elts = + if Int64.(C.Size.max_enum_elt elts < (1L lsl 32)) + then self#integer `uint + else self#integer `ulong_long + method! real = function + | `float -> `r32 + | `double | `long_double -> `r64 +end module Aapcs32 = struct - open Bap_core_theory - open Bap_c.Std - open Bap.Std - - module Arg = C.Abi.Arg - open Arg.Language - - let model = object(self) - inherit C.Size.base `ILP32 - method! enum elts = - if Int64.(C.Size.max_enum_elt elts < (1L lsl 32)) - then self#integer `uint - else self#integer `ulong_long - method! real = function - | `float -> `r32 - | `double | `long_double -> `r64 - end let define t = - install t model @@ fun describe -> + install t (data `ILP32) @@ fun describe -> let* iargs = Arg.Arena.iargs t in let* irets = Arg.Arena.irets t in let rev = Theory.Endianness.(Theory.Target.endianness t = le) in @@ -44,41 +40,15 @@ module Aapcs32 = struct Arg.memory ]; ] - - let supported_abis = Theory.Abi.[unknown; gnueabi; eabi] - let is_our_abi abi = List.exists supported_abis ~f:(Theory.Abi.equal abi) - - - let install () = - Theory.Target.family Arm_target.parent |> - List.iter ~f:(fun t -> - if Theory.Target.bits t = 32 && - is_our_abi (Theory.Target.abi t) - then define t) end - module Aapcs64 = struct - open Bap_core_theory - open Bap_c.Std - open Bap.Std - - let name = "aapcs64" - - module Arg = C.Abi.Arg - open Arg.Language - - let data_model t = - let bits = Theory.Target.bits t in - new C.Size.base (if bits = 32 then `ILP32 else `LP64) - let is_composite t = C.Type.(is_structure t || is_union t) let define t = - let model = data_model t in + let model = data `LP64 in let rev = Theory.Endianness.(Theory.Target.endianness t = le) in - install t model @@ fun describe -> let* iargs = Arg.Arena.iargs t in let* irets = Arg.Arena.irets t in @@ -126,20 +96,17 @@ module Aapcs64 = struct ] ] ] - - let is_our_abi abi = List.exists ~f:(Theory.Abi.equal abi) Theory.Abi.[ - unknown; gnu; eabi; - ] - - let install () = - Theory.Target.family Arm_target.parent |> - List.iter ~f:(fun t -> - if Theory.Target.bits t = 64 && is_our_abi (Theory.Target.abi t) - then define t) - - end +let is_our_abi abi = List.exists ~f:(Theory.Abi.equal abi) Theory.Abi.[ + unknown; gnu; eabi; gnueabi; + ] + let setup () = - Aapcs32.install (); - Aapcs64.install (); + Theory.Target.family Arm_target.parent |> + List.iter ~f:(fun t -> + if is_our_abi (Theory.Target.abi t) + then match Theory.Target.bits t with + | 64 -> Aapcs64.define t + | 32 -> Aapcs32.define t + | _ -> ()) diff --git a/plugins/arm/arm_main.ml b/plugins/arm/arm_main.ml index 32e43bdfe..ded9a0312 100644 --- a/plugins/arm/arm_main.ml +++ b/plugins/arm/arm_main.ml @@ -47,7 +47,7 @@ let () = Bap_main.Extension.declare ~doc @@ fun ctxt -> let backend = ctxt-->backend in let features = List.concat (ctxt-->features) in Arm_target.load ~features ?backend ?interworking (); + Arm_gnueabi.setup (); List.iter all_of_arms ~f:(fun arch -> - register_target (arch :> arch) (module ARM); - Arm_gnueabi.setup ()); + register_target (arch :> arch) (module ARM)); Ok ()