method vexpr expr =
self#on_current_stmt
DoChildren
(fun ki ->
PropagationParameters.debug ~level:2
"Replacing %a ?" !Ast_printer.d_exp expr;
let type_of_expr = typeOf expr in
try
begin
match unrollType type_of_expr with
| (TInt _
| TFloat _
| TPtr _
| TEnum _) -> ()
| _ -> raise Cannot_expand
end;
let mkCast ~e ~newt =
(* introduce a new cast or do not expand [e] *)
let exp = mkCast e newt in
if cast_intro then
exp
else
match exp.enode with
| CastE _ ->
if exp == e (* older cast, no new cast added *) then
exp
else
(* without [cast_intro], introducing such a cast is not
allowed: do not expand [e] *)
raise Cannot_expand
| _ ->
(* remember the change done by [mkCast] (if any).
note that [mkCast] make some modifications, even if it
does not introduce a new cast. *)
exp
in
let evaled = !Value.access_expr ki expr in
let k,m = Cvalue_type.V.find_lonely_binding evaled in
let can_replace vi =
vi.vglob ||
Extlib.may_map
(Kernel_function.is_formal_or_local vi) ~dft:false
self#current_kf
in
begin
match k with
| Base.Var (vi,_) | Base.Initialized_Var (vi,_)
when not vi.vlogic && can_replace vi ->
if vi.vglob && not (Varinfo.Set.mem vi known_globals)
then begin
let vi = Visitor.visitFramacVarDecl
(self:>Visitor.frama_c_visitor) vi
in
must_add_decl <- Varinfo.Set.add vi must_add_decl;
end;
(* This is a pointer coming for C code *)
PropagationParameters.debug
"Trying replacing %a from a pointer value {&%a + %a}"
!Ast_printer.d_exp expr
Base.pretty k
Ival.pretty m;
let base = mkAddrOrStartOf ~loc:expr.eloc (var vi) in
let offset = Ival.project_int m in (* these are bytes *)
let shifted =
if Abstract_interp.Int.is_zero offset then base
else
let offset,rem =
let sizeof_pointed =
try
Int_Base.project
(if isArrayType vi.vtype then
Bit_utils.osizeof_pointed vi.vtype
else
Bit_utils.osizeof vi.vtype)
with
| Int_Base.Error_Top
| Int_Base.Error_Bottom -> raise Cannot_expand
in (Abstract_interp.Int.pos_div offset sizeof_pointed),
(Abstract_interp.Int.pos_rem offset sizeof_pointed)
in let shifted =
if Abstract_interp.Int.is_zero offset
then base
else let v1 = Abstract_interp.Int.cast
~signed:true
~size:(Abstract_interp.Int.of_int 64)
~value:offset
in increm64 base (Abstract_interp.Int.to_int64 v1)
in if Abstract_interp.Int.is_zero rem
then shifted
else let v1 = Abstract_interp.Int.cast
~signed:true
~size:(Abstract_interp.Int.of_int 64)
~value:rem
in increm64 (mkCast ~e:shifted ~newt:Cil.charPtrType)
(Abstract_interp.Int.to_int64 v1)
in let change_to = (* Give it the right type! *)
mkCast ~e:shifted ~newt:type_of_expr
in
PropagationParameters.debug "Replacing %a with %a"
!Ast_printer.d_exp expr
!Ast_printer.d_exp change_to;
ChangeDoChildrenPost (change_to, fun x -> x)
| Base.Null ->
let e =
begin
try
(* This is an integer *)
let v = Ival.project_int m in
PropagationParameters.debug
"Trying replacing %a with a numeric value: %a"
!Ast_printer.d_exp expr
Abstract_interp.Int.pretty v;
try
let v1 = Abstract_interp.Int.cast
~signed:true
~size:(Abstract_interp.Int.of_int 64)
~value:v
in
(* PropagationParameters.debug "XXXXXXXX v=%a v1=%a"
Abstract_interp.Int.pretty v
Abstract_interp.Int.pretty v1; *)
kinteger64 ~loc:expr.eloc
IULongLong
(Abstract_interp.Int.to_int64 v1)
with Failure _ -> raise Cannot_expand
with Ival.Not_Singleton_Int->
(* TODO: floats *)
raise Cannot_expand
end
in let change_to = (* Give it the right type ! *)
mkCast ~e ~newt:(type_of_expr)
in
PropagationParameters.debug "Replacing %a with %a"
!Ast_printer.d_exp expr
!Ast_printer.d_exp change_to;
ChangeDoChildrenPost(change_to,fun x -> x)
| Base.Cell_class _ | Base.String _
| Base.Var _ | Base.Initialized_Var _ -> DoChildren
end
with Not_found | Cannot_expand -> DoChildren)