Skip to content

Commit

Permalink
makes the ABI processors usable programmatically (#1529)
Browse files Browse the repository at this point in the history
Publishes several functions that make it easier to apply the ABI
processors. Also, fixes the naming scheme for the abi processors that
stopped to be unique, after we switched to the real ABI names. We now
use the target name for the name of the ABI.
  • Loading branch information
ivg authored Jul 7, 2022
1 parent 7e3d406 commit c100c28
Show file tree
Hide file tree
Showing 5 changed files with 144 additions and 113 deletions.
114 changes: 74 additions & 40 deletions lib/bap_c/bap_c_abi.ml
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
open Core_kernel[@@warning "-D"]
open Bap_core_theory
open Bap.Std
open Bap_c_type
open Monads.Std
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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"
Expand Down Expand Up @@ -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
Expand Down
39 changes: 35 additions & 4 deletions lib/bap_c/bap_c_abi.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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. *)
Expand Down Expand Up @@ -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.
Expand Down
11 changes: 5 additions & 6 deletions lib/x86_cpu/x86_target.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand All @@ -561,7 +561,7 @@ module Abi = struct
];

(* 64-bit ABI *)
[amd64], [
amd64, [
Abi.ms, ms64;
Abi.sysv, sysv;
]
Expand All @@ -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
Expand Down
89 changes: 28 additions & 61 deletions plugins/arm/arm_gnueabi.ml
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
| _ -> ())
4 changes: 2 additions & 2 deletions plugins/arm/arm_main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()

0 comments on commit c100c28

Please sign in to comment.