uses ghidra backend for AVR lifter and disassembler

Author: ivg

lib/bap_avr/bap_avr_target.ml

@@ -1,5 +1,7 @@
 open Core_kernel
 open Bap_core_theory
+module Dis = Bap.Std.Disasm_expert.Basic
+
 
 let package = "bap"
 
@@ -36,12 +38,42 @@ let parent = Theory.Target.declare ~package "avr"
     ~byte:8
     ~endianness:Theory.Endianness.le
 
-
 let atmega328 = Theory.Target.declare ~package "ATmega328"
     ~parent
     ~data
     ~code
     ~vars:(gpr @< [sp] @< flags @< [data] @< [code])
 
+let pcode =
+  Theory.Language.declare ~package:"bap" "pcode-avr"
+
+let provide_decoding () =
+  let open KB.Syntax in
+  KB.promise Theory.Label.encoding @@ fun label ->
+  Theory.Label.target label >>| fun t ->
+  if Theory.Target.belongs parent t
+  then pcode
+  else Theory.Language.unknown
+
+let enable_ghidra () =
+  Dis.register pcode @@ fun _target ->
+  Dis.create ~backend:"ghidra" "avr8:LE:16:atmega256"
+
+let enable_loader () =
+  let open Bap.Std in
+  let open KB.Syntax in
+  let request_arch doc =
+    let open Ogre.Syntax in
+    match Ogre.eval (Ogre.request Image.Scheme.arch) doc with
+    | Error _ -> None
+    | Ok arch -> arch in
+  KB.promise Theory.Unit.target @@ fun unit ->
+  KB.collect Image.Spec.slot unit >>| request_arch >>| function
+  | Some "avr" -> atmega328
+  | _ -> Theory.Target.unknown
+
 
-let llvm_avr16 = Theory.Language.declare ~package "llvm-avr16"
+let load () =
+  enable_ghidra ();
+  enable_loader ();
+  provide_decoding ()

lib/bap_avr/bap_avr_target.mli

@@ -1,18 +1,5 @@
 open Bap_core_theory
 
 val parent : Theory.target
-val atmega328 : Theory.target
-val llvm_avr16 : Theory.language
 
-type r16 and r8
-
-type 'a bitv = 'a Theory.Bitv.t Theory.Value.sort
-
-val r16 : r16 bitv
-val r8  : r8 bitv
-
-val code : (r16, r16) Theory.Mem.t Theory.var
-val data : (r16, r8) Theory.Mem.t Theory.var
-val gpr : r8 Theory.Bitv.t Theory.var list
-val sp : r16 Theory.Bitv.t Theory.var
-val flags : Theory.Bool.t Theory.var list
+val load : unit -> unit

oasis/avr

@@ -6,17 +6,15 @@ Library "bap-avr"
  Build$:           flag(everything) || flag(avr)
  XMETADescription: common definitions for Avr targets
  Path: lib/bap_avr
- BuildDepends: core_kernel, bap-knowledge, bap-core-theory
+ BuildDepends: core_kernel, bap-knowledge, bap-core-theory, bap, ogre
  FindlibName: bap-avr
  Modules: Bap_avr_target
 
 Library avr_plugin
   XMETADescription: provide Avr lifter
   Path:             plugins/avr
   Build$:           flag(everything) || flag(avr)
-  BuildDepends:     core_kernel, ppx_jane, ogre,
-                    bap-core-theory, bap-knowledge, bap-main,
-                    bap, bap-avr, bitvec
+  BuildDepends:     bap-main, bap-avr
   FindlibName:      bap-plugin-avr
-  InternalModules:  Avr_main, Avr_lifter
+  InternalModules:  Avr_main
   XMETAExtraLines:  tags="avr, lifter, atmega"

plugins/avr/avr_lifter.ml

@@ -1,53 +1,12 @@
 open Bap_main
-open Bap.Std
-open Bap_core_theory
-open KB.Syntax
-module CT = Theory
-
-include Bap_main.Loggers()
-
-module Target = Bap_avr_target
-module Dis = Disasm_expert.Basic
-
-let provide_decoding () =
-  KB.promise CT.Label.encoding @@ fun label ->
-  CT.Label.target label >>| fun t ->
-  if CT.Target.belongs Target.parent t
-  then Target.llvm_avr16
-  else CT.Language.unknown
-
-let enable_llvm () =
-  Dis.register Target.llvm_avr16 @@ fun _target ->
-  Dis.create ~backend:"llvm" "avr"
-
-let enable_loader () =
-  let request_arch doc =
-    let open Ogre.Syntax in
-    match Ogre.eval (Ogre.request Image.Scheme.arch) doc with
-    | Error _ -> assert false (* nothing could go wrong here! *)
-    | Ok arch -> arch in
-  KB.promise CT.Unit.target @@ fun unit ->
-  KB.collect Image.Spec.slot unit >>| request_arch >>| function
-  | Some "avr" -> Target.atmega328
-  | _ -> CT.Target.unknown
-
 
 let main _ctxt =
-  enable_llvm ();
-  enable_loader ();
-  provide_decoding ();
-  Avr_lifter.load ();
+  Bap_avr_target.load ();
   Ok ()
 
-(* semantic tags that describe what our plugin is providing,
-   setting them is important not only for introspection but
-   for the proper function of the cache subsystem.
-*)
-let provides = [
-  "avr";
-  "lifter";
-]
 
-(* finally, let's register our extension and call the main function  *)
 let () = Bap_main.Extension.declare main
-    ~provides
+    ~provides:[
+      "avr";
+      "lifter";
+    ]