let isCrossableAtInit tr func =
let eval_term_at_init t =
if Kernel.LibEntry.get() then t
else begin
let bool_res test =
if test then Cil.lconstant My_bigint.one else Cil.lzero ()
in
let bool3_res dft test =
match test with
| True -> bool_res true
| False -> bool_res false
| Undefined -> dft
in
let is_true t =
match t with
| TConst(CInt64(i,_,_)) ->
Bool3.bool3_of_bool (not (My_bigint.is_zero i))
| TConst(CChr c) -> Bool3.bool3_of_bool (not (Char.code c <> 0))
| TConst(CReal (f,_,_)) -> Bool3.bool3_of_bool (not (f <> 0.))
| TConst(CStr _ | CWStr _) -> Bool3.True
| _ -> Bool3.Undefined
in
let rec aux t =
match t.term_node with
| TConst (CEnum ei) ->
aux (Logic_utils.expr_to_term ~cast:false ei.eival)
| TLval lv ->
(match aux_lv lv with
| Some t -> t
| None -> t)
| TUnOp(op,t1) ->
let t1 = aux t1 in
(match op,t1.term_node with
| Neg, TConst(CInt64(i,ik,_)) ->
{ t with term_node = TConst(CInt64(My_bigint.neg i,ik,None)) }
| Neg, TConst(CReal(f,fk,_)) ->
{ t with term_node = TConst(CReal(~-. f,fk,None)) }
| LNot, t1 -> bool3_res t (is_true t1)
| _ -> t)
| TBinOp(op,t1,t2) ->
let t1 = aux t1 in
let t2 = aux t2 in
let rec comparison comp t1 t2 =
match t1.term_node,t2.term_node with
| TConst (CInt64(i1,_,_)), TConst (CInt64(i2,_,_)) ->
bool_res (comp (My_bigint.compare i1 i2))
| TConst (CChr c1), TConst (CChr c2) ->
bool_res (comp (Char.compare c1 c2))
| TConst(CReal (f1,_,_)), TConst (CReal(f2,_,_)) ->
bool_res (comp (compare f1 f2))
| TCastE(ty1,t1), TCastE(ty2,t2)
when Cil_datatype.Typ.equal ty1 ty2 ->
comparison comp t1 t2
| _ -> t
in
(match op, t1.term_node, t2.term_node with
| PlusA, TConst(CInt64(i1,ik1,_)), TConst(CInt64(i2,_,_)) ->
{ t with term_node =
TConst(CInt64(My_bigint.add i1 i2,ik1,None))}
| MinusA, TConst(CInt64(i1,ik1,_)), TConst(CInt64(i2,_,_)) ->
{ t with term_node =
TConst(CInt64(My_bigint.sub i1 i2,ik1,None)) }
| Mult, TConst(CInt64(i1,ik1,_)), TConst(CInt64(i2,_,_)) ->
{ t with term_node =
TConst(CInt64(My_bigint.mul i1 i2,ik1,None)) }
| Div, TConst(CInt64(i1,ik1,_)), TConst(CInt64(i2,_,_)) ->
(try
{ t with term_node =
TConst(CInt64(My_bigint.c_div i1 i2,ik1,None)) }
with Division_by_zero -> t)
| Mod, TConst(CInt64(i1,ik1,_)), TConst(CInt64(i2,_,_)) ->
(try
{ t with term_node =
TConst(CInt64(My_bigint.c_rem i1 i2,ik1,None)) }
with Division_by_zero -> t)
| Shiftlt, TConst(CInt64(i1,ik1,_)), TConst(CInt64(i2,_,_)) ->
{ t with term_node =
TConst(CInt64(My_bigint.shift_left i1 i2,ik1,None)) }
| Shiftrt, TConst(CInt64(i1,ik1,_)), TConst(CInt64(i2,_,_)) ->
{ t with term_node =
TConst(CInt64(My_bigint.shift_right i1 i2,ik1,None)) }
| Lt, _, _ -> comparison ((<) 0) t1 t2
| Gt, _, _ -> comparison ((>) 0) t1 t2
| Le, _, _ -> comparison ((<=) 0) t1 t2
| Ge, _, _ -> comparison ((>=) 0) t1 t2
| Eq, _, _ -> comparison ((=) 0) t1 t2
| Ne, _, _ -> comparison ((<>) 0) t1 t2
| LAnd, t1, t2 ->
bool3_res t (Bool3.bool3and (is_true t1) (is_true t2))
| LOr, t1, t2 ->
bool3_res t (Bool3.bool3or (is_true t1) (is_true t2))
| _ -> t)
| TCastE(ty,t1) ->
let t1 = aux t1 in
(match t1.term_type with
Ctype ty1 when Cil_datatype.Typ.equal ty ty1 -> t1
| _ -> { t with term_node = TCastE(ty,t1) })
| _ -> t
and aux_lv (base,off) =
match base with
| TVar v ->
(try
Extlib.opt_bind
(fun v ->
let init = Globals.Vars.find v in
let init = match init.Cil_types.init with
None -> Cil.makeZeroInit ~loc:v.vdecl v.vtype
| Some i -> i
in
aux_init off init)
v.lv_origin
with Not_found -> None)
| TMem t ->
(match (aux t).term_node with
| TAddrOf lv -> aux_lv (Cil.addTermOffsetLval off lv)
| _ -> None)
| TResult _ -> None
and aux_init off initinfo =
match off, initinfo with
| TNoOffset, SingleInit e ->
Some (aux (Logic_utils.expr_to_term ~cast:false e))
| TIndex(t,oth), CompoundInit (ct,initl) ->
(match (aux t).term_node with
| TConst(CInt64(i1,_,_)) ->
Cil.foldLeftCompound ~implicit:true
~doinit:
(fun o i _ t ->
match o with
| Index({ enode = Const(CInt64(i2,_,_))},_)
when My_bigint.equal i1 i2 -> aux_init oth i
| _ -> t)
~ct ~initl ~acc:None
| _ -> None)
| TField(f1,oth), CompoundInit(ct,initl) ->
Cil.foldLeftCompound ~implicit:true
~doinit:
(fun o i _ t ->
match o with
| Field(f2,_) when Cil_datatype.Fieldinfo.equal f1 f2 ->
aux_init oth i
| _ -> t)
~ct ~initl ~acc:None
| _ -> None
in
aux t
end
in
let eval_rel_at_init rel t1 t2 =
let t1 = eval_term_at_init (Cil.constFoldTerm true t1) in
let t2 = eval_term_at_init (Cil.constFoldTerm true t2) in
let comp =
match rel with
| Req -> ((=) 0)
| Rneq -> ((<>) 0)
| Rge -> ((>=) 0)
| Rgt -> ((>) 0)
| Rle -> ((<=) 0)
| Rlt -> ((<) 0)
in
let rec comparison t1 t2 =
match t1.term_node,t2.term_node with
| TConst (CInt64(i1,_,_)), TConst (CInt64(i2,_,_)) ->
Bool3.bool3_of_bool (comp (My_bigint.compare i1 i2))
| TConst (CChr c1), TConst (CChr c2) ->
Bool3.bool3_of_bool (comp (Char.compare c1 c2))
| TConst(CReal (f1,_,_)), TConst (CReal(f2,_,_)) ->
Bool3.bool3_of_bool (comp (compare f1 f2))
| TCastE(ty1,t1), TCastE(ty2,t2) when Cil_datatype.Typ.equal ty1 ty2 ->
comparison t1 t2
| _ -> Bool3.Undefined
in
comparison t1 t2
in
let rec isCross = function
| TOr (c1, c2) -> Bool3.bool3or (isCross c1) (isCross c2)
| TAnd (c1, c2) -> Bool3.bool3and (isCross c1) (isCross c2)
| TNot (c1) -> Bool3.bool3not (isCross c1)
| TCall (s,None) -> Bool3.bool3_of_bool (Kernel_function.equal s func)
| TCall (s, Some _) when Kernel_function.equal s func -> Undefined
| TCall _ -> Bool3.False
| TReturn _ -> Bool3.False
| TTrue -> Bool3.True
| TFalse -> Bool3.False
| TRel(rel,t1,t2) -> eval_rel_at_init rel t1 t2
in
let (cond,_) = tr.cross in
match isCross cond with
| Bool3.True | Bool3.Undefined -> true
| Bool3.False -> false