From 3664146074fdf3f29dfd177c20d9a5bb65a09985 Mon Sep 17 00:00:00 2001 From: Ivan Gotovchits Date: Tue, 10 Feb 2015 18:59:28 -0500 Subject: [PATCH] v0.9.3 Introduction ------------ This release is based on a feedback from our users (including myself). The main goal of this release is to increase the usability of BAP. Major changes ------------- 1. `Bitvector` (aka `Word`, aka `Addr`) now provides all `Integer` interface without any monads right at the toplevel of the module. In other words, now you can write: `Word.(x + y)`. 2. `Bitvector.Int` is renamed to `Bitvector.Int_exn` so that it don't clobber the real `Int` module 3. All BIL is now consolidated in one module named `Bil`. This module contains everything, including constructors for statements, expressions casts, binary and unary operations. It also includes functional constructors, that are now written by hand and, thus, don't suffer from syntactic clashes with keywords. There're also a plenty of other functions and new operators, available from the new `Bap_helpers` module, see later. Old modules, like `Expr`, `Stmt`, etc are still available, they implement `Regular` interface for corresponding types. 4. New feature: visitor classes to traverse and transform the AST. Writing a pattern matching code every time you need to traverse or map the BIL AST is error prone and time-consuming. This visitors, do all the traversing for you, allowing you to override default behavior. Some handy algorithms, that use visitors are provided in an internal `Bap_helpers` module, that is included into resulting `Bil` module. Several optimizations were added to `bap-objdump` utility, like constant propogation, inlining, pruning unused variables and resolving addresses to symbols. 5. Insn interface now provides predicates to query insn classes, this predicates use BIL if available. 6. Disam interface now provides `linear_sweep` function. Minor Changes ------------- There're some bug fixes, the most important is fixing `bitsub`. Now it is renamed to `extract`, as it can output words of greater size, and it also handles signed extraction correctly. The drastic `disassemble_file` function now checks for errors. --- _oasis | 6 +- lib/bap_disasm/bap_disasm.ml | 43 +++- lib/bap_disasm/bap_disasm.mli | 19 +- lib/bap_disasm/bap_disasm_arm_bit.ml | 4 +- lib/bap_disasm/bap_disasm_arm_flags.ml | 2 +- lib/bap_disasm/bap_disasm_arm_lifter.ml | 6 +- lib/bap_disasm/bap_disasm_arm_mem.ml | 10 +- lib/bap_disasm/bap_disasm_arm_mov.ml | 6 +- lib/bap_disasm/bap_disasm_arm_mul.ml | 8 +- lib/bap_disasm/bap_disasm_arm_shift.ml | 17 +- lib/bap_disasm/bap_disasm_arm_utils.ml | 6 +- lib/bap_disasm/bap_disasm_basic.ml | 2 +- lib/bap_disasm/bap_disasm_insn.ml | 68 +++++- lib/bap_disasm/bap_disasm_insn.mli | 34 +++ lib/bap_image/bap_memory.ml | 10 +- lib/bap_image/image_elf.ml | 2 +- lib/bap_types/bap_addr.ml | 5 +- lib/bap_types/bap_bil.ml | 88 ++++++-- lib/bap_types/bap_bitvector.ml | 46 ++-- lib/bap_types/bap_bitvector.mli | 26 ++- lib/bap_types/bap_common.ml | 52 ----- lib/bap_types/bap_exp.ml | 86 +++++-- lib/bap_types/bap_exp.mli | 120 +++++++--- lib/bap_types/bap_helpers.ml | 192 ++++++++++++++++ lib/bap_types/bap_helpers.mli | 46 ++++ lib/bap_types/bap_stmt.ml | 18 +- lib/bap_types/bap_stmt.mli | 13 ++ lib/bap_types/bap_types.ml | 68 ++++-- lib/bap_types/bap_visitor.ml | 288 ++++++++++++++++++++++++ lib/bap_types/bap_visitor.mli | 253 +++++++++++++++++++++ lib/bap_types/conceval.ml | 38 ++-- lib_test/bap_image/test_image.ml | 2 +- lib_test/bap_types/test_bitvector.ml | 2 +- opam | 5 +- src/readbin/cmdline.ml | 33 +-- src/readbin/helpers.ml | 108 +++++---- src/readbin/options.ml | 5 +- test.sh | 2 +- 38 files changed, 1423 insertions(+), 316 deletions(-) create mode 100644 lib/bap_types/bap_helpers.ml create mode 100644 lib/bap_types/bap_helpers.mli create mode 100644 lib/bap_types/bap_visitor.ml create mode 100644 lib/bap_types/bap_visitor.mli diff --git a/_oasis b/_oasis index 69aadc6e7..924e250a7 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: bap -Version: 0.9.1 +Version: 0.9.3 Synopsis: BAP Core Library Authors: BAP Team Maintainers: Ivan Gotovchits @@ -118,6 +118,7 @@ Library types Bap_bitvector, Bap_common, Bap_exp, + Bap_helpers, Bap_int_conversions, Bap_integer, Bap_integer_intf, @@ -126,7 +127,8 @@ Library types Bap_size, Bap_stmt, Bap_type, - Bap_var + Bap_var, + Bap_visitor Library conceval Path: lib/bap_types diff --git a/lib/bap_disasm/bap_disasm.ml b/lib/bap_disasm/bap_disasm.ml index b4c7ab211..2974bb2e2 100644 --- a/lib/bap_disasm/bap_disasm.ml +++ b/lib/bap_disasm/bap_disasm.ml @@ -7,6 +7,7 @@ open Bap_disasm_types open Image_internal_std module Rec = Bap_disasm_rec +module Dis = Bap_disasm_basic module Block = Bap_disasm_block module Insn = Bap_disasm_insn module Image = Bap_image @@ -34,8 +35,6 @@ type disasm = { mems_of_insn : (insn -> mem seq) Lazy.t; } -type t = disasm - let insns_of_blocks bs = Seq.(Table.elements bs >>| Block.insns |> join) @@ -64,7 +63,6 @@ let fail error mem = { memmap = Table.singleton mem (Failed error); } - let mem_of_rec_error = function | `Failed_to_disasm mem -> mem | `Failed_to_lift (mem,insn,err) -> mem @@ -112,6 +110,26 @@ let lifter_of_arch = function | #Arch.arm -> Some Bap_disasm_arm_lifter.insn | _ -> None +let linear_sweep arch mem : (mem * insn option) list Or_error.t = + Dis.create ~backend:"llvm" (Arch.to_string arch) >>| fun dis -> + let dis = Dis.store_asm dis in + let dis = Dis.store_kinds dis in + Dis.run dis mem + ~init:[] ~return:ident ~stopped:(fun s _ -> + Dis.stop s (Dis.insns s)) |> + List.map ~f:(function + | mem, None -> mem,None + | mem, Some insn -> match lifter_of_arch arch with + | None -> mem, Some (Insn.of_basic insn) + | Some lift -> match lift mem insn with + | Ok bil -> mem, Some (Insn.of_basic ~bil insn) + | _ -> mem, Some (Insn.of_basic insn)) + + +let linear_sweep_exn arch mem = ok_exn (linear_sweep arch mem) + + + let disassemble ?roots arch mem = let lifter = lifter_of_arch arch in match Rec.run ?lifter ?roots arch mem with @@ -140,12 +158,23 @@ let disassemble_image ?roots image = else dis) let disassemble_file ?roots filename = - match Image.create filename with - | Error err -> empty - | Ok (image,_warns) -> (* todo: add warnings *) - disassemble_image ?roots image + Image.create filename >>= fun (img,errs) -> + let dis = disassemble_image ?roots img in + let memmap = + List.fold ~init:dis.memmap errs ~f:(fun memmap e -> + let e = `Failed e in + Table.map memmap ~f:(function + | Failed e' -> Failed (`Errors (e,e')) + | Decoded (insn,None) -> Decoded (insn,Some e) + | Decoded (insn,Some e') -> + Decoded (insn, Some (`Errors(e,e'))))) in + return {dis with memmap} + +let disassemble_file_exn ?roots filename = + disassemble_file ?roots filename |> ok_exn module Disasm = struct + type t = disasm let insns t = insns_of_blocks t.blocks let blocks t = t.blocks let insn_at_mem {memmap} m = diff --git a/lib/bap_disasm/bap_disasm.mli b/lib/bap_disasm/bap_disasm.mli index 1ba1f55c8..f394f9731 100644 --- a/lib/bap_disasm/bap_disasm.mli +++ b/lib/bap_disasm/bap_disasm.mli @@ -16,7 +16,6 @@ open Image_internal_std memory region. To create values of this type use [disassemble] function *) type disasm -type t = disasm (** values of type [insn] represents machine instructions decoded from the given piece of memory *) @@ -36,7 +35,7 @@ type block = Bap_disasm_block.t with compare, sexp_of The returned value will contain all memory reachable from the given set of roots, at our best knowledge. *) -val disassemble : ?roots:addr list -> arch -> mem -> t +val disassemble : ?roots:addr list -> arch -> mem -> disasm (** [disassemble_image image] disassemble given image. Will take executable sections of the image and disassemble it, @@ -44,14 +43,26 @@ val disassemble : ?roots:addr list -> arch -> mem -> t symbol table will be used as a source of roots. If file doesn't contain one, then entry point will be used. *) -val disassemble_image : ?roots:addr list -> Bap_image.t -> t +val disassemble_image : ?roots:addr list -> Bap_image.t -> disasm (** [disassemble_file ?roots path] takes a path to a binary and disassembles it *) -val disassemble_file : ?roots:addr list -> string -> t +val disassemble_file : ?roots:addr list -> string -> disasm Or_error.t + +(** [disassemble_file ?roots path] takes a path to a binary and + disassembles it *) +val disassemble_file_exn : ?roots:addr list -> string -> disasm + +(** [linear_sweep arch mem] will perform a linear sweep disassembly on + the specified memory [mem] *) +val linear_sweep : arch -> mem -> (mem * insn option) list Or_error.t +val linear_sweep_exn : arch -> mem -> (mem * insn option) list + (** Disassembled program *) module Disasm : sig + type t = disasm + (** returns all instructions that was successfully decoded in an ascending order of their addresses. Each instruction is accompanied with its block of memory. *) diff --git a/lib/bap_disasm/bap_disasm_arm_bit.ml b/lib/bap_disasm/bap_disasm_arm_bit.ml index 188048487..0e53f078c 100644 --- a/lib/bap_disasm/bap_disasm_arm_bit.ml +++ b/lib/bap_disasm/bap_disasm_arm_bit.ml @@ -18,7 +18,7 @@ let wordm x = Ok (Word.of_int x ~width:32) let extend ~dest ~src ?src2 sign size ~rot cond = let rot = assert_imm _here_ rot in let dest = assert_reg _here_ dest in - let amount = match Word.Int.((!$rot * wordm 8)) with + let amount = match Word.Int_err.((!$rot * wordm 8)) with | Ok amount -> amount | Error err -> fail _here_ "failed to obtain amount" in let rotated, (_ : exp) = @@ -28,7 +28,7 @@ let extend ~dest ~src ?src2 sign size ~rot cond = Shift.lift_c ~src:(exp_of_op src) `ROR ~shift:(Exp.int amount) reg32_t in let extracted = - Exp.(cast Cast.low (bits_of_size size) rotated) in + Bil.(cast low (bits_of_size size) rotated) in let extent = cast_of_sign sign 32 extracted in let final = match src2 with | Some s2 -> Exp.(exp_of_op s2 + extent) diff --git a/lib/bap_disasm/bap_disasm_arm_flags.ml b/lib/bap_disasm/bap_disasm_arm_flags.ml index 96b8359a3..968e34372 100644 --- a/lib/bap_disasm/bap_disasm_arm_flags.ml +++ b/lib/bap_disasm/bap_disasm_arm_flags.ml @@ -31,7 +31,7 @@ let set_sub s1 s2 r t = let set_adc s1 s2 r t = let sum_with_carry = - let extend = Exp.cast Exp.Cast.unsigned (bitlen t + 1) in + let extend = Bil.(cast unsigned) (bitlen t + 1) in Exp.(extend s1 + extend s2 + extend (var Env.cf)) in Stmt.move Env.cf (msb sum_with_carry) :: set_vnzf_add s1 s2 r t diff --git a/lib/bap_disasm/bap_disasm_arm_lifter.ml b/lib/bap_disasm/bap_disasm_arm_lifter.ml index fa510cc30..da4e3bb85 100644 --- a/lib/bap_disasm/bap_disasm_arm_lifter.ml +++ b/lib/bap_disasm/bap_disasm_arm_lifter.ml @@ -304,7 +304,7 @@ let lift_bits mem ops (insn : Arm.Insn.bits ) = assn temp Exp.(load (var mem) src2 LittleEndian `r8); Stmt.move mem Exp.(store (var mem) src2 (extract 7 0 src1) LittleEndian `r8); - assn dest Exp.(cast Cast.unsigned 32 (var temp)); + assn dest Exp.(cast unsigned 32 (var temp)); ] cond (* Pack half *) @@ -984,7 +984,7 @@ let lift_special ops insn = | `MRS, [|Reg dest; cond; _|] -> let get_bits flag src lsb = - Exp.(src lor (cast Cast.unsigned 32 (var flag) lsl int32 lsb)) in + Exp.(src lor (cast unsigned 32 (var flag) lsl int32 lsb)) in let d = Env.of_reg dest in let vd = Exp.var d in exec [ @@ -1046,7 +1046,7 @@ let arm_ops ops = try_with (arm_ops_exn ops) let insn_exn mem insn = let open Arm.Insn in let name = Basic.Insn.name insn in - Memory.(Addr.Int.(!$(max_addr mem) - !$(min_addr mem))) + Memory.(Addr.Int_err.(!$(max_addr mem) - !$(min_addr mem))) >>= Word.to_int >>= fun s -> Size.of_int ((s+1) * 8) >>= fun size -> Memory.get ~scale:(size ) mem >>| fun word -> match Arm.Insn.create insn with diff --git a/lib/bap_disasm/bap_disasm_arm_mem.ml b/lib/bap_disasm/bap_disasm_arm_mem.ml index f54d0e613..d057c6dc2 100644 --- a/lib/bap_disasm/bap_disasm_arm_mem.ml +++ b/lib/bap_disasm/bap_disasm_arm_mem.ml @@ -83,7 +83,7 @@ let lift_r ~(dst1 : Var.t) ?(dst2 : Var.t option) ~(base : Var.t) let trunc = match size with | B | H -> let n = if size = B then 8 else 16 in - [Stmt.move temp Exp.(cast Cast.low n (var dst1))] + [Stmt.move temp Exp.(cast low n (var dst1))] | W | D -> [] in let stores = let m1,m2 = Env.(new_mem "m1", new_mem "m2") in @@ -137,7 +137,7 @@ let lift_m dest_list base mode update operation = | (Stmt.Jmp exp) -> stmts @ [Stmt.Jmp exp] | _ -> stmt :: move_jump_to_end stmts in move_jump_to_end (List.concat [ - [Stmt.move o_base Exp.(var base)]; - List.mapi ~f:create_access dest_list; - writeback - ]) + [Stmt.move o_base Exp.(var base)]; + List.mapi ~f:create_access dest_list; + writeback + ]) diff --git a/lib/bap_disasm/bap_disasm_arm_mov.ml b/lib/bap_disasm/bap_disasm_arm_mov.ml index 1c9f7ee72..d093ab071 100644 --- a/lib/bap_disasm/bap_disasm_arm_mov.ml +++ b/lib/bap_disasm/bap_disasm_arm_mov.ml @@ -79,7 +79,7 @@ let lift ?dest src1 ?src2 (itype ) ?sreg ?simm raw ~wflag cond = | `SUB -> Exp.(s1 - s2) | `RSB -> Exp.(s2 - s1) | `ADD -> Exp.(s1 + s2) - | `ADC -> Exp.(s1 + s2 + cast Cast.unsigned 32 vcf) - | `SBC -> Exp.(s1 + lnot s2 + cast Cast.unsigned 32 vcf) - | `RSC -> Exp.(lnot s1 + s2 + cast Cast.unsigned 32 vcf) in + | `ADC -> Exp.(s1 + s2 + cast unsigned 32 vcf) + | `SBC -> Exp.(s1 + lnot s2 + cast unsigned 32 vcf) + | `RSC -> Exp.(lnot s1 + s2 + cast unsigned 32 vcf) in exec (stmts @ [assn dest oper]) ~flags ~wflag cond diff --git a/lib/bap_disasm/bap_disasm_arm_mul.ml b/lib/bap_disasm/bap_disasm_arm_mul.ml index 6177c3e40..27d4d6ae2 100644 --- a/lib/bap_disasm/bap_disasm_arm_mul.ml +++ b/lib/bap_disasm/bap_disasm_arm_mul.ml @@ -36,7 +36,7 @@ let lift_smul ~dest ?hidest ~src1 ~src2 ?accum ?hiaccum ?q size cond = let dest = assert_reg _here_ dest in let src1 = exp_of_op src1 in let src2 = exp_of_op src2 in - let excast hi lo s = Exp.(cast Cast.signed 64 (extract hi lo s)) in + let excast hi lo s = Exp.(cast signed 64 (extract hi lo s)) in let top = excast 31 16 in let bot = excast 15 0 in let top32 = excast 47 16 in @@ -50,13 +50,13 @@ let lift_smul ~dest ?hidest ~src1 ~src2 ?accum ?hiaccum ?q size cond = | TT -> top src1 * top src2 | D -> top src1 * top src2 + bot src1 * bot src2 | DX -> top src1 * bot src2 + bot src1 * top src2 - | WB -> top32 (cast Cast.signed 64 (src1 * bot src2)) - | WT -> top32 (cast Cast.signed 64 (src1 * top src2)) in + | WB -> top32 (cast signed 64 (src1 * bot src2)) + | WT -> top32 (cast signed 64 (src1 * top src2)) in let result = let open Exp in match accum, hiaccum with | None, None -> result - | Some a, None -> result + cast Cast.signed 64 (exp_of_op a) + | Some a, None -> result + cast signed 64 (exp_of_op a) | Some a, Some hia -> result + concat (exp_of_op hia) (exp_of_op a) | _ -> fail _here_ "Cannot specify only a hi accumulator" in let qflag = diff --git a/lib/bap_disasm/bap_disasm_arm_shift.ml b/lib/bap_disasm/bap_disasm_arm_shift.ml index 607bd13fd..e733535c6 100644 --- a/lib/bap_disasm/bap_disasm_arm_shift.ml +++ b/lib/bap_disasm/bap_disasm_arm_shift.ml @@ -24,7 +24,7 @@ let shift_of_word op = match Word.to_int op with let shift_c ~src shift_type ~shift t = let bits = bitlen t in let bits_e = Exp.int (Word.of_int bits ~width:bits) in - let nth_bit n e = Exp.(cast Cast.low 1 (e lsr n)) in + let nth_bit n e = Exp.(cast low 1 (e lsr n)) in let e1 = Exp.int (Word.one bits) in match shift_type with | `ASR -> @@ -49,7 +49,7 @@ let shift_c ~src shift_type ~shift t = shifted, carry | `RRX -> let ret1 = Exp.(src lsr e1) in - let carryin = Exp.(cast Cast.unsigned bits (var Env.cf) lsl (bits_e - e1)) in + let carryin = Exp.(cast unsigned bits (var Env.cf) lsl (bits_e - e1)) in let shifted = Exp.(ret1 lor carryin) in let carry = nth_bit Exp.(int (Word.zero 0)) src in shifted, carry @@ -65,9 +65,11 @@ let i_shift ~src shift_type t = let three = Word.of_int 3 ~width in (* lower three bits are type*) let r = - Word.Int.(!$shift_type land !$mask) >>| shift_of_word >>= fun shift_t -> + Word.Int_err.(!$shift_type land !$mask) >>| shift_of_word >>= + fun shift_t -> (* other bits are immediate *) - Word.Int.((!$shift_type land (lnot !$mask)) lsr !$three) >>= fun shift_amt -> + Word.Int_err.((!$shift_type land (lnot !$mask)) lsr !$three) >>= + fun shift_amt -> return (shift_t, shift_amt) in match r with | Error err -> fail _here_ "%s" Error.(to_string_hum err) @@ -89,12 +91,13 @@ let mem_shift ~src shift typ = let word = Word.of_int ~width in let wordm n = Ok (word n) in let shift_typ w = - Word.Int.((!$w land wordm 0xE000) lsr wordm 13) >>| shift_of_word in + Word.Int_err.((!$w land wordm 0xE000) lsr wordm 13) >>| + shift_of_word in (* Gets the shift amount from the immediate *) - let shift_amt w = Word.Int.(!$w land wordm 0xFFF) >>| Exp.int in + let shift_amt w = Word.Int_err.(!$w land wordm 0xFFF) >>| Exp.int in (* Converts the shift to a negative if the negative bit is set *) let to_neg w exp = - if Word.Int.(wordm 0x1000 land !$w = wordm 0x1000) then + if Word.Int_err.(wordm 0x1000 land !$w = wordm 0x1000) then Exp.(int (Word.ones width) * exp) else exp in diff --git a/lib/bap_disasm/bap_disasm_arm_utils.ml b/lib/bap_disasm/bap_disasm_arm_utils.ml index b4323c235..8aef73a94 100644 --- a/lib/bap_disasm/bap_disasm_arm_utils.ml +++ b/lib/bap_disasm/bap_disasm_arm_utils.ml @@ -81,12 +81,12 @@ let exp_of_op = function | Op.Imm word -> Exp.int word let cast_type = function - | Signed -> Exp.Cast.signed - | Unsigned -> Exp.Cast.unsigned + | Signed -> Exp.signed + | Unsigned -> Exp.unsigned let cast_of_sign sign size exp = Exp.cast (cast_type sign) size exp -let msb r = Exp.(cast Cast.high 1 r) +let msb r = Exp.(cast high 1 r) let zero ty = Exp.int (Word.zero (bitlen ty)) diff --git a/lib/bap_disasm/bap_disasm_basic.ml b/lib/bap_disasm/bap_disasm_basic.ml index ddd00228f..5b5bf263d 100644 --- a/lib/bap_disasm/bap_disasm_basic.ml +++ b/lib/bap_disasm/bap_disasm_basic.ml @@ -137,7 +137,7 @@ module Imm = struct let to_word t ~width = let n = to_int64 t in - match Word.bitsub ~hi:(width-1) (Word.of_int64 n) with + match Word.extract ~hi:(width-1) (Word.of_int64 n) with | Ok word -> Some word | Error _ -> None diff --git a/lib/bap_disasm/bap_disasm_insn.ml b/lib/bap_disasm/bap_disasm_insn.ml index 7b7fdab28..a9a837de9 100644 --- a/lib/bap_disasm/bap_disasm_insn.ml +++ b/lib/bap_disasm/bap_disasm_insn.ml @@ -4,12 +4,21 @@ open Bap_disasm_types module Insn = Bap_disasm_basic.Insn + type t = { code : int; name : string; asm : string; bil : bil; ops : Op.t array; + is_jump : bool; + is_conditional_jump : bool; + is_indirect_jump : bool; + is_call : bool; + is_return : bool; + may_affect_control_flow : bool; + may_load : bool; + may_store : bool; } with bin_io, fields, sexp type op = Op.t with bin_io, compare, sexp @@ -22,13 +31,58 @@ let normalize_asm asm = String.substr_replace_all asm ~pattern:"\t" ~with_:" " |> String.strip -let of_basic ?bil insn = { - code = Insn.code insn; - name = Insn.name insn; - asm = normalize_asm (Insn.asm insn); - bil = Option.value bil ~default:[]; - ops = Insn.ops insn; -} +let lookup_jumps bil = (object + inherit [kind list] Bil.visitor + method! enter_jmp ex _ = + match ex with + | Bil.Int _ when under_condition -> [`Conditional_branch] + | Bil.Int _ -> [`Unconditional_branch] + | _ when under_condition -> [`Conditional_branch; `Indirect_branch] + | _ -> [`Indirect_branch] +end)#run bil [] + +let lookup_side_effects bil = (object + inherit [kind list] Bil.visitor + method! enter_store ~dst:_ ~addr:_ ~src:_ _ _ acc = + `May_store :: acc + method! enter_load ~src:_ ~addr:_ _ _ acc = + `May_load :: acc +end)#run bil [] + +let of_basic ?bil insn = + let bil_kinds = match bil with + | Some bil -> lookup_jumps bil @ lookup_side_effects bil + | None -> [] in + let is = Insn.is insn in + let is_bil kind = + if bil <> None then List.mem bil_kinds kind else is kind in + let is_conditional_jump = is_bil `Conditional_branch in + let is_jump = is_conditional_jump || is_bil `Unconditional_branch in + let is_indirect_jump = is_bil `Indirect_branch in + let is_return = is `Return in + let is_call = is `Call in + let may_affect_control_flow = is `May_affect_control_flow in + let may_load = is_bil `May_load in + let may_store = is_bil `May_store in + { + code = Insn.code insn; + name = Insn.name insn; + asm = normalize_asm (Insn.asm insn); + bil = Option.value bil ~default:[]; + ops = Insn.ops insn; + is_jump; + is_conditional_jump; + is_indirect_jump; + is_call; + is_return; + may_affect_control_flow; + may_load; + may_store; + } + +let has_side_effect insn = may_store insn || may_load insn +let is_unconditional_jump insn = + is_jump insn || not (is_conditional_jump insn) let of_decoded = function | _, Some insn, bil -> Some (of_basic ?bil insn) diff --git a/lib/bap_disasm/bap_disasm_insn.mli b/lib/bap_disasm/bap_disasm_insn.mli index b0dfefeab..79a403c4e 100644 --- a/lib/bap_disasm/bap_disasm_insn.mli +++ b/lib/bap_disasm/bap_disasm_insn.mli @@ -29,6 +29,40 @@ val bil : t -> bil (** instruction operands *) val ops : t -> op array +(** {3 Instruction predicates} *) + +(** [is_jump] [true] for all jumps *) +val is_jump : t -> bool + +(** [is_conditional] [true] for conditional jumps *) +val is_conditional_jump : t -> bool + +(** [is_unconditional] iff [is_jump && not is_conditional_jump] *) +val is_unconditional_jump : t -> bool + +(** [is_indirect_jump] [true] if it is indirect *) +val is_indirect_jump : t -> bool + +(** [is_call] is [true] for all call instructions *) +val is_call : t -> bool + +(** [is_return] [true] for returns *) +val is_return : t -> bool + +(** [may_affect_control_flow] is true if it may affect control flow. + «may» stays for the fact, that it «may not» affect. +*) +val may_affect_control_flow : t -> bool + +(** [has_side_effect] is [true] if instruction may load or store *) +val has_side_effect : t -> bool + +(** [may_load] is true if instruction may load data from memory *) +val may_load : t -> bool + +(** [may_store] is true if instruction may store data to memory *) +val may_store : t -> bool + (** {3 Creating} The following functions will create [insn] instances from a lower level representation. diff --git a/lib/bap_image/bap_memory.ml b/lib/bap_image/bap_memory.ml index e96a04246..a60367cdf 100644 --- a/lib/bap_image/bap_memory.ml +++ b/lib/bap_image/bap_memory.ml @@ -70,7 +70,7 @@ let create_getters endian addr off size data = inj r in let safe ~pos_ref : word or_error = - Addr.Int.(!$(!pos_ref) - !$addr) >>= fun addr -> + Addr.Int_err.(!$(!pos_ref) - !$addr) >>= fun addr -> Addr.(to_int (addr ++ off)) >>= fun pos -> if pos < off then errorf "segfault: addr < min_addr" else @@ -212,13 +212,13 @@ let sub copy ?(word_size=`r8) ?from ?words t : t or_error = let amin = Option.value from ~default:(min_addr t) in let amax = Option.map words - ~f:(fun w -> Addr.(amin ++ (w * Size.to_bytes word_size - 1))) |> + ~f:(fun w -> Addr.(amin ++ Int.(w * Size.to_bytes word_size - 1))) |> Option.value ~default:(max_addr t) in Validate.(result @@ name "view must not be empty" @@ Addr.validate_lbound amax ~min:(Incl amin)) >>= fun () -> - Addr.Int.(!$amax - !$amin >>= Addr.to_int) >>= fun diff -> + Addr.Int_err.(!$amax - !$amin >>= Addr.to_int) >>= fun diff -> let size = diff + 1 in - Addr.Int.(!$amin - !$(t.addr) >>= Addr.to_int) >>= fun off -> + Addr.Int_err.(!$amin - !$(t.addr) >>= Addr.to_int) >>= fun off -> let off = t.off + off in let check_preconditions = Validate.(name_list "preconditions" [ name "offset in bounds" @@ Int.validate_bound off @@ -240,7 +240,7 @@ let view = sub ident let copy = sub Bigstring.subo let range mem a1 a2 = - Addr.Int.(!$a2 - !$a1) >>= Addr.to_int >>= fun bytes -> + Addr.Int_err.(!$a2 - !$a1) >>= Addr.to_int >>= fun bytes -> view ~from:a1 ~words:(bytes + 1) mem let to_buffer {data; off; size} = diff --git a/lib/bap_image/image_elf.ml b/lib/bap_image/image_elf.ml index b3aeb16b0..81bbb0815 100644 --- a/lib/bap_image/image_elf.ml +++ b/lib/bap_image/image_elf.ml @@ -58,7 +58,7 @@ let create_symtab data endian elf = let size = match Dwarf.Fn.pc_hi fn with | None -> return None | Some pc_hi -> - Addr.Int.(!$pc_hi - !$pc_lo) >>= Addr.to_int >>| fun size -> + Addr.Int_err.(!$pc_hi - !$pc_lo) >>= Addr.to_int >>| fun size -> Some size in size >>= fun size -> let location = Location.({ diff --git a/lib/bap_types/bap_addr.ml b/lib/bap_types/bap_addr.ml index 326d64573..e87fe7528 100644 --- a/lib/bap_types/bap_addr.ml +++ b/lib/bap_types/bap_addr.ml @@ -4,7 +4,8 @@ open Bap_common let memref ?(disp=0) ?(index=0) ?(scale=`r8) addr = let n = Bap_size.to_bytes scale in - Bap_bitvector.(addr ++ (n * index + disp)) + let off = n * index + disp in + Bap_bitvector.(addr ++ off) module type Arith = sig include Integer @@ -32,7 +33,7 @@ module Make(Int : Core_int) = struct let width = Int.num_bits in let x = Int.to_bv x in let w = Bitvector.of_int width ~width in - match Bitvector.(Int.(!$x mod !$w) >>= to_int) with + match Bitvector.(Int_err.(!$x mod !$w) >>= to_int) with | Error _ -> assert false | Ok x -> x diff --git a/lib/bap_types/bap_bil.ml b/lib/bap_types/bap_bil.ml index 9c8dd509f..6d863d331 100644 --- a/lib/bap_types/bap_bil.ml +++ b/lib/bap_types/bap_bil.ml @@ -4,42 +4,96 @@ open Bap_common type var = Bap_var.t with bin_io, compare, sexp +(** Different forms of casting *) +module Cast = struct + type cast = + | UNSIGNED (** 0-padding widening cast. *) + | SIGNED (** Sign-extending widening cast. *) + | HIGH (** Narrowning cast. Keeps the high bits. *) + | LOW (** Narrowing cast. Keeps the low bits. *) + with bin_io, compare, sexp +end + +type cast = Cast.cast +with bin_io, compare, sexp + +(** Binary operations implemented in the IR *) +module Binop = struct + type binop = + | PLUS (** Integer addition. (commutative, associative) *) + | MINUS (** Subtract second integer from first. *) + | TIMES (** Integer multiplication. (commutative, associative) *) + | DIVIDE (** Unsigned integer division. *) + | SDIVIDE (** Signed integer division. *) + | MOD (** Unsigned modulus. *) + | SMOD (** Signed modulus. *) + | LSHIFT (** Left shift. *) + | RSHIFT (** Right shift, fill with 0. *) + | ARSHIFT (** Right shift, sign extend. *) + | AND (** Bitwise and. (commutative, associative) *) + | OR (** Bitwise or. (commutative, associative) *) + | XOR (** Bitwise xor. (commutative, associative) *) + | EQ (** Equals. (commutative) (associative on booleans) *) + | NEQ (** Not equals. (commutative) (associative on booleans) *) + | LT (** Unsigned less than. *) + | LE (** Unsigned less than or equal to. *) + | SLT (** Signed less than. *) + | SLE (** Signed less than or equal to. *) + with bin_io, compare, sexp +end + +type binop = Binop.binop +with bin_io, compare, sexp + + +(** Unary operations implemented in the IR *) +module Unop = struct + type unop = + | NEG (** Negate. (2's complement) *) + | NOT (** Bitwise not. *) + with bin_io, compare, sexp +end + +type unop = Unop.unop +with bin_io, compare, sexp + module Exp = struct - type t = + type exp = (** Load (mem, idx, endian, size) *) - | Load of t * t * endian * size + | Load of exp * exp * endian * size (** Store (mem, idx, val, endian, size) *) - | Store of t * t * t * endian * size - | BinOp of binop * t * t - | UnOp of unop * t + | Store of exp * exp * exp * endian * size + | BinOp of binop * exp * exp + | UnOp of unop * exp | Var of var | Int of word (** Cast to a new type *) - | Cast of cast * nat1 * t - | Let of var * t * t + | Cast of cast * nat1 * exp + | Let of var * exp * exp | Unknown of string * typ - | Ite of t * t * t + | Ite of exp * exp * exp (** Extract hbits to lbits of e (Reg type) *) - | Extract of nat1 * nat1 * t + | Extract of nat1 * nat1 * exp (** Concat two reg expressions together *) - | Concat of t * t - with bin_io, compare, sexp, variants + | Concat of exp * exp + with bin_io, compare, sexp end -type exp = Exp.t with bin_io, compare, sexp +type exp = Exp.exp with bin_io, compare, sexp module Stmt = struct - type t = + type stmt = (** Assign the value on the right to the var on the left *) | Move of var * exp (** Jump to a address *) | Jmp of exp (** Statement with semantics not expressible in BIL *) | Special of string - | While of exp * t list - | If of exp * t list * t list + | While of exp * stmt list + | If of exp * stmt list * stmt list | CpuExn of int - with bin_io, compare, sexp, variants + with bin_io, compare, sexp end -type stmt = Stmt.t with bin_io, compare, sexp +type stmt = Stmt.stmt with bin_io, compare, sexp +type bil = stmt list with bin_io, compare, sexp diff --git a/lib/bap_types/bap_bitvector.ml b/lib/bap_types/bap_bitvector.ml index 82b9665e7..7c7a97b20 100644 --- a/lib/bap_types/bap_bitvector.ml +++ b/lib/bap_types/bap_bitvector.ml @@ -51,7 +51,7 @@ module type Kernel = sig val lift2 : (bignum -> bignum -> bignum) -> t -> t -> t val unop : (bignum -> 'a) -> t -> 'a val binop : (bignum -> bignum -> 'a) -> t -> t -> 'a - val bitsub : ?hi:int -> ?lo:int -> t -> t Or_error.t + val extract : ?hi:int -> ?lo:int -> t -> t Or_error.t val bitwidth : t -> int val bits_of_z : t -> string val compare : t -> t -> int @@ -120,7 +120,7 @@ module Make(Size : Compare) : Kernel = struct let with_validation t ~f = Or_error.map ~f (Validate.result t) - let bitsub ?hi ?(lo=0) t = + let extract ?hi ?(lo=0) t = let n = bitwidth t in let hi = Option.value ~default:(n-1) hi in let extract = if t.signed then @@ -128,13 +128,13 @@ module Make(Size : Compare) : Kernel = struct Bignum.extract in let do_extract () = let len = hi-lo+1 in - create (extract t.z lo len) len in + let z = if t.signed then signed_z t else t.z in + create (extract z lo len) len in with_validation ~f:do_extract - Validate.(name_list "bitsub" [ + Validate.(name_list "extract" [ name "(hi >= 0)" @@ Int.validate_non_negative hi; name "(lo >= 0)" @@ Int.validate_non_negative lo; - name "(hi > lo)" @@ Int.validate_positive (hi - lo); - name "(hi < width)" @@ Int.validate_positive (n - hi); + name "(hi > lo)" @@ Int.validate_non_negative (hi - lo); ]) end @@ -154,17 +154,19 @@ end module T = Make(Size_poly) include T -let b0 = create (Bignum.of_int 0) 1 -let b1 = create (Bignum.of_int 1) 1 -let of_bool v = if v then b1 else b0 - -let of_int32 ?(width=32) n = create (Bignum.of_int32 n) width -let of_int64 ?(width=64) n = create (Bignum.of_int64 n) width -let of_int ~width v = create (Bignum.of_int v) width -let ones n = of_int (-1) ~width:n -let zeros n = of_int (0) ~width:n -let zero n = of_int 0 ~width:n -let one n = of_int 1 ~width:n +module Cons = struct + let b0 = create (Bignum.of_int 0) 1 + let b1 = create (Bignum.of_int 1) 1 + let of_bool v = if v then b1 else b0 + let of_int32 ?(width=32) n = create (Bignum.of_int32 n) width + let of_int64 ?(width=64) n = create (Bignum.of_int64 n) width + let of_int ~width v = create (Bignum.of_int v) width + let ones n = of_int (-1) ~width:n + let zeros n = of_int (0) ~width:n + let zero n = of_int 0 ~width:n + let one n = of_int 1 ~width:n +end +include Cons let safe f t = try_with (fun () -> f t) @@ -320,10 +322,11 @@ module Int_exn = struct include Bap_integer.Make(Base) end -let bitsub_exn ?hi ?lo z = - Or_error.ok_exn @@ bitsub ?hi ?lo z +let extract_exn ?hi ?lo z = + Or_error.ok_exn @@ extract ?hi ?lo z let is_zero = unop Bignum.(equal zero) +let is_one = unop Bignum.(equal one) let is_positive = unop Bignum.(fun z -> gt z zero) let is_non_positive = Fn.non is_positive let is_negative = unop Bignum.(fun z -> lt z zero) @@ -383,4 +386,7 @@ module Mono = Comparable.Make(Make(Size_mono)) include Or_error.Monad_infix include Bap_regular.Make(T) -module Int = Safe +module Int_err = Safe +include (Int_exn : Bap_integer.S with type t := t) +let one = Cons.one +let zero = Cons.zero diff --git a/lib/bap_types/bap_bitvector.mli b/lib/bap_types/bap_bitvector.mli index 255ca5d6b..799abf7b3 100644 --- a/lib/bap_types/bap_bitvector.mli +++ b/lib/bap_types/bap_bitvector.mli @@ -132,6 +132,7 @@ with bin_io, compare, sexp include Bap_regular.S with type t := t include Comparable.With_zero with type t := t +include Bap_integer.S with type t := t (** {2 Container interfaces} Bitvector is also a container for bytes and bits. You can access @@ -200,32 +201,33 @@ val signed : t -> t (** [is_zero bv] is true iff all bits are set to zero. *) val is_zero : t -> bool +(** [is_ones bv] is true if the least significant bit is equal to one *) +val is_one : t -> bool + (** [bitwidth bv] return a bit-width, i.e., the amount of bits *) val bitwidth : t -> int -(** [bitsub bv ~signed ~hi ~lo] extracts a subvector from [bv], starting +(** [extract bv ~signed ~hi ~lo] extracts a subvector from [bv], starting from bit [hi] and ending with [lo]. Bits are enumerated from right to left (from least significant to most), starting from - zero. + zero. [hi] maybe greater then [size]. - [hi] defaults to [width bv] + [hi] defaults to [width bv - 1] [lo] defaults to [0]. - [signed] defaults to [false] Example: - [bitsub (of_int 17 ~width:8) ~hi:4 ~lo:3] - + [extract (of_int 17 ~width:8) ~hi:4 ~lo:3] will result in a two bit vector consisting of the forth and third bits, i.e., equal to a number [2]. - [lo] and [hi] should be non-negative numbers less then a - [width bv] and [hi > lo]. *) -val bitsub : ?hi:int -> ?lo:int -> t -> t Or_error.t + [lo] and [hi] should be non-negative numbers. [lo] must be less + then a [width bv] and [hi >= lo]. *) +val extract : ?hi:int -> ?lo:int -> t -> t Or_error.t -(** [bitsub_exn bv ~hi ~lo] is the same as [bitsub], but will raise +(** [extract_exn bv ~hi ~lo] is the same as [extract], but will raise an exception on error. *) -val bitsub_exn : ?hi:int -> ?lo:int -> t -> t +val extract_exn : ?hi:int -> ?lo:int -> t -> t (** [concat b1 b2] concatenates two bitvectors *) val concat : t -> t -> t @@ -286,7 +288,7 @@ val to_bits : t -> endian -> bool Sequence.t [Z.(!$v1 + !$v2 / !$v3)]. *) -module Int : sig +module Int_err : sig (** [!$v] lifts [v] to an Or_error monad. It is, essentially, the same as [Ok v] *) val (!$): t -> t Or_error.t diff --git a/lib/bap_types/bap_common.ml b/lib/bap_types/bap_common.ml index d60490ad3..6f926ff01 100644 --- a/lib/bap_types/bap_common.ml +++ b/lib/bap_types/bap_common.ml @@ -64,58 +64,6 @@ end type typ = Type.t with bin_io, compare, sexp -(** Different forms of casting *) -module Cast = struct - type t = - | UNSIGNED (** 0-padding widening cast. *) - | SIGNED (** Sign-extending widening cast. *) - | HIGH (** Narrowning cast. Keeps the high bits. *) - | LOW (** Narrowing cast. Keeps the low bits. *) - with bin_io, compare, sexp, variants -end - -type cast = Cast.t -with bin_io, compare, sexp - -(** Binary operations implemented in the IR *) -module Binop = struct - type t = - | PLUS (** Integer addition. (commutative, associative) *) - | MINUS (** Subtract second integer from first. *) - | TIMES (** Integer multiplication. (commutative, associative) *) - | DIVIDE (** Unsigned integer division. *) - | SDIVIDE (** Signed integer division. *) - | MOD (** Unsigned modulus. *) - | SMOD (** Signed modulus. *) - | LSHIFT (** Left shift. *) - | RSHIFT (** Right shift, fill with 0. *) - | ARSHIFT (** Right shift, sign extend. *) - | AND (** Bitwise and. (commutative, associative) *) - | OR (** Bitwise or. (commutative, associative) *) - | XOR (** Bitwise xor. (commutative, associative) *) - | EQ (** Equals. (commutative) (associative on booleans) *) - | NEQ (** Not equals. (commutative) (associative on booleans) *) - | LT (** Unsigned less than. *) - | LE (** Unsigned less than or equal to. *) - | SLT (** Signed less than. *) - | SLE (** Signed less than or equal to. *) - with bin_io, compare, sexp, variants -end - -type binop = Binop.t -with bin_io, compare, sexp - - -(** Unary operations implemented in the IR *) -module Unop = struct - type t = - | NEG (** Negate. (2's complement) *) - | NOT (** Bitwise not. *) - with bin_io, compare, sexp, variants -end - -type unop = Unop.t -with bin_io, compare, sexp (** Supported architectures *) module Arch = struct diff --git a/lib/bap_types/bap_exp.ml b/lib/bap_types/bap_exp.ml index 4bf8c8c20..1fefea049 100644 --- a/lib/bap_types/bap_exp.ml +++ b/lib/bap_types/bap_exp.ml @@ -1,15 +1,70 @@ open Core_kernel.Std open Bap_common -module Ops = struct - open Bap_bil +open Bap_bil + +type binop = exp -> exp -> exp +type unop = exp -> exp + +module Exp = struct + open Exp + let load ~mem ~addr e s = Load (mem,addr,e,s) + let store ~mem ~addr value e s = Store (mem,addr,value,e,s) + let binop op x y = BinOp (op,x,y) + let unop op x = UnOp (op,x) + let var v = Var v + let int w = Int w + let cast ct s e = Cast (ct,s,e) + let let_ v e b = Let (v,e,b) + let unknown s t = Unknown (s,t) + let ite ~if_ ~then_ ~else_ = Ite (if_,then_,else_) + let extract ~hi ~lo e = Extract (hi,lo,e) + let concat e1 e2 = Concat (e1,e2) +end +include Exp + +module Binop = struct + open Binop + let plus = PLUS + let minus = MINUS + let times = TIMES + let divide = DIVIDE + let sdivide = SDIVIDE + let modulo = MOD + let smodulo = SMOD + let lshift = LSHIFT + let rshift = RSHIFT + let arshift = ARSHIFT + let bit_and = AND + let bit_xor = XOR + let bit_or = OR + let eq = EQ + let neq = NEQ + let lt = LT + let le = LE + let slt = SLT + let sle = SLE +end + +module Unop = struct + open Unop + let neg = NEG + let not = NOT +end + +module Cast = struct + open Cast + let unsigned = UNSIGNED + let signed = SIGNED + let high = HIGH + let low = LOW +end +module Infix = struct open Bap_bil.Exp open Binop open Unop - type binop = exp -> exp -> exp - type unop = exp -> exp (** Arithmetic operations *) let ( + ) = binop plus @@ -17,17 +72,17 @@ module Ops = struct let ( * ) = binop times let ( / ) = binop divide let ( /$ ) = binop sdivide - let ( mod ) = binop (mod) - let ( %$ ) = binop smod + let ( mod ) = binop modulo + let ( %$ ) = binop smodulo (** Bit operations *) let ( lsl ) = binop lshift let ( lsr ) = binop rshift let ( asr ) = binop arshift - let ( land ) a b = binop AND a b - let ( lor ) a b = binop OR a b - let ( lxor ) a b = binop XOR a b - let lnot a = unop NOT a + let ( land ) a b = binop bit_and a b + let ( lor ) a b = binop bit_or a b + let ( lxor ) a b = binop bit_xor a b + let lnot a = unop not a (** Equality tests *) let ( = ) a b = binop eq a b @@ -47,6 +102,7 @@ end module PP = struct open Format + open Bap_bil let pp_cast fmt cst = fprintf fmt "%s" (match cst with @@ -80,15 +136,13 @@ module PP = struct let pp_unop fmt op = fprintf fmt "%s" Unop.(match op with | NEG -> "-" - | NOT -> "lnot") + | NOT -> "~") let pp_edn fmt e = fprintf fmt "%s" Bap_bil.(match e with | LittleEndian -> "el" | BigEndian -> "be") - - let rec pp fmt exp = let open Bap_bil.Exp in let is_imm = function @@ -101,7 +155,7 @@ module PP = struct | Load (mem, idx, edn, s) -> pr "%a[%a, %a]:%a" pp mem pp idx pp_edn edn Bap_size.pp s | Store (mem, idx, exp, edn, s) -> - pr "@[%a with[%a, %a]:%a <- %a@]" + pr "@[%a with [%a, %a]:%a <- %a@]" pp mem pp idx pp_edn edn Bap_size.pp s pp exp | Ite (ce, te, fe) -> pr "@[if %a@;then %a@;else %a@]" pp ce pp te pp fe @@ -124,10 +178,8 @@ module PP = struct end include Regular.Make(struct - include Bap_bil.Exp + type t = Bap_bil.exp with bin_io, compare, sexp let hash = Hashtbl.hash let module_name = "Bap_exp" let pp = PP.pp end) - -include Ops diff --git a/lib/bap_types/bap_exp.mli b/lib/bap_types/bap_exp.mli index 47c710fdd..092026944 100644 --- a/lib/bap_types/bap_exp.mli +++ b/lib/bap_types/bap_exp.mli @@ -5,39 +5,87 @@ open Bap_bil include Regular with type t := exp -type binop = exp -> exp -> exp -type unop = exp -> exp - -(** Arithmetic operations *) -val ( + ) : binop -val ( - ) : binop -val ( * ) : binop -val ( / ) : binop -val ( /$ ) : binop -val ( mod ) : binop -val ( %$ ) : binop - -(** Bit operations *) -val ( lsl ) : binop -val ( lsr ) : binop -val ( asr ) : binop -val ( land) : binop -val ( lor ) : binop -val ( lxor) : binop -val lnot : unop - -(** Equality tests *) -val ( = ) : binop -val ( <> ) : binop -val ( < ) : binop -val ( > ) : binop -val ( <= ) : binop -val ( >= ) : binop -val ( <$ ) : binop -val ( >$ ) : binop -val ( <=$ ) : binop -val ( >=$ ) : binop - -(** Misc operations *) -(** [a ^ b] contatenate [a] and [b] *) -val ( ^ ) : binop +module Cast : sig + val unsigned : cast + val signed : cast + val high : cast + val low : cast +end + +module Binop : sig + val plus : binop + val minus : binop + val times : binop + val divide : binop + val sdivide : binop + val modulo : binop + val smodulo : binop + val lshift : binop + val rshift : binop + val arshift : binop + val bit_and : binop + val bit_or : binop + val bit_xor : binop + val eq : binop + val neq : binop + val lt : binop + val le : binop + val slt : binop + val sle : binop +end + +module Unop : sig + val neg : unop + val not : unop +end + +module Exp : sig + val load : mem:exp -> addr:exp -> endian -> size -> exp + val store : mem:exp -> addr:exp -> exp -> endian -> size -> exp + val binop : binop -> exp -> exp -> exp + val unop : unop -> exp -> exp + val var : var -> exp + val int : Bitvector.t -> exp + val cast : cast -> nat1 -> exp -> exp + val let_ : var -> exp -> exp -> exp + val unknown : string -> typ -> exp + val ite : if_:exp -> then_:exp -> else_:exp -> exp + val extract : hi:nat1 -> lo:nat1 -> exp -> exp + val concat : exp -> exp -> exp +end + +module Infix : sig + (** Arithmetic operations *) + val ( + ) : exp -> exp -> exp + val ( - ) : exp -> exp -> exp + val ( * ) : exp -> exp -> exp + val ( / ) : exp -> exp -> exp + val ( /$ ) : exp -> exp -> exp + val ( mod ) : exp -> exp -> exp + val ( %$ ) : exp -> exp -> exp + + (** Bit operations *) + val ( lsl ) : exp -> exp -> exp + val ( lsr ) : exp -> exp -> exp + val ( asr ) : exp -> exp -> exp + val ( land) : exp -> exp -> exp + val ( lor ) : exp -> exp -> exp + val ( lxor) : exp -> exp -> exp + val lnot : exp -> exp + + (** Equality tests *) + val ( = ) : exp -> exp -> exp + val ( <> ) : exp -> exp -> exp + val ( < ) : exp -> exp -> exp + val ( > ) : exp -> exp -> exp + val ( <= ) : exp -> exp -> exp + val ( >= ) : exp -> exp -> exp + val ( <$ ) : exp -> exp -> exp + val ( >$ ) : exp -> exp -> exp + val ( <=$ ) : exp -> exp -> exp + val ( >=$ ) : exp -> exp -> exp + + (** Misc operations *) + (** [a ^ b] contatenate [a] and [b] *) + val ( ^ ) : exp -> exp -> exp +end diff --git a/lib/bap_types/bap_helpers.ml b/lib/bap_types/bap_helpers.ml new file mode 100644 index 000000000..875d37085 --- /dev/null +++ b/lib/bap_types/bap_helpers.ml @@ -0,0 +1,192 @@ +open Core_kernel.Std +open Bap_common +open Bap_bil +open Bap_visitor + +module Word = Bitvector + +let find_map (finder : 'a #finder) ss : 'a option = finder#find ss +let find finder ss = finder#find ss = Some () +let iter (visitor : unit #visitor) ss = visitor#run ss () + +let is_assigned ?(strict=false) x = find (object(self) + inherit [unit] finder + method! enter_move y _ cc = + if Bap_var.(x = y) && not(strict && under_condition) + then cc.return (Some ()); + cc + end) + +let is_referenced x = find (object(self) + inherit [unit] finder + method! enter_var y cc = + if Bap_var.(x = y) then cc.return (Some ()); cc + end) + +let is_modified x = find (object inherit [unit] finder + method! enter_move y _ ctrl = + if Bap_var.(x = y) then ctrl.return (Some ()); + ctrl + end) + +let prune_unreferenced stmt = + let rec loop ss = function + | [] -> List.rev ss + | Stmt.Move (x,_) as s :: xs when Bap_var.is_tmp x -> + if is_referenced x xs then loop (s::ss) xs else loop ss xs + | s :: xs -> loop (s::ss) xs in + loop [] stmt + +let normalize_negatives = (object inherit mapper as super + method! map_binop op e1 e2 = match op,e2 with + | Binop.PLUS, Exp.Int arg + when Word.(is_negative (signed arg)) -> + let (-) = Bap_exp.Infix.(-) in + (e1 - Exp.Int Word.(abs (signed arg))) + | _ -> super#map_binop op e1 e2 +end)#run + + +include struct + open Exp + class constant_folder = + object inherit mapper as super + method! map_binop op e1 e2 = + let open Binop in + let zero v1 v2 = match v1,v2 with + | Var v,_ | _, Var v -> begin match Bap_var.typ v with + | Type.Imm width -> Int (Word.zero width) + | Type.Mem _ -> super#map_binop op e1 e2 + end + | _ -> super#map_binop op e1 e2 in + match op, e1, e2 with + | op, Int v1, Int v2 -> + let open Bap_exp.Exp in + let signed = Word.signed in + let bool v = int (Word.of_bool v) in + let open Word.Mono in + Word.Int_exn.(match op with + | PLUS -> int (v1 + v2) + | MINUS -> int (v1 - v2) + | TIMES -> int (v1 * v2) + | DIVIDE -> int (v1 / v2) + | SDIVIDE -> int (signed v1 / signed v2) + | MOD -> int (v1 mod v2) + | SMOD -> int (signed v1 mod signed v2) + | LSHIFT -> int (v1 lsl v2) + | RSHIFT -> int (v1 lsr v2) + | ARSHIFT -> int (v1 asr v2) + | AND -> int (v1 land v2) + | OR -> int (v1 lor v2) + | XOR -> int (v1 lxor v2) + | EQ -> bool (v1 = v2) + | NEQ -> bool (v1 <> v2) + | LT -> bool (v1 < v2) + | LE -> bool (v1 <= v2) + | SLT -> bool (signed v1 <= signed v2) + | SLE -> bool (signed v1 <= signed v2)) + | (PLUS|LSHIFT|RSHIFT|ARSHIFT|OR|XOR), Int v, e + | (PLUS|MINUS|LSHIFT|RSHIFT|ARSHIFT|OR|XOR), e, Int v + when Word.is_zero v -> e + | TIMES,e,Int v | TIMES, Int v, e when Word.is_one v -> e + | (TIMES|AND), e, Int v + | (TIMES|AND), Int v, e when Word.is_zero v -> Int v + | (OR|AND), v1, v2 when compare_exp v1 v2 = 0 -> v1 + | (XOR), v1, v2 when compare_exp v1 v2 = 0 -> zero v1 v2 + | _ -> super#map_binop op e1 e2 + + method! map_unop op arg = match arg with + | Int v -> Unop.(match op with + | NEG -> Int Word.(neg v) + | NOT -> Int Word.(lnot v)) + | _ -> super#map_unop op arg + + method! map_cast kind size arg = + let cast kind v = + let open Cast in match kind with + | UNSIGNED -> Word.extract_exn ~hi:(size - 1) v + | SIGNED -> Word.extract_exn ~hi:(size - 1) (Word.signed v) + | HIGH -> Word.extract_exn ~lo:(Word.bitwidth v - size) v + | LOW -> Word.extract_exn ~hi:(size - 1) v in + match arg with + | Int v -> Int (cast kind v) + | _ -> super#map_cast kind size arg + + method! map_let var ~exp ~body = + match exp with + | Int v -> + (object inherit mapper + method! map_var z = + if Bap_var.(z = var) then exp else (Exp.Var z) + end)#map_exp body + | _ -> super#map_let var ~exp ~body + + method! map_ite ~cond ~yes ~no = + match cond with + | Int v -> if Word.is_zero v then no else yes + | _ -> super#map_ite ~cond ~yes ~no + + method! map_extract ~hi ~lo = function + | Int v -> Int (Word.extract_exn ~hi ~lo v) + | e -> super#map_extract ~hi ~lo e + + method! map_concat e1 e2 = match e1,e2 with + | Int v1, Int v2 -> Int (Word.concat v1 v2) + | _ -> super#map_concat e1 e2 + + method! map_if ~cond ~yes ~no = match cond with + | Int v -> if Word.is_zero v then no else yes + | _ -> super#map_if ~cond ~yes ~no + + method! map_while ~cond bil = match cond with + | Int v -> if Word.is_zero v then [] else bil + | _ -> super#map_while ~cond bil + + end +end +let fold_consts = (new constant_folder)#run + + +let connection_point (next : 'a -> 'a option) x : 'a option = + let collision_point init = + let rec loop slow = function + | None -> None + | Some fast when phys_equal slow fast -> Some fast + | Some fast -> match next slow with + | None -> assert false + | Some slow -> match next fast with + | None -> None + | Some fast -> loop slow (next fast) in + loop init (next init) in + let convergent_point x y = + let next p = match next p with + | None -> invalid_arg "transformation has terminated" + | Some p -> p in + let rec loop x y = + if phys_equal x y then x else loop (next x) (next y) in + loop x y in + match collision_point x with + | None -> None + | Some p -> match next p with + | None -> Some p + | Some p -> Some (convergent_point x p) + +(* later we can provide a hashconsing, but for now a simple + but safe implementation. + The algorithm is adopted from A. Stepanov and P. McJones + collision point algorithm [ISBN-10: 0-321-63537-X]. +*) +let fix compare f x = + let rec loop slow fast = + if compare slow fast = 0 then fast + else + let fast' = f fast in + if compare fast' fast = 0 then fast + else loop (f slow) (f fast) in + loop x (f x) + +let fixpoint = fix compare_bil + +let substitute x y = (object inherit mapper + method! map_exp z = if Bap_exp.(x = z) then y else z +end)#run diff --git a/lib/bap_types/bap_helpers.mli b/lib/bap_types/bap_helpers.mli new file mode 100644 index 000000000..03f73eba4 --- /dev/null +++ b/lib/bap_types/bap_helpers.mli @@ -0,0 +1,46 @@ +open Core_kernel.Std +open Bap_common +open Bap_bil +open Bap_visitor + +val find_map : 'a #finder -> bil -> 'a option +val find : unit #finder -> bil -> bool +val iter : unit #visitor -> bil -> unit + +(** [is_referenced x p] is [true] if [x] is referenced in some expression or + statement in program [p] *) +val is_referenced : var -> bil -> bool + +(** [is_modified x p] is [true] is [x] is assigned in [p] *) +val is_modified : var -> bil -> bool + +(** [is_assigned x p] is [true] if there exists such [Move] + statement, that [x] occures on the left side of it. If [strict] + is true, then only unconditional assignments. By default, + [strict] is [false] *) +val is_assigned : ?strict:bool -> var -> bil -> bool + +(** [prune_unreferenced p] remove all assignments to variables that + are not used in the program [p] *) +val prune_unreferenced : bil -> bil + +(** [normalize_negatives p] transform [x + y] to [x - abs(y)] if [y < 0] *) +val normalize_negatives : bil -> bil + +(** [substitute x y p] substitutes each occurrence of expression [x] by + expression [y] in program [p] *) +val substitute : exp -> exp -> bil -> bil + +(** [fold_consts] evaluate constant expressions. + Note: this function performs only one step, and has no loops, + it is supposed to be run using a fixpoint combinator. +*) +val fold_consts : bil -> bil + +(** [constant_folder] is a class that implements the [fold_consts] *) +class constant_folder : mapper + +(** [fixpoint f] applies transformation [f] until fixpoint is + reached. If the transformation orbit contains non-trivial + cycles, then a arbitrary point of cycle will be returned. *) +val fixpoint : (bil -> bil) -> (bil -> bil) diff --git a/lib/bap_types/bap_stmt.ml b/lib/bap_types/bap_stmt.ml index ae72fbd14..da87bc1b1 100644 --- a/lib/bap_types/bap_stmt.ml +++ b/lib/bap_types/bap_stmt.ml @@ -4,7 +4,7 @@ open Format let rec pp fmt s = let open Bap_bil.Stmt in match s with - | Move (var, exp) -> fprintf fmt "@[%a = %a@]" Bap_var.pp var Bap_exp.pp exp + | Move (var, exp) -> fprintf fmt "@[%a := %a@]" Bap_var.pp var Bap_exp.pp exp | Jmp exp -> fprintf fmt "jmp %a" Bap_exp.pp exp | Special s -> fprintf fmt "special (%s)" s | While (cond, body) -> @@ -28,9 +28,23 @@ and pp_else fmt = function let pp_stmts fmt ss = fprintf fmt "@[@[{@\n%a@]@\n}@]" pp_list ss +module Stmt = struct + open Bap_bil.Stmt + let move v x = Move (v,x) + let jmp x = Jmp x + let special s = Special s + let while_ x s1 = While (x,s1) + let if_ x s1 s2 = If (x,s1,s2) + let cpuexn n = CpuExn n +end + + +module Infix = struct + let (:=) v x = Bap_bil.Stmt.Move (v,x) +end include Regular.Make(struct - include Bap_bil.Stmt + type t = Bap_bil.stmt with bin_io, compare, sexp let hash = Hashtbl.hash let module_name = "Bap_stmt" let pp = pp diff --git a/lib/bap_types/bap_stmt.mli b/lib/bap_types/bap_stmt.mli index b68f07678..ef20b94d9 100644 --- a/lib/bap_types/bap_stmt.mli +++ b/lib/bap_types/bap_stmt.mli @@ -7,3 +7,16 @@ include Regular with type t := stmt (** [pp_stmts] pretty prints a sequence of statements. *) val pp_stmts : Format.formatter -> stmt list -> unit + +module Stmt : sig + val move : var -> exp -> stmt + val jmp : exp -> stmt + val special : string -> stmt + val while_ : exp -> stmt list -> stmt + val if_ : exp -> stmt list -> stmt list -> stmt + val cpuexn : int -> stmt +end + +module Infix : sig + val (:=) : var -> exp -> stmt +end diff --git a/lib/bap_types/bap_types.ml b/lib/bap_types/bap_types.ml index ade1d4140..91ed87f15 100644 --- a/lib/bap_types/bap_types.ml +++ b/lib/bap_types/bap_types.ml @@ -144,26 +144,56 @@ module Std = struct like [reg8_t], or [mem32_t]. Look at [Bap_type], for more. *) include Type.Export - - (** BIL expressions. *) - module Exp = struct - include Bap_bil.Exp - include Bap_exp - module Cast = Cast - module Binop = Binop - module Unop = Unop - end - (** Sizes of expression operands *) module Size = struct include Size include Bap_size end + (** BIL expressions. *) + module Exp = struct + type t = Bap_bil.exp with bin_io, compare, sexp + include Bap_bil.Cast + include Bap_bil.Binop + include Bap_bil.Unop + include Bap_bil.Exp + include Bap_bil.Stmt + include Bap_exp.Exp + include Bap_exp.Unop + include Bap_exp.Binop + include Bap_exp.Cast + include Bap_exp.Infix + module Unop = Bap_bil.Unop + module Binop = Bap_bil.Binop + module Cast = Bap_bil.Cast + end + (** Bil statements *) module Stmt = struct + type t = Bap_bil.stmt with bin_io, compare, sexp include Bap_bil.Stmt + include Bap_stmt.Stmt include Bap_stmt + include Bap_stmt.Infix + end + + module Bil = struct + type t = Bap_bil.bil with bin_io, compare, sexp + include Bap_exp + include Bap_bil.Cast + include Bap_bil.Binop + include Bap_bil.Unop + include Bap_bil.Exp + include Bap_bil.Stmt + include Bap_exp.Exp + include Bap_exp.Unop + include Bap_exp.Binop + include Bap_exp.Cast + include Bap_exp.Infix + include Bap_stmt.Stmt + include Bap_stmt.Infix + include Bap_helpers + include Bap_visitor end (** Bitvector is an ubiquitous module, that represents bitstrings and @@ -213,18 +243,20 @@ module Std = struct type nonrec addr_size = addr_size with bin_io, compare, sexp + type addr = Addr.t with bin_io, compare, sexp + type arch = Arch.t with bin_io, compare, sexp + type bil = Bap_bil.bil with bin_io, compare, sexp + type binop = Bil.binop with bin_io, compare, sexp + type cast = Bil.cast with bin_io, compare, sexp + type exp = Exp.t with bin_io, compare, sexp type size = Size.t with bin_io, compare, sexp + type stmt = Stmt.t with bin_io, compare, sexp type typ = Type.t with bin_io, compare, sexp + type unop = Bil.unop with bin_io, compare, sexp type var = Var.t with bin_io, compare, sexp - type stmt = Stmt.t with bin_io, compare, sexp - type exp = Exp.t with bin_io, compare, sexp - type bil = stmt list with bin_io, compare, sexp - type arch = Arch.t with bin_io, compare, sexp - type addr = Addr.t with bin_io, compare, sexp type word = Word.t with bin_io, compare, sexp - type cast = Exp.Cast.t with bin_io, compare, sexp - type unop = Exp.Unop.t with bin_io, compare, sexp - type binop = Exp.Binop.t with bin_io, compare, sexp + + class ['a] bil_visitor = ['a] Bap_visitor.visitor module Seq = struct diff --git a/lib/bap_types/bap_visitor.ml b/lib/bap_types/bap_visitor.ml new file mode 100644 index 000000000..e3bfe7686 --- /dev/null +++ b/lib/bap_types/bap_visitor.ml @@ -0,0 +1,288 @@ +open Core_kernel.Std +open Bap_common +open Bap_bil + + +type nat1 = int + +class state = object + val stmts_stack : stmt list = [] + val exps_stack : exp list = [] + val preds : stmt list = [] + val succs : stmt list = [] + val in_jmp = false + val in_move = false + val under_condition = false + val in_loop = false +end + +class ['a] visitor = object (self : 's) + inherit state + method run stmts x : 'a = match stmts with + | [] -> x + | s :: ss -> + {< succs = ss >}#visit_stmt s x |> + {< preds = s :: preds >}#run ss + + method enter_unop op _ x = x + method leave_unop op _ x = x + method visit_unop op e x = + self#enter_unop op e x |> + self#visit_exp e |> + self#leave_unop op e + + method enter_binop op e1 e2 x = x + method leave_binop op e1 e2 x = x + method visit_binop op e1 e2 x = + self#enter_binop op e1 e2 x |> + self#visit_exp e1 |> self#visit_exp e2 |> + self#leave_binop op e1 e2 + + method enter_store ~dst ~addr ~src e s x = x + method leave_store ~dst ~addr ~src e s x = x + method visit_store ~dst ~addr ~src e s x = + self#enter_store ~dst ~addr ~src e s x |> + self#visit_exp dst |> self#visit_exp addr |> self#visit_exp src |> + self#leave_store ~dst ~addr ~src e s + + method enter_load ~src ~addr _e _s x = x + method leave_load ~src ~addr _e _s x = x + method visit_load ~src ~addr _e _s x = + self#enter_load ~src ~addr _e _s x |> + self#visit_exp src |> self#visit_exp addr |> + self#leave_load ~src ~addr _e _s + + method enter_cast _ _ e x = x + method leave_cast _ _ e x = x + method visit_cast ct cs e x = + self#enter_cast ct cs e x |> self#visit_exp e |> + self#leave_cast ct cs e + + method enter_let v ~exp ~body x = x + method leave_let v ~exp ~body x = x + method visit_let v ~exp ~body x = + self#enter_let v ~exp ~body x |> + self#visit_var v |> + self#visit_exp exp |> self#visit_exp body |> + self#leave_let v ~exp ~body + + method enter_ite ~cond ~yes ~no x = x + method leave_ite ~cond ~yes ~no x = x + method visit_ite ~cond ~yes ~no x = + let x = self#enter_ite ~cond ~yes ~no x |> + self#visit_exp cond in + let self = {< under_condition = true >} in + self#visit_exp yes x |> self#visit_exp no |> + self#leave_ite ~cond ~yes ~no + + method enter_extract ~hi ~lo e x = x + method leave_extract ~hi ~lo e x = x + method visit_extract ~hi ~lo e x = + self#enter_extract ~hi ~lo e x |> + self#visit_exp e |> + self#leave_extract ~hi ~lo e + + method enter_concat e1 e2 x = x + method leave_concat e1 e2 x = x + method visit_concat e1 e2 x = + self#enter_concat e1 e2 x |> + self#visit_exp e1 |> self#visit_exp e2 |> + self#leave_concat e1 e2 + + method enter_var v x = x + method leave_var v x = x + method visit_var v x = self#enter_var v x |> self#leave_var v + + method enter_int n x = x + method leave_int n x = x + method visit_int n x = + self#enter_int n x |> self#leave_int n + + method enter_unknown s t x = x + method leave_unknown s t x = x + method visit_unknown s t x = + self#enter_unknown s t x |> self#leave_unknown s t + + method enter_special s x = x + method leave_special s x = x + method visit_special s x = + self#enter_special s x |> self#leave_special s + + method enter_jmp e x = x + method leave_jmp e x = x + method visit_jmp e x = + self#enter_jmp e x |> + {< in_jmp = true >}#visit_exp e |> + self#leave_jmp e + + method enter_move v e x = x + method leave_move v e x = x + method visit_move v e x = + let x = self#enter_move v e x in + let self = {< in_move = true >} in + self#visit_var v x |> self#visit_exp e |> + self#leave_move v e + + method enter_while ~cond ss x = x + method leave_while ~cond ss x = x + method visit_while ~cond ss x = + let x = self#enter_while ~cond ss x |> + self#visit_exp cond in + let self = {< under_condition = true; + in_loop = true >} in + self#run ss x |> + self#leave_while ~cond ss + + method enter_if ~cond ~yes ~no x = x + method leave_if ~cond ~yes ~no x = x + method visit_if ~cond ~yes ~no x = + let x = self#enter_if ~cond ~yes ~no x |> + self#visit_exp cond in + let self = {< under_condition = true >} in + self#run yes x |> self#run no |> + self#leave_if ~cond ~yes ~no + + method enter_cpuexn n x = x + method leave_cpuexn n x = x + method visit_cpuexn n x = + self#enter_cpuexn n x |> self#leave_cpuexn n + + method enter_exp e x = x + method leave_exp e x = x + method visit_exp e x : 'a = + let x = self#enter_exp e x in + let self = {< exps_stack = e :: exps_stack >} in + let x = match e with + | Exp.Int v -> self#visit_int v x + | Exp.UnOp (op,e) -> self#visit_unop op e x + | Exp.BinOp (op,e1,e2) -> self#visit_binop op e1 e2 x + | Exp.Store (dst,addr,src,e,s) -> self#visit_store ~dst ~addr ~src e s x + | Exp.Load (src,addr,e,s) -> self#visit_load ~src ~addr e s x + | Exp.Cast (ct,sz,ex) -> self#visit_cast ct sz ex x + | Exp.Let (v,exp,body) -> self#visit_let v ~exp ~body x + | Exp.Ite (cond,yes,no) -> self#visit_ite ~cond ~yes ~no x + | Exp.Extract (hi,lo,e) -> self#visit_extract ~hi ~lo e x + | Exp.Concat (e1,e2) -> self#visit_concat e1 e2 x + | Exp.Var v -> self#visit_var v x + | Exp.Unknown (s,t) -> self#visit_unknown s t x in + self#leave_exp e x + + method enter_stmt stmt x = x + method leave_stmt stmt x = x + method visit_stmt stmt x = + let x = self#enter_stmt stmt x in + let self = {< stmts_stack = stmt :: stmts_stack >} in + let x = match stmt with + | Stmt.Move (var,exp) -> self#visit_move var exp x + | Stmt.Jmp exp -> self#visit_jmp exp x + | Stmt.Special s -> self#visit_special s x + | Stmt.While (cond,ss) -> self#visit_while ~cond ss x + | Stmt.If (cond,yes,no) -> self#visit_if ~cond ~yes ~no x + | Stmt.CpuExn n -> self#visit_cpuexn n x in + self#leave_stmt stmt x +end + +exception Found + +class ['a] finder = object(self) + inherit ['a option return] visitor + method find stmts : 'a option = + with_return (fun cc -> + ignore (self#run stmts cc); + None) +end + +class mapper = object (self : 's) + inherit state + method run stmts : stmt list = + let rec loop self acc = function + | [] -> List.rev acc + | s :: ss -> + let self = {< succs = ss>} in + let acc = self#map_stmt s :: acc in + let self = {< preds = s :: preds >} in + loop self acc ss in + loop self [] stmts |> List.concat + + method map_unop op e = + Exp.UnOp (op, self#map_exp e) + + method map_binop op e1 e2= + Exp.BinOp (op, self#map_exp e1, self#map_exp e2) + + method map_store ~dst ~addr ~src e s = + Exp.Store (self#map_exp dst, + self#map_exp addr, + self#map_exp src, e, s) + + method map_load ~src ~addr e s = + Exp.Load (self#map_exp src, self#map_exp addr, e, s) + + method map_cast ct cs e = Exp.Cast (ct,cs,self#map_exp e) + + method map_let v ~exp ~body = + Exp.Let (self#map_sym v, self#map_exp exp, self#map_exp body) + + method map_ite ~cond ~yes ~no = + let s = {< under_condition = true >} in + Exp.Ite (self#map_exp cond, s#map_exp yes, s#map_exp no) + + method map_extract ~hi ~lo e = + Exp.Extract (hi, lo, self#map_exp e) + + method map_concat e1 e2 = + Exp.Concat (self#map_exp e1, self#map_exp e2) + + method map_var s = Exp.Var (self#map_sym s) + + method map_sym = Fn.id + + method map_int n = Exp.Int n + + method map_unknown s t = Exp.Unknown (s,t) + + method map_special s = [Stmt.Special s] + + method map_jmp e = + [Stmt.Jmp ({< in_jmp = true >}#map_exp e)] + + method map_move v e = + let self = {< in_move = true >} in + [Stmt.Move (self#map_sym v, self#map_exp e)] + + method map_while ~cond ss = + [Stmt.While (self#map_exp cond, + {< in_loop = true; under_condition = true >}#run ss)] + + method map_if ~cond ~yes ~no = + let s = {< under_condition = true >} in + [Stmt.If (self#map_exp cond, s#run yes, s#run no)] + + method map_cpuexn n = [Stmt.CpuExn n] + + method map_exp e : exp = + let self = {< exps_stack = e :: exps_stack >} in + match e with + | Exp.Int v -> self#map_int v + | Exp.UnOp (op,e) -> self#map_unop op e + | Exp.BinOp (op,e1,e2) -> self#map_binop op e1 e2 + | Exp.Store (dst,addr,src,e,s) -> self#map_store ~dst ~addr ~src e s + | Exp.Load (src,addr,e,s) -> self#map_load ~src ~addr e s + | Exp.Cast (ct,sz,ex) -> self#map_cast ct sz ex + | Exp.Let (v,exp,body) -> self#map_let v ~exp ~body + | Exp.Ite (cond,yes,no) -> self#map_ite ~cond ~yes ~no + | Exp.Extract (hi,lo,e) -> self#map_extract ~hi ~lo e + | Exp.Concat (e1,e2) -> self#map_concat e1 e2 + | Exp.Var v -> self#map_var v + | Exp.Unknown (s,t) -> self#map_unknown s t + + method map_stmt stmt : bil = + let self = {< stmts_stack = stmt :: stmts_stack >} in + match stmt with + | Stmt.Move (var,exp) -> self#map_move var exp + | Stmt.Jmp exp -> self#map_jmp exp + | Stmt.Special s -> self#map_special s + | Stmt.While (cond,ss) -> self#map_while ~cond ss + | Stmt.If (cond,yes,no) -> self#map_if ~cond ~yes ~no + | Stmt.CpuExn n -> self#map_cpuexn n +end diff --git a/lib/bap_types/bap_visitor.mli b/lib/bap_types/bap_visitor.mli new file mode 100644 index 000000000..4f46c9ae5 --- /dev/null +++ b/lib/bap_types/bap_visitor.mli @@ -0,0 +1,253 @@ +(** AST Visitors. + + This module provides three classes that visits AST: + + [visitor] that folds arbitrary value over the AST, + [finder] is a visitor, that can prematurely finish the traversal, + [mapper] that maps AST, allowing limited transformation + of its structure. + + You can find some handy transformations in `Bap_helpers` + module. Note, all definitions from this module and `Bap_helpers` + is available under `Bil` namespace. + + +*) +open Core_kernel.Std +open Bap_common +open Bap_bil + +(** Both visitors provides some information about the current + position of the visitor *) +class state : object + (** the stack of stmts that was already visited, with the last on + the top. Not including the currently visiting stmt. *) + val preds : bil + + (** stmts that are not yet visited *) + val succs : bil + + (** a stack of stmts that are parents for the currently visiting + entity. The top one is the one that we're currently visiting. *) + val stmts_stack : bil + + (** a stack of expr, that are parents for the currenly visiting + expression *) + val exps_stack : exp list + + (** is [true] if we're visiting expression that is a jump target *) + val in_jmp : bool + + (** is [true] if we're visiting expression that is on the left or + right side of the assignment. *) + val in_move : bool + + (** is [true] if currently visiting expression or statement is + executed under condition. *) + val under_condition : bool + (** is [true] if currently visiting expression or statement is + executed under loop. *) + val in_loop : bool +end + +(** Visitor. + Visits AST providing lots of hooks. + + For each AST constructor [C] the visitor provides three methods: + [enter_C], [visit_C], [leave_C]. The default implementation for + [enter_C] and [leave_C] is to return its argument. The default + implementation for [visit_C] is the following: + 1. call [enter_C] + 2. visit all children + 3. call [leave_C]. + + It is recommended to override [enter_C] method if you only need + to visit [C] constructor without changing a way you're visiting + the tree. + + For example, to collect all resolved jumps one could write the + following function: + + {[ + let collect_calls bil = (object(self) + inherit [Word.t list] visitor + method! enter_int x js = if in_jmp then x :: js else js + end)#run bil [] + ]} + + The default entry point of the visitor is method [run], but + you can use any other method as well, for example, if you do + not have a statement at all and want to visit expression. +*) +class ['a] visitor : object + inherit state + (** {3 Default entry point} *) + method run : bil -> 'a -> 'a + + (** {3 Statements } *) + method enter_stmt : stmt -> 'a -> 'a + method visit_stmt : stmt -> 'a -> 'a + method leave_stmt : stmt -> 'a -> 'a + + (** {4 [Move(var,exp)]} *) + method enter_move : var -> exp -> 'a -> 'a + method visit_move : var -> exp -> 'a -> 'a + method leave_move : var -> exp -> 'a -> 'a + + (** {4 [Jmp exp]} *) + method enter_jmp : exp -> 'a -> 'a + method visit_jmp : exp -> 'a -> 'a + method leave_jmp : exp -> 'a -> 'a + + (** {4 [While (cond,bil)]} *) + method enter_while : cond:exp -> bil -> 'a -> 'a + method visit_while : cond:exp -> bil -> 'a -> 'a + method leave_while : cond:exp -> bil -> 'a -> 'a + + (** {4 [If (cond,yes,no)]} *) + method enter_if : cond:exp -> yes:bil -> no:bil -> 'a -> 'a + method visit_if : cond:exp -> yes:bil -> no:bil -> 'a -> 'a + method leave_if : cond:exp -> yes:bil -> no:bil -> 'a -> 'a + + (** {4 [CpuExn n]} *) + method enter_cpuexn : int -> 'a -> 'a + method visit_cpuexn : int -> 'a -> 'a + method leave_cpuexn : int -> 'a -> 'a + + (** {4 [Special string]} *) + method enter_special : string -> 'a -> 'a + method visit_special : string -> 'a -> 'a + method leave_special : string -> 'a -> 'a + + (** {3 Expressions} *) + method enter_exp : exp -> 'a -> 'a + method visit_exp : exp -> 'a -> 'a + method leave_exp : exp -> 'a -> 'a + + (** {4 [Load (src,addr,endian,size)]} *) + method enter_load : src:exp -> addr:exp -> endian -> size -> 'a -> 'a + method visit_load : src:exp -> addr:exp -> endian -> size -> 'a -> 'a + method leave_load : src:exp -> addr:exp -> endian -> size -> 'a -> 'a + + (** {4 [Store (dst,addr,src,endian,size)]} *) + method enter_store : dst:exp -> addr:exp -> src:exp -> endian -> size -> 'a -> 'a + method visit_store : dst:exp -> addr:exp -> src:exp -> endian -> size -> 'a -> 'a + method leave_store : dst:exp -> addr:exp -> src:exp -> endian -> size -> 'a -> 'a + + (** {4 [BinOp (op,e1,e2)]} *) + method enter_binop : binop -> exp -> exp -> 'a -> 'a + method visit_binop : binop -> exp -> exp -> 'a -> 'a + method leave_binop : binop -> exp -> exp -> 'a -> 'a + + (** {4 [Unop (op,e)]} *) + method enter_unop : unop -> exp -> 'a -> 'a + method visit_unop : unop -> exp -> 'a -> 'a + method leave_unop : unop -> exp -> 'a -> 'a + + (** {4 [Cast(kind,size,e)]} *) + method enter_cast : cast -> nat1 -> exp -> 'a -> 'a + method visit_cast : cast -> nat1 -> exp -> 'a -> 'a + method leave_cast : cast -> nat1 -> exp -> 'a -> 'a + + (** {4 [Let (v,exp,body)]} *) + method enter_let : var -> exp:exp -> body:exp -> 'a -> 'a + method visit_let : var -> exp:exp -> body:exp -> 'a -> 'a + method leave_let : var -> exp:exp -> body:exp -> 'a -> 'a + + (** {4 [Ite (cond,yes,no)]} *) + method enter_ite : cond:exp -> yes:exp -> no:exp -> 'a -> 'a + method visit_ite : cond:exp -> yes:exp -> no:exp -> 'a -> 'a + method leave_ite : cond:exp -> yes:exp -> no:exp -> 'a -> 'a + + (** {4 [Extract (hi,lo,e)]} *) + method enter_extract : hi:nat1 -> lo:nat1 -> exp -> 'a -> 'a + method visit_extract : hi:nat1 -> lo:nat1 -> exp -> 'a -> 'a + method leave_extract : hi:nat1 -> lo:nat1 -> exp -> 'a -> 'a + + (** {4 [Concat(e1,e2)]} *) + method enter_concat : exp -> exp -> 'a -> 'a + method visit_concat : exp -> exp -> 'a -> 'a + method leave_concat : exp -> exp -> 'a -> 'a + + (** {3 [Leafs]} *) + (** {4 [Int w]} *) + method enter_int : word -> 'a -> 'a + method visit_int : word -> 'a -> 'a + method leave_int : word -> 'a -> 'a + + (** {4 [Var v]} *) + method enter_var : var -> 'a -> 'a + method visit_var : var -> 'a -> 'a + method leave_var : var -> 'a -> 'a + + (** {4 [Unknown (str,typ)]} *) + method enter_unknown : string -> typ -> 'a -> 'a + method visit_unknown : string -> typ -> 'a -> 'a + method leave_unknown : string -> typ -> 'a -> 'a +end + + +(** A visitor with shortcut. + Finder is a specialization of a visitor, that uses [return] as its + folding argument. At any time you can stop the traversing by + calling [return] function of the provided argument (which is by + itself is a record with one field - a function accepting argument + of type ['a option]). + + For example, the following function will check whether [x] + variable is referenced in the provided scope. + {[ + let is_referenced x = find (object(self) + inherit [unit] finder + method! enter_var y cc = + if Bap_var.(x = y) then cc.return (Some ()); cc + end) + ]} + + Note: the example uses [find] function from the [Bap_helpers]. +*) +class ['a] finder : object + inherit ['a option return] visitor + method find : bil -> 'a option +end + +(** AST transformation. + mapper allows one to map AST, performing some limited + amount of transformations on it. Mapper provides extra + flexibility by mapping [stmt] to [stmt list], thus allowing + to remove statements from the output (by mapping to empty list) or + to map one statement to several. This is particularly useful when + you map [if] or [while] statements. +*) +class mapper : object + inherit state + + (** Default entry point. + But again, you can use any method as an entry *) + method run : bil -> bil + + (** {3 Statements} *) + method map_stmt : stmt -> bil + method map_move : var -> exp -> bil + method map_jmp : exp -> bil + method map_while : cond:exp -> bil -> bil + method map_if : cond:exp -> yes:bil -> no:bil -> bil + method map_cpuexn : int -> bil + method map_special : string -> bil + + (** {3 Expressions} *) + method map_exp : exp -> exp + method map_load : src:exp -> addr:exp -> endian -> size -> exp + method map_store : dst:exp -> addr:exp -> src:exp -> endian -> size -> exp + method map_binop : binop -> exp -> exp -> exp + method map_unop : unop -> exp -> exp + method map_cast : cast -> nat1 -> exp -> exp + method map_let : var -> exp:exp -> body:exp -> exp + method map_ite : cond:exp -> yes:exp -> no:exp -> exp + method map_extract : hi:nat1 -> lo:nat1 -> exp -> exp + method map_concat : exp -> exp -> exp + method map_int : word -> exp + method map_var : var -> exp + method map_sym : var -> var + method map_unknown : string -> typ -> exp +end diff --git a/lib/bap_types/conceval.ml b/lib/bap_types/conceval.ml index 6db5470c0..85aaf622a 100644 --- a/lib/bap_types/conceval.ml +++ b/lib/bap_types/conceval.ml @@ -52,7 +52,7 @@ module Memory = struct if Mem.is_empty mem then None else let bytes = Size.to_bytes sz in - let max = Addr.(idx ++ (bytes - 1)) in + let max = Addr.(idx ++ Int.(bytes - 1)) in let data = List.map ~f:snd (Mem.range_to_alist mem ~min:idx ~max) in if List.length data = bytes then @@ -165,43 +165,43 @@ let handle_binop op l r : value = let handle_cast cast_kind size v = let open Exp.Cast in + let hi = size - 1 in let cast v = match cast_kind with - | UNSIGNED -> Word.bitsub_exn ~hi:size v - | SIGNED -> Word.bitsub_exn ~hi:size (Word.signed v) - | HIGH -> Word.bitsub_exn ~lo:(Word.bitwidth v - size) v - | LOW -> Word.bitsub_exn ~hi:size v in + | UNSIGNED -> Word.extract_exn ~hi v + | SIGNED -> Word.extract_exn ~hi (Word.signed v) + | HIGH -> Word.extract_exn ~lo:(Word.bitwidth v - size) v + | LOW -> Word.extract_exn ~hi v in bv_action_or_unknown v (fun v -> BV (cast v)) (** Given state, evaluate a single BIL expression. *) let rec eval_exp state exp = - let open Exp in let result = match exp with - | Load (arr, idx, endian, t) -> + | Bil.Load (arr, idx, endian, t) -> (match Memory.load (eval_exp state arr) (eval_exp state idx) endian t with | Some v -> v | None -> Un ("Load from uninitialized memory", Type.imm Size.(to_bits t))) - | Store (arr, idx, v, endian, t) -> + | Bil.Store (arr, idx, v, endian, t) -> Memory.store (eval_exp state arr) (eval_exp state idx) (eval_exp state v) endian t - | BinOp (op, l, r) -> handle_binop op (eval_exp state l) (eval_exp state r) - | UnOp (op, v) -> handle_unop op (eval_exp state v) - | Var v -> State.peek_exn state v - | Int v -> BV v - | Cast (cast_kind, new_type, v) -> + | Bil.BinOp (op, l, r) -> handle_binop op (eval_exp state l) (eval_exp state r) + | Bil.UnOp (op, v) -> handle_unop op (eval_exp state v) + | Bil.Var v -> State.peek_exn state v + | Bil.Int v -> BV v + | Bil.Cast (cast_kind, new_type, v) -> handle_cast cast_kind new_type (eval_exp state v) - | Let (v, a, b) -> (* FIXME Should there be typechecking done here? *) + | Bil.Let (v, a, b) -> (* FIXME Should there be typechecking done here? *) let state = State.move state ~key:v ~data:(eval_exp state a) in eval_exp state b - | Unknown (str, typ) -> Un (str, typ) - | Ite (cond, t_case, f_case) -> + | Bil.Unknown (str, typ) -> Un (str, typ) + | Bil.Ite (cond, t_case, f_case) -> bv_action_or_unknown (eval_exp state cond) (fun v -> if not (Word.is_zero v) then eval_exp state t_case else eval_exp state f_case) - | Extract (hi, lo, v) -> bv_action_or_unknown (eval_exp state v) - (fun v -> BV (Word.bitsub_exn ~hi ~lo v)) - | Concat (l, r) -> (match eval_exp state l, eval_exp state r with + | Bil.Extract (hi, lo, v) -> bv_action_or_unknown (eval_exp state v) + (fun v -> BV (Word.extract_exn ~hi ~lo v)) + | Bil.Concat (l, r) -> (match eval_exp state l, eval_exp state r with | (Mem _, _) | (_, Mem _) -> raise (Abort "Operation cannot be performed on memory.") | ((Un (_, _) as un), _) | (_, (Un (_, _) as un)) -> un diff --git a/lib_test/bap_image/test_image.ml b/lib_test/bap_image/test_image.ml index a2614df18..701d819ae 100644 --- a/lib_test/bap_image/test_image.ml +++ b/lib_test/bap_image/test_image.ml @@ -129,7 +129,7 @@ let assert_cont ~word_size img = Addr.(a1 = a2) ==> Addr.(a1 = base) end; let s1 = Addr.of_int ~width:32 step in - let () = match Addr.Int.(!$a2 - !$a1 - !$s1) with + let () = match Addr.Int_err.(!$a2 - !$a1 - !$s1) with | Error err -> assert_string @@ Error.to_string_hum err | Ok diff -> assert_bool "a1 <> a2 -> a2 - a1 = (word_size)" diff --git a/lib_test/bap_types/test_bitvector.ml b/lib_test/bap_types/test_bitvector.ml index ab1a64c70..49b69adb0 100644 --- a/lib_test/bap_types/test_bitvector.ml +++ b/lib_test/bap_types/test_bitvector.ml @@ -65,7 +65,7 @@ let bitsub ?hi ?lo ~expect v ctxt = assert_equal ~ctxt ~printer:Word.to_string !$expect - (Word.bitsub_exn ?hi ?lo !$v) + (Word.extract_exn ?hi ?lo !$v) let of_binary endian string ~expect ctxt = assert_equal ~ctxt diff --git a/opam b/opam index 284fe268e..3a59787fa 100644 --- a/opam +++ b/opam @@ -1,6 +1,6 @@ opam-version: "1.2" name: "bap" -version: "0.9.2" +version: "0.9.3" maintainer: "Ivan Gotovchits " authors: "BAP Team" homepage: "https://github.com/BinaryAnalysisPlatform/bap/" @@ -8,7 +8,7 @@ bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" dev-repo: "git://github.com/BinaryAnalysisPlatform/bap/" license: "MIT" build: [ - ["./configure" "--prefix=%{prefix}%"] + ["./configure" "--prefix=%{prefix}%" "--enable-docs"] [make] ] install: [make "install"] @@ -32,6 +32,7 @@ depends: [ "ocamlgraph" "re" "uri" {= "1.7.2"} + "utop" "zarith" ] available: [ocaml-version >= "4.01"] diff --git a/src/readbin/cmdline.ml b/src/readbin/cmdline.ml index c66ecf956..a3207c643 100644 --- a/src/readbin/cmdline.ml +++ b/src/readbin/cmdline.ml @@ -59,24 +59,30 @@ let demangle : 'a option Term.t = Arg.(value & opt ~vopt:(Some `internal) (some spec) None & info ["demangle"] ~doc) - -let target_format : _ Term.t = - let vals = ["numeric", `numeric; "symbolic", `symbolic] in - let doc = - sprintf "Set jump destinations format in BIL to %s" - (Arg.doc_alts_enum vals) in - Arg.(value & opt (enum vals) `symbolic & - info ["dests"] ~doc) +let no_resolve : bool Term.t = + let doc = "Do not resolve addresses to symbolic names" in + Arg.(value & flag & info ["no-resolve"; "-n"] ~doc) let keep_alive : bool Term.t = - let doc = "Keep alive dead BIL code" in + let doc = "Keep alive unused temporary variables" in Arg.(value & flag & info ["keep-alive"] ~doc) +let no_inline : bool Term.t = + let doc = "Disable inlining temporary variables" in + Arg.(value & flag & info ["no-inline"] ~doc) -let create - a b c d e f g h = Options.Fields.create - a b c d e f g h +let keep_consts : bool Term.t = + let doc = "Disable constant folding" in + Arg.(value & flag & info ["keep-const"] ~doc) + +let no_optimizations : bool Term.t = + let doc = "Disable all kinds of optimizations" in + Arg.(value & flag & info ["no-optimizations"] ~doc) + +let create + a b c d e f g h i k l = Options.Fields.create + a b c d e f g h i k l let program = let doc = "Disassemble binary" in let man = [ @@ -99,7 +105,8 @@ let program = Term.(pure create $filename $symsfile $cfg_format $output_phoenix $output_dump $demangle - $target_format $keep_alive), + $no_resolve $keep_alive + $no_inline $keep_consts $no_optimizations), Term.info "bap-objdump" ~version:"0.9.2" ~doc ~man let parse () = match Term.eval program with diff --git a/src/readbin/helpers.ml b/src/readbin/helpers.ml index 20d9feab6..b4a856571 100644 --- a/src/readbin/helpers.ml +++ b/src/readbin/helpers.ml @@ -7,62 +7,76 @@ module Make(Env : Printing.Env) = struct open Env open Printing - (* all let bindings create fresh new variables, - so we needn't worry about shadowing. *) - let rec is_bound x = List.exists ~f:(stmt x) - and stmt x = Stmt.(function - | Move (y,e) -> Var.(x = y) || expr x e - | While (e,bil) -> is_bound x bil || expr x e - | If (e,b1,b2) -> is_bound x b1 || is_bound x b2 || expr x e - | Jmp _ | Special _ | CpuExn _ -> false) - and expr x = Exp.(function - | Var y -> Var.(x = y) - | Int _ | Unknown _ -> false - | UnOp (_,e) | Extract (_,_,e) | Cast (_,_,e) -> expr x e - | Load (e1,e2,_,_) | BinOp (_,e1,e2) - | Let (_,e1,e2) | Concat (e1,e2) -> expr x e1 || expr x e2 - | Ite (e1,e2,e3) | Store (e1,e2,e3,_,_) -> - List.exists [e1;e2;e3] ~f:(expr x)) + (** maps immediates to symbols. + For any given value, if it belongs to some basic block, then + substitute it with [base + off], where [base] is a start of + basic block and [off] is the offset from the [base]. *) + let resolve_jumps = + let jump_type = match Arch.addr_size arch with + | `r32 -> reg32_t + | `r64 -> reg64_t in + let blk_base blk = + let name = Format.asprintf "%a" pp_blk_name blk in + Exp.var (Var.create name jump_type) in + (object inherit Bil.mapper as super + method! map_int addr = + match Table.find_addr cfg addr with + | Some (mem,blk) -> + let start = Memory.min_addr mem in + if Addr.(start = addr) then blk_base blk else + let off = Addr.Int_exn.(addr - start) in + Exp.(blk_base blk + int off) + | None -> Exp.Int addr + end)#run + + + + (* we're very conservative here *) + let has_side_effect e scope = (object inherit [bool] Bil.visitor + method! enter_load ~src:_ ~addr:_ _e _s _r = true + method! enter_store ~dst:_ ~addr:_ ~src:_ _e _s _r = true + method! enter_var v r = r || Bil.is_modified v scope + end)#visit_exp e false - let remove_dead_variables stmt = + (** This optimization will inline temporary variables that occurres + inside the instruction definition if the right hand side of the + variable definition is either side-effect free, or another + variable, that is not changed in the scope of the variable definition. + *) + let inline_variables stmt = let rec loop ss = function | [] -> List.rev ss - | Stmt.Move (x,_) as s :: xs when Var.is_tmp x -> - if is_bound x xs then loop (s::ss) xs else loop ss xs + | Stmt.Move (x, Exp.Var y) as s :: xs when Var.is_tmp x -> + if Bil.is_modified y xs || Bil.is_modified x xs + then loop (s::ss) xs else + let xs = Bil.substitute (Exp.var x) (Exp.var y) xs in + loop ss xs + | Stmt.Move (x, y) as s :: xs when Var.is_tmp x -> + if has_side_effect y xs || Bil.is_modified x xs + then loop (s::ss) xs + else loop ss (Bil.substitute (Exp.var x) y xs) | s :: xs -> loop (s::ss) xs in loop [] stmt - let jump_type = match Arch.addr_size arch with - | `r32 -> reg32_t - | `r64 -> reg64_t - - let resolve_jumps bil = - let fn name = Exp.var (Var.create name jump_type) in - let resolve_addr addr = - match Table.find_addr cfg addr with - | Some (_,blk) -> - let name = Format.asprintf "%a" pp_blk_name blk in - Exp.(fn name) - | None -> Exp.Int addr in - let open Stmt in - let rec resolve bil = - List.map bil ~f:(function - | Jmp (Exp.Int addr) -> Jmp (resolve_addr addr) - | Jmp _ as jmp -> jmp - | While (e,bil) -> While (e, resolve bil) - | If (e,b1,b2) -> If (e,resolve b1, resolve b2) - | Move _ | Special _ | CpuExn _ as s -> s) in - resolve bil - - let resolve_jumps = - if options.target_format = `numeric then ident else resolve_jumps + let disable_if option optimization = + if Field.get option options then Fn.id else optimization - let remove_dead_variables = - if options.keep_alive then ident else remove_dead_variables + let optimizations = + let open Fields in + List.map ~f:Bil.fixpoint [ + disable_if no_resolve resolve_jumps; + disable_if keep_alive Bil.prune_unreferenced; + disable_if keep_consts Bil.fold_consts; + disable_if keep_consts Bil.normalize_negatives; + disable_if no_inline inline_variables; + ] + |> List.reduce_exn ~f:Fn.compose + |> Bil.fixpoint + |> disable_if no_optimizations let bil_of_insns insns = - let bs = Seq.(insns >>| Insn.bil |> to_list) in - List.(bs >>| remove_dead_variables >>| resolve_jumps |> concat) + let insns = Seq.(insns >>| Insn.bil |> to_list) in + List.(insns >>| optimizations |> concat) let bil_of_block blk : bil = bil_of_insns Seq.(Block.insns blk >>| snd) diff --git a/src/readbin/options.ml b/src/readbin/options.ml index fe33319da..5461f13aa 100644 --- a/src/readbin/options.ml +++ b/src/readbin/options.ml @@ -11,8 +11,11 @@ type t = { output_phoenix : string option; output_dump : insn_format sexp_list; demangle : demangle sexp_option; - target_format : [`numeric | `symbolic]; + no_resolve : bool; keep_alive : bool; + no_inline : bool; + keep_consts : bool; + no_optimizations : bool; } with sexp, fields module type Provider = sig diff --git a/test.sh b/test.sh index bbac93a03..cc70cf594 100755 --- a/test.sh +++ b/test.sh @@ -10,7 +10,7 @@ for target in $TEST_TARGETS; do files=`find "$target-binaries" -name "*$1*" -type f -regex '.*utils_.*'` for file in $files; do printf '%-70s ' $file; - bap-objdump $file > /dev/null; + bap-objdump $file -d bil -d asm > /dev/null; if [ $? -eq 0 ]; then echo 'ok'; else