(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 2 of the License, or  *)
(*  (at your option) any later version.  This file is also distributed *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
(** Observable events, execution traces, and semantics of external calls. *)
Require Intv.
(** * Events and traces *)
(** The observable behaviour of programs is stated in terms of input/output events, which represent the actions of the program that the external world can observe.  CompCert leaves much flexibility as to the exact content of events: the only requirement is that they do not expose memory states nor pointer values (other than pointers to global variables), because these are not preserved literally during compilation.  For concreteness, we use the following type for events.  Each event represents either:  - A system call (e.g. an input/output operation), recording the name of the system call, its parameters, and its result.  - A volatile load from a global memory location, recording the chunk and address being read and the value just read.  - A volatile store to a global memory location, recording the chunk and address being written and the value stored there.  - An annotation, recording the text of the annotation and the values of the arguments.  The values attached to these events are of the following form. As mentioned above, we do not expose pointer values directly. Pointers relative to a global variable are shown with the name of the variable instead of the block identifier. *)
Inductive eventval: Type :=
| EVint: int -> eventval
| EVlong: int64 -> eventval
| EVfloat: float -> eventval
| EVsingle: float32 -> eventval
| EVptr_global: ident -> ptrofs -> eventval.
(* Delta Permission Maps: A change in memory permissions. - They have the same shape as the memories - they return [None], if the permission doesn't change at that location - return [Some perm], if the new permission is [perm]. *)
Notation delta_perm_map := (Maps.PTree.t (Z -> option (option permission))).
Inductive inject_Z_map {A} (delt: Z) (f1 f2: (Z -> A)): Prop:=
| InjectZ: (forall ofs x, f1 ofs = x ->
f2 (ofs+ delt) = x) ->
inject_Z_map delt f1 f2.
Record inject_delta_map (mu: meminj)(dpm1 dpm2: delta_perm_map): Prop:=
{ DPM_image: forall b1 b2 delt f1,
mu b1 = Some (b2, delt) ->
(Maps.PTree.get b1 dpm1) = Some f1 ->
exists f2, Maps.PTree.get b2 dpm2 = Some f2 /\
inject_Z_map delt f1 f2
;DPM_preimage:
forall b2 ofs2 f2 p,
Maps.PTree.get b2 dpm2 = Some f2 ->
f2 ofs2 = p ->
exists b1 f1 ofs1 delt,
mu b1 = Some(b2, delt) /\
Maps.PTree.get b1 dpm1 = Some f1 /\
f1 ofs1 = p /\
ofs2 = ofs1 + delt
}.
(* New memory events: * These events are injectable * They can indicate changes to memory with an mem_effect * or changes to permissions with a delta_map. NOTE: alloc records the new block. This helps on injections. *)
Inductive mem_effect :=
Write : forall (b : block) (ofs : Z) (bytes : list memval), mem_effect
| Alloc: forall (b : block)(lo hi:Z), mem_effect
| Free: forall (l: list (block * Z * Z)), mem_effect.
Inductive list_map_rel {A B} (r:A-> B -> Prop): list A -> list B-> Prop:=
| list_rel_nil:
list_map_rel r nil nil
| list_rel_cons: forall a b l1 l2,
r a b ->
list_map_rel r (l1) (l2)->
list_map_rel r (a::l1) (b::l2).
Inductive inject_strong (mi : meminj) : val -> val -> Prop :=
inject_int : forall i : int, inject_strong mi (Vint i) (Vint i)
| inject_long : forall i : int64, inject_strong mi (Vlong i) (Vlong i)
| inject_float : forall f : float, inject_strong mi (Vfloat f) (Vfloat f)
| inject_single : forall f : float32, inject_strong mi (Vsingle f) (Vsingle f)
| inject_ptr : forall (b1 : block) (ofs1 : ptrofs) (b2 : block) (ofs2 : ptrofs) (delta : Z),
mi b1 = Some (b2, delta) ->
ofs2 = Ptrofs.add ofs1 (Ptrofs.repr delta) ->
inject_strong mi (Vptr b1 ofs1) (Vptr b2 ofs2)
| val_inject_undef : inject_strong mi Vundef Vundef.
Inductive memval_inject_strong (f : meminj) : memval -> memval -> Prop :=
memval_inject_byte_str : forall n : byte, memval_inject_strong f (Byte n) (Byte n)
| memval_inject_frag_str : forall (v1 v2 : val) (q : quantity) (n : nat),
inject_strong f v1 v2 ->
memval_inject_strong f (Fragment v1 q n) (Fragment v2 q n)
| memval_inject_undef_str : memval_inject_strong f Undef Undef.
Definition list_memval_inject mu:= list_map_rel (memval_inject mu).
Definition list_memval_inject_strong mu:= list_map_rel (memval_inject_strong mu).
Inductive inject_hi_low (mu:meminj): (block * Z * Z) -> (block * Z * Z) -> Prop:=
| HiLow: forall b1 b2 hi low delt,
mu b1 = Some(b2, delt) ->
inject_hi_low mu (b1, hi, low) (b2, hi+delt, low+delt).
Definition list_inject_hi_low mu := list_map_rel (inject_hi_low mu).
Inductive inject_mem_effect (mu: meminj): mem_effect -> mem_effect -> Prop :=
| InjectWrites: forall b1 b2 ofs1 delt vals1 vals2,
mu b1 = Some (b2, delt) ->
list_memval_inject mu vals1 vals2 ->
inject_mem_effect mu (Write b1 ofs1 vals1) (Write b2 (ofs1 + delt) vals2)
| InjectAlloc: forall lo hi b1 b2,
mu b1 = Some (b2, 0) ->
inject_mem_effect mu (Alloc b1 hi lo) (Alloc b2 hi lo)
| InjectFree: forall l1 l2,
list_inject_hi_low mu l1 l2 ->
inject_mem_effect mu (Free l1) (Free l2).
Definition list_inject_mem_effect (mu:meminj):= list_map_rel (inject_mem_effect mu).
Inductive inject_mem_effect_strong (mu: meminj): mem_effect -> mem_effect -> Prop :=
| InjectWritesStrong: forall b1 b2 ofs1 delt vals1 vals2,
mu b1 = Some (b2, delt) ->
list_memval_inject_strong mu vals1 vals2 ->
inject_mem_effect_strong mu (Write b1 ofs1 vals1) (Write b2 (ofs1 + delt) vals2)
| InjectAllocStrong:forall lo hi b1 b2,
mu b1 = Some (b2, 0) ->
inject_mem_effect_strong mu (Alloc b1 hi lo) (Alloc b2 hi lo)
| InjectFreeStrong: forall l1 l2,
list_inject_hi_low mu l1 l2 ->
inject_mem_effect_strong mu (Free l1) (Free l2).
Definition list_inject_mem_effect_strong (mu:meminj):= list_map_rel (inject_mem_effect_strong mu).
Inductive event: Type :=
| Event_syscall: string -> list eventval -> eventval -> event
| Event_vload: memory_chunk -> ident -> ptrofs -> eventval -> event
| Event_vstore: memory_chunk -> ident -> ptrofs -> eventval -> event
| Event_annot: string -> list eventval -> event
| Event_acq_rel: list mem_effect -> delta_perm_map -> list mem_effect -> event
| Event_spawn: block -> delta_perm_map -> delta_perm_map -> event.
(** The dynamic semantics for programs collect traces of events. Traces are of two kinds: finite (type [trace]) or infinite (type [traceinf]). *)
Definition trace := list event.
Definition E0 : trace := nil.
Definition Eapp (t1 t2: trace) : trace := t1 ++ t2.
CoInductive traceinf : Type :=
| Econsinf: event -> traceinf -> traceinf.
Fixpoint Eappinf (t: trace) (T: traceinf) {struct t} : traceinf :=
match t with
| nil => T
| ev :: t' => Econsinf ev (Eappinf t' T)
end.
(** Concatenation of traces is written [**] in the finite case or [***] in the infinite case. *)
Infix "**" := Eapp (at level 60, right associativity).
Infix "***" := Eappinf (at level 60, right associativity).
Hint Rewrite E0_left E0_right Eapp_assoc
E0_left_inf Eappinf_assoc: trace_rewrite.
Opaque trace E0 Eapp Eappinf.
(** The following [traceEq] tactic proves equalities between traces or infinite traces. *)
Ltac substTraceHyp :=
match goal with
| [ H: (@eq trace ?x ?y) |- _ ] =>
subst x || clear H
end.
Ltac decomposeTraceEq :=
match goal with
| [ |- (_ ** _) = (_ ** _) ] =>
apply (f_equal2 Eapp); auto; decomposeTraceEq
| _ =>
auto
end.
Ltac traceEq :=
repeat substTraceHyp; autorewrite with trace_rewrite; decomposeTraceEq.
(** Bisimilarity between infinite traces. *)
CoInductive traceinf_sim: traceinf -> traceinf -> Prop :=
| traceinf_sim_cons: forall e T1 T2,
traceinf_sim T1 T2 ->
traceinf_sim (Econsinf e T1) (Econsinf e T2).
CoInductive traceinf_sim': traceinf -> traceinf -> Prop :=
| traceinf_sim'_cons: forall t T1 T2,
t <> E0 -> traceinf_sim' T1 T2 -> traceinf_sim' (t *** T1) (t *** T2).
(** An alternate presentation of infinite traces as infinite concatenations of nonempty finite traces. *)
CoInductive traceinf': Type :=
| Econsinf': forall (t: trace) (T: traceinf'), t <> E0 -> traceinf'.
Program Definition split_traceinf' (t: trace) (T: traceinf') (NE: t <> E0): event * traceinf' :=
match t with
| nil => _
| e :: nil => (e, T)
| e :: t' => (e, Econsinf' t' T _)
end.
Next Obligation.
elimtype False. elim NE. auto.
Qed.
Next Obligation.
red; intro. elim (H e). rewrite H0. auto.
Qed.
CoFixpoint traceinf_of_traceinf' (T': traceinf') : traceinf :=
match T' with
| Econsinf' t T'' NOTEMPTY =>
let (e, tl) := split_traceinf' t T'' NOTEMPTY in
Econsinf e (traceinf_of_traceinf' tl)
end.
Remark unroll_traceinf':
forall T, T = match T with Econsinf' t T' NE => Econsinf' t T' NE end.
Remark unroll_traceinf:
forall T, T = match T with Econsinf t T' => Econsinf t T' end.
(** Prefixes of traces. *)
Definition trace_prefix (t1 t2: trace) :=
exists t3, t2 = t1 ** t3.
Definition traceinf_prefix (t1: trace) (T2: traceinf) :=
exists T3, T2 = t1 *** T3.

Lemma traceinf_prefix_app:
forall t1 T2 t,
traceinf_prefix t1 T2 ->
traceinf_prefix (t ** t1) (t *** T2).