Section EXPR.
Variable e: env.
Variable le: temp_env.
Variable m: mem.
(** [eval_expr ge e m a v] defines the evaluation of expression [a] in r-value position.  [v] is the value of the expression. [e] is the current environment and [m] is the current memory state. *)
Inductive eval_expr: expr -> val -> Prop :=
| eval_Econst_int:   forall i ty,
eval_expr (Econst_int i ty) (Vint i)
| eval_Econst_float:   forall f ty,
eval_expr (Econst_float f ty) (Vfloat f)
| eval_Econst_single:   forall f ty,
eval_expr (Econst_single f ty) (Vsingle f)
| eval_Econst_long:   forall i ty,
eval_expr (Econst_long i ty) (Vlong i)
| eval_Etempvar:  forall id ty v,
le!id = Some v ->
eval_expr (Etempvar id ty) v
| eval_Eaddrof: forall a ty loc ofs,
eval_lvalue a loc ofs ->
eval_expr (Eaddrof a ty) (Vptr loc ofs)
| eval_Eunop:  forall op a ty v1 v,
eval_expr a v1 ->
sem_unary_operation op v1 (typeof a) m = Some v ->
eval_expr (Eunop op a ty) v
| eval_Ebinop: forall op a1 a2 ty v1 v2 v,
eval_expr a1 v1 ->
eval_expr a2 v2 ->
sem_binary_operation ge op v1 (typeof a1) v2 (typeof a2) m = Some v ->
eval_expr (Ebinop op a1 a2 ty) v
| eval_Ecast:   forall a ty v1 v,
eval_expr a v1 ->
sem_cast v1 (typeof a) ty m = Some v ->
eval_expr (Ecast a ty) v
| eval_Esizeof: forall ty1 ty,
eval_expr (Esizeof ty1 ty) (Vptrofs (Ptrofs.repr (sizeof ge ty1)))
| eval_Ealignof: forall ty1 ty,
eval_expr (Ealignof ty1 ty) (Vptrofs (Ptrofs.repr (alignof ge ty1)))
| eval_Elvalue: forall a loc ofs v,
eval_lvalue a loc ofs ->
deref_loc (typeof a) m loc ofs v ->
eval_expr a v
(** [eval_lvalue ge e m a b ofs] defines the evaluation of expression [a] in l-value position.  The result is the memory location [b, ofs] that contains the value of the expression [a]. *)
with eval_lvalue: expr -> block -> ptrofs -> Prop :=
| eval_Evar_local:   forall id l ty,
e!id = Some(l, ty) ->
eval_lvalue (Evar id ty) l Ptrofs.zero
| eval_Evar_global: forall id l ty,
e!id = None ->
Genv.find_symbol ge id = Some l ->
eval_lvalue (Evar id ty) l Ptrofs.zero
| eval_Ederef: forall a ty l ofs,
eval_expr a (Vptr l ofs) ->
eval_lvalue (Ederef a ty) l ofs
| eval_Efield_struct:   forall a i ty l ofs id co att delta,
eval_expr a (Vptr l ofs) ->
typeof a = Tstruct id att ->
ge.(genv_cenv)!id = Some co ->
field_offset ge i (co_members co) = OK delta ->
eval_lvalue (Efield a i ty) l (Ptrofs.add ofs (Ptrofs.repr delta))
| eval_Efield_union:   forall a i ty l ofs id co att,
eval_expr a (Vptr l ofs) ->
typeof a = Tunion id att ->
ge.(genv_cenv)!id = Some co ->
eval_lvalue (Efield a i ty) l ofs.
Scheme eval_expr_ind2 := Minimality for eval_expr Sort Prop
with eval_lvalue_ind2 := Minimality for eval_lvalue Sort Prop.
Combined Scheme eval_expr_lvalue_ind from eval_expr_ind2, eval_lvalue_ind2.
(** [eval_exprlist ge e m al tyl vl] evaluates a list of r-value expressions [al], cast their values to the types given in [tyl], and produces the list of cast values [vl].  It is used to evaluate the arguments of function calls. *)
Inductive eval_exprlist: list expr -> typelist -> list val -> Prop :=
| eval_Enil:
eval_exprlist nil Tnil nil
| eval_Econs:   forall a bl ty tyl v1 v2 vl,
eval_expr a v1 ->
sem_cast v1 (typeof a) ty m = Some v2 ->
eval_exprlist bl tyl vl ->
eval_exprlist (a :: bl) (Tcons ty tyl) (v2 :: vl).
End EXPR.
(** ** Transition semantics for statements and functions *)
(** Continuations *)
Inductive cont: Type :=
| Kstop: cont
| Kseq: statement -> cont -> cont       (**r [Kseq s2 k] = after [s1] in [s1;s2] *)
| Kloop1: statement -> statement -> cont -> cont (**r [Kloop1 s1 s2 k] = after [s1] in [Sloop s1 s2] *)
| Kloop2: statement -> statement -> cont -> cont (**r [Kloop1 s1 s2 k] = after [s2] in [Sloop s1 s2] *)
| Kswitch: cont -> cont       (**r catches [break] statements arising out of [switch] *)
| Kcall: option ident ->                  (**r where to store result *)
function ->                      (**r calling function *)
env ->                           (**r local env of calling function *)
temp_env ->                      (**r temporary env of calling function *)
cont -> cont.
(** Pop continuation until a call or stop *)
Fixpoint call_cont (k: cont) : cont :=
match k with
| Kseq s k => call_cont k
| Kloop1 s1 s2 k => call_cont k
| Kloop2 s1 s2 k => call_cont k
| Kswitch k => call_cont k
| _ => k
end.
Definition is_call_cont (k: cont) : Prop :=
match k with
| Kstop => True
| Kcall _ _ _ _ _ => True
| _ => False
end.
(** States *)
Inductive state: Type :=
| State
(f: function)
(s: statement)
(k: cont)
(e: env)
(le: temp_env)
(m: mem) : state
| Callstate
(fd: fundef)
(args: list val)
(k: cont)
(m: mem) : state
| Returnstate
(res: val)
(k: cont)
(m: mem) : state.
(**NEW *)
Definition get_mem (s:state):=
match s with
| State _ _ _ _ _ m => m
| Callstate _ _ _ m => m
| Returnstate _ _ m => m
end.
(**NEW *)
Definition set_mem (s:state)(m:mem):=
match s with
| State f s k e le _ => State f s k e le m
| Callstate fd args k _ => Callstate fd args k m
| Returnstate res k _ => Returnstate res k m
end.
(**NEW *)
Definition at_external (c: state) : option (external_function * list val) :=
match c with
| State _ _ _ _ _ _ => None
| Callstate fd args k _ =>
match fd with
Internal f => None
| External ef targs tres cc =>
Some (ef, args)
end
| Returnstate _ _ _ => None
end.
(**NEW *)
Definition after_external (rv: option val) (c: state) (m0:mem): option state :=
match c with
Callstate fd vargs k m =>
match fd with
Internal _ => None
| External ef tps tp cc =>
match rv with
Some v => Some(Returnstate v k m0)
| None  => Some(Returnstate Vundef k m0)
end
end
| _ => None
end.
(** Find the statement and manufacture the continuation corresponding to a label *)
Fixpoint find_label (lbl: label) (s: statement) (k: cont)
{struct s}: option (statement * cont) :=
match s with
| Ssequence s1 s2 =>
match find_label lbl s1 (Kseq s2 k) with
| Some sk => Some sk
| None => find_label lbl s2 k
end
| Sifthenelse a s1 s2 =>
match find_label lbl s1 k with
| Some sk => Some sk
| None => find_label lbl s2 k
end
| Sloop s1 s2 =>
match find_label lbl s1 (Kloop1 s1 s2 k) with
| Some sk => Some sk
| None => find_label lbl s2 (Kloop2 s1 s2 k)
end
| Sswitch e sl =>
find_label_ls lbl sl (Kswitch k)
| Slabel lbl' s' =>
if ident_eq lbl lbl' then Some(s', k) else find_label lbl s' k
| _ => None
end
with find_label_ls (lbl: label) (sl: labeled_statements) (k: cont)
{struct sl}: option (statement * cont) :=
match sl with
| LSnil => None
| LScons _ s sl' =>
match find_label lbl s (Kseq (seq_of_labeled_statement sl') k) with
| Some sk => Some sk
| None => find_label_ls lbl sl' k
end
end.
(** Semantics for allocation of variables and binding of parameters at function entry.  Two semantics are supported: one where parameters are local variables, reside in memory, and can have their address taken; the other where parameters are temporary variables and do not reside in memory.  We parameterize the [step] transition relation over the parameter binding semantics, then instantiate it later to give the two semantics described above. *)
Variable function_entry: function -> list val -> mem -> env -> temp_env -> mem -> Prop.
(** Transition relation *)
Inductive step: state -> trace -> state -> Prop :=
| step_assign:   forall f a1 a2 k e le m loc ofs v2 v m',
eval_lvalue e le m a1 loc ofs ->
eval_expr e le m a2 v2 ->
sem_cast v2 (typeof a2) (typeof a1) m = Some v ->
assign_loc ge (typeof a1) m loc ofs v m' ->
step (State f (Sassign a1 a2) k e le m)
E0 (State f Sskip k e le m')
| step_set:   forall f id a k e le m v,
eval_expr e le m a v ->
step (State f (Sset id a) k e le m)
E0 (State f Sskip k e (PTree.set id v le) m)
| step_call:   forall f optid a al k e le m tyargs tyres cconv vf vargs fd,
classify_fun (typeof a) = fun_case_f tyargs tyres cconv ->
eval_expr e le m a vf ->
eval_exprlist e le m al tyargs vargs ->
Genv.find_funct ge vf = Some fd ->
type_of_fundef fd = Tfunction tyargs tyres cconv ->
step (State f (Scall optid a al) k e le m)
E0 (Callstate fd vargs (Kcall optid f e le k) m)
| step_builtin:   forall f optid ef tyargs al k e le m vargs t vres m',
eval_exprlist e le m al tyargs vargs ->
external_call ef ge vargs m t vres m' ->
step (State f (Sbuiltin optid ef tyargs al) k e le m)
t (State f Sskip k e (set_opttemp optid vres le) m')
| step_seq:  forall f s1 s2 k e le m,
step (State f (Ssequence s1 s2) k e le m)
E0 (State f s1 (Kseq s2 k) e le m)
| step_skip_seq: forall f s k e le m,
step (State f Sskip (Kseq s k) e le m)
E0 (State f s k e le m)
| step_continue_seq: forall f s k e le m,
step (State f Scontinue (Kseq s k) e le m)
E0 (State f Scontinue k e le m)
| step_break_seq: forall f s k e le m,
step (State f Sbreak (Kseq s k) e le m)
E0 (State f Sbreak k e le m)
| step_ifthenelse:  forall f a s1 s2 k e le m v1 b,
eval_expr e le m a v1 ->
bool_val v1 (typeof a) m = Some b ->
step (State f (Sifthenelse a s1 s2) k e le m)
E0 (State f (if b then s1 else s2) k e le m)
| step_loop: forall f s1 s2 k e le m,
step (State f (Sloop s1 s2) k e le m)
E0 (State f s1 (Kloop1 s1 s2 k) e le m)
| step_skip_or_continue_loop1:  forall f s1 s2 k e le m x,
x = Sskip \/ x = Scontinue ->
step (State f x (Kloop1 s1 s2 k) e le m)
E0 (State f s2 (Kloop2 s1 s2 k) e le m)
| step_break_loop1:  forall f s1 s2 k e le m,
step (State f Sbreak (Kloop1 s1 s2 k) e le m)
E0 (State f Sskip k e le m)
| step_skip_loop2: forall f s1 s2 k e le m,
step (State f Sskip (Kloop2 s1 s2 k) e le m)
E0 (State f (Sloop s1 s2) k e le m)
| step_break_loop2: forall f s1 s2 k e le m,
step (State f Sbreak (Kloop2 s1 s2 k) e le m)
E0 (State f Sskip k e le m)
| step_return_0: forall f k e le m m',
Mem.free_list m (blocks_of_env e) = Some m' ->
step (State f (Sreturn None) k e le m)
E0 (Returnstate Vundef (call_cont k) m')
| step_return_1: forall f a k e le m v v' m',
eval_expr e le m a v ->
sem_cast v (typeof a) f.(fn_return) m = Some v' ->
Mem.free_list m (blocks_of_env e) = Some m' ->
step (State f (Sreturn (Some a)) k e le m)
E0 (Returnstate v' (call_cont k) m')
| step_skip_call: forall f k e le m m',
is_call_cont k ->
Mem.free_list m (blocks_of_env e) = Some m' ->
step (State f Sskip k e le m)
E0 (Returnstate Vundef k m')
| step_switch: forall f a sl k e le m v n,
eval_expr e le m a v ->
sem_switch_arg v (typeof a) = Some n ->
step (State f (Sswitch a sl) k e le m)
E0 (State f (seq_of_labeled_statement (select_switch n sl)) (Kswitch k) e le m)
| step_skip_break_switch: forall f x k e le m,
x = Sskip \/ x = Sbreak ->
step (State f x (Kswitch k) e le m)
E0 (State f Sskip k e le m)
| step_continue_switch: forall f k e le m,
step (State f Scontinue (Kswitch k) e le m)
E0 (State f Scontinue k e le m)
| step_label: forall f lbl s k e le m,
step (State f (Slabel lbl s) k e le m)
E0 (State f s k e le m)
| step_goto: forall f lbl k e le m s' k',
find_label lbl f.(fn_body) (call_cont k) = Some (s', k') ->
step (State f (Sgoto lbl) k e le m)
E0 (State f s' k' e le m)
| step_internal_function: forall f vargs k m e le m1,
function_entry f vargs m e le m1 ->
step (Callstate (Internal f) vargs k m)
E0 (State f f.(fn_body) k e le m1)
| step_external_function: forall ef targs tres cconv vargs k m vres t m',
external_call ef ge vargs m t vres m' ->
step (Callstate (External ef targs tres cconv) vargs k m)
t (Returnstate vres k m')
| step_returnstate: forall v optid f e le k m,
step (Returnstate v (Kcall optid f e le k) m)
E0 (State f Sskip k e (set_opttemp optid v le) m).
(** ** Whole-program semantics *)
(** Execution of whole programs are described as sequences of transitions from an initial state to a final state.  An initial state is a [Callstate] corresponding to the invocation of the ``main'' function of the program without arguments and with an empty continuation. *)
(*Inductive entry_point (p: program): mem -> state -> val -> list val -> Prop := | entry_point_intro: forall b f args m0, let ge := Genv.globalenv p in Genv.init_mem p = Some m0 -> Genv.find_symbol ge p.(prog_main) = Some b -> Genv.find_funct_ptr ge b = Some f -> type_of_fundef f = Tfunction Tnil type_int32s cc_default -> entry_point p m0 (Callstate f nil Kstop m0) (Vptr b Ptrofs.zero) args.*)
Inductive initial_state (p: program): state -> Prop :=
| initial_state_intro: forall b f m0,
let ge := Genv.globalenv p in
Genv.init_mem p = Some m0 ->
Genv.find_symbol ge p.(prog_main) = Some b ->
Genv.find_funct_ptr ge b = Some f ->
type_of_fundef f = Tfunction Tnil type_int32s cc_default ->
initial_state p (Callstate f nil Kstop m0).
(*NEW*)
(* The following parameters are simple and reasonable, *)
(* but might not be needed. All definitions come from  *)
(* compcomp/core/val_casted.v                          *)
(*Parameter val_casted_list_func: list val -> typelist -> bool. (* TODO *)
Parameter tys_nonvoid: typelist -> bool .
Parameter vals_defined: list val -> bool.
*)
(* No unvalid pointers, i.e. othing pointing after nextblock *)
Definition mem_well_formed m:=
Mem.inject (Mem.flat_inj (Mem.nextblock m)) m m.
(* All arguments are in memory and without unvalid pointers*)
Definition arg_well_formed args m0:=
Val.inject_list (Mem.flat_inj (Mem.nextblock m0)) args args.
Inductive val_casted_list: list val -> typelist -> Prop :=
| vcl_nil:
val_casted_list nil Tnil
| vcl_cons: forall v1 vl ty1 tyl,
val_casted v1 ty1 -> val_casted_list vl tyl ->
val_casted_list (v1 :: vl) (Tcons  ty1 tyl).
(* Require Import Conventions.  Definition loc_arguments' l := if Archi.ptr64 then loc_arguments_64 l 0 0 0 else loc_arguments_32 l 0. *)
(*NOTE: DOUBLE CHECK TARGS (it's not used right now)*)
Inductive entry_point (ge:genv): mem -> state -> val -> list val -> Prop :=
| initi_core:
forall f fb b0 f0 m0 m1 stk args targs tres,
Genv.find_funct_ptr ge fb = Some f ->
type_of_fundef f = Tfunction targs tres cc_default ->
globals_not_fresh ge m0 ->
Mem.mem_wd m0 ->
Mem.arg_well_formed args m0 ->
val_casted_list args targs ->
Val.has_type_list args (typlist_of_typelist targs) ->
(*val_casted_list_func args targs && tys_nonvoid targs && vals_defined args && zlt (4*(2*(Zlength args))) Int.max_unsigned = true ->*)
Genv.find_funct_ptr ge b0 = Some (Internal f0) ->
Mem.alloc m0 0 0 = (m1, stk) ->
entry_point ge m0 (Callstate f args (Kcall None f0 empty_env
(temp_bindings
1%positive (Vptr fb Ptrofs.zero::args)) Kstop) m1) (Vptr fb Ptrofs.zero) args.
(** A final state is a [Returnstate] with an empty continuation. *)
Inductive final_state: state -> int -> Prop :=
| final_state_intro: forall r m,
final_state (Returnstate (Vint r) Kstop m) r.
End SEMANTICS.
(** The two semantics for function parameters.  First, parameters as local variables. *)
Inductive function_entry1 (ge: genv) (f: function) (vargs: list val) (m: mem) (e: env) (le: temp_env) (m': mem) : Prop :=
| function_entry1_intro: forall m1,
list_norepet (var_names f.(fn_params) ++ var_names f.(fn_vars)) ->
alloc_variables ge empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 ->
bind_parameters ge e m1 f.(fn_params) vargs m' ->
le = create_undef_temps f.(fn_temps) ->
function_entry1 ge f vargs m e le m'.
Definition step1 (ge: genv) := step ge (function_entry1 ge).
(** Second, parameters as temporaries. *)
Inductive function_entry2 (ge: genv)  (f: function) (vargs: list val) (m: mem) (e: env) (le: temp_env) (m': mem) : Prop :=
| function_entry2_intro:
list_norepet (var_names f.(fn_vars)) ->
list_norepet (var_names f.(fn_params)) ->
list_disjoint (var_names f.(fn_params)) (var_names f.(fn_temps)) ->
alloc_variables ge empty_env m f.(fn_vars) e m' ->
bind_parameter_temps f.(fn_params) vargs (create_undef_temps f.(fn_temps)) = Some le ->
function_entry2 ge f vargs m e le m'.
Definition step2 (ge: genv) := step ge (function_entry2 ge).
(** Wrapping up these definitions in two small-step semantics. *)
Definition part_semantics1 (ge: genv) :=
Build_part_semantics get_mem set_mem (step1 ge)
(entry_point ge)
at_external
after_external
final_state ge ge.
Definition semantics1 (p: program) :=
let ge := globalenv p in
let main :=Genv.find_symbol ge p.(prog_main) in
let init_mem:=(Genv.init_mem p) in
Build_semantics (part_semantics1 ge) main init_mem.
Definition part_semantics2 (ge: genv) :=
Build_part_semantics get_mem set_mem (step2 ge)
(entry_point ge)
at_external
after_external
final_state ge ge.
Definition semantics2 (p: program) :=
let ge := globalenv p in
let main :=Genv.find_symbol ge p.(prog_main) in
let init_mem:=(Genv.init_mem p) in
Build_semantics (part_semantics2 ge) main init_mem.
(** This semantics is receptive to changes in events. *)

Lemma semantics_receptive:
forall (p: program), receptive (semantics1 p).