let do_assign_abstract_value_to_loc ~with_alarms state lv loc_lv exp =
assert (not (Cvalue.V.is_bottom exp));
let exp =
try
let size = Int_Base.project loc_lv.size in
try
ignore (V.project_ival exp);
cast_lval_bitfield lv size exp
with
| V.Not_based_on_null ->
if Int.compare size (Int.of_int (sizeofpointer ())) >= 0
|| V.is_imprecise exp
then exp
else begin
Value_parameters.result
"casting address to a bit-field of %s bits: this is smaller than sizeof(void*)"
(Int.to_string size);
V.topify_arith_origin exp
end
| Neither_Int_Nor_Enum_Nor_Pointer
-> exp
with
| Int_Base.Error_Top | Int_Base.Error_Bottom ->
exp
in
let pretty_org fmt org = if not (Origin.is_top org) then
Format.fprintf fmt " because of %a" Origin.pretty org
in
(match loc_lv.loc with
| Location_Bits.Top (Location_Bits.Top_Param.Top, orig) ->
Value_parameters.result
"State before degeneration:@\n======%a@\n======="
Cvalue.Model.pretty state;
warning_once_current
"writing at a completely unknown address@[%a@].@\nAborting."
pretty_org orig;
do_degenerate (Some lv)
| Location_Bits.Top((Location_Bits.Top_Param.Set _) as param,orig) ->
Value_parameters.result ~current:true ~once:true
"writing somewhere in @[%a@]@[%a@]."
Location_Bits.Top_Param.pretty param
pretty_org orig
| Location_Bits.Map _ -> ());
let exact = valid_cardinal_zero_or_one ~for_writing:true loc_lv in
let value =
Cvalue.Model.add_binding ~with_alarms ~exact
state loc_lv exp
in
value