Section CLC_SEM.
Definition F: Type := fundef.
Definition V: Type := type.
Definition G := genv.
Definition C := CC_core.
Definition getEnv (g:G): Genv.t F V := genv_genv g.
(* We might want to define this properly or factor the machines so we don't need events here. *)
(** Transition relation *)
Inductive cl_evstep (ge: Clight.genv): forall (q: CC_core) (m: mem) (T:list mem_event) (q': CC_core) (m': mem), Prop :=
| evstep_assign:   forall f a1 a2 k e le m loc ofs v2 v m' T1 T2 T3,
(*     type_is_volatile (typeof a1) = false ->*)
eval_lvalueT ge e le m a1 loc ofs T1 ->
eval_exprT ge e le m a2 v2 T2 ->
sem_cast v2 (typeof a2) (typeof a1) m = Some v ->
assign_locT ge (typeof a1) m loc ofs v m' T3 ->
cl_evstep ge (State f (Sassign a1 a2) k e le) m (T1++T2++T3)
(State f Sskip k e le) m'
| evstep_set:   forall f id a k e le m v T,
eval_exprT ge e le m a v T ->
cl_evstep ge (State f (Sset id a) k e le) m T
(State f Sskip k e (PTree.set id v le)) m
| evstep_call:   forall f optid a al k e le m tyargs tyres cconv vf vargs fd T1 T2,
classify_fun (typeof a) = fun_case_f tyargs tyres cconv ->
eval_exprT ge e le m a vf T1 ->
eval_exprTlist ge e le m al tyargs vargs T2 ->
Genv.find_funct ge vf = Some fd ->
type_of_fundef fd = Tfunction tyargs tyres cconv ->
cl_evstep ge (State f (Scall optid a al) k e le) m (T1++T2)
(Callstate fd vargs (Kcall optid f e le k)) m
| evstep_seq:  forall f s1 s2 k e le m,
cl_evstep ge (State f (Ssequence s1 s2) k e le) m nil
(State f s1 (Kseq s2 k) e le) m
| evstep_skip_seq: forall f s k e le m,
cl_evstep ge (State f Sskip (Kseq s k) e le) m nil
(State f s k e le) m
| evstep_continue_seq: forall f s k e le m,
cl_evstep ge (State f Scontinue (Kseq s k) e le) m nil
(State f Scontinue k e le) m
| evstep_break_seq: forall f s k e le m,
cl_evstep ge (State f Sbreak (Kseq s k) e le) m nil
(State f Sbreak k e le) m
| evstep_ifthenelse:  forall f a s1 s2 k e le m v1 b T,
eval_exprT ge e le m a v1 T ->
bool_val v1 (typeof a) m = Some b ->
cl_evstep ge (State f (Sifthenelse a s1 s2) k e le) m T
(State f (if b then s1 else s2) k e le) m
| evstep_loop: forall f s1 s2 k e le m,
cl_evstep ge (State f (Sloop s1 s2) k e le) m nil
(State f s1 (Kloop1 s1 s2 k) e le) m
| evstep_skip_or_continue_loop1:  forall f s1 s2 k e le m x,
x = Sskip \/ x = Scontinue ->
cl_evstep ge (State f x (Kloop1 s1 s2 k) e le) m nil
(State f s2 (Kloop2 s1 s2 k) e le) m
| evstep_break_loop1:  forall f s1 s2 k e le m,
cl_evstep ge (State f Sbreak (Kloop1 s1 s2 k) e le) m nil
(State f Sskip k e le) m
| evstep_skip_loop2: forall f s1 s2 k e le m,
cl_evstep ge (State f Sskip (Kloop2 s1 s2 k) e le) m nil
(State f (Sloop s1 s2) k e le) m
| evstep_break_loop2: forall f s1 s2 k e le m,
cl_evstep ge (State f Sbreak (Kloop2 s1 s2 k) e le) m nil
(State f Sskip k e le) m
| evstep_return_0: forall f k e le m m',
Mem.free_list m (blocks_of_env ge e) = Some m' ->
cl_evstep ge (State f (Sreturn None) k e le) m
(Free (Clight.blocks_of_env ge e)::nil)
(Returnstate Vundef (call_cont k)) m'
| evstep_return_1: forall f a k e le m v v' m' T,
eval_exprT ge e le m a v T ->
sem_cast v (typeof a) f.(fn_return) m = Some v' ->
Mem.free_list m (blocks_of_env ge e) = Some m' ->
cl_evstep ge (State f (Sreturn (Some a)) k e le) m
(T ++ Free (Clight.blocks_of_env ge e)::nil)
(Returnstate v' (call_cont k)) m'
| evstep_skip_call: forall f k e le m m',
is_call_cont k ->
Mem.free_list m (blocks_of_env ge e) = Some m' ->
cl_evstep ge (State f Sskip k e le) m
(Free (Clight.blocks_of_env ge e)::nil)
(Returnstate Vundef k) m'
| evstep_switch: forall f a sl k e le m v n T,
eval_exprT ge e le m a v T ->
sem_switch_arg v (typeof a) = Some n ->
cl_evstep ge (State f (Sswitch a sl) k e le) m T
(State f (seq_of_labeled_statement (select_switch n sl)) (Kswitch k) e le) m
| evstep_skip_break_switch: forall f x k e le m,
x = Sskip \/ x = Sbreak ->
cl_evstep ge (State f x (Kswitch k) e le) m nil
(State f Sskip k e le) m
| evstep_continue_switch: forall f k e le m,
cl_evstep ge (State f Scontinue (Kswitch k) e le) m nil
(State f Scontinue k e le) m
| evstep_label: forall f lbl s k e le m,
cl_evstep ge (State f (Slabel lbl s) k e le) m nil
(State f s k e le) m
| evstep_goto: forall f lbl k e le m s' k',
find_label lbl f.(fn_body) (call_cont k) = Some (s', k') ->
cl_evstep ge (State f (Sgoto lbl) k e le) m nil
(State f s' k' e le) m
| evstep_internal_function: forall f vargs k m e le m1 T,
list_norepet (var_names (fn_params f)) ->
list_disjoint (var_names (fn_params f)) (var_names (fn_temps f)) ->
forall (NRV: list_norepet (var_names f.(fn_vars))),
alloc_variablesT ge empty_env m (f.(fn_vars)) e m1 T ->
bind_parameter_temps f.(fn_params) vargs (create_undef_temps f.(fn_temps)) = Some
le ->
cl_evstep ge (Callstate (Internal f) vargs k) m T
(State f f.(fn_body) k e le) m1
| evstep_external_function: forall ef targs tres cconv vargs k m t vres m' T
(EFI: ef_inline ef = true)
(EC: Events.external_call ef ge vargs m t vres m'),
T = proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EC) ->
cl_evstep ge (Callstate (External ef targs tres cconv) vargs k) m T
(Returnstate vres k) m'
| evstep_returnstate: forall v optid f e le k m,
cl_evstep ge (Returnstate v (Kcall optid f e le k)) m nil
(State f Sskip k e (set_opttemp optid v le)) m.
(** *Event semantics for Clight_new*)
(* This should be a version of CLN_memsem annotated with memory events.*)
Program Definition CLC_evsem ge : @EvSem C := {| msem := CLC_memsem ge; ev_step := cl_evstep ge |}.
Next Obligation. apply CLC_evstep_ax1. Qed.
Next Obligation. apply CLC_evstep_ax2. Qed.
(*  Next Obligation. apply CLC_evstep_fun. Qed. *)
Next Obligation. apply CLC_evstep_elim. Qed.
inversion BE1; inv BE2; try discriminate; try contradiction; simpl in *; trivial.
+ assert (Vptrofs n0 = Vptrofs n) as H by congruence.
rewrite H; rewrite (Vptrofs_inj _ _ H) in *.
rewrite ALLOC0 in ALLOC; inv ALLOC; trivial.
+ inv H5.
rewrite LB0 in LB; inv LB. rewrite <- SZ in SZ0. rewrite (Vptrofs_inj _ _ SZ0); trivial.
+ inv H3; inv H5.
rewrite LB0 in LB; inv LB; trivial.
Qed.
(* extending Clight_sim to event semantics *)
Inductive ev_star ge: state -> mem -> _ -> state -> mem -> Prop :=
| ev_star_refl: forall s m,
ev_star ge s m nil s m
| ev_star_step: forall s1 m1 ev1 s2 m2 ev2 s3 m3,
ev_step (CLC_evsem ge) s1 m1 ev1 s2 m2 -> ev_star ge s2 m2 ev2 s3 m3 ->
ev_star ge s1 m1 (ev1 ++ ev2) s3 m3.

Lemma ev_star_two:
forall ge s1 m1 ev1 s2 m2 ev2 s3 m3,
ev_step (CLC_evsem ge) s1 m1 ev1 s2 m2 -> ev_step (CLC_evsem ge) s2 m2 ev2 s3 m3 ->
ev_star ge s1 m1 (ev1 ++ ev2) s3 m3.