let do_assign_abstract_value_to_loc ~with_alarms state lv loc_lv exp =
assert (not (Cvalue_type.V.is_bottom exp));
let exp =
try
let size = Int_Base.project loc_lv.size in
try
let old_ival = V.find_ival exp in
let exp =
V.inject_ival
(Ival.cast
~size
~signed:(signof_typeof_lval lv)
~value:old_ival)
in
exp
with
| V.Not_based_on_null ->
if Int.compare size (Int.of_int (sizeofpointer ())) >= 0
|| V.is_top exp
then exp
else begin
Value_parameters.result "casting address to a bitfield 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======="
Relations_type.Model.pretty state;
Value_parameters.warning ~once:true
"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 loc_lv in
let value =
Relations_type.Model.add_binding ~with_alarms ~exact
state loc_lv exp
in
value