restructures powerpc targets and reimplements ppc32 eabi (#1526)

* revamps powerpc targets

* reimplements powerpc abi

Author: ivg

.merlin

@@ -73,7 +73,7 @@ B lib/bap_llvm
 B lib/regular
 B lib/text_tags
 B lib/knowledge
-
+B lib/bap_powerpc
 
 S lib/bap
 S lib/bap_main

lib/bap_powerpc/bap_powerpc_target.ml

@@ -19,18 +19,14 @@ let bool = Theory.Bool.t
 
 let reg t n = Theory.Var.define t n
 
-let array t fmt size =
+let array ?(from=0) t fmt size =
   let fmt = Scanf.format_from_string fmt "%d" in
-  List.init size ~f:(fun i -> reg t (sprintf fmt i))
+  List.init size ~f:(fun i -> reg t (sprintf fmt (i+from)))
 
 let untyped = List.map ~f:Theory.Var.forget
 let (@<) xs ys = untyped xs @ untyped ys
 
-let name size order  =
-  let order = Theory.Endianness.name order in
-  sprintf "powerpc%d+%s" size (KB.Name.unqualified order)
-
-let parent = Theory.Target.declare ~package "powerpc"
+let parent = Theory.Target.declare ~package "powerpc-family"
 
 let crflags =
   List.concat @@ List.init 8 ~f:(fun group ->
@@ -43,7 +39,7 @@ let flags = List.map ~f:(reg bool) [
     "C"; "FL"; "FE"; "FG"; "FU"
   ] @ crflags
 
-let define ?(parent=parent) ?nicknames bits endianness =
+let define ?(parent=parent) ?nicknames name bits endianness =
   let size = Theory.Bitv.size bits in
   let mems = Theory.Mem.define bits r8 in
   let data = Theory.Var.define mems "mem" in
@@ -53,7 +49,7 @@ let define ?(parent=parent) ?nicknames bits endianness =
              flags @<
              [reg bits "CTR"; reg bits "LR"; reg bits "TAR" ] @<
              [data] in
-  Theory.Target.declare ~package (name size endianness)
+  Theory.Target.declare ~package name
     ~parent
     ?nicknames
     ~bits:size
@@ -74,36 +70,48 @@ let define ?(parent=parent) ?nicknames bits endianness =
         [carry_flag], untyped@@[reg bool "CA"; reg bool "CA32"];
         [overflow_flag], untyped@@List.(["SO"; "OV"; "OV32"] >>| reg bool);
         [status; floating], untyped@@List.(["FL"; "FE"; "FG"; "FU"] >>| reg bool);
+        [caller_saved], untyped [reg bits "R0"] @
+                        untyped (array bits ~from:3 "R%d" 10) @
+                        untyped (array r64 "F%d" 14);
+        [callee_saved], untyped [reg bits "R1"] @
+                        untyped (array bits ~from:14 "R%d" 18) @
+                        untyped (array r64  ~from:14 "F%d" 18);
+        [function_argument; integer], untyped (array bits ~from:3 "R%d" 8);
+        [function_argument; floating], untyped (array bits ~from:1 "F%d" 8);
+        [function_return; integer], untyped [reg bits "R3"; reg bits "R4"];
+        [function_return; floating], untyped [reg r64 "F0"];
+        [reserved], untyped@@[reg bits "R2"];
       ]
 
-let powerpc32bi = define r32 Theory.Endianness.bi
-    ~nicknames:["powerpc32bi"; "ppc32bi"]
+let powerpc32bi = define "powerpcbi" r32 Theory.Endianness.bi
+    ~nicknames:["powerpc32bi"; "ppc32bi"; "powerpc32+bi"]
 
-let powerpc32eb = define r32 Theory.Endianness.eb
+let powerpc32eb = define "powerpc" r32 Theory.Endianness.eb
     ~nicknames:[
-      "powerpc"; "ppc"; "powerpc32"; "ppc32";
+      "powerpc32+eb"; "ppc"; "powerpc32"; "ppc32";
       "powerpc32eb"; "powerpc32be"; "ppc32eb"; "ppc32be";
       "power"; "power32";
     ]
-let powerpc32le = define r32 Theory.Endianness.le
+let powerpc32le = define "powerpcle" r32 Theory.Endianness.le
     ~nicknames:[
-      "powerpcle"; "ppcle"; "ppcel";
+      "powerpc32+le"; "ppcle"; "ppcel";
       "powerpc32le"; "powerpc32el";
       "ppc32le"; "ppc32el"
     ]
 
-let powerpc64bi = define r64 Theory.Endianness.bi
-    ~nicknames:["powerpc64bi"; "power64bi"]
-let powerpc64eb = define r64 Theory.Endianness.eb
+let powerpc64bi = define "powerpc64bi" r64 Theory.Endianness.bi
+    ~nicknames:["powerpc64+bi"; "power64bi"]
+
+let powerpc64eb = define "powerpc64" r64 Theory.Endianness.eb
     ~nicknames:[
-      "powerpc64"; "ppc64"; "power64";
+      "powerpc64+bi"; "ppc64"; "power64";
       "powerpc64eb"; "powerpc64be";
       "ppc64eb"; "ppc64be";
       "power64eb"; "power64be"
     ]
-let powerpc64le = define r64 Theory.Endianness.le
+let powerpc64le = define "powerpc64le" r64 Theory.Endianness.le
     ~nicknames:[
-      "powerpc64el"; "powerpc64le";
+      "powerpc64el"; "powerpc64+le";
       "ppc64el"; "ppc64le";
       "power64el"; "power64le"
     ]
@@ -115,35 +123,47 @@ let enable_loader () =
     let request =
       Ogre.request Image.Scheme.arch >>= fun arch ->
       Ogre.request Image.Scheme.is_little_endian >>= fun little ->
-      Ogre.return (arch,little) in
+      Ogre.request Image.Scheme.format >>= fun format ->
+      Ogre.return (arch,little,format) in
     match Ogre.eval request doc with
-    | Error _ -> None,None
+    | Error _ -> None,None,None
     | Ok info -> info in
   KB.promise Theory.Unit.target @@ fun unit ->
-  KB.collect Image.Spec.slot unit >>|
-  request_info >>| function
-  | Some "powerpc", None -> powerpc32bi
-  | Some "powerpc64",None -> powerpc64bi
-  | Some "powerpc",Some true -> powerpc32le
-  | Some "powerpc64",Some true -> powerpc64le
-  | Some "powerpc",Some false -> powerpc32eb
-  | Some "powerpc64",Some false -> powerpc64eb
-  | _ -> Theory.Target.unknown
-
-
-let mapped_powerpc = Map.of_alist_exn (module Theory.Target) [
-    powerpc32eb, `ppc;
-    powerpc64eb, `ppc64;
-    powerpc64le, `ppc64le;
-  ]
+  KB.collect Image.Spec.slot unit >>| request_info >>| fun (arch,is_little,format) ->
+  let (abi,filetype) = match format with
+    | Some "elf" -> Theory.Abi.gnu, Theory.Filetype.elf
+    | Some "macho" -> Theory.Abi.gnu, Theory.Filetype.macho
+    | _ -> Theory.Abi.unknown, Theory.Filetype.unknown  in
+  let parent = match arch, is_little with
+    | Some "powerpc", (None|Some false) -> powerpc32eb
+    | Some "powerpc64",(None|Some false) -> powerpc64eb
+    | Some "powerpc",Some true -> powerpc32le
+    | Some "powerpc64",Some true -> powerpc64le
+    | _ -> Theory.Target.unknown in
+  if Theory.Target.is_unknown parent then parent
+  else Theory.Target.select ~strict:true ~parent ~filetype ~abi ()
+
+
+let register_subtargets () =
+  [powerpc32eb; powerpc32le; powerpc64eb; powerpc64le] |>
+  List.iter ~f:(fun parent ->
+      Theory.Target.register parent
+        ~abis:Theory.Abi.[unknown; gnu]
+        ~systems:Theory.System.[unknown; linux; freebsd; openbsd; vxworks]
+        ~filetypes:Theory.Filetype.[unknown; elf; macho])
+
 
 let map_powerpc () =
   let open KB.Syntax in
   KB.promise Arch.unit_slot @@ fun unit ->
-  KB.collect Theory.Unit.target unit >>|
-  Map.find mapped_powerpc >>| function
-  | Some arch -> arch
-  | None -> `unknown
+  KB.collect Theory.Unit.target unit >>| fun t ->
+  if Theory.Target.belongs parent t then
+    match Theory.Target.bits t, Theory.Endianness.(Theory.Target.endianness t = le) with
+    | 32,false -> `ppc
+    | 64,false -> `ppc64
+    | 64,true -> `ppc64le
+    | _ -> `unknown
+  else `unknown
 
 module Dis = Disasm_expert.Basic
 
@@ -186,6 +206,7 @@ let enable_pcode_decoder () =
   end
 
 let load ?(backend="llvm") () =
+  register_subtargets ();
   enable_loader ();
   map_powerpc ();
   match backend with

oasis/powerpc

@@ -16,7 +16,7 @@ Library powerpc_plugin
   Path:             plugins/powerpc
   Build$:           flag(everything) || flag(powerpc)
   BuildDepends:     bap, bap-abi, bap-c, zarith, monads, core_kernel,
-                    ppx_bap, regular, bap-api, bap-powerpc
+                    ppx_bap, regular, bap-api, bap-powerpc, bap-core-theory
   FindlibName:      bap-plugin-powerpc
   InternalModules:  Powerpc,
                     Powerpc_cpu,

plugins/powerpc/powerpc_abi.ml

@@ -1,89 +1,52 @@
 open Core_kernel[@@warning "-D"]
+open Bap_core_theory
 open Bap.Std
 open Bap_c.Std
-
-include Self()
-
-module Stack = C.Abi.Stack
-
-type pos =
-  | Ret_0
-  | Ret_1
-  | Arg of int
-
-module type abi = sig
-  val name : string
-  val size : C.Size.base
-  val arg  : pos -> exp
-end
-
-type abi = (module abi)
-
-exception Unsupported
-
-module Abi32 = struct
-  open Powerpc.Std
-  open PowerPC_32
-
-  let reg i = Int.Map.find_exn gpri i |> Bil.var
-  let name = "ppc32"
-  let size = object
-    inherit C.Size.base `ILP32
-  end
-  let arg = function
-    | Ret_0 -> reg 3
-    | Ret_1 -> reg 4
-    | Arg n -> reg (n + 3)
-end
-
-let supported_api (module Abi : abi) {C.Type.Proto.return; args} =
-  let word = Arch.addr_size (`ppc :> arch) |> Size.in_bits in
-  let return = match Abi.size#bits return with
-    | None -> None
-    | Some width -> match Size.of_int_opt width with
-      | None ->
-        warning "size of return object doesn't fit into word sizes";
-        raise Unsupported
-      | Some sz ->
-        let data = C.Abi.data Abi.size return in
-        if width > word && width <= word * 2
-        then Some (data, Bil.(Abi.arg Ret_0 ^ Abi.arg Ret_1))
-        else if width <= word
-        then Some (data, Abi.arg Ret_0)
-        else
-          (warning "size of return object doesn't fit into double word\n";
-           raise Unsupported) in
-  let params = List.mapi args ~f:(fun i (n,t) ->
-      match Abi.size#bits t with
-      | None ->
-        warning "size of %a parameter is unknown" C.Type.pp t;
-        raise Unsupported
-      | Some size -> match Size.of_int_opt size with
-        | Some sz when size <= word ->
-          C.Abi.data Abi.size t, Abi.arg (Arg i)
-        | _ ->
-          warning "argument %d doesn't fit into word" i;
-          raise Unsupported) in
-  C.Abi.{return; params; hidden=[]}
-
-let api abi proto =
-  try Some (supported_api abi proto) with Unsupported ->
-    warning "skipped function due to unsupported abi";
-    None
-
-let dispatch abi sub attrs proto = api abi proto
-
-let main proj = match Project.arch proj with
-  | `ppc ->
-    info "using powerpc ABI";
-    let abi = C.Abi.{
-        insert_args = dispatch (module Abi32);
-        apply_attrs = fun _ -> Fn.id
-      } in
-    C.Abi.register Abi32.name abi;
-    let api = C.Abi.create_api_processor Abi32.size abi in
-    Bap_api.process api;
-    Project.set proj Bap_abi.name Abi32.name
-  | _ -> proj
-
-let setup () = Bap_abi.register_pass main
+module Arg = C.Abi.Arg
+open Arg.Language
+
+let arena t name ~from len =
+  Arg.Arena.create @@
+  List.init len ~f:(fun i ->
+      let name = sprintf "%s%d" name (from+i) in
+      match Theory.Target.var t name with
+      | Some v -> v
+      | None -> failwithf "Target %s doesn't have a register named %s"
+                  (Theory.Target.to_string t) name ())
+
+
+let sysv32 t =
+  let rev = Theory.Endianness.(equal le) (Theory.Target.endianness t) in
+  install t (new C.Size.base `ILP32) @@ fun declare ->
+  let* iargs = arena t ~from:3 "R" 8 in
+  let* fargs = arena t ~from:1 "F" 8 in
+  let* irets = Arg.Arena.irets t in
+  let* frets = Arg.Arena.frets t in
+  let return ~alignment:_ _ = select [
+      C.Type.is_floating, Arg.registers ~rev frets;
+      otherwise, choose [
+        Arg.registers ~rev irets;
+        Arg.reference iargs;
+      ]
+    ] in
+  declare ~return @@ fun ~alignment:_ size -> select [
+    C.Type.is_floating, choose [
+      Arg.register fargs;
+      Arg.memory;
+    ];
+    is (size > 32), choose [
+      Arg.pointer iargs;
+      Arg.memory;
+    ];
+    otherwise, choose [
+      Arg.pointer iargs;
+      Arg.memory;
+    ]
+  ]
+
+
+let setup () =
+  Theory.Target.family Bap_powerpc_target.parent |>
+  List.iter ~f:(fun t ->
+      if Theory.Target.bits t = 32 &&
+         Theory.Abi.(Theory.Target.abi t = gnu) then sysv32 t)

plugins/primus_lisp/site-lisp/libc-init.lisp

@@ -62,7 +62,7 @@
 
 (defun init (argc argv ubpev auxvec fini stinfo stack_on_entry)
   (declare (external "__libc_start_main")
-           (context (abi "ppc32")))
+           (context (target "powerpc") (abi "gnu")))
   (set R2 (+ stack_on_entry 0x7008))
   (let ((argc (read-word ptr_t stack_on_entry))
         (argv (ptr+1 ptr_t stack_on_entry))

plugins/primus_lisp/site-lisp/types.lisp

@@ -65,11 +65,11 @@
 (defun long ()  (declare (context (target mips64))) (model-ilp64 'long))
 (defun ptr_t () (declare (context (target mips64))) (model-ilp64 'ptr))
 
-(defun char ()  (declare (context (abi ppc32))) (model-ilp32 'char))
-(defun short () (declare (context (abi ppc32))) (model-ilp32 'short))
-(defun int ()   (declare (context (abi ppc32))) (model-ilp32 'int))
-(defun long ()  (declare (context (abi ppc32))) (model-ilp32 'long))
-(defun ptr_t () (declare (context (abi ppc32))) (model-ilp32 'ptr))
+(defun char ()  (declare (context (target powerpc) (bits 32))) (model-ilp32 'char))
+(defun short () (declare (context (target powerpc) (bits 32))) (model-ilp32 'short))
+(defun int ()   (declare (context (target powerpc) (bits 32))) (model-ilp32 'int))
+(defun long ()  (declare (context (target powerpc) (bits 32))) (model-ilp32 'long))
+(defun ptr_t () (declare (context (target powerpc) (bits 32))) (model-ilp32 'ptr))
 
 (defun char ()  (declare (context (arch x86_64 sysv))) (model-lp64 'char))
 (defun short () (declare (context (arch x86_64 sysv))) (model-lp64 'short))