let alloc_with_validity initial_state actuals =
try
let size = match actuals with
| [_,size,_] -> size
| _ -> raise Invalid_CEA_alloc
in
let size =
try
let size = Cvalue.V.project_ival size in
Ival.project_int size
with Ival.Not_Singleton_Int | V.Not_based_on_null ->
raise Invalid_CEA_alloc
in
if Int.le size Int.zero then raise Invalid_CEA_alloc;
let new_name = Format.sprintf "Frama_C_alloc" in
let new_name = Cabs2cil.fresh_global new_name in
let bounded_type =
TArray(
charType,
Some (new_exp ~loc:Cil_datatype.Location.unknown
(Const (CInt64 (size,IInt ,None)))),
empty_size_cache (),
[])
in
let new_varinfo = makeGlobalVar ~logic:true new_name bounded_type in
let size_in_bits = Int.mul (Bit_utils.sizeofchar()) size in
let new_offsetmap = Cvalue.V_Offsetmap.sized_zero ~size_in_bits in
let new_base =
Cvalue.Default_offsetmap.create_initialized_var
new_varinfo
(Base.Known (Int.zero, Int.pred size_in_bits))
new_offsetmap
in
let loc_without_size = Location_Bytes.inject new_base Ival.zero in
(wrap_ptr loc_without_size),
initial_state,
Location_Bits.Top_Param.bottom
with Ival.Error_Top | Invalid_CEA_alloc ->
Value_parameters.error
"Invalid argument for Frama_C_alloc_size function";
do_degenerate None;
raise Db.Value.Aborted