Section fs_open.
Variable (fsys: fs) (unused_fd: int).
Definition fs_open_existing (fname: int) (f: file) (md: fmode): fs :=
mkfs (get_max_fds fsys)
(mkfsdata (fun i => if Int.eq i unused_fd then Some (md, O)
else get_fdtable fsys i)
(fun i => if Int.eq i unused_fd then Some f
else get_fcache fsys i)
(fun i => if Int.eq i unused_fd then Some fname
else get_fnames fsys i))
(get_fstore fsys).
Definition fs_open_new (fname: int) (md: fmode): fs :=
mkfs (get_max_fds fsys)
(mkfsdata (fun i => if Int.eq i unused_fd then Some (md, O)
else get_fdtable fsys i)
(fun i => if Int.eq i unused_fd then Some new_file
else get_fcache fsys i)
(fun i => if Int.eq i unused_fd then Some fname
else get_fnames fsys i))
(get_fstore fsys).
Definition fs_open (fname: int) (md: fmode): option fs :=
match fwritable md, get_fstore fsys fname with
| false, Some f => Some (fs_open_existing fname f md)
| false, None => None
| true, Some f => Some (fs_open_existing fname f md)
| true, None => Some (fs_open_new fname md)
end.
End fs_open.
Definition handled_list: list AST.external_function := SYS_READ::SYS_WRITE::SYS_OPEN::nil.
Definition is_open (fsys: fs) (fname: int) := exists fd, get_fnames fsys fd = Some fname.
Definition is_readable (fsys: fs) (fd: int) :=
exists md, exists cur, exists f,
get_fdtable fsys fd = Some (md, cur) /\ get_fcache fsys fd = Some f.
Definition is_writable (fsys: fs) (fd: int) :=
exists md, exists cur, exists f,
get_fdtable fsys fd = Some (md, cur) /\ fwritable md=true /\
get_fcache fsys fd = Some f.
Inductive os_step: genv -> xT -> mem -> xT -> mem -> Prop :=
| os_corestep: forall ge z c fs m c' m',
corestep csem ge c m c' m' ->
os_step ge (mkxT z c fs) m (mkxT z c' fs) m'
| os_open: forall ge z s m c md0 fname0 md fname unused_fd fs',
let fs := get_fs s in
at_external csem (get_core s) = Some (SYS_OPEN, SYS_OPEN_SIG, fname0::md0::nil) ->
alloc_fd fs = Some unused_fd ->
val2omode md0 = Some md ->
val2oint fname0 = Some fname ->
~is_open fs fname ->
fs_open fs unused_fd fname md = Some fs' ->
after_external csem (Some (Vint unused_fd)) (get_core s) = Some c ->
os_step ge s m (mkxT z c fs') m
| os_read: forall ge z s m c fd0 fd buf adr nbytes0 nbytes bytes m',
let fs := get_fs s in
at_external csem (get_core s) = Some (SYS_READ, SYS_READ_SIG, fd0::buf::nbytes0::nil) ->
val2oint fd0 = Some fd ->
val2oadr buf = Some adr ->
val2oint nbytes0 = Some nbytes ->
fs_read fs fd (nat_of_Z (Int.unsigned nbytes)) = Some bytes ->
Forall is_defchar bytes ->
(Zlength bytes > 0)%Z ->
Mem.storebytes m (fst adr) (Int.unsigned (snd adr)) bytes = Some m' ->
after_external csem (Some (Vint (Int.repr (Zlength bytes)))) (get_core s) = Some c ->
os_step ge s m (mkxT z c fs) m'
(*| os_write: forall ge z s m c fd0 fd adr buf nbytes0 nbytes bytes fs' nbytes_written sig, let fs := get_fs s in at_external csem (get_core s) = Some (SYS_WRITE, sig, fd0::buf::nbytes0::nil) -> val2oint fd0 = Some fd -> val2oadr buf = Some adr -> val2oint nbytes0 = Some nbytes -> Mem.loadbytes m (fst adr) (Int.unsigned (snd adr)) (Int.unsigned nbytes) = Some bytes -> fs_write fs fd bytes = Some (nbytes_written, fs') -> after_external csem (Some (Vint (Int.repr (Z_of_nat nbytes_written)))) (get_core s) = Some c -> os_step ge s m (mkxT z c fs') m*).  Definition os_initial_core (ge: genv) (v: val) (args: list val): option xT := match initial_core csem ge v args with | Some c => Some (mkxT init_world c (mount_fs (fun _: int => None))) | None => None end.  Definition os_at_external (s: xT) := match at_external csem (get_core s) with | Some (SYS_READ, sig, args) => None | Some (SYS_WRITE, sig, args) => None | Some (SYS_OPEN, sig, args) => None | Some (ef, sig, args) => Some (ef, sig, args) | None => None end.  Lemma os_at_external_core1: forall s ef sig args, os_at_external s = Some (ef, sig, args) -> at_external csem (get_core s) = Some (ef, sig, args).  Lemma os_at_external_core2: forall s ef sig args, at_external csem (get_core s) = Some (ef, sig, args) -> ef<>SYS_READ -> ef<>SYS_WRITE -> ef<>SYS_OPEN -> os_at_external s = Some (ef, sig, args).  Lemma os_at_external_core3: forall s ef sig args, at_external csem (get_core s) = Some (ef, sig, args) -> ef=SYS_READ \/ ef=SYS_WRITE \/ ef=SYS_OPEN -> os_at_external s = None.  Lemma os_at_external_core4: forall s ef sig args, at_external csem (get_core s) = Some (ef, sig, args) -> os_at_external s = None -> ef=SYS_READ \/ ef=SYS_WRITE \/ ef=SYS_OPEN.  Definition os_after_external (ov: option val) (s: xT): option xT := match after_external csem ov (get_core s) with | Some c => Some (mkxT (get_ext s) c (get_fs s)) | None => None end.  Definition os_halted (s: xT): option val := halted csem (get_core s).  Program Definition FSCoreSem := Build_CoreSemantics genv xT mem os_initial_core os_at_external os_after_external os_halted os_step _ _ _ _. Next Obligation. case_eq (at_external csem (get_core q)). 2: unfold os_at_external; intros H1; rewrite H1; auto. intros [[ef sig] args] H1. inv H. apply corestep_not_at_external in H0; simpl in H1; congruence. unfold os_at_external; rewrite H0; auto. unfold os_at_external; rewrite H0; auto. (*unfold os_at_external; rewrite H0; auto.*)
Qed.
Next Obligation.
inv H.
apply corestep_not_halted in H0; simpl; auto.
edestruct (at_external_halted_excl csem); eauto. congruence.
edestruct (at_external_halted_excl csem); eauto. congruence.
(*edestruct (at_external_halted_excl csem); eauto. congruence.*)
Qed.
Next Obligation.
edestruct (at_external_halted_excl csem); eauto.
left; unfold os_at_external; rewrite H; auto.
Qed.
Next Obligation.
unfold os_after_external in H|-*.
case_eq (after_external csem retv (get_core q)).
intros c H1.
rewrite H1 in H.
inv H.
apply after_at_external_excl in H1.
unfold os_at_external.
simpl; rewrite H1; auto.
intros H1; rewrite H1 in H; congruence.
Qed.
Program Definition FSCoopSem :=
Build_CoopCoreSem _ _ FSCoreSem _.
Next Obligation.
inv CS.
destruct csem.
destruct coopsem.
eapply corestep_fwd; eauto.
solve[apply mem_lemmas.mem_forward_refl].
solve[eapply mem_lemmas.storebytes_forward; eauto].
Qed.
(* Next Obligation. inv CS. destruct csem. eapply corestep_wdmem; eauto. auto. eapply mem_lemmas.mem_wd_storebytes; eauto. intros v IN. clear - H5 IN. induction bytes. simpl in IN; inv IN. simpl in IN. destruct IN. subst. inv H5. destruct v; simpl in H1; try inv H1. solve[apply memval_inject_byte]. apply IHbytes; auto. solve[inv H5; auto]. Qed. *)
Definition file_exists (fsys: fs) (fname: int) := isSome (get_fstore fsys fname).
Definition fs_pre (ef: AST.external_function) u (typs: list typ) args (fsz: fs*Z) m :=
match ef, fsz, args with
| SYS_OPEN, (fsys, z), fname0::md0::nil =>
match val2oint fname0, val2omode md0 with
| Some fname, Some md =>
List.Forall2 Val.has_type (md0::nil) (sig_args SYS_OPEN_SIG) /\
get_nfiles_open fsys < nat_of_Z (Int.unsigned (get_max_fds fsys)) /\
(~file_exists fsys fname=true -> fwritable md=true) /\
~is_open fsys fname
| _, _ => False
end
| SYS_READ, (fsys, z), (fd0::buf::nbytes0::nil) =>
match val2oint fd0, val2oadr buf, val2oint nbytes0 with
| Some fd, Some adr, Some nbytes =>
u=adr /\
List.Forall2 Val.has_type (fd0::buf::nbytes0::nil) (sig_args SYS_READ_SIG) /\
is_readable fsys fd /\
Mem.range_perm m (fst adr) (Int.unsigned (snd adr))
(Int.unsigned (snd adr) + Int.unsigned nbytes) Cur Writable
| _, _, _ => False
end
| SYS_WRITE, (fsys, z), (fd0::buf::nbytes0::nil) =>
match val2oint fd0, val2oadr buf, val2oint nbytes0 with
| Some fd, Some adr, Some nbytes =>
u=adr /\
List.Forall2 Val.has_type (fd0::buf::nbytes0::nil) (sig_args SYS_WRITE_SIG) /\
is_writable fsys fd /\
Mem.range_perm m (fst adr) (Int.unsigned (snd adr))
(Int.unsigned (snd adr) + Int.unsigned nbytes) Cur Readable
| _, _, _ => False
end
| _, _, _ => False
end.
Definition obind {A B: Type} (d: B) (o: option A) (f: A -> B) :=
match o with Some a => f a | None => d end.
(*TODO: to make fs_post more precise, we'll have to add more information to the shared parameter x, i.e., the fd and fptr for file read/written*)
Definition fs_post (ef: AST.external_function) (adr: address) (ty: option typ)
retval0 (fsz: fs*Z) (m: mem) :=
match ef, fsz with
| SYS_OPEN, (fsys, z) => obind False retval0 (fun retval =>
obind False (val2oint retval) (fun fd => is_readable fsys fd))
| SYS_READ, (fsys, z) => obind False retval0 (fun retval =>
obind False (val2oint retval) (fun nbytes =>
exists bytes,
nbytes=Int.repr (Zlength bytes) /\
Mem.loadbytes m (fst adr) (Int.unsigned (snd adr)) (Int.unsigned nbytes) = Some bytes))
| SYS_WRITE, (fsys, z) => True
| _, _ => True
end.
Definition Client_FSExtSpec :=
Build_external_specification Memory.mem AST.external_function (fs*Z)
(fun ef: AST.external_function => address) fs_pre fs_post.
Program Definition FS_extension: Extension.Sig (Z*fs) fs Z FSCoreSem _ _ csem :=
@Extension.Make _ _ _ _ _ _ FSCoreSem _ _ csem
get_core get_fs fst (fun (x: fs) (y: Z) => (y, x))
_ _ _ fs_ext_pf3.
Next Obligation.
unfold os_after_external in H0.
case_eq (after_external csem ret (get_core s)).
intros.
rewrite H1 in H0.
inv H0.
simpl; auto.
intros.
rewrite H1 in H0.
congruence.
Qed.
Next Obligation.
apply corestep_not_at_external in H.
inv H0; simpl; auto; rewrite H in H1; congruence.
Qed.
Variable csem_det:
forall ge c m c' m' c'' m'',
corestep csem ge c m c' m' ->
corestep csem ge c m c'' m'' ->
c'=c'' /\ m'=m''.

Lemma FS_core_compat:
forall ge, @core_compatible _ _ _ _ _ _  FSCoreSem  _ _ _ ge ge FS_extension.