diff --git a/sledge/src/llair/frontend.ml b/sledge/src/llair/frontend.ml index 69420370f..76f4399a8 100644 --- a/sledge/src/llair/frontend.ml +++ b/sledge/src/llair/frontend.ml @@ -917,6 +917,12 @@ let xlate_instr : (Llair.Inst.nondet ~reg ~msg ~loc :: insts, term, []) ) in match String.split fname ~on:'.' with + | "llvm" :: "memset" :: _ -> + let dst = xlate_value x (Llvm.operand instr 0) in + let byt = xlate_value x (Llvm.operand instr 1) in + let len = xlate_value x (Llvm.operand instr 2) in + continue (fun (insts, term) -> + (Llair.Inst.memset ~dst ~byt ~len ~loc :: insts, term, []) ) | "llvm" :: "memcpy" :: _ -> let dst = xlate_value x (Llvm.operand instr 0) in let src = xlate_value x (Llvm.operand instr 1) in @@ -929,12 +935,6 @@ let xlate_instr : let len = xlate_value x (Llvm.operand instr 2) in continue (fun (insts, term) -> (Llair.Inst.memmov ~dst ~src ~len ~loc :: insts, term, []) ) - | "llvm" :: "memset" :: _ -> - let dst = xlate_value x (Llvm.operand instr 0) in - let byt = xlate_value x (Llvm.operand instr 1) in - let len = xlate_value x (Llvm.operand instr 2) in - continue (fun (insts, term) -> - (Llair.Inst.memset ~dst ~byt ~len ~loc :: insts, term, []) ) | _ when Option.is_some (xlate_intrinsic_exp fname) -> continue (fun (insts, term) -> (insts, term, [])) | ["llvm"; "dbg"; ("declare" | "value")] diff --git a/sledge/src/llair/llair.ml b/sledge/src/llair/llair.ml index 7d930662f..025bab18e 100644 --- a/sledge/src/llair/llair.ml +++ b/sledge/src/llair/llair.ml @@ -10,14 +10,14 @@ type inst = | Load of {reg: Var.t; ptr: Exp.t; len: Exp.t; loc: Loc.t} | Store of {ptr: Exp.t; exp: Exp.t; len: Exp.t; loc: Loc.t} + | Memset of {dst: Exp.t; byt: Exp.t; len: Exp.t; loc: Loc.t} | Memcpy of {dst: Exp.t; src: Exp.t; len: Exp.t; loc: Loc.t} | Memmov of {dst: Exp.t; src: Exp.t; len: Exp.t; loc: Loc.t} - | Memset of {dst: Exp.t; byt: Exp.t; len: Exp.t; loc: Loc.t} | Alloc of {reg: Var.t; num: Exp.t; len: Exp.t; loc: Loc.t} - | Malloc of {reg: Var.t; siz: Exp.t; loc: Loc.t} | Free of {ptr: Exp.t; loc: Loc.t} - | Nondet of {reg: Var.t option; msg: string; loc: Loc.t} + | Malloc of {reg: Var.t; siz: Exp.t; loc: Loc.t} | Strlen of {reg: Var.t; ptr: Exp.t; loc: Loc.t} + | Nondet of {reg: Var.t option; msg: string; loc: Loc.t} [@@deriving sexp] type cmnd = inst vector [@@deriving sexp] @@ -94,26 +94,26 @@ let pp_inst fs inst = | Store {ptr; exp; len; loc} -> pf "@[<2>store %a@ %a@ %a;@]\t%a" Exp.pp len Exp.pp ptr Exp.pp exp Loc.pp loc + | Memset {dst; byt; len; loc} -> + pf "@[<2>memset %a %a %a;@]\t%a" Exp.pp len Exp.pp dst Exp.pp byt + Loc.pp loc | Memcpy {dst; src; len; loc} -> pf "@[<2>memcpy %a %a %a;@]\t%a" Exp.pp len Exp.pp dst Exp.pp src Loc.pp loc | Memmov {dst; src; len; loc} -> pf "@[<2>memmov %a %a %a;@]\t%a" Exp.pp len Exp.pp dst Exp.pp src Loc.pp loc - | Memset {dst; byt; len; loc} -> - pf "@[<2>memset %a %a %a;@]\t%a" Exp.pp len Exp.pp dst Exp.pp byt - Loc.pp loc | Alloc {reg; num; len; loc} -> pf "@[<2>alloc %a@ [%a x %a];@]\t%a" Var.pp reg Exp.pp num Exp.pp len Loc.pp loc + | Free {ptr; loc} -> pf "@[<2>free %a;@]\t%a" Exp.pp ptr Loc.pp loc | Malloc {reg; siz; loc} -> pf "@[<2>malloc %a@ %a;@]\t%a" Var.pp reg Exp.pp siz Loc.pp loc - | Free {ptr; loc} -> pf "@[<2>free %a;@]\t%a" Exp.pp ptr Loc.pp loc + | Strlen {reg; ptr; loc} -> + pf "@[<2>strlen %a@ %a;@]\t%a" Var.pp reg Exp.pp ptr Loc.pp loc | Nondet {reg; msg; loc} -> pf "@[<2>nondet %a\"%s\";@]\t%a" (Option.pp "%a " Var.pp) reg msg Loc.pp loc - | Strlen {reg; ptr; loc} -> - pf "@[<2>strlen %a@ %a;@]\t%a" Var.pp reg Exp.pp ptr Loc.pp loc let pp_args pp_arg fs args = Format.fprintf fs "@ (@[%a@])" (List.pp ",@ " pp_arg) (List.rev args) @@ -189,26 +189,26 @@ module Inst = struct let pp = pp_inst let load ~reg ~ptr ~len ~loc = Load {reg; ptr; len; loc} let store ~ptr ~exp ~len ~loc = Store {ptr; exp; len; loc} + let memset ~dst ~byt ~len ~loc = Memset {dst; byt; len; loc} let memcpy ~dst ~src ~len ~loc = Memcpy {dst; src; len; loc} let memmov ~dst ~src ~len ~loc = Memmov {dst; src; len; loc} - let memset ~dst ~byt ~len ~loc = Memset {dst; byt; len; loc} let alloc ~reg ~num ~len ~loc = Alloc {reg; num; len; loc} - let malloc ~reg ~siz ~loc = Malloc {reg; siz; loc} let free ~ptr ~loc = Free {ptr; loc} - let nondet ~reg ~msg ~loc = Nondet {reg; msg; loc} + let malloc ~reg ~siz ~loc = Malloc {reg; siz; loc} let strlen ~reg ~ptr ~loc = Strlen {reg; ptr; loc} + let nondet ~reg ~msg ~loc = Nondet {reg; msg; loc} let loc = function | Load {loc} |Store {loc} + |Memset {loc} |Memcpy {loc} |Memmov {loc} - |Memset {loc} |Alloc {loc} - |Malloc {loc} |Free {loc} - |Nondet {loc} - |Strlen {loc} -> + |Malloc {loc} + |Strlen {loc} + |Nondet {loc} -> loc let union_locals inst vs = @@ -216,8 +216,8 @@ module Inst = struct | Load {reg} |Alloc {reg} |Malloc {reg} - |Nondet {reg= Some reg} - |Strlen {reg} -> + |Strlen {reg} + |Nondet {reg= Some reg} -> Set.add vs reg | Store _ | Memcpy _ | Memmov _ | Memset _ | Free _ | Nondet {reg= None} -> diff --git a/sledge/src/llair/llair.mli b/sledge/src/llair/llair.mli index a66028386..b29eac273 100644 --- a/sledge/src/llair/llair.mli +++ b/sledge/src/llair/llair.mli @@ -35,27 +35,27 @@ type inst = private [ptr] into [reg]. *) | Store of {ptr: Exp.t; exp: Exp.t; len: Exp.t; loc: Loc.t} (** Write [len]-byte value [exp] into memory at address [ptr]. *) + | Memset of {dst: Exp.t; byt: Exp.t; len: Exp.t; loc: Loc.t} + (** Store byte [byt] into [len] memory addresses starting from [dst]. *) | Memcpy of {dst: Exp.t; src: Exp.t; len: Exp.t; loc: Loc.t} (** Copy [len] bytes starting from address [src] to [dst], undefined if ranges overlap. *) | Memmov of {dst: Exp.t; src: Exp.t; len: Exp.t; loc: Loc.t} (** Copy [len] bytes starting from address [src] to [dst]. *) - | Memset of {dst: Exp.t; byt: Exp.t; len: Exp.t; loc: Loc.t} - (** Store byte [byt] into [len] memory addresses starting from [dst]. *) | Alloc of {reg: Var.t; num: Exp.t; len: Exp.t; loc: Loc.t} (** Allocate a block of memory large enough to store [num] elements of [len] bytes each and bind [reg] to the first address. *) + | Free of {ptr: Exp.t; loc: Loc.t} + (** Deallocate the previously allocated block at address [ptr]. *) | Malloc of {reg: Var.t; siz: Exp.t; loc: Loc.t} (** Maybe allocate a block of memory of size [siz] bytes and bind [reg] to the first address, otherwise bind [reg] to [null]. *) - | Free of {ptr: Exp.t; loc: Loc.t} - (** Deallocate the previously allocated block at address [ptr]. *) - | Nondet of {reg: Var.t option; msg: string; loc: Loc.t} - (** Bind [reg] to an arbitrary value, representing non-deterministic - approximation of behavior described by [msg]. *) | Strlen of {reg: Var.t; ptr: Exp.t; loc: Loc.t} (** Bind [reg] to the length of the null-terminated string in memory starting from [ptr]. *) + | Nondet of {reg: Var.t option; msg: string; loc: Loc.t} + (** Bind [reg] to an arbitrary value, representing non-deterministic + approximation of behavior described by [msg]. *) (** A (straight-line) command is a sequence of instructions. *) type cmnd = inst vector @@ -130,14 +130,14 @@ module Inst : sig val pp : t pp val load : reg:Var.t -> ptr:Exp.t -> len:Exp.t -> loc:Loc.t -> inst val store : ptr:Exp.t -> exp:Exp.t -> len:Exp.t -> loc:Loc.t -> inst + val memset : dst:Exp.t -> byt:Exp.t -> len:Exp.t -> loc:Loc.t -> inst val memcpy : dst:Exp.t -> src:Exp.t -> len:Exp.t -> loc:Loc.t -> inst val memmov : dst:Exp.t -> src:Exp.t -> len:Exp.t -> loc:Loc.t -> inst - val memset : dst:Exp.t -> byt:Exp.t -> len:Exp.t -> loc:Loc.t -> inst val alloc : reg:Var.t -> num:Exp.t -> len:Exp.t -> loc:Loc.t -> inst - val malloc : reg:Var.t -> siz:Exp.t -> loc:Loc.t -> inst val free : ptr:Exp.t -> loc:Loc.t -> inst - val nondet : reg:Var.t option -> msg:string -> loc:Loc.t -> inst + val malloc : reg:Var.t -> siz:Exp.t -> loc:Loc.t -> inst val strlen : reg:Var.t -> ptr:Exp.t -> loc:Loc.t -> inst + val nondet : reg:Var.t option -> msg:string -> loc:Loc.t -> inst val loc : inst -> Loc.t val locals : inst -> Var.Set.t end diff --git a/sledge/src/symbheap/exec.ml b/sledge/src/symbheap/exec.ml index 934dda881..85c391859 100644 --- a/sledge/src/symbheap/exec.ml +++ b/sledge/src/symbheap/exec.ml @@ -33,42 +33,6 @@ let assume cnd pre = let post = Sh.and_ cnd pre in if Sh.is_false post then None else Some post -(* { emp } - * alloc r [n × l] - * { ∃α'. r-[r;n×l)->⟨n×l,α'⟩ } - *) -let alloc_spec us reg num len = - let loc = Exp.var reg in - let siz = Exp.mul Typ.siz num len in - let {xs; seg} = fresh_seg ~loc ~bas:loc ~len:siz ~siz us in - let post = Sh.seg seg in - let foot = Sh.extend_us xs Sh.emp in - {xs; foot; post} - -(* { emp } - * malloc r s - * { r=0 ∨ ∃α'. r-[r;s)->⟨s,α'⟩ } - *) -let malloc_spec us reg siz = - let loc = Exp.var reg in - let {xs; seg} = fresh_seg ~loc ~bas:loc ~len:siz ~siz us in - let foot = Sh.extend_us xs Sh.emp in - let post = Sh.or_ (null_eq (Exp.var reg)) (Sh.seg seg) in - {xs; foot; post} - -(* { p=0 ∨ p-[p;m)->⟨m,α⟩ } - * free p - * { emp } - *) -let free_spec us ptr = - let len, us = Var.fresh "m" ~wrt:us in - let siz = Exp.var len in - let {xs; seg} = fresh_seg ~loc:ptr ~bas:ptr ~len:siz ~siz us in - let xs = Set.add xs len in - let foot = Sh.or_ (null_eq ptr) (Sh.seg seg) in - let post = Sh.emp in - {xs; foot; post} - (* { p-[b;m)->⟨l,α⟩ } * load l r p * { r=α * p-[b;m)->⟨l,α⟩ } @@ -242,6 +206,42 @@ let memmov_specs us dst src len = ; memmov_dn_spec us dst src len ; memmov_up_spec us dst src len ] +(* { emp } + * alloc r [n × l] + * { ∃α'. r-[r;n×l)->⟨n×l,α'⟩ } + *) +let alloc_spec us reg num len = + let loc = Exp.var reg in + let siz = Exp.mul Typ.siz num len in + let {xs; seg} = fresh_seg ~loc ~bas:loc ~len:siz ~siz us in + let post = Sh.seg seg in + let foot = Sh.extend_us xs Sh.emp in + {xs; foot; post} + +(* { p=0 ∨ p-[p;m)->⟨m,α⟩ } + * free p + * { emp } + *) +let free_spec us ptr = + let len, us = Var.fresh "m" ~wrt:us in + let siz = Exp.var len in + let {xs; seg} = fresh_seg ~loc:ptr ~bas:ptr ~len:siz ~siz us in + let xs = Set.add xs len in + let foot = Sh.or_ (null_eq ptr) (Sh.seg seg) in + let post = Sh.emp in + {xs; foot; post} + +(* { emp } + * malloc r s + * { r=0 ∨ ∃α'. r-[r;s)->⟨s,α'⟩ } + *) +let malloc_spec us reg siz = + let loc = Exp.var reg in + let {xs; seg} = fresh_seg ~loc ~bas:loc ~len:siz ~siz us in + let foot = Sh.extend_us xs Sh.emp in + let post = Sh.or_ (null_eq (Exp.var reg)) (Sh.seg seg) in + {xs; foot; post} + (* { p-[b;m)->⟨l,α⟩ } * r = strlen p * { r=b+m-p-1 * p-[b;m)->⟨l,α⟩ } @@ -296,14 +296,14 @@ let inst : Sh.t -> Llair.inst -> (Sh.t, _) result = assert (Set.disjoint (Sh.fv pre) (Llair.Inst.locals inst)) ; let us = pre.us in ( match inst with - | Nondet _ -> Ok pre - | Alloc {reg; num; len} -> exec_spec pre (alloc_spec us reg num len) - | Malloc {reg; siz} -> exec_spec pre (malloc_spec us reg siz) - | Free {ptr} -> exec_spec pre (free_spec us ptr) | Load {reg; ptr; len} -> exec_spec pre (load_spec us reg ptr len) | Store {ptr; exp; len} -> exec_spec pre (store_spec us ptr exp len) | Memset {dst; byt; len} -> exec_spec pre (memset_spec us dst byt len) | Memcpy {dst; src; len} -> exec_specs pre (memcpy_specs us dst src len) | Memmov {dst; src; len} -> exec_specs pre (memmov_specs us dst src len) - | Strlen {reg; ptr} -> exec_spec pre (strlen_spec us reg ptr) ) + | Alloc {reg; num; len} -> exec_spec pre (alloc_spec us reg num len) + | Free {ptr} -> exec_spec pre (free_spec us ptr) + | Malloc {reg; siz} -> exec_spec pre (malloc_spec us reg siz) + | Strlen {reg; ptr} -> exec_spec pre (strlen_spec us reg ptr) + | Nondet _ -> Ok pre ) |> Result.map_error ~f:(fun () -> (pre, inst))