let rec instruction = function
| Set(lv,e,pos) ->
let enode = JCPEassign(lval pos lv,expr pos e) in
(locate (mkexpr enode pos))#node
| Call(None,{enode = Lval(Var v,NoOffset)},eargs,pos) ->
if is_assert_function v then
JCPEassert([new identifier name_of_default_behavior],
Aassert,locate (boolean_expr pos (as_singleton eargs)))
else
let enode =
if is_free_function v then
let arg = as_singleton eargs in
let subarg = stripCasts arg in
let arg = if isPointerType (typeOf subarg) then subarg else arg in
JCPEfree(expr pos arg)
else
JCPEapp(v.vname,[],
keep_only_declared_nb_of_arguments
v
(List.map (expr pos) eargs))
in
(locate (mkexpr enode pos))#node
| Call(Some lv,{enode = Lval(Var v,NoOffset)},eargs,pos) ->
let enode =
if is_malloc_function v || is_realloc_function v then
let lvtyp = pointed_type (typeOfLval lv) in
let lvsiz = (bits_sizeof lvtyp) lsr 3 in
let arg =
if is_malloc_function v then as_singleton eargs
else
match eargs with [ _; arg ] -> arg | _ -> assert false
in
let arg = stripInfo arg in
let ty,arg = match arg.enode with
| Info _ -> assert false
| Const c when is_integral_const c ->
let allocsiz = (value_of_integral_expr arg) / lvsiz in
let siznode = JCPEconst(JCCinteger(Int64.to_string allocsiz)) in
lvtyp, mkexpr siznode pos
| BinOp(Mult,({enode = Const c} as arg),nelem,_ty)
| BinOp(Mult,nelem,({enode = Const c} as arg),_ty)
when is_integral_const c ->
let factor = (value_of_integral_expr arg) / lvsiz in
let siz =
if factor = Int64.one then
expr pos nelem
else
let factor = constant_expr factor in
expr pos (new_exp(BinOp(Mult,nelem,factor,typeOf arg)))
in
lvtyp, siz
| _ ->
if lvsiz = Int64.one then
lvtyp, expr pos arg
else
let esiz = constant_expr lvsiz in
lvtyp, expr pos (new_exp (BinOp(Div,arg,esiz,typeOf arg)))
in
let name_of_type = match unrollType ty with
| TComp(compinfo,_,_) -> compinfo.cname
| _ -> assert false
in
JCPEalloc(arg,name_of_type)
else if is_calloc_function v then
let nelem,elsize = match eargs with
| [nelem;elsize] -> nelem,elsize
| _ -> assert false
in
let arg = stripInfo elsize in
let ty,arg = match arg.enode with
| Info _ -> assert false
| Const c when is_integral_const c ->
let lvtyp = pointed_type (typeOfLval lv) in
let lvsiz = (bits_sizeof lvtyp) lsr 3 in
let factor = (value_of_integral_expr arg) / lvsiz in
let siz =
if factor = Int64.one then
expr pos nelem
else
let factor = constant_expr factor in
expr pos (new_exp (BinOp(Mult,nelem,factor,typeOf arg)))
in
lvtyp, siz
| _ ->
let lvtyp = pointed_type (typeOfLval lv) in
let lvsiz = (bits_sizeof lvtyp) lsr 3 in
let esiz = constant_expr lvsiz in
lvtyp,
expr pos
(new_exp
(BinOp(Div,
new_exp (BinOp(Mult,nelem,elsize,typeOf arg)),
esiz,
typeOf arg)))
in
let name_of_type = match unrollType ty with
| TComp(compinfo,_,_) -> compinfo.cname
| _ -> assert false
in
JCPEalloc(arg,name_of_type)
else
JCPEapp(v.vname,[],
keep_only_declared_nb_of_arguments
v
(List.map (expr pos) eargs))
in
let lvty = typeOfLval lv in
let call = locate (mkexpr enode pos) in
let enode =
if TypeComparable.equal lvty (getReturnType v.vtype)
|| is_malloc_function v
|| is_realloc_function v
|| is_calloc_function v
then
JCPEassign(lval pos lv,call)
else
let tmpv = makeTempVar (get_curFundec()) (getReturnType v.vtype) in
let tmplv = Var tmpv, NoOffset in
let cast = new_exp (CastE(lvty,new_exp(Lval tmplv))) in
let tmpassign = JCPEassign(lval pos lv,expr pos cast) in
JCPElet(None,tmpv.vname,Some call,locate (mkexpr tmpassign pos))
in
(locate (mkexpr enode pos))#node
| Call _ -> assert false
| Asm _ -> assert false
| Skip _pos -> JCPEconst JCCvoid
| Code_annot _ -> JCPEconst JCCvoid