Section MATCH_TRACES_INV.
Variables ge1 ge2: Senv.t.
Hypothesis public_preserved:
forall id, Senv.public_symbol ge2 id = Senv.public_symbol ge1 id.
End MATCH_TRACES_INV.
(** An output trace is a trace composed only of output events, that is, events that do not take any result from the outside world. *)
Definition output_event (ev: event) : Prop :=
match ev with
| Event_syscall _ _ _ => False
| Event_vload _ _ _ _ => False
| Event_vstore _ _ _ _ => True
| Event_annot _ _ => True
end.
Fixpoint output_trace (t: trace) : Prop :=
match t with
| nil => True
| ev :: t' => output_event ev /\ output_trace t'
end.
(** * Semantics of volatile memory accesses *)
Inductive volatile_load (ge: Senv.t):
memory_chunk -> mem -> block -> ptrofs -> trace -> val -> Prop :=
| volatile_load_vol: forall chunk m b ofs id ev v,
Senv.block_is_volatile ge b = true ->
Senv.find_symbol ge id = Some b ->
eventval_match ge ev (type_of_chunk chunk) v ->
volatile_load ge chunk m b ofs
(Event_vload chunk id ofs ev :: nil)
(Val.load_result chunk v)
| volatile_load_nonvol: forall chunk m b ofs v,
Senv.block_is_volatile ge b = false ->
Mem.load chunk m b (Ptrofs.unsigned ofs) = Some v ->
volatile_load ge chunk m b ofs E0 v.
Inductive volatile_store (ge: Senv.t):
memory_chunk -> mem -> block -> ptrofs -> val -> trace -> mem -> Prop :=
| volatile_store_vol: forall chunk m b ofs id ev v,
Senv.block_is_volatile ge b = true ->
Senv.find_symbol ge id = Some b ->
eventval_match ge ev (type_of_chunk chunk) (Val.load_result chunk v) ->
volatile_store ge chunk m b ofs v
(Event_vstore chunk id ofs ev :: nil)
m
| volatile_store_nonvol: forall chunk m b ofs v m',
Senv.block_is_volatile ge b = false ->
Mem.store chunk m b (Ptrofs.unsigned ofs) v = Some m' ->
volatile_store ge chunk m b ofs v E0 m'.
(** * Semantics of external functions *)
(** For each external function, its behavior is defined by a predicate relating: - the global symbol environment - the values of the arguments passed to this function - the memory state before the call - the result value of the call - the memory state after the call - the trace generated by the call (can be empty). *)
Definition extcall_sem : Type :=
Senv.t -> list val -> mem -> trace -> val -> mem -> Prop.
(** We now specify the expected properties of this predicate. *)
Definition loc_out_of_bounds (m: mem) (b: block) (ofs: Z) : Prop :=
~Mem.perm m b ofs Max Nonempty.
Definition loc_not_writable (m: mem) (b: block) (ofs: Z) : Prop :=
~Mem.perm m b ofs Max Writable.
Definition loc_unmapped (f: meminj) (b: block) (ofs: Z): Prop :=
f b = None.
Definition loc_out_of_reach (f: meminj) (m: mem) (b: block) (ofs: Z): Prop :=
forall b0 delta,
f b0 = Some(b, delta) -> ~Mem.perm m b0 (ofs - delta) Max Nonempty.
Definition inject_separated (f f': meminj) (m1 m2: mem): Prop :=
forall b1 b2 delta,
f b1 = None -> f' b1 = Some(b2, delta) ->
~Mem.valid_block m1 b1 /\ ~Mem.valid_block m2 b2.
Record extcall_properties (sem: extcall_sem) (sg: signature) : Prop :=
mk_extcall_properties {
(** The return value of an external call must agree with its signature. *)
ec_well_typed:
forall ge vargs m1 t vres m2,
sem ge vargs m1 t vres m2 ->
Val.has_type vres (proj_sig_res sg);
(** The semantics is invariant under change of global environment that preserves symbols. *)
ec_symbols_preserved:
forall ge1 ge2 vargs m1 t vres m2,
Senv.equiv ge1 ge2 ->
sem ge1 vargs m1 t vres m2 ->
sem ge2 vargs m1 t vres m2;
(** External calls cannot invalidate memory blocks.  (Remember that freeing a block does not invalidate its block identifier.) *)
ec_valid_block:
forall ge vargs m1 t vres m2 b,
sem ge vargs m1 t vres m2 ->
Mem.valid_block m1 b -> Mem.valid_block m2 b;
(** External calls cannot increase the max permissions of a valid block. They can decrease the max permissions, e.g. by freeing. *)
ec_max_perm:
forall ge vargs m1 t vres m2 b ofs p,
sem ge vargs m1 t vres m2 ->
Mem.valid_block m1 b -> Mem.perm m2 b ofs Max p -> Mem.perm m1 b ofs Max p;
(** External call cannot modify memory unless they have [Max, Writable] permissions. *)
ec_readonly:
forall ge vargs m1 t vres m2,
sem ge vargs m1 t vres m2 ->
Mem.unchanged_on (loc_not_writable m1) m1 m2;
(** External calls must commute with memory extensions, in the following sense. *)
ec_mem_extends:
forall ge vargs m1 t vres m2 m1' vargs',
sem ge vargs m1 t vres m2 ->
Mem.extends m1 m1' ->
Val.lessdef_list vargs vargs' ->
exists vres', exists m2',
sem ge vargs' m1' t vres' m2'
/\ Val.lessdef vres vres'
/\ Mem.extends m2 m2'
/\ Mem.unchanged_on (loc_out_of_bounds m1) m1' m2';
(** External calls must commute with memory injections, in the following sense. *)
ec_mem_inject:
forall ge1 ge2 vargs m1 t vres m2 f m1' vargs',
symbols_inject f ge1 ge2 ->
sem ge1 vargs m1 t vres m2 ->
Mem.inject f m1 m1' ->
Val.inject_list f vargs vargs' ->
exists f', exists vres', exists m2',
sem ge2 vargs' m1' t vres' m2'
/\ Val.inject f' vres vres'
/\ Mem.inject f' m2 m2'
/\ Mem.unchanged_on (loc_unmapped f) m1 m2
/\ Mem.unchanged_on (loc_out_of_reach f m1) m1' m2'
/\ inject_incr f f'
/\ inject_separated f f' m1 m1';
(** External calls produce at most one event. *)
ec_trace_length:
forall ge vargs m t vres m',
sem ge vargs m t vres m' -> (length t <= 1)%nat;
(** External calls must be receptive to changes of traces by another, matching trace. *)
ec_receptive:
forall ge vargs m t1 vres1 m1 t2,
sem ge vargs m t1 vres1 m1 -> match_traces ge t1 t2 ->
exists vres2, exists m2, sem ge vargs m t2 vres2 m2;
(** External calls must be deterministic up to matching between traces. *)
ec_determ:
forall ge vargs m t1 vres1 m1 t2 vres2 m2,
sem ge vargs m t1 vres1 m1 -> sem ge vargs m t2 vres2 m2 ->
match_traces ge t1 t2 /\ (t1 = t2 -> vres1 = vres2 /\ m1 = m2)
}.
(** ** Semantics of volatile loads *)
Inductive volatile_load_sem (chunk: memory_chunk) (ge: Senv.t):
list val -> mem -> trace -> val -> mem -> Prop :=
| volatile_load_sem_intro: forall b ofs m t v,
volatile_load ge chunk m b ofs t v ->
volatile_load_sem chunk ge (Vptr b ofs :: nil) m t v m.

Lemma volatile_load_ok:
forall chunk,
extcall_properties (volatile_load_sem chunk)
(mksignature (Tptr :: nil) (Some (type_of_chunk chunk)) cc_default).