(** External calls *)
Variable do_external_function:
string -> signature -> Senv.t -> world -> list val -> mem -> option (world * trace * val * mem).
Hypothesis do_external_function_sound:
forall id sg ge vargs m t vres m' w w',
do_external_function id sg ge w vargs m = Some(w', t, vres, m') ->
external_functions_sem id sg ge vargs m t vres m' /\ possible_trace w t w'.
Hypothesis do_external_function_complete:
forall id sg ge vargs m t vres m' w w',
external_functions_sem id sg ge vargs m t vres m' ->
possible_trace w t w' ->
do_external_function id sg ge w vargs m = Some(w', t, vres, m').
Variable do_inline_assembly:
string -> signature -> Senv.t -> world -> list val -> mem -> option (world * trace * val * mem).
Hypothesis do_inline_assembly_sound:
forall txt sg ge vargs m t vres m' w w',
do_inline_assembly txt sg ge w vargs m = Some(w', t, vres, m') ->
inline_assembly_sem txt sg ge vargs m t vres m' /\ possible_trace w t w'.
Hypothesis do_inline_assembly_complete:
forall txt sg ge vargs m t vres m' w w',
inline_assembly_sem txt sg ge vargs m t vres m' ->
possible_trace w t w' ->
do_inline_assembly txt sg ge w vargs m = Some(w', t, vres, m').
Definition do_ef_volatile_load (chunk: memory_chunk)
(w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
match vargs with
| Vptr b ofs :: nil => do w',t,v <- do_volatile_load w chunk m b ofs; Some(w',t,v,m)
| _ => None
end.
Definition do_ef_volatile_store (chunk: memory_chunk)
(w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
match vargs with
| Vptr b ofs :: v :: nil => do w',t,m' <- do_volatile_store w chunk m b ofs v; Some(w',t,Vundef,m')
| _ => None
end.
Definition do_ef_volatile_load_global (chunk: memory_chunk) (id: ident) (ofs: ptrofs)
(w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
do b <- Genv.find_symbol ge id; do_ef_volatile_load chunk w (Vptr b ofs :: vargs) m.
Definition do_ef_volatile_store_global (chunk: memory_chunk) (id: ident) (ofs: ptrofs)
(w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
do b <- Genv.find_symbol ge id; do_ef_volatile_store chunk w (Vptr b ofs :: vargs) m.
Definition do_alloc_size (v: val) : option ptrofs :=
match v with
| Vint n => if Archi.ptr64 then None else Some (Ptrofs.of_int n)
| Vlong n => if Archi.ptr64 then Some (Ptrofs.of_int64 n) else None
| _ => None
end.
Definition do_ef_malloc
(w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
match vargs with
| v :: nil =>
do sz <- do_alloc_size v;
let (m', b) := Mem.alloc m (- size_chunk Mptr) (Ptrofs.unsigned sz) in
do m'' <- Mem.store Mptr m' b (- size_chunk Mptr) v;
Some(w, E0, Vptr b Ptrofs.zero, m'')
| _ => None
end.
Definition do_ef_free
(w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
match vargs with
| Vptr b lo :: nil =>
do vsz <- Mem.load Mptr m b (Ptrofs.unsigned lo - size_chunk Mptr);
do sz <- do_alloc_size vsz;
check (zlt 0 (Ptrofs.unsigned sz));
do m' <- Mem.free m b (Ptrofs.unsigned lo - size_chunk Mptr) (Ptrofs.unsigned lo + Ptrofs.unsigned sz);
Some(w, E0, Vundef, m')
| _ => None
end.
Definition memcpy_args_ok
(sz al: Z) (bdst: block) (odst: Z) (bsrc: block) (osrc: Z) : Prop :=
(al = 1 \/ al = 2 \/ al = 4 \/ al = 8)
/\ sz >= 0 /\ (al | sz)
/\ (sz > 0 -> (al | osrc))
/\ (sz > 0 -> (al | odst))
/\ (bsrc <> bdst \/ osrc = odst \/ osrc + sz <= odst \/ odst + sz <= osrc).
Definition do_ef_memcpy (sz al: Z)
(w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
match vargs with
| Vptr bdst odst :: Vptr bsrc osrc :: nil =>
if decide (memcpy_args_ok sz al bdst (Ptrofs.unsigned odst) bsrc (Ptrofs.unsigned osrc)) then
do bytes <- Mem.loadbytes m bsrc (Ptrofs.unsigned osrc) sz;
do m' <- Mem.storebytes m bdst (Ptrofs.unsigned odst) bytes;
Some(w, E0, Vundef, m')
else None
| _ => None
end.
Definition do_ef_annot (text: string) (targs: list typ)
(w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
do args <- list_eventval_of_val vargs targs;
Some(w, Event_annot text args :: E0, Vundef, m).
Definition do_ef_annot_val (text: string) (targ: typ)
(w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
match vargs with
| varg :: nil =>
do arg <- eventval_of_val varg targ;
Some(w, Event_annot text (arg :: nil) :: E0, varg, m)
| _ => None
end.
Definition do_ef_debug (kind: positive) (text: ident) (targs: list typ)
(w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
Some(w, E0, Vundef, m).
Definition do_external (ef: external_function):
world -> list val -> mem -> option (world * trace * val * mem) :=
match ef with
| EF_external name sg => do_external_function name sg ge
| EF_builtin name sg => do_external_function name sg ge
| EF_runtime name sg => do_external_function name sg ge
| EF_vload chunk => do_ef_volatile_load chunk
| EF_vstore chunk => do_ef_volatile_store chunk
| EF_malloc => do_ef_malloc
| EF_free => do_ef_free
| EF_memcpy sz al => do_ef_memcpy sz al
| EF_annot kind text targs => do_ef_annot text targs
| EF_annot_val kind text targ => do_ef_annot_val text targ
| EF_inline_asm text sg clob => do_inline_assembly text sg ge
| EF_debug kind text targs => do_ef_debug kind text targs
end.

Lemma do_ef_external_sound:
forall ef w vargs m w' t vres m',
do_external ef w vargs m = Some(w', t, vres, m') ->
external_call ef ge vargs m t vres m' /\ possible_trace w t w'.