let frama_c_alloc_infinite state actuals =
try
let file = match actuals with
| [_,file,_] -> file
| _ -> raise Invalid_CEA_alloc_infinite
in
let file_base,_file_offset =
try
Cvalue_type.V.find_lonely_key file
with Not_found -> raise Not_found_lonely_key
in
let file = match file_base with
| Base.String (_,s) -> s
| Base.Var (s,_) | Base.Initialized_Var (s,_) -> s.Cil_types.vname
| Base.Null | Base.Cell_class _ -> raise Invalid_CEA_alloc_infinite
in
let loc =
Dynamic_Alloc_Table.memo
(fun file ->
let new_name =
if Extlib.string_prefix ~strict:true "Frama_C_alloc_" file
then file
else Format.sprintf "Frama_C_alloc_%s" file
in
let new_name = Cabs2cil.fresh_global new_name in
let unbounded_type =
Cil_types.TArray
(intType,
Some (new_exp ~loc:Cil_datatype.Location.unknown
(Cil_types.Const (Cil_types.CStr "NOSIZE"))),
empty_size_cache (),[])
in
let new_varinfo =
makeGlobalVar ~logic:true new_name unbounded_type
in
let new_offsetmap =
Cvalue_type.V_Offsetmap.sized_zero (Bit_utils.memory_size ())
in
let new_base =
Cvalue_type.Default_offsetmap.create_initialized_var
new_varinfo
Base.All
new_offsetmap
in
Location_Bytes.inject new_base Ival.zero)
file
in
wrap_ptr loc, state, Location_Bits.Top_Param.bottom
with
| Ival.Error_Top | Invalid_CEA_alloc_infinite
| Not_found_lonely_key
-> Value_parameters.error
"Invalid argument for Frama_C_alloc_infinite function";
do_degenerate None;
raise Db.Value.Aborted
| Not_found -> assert false