let frama_c_memcpy state actuals =
let compute (exp_dst,dst,_) (exp_src,src,_) (exp_size,size,_) =
warn_memcpy ();
if Value_parameters.ValShowProgress.get () then
Value_parameters.feedback "Call to builtin memcpy(%a)%t"
pretty_actuals actuals Value_util.pp_callstack;
let with_alarms = warn_all_quiet_mode () in
let size = Cvalue.V.project_ival size in
let min,max = Ival.min_and_max size in
let min = match min with None -> Int.zero | Some m -> Int.max m Int.zero in
let max = match max with None -> assert false | Some m -> m in
let size_min = Int.mul Int.eight min in
let right = loc_bytes_to_loc_bits src in
let left = loc_bytes_to_loc_bits dst in
let right_loc = make_loc right (Int_Base.inject size_min) in
let term_size = Logic_utils.expr_to_term ~cast:true exp_size in
let array_src = Logic_utils.array_with_range exp_src term_size in
let array_dst = Logic_utils.array_with_range exp_dst term_size in
CilE.set_syntactic_context (CilE.SyMemLogic array_src);
match Cvalue.Model.copy_offsetmap ~with_alarms right_loc state with
| None ->
None, Cvalue.Model.bottom, Location_Bits.Top_Param.bottom
| Some offsetmap ->
CilE.set_syntactic_context (CilE.SyMemLogic array_dst);
let new_state =
if Int.gt size_min Int.zero then
Cvalue.Model.paste_offsetmap with_alarms
offsetmap left Int.zero size_min true state
else state
in
if Int.equal min max then None, new_state, Location_Bits.get_bases right
else begin
let size_min_ival = Ival.inject_singleton size_min in
let left = Location_Bits.location_shift size_min_ival left in
let right = Location_Bits.location_shift size_min_ival right in
try
ignore (Ival.cardinal_less_than size 10);
let rec do_size s (left, right, prev_size, state) =
let s = Int.mul Int.eight s in
let diff = Int.sub s prev_size in
let right_loc = make_loc right (Int_Base.inject diff) in
if Int.equal s size_min then
(left, right, s, state)
else begin
CilE.set_syntactic_context (CilE.SyMemLogic array_src);
match Cvalue.Model.copy_offsetmap ~with_alarms
right_loc state
with
| None ->
raise (Memcpy_result state)
| Some offsetmap ->
CilE.set_syntactic_context (CilE.SyMemLogic array_dst);
let new_state =
Cvalue.Model.paste_offsetmap with_alarms
offsetmap left Int.zero diff false state
in
if Db.Value.is_reachable new_state then
let diffi = Ival.inject_singleton diff in
let left = Location_Bits.location_shift diffi left in
let right = Location_Bits.location_shift diffi right in
(left, right, s, new_state)
else
raise (Memcpy_result state)
end
in
let _, _, _, state = Ival.fold do_size size
(left, right, Int.zero, new_state)
in
raise (Memcpy_result state)
with
| Memcpy_result new_state ->
wrap_ptr dst, new_state, Location_Bits.get_bases right
| Abstract_interp.Not_less_than ->
let diff = Int.mul Int.eight (Int.sub max min) in
let range = Ival.inject_top
(Some Int.zero) (Some diff) Int.zero Int.eight in
let right = Location_Bits.location_shift range right in
let loc_right = make_loc right (Int_Base.inject Int.eight) in
let left = Location_Bits.location_shift range left in
let loc_left = make_loc left (Int_Base.inject Int.eight) in
CilE.set_syntactic_context (CilE.SyMemLogic array_src);
let v =
Cvalue.Model.find ~with_alarms
~conflate_bottom:false state loc_right
in
CilE.set_syntactic_context (CilE.SyMemLogic array_dst);
let new_state = Cvalue.Model.add_binding ~with_alarms
~exact:false new_state loc_left v
in
wrap_ptr dst, new_state, Location_Bits.get_bases right
end
in
try
match actuals with
| [dst; src; size] -> compute dst src size
| _ -> raise Db.Value.Outside_builtin_possibilities
with
| V.Not_based_on_null
| Lmap.Cannot_copy
| Db.Value.Outside_builtin_possibilities ->
Value_parameters.result
"Invalid call to Frama_C_memcpy builtin %a"
pretty_actuals actuals;
raise Db.Value.Outside_builtin_possibilities
| Db.Value.Aborted ->
Value_parameters.error
"Invalid call to Frama_C_memcpy%a"
pretty_actuals actuals;
do_degenerate None;
raise Db.Value.Aborted