Local Open Scope pred.
(* Scall *)
Fixpoint alloc_juicy_variables (ge: genv) (rho: env) (jm: juicy_mem) (vl: list (ident*type)) : env * juicy_mem :=
match vl with
| nil => (rho,jm)
| (id,ty)::vars => match JuicyMemOps.juicy_mem_alloc jm 0 (@sizeof ge ty) with
(m1,b1) => alloc_juicy_variables ge (PTree.set id (b1,ty) rho) m1 vars
end
end.
Definition substopt {A} (ret: option ident) (v: val) (P: environ -> A)  : environ -> A :=
match ret with
| Some id => subst id v P
| None => P
end.
Definition freeable_blocks: list (block * BinInt.Z * BinInt.Z) -> mpred :=
fold_right (fun (bb: block*BinInt.Z * BinInt.Z) a =>
match bb with (b,lo,hi) =>
sepcon (VALspec_range (hi-lo) Share.top (b,lo)) a
end)
emp.
Inductive free_list_juicy_mem:
forall  (jm: juicy_mem) (bl: list (block * BinInt.Z * BinInt.Z))
(jm': juicy_mem), Prop :=
| FLJM_nil: forall jm, free_list_juicy_mem jm nil jm
| FLJM_cons: forall jm b lo hi bl jm2 jm'
(H: free (m_dry jm) b lo hi = Some (m_dry jm2))
(H0 : forall ofs : Z,
lo <= ofs < hi ->
perm_of_res (m_phi jm @ (b, ofs)) = Some Freeable),
free_juicy_mem jm (m_dry jm2) b lo hi H = jm2 ->
free_list_juicy_mem jm2 bl jm' ->
free_list_juicy_mem jm ((b,lo,hi)::bl) jm'.
Definition maybe_retval (Q: environ -> mpred) retty ret :=
match ret with
| Some id => fun rho => Q (get_result1 id rho)
| None =>
match retty with
| Tvoid => (fun rho => Q (globals_only rho))
| _ => fun rho => EX v: val, Q (make_args (ret_temp::nil) (v::nil) rho)
end
end.
Definition tc_fn_return (Delta: tycontext) (ret: option ident) (t: type) :=
match ret with
| None => True
| Some i => match (temp_types Delta) ! i with Some t' => t=t' | _ => False end
end.
Definition thisvar (ret: option ident) (i : ident) : Prop :=
match ret with None => False | Some x => x=i end.
(* bind_parameter_temps params args (create_undef_temps (fn_temps f)) = Some te' -> alloc_juicy_variables psi empty_env jmx (fn_vars f) = (ve', jm'') -> P ts x (make_args (map fst (fst fsig)) args (construct_rho (filter_genv psi) vx tx)) |-- close_precondition (map fst (fst fsig)) (map fst params) (P ts x) (construct_rho (filter_genv psi) ve' te') *)
Definition globals_only (rho: environ) : environ := (mkEnviron (ge_of rho) (Map.empty _) (Map.empty _)).
Fixpoint make_args' (il: list ident) (vl: list val)  : tenviron :=
match il, vl with
| i::il', v::vl' => Map.set i v (make_args' il' vl')
| _, _ => Map.empty _
end.

Lemma semax_call_aux2:
forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext)
(A : TypeTree)
(P Q : forall ts : list Type,
_functor (dependent_type_functor_rec ts (AssertTT A)) mpred)
(ts : list Type)
(x : _functor (dependent_type_functor_rec ts A) mpred)
(F : environ -> pred rmap)
(F0 : assert)
(ret : option ident)
(curf : function)
(fsig : funsig)
(cc : calling_convention)
(a : expr) (bl : list expr) (R : ret_assert)
(psi : genv)
(ora : OK_ty) (jm jmx : juicy_mem)
(f : function)
(NEP : super_non_expansive P)
(NEQ : super_non_expansive Q)
(Hora : app_pred (juicy_mem_op (ext_compat ora)) jm)
(TCret : tc_fn_return Delta ret (snd fsig))
(TC5 : snd fsig = Tvoid -> ret = None)
(H : closed_wrt_modvars (Scall ret a bl) F0)
(HR : app_pred
(ALL rho' : environ,
|> ! ((EX old : val,
substopt ret old F rho' *
maybe_retval (Q ts x) (snd fsig) ret rho') >=>
RA_normal R rho')) (m_phi jm))
(HGG : cenv_sub cenv_cs (genv_cenv psi))
(H13 : age1 jm = Some jmx)
(COMPLETE : Forall
(fun it : ident * type => complete_type cenv_cs (snd it) = true)
(fn_vars f))
(H17 : list_norepet (map fst (fn_params f) ++ map fst (fn_temps f)))
(H17' : list_norepet (map fst (fn_vars f)))
(H18 : map snd (fst fsig) = map snd (fst (fn_funsig f)) /\
snd fsig = snd (fn_funsig f) /\ list_norepet (map fst (fst fsig))),
forall vx tx k rho
(H0 : rho = construct_rho (filter_genv psi) vx tx)
(H1 : app_pred (|> rguard Espec psi Delta curf (frame_ret_assert R F0) k)
(level (m_phi jm)))
(TC3 : guard_environ Delta curf rho),
app_pred
(!! closed_wrt_modvars (fn_body f) (fun _ : environ => F0 rho * F rho) &&
rguard Espec psi (func_tycontext' f Delta) f
(frame_ret_assert
(frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts x))
(stackframe_of' cenv_cs f)) (fun _ : environ => F0 rho * F rho))
(Kcall ret curf vx tx k)) (level jmx).