diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 5b9a00313e..0312a8ad2b 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2355,6 +2355,40 @@ struct | _ -> failwith ("non-integer argument in call to function "^f.vname) end in + let apply_cos fk (float_fun : ?asPreciseAsConcrete:bool -> ?notInf_notNaN:bool -> FD.t -> FD.t) x = + let eval_x = eval_rv (Analyses.ask_of_ctx ctx) gs st x in + begin match eval_x with + | Float float_x -> + let notInf_notNaN = match x with + | Lval (Var xvar, offs) -> ( + match ctx.ask (Q.TmpSpecialInv (xvar, Offset.Exp.of_cil offs)) with + | s when Q.MLInv.is_top s -> false + | s -> + let matchnan = function + | `Lifted LibraryDesc.Isnan _ -> true + | _ -> false in + let matchinf = function + | `Lifted LibraryDesc.Isnan _ -> true + | _ -> false in + let isFalse = function + | `Lifted expy -> ( + match ctx.ask (Q.EvalInt expy) with + | v when Queries.ID.is_bot v -> false + | v -> + match Queries.ID.to_bool v with + | Some b -> not b + | None -> false) + | _ -> false + in + let isNotNan = Q.MLInv.exists (fun (y, ml) -> matchnan ml && isFalse y) s in + let isNotInf = Q.MLInv.exists (fun (y, ml) -> matchinf ml && isFalse y) s in + isNotInf && isNotNan) + | _ -> false + in + float_fun ~notInf_notNaN (FD.cast_to fk float_x) + | _ -> failwith ("non-floating-point argument in call to function "^f.vname) + end + in let result:value = begin match fun_args with | Nan (fk, str) when Cil.isPointerType (Cilfacade.typeOf str) -> Float (FD.nan_of fk) @@ -2372,7 +2406,7 @@ struct | Asin (fk, x) -> Float (apply_unary fk FD.asin x) | Atan (fk, x) -> Float (apply_unary fk FD.atan x) | Atan2 (fk, y, x) -> Float (apply_binary fk (fun y' x' -> FD.atan (FD.div y' x')) y x) - | Cos (fk, x) -> Float (apply_unary fk FD.cos x) + | Cos (fk, x) -> Float (apply_cos fk FD.cos x) | Sin (fk, x) -> Float (apply_unary fk FD.sin x) | Tan (fk, x) -> Float (apply_unary fk FD.tan x) | Isgreater (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.gt x y)) diff --git a/src/analyses/tmpSpecial.ml b/src/analyses/tmpSpecial.ml index 9ed6da7c60..eb78d18695 100644 --- a/src/analyses/tmpSpecial.ml +++ b/src/analyses/tmpSpecial.ml @@ -13,13 +13,29 @@ struct let name () = "tmpSpecial" module ML = LibraryDesc.MathLifted - module Deps = SetDomain.Reverse (SetDomain.ToppedSet (CilType.Exp) (struct let topname = "All" end)) + module Deps = SetDomain.ToppedSet (CilType.Exp) (struct let topname = "All" end) module MLDeps = Lattice.Prod (ML) (Deps) - module D = MapDomain.MapBot (Mval.Exp) (MLDeps) + + (* x maps to (mathf(arg), deps) arg if x = mathf(arg) *) + module MM = MapDomain.MapBot_LiftTop (Mval.Exp) (MLDeps) + + (* arg maps to (x, mathf(arg), deps) if x = mathf(arg) *) + module ExpFlat = Lattice.Flat (CilType.Exp) (Printable.DefaultNames) + module MInvEntry = Lattice.Prod3 (ExpFlat) (ML) (Deps) + module MInvEntrySet = SetDomain.Reverse (SetDomain.ToppedSet (MInvEntry) (struct let topname = "All" end)) + module MInv = MapDomain.MapBot_LiftTop (Mval.Exp) (MInvEntrySet) + + module D = Lattice.Prod (MM) (MInv) module C = Lattice.Unit let invalidate ask exp_w st = - D.filter (fun _ (ml, deps) -> (Deps.for_all (fun arg -> not (VarEq.may_change ask exp_w arg)) deps)) st + let depNotChanged = Deps.for_all (fun arg -> not (VarEq.may_change ask exp_w arg)) in + let invalidate1 m = MM.filter (fun _ (ml, deps) -> depNotChanged deps) m in + let invalidate2 m = MInv.map (fun es -> + match es with + | es when MInvEntrySet.is_bot es -> es + | es -> MInvEntrySet.filter (fun (_,_,deps) -> depNotChanged deps) es) m in + invalidate1 (fst st), invalidate2 (snd st) let context _ _ = () @@ -70,8 +86,30 @@ struct (* actually it would be necessary to check here, if one of the arguments is written by the call. However this is not the case for any of the math functions and no other functions are covered so far *) if List.exists (fun arg -> VarEq.may_change ask (mkAddrOf lv) arg) arglist then d - else - D.add (v, Offset.Exp.of_cil offs) ((ML.lift fun_args, Deps.of_list ((Lval lv)::arglist))) d + else ( + if M.tracing then M.trace "tmpSpecialInv" "build tmpSpecial Entry for Lval %s\n" v.vname; + let d1 = MM.add (v, Offset.Exp.of_cil offs) ((ML.lift fun_args, Deps.of_list ((Lval lv)::arglist))) (fst d) in + let castNeglectable t x = match fun_args with + | LibraryDesc.Isinf _ + | LibraryDesc.Isnan _ -> BaseDomain.VD.is_safe_cast t (Cilfacade.typeOfLval x) + | _ -> false + in + let build_inv_entry varg offsarg = + if M.tracing then M.trace "tmpSpecialInv" "build tmpSpecialInv Entry for Argument %s\n" varg.vname; + let key = (varg, Offset.Exp.of_cil offsarg) in + let newE = (`Lifted (Lval lv), ML.lift fun_args, Deps.of_list ((Lval lv)::arglist)) in + if M.tracing then M.trace "tmpSpecialInv" "newE (lv: %s, ml: %s)\n" v.vname (LibraryDesc.MathPrintable.show fun_args); + let combined = match MInv.find key (snd d) with + | `Top -> MInvEntrySet.singleton newE + | s -> MInvEntrySet.add newE s in + Some (key, combined) in + let pick_lval = function + | Lval (Var varg, offsarg) -> build_inv_entry varg offsarg + (* we store the relationship neglecting the cast only in case of upcasting and math functions being IsNan and IsInf *) + | CastE(t, Lval (Var varg, offsarg)) when castNeglectable t (Var varg, offsarg) -> build_inv_entry varg offsarg + | _ -> None in + let d2 = MInv.add_list (List.filter_map pick_lval arglist) (snd d) in + d1, d2) | _ -> d in @@ -82,9 +120,22 @@ struct let query ctx (type a) (q: a Queries.t) : a Queries.result = match q with - | TmpSpecial lv -> let ml = fst (D.find lv ctx.local) in + | TmpSpecial lv -> let ml = fst (MM.find lv (fst ctx.local)) in if ML.is_bot ml then Queries.Result.top q else ml + | TmpSpecialInv lv -> ( + if M.tracing then M.trace "tmpSpecialInv" "MInv.find lv: %s\n" (fst lv).vname; + match MInv.find lv (snd ctx.local) with + | `Top -> Queries.Result.top q + | es -> + let mlv = MInvEntrySet.fold (fun (v, ml, deps) acc -> Queries.MLInv.add (v,ml) acc) es (Queries.MLInv.empty ()) + |> Queries.MLInv.filter (fun (v,ml) -> + match ml, v with + | `Bot, _ -> false + | _, `Lifted exp -> true + | _ -> false) in + if Queries.MLInv.is_bot mlv then Queries.Result.top q + else mlv) | _ -> Queries.Result.top q let startstate v = D.bot () diff --git a/src/cdomains/floatDomain.ml b/src/cdomains/floatDomain.ml index 39d3744401..6849593eef 100644 --- a/src/cdomains/floatDomain.ml +++ b/src/cdomains/floatDomain.ml @@ -34,7 +34,7 @@ module type FloatArith = sig (** asin(x) *) val atan : t -> t (** atan(x) *) - val cos : t -> t + val cos : ?asPreciseAsConcrete:bool -> ?notInf_notNaN:bool -> t -> t (** cos(x) *) val sin : t -> t (** sin(x) *) @@ -791,7 +791,18 @@ module FloatIntervalImpl(Float_t : CFloatType) = struct let acos = eval_unop eval_acos let asin = eval_unop eval_asin let atan = eval_unop eval_atan - let cos = eval_unop eval_cos + let cos ?(asPreciseAsConcrete=false) ?(notInf_notNaN=false) op = + match op with + | Bot -> raise (ArithmeticOnFloatBot (Printf.sprintf "unop %s" (show op))) + (* TODO: cos should return NaN if argument is + or - infinity, fix this. *) + | Interval v -> eval_cos v + | PlusInfinity + | MinusInfinity + | NaN -> NaN + | Top -> + if asPreciseAsConcrete && notInf_notNaN then + eval_cos (Float_t.lower_bound, Float_t.upper_bound) + else top() let sin = eval_unop eval_sin let tan = eval_unop eval_tan let sqrt = eval_unop eval_sqrt @@ -907,7 +918,11 @@ module FloatIntervalImplLifted = struct let acos = lift (F1.acos, F2.acos) let asin = lift (F1.asin, F2.asin) let atan = lift (F1.atan, F2.atan) - let cos = lift (F1.cos, F2.cos) + let cos ?(asPreciseAsConcrete=BoolDomain.MustBool.top ()) ?(notInf_notNaN=BoolDomain.MustBool.top ()) = function + | F32 a -> F32 (F1.cos ~asPreciseAsConcrete:true ~notInf_notNaN a) + | F64 a -> F64 (F2.cos ~asPreciseAsConcrete:true ~notInf_notNaN a) + | FLong a -> FLong (F2.cos ~notInf_notNaN a) + | FFloat128 a -> FFloat128 (F2.cos ~notInf_notNaN a) let sin = lift (F1.sin, F2.sin) let tan = lift (F1.tan, F2.tan) let sqrt = lift (F1.sqrt, F2.sqrt) @@ -1165,8 +1180,8 @@ module FloatDomTupleImpl = struct map { f1= (fun (type a) (module F : FloatDomain with type t = a) -> F.asin); } let atan = map { f1= (fun (type a) (module F : FloatDomain with type t = a) -> F.atan); } - let cos = - map { f1= (fun (type a) (module F : FloatDomain with type t = a) -> F.cos); } + let cos ?(asPreciseAsConcrete=BoolDomain.MustBool.top ()) ?(notInf_notNaN=BoolDomain.MustBool.top ()) = + map { f1= (fun (type a) (module F : FloatDomain with type t = a) -> F.cos ~asPreciseAsConcrete ~notInf_notNaN); } let sin = map { f1= (fun (type a) (module F : FloatDomain with type t = a) -> F.sin); } let tan = diff --git a/src/cdomains/floatDomain.mli b/src/cdomains/floatDomain.mli index d958e1ee81..e978d3772b 100644 --- a/src/cdomains/floatDomain.mli +++ b/src/cdomains/floatDomain.mli @@ -48,7 +48,7 @@ module type FloatArith = sig val atan : t -> t (** atan(x) *) - val cos : t -> t + val cos : ?asPreciseAsConcrete:bool -> ?notInf_notNaN:bool -> t -> t (** cos(x) *) val sin : t -> t @@ -63,8 +63,10 @@ module type FloatArith = sig (** {inversions of unary functions}*) val inv_ceil : ?asPreciseAsConcrete:bool -> t -> t (** (inv_ceil z -> x) if (z = ceil(x)) *) + val inv_floor : ?asPreciseAsConcrete:bool -> t -> t (** (inv_floor z -> x) if (z = floor(x)) *) + val inv_fabs : t -> t (** (inv_fabs z -> x) if (z = fabs(x)) *) diff --git a/src/domains/queries.ml b/src/domains/queries.ml index b9fa28f5be..4824c5324b 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -16,6 +16,7 @@ module TC = WrapperFunctionAnalysis0.ThreadCreateUniqueCount module ThreadNodeLattice = Lattice.Prod (NFL) (TC) module ML = LibraryDesc.MathLifted +module MLInv = SetDomain.Reverse (SetDomain.ToppedSet (Lattice.Prod (Lattice.Flat (CilType.Exp) (Printable.DefaultNames)) (ML)) (struct let topname = "All" end)) module VI = Lattice.Flat (Basetype.Variables) (struct let top_name = "Unknown line" @@ -131,6 +132,7 @@ type _ t = | MustTermAllLoops: MustBool.t t | IsEverMultiThreaded: MayBool.t t | TmpSpecial: Mval.Exp.t -> ML.t t + | TmpSpecialInv: Mval.Exp.t -> MLInv.t t type 'a result = 'a @@ -200,6 +202,7 @@ struct | MustTermAllLoops -> (module MustBool) | IsEverMultiThreaded -> (module MayBool) | TmpSpecial _ -> (module ML) + | TmpSpecialInv _ -> (module MLInv) (** Get bottom result for query. *) let bot (type a) (q: a t): a result = @@ -268,6 +271,7 @@ struct | MustTermAllLoops -> MustBool.top () | IsEverMultiThreaded -> MayBool.top () | TmpSpecial _ -> ML.top () + | TmpSpecialInv _ -> MLInv.top () end (* The type any_query can't be directly defined in Any as t, @@ -332,7 +336,8 @@ struct | Any MustTermAllLoops -> 54 | Any IsEverMultiThreaded -> 55 | Any (TmpSpecial _) -> 56 - | Any (IsAllocVar _) -> 57 + | Any (TmpSpecialInv _) -> 57 + | Any (IsAllocVar _) -> 58 let rec compare a b = let r = Stdlib.compare (order a) (order b) in @@ -489,6 +494,7 @@ struct | Any MustTermAllLoops -> Pretty.dprintf "MustTermAllLoops" | Any IsEverMultiThreaded -> Pretty.dprintf "IsEverMultiThreaded" | Any (TmpSpecial lv) -> Pretty.dprintf "TmpSpecial %a" Mval.Exp.pretty lv + | Any (TmpSpecialInv lv) -> Pretty.dprintf "TmpSpecialInv %a" Mval.Exp.pretty lv end let to_value_domain_ask (ask: ask) =