Unsupported opcode fallback

bin/main.ml

@@ -1,3 +1,5 @@
+module OcamlResult = Result
+
 open Ocaml_protoc_plugin
 open Gtirb_semantics.IR.Gtirb.Proto
 open Gtirb_semantics.ByteInterval.Gtirb.Proto
@@ -7,6 +9,8 @@ open Gtirb_semantics.CodeBlock.Gtirb.Proto
 open Gtirb_semantics.AuxData.Gtirb.Proto
 open LibASL
 
+module Result = OcamlResult
+
 (* TYPES  *)
 
 (* These could probably be simplified *)
@@ -20,10 +24,16 @@ type rectified_block = {
   size      : int;
 }
 
+
+type dis_error = {
+  opcode: string;
+  error: string
+}
+
 (* ASLi semantic info for a block *)
 type ast_block = {
   auuid   : bytes;
-  asts    : string list list;
+  asts    : ((string list, dis_error) result) list;
 }
 
 (* Wrapper for polymorphic code/data/not-set block pre-rectification  *)
@@ -33,6 +43,7 @@ type content_block = {
   address : int; 
 }
 
+
 (* CONSTANTS  *)
 let opcode_length = 4
 let json_file = ref ""
@@ -116,8 +127,9 @@ let do_module (m: Module.t): Module.t =
     | None -> Printf.eprintf "unable to load bundled asl files. has aslp been installed correctly?"; exit 1
   in
 
+
   (* Evaluate each instruction one by one with a new environment for each *)
-  let to_asli (opcode_be: bytes) (addr : int) : string list =
+  let to_asli (opcode_be: bytes) (addr : int) : ((string list, dis_error) result) =
     let p_raw a = Utils.to_string (Asl_parser_pp.pp_raw_stmt a) |> String.trim   in
     let p_pretty a = Asl_utils.pp_stmt a |> String.trim                          in
     let p_byte (b: char) = Printf.sprintf "%02X" (Char.code b)                   in
@@ -131,16 +143,21 @@ let do_module (m: Module.t): Module.t =
     let opcode_list : char list = List.(rev @@ of_seq @@ Bytes.to_seq opcode_be) in
     let opcode_str = String.concat " " List.(map p_byte opcode_list)             in
     let _opcode : bytes = Bytes.of_seq List.(to_seq opcode_list)                  in
-    let do_dis () =
+
+    let do_dis () : ((string list * string list), dis_error) result =
       (match Dis.retrieveDisassembly ?address env (Dis.build_env env) opnum_str with
-      | res -> (List.map p_raw res, List.map p_pretty res)
+      | res -> Ok (List.map p_raw res, List.map p_pretty res)
       | exception exc ->
         Printf.eprintf
-          "error during aslp disassembly (opcode %s, bytes %s):\n\nFatal error: exception %s\n"
+          "error during aslp disassembly (unsupported opcode %s, bytes %s):\n\nException : %s\n"
           opnum_str opcode_str (Printexc.to_string exc);
-        Printexc.print_backtrace stderr;
-        exit 1)
-    in fst @@ do_dis ()
+          (* Printexc.print_backtrace stderr; *)
+          Error {
+            opcode =  opnum_str;
+            error = (Printexc.to_string exc)
+          }
+      )
+    in Result.map fst (do_dis ())
   in
   let rec asts opcodes addr =
     match opcodes with
@@ -162,8 +179,14 @@ let do_module (m: Module.t): Module.t =
   let serialisable: string =
     let to_list x = `List x in
     let to_string x = `String x in
-    let jsoned (asts: string list list) : Yojson.Safe.t =
-      to_list @@ List.map (fun x -> to_list @@ List.map to_string x) asts in
+    let jsoned (asts: (string list, dis_error) result list) : Yojson.Safe.t =
+      let toj (x: (string list, dis_error) result) : Yojson.Safe.t = match x with
+        | Ok sl -> to_list @@ List.map to_string sl
+        | Error err -> `Assoc [
+          ("decode_error", `Assoc [("opcode", (`String err.opcode)); ("error", `String err.error)] )
+        ]
+      in
+      to_list @@ List.map toj asts in 
 
     let paired: Yojson.Safe.t =
       `Assoc (

dune-project

@@ -19,7 +19,7 @@
  (name gtirb_semantics)
  (synopsis "Add semantic information to the IR of a disassembled ARM64 binary")
  (description "A longer description")
- (depends ocaml dune yojson asli ocaml-protoc-plugin base64)
+ (depends ocaml dune yojson asli (ocaml-protoc-plugin (>= 6.1.0)) base64)
  (tags
   (decompilers instruction-lifters static-analysis)))
 

gtirb_semantics.opam

@@ -14,7 +14,7 @@ depends: [
   "dune" {>= "3.6"}
   "yojson"
   "asli"
-  "ocaml-protoc-plugin"
+  "ocaml-protoc-plugin" {>= "6.1.0"}
   "base64"
   "odoc" {with-doc}
 ]

lib/dune

@@ -3,7 +3,7 @@
  (libraries ocaml-protoc-plugin asli.libASL base64))
 
 (rule
- (targets AuxData.ml ByteInterval.ml CFG.ml CodeBlock.ml DataBlock.ml IR.ml Module.ml Offset.ml ProxyBlock.ml Section.ml Symbol.ml SymbolicExpression.ml)
+ (targets auxData.ml byteInterval.ml cFG.ml codeBlock.ml dataBlock.ml iR.ml module.ml offset.ml proxyBlock.ml section.ml symbol.ml symbolicExpression.ml)
  (deps
   (:proto AuxData.proto ByteInterval.proto CFG.proto CodeBlock.proto DataBlock.proto IR.proto Module.proto Offset.proto ProxyBlock.proto Section.proto Symbol.proto SymbolicExpression.proto))
  (action