coq/0000755000107400000620000000000011207051710011047 5ustar shaosystemscoq/Machine.v0000644000107400000620000002676411000223177012620 0ustar shaosystemsRequire Import Coqlib. Require Import Map. Require Import Arith. Set Implicit Arguments. Unset Strict Implicit. Notation Label := nat (only parsing). Notation int := nat (only parsing). Module MemSpec <: MapSpec. Definition domain := Label. Definition image := int. Definition beq_Domain := eq_nat_dec. End MemSpec. Module MemMod := MapFun(MemSpec). Definition Mem := MemMod.Map. (** cell l in Mem *) Definition l_inH (l : Label) (h : Mem) : Prop := MemMod.in_dom l h. (** Store w into Mem l *) Definition H_Set (h : Mem) (l : Label) (w : int) : Mem := MemMod.put h l w. (** load w from Mem l *) Definition H_Get (h : Mem) (l : Label) : int := match h l with | Some b => b | None => 0 end. Inductive reg : Set := AX : reg | BX : reg | CX : reg | DX : reg | BP : reg | SI : reg | DI : reg | SP : reg. Definition beq_reg (r r': reg) := match r, r' with | AX, AX => true | BX, BX => true | CX, CX => true | DX, DX => true | BP, BP => true | DI, DI => true | SI, SI => true | SP, SP => true | _, _ => false end. Definition RFile := reg -> nat. Definition RF_update (R : RFile) (r : reg) (n : nat) : RFile := fun (r' : reg) => if beq_reg r' r then n else R r'. Inductive flag : Set := _ZF : flag | _IF : flag. Definition beq_flag(f f' : flag) := match f, f' with | _ZF, _ZF => true | _IF, _IF => true | _, _ => false end. Definition FlagR := flag -> bool. Definition Set_Flag (FL : FlagR) (fl : flag) : FlagR := fun (fl' : flag) => if beq_flag fl' fl then true else FL fl'. Definition Clear_Flag (FL : FlagR) (fl : flag) : FlagR := fun (fl' : flag) => if beq_flag fl' fl then false else FL fl'. Parameter FR2nat : FlagR -> nat. Parameter nat2FR : nat -> FlagR. Parameter FR_nat_iso_left : forall fr : FlagR, nat2FR (FR2nat fr) = fr. (* ISR is a special register in the PIC *) (* here we do not model the full PIC *) (* instead, we treat it as a special reg in CPU *) (* Since we only support one interrupt, *) (* it is sufficient to model it as boolean value *) Notation ISR := bool (only parsing). (*******************************************************************) (** pc, program counter *) Definition PC := int. (** entry point for the timer interrupt handler *) Parameter timer : PC. Definition h_entry := timer. Definition State := (Mem * RFile * FlagR * ISR)%type. (** Machine parameter manipulating *) (** A_B, meams, find "Part B" in "A" *) Definition S_Mem (S : State) : Mem := match S with (M, _, _, _) => M end. Definition S_RF (S : State) : RFile := match S with (_, R, _, _) => R end. Definition S_Flag (S : State) : FlagR := match S with (_, _, fl, _) => fl end. Definition S_ISR (S : State) : ISR := match S with (_, isr) => isr end. (** Update Machine State *******************************************) (** A_B_Upd, meams, update "Part B" in "A" *) Definition S_Mem_Upd (S : State) (M : Mem) : State := (M, S_RF S, S_Flag S, S_ISR S). Definition S_RF_Upd (S : State) (R : RFile) : State := (S_Mem S, R, S_Flag S, S_ISR S). Definition S_Flag_Upd (S : State) (fl : FlagR) : State := (S_Mem S, S_RF S, fl, S_ISR S). Definition S_ISR_Upd (S : State) (isr : ISR) : State := (S_Mem S, S_RF S, S_Flag S, isr). Tactic Notation "simplS" "in" hyp(H) := unfold S_Mem_Upd, S_RF_Upd, S_Flag_Upd, S_ISR_Upd, S_Mem, S_RF, S_Flag, S_ISR in H. Tactic Notation "simplS" := unfold S_Mem_Upd, S_RF_Upd, S_Flag_Upd, S_ISR_Upd, S_Mem, S_RF, S_Flag, S_ISR. Tactic Notation "simplS" "in" "*" := unfold S_Mem_Upd, S_RF_Upd, S_Flag_Upd, S_ISR_Upd, S_Mem, S_RF, S_Flag, S_ISR in * . (** defination of labels *) Notation lab := Label (only parsing). Notation flab := Label (only parsing). (* address mode *) Inductive Addr : Set := | A_imm : int -> Addr | A_reg : int -> reg -> Addr. (* oprand *) Inductive Opr : Set := | Opr_imm : int -> Opr | Opr_reg : reg -> Opr. (** Common Instructions: l *) Inductive instr : Set := | _cli : instr | _sti : instr (** Function Call instruction **) | _call : lab -> instr (** Branch instruction **) | _jne : lab -> instr (** mov instructions **) | _movwp : Opr -> reg -> instr | _movwld : Addr -> reg -> instr | _movwst : Opr -> Addr -> instr (** stack operations **) | _pushwp : Opr -> instr | _pushwm : Addr -> instr | _pushfw : instr | _popw : reg -> instr | _popfw : instr (** Simple instructions **) | _cmpw : Opr -> reg -> instr | _addw : Opr -> reg -> instr | _subw : Opr -> reg -> instr (** a special instruction for eoi **) | _outb_eoi: instr. (* outb_eoi is a hardwired instruction corresponding to outb al dx, where both al and dx contain 0x20 *) (********************************* We would like to support the following mov instructions: | _movir : int -> reg -> instr (* movw n r *) | _movrr : reg -> reg -> instr (* movw r r' *) | _movldi : int -> reg -> instr (* movw (n) r *) | _movldr : int -> reg -> reg -> instr (* movw n(r) r' *) (* store registers into memory *) | _movstri : reg -> int -> instr (* movw r (n) *) | _movstrr : reg -> int -> reg -> instr (* movw r n(r') *) (* store immediate num into memory *) | _movstii : int -> int -> instr (* movw n (n) *) | _movstir : int -> int -> reg -> instr (* movw n n'(r) *) **********************************) (** jump and return Instructions *) Inductive sinstr : Set := _jmp : lab -> sinstr | _retw : sinstr | _iret : sinstr. (** command, all the instructions and s-instructions are all commands. *) Inductive comm : Set := comml : instr -> comm |comms : sinstr -> comm. (** instruction sequence *) Inductive iseq : Set := seq : instr -> iseq -> iseq | sseq : sinstr -> iseq. (** CodeHeap C with Partitial Map **) Module CHSpec <: MapSpec. Definition domain := lab. Definition image := comm. Definition beq_Domain := eq_nat_dec. End CHSpec. (** CodeHeap C **) Module CHMod := MapFun (CHSpec). Definition CodeHeap := CHMod.Map. (** instruction [l] code heap *) Definition l_inC (ch : CodeHeap) (l : lab) (b : comm) : Prop := CHMod.maps_to ch l b. (** C[f]: find iseq in CodeHeap form label l, look up code heap **) Inductive lookupC: CodeHeap -> lab -> iseq -> Prop := | lookupC_c : forall (ch:CodeHeap) (l:lab) (s:sinstr), l_inC ch l (comms s) -> lookupC ch l (sseq s) | lookupC_b : forall (ch:CodeHeap) (l:lab) (s:instr) (b:iseq), l_inC ch l (comml s) -> lookupC ch (l+1) b -> lookupC ch l (seq s b). Definition World := (CodeHeap * State * PC)%type. Definition W_PC (W : World) := match W with (_, pc) => pc end. Definition W_S (W : World) := match W with (_, st, _) => st end. Definition W_Ch (W : World) := match W with (cdhp, _, _) => cdhp end. Ltac UnfoldStateAll := unfold S_Mem_Upd in * |- *; unfold S_RF_Upd in * |- *; unfold S_Flag_Upd in * |- *; unfold S_ISR_Upd in * |- *; unfold S_Mem in * |- *; unfold S_RF in * |- *; unfold S_Flag in * |- *; unfold S_ISR in * |- * . (** Iseq[l] in code block C1, it must in code block C1#C2 **) Lemma lkpC_DisjUnion_Left: forall (C_1 C_2 C:CodeHeap) (x:iseq) (l:lab), lookupC C_1 l x /\ CHMod.disjUnion C_1 C_2 C -> lookupC C l x. Proof. induction x. intros. InvertAll. inversion_clear H0. generalize H1. intros. constructor. unfold CHMod.disjUnion in H1. InvertAll. unfold l_inC in H. unfold l_inC. rewrite H4. apply CHMod.in_left_in_merge; auto. apply IHx. split; auto. intros. InvertAll. inversion_clear H0. constructor. unfold CHMod.disjUnion in H1. InvertAll. unfold l_inC in H. unfold l_inC. rewrite H2. apply CHMod.in_left_in_merge; auto. Qed. (** Iseq[l] in code block C2, it must in code block C1#C2 **) Lemma lkpC_DisjUnion_Right: forall C_1 C_2 C l x, lookupC C_2 l x /\ CHMod.disjUnion C_1 C_2 C -> lookupC C l x. Proof. intros. InvertAll. apply lkpC_DisjUnion_Left with C_2 C_1. split. auto. apply CHMod.disjUnion_commut. auto. Qed. (** Iseq[l] in code block C is the only instruction sequnce **) Lemma l_inC_unique: forall ch l b b', l_inC ch l b -> l_inC ch l b' -> b = b'. Proof. intros. inversion H. inversion H0. rewrite H2 in H3. inversion H3. auto. Qed. (** lookup into code block C, can find only one unique Iseq[l]**) Lemma lookupC_unique: forall (ch : CodeHeap) (b b' : iseq) (l : lab), lookupC ch l b -> lookupC ch l b' -> b = b'. Proof. induction b. induction b'. intros. inversion H. inversion H0. assert (comml i = comml i0). apply l_inC_unique with ch l; auto. inversion H13. assert (b = b'). apply IHb with (l + 1); auto. rewrite H14; auto. intros. inversion H. inversion H0. assert (comml i = comms s). apply l_inC_unique with ch l; auto. inversion H11. intros. inversion H. inversion H0. assert (comms s = comms s1). apply l_inC_unique with ch l; auto. inversion H9; auto. assert (comms s = comml s1). apply l_inC_unique with ch l; auto. inversion H10; auto. Qed. (***added by wangwei***) Lemma beq_reg_refl: forall r , true = beq_reg r r. Proof. induction r;simpl;trivial. Qed. Lemma reg_eq_dec: forall r r':reg,{r=r'}+{r<>r'}. Proof. double induction r r'; try (right;discriminate);try (left;reflexivity). Qed. Lemma reg_eq_beq_true: forall r r', r=r' -> true = beq_reg r r'. Proof. double induction r r'; try (intro H;elim H); try apply beq_reg_refl. Qed. Lemma reg_neq_beq_false: forall r r', r<>r'->false = beq_reg r r'. Proof. double induction r r'; auto. Qed. Lemma reg_beq_true_eq: forall r r', true = beq_reg r r' -> r=r'. Proof. double induction r r'; simpl;intro H; auto;inversion H. Qed. Lemma reg_beq_false_neq: forall r r',false = beq_reg r r'->r<>r'. Proof. double induction r r'; auto. Qed. Lemma beq_flag_refl: forall f , true = beq_flag f f. Proof. induction f;simpl;trivial. Qed. Lemma flag_eq_dec: forall r r':flag,{r=r'}+{r<>r'}. Proof. double induction r r'; try (right;discriminate);try (left;reflexivity). Qed. Lemma flag_eq_beq_true: forall r r', r=r' -> true = beq_reg r r'. Proof. double induction r r'; try (intro H;elim H); try apply beq_reg_refl. Qed. Lemma flag_neq_beq_false: forall r r', r<>r'->false = beq_reg r r'. Proof. double induction r r'; auto. Qed. Lemma flag_beq_true_eq: forall r r', true = beq_reg r r' -> r=r'. Proof. double induction r r'; simpl;intro H; auto;inversion H. Qed. Lemma falg_beq_false_neq: forall r r',false = beq_reg r r'->r<>r'. Proof. double induction r r'; auto. Qed. Lemma RF_update_RF_update : forall R r v v', RF_update (RF_update R r v') r v = RF_update R r v. Proof. intros. apply (extensionality reg nat). intro r0. unfold RF_update. generalize (beq_reg r0 r). induction b;reflexivity. Qed. Lemma RF_update_RF : forall R r v, RF_update R r v r = v. Proof. unfold RF_update. intros. replace (beq_reg r r) with true. reflexivity. apply beq_reg_refl. Qed. Lemma RF_update_prev : forall R r, RF_update R r (R r) = R. Proof. intros. apply (extensionality reg nat). intro r0;unfold RF_update. destruct (reg_eq_dec r0 r). subst. replace (beq_reg r r) with true; [reflexivity|apply beq_reg_refl]. replace (beq_reg r0 r) with false; [reflexivity|apply flag_neq_beq_false;assumption ]. Qed. coq/Operational_Semantics.v0000644000107400000620000002542511000223177015530 0ustar shaosystems(****** Operational Semantics ******) Require Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Set Implicit Arguments. Unset Strict Implicit. (* Definition stkSpace (sp : int) (n : nat) : MPred := *) (* fun (M : Mem) => (sp >= n) /\ (leadsToBlk (sp-n) n) M. *) (* (\* precise version of stkSpace *\) *) (* Definition stkSpacePrec (sp : int) (n : nat) : MPred := *) (* fun (M : Mem) => (sp >= n) /\ (ptoxBlk (sp-n) n) M. *) (* Definition MemUpd16 (M : Mem) (l : int) (n : int) (M' : Mem) : Prop := *) (* exists x, M' = MemMod.put (MemMod.put M l n) (l+1) x. *) Definition opr_eval (R : RFile) (o : Opr) : int := match o with Opr_imm i => i | Opr_reg r => R r end. Definition addr_eval (R : RFile) (a : Addr) : int := match a with A_imm l => l | A_reg l r => R r + l end. Definition pushW (M M' : Mem) (R R': RFile) (n : int) : Prop := stkSpace (R SP) 2 M /\ MemUpd16 M (R SP - 2) n M' /\ R' = RF_update R SP (R SP - 2). Definition popW (M : Mem) (R R': RFile) (n : int) : Prop := leadsToW (R SP) n M /\ R' = RF_update R SP (R SP + 2). Definition trash_fl (FL FL': FlagR) (f : flag) : Prop := (FL' = Set_Flag FL f) \/ (FL' = Clear_Flag FL f). Inductive nextS : PC -> comm -> State -> State -> Prop := (** Interrupt status instructions **) | nextS_cli: forall (pc : PC) (M:Mem) (R:RFile) (fl: FlagR) (isr: ISR), nextS pc (comml _cli) (M, R, fl, isr) (M, R, Clear_Flag fl _IF, isr) | nextS_sti: forall (pc : PC) (M:Mem) (R:RFile) (fl: FlagR) (isr: ISR), nextS pc (comml _sti) (M, R, fl, isr) (M, R, Set_Flag fl _IF, isr) (** Function call instruction**) | nextS_call: forall (pc : PC) (f: flab) (M M':Mem) (R R':RFile) (fl : FlagR) (isr: ISR), pushW M M' R R' (pc + 1) -> nextS pc (comml (_call f)) (M, R, fl, isr) (M', R', fl, isr) (** BrancM instruction **) | nextS_jne : forall (pc : PC) (f : flab) (M:Mem) (R: RFile) (fl : FlagR) (isr:ISR), nextS pc (comml (_jne f)) (M, R, fl, isr) (M, R, fl, isr) (** Move instruction **) | nextS_movwp : forall (pc : PC) (o : Opr) (r : reg) (M:Mem) (R R': RFile) (fl : FlagR) (isr: ISR) (x : int), (x = opr_eval R o) -> R' = RF_update R r x -> nextS pc (comml (_movwp o r)) (M, R, fl, isr) (M, R', fl, isr) | nextS_movwld : forall (pc : PC) (r : reg) (a : Addr) (M:Mem) (R R': RFile) (fl : FlagR) (isr: ISR) (l x : int), (l = addr_eval R a) -> leadsToW l x M -> R' = RF_update R r x -> nextS pc (comml (_movwld a r)) (M, R, fl, isr) (M, R', fl, isr) | nextS_movwst : forall (pc : PC) (o : Opr) (a : Addr) (M M':Mem) (R: RFile) (fl : FlagR) (isr: ISR) (l x : int), (l = addr_eval R a) -> (x = opr_eval R o) -> leadsToxW l M -> MemUpd16 M l x M' -> nextS pc (comml (_movwst o a)) (M, R, fl, isr) (M', R, fl, isr) (** stack operations **) | nextS_pushwp : forall (pc : PC) (o : Opr) (M M':Mem) (R R': RFile) (fl : FlagR) (isr: ISR) (x:int), (x = opr_eval R o) -> pushW M M' R R' x -> nextS pc (comml (_pushwp o)) (M, R, fl, isr) (M', R', fl, isr) | nextS_pushwm : forall (pc : PC) (a : Addr) (M M':Mem) (R R': RFile) (fl : FlagR) (isr: ISR) (l x :int), (l = addr_eval R a) -> leadsToW l x M -> pushW M M' R R' x -> nextS pc (comml (_pushwm a)) (M, R, fl, isr) (M', R', fl, isr) | nextS_pushfw : forall (pc : PC) (M M':Mem) (R R': RFile) (fl : FlagR) (isr: ISR), pushW M M' R R' (FR2nat fl) -> nextS pc (comml _pushfw) (M, R, fl, isr) (M', R', fl, isr) | nextS_popw : forall (pc : PC) (r : reg) (M:Mem) (R R' R'': RFile) (fl : FlagR) (isr: ISR) (x:int), popW M R R' x -> R'' = RF_update R' r x -> nextS pc (comml (_popw r)) (M, R, fl, isr) (M, R'', fl, isr) | nextS_popfw : forall (pc : PC) (M:Mem) (R R': RFile) (fl fl': FlagR) (isr: ISR) (flnum:int), popW M R R' flnum -> fl' = nat2FR flnum -> nextS pc (comml _popfw) (M, R, fl, isr) (M, R', fl', isr) (** Simple instructions **) | nextS_cmpw : forall (pc : PC) (o : Opr) (r : reg) (M:Mem) (R: RFile) (fl fl': FlagR) (isr:ISR), ((opr_eval R o = R r) /\ (fl' = Set_Flag fl _ZF) \/ (opr_eval R o <> R r) /\ (fl' = Clear_Flag fl _ZF)) -> nextS pc (comml (_cmpw o r)) (M, R, fl, isr) (M, R, fl', isr) | nextS_addw : forall (pc : PC) (o : Opr) (r : reg) (M : Mem) (R R' : RFile) (fl fl' : FlagR) (isr : ISR) (x x' : int), (x = opr_eval R o) -> (x' = R r) -> R' = RF_update R r (x + x') -> trash_fl fl fl' _ZF -> nextS pc (comml (_addw o r)) (M, R, fl, isr) (M, R', fl', isr) | nextS_subw : forall (pc : PC) (o : Opr) (r : reg) (M : Mem) (R R' : RFile) (fl fl' : FlagR) (isr : ISR) (x x' : int), (x = opr_eval R o) -> (x' = R r) -> R' = RF_update R r (x' - x) -> trash_fl fl fl' _ZF -> nextS pc (comml (_subw o r)) (M, R, fl, isr) (M, R', fl', isr) (** eoi instruction **) | nextS_EOI : forall (pc : PC) (M : Mem) (R : RFile) (fl : FlagR) (isr : ISR), (R AX = 32) -> (R DX = 32) -> nextS pc (comml _outb_eoi) (M, R, fl, isr) (M, R, fl, false) (** Special instruction **) | nextS_jmp : forall (pc : PC) (M:Mem) (R: RFile) (fl : FlagR) (isr:ISR) (f': flab), nextS pc (comms (_jmp f')) (M, R, fl, isr) (M, R, fl, isr) | nextS_retw: forall (pc : PC) (M:Mem) (R R':RFile) (fl : FlagR) (isr: ISR), (exists pc', popW M R R' pc') -> nextS pc (comms _retw) (M, R, fl, isr) (M, R', fl, isr) | nextS_iret: forall (pc : PC) (M:Mem) (R R':RFile) (fl fl': FlagR) (isr: ISR) (flnum sp : int), (R SP = sp) -> leadsToBlk sp 6 M -> leadsToW (sp+4) flnum M -> fl' = nat2FR flnum -> R' = RF_update R SP (sp+6) -> nextS pc (comms _iret) (M, R, fl, isr) (M, R', fl', isr). Inductive nextPC : comm -> Mem -> RFile -> FlagR -> PC -> PC -> Prop := (** Interrupt status instructions **) | nextPC_cli: forall (pc : PC) (M:Mem) (R:RFile) (fl:FlagR), nextPC (comml _cli) M R fl pc (pc+1) | nextPC_sti: forall (pc : PC) (M:Mem) (R:RFile) (fl:FlagR), nextPC (comml _sti) M R fl pc (pc+1) (** Function call instruction**) | nextPC_call: forall (pc : PC) (f: flab) (M :Mem) (R :RFile) (fl:FlagR), nextPC (comml (_call f)) M R fl pc f (** BrancM instruction **) | nextPC_jneF: forall (pc : PC) (f : flab) (M:Mem) (R: RFile) (fl : FlagR), (fl _ZF = true) -> nextPC (comml (_jne f)) M R fl pc (pc+1) | nextPC_jneT: forall (pc : PC) (f : flab) (M:Mem) (R: RFile) (fl : FlagR), (fl _ZF = false) -> nextPC (comml (_jne f)) M R fl pc f (** Move instruction **) | nextPC_movwp : forall (pc : PC) (o : Opr) (r : reg) (M:Mem) (R : RFile) (fl:FlagR), nextPC (comml (_movwp o r)) M R fl pc (pc+1) | nextPC_movwld : forall (pc : PC) (a : Addr) (r : reg) (M:Mem) (R : RFile) (fl:FlagR), nextPC (comml (_movwld a r)) M R fl pc (pc+1) | nextPC_movwst : forall (pc : PC) (o : Opr) (a : Addr) (M:Mem) (R : RFile) (fl:FlagR), nextPC (comml (_movwst o a)) M R fl pc (pc+1) (** stack operations **) | nextPC_pushwp : forall (pc : PC) (o : Opr) (M:Mem) (R: RFile) (fl:FlagR), nextPC (comml (_pushwp o)) M R fl pc (pc+1) | nextPC_pushwm : forall (pc : PC) (a : Addr) (M:Mem) (R: RFile) (fl:FlagR), nextPC (comml (_pushwm a)) M R fl pc (pc+1) | nextPC_pushfw : forall (pc : PC) (M:Mem) (R: RFile) (fl:FlagR), nextPC (comml _pushfw) M R fl pc (pc+1) | nextPC_popw : forall (pc : PC) (r : reg) (M:Mem) (R: RFile) (fl:FlagR), nextPC (comml (_popw r)) M R fl pc (pc+1) | nextPC_popfw : forall (pc : PC) (M:Mem) (R : RFile) (fl:FlagR), nextPC (comml _popfw) M R fl pc (pc+1) (** Simple instructions **) | nextPC_cmpw : forall (pc : PC) (o : Opr) (r : reg) (M:Mem) (R: RFile) (fl:FlagR), nextPC (comml (_cmpw o r)) M R fl pc (pc+1) | nextPC_addw : forall (pc : PC) (o : Opr) (r : reg) (M:Mem) (R: RFile) (fl:FlagR), nextPC (comml (_addw o r)) M R fl pc (pc+1) | nextPC_subw : forall (pc : PC) (o : Opr) (r : reg) (M:Mem) (R: RFile) (fl:FlagR), nextPC (comml (_subw o r)) M R fl pc (pc+1) (** eoi instruction **) | nextPC_EOI : forall (pc : PC) (M : Mem) (R : RFile) (fl:FlagR), nextPC (comml _outb_eoi) M R fl pc (pc+1) (** Special instruction **) | nextPC_jmp : forall (pc : PC) (M:Mem) (R: RFile) (f': flab) (fl:FlagR), nextPC (comms (_jmp f')) M R fl pc f' | nextPC_retw: forall (pc pc': PC) (M:Mem) (R:RFile) (sp:int) (fl:FlagR), (R SP = sp) -> leadsToW sp pc' M -> nextPC (comms _retw) M R fl pc pc' | nextPC_iret: forall (pc pc': PC) (M:Mem) (R:RFile) (sp:int) (fl:FlagR), (R SP = sp) -> leadsToBlk sp 6 M -> leadsToW sp pc' M -> nextPC (comms _iret) M R fl pc pc'. (** Step World: W --> W' common instructions **) Definition stepInstr (W:World) (W':World) : Prop := match W,W' with (ch, st, pc), (ch',st',pc')=> (ch = ch') /\ exists c:comm, l_inC ch pc c /\ nextPC c (S_Mem st) (S_RF st) (S_Flag st) pc pc' /\ nextS pc c st st' end. Definition itr_enabled (S : State) : Prop := (S_Flag S _IF = true) /\ (S_ISR S = false). Definition itr_nextS (pc : PC) (S S' : State) : Prop := match S, S' with | (M, R, fl, isr), (M',R',fl',isr')=> exists sp, exists flnum, exists cs, exists M'', exists M''', (sp = R SP) /\ (stkSpace sp 6 M) /\ (R' = RF_update R SP (sp - 6)) /\ (fl' = Clear_Flag fl _IF) /\ (isr' = true) /\ (flnum = FR2nat fl) /\ (MemUpd16 M (sp-6) pc M'') /\ (MemUpd16 M'' (sp-4) cs M''') /\ (MemUpd16 M''' (sp-2) flnum M') end. (** Step World: W ==> W' interrupts *) Definition stepItr (W:World) (W':World) : Prop := match W, W' with | (ch, st, pc), (ch', st', pc') => (ch = ch') /\ itr_enabled st /\ itr_nextS pc st st' /\ pc' = h_entry end. (** Step World ****) Inductive step : World -> World -> Prop := (** W --> W' common instructions **) | step_instr : forall (W:World) (W':World), stepInstr W W' -> step W W' (** W ==> W' interrupts *) | step_inter : forall (W:World) (W':World), stepItr W W' -> step W W'. (** N-Step World ****) Inductive stepN : nat -> World -> World -> Prop := (** 0-Step: 0 W |==> W **) | stepO : forall W W', W' = W -> stepN 0 W W' (** N-Step: n W |==> W'**) | stepS : forall W W' n, (exists W'', step W W'' /\ stepN n W'' W') -> stepN (S n) W W'. coq/Assertion_Lemmas5.v0000644000107400000620000000677311000223177014604 0ustar shaosystemsRequire Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Mem_Lemmas. Require Import Assertion. Require Import Omega. Lemma prepost_weaken_pre : forall (mP mP' mQ: MPred) S S', prepost mP mQ S S' -> (forall M, mP M -> mP' M) -> prepost mP' mQ S S'. Proof. unfold prepost. intros mP mP' mQ S S' HSS' H. destruct HSS' as [M1 [M2 [M1' [HM1 [HM1' [HJM HJM']]]]]]. exists M1; exists M2; exists M1'. auto. Qed. Implicit Arguments prepost_weaken_pre [mP mP' mQ S S']. Lemma prepost_weaken_post : forall (mP mQ mQ': MPred) S S', prepost mP mQ S S' -> (forall M, mQ M -> mQ' M) -> prepost mP mQ' S S'. Proof. unfold prepost. intros mP mQ mQ' S S' HSS' H. destruct HSS' as [M1 [M2 [M1' [HM1 [HM1' [HJM HJM']]]]]]. exists M1; exists M2; exists M1'. auto. Qed. Implicit Arguments prepost_weaken_post [mP mQ mQ' S S']. Lemma precise_Aemp : precise Aemp. Proof. unfold precise, Aemp. intros M1 M2 M Hsub1 Hsub2 HM1 HM2. subst M1 M2. trivial. Qed. Lemma prec_disjUnion_inv : forall M M1 M2 M1' M2' (Inv : MPred), MemMod.disjUnion M1 M2 M -> MemMod.disjUnion M1' M2' M -> Inv M2 -> Inv M2' -> precise Inv -> M1 = M1' /\ M2 = M2'. Proof. intros. unfold precise in H3. assert (MemMod.subseteq M2 M). eapply MemMod.disjUnion_subseteq_right; eauto. assert (MemMod.subseteq M2' M). eapply MemMod.disjUnion_subseteq_right; eauto. assert (Heq := H3 _ _ _ H4 H5 H1 H2). split_r. eapply MemMod.disjUnion_unique with (M5:=M); eauto. auto with PMap. auto with PMap. Qed. Implicit Arguments prec_disjUnion_inv [M M1 M2 M1' M2' Inv]. Lemma prec_disjUnion_inv_left : forall M M1 M2 M1' M2' (Inv : MPred), MemMod.disjUnion M1 M2 M -> MemMod.disjUnion M1' M2' M -> Inv M1 -> Inv M1' -> precise Inv -> M1 = M1' /\ M2 = M2'. Proof. intros. assert (MemMod.disjUnion M2 M1 M). auto with PMap. assert (MemMod.disjUnion M2' M1' M). auto with PMap. assert (Hx := prec_disjUnion_inv H4 H5 H1 H2 H3). destruct Hx; auto. Qed. Implicit Arguments prec_disjUnion_inv_left [M M1 M2 M1' M2' Inv]. Lemma prepost_elim : forall mP mQ A S S', prepost mP mQ S S' -> precise mP -> (mP *^* A) (S_Mem S) -> (mQ *^* A) (S_Mem S'). Proof. unfold prepost. intros mP mQ A S S' HSS' HmP HS. destruct HSS' as [M1 [M2 [M1' [HM1 [HM1' [HJM HJM']]]]]]. destruct HS as [M1x [M2x [HJMx [HM1x HM2x]]]]. destruct (prec_disjUnion_inv_left HJM HJMx HM1 HM1x HmP). subst M1x M2x; clear HJMx. exists M1'; exists M2; auto. Qed. Implicit Arguments prepost_elim [mP mQ A S S']. Lemma prepost_elim_emp : forall S S', prepost Aemp Aemp S S' -> (S_Mem S') = (S_Mem S). Proof. intros S S'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS. unfold prepost, Aemp. intros H. destruct H as [M1 [M2 [M1' H]]]. destruct H as [HM1 [HM1' [HJM HJM']]]. subst M1 M1'. simplS in * . rewrite (MemMod.emp_disjUnion_unique (MemMod.disjUnion_commut HJM)) in HJM'. rewrite (MemMod.emp_disjUnion_unique (MemMod.disjUnion_commut HJM')). trivial. Qed. Lemma prepost_elim_emp_M : forall M R fl isr M' R' fl' isr', prepost Aemp Aemp (M, R, fl, isr) (M', R', fl', isr') -> M' = M. Proof. intros M R fl isr M' R' fl' isr'. unfold prepost, Aemp. intros H. destruct H as [M1 [M2 [M1' H]]]. destruct H as [HM1 [HM1' [HJM HJM']]]. subst M1 M1'. simplS in * . rewrite (MemMod.emp_disjUnion_unique (MemMod.disjUnion_commut HJM)) in HJM'. rewrite (MemMod.emp_disjUnion_unique (MemMod.disjUnion_commut HJM')). trivial. Qed. coq/Makefile0000644000107400000620000001331011000223177012504 0ustar shaosystems############################################################################## ## The Calculus of Inductive Constructions ## ## ## ## Projet Coq ## ## ## ## INRIA ENS-CNRS ## ## Rocquencourt Lyon ## ## ## ## Coq V7 ## ## ## ## ## ############################################################################## # WARNING # # This Makefile has been automagically generated by coq_makefile # Edit at your own risks ! # # END OF WARNING # # This Makefile was generated by the command line : # coq_makefile -I . Assertion.v Assertion_Lemmas.v Assertion_Lemmas2.v Assertion_Lemmas3.v Assertion_Lemmas4.v Assertion_Lemmas5.v Arith_Lemmas.v Coqlib.v ListT.v Machine.v Map.v Mem_Lemmas.v MultiMapT.v OpSem_Lemmas.v OpSem_Lemmas2.v Operational_Semantics.v Reg.v ./CAP0 ./SCAP ./miniOS # ########################## # # # Variables definitions. # # # ########################## CAMLP4LIB=`camlp4 -where` COQSRC=-I $(COQTOP)/kernel -I $(COQTOP)/lib \ -I $(COQTOP)/library -I $(COQTOP)/parsing \ -I $(COQTOP)/pretyping -I $(COQTOP)/interp \ -I $(COQTOP)/proofs -I $(COQTOP)/syntax -I $(COQTOP)/tactics \ -I $(COQTOP)/toplevel -I $(COQTOP)/contrib/correctness \ -I $(COQTOP)/contrib/extraction -I $(COQTOP)/contrib/field \ -I $(COQTOP)/contrib/fourier -I $(COQTOP)/contrib/graphs \ -I $(COQTOP)/contrib/interface -I $(COQTOP)/contrib/jprover \ -I $(COQTOP)/contrib/omega -I $(COQTOP)/contrib/romega \ -I $(COQTOP)/contrib/ring -I $(COQTOP)/contrib/xml \ -I $(CAMLP4LIB) ZFLAGS=$(OCAMLLIBS) $(COQSRC) OPT= COQFLAGS=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML) COQC=$(COQBIN)coqc GALLINA=gallina COQDOC=$(COQBIN)coqdoc CAMLC=ocamlc -c CAMLOPTC=ocamlopt -c CAMLLINK=ocamlc CAMLOPTLINK=ocamlopt COQDEP=$(COQBIN)coqdep -c GRAMMARS=grammar.cma CAMLP4EXTEND=pa_extend.cmo pa_ifdef.cmo q_MLast.cmo PP=-pp "camlp4o -I . -I $(COQTOP)/parsing $(CAMLP4EXTEND) $(GRAMMARS) -impl" ######################### # # # Libraries definition. # # # ######################### OCAMLLIBS=-I .\ -I . COQLIBS=-I .\ -I . ################################### # # # Definition of the "all" target. # # # ################################### VFILES=Assertion.v\ Assertion_Lemmas.v\ Assertion_Lemmas2.v\ Assertion_Lemmas3.v\ Assertion_Lemmas4.v\ Assertion_Lemmas5.v\ Arith_Lemmas.v\ Coqlib.v\ ListT.v\ Machine.v\ Map.v\ Mem_Lemmas.v\ MultiMapT.v\ OpSem_Lemmas.v\ OpSem_Lemmas2.v\ Operational_Semantics.v\ Reg.v VOFILES=$(VFILES:.v=.vo) VIFILES=$(VFILES:.v=.vi) GFILES=$(VFILES:.v=.g) HTMLFILES=$(VFILES:.v=.html) GHTMLFILES=$(VFILES:.v=.g.html) all: Assertion.vo\ Assertion_Lemmas.vo\ Assertion_Lemmas2.vo\ Assertion_Lemmas3.vo\ Assertion_Lemmas4.vo\ Assertion_Lemmas5.vo\ Arith_Lemmas.vo\ Coqlib.vo\ ListT.vo\ Machine.vo\ Map.vo\ Mem_Lemmas.vo\ MultiMapT.vo\ OpSem_Lemmas.vo\ OpSem_Lemmas2.vo\ Operational_Semantics.vo\ Reg.vo\ ./CAP0\ ./SCAP\ ./miniOS\ ./examples spec: $(VIFILES) gallina: $(GFILES) html: $(HTMLFILES) gallinahtml: $(GHTMLFILES) all.ps: $(VFILES) $(COQDOC) -ps -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` all-gal.ps: $(VFILES) $(COQDOC) -ps -g -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` ################### # # # Subdirectories. # # # ################### ./CAP0: cd ./CAP0 ; $(MAKE) all ./SCAP: cd ./SCAP ; $(MAKE) all ./miniOS: cd ./miniOS ; $(MAKE) all ./examples: cd ./examples ; $(MAKE) all #################### # # # Special targets. # # # #################### .PHONY: all opt byte archclean clean install depend html ./CAP0 ./SCAP ./miniOS ./examples .SUFFIXES: .v .vo .vi .g .html .tex .g.tex .g.html .v.vo: $(COQC) $(COQDEBUG) $(COQFLAGS) $* .v.vi: $(COQC) -i $(COQDEBUG) $(COQFLAGS) $* .v.g: $(GALLINA) $< .v.tex: $(COQDOC) -latex $< -o $@ .v.html: $(COQDOC) -html $< -o $@ .v.g.tex: $(COQDOC) -latex -g $< -o $@ .v.g.html: $(COQDOC) -html -g $< -o $@ byte: $(MAKE) all "OPT=" opt: $(MAKE) all "OPT=-opt" include .depend .depend depend: rm -f .depend $(COQDEP) -i $(COQLIBS) $(VFILES) *.ml *.mli >.depend $(COQDEP) $(COQLIBS) -suffix .html $(VFILES) >>.depend (cd ./CAP0 ; $(MAKE) depend) (cd ./SCAP ; $(MAKE) depend) (cd ./miniOS ; $(MAKE) depend) (cd ./examples ; $(MAKE) depend) install: mkdir -p `$(COQC) -where`/user-contrib cp -f $(VOFILES) `$(COQC) -where`/user-contrib (cd ./CAP0 ; $(MAKE) install) (cd ./SCAP ; $(MAKE) install) (cd ./miniOS ; $(MAKE) install) clean: rm -f *.cmo *.cmi *.cmx *.o $(VOFILES) $(VIFILES) $(GFILES) *~ rm -f all.ps all-gal.ps $(HTMLFILES) $(GHTMLFILES) (cd ./CAP0 ; $(MAKE) clean) (cd ./SCAP ; $(MAKE) clean) (cd ./miniOS ; $(MAKE) clean) archclean: rm -f *.cmx *.o (cd ./CAP0 ; $(MAKE) archclean) (cd ./SCAP ; $(MAKE) archclean) (cd ./miniOS ; $(MAKE) archclean) html: (cd ./CAP0 ; $(MAKE) html) (cd ./SCAP ; $(MAKE) html) (cd ./miniOS ; $(MAKE) html) # WARNING # # This Makefile has been automagically generated by coq_makefile # Edit at your own risks ! # # END OF WARNING coq/stat0000755000107400000620000000054511000223252011745 0ustar shaosystems#!/bin/bash echo "* Statistic " echo " " echo -n " ** Total lines of code : " find ./ -name '*.v' | xargs grep -v '^$' | wc -l echo -n " ** Total number of definitions : " find ./ -name '*.v' | xargs grep -E '(Definition|Fixpoint)' | wc -l echo -n " ** Total number of lemmas/theorems : " find ./ -name '*.v' | xargs grep -E '(Lemma|Theorem)' | wc -l coq/COPYRIGHT0000644000107400000620000000314411207051710012344 0ustar shaosystemsCopyright (c) 2008-2009 by Xinyu Feng, Zhong Shao, Yu Guo, and Yuan Dong. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the names of Yale University, Toyoto Technological Institute at Chicago, University of Science and Technology of China, and Tsinghua University, nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. coq/CAP0/0000755000107400000620000000000011000242127011525 5ustar shaosystemscoq/CAP0/Makefile0000644000107400000620000001010611000223221013155 0ustar shaosystems################################################################################ The Calculus of Inductive Constructions #### #### Projet Coq #### #### INRIA ENS-CNRS #### Rocquencourt Lyon #### #### Coq V7 #### #### ################################################################################# WARNING # # This Makefile has been automagically generated by coq_makefile # Edit at your own risks ! # # END OF WARNING # # This Makefile was generated by the command line : # coq_makefile -I ../ CAP0.v Soundness.v Link.v # ########################## # # # Variables definitions. # # # ########################## CAMLP4LIB=`camlp4 -where` COQSRC=-I $(COQTOP)/kernel -I $(COQTOP)/lib \ -I $(COQTOP)/library -I $(COQTOP)/parsing \ -I $(COQTOP)/pretyping -I $(COQTOP)/interp \ -I $(COQTOP)/proofs -I $(COQTOP)/syntax -I $(COQTOP)/tactics \ -I $(COQTOP)/toplevel -I $(COQTOP)/contrib/correctness \ -I $(COQTOP)/contrib/extraction -I $(COQTOP)/contrib/field \ -I $(COQTOP)/contrib/fourier -I $(COQTOP)/contrib/graphs \ -I $(COQTOP)/contrib/interface -I $(COQTOP)/contrib/jprover \ -I $(COQTOP)/contrib/omega -I $(COQTOP)/contrib/romega \ -I $(COQTOP)/contrib/ring -I $(COQTOP)/contrib/xml \ -I $(CAMLP4LIB) ZFLAGS=$(OCAMLLIBS) $(COQSRC) OPT= COQFLAGS=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML) COQC=$(COQBIN)coqc GALLINA=gallina COQDOC=coqdoc CAMLC=ocamlc -c CAMLOPTC=ocamlopt -c CAMLLINK=ocamlc CAMLOPTLINK=ocamlopt COQDEP=$(COQBIN)coqdep -c GRAMMARS=grammar.cma CAMLP4EXTEND=pa_extend.cmo pa_ifdef.cmo q_MLast.cmo PP=-pp "camlp4o -I . -I $(COQTOP)/parsing $(CAMLP4EXTEND) $(GRAMMARS) -impl" ######################### # # # Libraries definition. # # # ######################### OCAMLLIBS=-I .\ -I ../ COQLIBS=-I .\ -I ../ ################################### # # # Definition of the "all" target. # # # ################################### VFILES=CAP0.v\ Soundness.v\ Link.v VOFILES=$(VFILES:.v=.vo) VIFILES=$(VFILES:.v=.vi) GFILES=$(VFILES:.v=.g) HTMLFILES=$(VFILES:.v=.html) GHTMLFILES=$(VFILES:.v=.g.html) all: CAP0.vo\ Soundness.vo\ Link.vo spec: $(VIFILES) gallina: $(GFILES) html: $(HTMLFILES) gallinahtml: $(GHTMLFILES) all.ps: $(VFILES) $(COQDOC) -ps -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` all-gal.ps: $(VFILES) $(COQDOC) -ps -g -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` #################### # # # Special targets. # # # #################### .PHONY: all opt byte archclean clean install depend html .SUFFIXES: .v .vo .vi .g .html .tex .g.tex .g.html .v.vo: $(COQC) $(COQDEBUG) $(COQFLAGS) $* .v.vi: $(COQC) -i $(COQDEBUG) $(COQFLAGS) $* .v.g: $(GALLINA) $< .v.tex: $(COQDOC) -latex $< -o $@ .v.html: $(COQDOC) -html $< -o $@ .v.g.tex: $(COQDOC) -latex -g $< -o $@ .v.g.html: $(COQDOC) -html -g $< -o $@ byte: $(MAKE) all "OPT=" opt: $(MAKE) all "OPT=-opt" include .depend .depend depend: rm -f .depend $(COQDEP) -i $(COQLIBS) *.v *.ml *.mli >.depend $(COQDEP) $(COQLIBS) -suffix .html *.v >>.depend install: mkdir -p `$(COQC) -where`/user-contrib cp -f *.vo `$(COQC) -where`/user-contrib clean: rm -f *.cmo *.cmi *.cmx *.o *.vo *.vi *.g *~ rm -f all.ps all-gal.ps $(HTMLFILES) $(GHTMLFILES) archclean: rm -f *.cmx *.o html: # WARNING # # This Makefile has been automagically generated by coq_makefile # Edit at your own risks ! # # END OF WARNING coq/CAP0/CAP0.v0000644000107400000620000002540111000223221012373 0ustar shaosystemsAdd LoadPath "..". Require Import Coqlib. Require Import MultiMapT. Require Import EqNat. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Notation LangID := nat (only parsing). Inductive Spec0 : Type := packS0 : LangID -> Spec -> Spec0. Module OSpec0 <: ONE_TYPE. Definition B := Spec0. End OSpec0. (* psi : PSpec *) Module OPSpec := MultiMap OSpec0. Definition PSpec := OPSpec.map. Definition emptCT := OPSpec.emp_map. Definition consCT : flab -> Spec0 -> PSpec -> PSpec := fun f theta Psi => OPSpec.merge (OPSpec.sig_map f theta) Psi. (* look up code heap type *) Definition lookupCT : PSpec -> flab -> Spec0 -> Prop := fun Psi f s => OPSpec.lookup Psi f s. (* assertion be in domian PSpec type *) Definition inCT : PSpec -> flab -> Prop := fun Psi f => OPSpec.indom Psi f. (** Subset of PSpec, subsetCT Psi Psi' means: Psi is a subset of Psi' **) Definition subsetCT : PSpec -> PSpec -> Prop := fun Psi Psi' => OPSpec.sub Psi Psi'. Definition Assert := PSpec -> State -> Prop. Definition ITP := Spec -> Assert. Definition LDict := LangID -> OptionT ITP. (** Subset of LDict, subsetD D D' means: D is a subset of D' **) Definition subsetD : LDict -> LDict -> Prop := fun D D' => forall (rho : LangID) (itp : ITP), D rho = SomeT1 _ itp -> D' rho = SomeT1 _ itp. Definition ext_dict (D : LDict) (rho : LangID) (itp : ITP) : LDict := fun (rho' : LangID) => if (beq_nat rho' rho) then SomeT1 _ itp else D rho'. Lemma ext_dict_subsetD : forall D rho itp, D rho = NoneT1 ITP -> subsetD D (ext_dict D rho itp). Proof. unfold subsetD, ext_dict; intros. compare rho0 rho; intros. subst rho0. rewrite H in H0. discriminate. generalize (refl_equal (beq_nat rho0 rho)). pattern rho0 at 2. destruct (beq_nat rho0 rho); intros. rewrite (beq_nat_eq _ _ H1) in n. contradiction n; trivial. trivial. Qed. Parameter itr_spec : Spec. Parameter itr_ID : LangID. Parameter itr_Itp : ITP. Definition itr_theta := packS0 itr_ID itr_spec. Definition AFalse := fun (Psi : PSpec) (S : State) => False. Definition Itp0 (D : LDict) (theta : Spec0) : Assert := match theta with packS0 rho s => match D rho with NoneT1 => AFalse | SomeT1 itp => itp s end end. Definition Mono_CT_assert (a : Assert) : Prop := forall Psi S, a Psi S -> forall Psi', subsetCT Psi Psi' -> a Psi' S. Definition Mono_CT_PSpec (D : LDict) (Psi : PSpec) : Prop := forall f theta0, lookupCT Psi f theta0 -> Mono_CT_assert (Itp0 D theta0). Definition Mono_CT_Itp (D : LDict) := forall theta0, Mono_CT_assert (Itp0 D theta0). Definition WFcmd_aux (D : LDict) (Psi : PSpec) (theta : Spec0) (f : flab) (c : comm) : Prop := forall Psi' S, (Itp0 D theta) Psi' S -> subsetCT Psi Psi' -> (exists S', nextS f c S S') /\ (forall f' S', nextS f c S S' -> nextPC c (S_Mem S) (S_RF S) (S_Flag S) f f' -> exists theta', lookupCT Psi' f' theta' /\ Itp0 D theta' Psi' S') /\ (~ itr_enabled S \/ (exists S', itr_nextS f S S' /\ forall S', itr_nextS f S S' -> exists theta', lookupCT Psi' h_entry theta' /\ Itp0 D theta' (consCT f theta Psi') S') ). (* Definition WFcmd_aux (D : LDict) (Psi : PSpec) (a : Assert) (f : flab) (c : comm) : Prop := forall Psi' S, a Psi' S -> subsetCT Psi Psi' -> (exists S', nextS f c S S') /\ (forall f' S', nextS f c S S' -> nextPC c (S_Mem S) (S_RF S) (S_Flag S) f f' -> exists theta, lookupCT Psi' f' theta /\ Itp0 D theta Psi' S') /\ (~ itr_enabled S \/ (exists S', itr_nextS f S S' /\ forall S', itr_nextS f S S' -> exists theta, lookupCT Psi' h_entry theta /\ Itp0 D theta Psi' S') ). *) Definition WFcmd (D : LDict) (Psi : PSpec) (theta : Spec0) (f : flab) (c : comm) : Prop := WFcmd_aux D Psi theta f c /\ Mono_CT_assert (Itp0 D theta). (* Definition WFcmd (D : LDict) (Psi : PSpec) (a : Assert) (f : flab) (c : comm) : Prop := WFcmd_aux D Psi a f c /\ Mono_CT_assert a. *) Inductive WFiseq (D : LDict) (Psi : PSpec) : Spec0 -> flab -> iseq -> Prop := wfis_seq : forall (theta : Spec0) (f: flab) (i : instr) (is : iseq) (theta' : Spec0), WFcmd D (consCT (f+1) theta' Psi) theta f (comml i) -> WFiseq D Psi theta' (f+1) is -> WFiseq D Psi theta f (seq i is) | wfis_end : forall (theta : Spec0) (f: flab) (si : sinstr), WFcmd D Psi theta f (comms si) -> WFiseq D Psi theta f (sseq si). (* Inductive WFiseq (D : LDict) (Psi : PSpec) : Assert -> flab -> iseq -> Prop := wfis_seq : forall (a : Assert) (f: flab) (i : instr) (is : iseq) (theta : Spec0), WFcmd D (consCT (f+1) theta Psi) a f (comml i) -> WFiseq D Psi (Itp0 D theta) (f+1) is -> WFiseq D Psi a f (seq i is) | wfis_end : forall (a : Assert) (f: flab) (si : sinstr), WFcmd D Psi a f (comms si) -> WFiseq D Psi a f (sseq si). *) Definition WFcdhp (D : LDict) (Psi : PSpec) (C : CodeHeap) (Psi' : PSpec) : Prop := forall (f : flab) (theta : Spec0), lookupCT Psi' f theta -> exists isq : iseq, lookupC C f isq /\ WFiseq D Psi theta f isq. (* Definition WFcdhp (D : LDict) (Psi : PSpec) (C : CodeHeap) (Psi' : PSpec) : Prop := forall (f : flab) (theta : Spec0), lookupCT Psi' f theta -> exists isq : iseq, lookupC C f isq /\ WFiseq D Psi (Itp0 D theta) f isq. *) Definition WFworld (D : LDict) (Psi : PSpec) (W : World) : Prop := match W with (X, pc) => match X with (ch, st) => lookupCT Psi h_entry itr_theta /\ D itr_ID = SomeT1 _ itr_Itp /\ exists Psi', WFcdhp D Psi ch Psi' /\ subsetCT Psi Psi' /\ Mono_CT_PSpec D Psi' /\ exists theta, Itp0 D theta Psi' st /\ exists isq, lookupC ch pc isq /\ WFiseq D Psi theta pc isq end end. (* Definition WFworld (D : LDict) (Psi : PSpec) (W : World) : Prop := match W with (X, pc) => match X with (ch, st) => lookupCT Psi h_entry itr_theta /\ D itr_ID = SomeT1 _ itr_Itp /\ exists Psi', WFcdhp D Psi ch Psi' /\ subsetCT Psi Psi' /\ Mono_CT_PSpec D Psi' /\ exists a, a Psi' st /\ exists isq, lookupC ch pc isq /\ WFiseq D Psi a pc isq end end. *) (*****************************************************************************) (*** Mono related Lemma **) (*****************************************************************************) Lemma WFiseq_mono_a: forall D Psi f s isq, WFiseq D Psi s f isq -> Mono_CT_assert (Itp0 D s). Proof. intros D Psi f s isq WFI. inversion WFI. (** sequece instructions **) rename H into WFc. unfold WFcmd in WFc. InvertAll; auto. rename H into WFc. unfold WFcmd in WFc. InvertAll; auto. Qed. Lemma MonoCT_psi_extend: forall (D:LDict) (Psi:PSpec) (f:flab) (s:Spec0), Mono_CT_PSpec D Psi -> Mono_CT_assert (Itp0 D s) -> Mono_CT_PSpec D (consCT f s Psi). Proof. unfold Mono_CT_PSpec. intros D Psi f s monoCT monoa. intros f' s' lkpCT. unfold consCT in lkpCT. assert (lookupCT (OPSpec.sig_map f s) f' s' \/ lookupCT Psi f' s'). apply OPSpec.lookup_merge_elim; auto. rename H into lkpCT'. inversion lkpCT'. (** f = f' **) rename H into lkpCTf. inversion lkpCTf. rename H into pair. inversion pair. rename H1 into eqs. rewrite <- eqs; auto. absurd (False); auto. (** f' in Psi **) apply monoCT with f'; auto. Qed. (*****************************************************************************) (*** PSPec related Lemma **) (*****************************************************************************) (** Lemma for subset Code Specification **) Lemma Psi_extend_subsetCT: forall Psi Psi' pc s, subsetCT Psi Psi' -> subsetCT Psi (consCT pc s Psi'). Proof. unfold subsetCT, consCT. intros. apply OPSpec.sub_trans with Psi'; auto. apply OPSpec.sub_merge_r. Qed. Lemma subsetCT_refl: forall Psi, subsetCT Psi Psi. Proof. unfold subsetCT. intros. apply OPSpec.sub_refl. Qed. Lemma subsetCT_trans: forall Psi1 Psi2 Psi3, subsetCT Psi1 Psi2 -> subsetCT Psi2 Psi3 -> subsetCT Psi1 Psi3. Proof. unfold subsetCT. intros Psi1 Psi2 Psi3 sub1 sub2 f theta lkpCT. apply sub2. apply sub1; auto. Qed. Lemma Psi_extend2_subsetCT: forall Psi Psi' pc s, subsetCT Psi Psi' -> subsetCT (consCT pc s Psi) (consCT pc s Psi'). Proof. unfold subsetCT, consCT. intros. apply OPSpec.sub_merge_sub; auto. Qed. Lemma lookupCT_subsetCT : forall Psi Psi' l theta0, lookupCT Psi l theta0 -> subsetCT Psi Psi' -> lookupCT Psi' l theta0. Proof. unfold lookupCT, subsetCT. intros Psi Psi' l theta0 Hlk Hsubset. eapply OPSpec.lookup_sub_lookup; eauto. Qed. Lemma lookupCT_consCT : forall Psi l theta0, lookupCT (consCT l theta0 Psi) l theta0. Proof. unfold lookupCT, consCT. intros Psi l theta0. apply OPSpec.lookup_merge_intro_l. unfold OPSpec.sig_map, OPSpec.lookup. simpl. left; trivial. Qed. Lemma consCT_subsetCT: forall Psi pc s, subsetCT Psi (consCT pc s Psi). Proof. unfold subsetCT, consCT. intros. apply OPSpec.sub_merge_r. Qed. Lemma Psi_extend3_subsetCT : forall Psi Psi' f s, lookupCT Psi' f s -> subsetCT Psi Psi' -> subsetCT (consCT f s Psi) Psi'. Proof. unfold subsetCT,lookupCT. unfold OPSpec.sub . intros. unfold OPSpec.lookup. destruct H1. rewrite <- H1. apply H. apply H0. apply H1. Qed. Lemma lookupCT_lookupCT_consCT : forall Psi f f' s s', lookupCT Psi f s -> lookupCT (consCT f' s' Psi) f s. Proof. intros. apply (lookupCT_subsetCT Psi (consCT f' s' Psi) f s). apply H. apply consCT_subsetCT. Qed. (** OCAP WF Isequence when Psi enlarge with (f,s) **) Lemma WFcmd_Mono_CT : forall D Psi Psi' theta f c, subsetCT Psi Psi' -> WFcmd D Psi theta f c -> WFcmd D Psi' theta f c. Proof. unfold WFcmd, WFcmd_aux. intros D Psi Psi' theta f c Hsub [H1 H2]. split_r. intros. apply H1; trivial. eapply subsetCT_trans; eauto. Qed. Lemma WFcdhp_psi_extend: forall D Psi Psi' ch f s isq, lookupC ch f isq -> WFiseq D Psi s f isq -> WFcdhp D Psi ch Psi' -> WFcdhp D Psi ch (consCT f s Psi'). Proof. unfold WFcdhp, consCT. intros D Psi Psi' ch f s isq lkpC2 WFi WFc f' s' lkpCT. assert (lookupCT (OPSpec.sig_map f s) f' s' \/ lookupCT Psi' f' s'). apply OPSpec.lookup_merge_elim; auto. rename H into lkpCTor. inversion lkpCTor. rename H into lkpCTsig. inversion lkpCTsig. rename H into pair. inversion pair. rename H0 into eqf. rename H1 into eqs. rewrite <- eqf. rewrite <- eqs. exists isq. split; auto. absurd (False); auto. apply WFc; auto. Qed. Hint Resolve Psi_extend_subsetCT. Hint Resolve subsetCT_refl. Hint Resolve Psi_extend2_subsetCT. coq/CAP0/Link.v0000644000107400000620000003174511000223221012615 0ustar shaosystemsAdd LoadPath "..". Require Import Coqlib. Require Import MultiMapT. Require Import EqNat. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import CAP0. Definition compatible_Dict (D D' : LDict) : Prop := forall (rho : LangID), (D rho = NoneT1 _)\/ (D' rho = NoneT1 _) \/ (exists itp, D rho = SomeT1 _ itp /\ D' rho = SomeT1 _ itp). Definition union_Dict (D D' : LDict) : LDict := fun (rho : LangID) => match D rho with NoneT1 => D' rho | SomeT1 itp => D rho end. Definition Describe_theta (D : LDict) (theta : Spec0) : Prop := exists rho, exists a, theta = packS0 rho a /\ (exists itp, D rho = SomeT1 ITP itp). Definition Describe_Psi (D : LDict) (Psi : PSpec) : Prop := forall f rho a, lookupCT Psi f (packS0 rho a) /\ (exists itp, D rho = SomeT1 ITP itp). Definition union_Psi (Psi Psi':PSpec) : PSpec := OPSpec.merge Psi Psi'. (*****************************************************************************) (*** Dictionary related lemmas **) (*****************************************************************************) (** (D1 U D2) is the super set of D1 **) Lemma subsetD_Union_Left: forall D1 D2, compatible_Dict D1 D2 -> subsetD D1 (union_Dict D1 D2). Proof. intros D1 D2 cpt_D. unfold subsetD. intros. unfold union_Dict. rewrite H. auto. Qed. (** (D1 U D2) is the super set of D2 **) Lemma subsetD_Union_Right: forall D1 D2, compatible_Dict D1 D2 -> subsetD D2 (union_Dict D1 D2). Proof. intros D1 D2 cpt_D. unfold compatible_Dict in cpt_D. unfold subsetD. intros. assert (D1 rho = NoneT1 ITP \/ D2 rho = NoneT1 ITP \/ (exists itp : ITP, D1 rho = SomeT1 ITP itp /\ D2 rho = SomeT1 ITP itp)). apply cpt_D. inversion H0. unfold union_Dict. rewrite H1. auto. inversion H1. rewrite H2 in H. inversion H. InvertAll. unfold union_Dict. induction (D1 rho); auto. rewrite H2. rewrite <- H4. auto. Qed. (** OCAP WF command when Dictionary enlarge **) Lemma WFstate_dict_enlarge: forall D1 D2 theta Psi st, (Itp0 D1 theta) Psi st -> subsetD D1 D2 -> (Itp0 D2 theta) Psi st. Proof. unfold subsetD, Itp0. intros D1 D2 theta Psi st aS subD. induction theta. assert (D1 n = NoneT1 ITP \/ exists itp, D1 n = SomeT1 ITP itp). induction (D1 n). left; auto. right. exists t; auto. rename H into orItp. inversion orItp. rename H into nonItp. rewrite nonItp in aS. inversion aS. InvertAll. rename x into itp. rename H0 into smItp. rewrite smItp in aS. assert (D2 n = SomeT1 ITP itp). apply subD. auto. rename H into smItp'. rewrite smItp'; auto. Qed. (** OCAP WF command when Dictionary enlarge **) Lemma WFstate_dict_reduce: forall D1 D2 rho, (exists itp, D1 rho = SomeT1 ITP itp) /\ subsetD D1 D2 -> forall Psi st a, (Itp0 D2 (packS0 rho a)) Psi st -> (Itp0 D1 (packS0 rho a)) Psi st. Proof. unfold subsetD, Itp0. intros D1 D2 rho. intros [[itp desD] subC] Psi st a. assert (D2 rho = SomeT1 ITP itp). apply subC; auto. rename H into desD'. rewrite desD. rewrite desD'. auto. Qed. Lemma Mono_dict_extend: forall D1 D2 rho, (exists itp, D1 rho = SomeT1 ITP itp) /\ subsetD D1 D2 -> forall a, Mono_CT_assert (Itp0 D1 (packS0 rho a)) -> Mono_CT_assert (Itp0 D2 (packS0 rho a)). Proof. unfold Mono_CT_assert. intros D1 D2 rho. intros D1rho a aSp Psi st aS Psi' subCT. apply WFstate_dict_enlarge with D1. apply aSp with Psi. apply WFstate_dict_reduce with D2; auto. auto. InvertAll. auto. Qed. (** OCAP WF command when Dictionary enlarge **) Lemma WFcmd_dict_enlarge: forall D1 D2 rho, (exists itp, D1 rho = SomeT1 ITP itp) /\ subsetD D1 D2 -> forall Psi f theta c, WFcmd D1 Psi (packS0 rho theta) f c -> WFcmd D2 Psi (packS0 rho theta) f c. Proof. unfold WFcmd. unfold WFcmd_aux. intros D1 D2 rho. intros itp_subD Psi f theta c. intros [WFca mono]. split. intros Psi' st aS subCT. substH WFca with (WFca Psi' st (WFstate_dict_reduce _ _ _ itp_subD _ _ _ aS) subCT). destruct WFca as [nS [paS pitrS]]. split_l. split. intros f' st' nS' nPC'. assert ( exists theta : Spec0, lookupCT Psi' f' theta /\ Itp0 D1 theta Psi' st'). apply paS; auto. destruct H as [theta' [lkpCT aS']]. exists theta'. split_l. InvertAll. apply WFstate_dict_enlarge with D1; auto. inversion_clear pitrS. left; auto. destruct H as [st' [nS_itr pitrS]]. right. exists st'. split; auto. intros. substH pitrS with (pitrS _ H). destruct pitrS as [theta' [lkpCT aS_itr]]. exists theta'. split_l. InvertAll. apply WFstate_dict_enlarge with D1; auto. apply Mono_dict_extend with D1; auto. Qed. (** OCAP WF Isequence when Dictional enlarge **) Lemma WFiseq_dict_enlarge: forall D D' Psi, Describe_Psi D Psi /\ subsetD D D' -> (forall isq rho theta f, WFiseq D Psi (packS0 rho theta) f isq -> WFiseq D' Psi (packS0 rho theta) f isq). Proof. intros D D' Psi [disD subD]. induction isq. intros rho a f WFi. unfold Describe_Psi in disD. assert (lookupCT Psi f (packS0 rho a) /\ (exists itp : ITP, D rho = SomeT1 ITP itp)). apply disD. destruct H as [lkpCT smD]. inversion_clear WFi. assert (WFcmd D' (consCT (f + 1) theta' Psi) (packS0 rho a) f (comml i)). apply WFcmd_dict_enlarge with D; auto. induction theta'. assert (WFiseq D' Psi (packS0 n s) (f + 1) isq). apply IHisq; auto. rename H1 into WFc'. rename H2 into WFi'. gen_clear WFc' WFi'. apply wfis_seq. intros rho a f WFi. unfold Describe_Psi in disD. assert (lookupCT Psi f (packS0 rho a) /\ (exists itp : ITP, D rho = SomeT1 ITP itp)). apply disD. destruct H as [lkpCT smD]. inversion_clear WFi. assert (WFcmd D' Psi (packS0 rho a) f (comms s)). apply WFcmd_dict_enlarge with D; auto. apply wfis_end; auto. Qed. (** OCAP WF Codeheap when Psi enlarge **) Lemma WFcdhp_dict_enlarge: forall D1 D2 Psi, Describe_Psi D1 Psi /\ subsetD D1 D2 -> forall Psi' ch, WFcdhp D1 Psi ch Psi' -> WFcdhp D2 Psi ch Psi'. Proof. unfold WFcdhp. intros D1 D2 Psi [desD subD] Psi' ch. intros WFC f theta lkpCT. assert (exists isq : iseq, lookupC ch f isq /\ WFiseq D1 Psi theta f isq). apply WFC; auto. destruct H as [isq [lkpC WFi]]. exists isq. split_l. induction theta. apply WFiseq_dict_enlarge with D1; auto. Qed. (*****************************************************************************) (*** PSPec related lemma for link **) (*****************************************************************************) (** if (l theta) in (Psi1 U Psi2), it in Psi1 or Psi2 or in both of Psi1 and Psi2**) Lemma lkpCT_Union: forall Psi1 Psi2 l theta, lookupCT (union_Psi Psi1 Psi2) l theta -> lookupCT Psi1 l theta \/ lookupCT Psi2 l theta. Proof. unfold lookupCT. intros. apply OPSpec.lookup_merge_elim. auto. Qed. (** (Psi1 U Psi2) is the super set of Psi1 **) Lemma subsetCT_Union_Left: forall Psi1 Psi2, subsetCT Psi1 (union_Psi Psi1 Psi2). Proof. unfold subsetCT, union_Psi. intros. apply OPSpec.sub_merge_l. Qed. (** (Psi1 U Psi2) is the super set of Psi2 **) Lemma subsetCT_Union_Right: forall Psi1 Psi2, subsetCT Psi2 (union_Psi Psi1 Psi2). Proof. unfold subsetCT, union_Psi. intros. apply OPSpec.sub_merge_r. Qed. (** OCAP WF command when Psi enlarge **) Lemma WFcmd_psi_enlarge: forall D Psi Psi' f a c, subsetCT Psi Psi' -> WFcmd D Psi a f c -> WFcmd D Psi' a f c. Proof. unfold WFcmd. unfold WFcmd_aux. intros D Psi Psi' f a c subCT. intros. InvertAll. split_r. intros. apply H0; auto. apply subsetCT_trans with Psi'; auto. Qed. (** OCAP WF Isequence when Psi enlarge **) Lemma WFiseq_psi_enlarge: forall D Psi Psi', subsetCT Psi Psi' -> (forall isq a f, WFiseq D Psi a f isq -> WFiseq D Psi' a f isq). Proof. unfold subsetCT. intros D Psi Psi' subCT. induction isq. intros a f WFi. inversion WFi. apply wfis_seq with theta'; trivial. apply WFcmd_psi_enlarge with (consCT (f + 1) theta' Psi); trivial. apply Psi_extend2_subsetCT; auto. apply IHisq; trivial. intros a f WFi. inversion_clear WFi. assert (WFcmd D Psi' a f (comms s)). apply WFcmd_psi_enlarge with Psi; auto. apply wfis_end; auto. Qed. (** OCAP WF Codeheap when Psi enlarge **) Lemma WFcdhp_psi_enlarge: forall D Psi1 Psi2 Psi' ch, subsetCT Psi1 Psi2 -> WFcdhp D Psi1 ch Psi' -> WFcdhp D Psi2 ch Psi'. Proof. unfold WFcdhp. intros D Psi1 Psi2 Psi' ch subCT. intros WFc f theta lkpCT. assert (exists isq : iseq, lookupC ch f isq /\ WFiseq D Psi1 theta f isq). apply WFc; auto. InvertAll. rename x into isq. rename H into lkpC. rename H1 into WFi. exists isq. split_l. apply WFiseq_psi_enlarge with Psi1; auto. Qed. (** Lemma 3.3 in OCAP paper **) Lemma WFcdhp_Enlarge: forall D D' Psi Psi' C Psi'', WFcdhp D Psi C Psi'' -> subsetCT Psi Psi' -> subsetD D D' -> Describe_Psi D Psi -> Describe_Psi D' Psi' -> WFcdhp D' Psi' C Psi''. Proof. intros D D' Psi Psi' C Psi'' WFc subCT subD desD desD'. apply WFcdhp_psi_enlarge with Psi; auto. apply WFcdhp_dict_enlarge with D; auto. Qed. Lemma Describe_dict_union_left: forall D1 D2 Psi, compatible_Dict D1 D2 -> Describe_Psi D1 Psi -> Describe_Psi (union_Dict D1 D2) Psi. Proof. intros D1 D2 Psi. unfold Describe_Psi. intros comp_dict des1 f rho a. substH des1 with (des1 f rho a). destruct des1 as [lkpCT [itp d1rho]]. unfold compatible_Dict in comp_dict. assert (D1 rho = NoneT1 ITP \/ D2 rho = NoneT1 ITP \/ (exists itp : ITP, D1 rho = SomeT1 ITP itp /\ D2 rho = SomeT1 ITP itp)). apply comp_dict. inversion_clear H. rewrite d1rho in H0. inversion H0. inversion_clear H0. unfold union_Dict. rewrite d1rho. split_l. exists itp; auto. destruct H as [itp1 [d1rho' d2rho]]. split_l. exists itp1. unfold union_Dict. rewrite d1rho'. auto. Qed. Lemma Describe_dict_union_right: forall D1 D2 Psi, compatible_Dict D1 D2 -> Describe_Psi D2 Psi -> Describe_Psi (union_Dict D1 D2) Psi. Proof. intros D1 D2 Psi. unfold Describe_Psi. intros comp_dict des1 f rho a. substH des1 with (des1 f rho a). destruct des1 as [lkpCT [itp d2rho]]. unfold compatible_Dict in comp_dict. assert (D1 rho = NoneT1 ITP \/ D2 rho = NoneT1 ITP \/ (exists itp : ITP, D1 rho = SomeT1 ITP itp /\ D2 rho = SomeT1 ITP itp)). apply comp_dict. inversion_clear H. unfold union_Dict. rewrite H0. split_l. exists itp; auto. inversion_clear H0. rewrite d2rho in H. inversion H. destruct H as [itp1 [d1rho d2rho']]. split_l. exists itp1. unfold union_Dict. rewrite d1rho. auto. Qed. Lemma Describe_psi_union: forall D Psi1 Psi2, Describe_Psi D Psi1 -> Describe_Psi D Psi2 -> Describe_Psi D (union_Psi Psi1 Psi2). Proof. intros D Psi1 Psi2. unfold Describe_Psi. unfold lookupCT. intros des1 des2 f rho a. substH des1 with (des1 f rho a). destruct des1 as [lkpCT1 dPsi1]. substH des2 with (des2 f rho a). destruct des2 as [lkpCT2 dPsi2]. split_r. apply OPSpec.lookup_merge_intro. left; auto. Qed. Lemma Describe_enlarge: forall D1 D2 Psi1 Psi2, compatible_Dict D1 D2 -> Describe_Psi D1 Psi1 -> Describe_Psi D2 Psi2 -> Describe_Psi (union_Dict D1 D2) (union_Psi Psi1 Psi2). Proof. intros D1 D2 Psi1 Psi2. intros comp_dict des1 des2. apply Describe_psi_union. apply Describe_dict_union_left; auto. apply Describe_dict_union_right; auto. Qed. (****************************************************************************) (******* Code heap link lemma ****) (****************************************************************************) Lemma WFcdhp_link: forall D_1 D_2 Psi_1 Psi_1' Psi_2 Psi_2' C_1 C_2 C, WFcdhp D_1 Psi_1 C_1 Psi_1' -> WFcdhp D_2 Psi_2 C_2 Psi_2' -> compatible_Dict D_1 D_2 -> CHMod.disjUnion C_1 C_2 C -> Describe_Psi D_1 Psi_1 -> Describe_Psi D_2 Psi_2 -> WFcdhp (union_Dict D_1 D_2) (union_Psi Psi_1 Psi_2) C (union_Psi Psi_1' Psi_2'). Proof. intros D_1 D_2 Psi_1 Psi_1' Psi_2 Psi_2' C_1 C_2 C. intros wfc1 wfc2 comp_dict union_ch des1 des2. assert ( WFcdhp (union_Dict D_1 D_2) (union_Psi Psi_1 Psi_2) C_1 Psi_1'). apply WFcdhp_Enlarge with D_1 Psi_1; auto. apply subsetCT_Union_Left. apply subsetD_Union_Left; auto. apply Describe_enlarge; auto. assert ( WFcdhp (union_Dict D_1 D_2) (union_Psi Psi_1 Psi_2) C_2 Psi_2'). apply WFcdhp_Enlarge with D_2 Psi_2; auto. apply subsetCT_Union_Right. apply subsetD_Union_Right; auto. apply Describe_enlarge; auto. clear wfc1 wfc2. rename H into wfc1. rename H0 into wfc2. unfold WFcdhp. intros l theta lkpCT. assert (lookupCT Psi_1' l theta \/ lookupCT Psi_2' l theta). apply lkpCT_Union; auto. inversion H. unfold WFcdhp in wfc1. assert (exists isq : iseq, lookupC C_1 l isq /\ WFiseq (union_Dict D_1 D_2) (union_Psi Psi_1 Psi_2) theta l isq). apply wfc1; auto. InvertAll. exists x. split. apply lkpC_DisjUnion_Left with C_1 C_2. split; auto. auto. unfold WFcdhp in wfc2. assert (exists isq : iseq, lookupC C_2 l isq /\ WFiseq (union_Dict D_1 D_2) (union_Psi Psi_1 Psi_2) theta l isq). apply wfc2; auto. InvertAll. exists x. split. apply lkpC_DisjUnion_Right with C_1 C_2. split; auto. auto. Qed. coq/CAP0/make.sh0000644000107400000620000000024311000223221012767 0ustar shaosystems#!/bin/bash # Top rule for Makefile. # To generate top Makefile, just type: sh make.sh > Makefile # Then type: make coq_makefile -I ../ CAP0.v Soundness.v Link.v coq/CAP0/Soundness.v0000644000107400000620000004666211000223221013705 0ustar shaosystemsAdd LoadPath "..". Require Import Coqlib. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import CAP0. Lemma existsNextPC : forall pc i S, exists pc', nextPC (comml i) (S_Mem S) (S_RF S) (S_Flag S) pc pc'. Proof. induction i; intros. exists (pc+1). constructor. exists (pc+1). constructor. exists n. constructor. assert (S_Flag S _ZF = true \/ S_Flag S _ZF = false). induction (S_Flag S _ZF); auto. inversion_clear H. exists (pc+1). constructor. auto. exists n. constructor. auto. exists (pc+1). constructor. exists (pc+1). constructor. exists (pc+1). constructor. exists (pc+1). constructor. exists (pc+1). constructor. exists (pc+1). constructor. exists (pc+1). constructor. exists (pc+1). constructor. exists (pc+1). constructor. exists (pc+1). constructor. exists (pc+1). constructor. exists (pc+1). constructor. Qed. Hint Resolve existsNextPC. Lemma existsNS_existsNPC: forall pc s S, (exists S', nextS pc (comms s) S S') -> exists pc', nextPC (comms s) (S_Mem S) (S_RF S) (S_Flag S) pc pc'. Proof. intros. induction s. exists n. constructor. inversion H. rename x into S'. inversion H0. inversion H1. rename x into pc'. exists pc'. apply nextPC_retw with (S_RF S SP); auto. rewrite H4. auto. unfold popW in H3. inversion_clear H3. rewrite <- H4. unfold S_RF. auto. inversion H. rename x into S'. inversion H0. assert (exists pc', (sp |~>w pc') M). apply leadsToInterK; auto. inversion H7. exists x. apply nextPC_iret with sp; auto. Qed. Hint Resolve existsNS_existsNPC. Lemma CAP0_Progress: forall D Psi W, WFworld D Psi W -> exists W', stepInstr W W'. Proof. intros. (** unfold WFworld **) unfold WFworld in H. induction W as ((ch,st),pc). InvertAll. rename x into Psi'. rename x1 into isq. rename x0 into theta. rename H into itrD. rename H0 into lkpCT. rename H1 into subCT. rename H2 into WFC. rename H3 into monoCT. rename H5 into aS. rename H6 into lkpC. rename H7 into WFI. induction st as (((h,R),fl),isr). unfold stepInstr. (** inductive over instructions **) induction isq. clear IHisq. inversion_clear lkpC. inversion_clear WFI. rename H1 into WFc. unfold WFcmd in WFc. InvertAll. rename H1 into WFc. unfold WFcmd_aux in WFc. rename H3 into mono_a. unfold Mono_CT_assert in mono_a. rename theta' into theta0. assert ((exists S' : State, nextS pc (comml i) (h,R,fl,isr) S') /\ (forall (f' : PC) (S' : State), nextS pc (comml i) (h,R,fl,isr) S' -> nextPC (comml i) (S_Mem (h,R,fl,isr)) (S_RF (h,R,fl,isr)) (S_Flag (h,R,fl,isr)) pc f' -> exists theta' : Spec0, lookupCT (consCT (pc+1) theta0 Psi') f' theta' /\ Itp0 D theta' (consCT (pc+1) theta0 Psi') S') /\ (~ itr_enabled (h,R,fl,isr) \/ (exists S' : State, itr_nextS pc (h,R,fl,isr) S' /\ (forall S'0 : State, itr_nextS pc (h,R,fl,isr) S'0 -> exists theta' : Spec0, lookupCT (consCT (pc+1) theta0 Psi') h_entry theta' /\ Itp0 D theta' (consCT pc theta (consCT (pc+1) theta0 Psi')) S'0)))). apply WFc; auto. apply mono_a with Psi'; auto. InvertAll. rename H1 into Simp. rename H5 into itrnS. rename H4 into nS. clear Simp itrnS WFc. assert (exists pc', nextPC (comml i) (S_Mem (h, R, fl, isr)) (S_RF (h, R, fl, isr)) (S_Flag (h, R, fl, isr)) pc pc'). auto. inversion H1. rename x0 into pc'. exists (ch, x, pc'). split; auto. exists (comml i). split; auto. (** specicial instructions **) inversion_clear lkpC. inversion_clear WFI. rename H0 into WFc. unfold WFcmd in WFc. InvertAll. rename H0 into WFc. unfold WFcmd_aux in WFc. assert ((exists S' : State, nextS pc (comms s) (h,R,fl,isr) S') /\ (forall (f' : PC) (S' : State), nextS pc (comms s) (h,R,fl,isr) S' -> nextPC (comms s) (S_Mem (h,R,fl,isr)) (S_RF (h,R,fl,isr)) (S_Flag (h,R,fl,isr)) pc f' -> exists theta' : Spec0, lookupCT Psi' f' theta' /\ Itp0 D theta' Psi' S') /\ (~ itr_enabled (h,R,fl,isr) \/ (exists S' : State, itr_nextS pc (h,R,fl,isr) S' /\ (forall S'0 : State, itr_nextS pc (h,R,fl,isr) S'0 -> exists theta' : Spec0, lookupCT Psi' h_entry theta' /\ Itp0 D theta' (consCT pc theta Psi') S'0)))). apply WFc; auto. InvertAll. rename H0 into Simp. rename H1 into mono_a. rename H4 into itrnS. rename H3 into nS. assert (exists pc', nextPC (comms s) (S_Mem (h, R, fl, isr)) (S_RF (h, R, fl, isr)) (S_Flag (h, R, fl, isr)) pc pc'). apply existsNS_existsNPC; auto. exists x. auto. inversion H0. exists (ch, x, x0). split; auto. exists (comms s). split; auto. Qed. Lemma CAP0_Preservation: forall D Psi W W', WFworld D Psi W -> step W W' -> WFworld D Psi W'. Proof. intros D Psi W W' WFW stepW. unfold WFworld in WFW. induction W as ((ch,st),pc). induction W' as ((ch',st'), pc'). InvertAll. rename x into Psi'. rename x1 into isq. rename x0 into theta. rename H into lkpCTh. (** lookup h_entry into CT **) rename H0 into subCT. rename H1 into itrD. (** interrupt ID in Dict **) rename H2 into WFC. rename H3 into monoCT. rename H5 into aS. rename H6 into lkpCpc. (** lookup pc into C **) rename H7 into WFIseq. (** INDUCTION INSTR/INTERRUPT **) inversion_clear stepW. (** INSTRUCTION *) rename H into step1. unfold stepInstr in step1. InvertAll. rename x into c. rename H into equCh. rewrite <- equCh. clear equCh. rename H0 into pc_inC. rename H1 into nPC. rename H3 into nS. (** INDUCTION OVER ISEQ **) induction WFIseq. clear IHWFIseq. rename H into WFc. unfold WFcmd in WFc. InvertAll. rename H0 into mono_a. unfold Mono_CT_assert in mono_a. rename H into WFc. inversion_clear lkpCpc. (** lookupC **) assert (comml i = c). apply l_inC_unique with ch f; auto. rewrite <- H1 in nPC. rewrite <- H1 in nS. clear pc_inC H. (** l_inC **) clear H1 c. (** c=comml i/c **) (** WFPROG **) unfold WFworld. (** WFC/Mono_CT/subCT/interrupt entry/itrD **) split; auto. split; auto. unfold WFcmd_aux in WFc. (** WFcmd: aS -> a'S' **) rename st into S0. rename theta' into theta0. assert ((exists S' : State, nextS f (comml i) S0 S') /\ (forall (f' : PC) (S' : State), nextS f (comml i) S0 S' -> nextPC (comml i) (S_Mem S0) (S_RF S0) (S_Flag S0) f f' -> exists theta' : Spec0, lookupCT (consCT (f+1) theta0 Psi') f' theta' /\ Itp0 D theta' (consCT (f+1) theta0 Psi') S') /\ (~ itr_enabled S0 \/ (exists S' : State, itr_nextS f S0 S' /\ (forall S'0 : State, itr_nextS f S0 S'0 -> exists theta' : Spec0, lookupCT (consCT (f+1) theta0 Psi') h_entry theta' /\ Itp0 D theta' (consCT f theta (consCT (f+1) theta0 Psi')) S'0)))). apply WFc; auto. apply mono_a with Psi'; auto. rename theta0 into theta'. rename S0 into st. InvertAll. rename H3 into aS_itr. clear WFc aS_itr. rename H2 into nS_WFc. clear nS_WFc. clear x. rename H into Simp. assert (exists theta0 : Spec0, lookupCT (consCT (f + 1) theta' Psi') pc' theta0 /\ Itp0 D theta0 (consCT (f + 1) theta' Psi') st'). apply Simp; auto. exists (consCT (f+1) theta' Psi'). split. apply WFcdhp_psi_extend with is; auto. split; auto. split. apply MonoCT_psi_extend; auto. apply WFiseq_mono_a with Psi (f+1) is; auto. InvertAll. rename x into theta''. rename H into lkpCT. rename H2 into aS'. exists theta''. split; auto. unfold WFcdhp in WFC. (** INDUCTION OVER SIMPLE INSTRUCTION *) induction i. (** _cli ***********************************************************) (*******************************************************************) inversion nPC. (** nextPC **) rename H4 into getPC'. rewrite <- getPC' in lkpCT. unfold lookupCT in lkpCT. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; subst; auto. (** _sti ***********************************************************) (*******************************************************************) inversion nPC. (** nextPC **) rename H4 into getPC'. rewrite <- getPC' in lkpCT. inversion lkpCT. inversion H. rename H5 into eqTheta. subst. exists is. split; auto. apply WFC; subst; auto. (** _call n ********************************************************) (*******************************************************************) inversion nPC. (** nextPC **) rename H5 into getPC'. subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _jne n ********************************************************) (*******************************************************************) inversion nPC. (** nextPC **) (** DO not jump **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** DO jump **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _movwp o r *****************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _movwld a r ****************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _movwst o a ****************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _pushwp o ******************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _pushwm a ******************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _pushfw ********************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _popw r ********************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _popfw ********************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _cmpw o r ******************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _addw o r ******************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _subw o r ******************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (** _outb_eoi ******************************************************) (*******************************************************************) inversion nPC. (** nextPC **) subst. inversion lkpCT. inversion H. subst. exists is. split; auto. apply WFC; auto. (*******************************************************************) (** Sepcicial Instructions: jmp, retw, iret ************************) rename H into WFc. unfold WFcmd in WFc. InvertAll. rename H0 into mono_a. rename H into WFc. inversion_clear lkpCpc. (** lookupC **) assert (comms si = c). apply l_inC_unique with ch f; auto. rewrite <- H0 in nPC. rewrite <- H0 in nS. clear pc_inC H. (** l_inC **) clear H0 c. (** c=comml i/c **) (** WFPROG **) unfold WFworld. (** interrupt entry/itrD **) split; auto. split; auto. exists Psi'. split; auto. split; auto. split; auto. unfold WFcmd_aux in WFc. (** WFcmd: aS -> a'S' **) rename st into S. assert ((exists S' : State, nextS f (comms si) S S') /\ (forall (f' : PC) (S' : State), nextS f (comms si) S S' -> nextPC (comms si) (S_Mem S) (S_RF S) (S_Flag S) f f' -> exists theta' : Spec0, lookupCT Psi' f' theta' /\ Itp0 D theta' Psi' S') /\ (~ itr_enabled S \/ (exists S' : State, itr_nextS f S S' /\ (forall S'0 : State, itr_nextS f S S'0 -> exists theta' : Spec0, lookupCT Psi' h_entry theta' /\ Itp0 D theta' (consCT f theta Psi') S'0)))). apply WFc; auto. rename S into st. InvertAll. rename H2 into aS_itr. clear WFc aS_itr. rename H1 into nS_WFc. clear nS_WFc. clear x. rename H into Simp. assert (exists theta : Spec0, lookupCT Psi' pc' theta /\ Itp0 D theta Psi' st'). apply Simp; auto. InvertAll. rename x into theta'. rename H into lkpCT. rename H1 into aS'. exists theta'. split. auto. unfold WFcdhp in WFC. apply WFC. auto. (*******************************************************************) (** Interrupt ******************************************************) rename H into stepI. unfold stepItr in stepI. InvertAll. rename H into equCh. rewrite <- equCh. clear equCh. rename H3 into h_inC. rename H1 into itrEN. rename H0 into itrnS. rewrite h_inC. unfold WFcdhp in WFC. (** WFPROG **) unfold WFworld. (** interrupt entry/itrD/WFcdhp/subsetCT/Mono_CT_PSpec **) split; auto. split; auto. (** WFiseq ==> a'S' **) assert (WFiseq D Psi theta pc isq). auto. rename H into WFIseq2. induction WFIseq. clear IHWFIseq. rename H into WFc. unfold WFcmd in WFc. InvertAll. rename H0 into mono_a. unfold Mono_CT_assert in mono_a. rename H into WFc. unfold WFcmd_aux in WFc. exists (consCT f theta (consCT (f+1) theta' Psi')). split. assert (WFcdhp D Psi ch (consCT (f + 1) theta' Psi')). inversion lkpCpc. apply WFcdhp_psi_extend with is; auto. apply WFcdhp_psi_extend with (seq i is); auto. split; auto. split. assert (Mono_CT_PSpec D (consCT (f + 1) theta' Psi')). apply MonoCT_psi_extend; auto. apply WFiseq_mono_a with Psi (f+1) is; auto. apply MonoCT_psi_extend; auto. rename st into S0. rename theta' into theta0. assert ((exists S' : State, nextS f (comml i) S0 S') /\ (forall (f' : PC) (S' : State), nextS f (comml i) S0 S' -> nextPC (comml i) (S_Mem S0) (S_RF S0) (S_Flag S0) f f' -> exists theta' : Spec0, lookupCT (consCT (f+1) theta0 Psi') f' theta' /\ Itp0 D theta' (consCT (f+1) theta0 Psi') S') /\ (~ itr_enabled S0 \/ (exists S' : State, itr_nextS f S0 S' /\ (forall S'0 : State, itr_nextS f S0 S'0 -> exists theta' : Spec0, lookupCT (consCT (f+1) theta0 Psi') h_entry theta' /\ Itp0 D theta' (consCT f theta (consCT (f+1) theta0 Psi')) S'0)))). apply WFc; auto. apply mono_a with Psi'; auto. rename theta0 into theta'. rename S0 into st. InvertAll. rename H into Simp. rename H2 into aS_itr. clear WFc Simp. rename H1 into nS_WFc. clear nS_WFc. clear x. inversion_clear aS_itr. absurd (itr_enabled st); auto. InvertAll. rename H1 into a'S'. rename H into itrnS'. rename x into st0. clear itrnS'. clear st0. assert (exists theta0 : Spec0, lookupCT (consCT (f + 1) theta' Psi') h_entry theta0 /\ Itp0 D theta0 (consCT f theta (consCT (f + 1) theta' Psi')) st'). apply a'S'; auto. InvertAll. rename x into itr_theta'. exists itr_theta'. split. auto. rename H into lkpCTitr. inversion lkpCTitr. inversion H. rename H3 into eqTheta. rewrite <- eqTheta. inversion_clear lkpCpc. exists is. split; auto. apply WFC. auto. (** specicial instructions for Interrupt **) rename H into WFc. unfold WFcmd in WFc. InvertAll. rename H0 into mono_a. rename H into WFc. unfold WFcmd_aux in WFc. (** WFcmd: aS -> a'S' **) rename st into S. assert ((exists S' : State, nextS f (comms si) S S') /\ (forall (f' : PC) (S' : State), nextS f (comms si) S S' -> nextPC (comms si) (S_Mem S) (S_RF S) (S_Flag S) f f' -> exists theta' : Spec0, lookupCT Psi' f' theta' /\ Itp0 D theta' Psi' S') /\ (~ itr_enabled S \/ (exists S' : State, itr_nextS f S S' /\ (forall S'0 : State, itr_nextS f S S'0 -> exists theta' : Spec0, lookupCT Psi' h_entry theta' /\ Itp0 D theta' (consCT f theta Psi') S'0)))). apply WFc; auto. rename S into st. InvertAll. rename H into Simp. rename H2 into aS_itr. clear WFc Simp. rename H1 into nS_WFc. clear nS_WFc. clear x. inversion_clear aS_itr. absurd (itr_enabled st); auto. InvertAll. rename H1 into a'S'. rename H into itrnS'. clear itrnS'. clear x. assert (exists itr_theta' : Spec0, lookupCT Psi' h_entry itr_theta' /\ Itp0 D itr_theta' (consCT f theta Psi') st'). apply a'S'; auto. InvertAll. rename x into itr_theta'. exists (consCT f theta Psi'). split. apply WFcdhp_psi_extend with (sseq si); auto. split; auto. split. apply MonoCT_psi_extend; auto. exists itr_theta'. split. auto. apply WFC. auto. Qed. (** Soundness of CAP0: safe run N steps***************************) Lemma CAP0_Soundness_n: forall (n:nat) (D:LDict) (Psi:PSpec) (W:World), WFworld D Psi W -> (exists W', stepN n W W'). Proof. induction n. (** stepN 0 W W **) intros. exists W. constructor; auto. (** stepN n W W' **) intros. (** step once: W |--> W1, CASE 1, instructions**) assert (exists W1, stepInstr W W1). apply CAP0_Progress with D Psi; auto. InvertAll. rename x into W1. (** use IHn : W1 |==>n W' **) assert (exists W' : World, stepN n W1 W'). apply IHn with D Psi. apply CAP0_Preservation with W; auto. constructor; auto. InvertAll. exists x. constructor. exists W1. split. constructor; auto. auto. Qed. (** Soundness of CAP0: after N steps, Interrupt OK **********) Lemma CAP0_Soundness_nI: forall (n:nat) (D:LDict) (Psi:PSpec) (W:World), WFworld D Psi W -> (forall W', stepN n W W' -> exists W'', stepInstr W' W''). Proof. induction n. (** stepN 0 W W **) intros D Psi W WFW W' stepN. inversion stepN. rename H into eqWW'. rewrite eqWW'. apply CAP0_Progress with D Psi; auto. (** stepN n W W' **) intros D Psi W WFW W' stepN. inversion stepN. (** step once: W |--> W1, CASE 1, instructions**) InvertAll. rename x into W1. (** use IHn : W1 |==>n W' **) apply IHn with D Psi W1. apply CAP0_Preservation with W; auto. auto. Qed. (** Soundness of CAP0 **************************************) Lemma CAP0_Soundness: forall (n:nat) (D:LDict) (Psi:PSpec) (W:World), WFworld D Psi W -> (exists W', stepN n W W') /\ (forall W', stepN n W W' -> exists W'', stepInstr W' W''). Proof. split. apply CAP0_Soundness_n with D Psi; auto. apply CAP0_Soundness_nI with D Psi; auto. Qed. coq/Assertion.v0000644000107400000620000005365511000223177013222 0ustar shaosystemsRequire Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Omega. Set Implicit Arguments. Unset Strict Implicit. (**************************************************************) (** p, Pred *) Definition Pred := State -> Prop. (** m, MPred *) Definition MPred := Mem -> Prop. (** g, Guarantee *) Definition Grt := State -> State -> Prop. Notation STag := nat (only parsing). (** SCAP Spec *) Inductive Spec : Type := Ast : Pred -> Grt -> STag -> Spec. (*** Figure 8, Definitions *) (** True *) Definition mTrue : MPred := fun (M : Mem) => True. (** emp *) Definition Aemp : MPred := fun (M : Mem) => M = MemMod.emp. Definition mEq (M : Mem) : MPred := fun (M0 : Mem) => M = M0. Definition bang (P : Prop) : MPred := fun (M : Mem) => Aemp M /\ P. (** l |-> n *) Definition pto (l : Label) (n : int) : MPred := fun (M : Mem) => MemMod.sgltonM M l n. Notation "A |-> B" := (pto A B) (left associativity, at level 65). (** l |-> _ *) Definition ptox (l : Label) : MPred := fun (M : Mem) => exists n : int, pto l n M. Notation "A |->_" := (ptox A) (left associativity, at level 65). (** m1*m2 *) Definition mstar (m1 m2 : MPred) : MPred := fun (M : Mem) => exists M1 : Mem, exists M2 : Mem, MemMod.disjUnion M1 M2 M /\ m1 M1 /\ m2 M2. Notation "A *^* B" := (mstar A B) (left associativity, at level 68). Definition ptoW (l : Label) (n : int) : MPred := mstar (pto l n) (ptox (l+1)). Notation "l |->w n" := (ptoW l n) (left associativity, at level 65). Definition ptoxW (l : Label) : MPred := mstar (ptox l) (ptox (l+1)). Notation "l |->w_" := (ptoxW l) (left associativity, at level 65). (** l |-> _, ..., _ *) Fixpoint ptoxBlk (l : Label) (n : nat) {struct n}: MPred := match n with 0 => Aemp | S n' => mstar (ptox l) (ptoxBlk (l+1) n') end. Definition imprecM (m : MPred) : MPred := mstar m mTrue. (* l ~> n , equivalent to (l -> n) * mTrue *) Definition leadsTo (l : Label) (n : int) : MPred := imprecM (pto l n). Notation "l |~> n" := (leadsTo l n) (left associativity, at level 65). Definition leadsTox (l : Label) : MPred := imprecM (ptox l). Notation "l |~>_ " := (leadsTox l) (left associativity, at level 65). Definition leadsToW (l : Label) (n : int) : MPred := imprecM (ptoW l n). Notation "l |~>w n" := (leadsToW l n) (left associativity, at level 65). Definition leadsToxW (l : Label) : MPred := imprecM (ptoxW l). Notation "l |~>w_ " := (leadsToxW l) (left associativity, at level 65). Definition leadsToBlk (l : Label) (n : nat) : MPred := imprecM (ptoxBlk l n). Definition stkSpace (sp : int) (n : nat) : MPred := fun (M : Mem) => (sp >= n) /\ (leadsToBlk (sp-n) n) M. (* precise version of stkSpace *) Definition stkSpacePrec (sp : int) (n : nat) : MPred := fun (M : Mem) => (sp >= n) /\ (ptoxBlk (sp-n) n) M. Definition MemUpd16 (M : Mem) (l : int) (n : int) (M' : Mem) : Prop := exists x, M' = MemMod.put (MemMod.put M l n) (l+1) x. Definition MemUpdW (M : Mem) (l : Label) (w w': nat) : Mem := MemMod.put (MemMod.put M l w) (l+1) w'. Lemma MemUpd16_MemUpdW : forall M M' l w, MemUpd16 M l w M' -> exists w', M' = MemUpdW M l w w'. Proof. intros M M' l w H. unfold MemUpd16, MemUpdW in * . destruct H as [x H]. subst M'. exists x; trivial. Qed. Implicit Arguments MemUpd16_MemUpdW [M M' l w]. Lemma MemUpdW_MemUpd16 : forall M M' l w w', M' = MemUpdW M l w w' -> MemUpd16 M l w M'. Proof. intros M M' l w w' H. subst M'. unfold MemUpd16, MemUpdW. exists w'; trivial. Qed. Implicit Arguments MemUpdW_MemUpd16 [M M' l w w']. (** precise(m) *) Definition precise : MPred -> Prop := fun (m : MPred) => forall (M1 M2 M : Mem), MemMod.subseteq M1 M -> MemMod.subseteq M2 M -> m M1 -> m M2 -> M1 = M2. (** p*m *) Definition pmstar (p : Pred) (m : MPred) : Pred := fun (S : State) => exists M1, exists M2, MemMod.disjUnion M1 M2 (S_Mem S) /\ p (S_Mem_Upd S M1) /\ m M2. Notation "p *<* m" := (pmstar p m) (left associativity, at level 68). (** m-*p *) Definition pm_mwand (m : MPred) (p : Pred) : Pred := fun (S : State) => forall (M M' : Mem), MemMod.disjUnion M (S_Mem S) M' -> m M -> p (S_Mem_Upd S M'). Notation "m -* p" := (pm_mwand m p) (right associativity, at level 70). (** p*True imprec *) Definition imprec (p : Pred) : Pred := pmstar p mTrue. Definition pTrue : Pred := fun (S : State) => True. (* the old definition Definition prepost (m m' : MPred) : Grt := fun (S S' : State) => forall M1 M2, MemMod.disjUnion M1 M2 (S_Mem S) -> m M1 -> exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ m' M1'. *) Definition prepost (m m' : MPred) : Grt := fun (S S' : State) => exists M1, exists M2, exists M1', m M1 /\ m' M1' /\ MemMod.disjUnion M1 M2 (S_Mem S) /\ MemMod.disjUnion M1' M2 (S_Mem S'). Definition pimp (p p' : Pred) : Prop := forall (S : State), p S -> p' S. Definition gimp (g g' : Grt) : Prop := forall (S S' : State), g S S' -> g' S S'. (* (** (p, g) => (p', g') **) Definition simp (s s' : Spec) : Prop := match s with Ast p g => match s' with Ast p' g' => pimp p p' /\ gimp g' g end end. *) (** Strongest Predicate **) Definition strongPred (gc: Grt) (p : Pred) : Pred := fun (S : State) => (exists S0, (imprec p) S0 /\ gc S0 S). (** Weakest Guarantee **) Definition weakGrt (gc : Grt) (p : Pred) (g : Grt) : Grt := fun (S S' : State) => forall S0, (imprec p) S0 -> gc S0 S -> g S0 S'. (* (** Weakest Guarantee **) Definition weakGrta (gc : Grt) (a : Spec) : Grt := match a with Ast p g => weakGrt gc p g end. (** Strongest Assertion **) Definition strongAst (gc : Grt) (a : Spec) : Spec := match a with Ast p g => Ast (strongPred gc p) (weakGrt gc p g) end. *) Definition enable (p : Pred) (g : Grt) : Prop := forall S, p S -> exists S', g S S'. Definition conjG (g g' : Grt) : Grt := fun (S S' : State) => exists S'', g S S'' /\ g' S'' S'. Infix "oo" := conjG (left associativity, at level 69). Definition linkPG (p : Pred) (g: Grt) : Pred := fun (S' : State) => exists S, p S /\ g S S'. Infix "|>" := linkPG (left associativity, at level 69). Definition conjPG (p : Pred) (g : Grt) : Grt := fun (S S' : State) => p S /\ g S S'. Infix ">o" := conjPG (left associativity, at level 69). (** pattern used to define g based on pre and post *) Definition leadstoPQ (p q : Pred) : Grt := fun (S S' : State) => match S with (M, R, fl, isr) => match S' with (M', R', fl', isr') => forall M1 M2, MemMod.disjUnion M1 M2 M -> p (M1, R, fl, isr) -> exists M1', MemMod.disjUnion M1' M2 M' /\ q (M1', R', fl', isr') end end. Definition enableS (S : State) (g : Grt) : Prop := exists S', g S S'. (** frame property of g *) Definition frame (g : Grt) : Prop := forall S S', g S S' -> forall M1 M2, MemMod.disjUnion M1 M2 (S_Mem S) -> enableS (S_Mem_Upd S M1) g -> exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ g (S_Mem_Upd S M1) (S_Mem_Upd S' M1'). (** monotonicigy of g *) Definition safe_mono (g : Grt) : Prop := forall p, enable p g -> enable (fun S => imprec p S) g. Lemma frame_rule_1: forall p g p', pimp (p |> g) p' -> frame g -> enable p g -> pimp ((fun S=> imprec p S) |> g) (fun S => imprec p' S). Proof. intros. unfold pimp. unfold linkPG. unfold imprec. intros. InvertAll. rename x into S0. induction S0 as (((M0, R0), fl0), isr0). induction S as (((M, R), fl), isr). unfold pmstar in H2. InvertAll. rename x into M01. rename x0 into M02. unfold frame in H0. assert (exists M1' : MemMod.Map, MemMod.disjUnion M1' M02 (S_Mem (M, R, fl, isr)) /\ g (S_Mem_Upd (M0, R0, fl0, isr0) M01) (S_Mem_Upd (M, R, fl, isr) M1')). apply H0; auto. unfold enableS. unfold enable in H1. apply H1; auto. InvertAll. rename x into M1. unfold pmstar. exists M1. exists M02. split; auto. split; auto. UnfoldStateAll. clear H0. unfold pimp in H. apply H. unfold linkPG. exists (M01, R0, fl0, isr0). split; auto. Qed. Lemma leadstoPQ_sameQ_reverseP: forall p p' q g, frame g -> enable p g -> pimp (p |> g) p' -> gimp (g oo (leadstoPQ p' q)) (leadstoPQ p q). Proof. intros. unfold gimp. intros. unfold conjG in H2. InvertAll. rename x into S0. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). unfold leadstoPQ. induction S0 as (((M0, R0), fl0), isr0). intros. unfold leadstoPQ in H4. unfold frame in H. assert (exists M1' : MemMod.Map, MemMod.disjUnion M1' M2 (S_Mem (M0, R0, fl0, isr0)) /\ g (S_Mem_Upd (M, R, fl, isr) M1) (S_Mem_Upd (M0, R0, fl0, isr0) M1')). apply H; auto. unfold enableS. unfold enable in H0. UnfoldStateAll. apply H0; auto. InvertAll. rename x into M01. apply H4 with M01; auto. unfold pimp in H1. apply H1. unfold linkPG. exists (M1, R, fl, isr). split; auto. Qed. (* Inductive SpecX : Type := AstX : Spec -> STag -> SpecX. Definition SpecX_Tag (thetaX : SpecX) : STag := match thetaX with AstX _ t => t end. *) Lemma imprec_weaker: forall (S : State) (p : Pred), p S -> imprec p S. Proof. intros. unfold imprec. unfold pmstar. induction S. induction a. induction a. exists a. exists MemMod.emp. UnfoldStateAll. split. auto with PMap. split; auto. unfold mTrue. auto. Qed. Hint Resolve imprec_weaker. (* ********** *) Lemma imprecPimp: forall (S : State) (p p0: Pred), pimp p p0 -> imprec p S -> imprec p0 S. Proof. intros. unfold pimp in H. inversion_clear H0. InvertAll. unfold imprec. unfold pmstar. exists x; exists x0. split; auto. Qed. Hint Resolve imprecPimp. (* (** Lemma 2.3 ***) Lemma StrongAst_Strengthen: forall (s s': Spec) (g:Grt), simp s s' -> simp (strongAst g s) (strongAst g s'). Proof. intros. unfold simp in |- *. unfold strongAst in |- *. induction s. induction s'. inversion_clear H. split. unfold pimp in |- *. unfold strongPred in |- *. intros. inversion_clear H. inversion_clear H2. rename x into S0; exists S0. split. apply imprecPimp with p; auto. auto. unfold gimp, weakGrt in |- *. intros. unfold gimp in H1. apply H1. apply H; auto. eauto. Qed. Hint Resolve StrongAst_Strengthen. *) (*** SIMP/PIMP/GIMP Related Lemmas ***) Lemma equ_pimp: forall (p : Pred), pimp p p. Proof. unfold pimp. intros. auto. Qed. Hint Resolve equ_pimp. Lemma equ_gimp: forall (g : Grt), gimp g g. Proof. unfold gimp. intros. auto. Qed. Hint Resolve equ_gimp. (* Lemma equ_simp: forall (a : Spec), simp a a. Proof. unfold simp. intros. induction a. split; auto. Qed. Hint Resolve equ_simp. *) Lemma pimp_transt: forall (p p' p'' : Pred), pimp p p' -> pimp p' p'' -> pimp p p''. Proof. unfold pimp. intros. apply H0. apply H. auto. Qed. Hint Resolve pimp_transt. Lemma gimp_transt: forall (g g' g'' : Grt), gimp g g' -> gimp g' g'' -> gimp g g''. Proof. unfold gimp. intros. apply H0. apply H. auto. Qed. Hint Resolve gimp_transt. (* Lemma simp_transt: forall (a a' a'' : Spec), simp a a' -> simp a' a'' -> simp a a''. Proof. intros. unfold simp. induction a. induction a'. induction a''. inversion_clear H. inversion_clear H0. split. apply pimp_transt with p0; auto. apply gimp_transt with g0; auto. Qed. Hint Resolve simp_transt. *) Lemma mstar_presv_prec: forall (m m' : MPred), precise m -> precise m' -> precise (mstar m m'). Proof. intros. unfold precise. intros. unfold mstar in H3. unfold mstar in H4. InvertAll. assert (MemMod.subseteq x M2). apply MemMod.disjUnion_subseteq_left with x0; auto. assert (MemMod.subseteq x1 M1). apply MemMod.disjUnion_subseteq_left with x2; auto. assert (MemMod.subseteq x0 M2). apply MemMod.disjUnion_subseteq_right with x; auto. assert (MemMod.subseteq x2 M1). apply MemMod.disjUnion_subseteq_right with x1; auto. assert (MemMod.subseteq x1 M). apply MemMod.subseteq_transitivity with M1; auto. assert (MemMod.subseteq x0 M). apply MemMod.subseteq_transitivity with M2; auto. assert (MemMod.subseteq x2 M). apply MemMod.subseteq_transitivity with M1; auto. assert (MemMod.subseteq x M). apply MemMod.subseteq_transitivity with M2; auto. unfold precise in H. unfold precise in H0. assert (x = x1). apply H with M; auto. assert (x0 = x2). apply H0 with M; auto. unfold MemMod.disjUnion in H5. unfold MemMod.disjUnion in H6. inversion_clear H5. inversion_clear H6. rewrite H17 in H20. rewrite H18 in H20. rewrite <- H20 in H21. auto. Qed. Implicit Arguments mstar_presv_prec [m m']. Hint Resolve mstar_presv_prec. Lemma precise_emp : precise Aemp. Proof. unfold Aemp. unfold precise. intros. rewrite <- H1 in H2. auto. Qed. Hint Resolve precise_emp. Lemma mstar_Aemp_unit: forall (m: MPred) (M: Mem), mstar m Aemp M -> m M. Proof. intros. unfold mstar in H. InvertAll. unfold Aemp in H2. rewrite H2 in H0. assert (x = M). auto with PMap. rewrite H1 in H. auto. Qed. Lemma mstar_Aemp_unit_right: forall (m: MPred) (M: Mem), m M -> mstar m Aemp M. Proof. intros. unfold mstar. exists M. exists MemMod.emp. split; auto. auto with PMap. unfold Aemp. auto. Qed. Hint Resolve mstar_Aemp_unit_right. Lemma pmstar_Aemp_unit: forall p S, pmstar p Aemp S -> p S. Proof. intros. induction S. induction a. induction a. unfold pmstar in H. InvertAll. unfold Aemp in H2. rewrite H2 in H0. UnfoldStateAll. assert (x = a). auto with PMap. rewrite <- H1. auto. Qed. Lemma pmstar_Aemp_unit_right: forall (p: Pred) (S: State), p S -> (pmstar p Aemp) S. Proof. intros. unfold pmstar. induction S. induction a. induction a. exists a. exists MemMod.emp. unfold Aemp. UnfoldStateAll. split; auto with PMap. Qed. Hint Resolve pmstar_Aemp_unit_right. Lemma imprec_monotone: forall (p : Pred) (M M': Mem) (R : RFile) (fl : FlagR) (is : ISR), imprec p (M, R, fl, is) -> MemMod.subseteq M M' -> imprec p (M', R, fl, is). Proof. intros. assert (exists M'', MemMod.disjUnion M M'' M'). auto with PMap. inversion_clear H1. unfold imprec. unfold pmstar. unfold imprec in H. unfold pmstar in H. UnfoldStateAll. InvertAll. exists x0. exists (MemMod.merge x1 x). split. unfold MemMod.disjUnion in H1. inversion_clear H1. rewrite H5 in H2. apply MemMod.disjUnion_assoc_left_right; auto. split; auto. Qed. Hint Resolve imprec_monotone. Lemma mstar_mwand_equ_left: forall m m' p S, pm_mwand (mstar m m') p S -> pm_mwand m (pm_mwand m' p) S. Proof. intros. unfold pm_mwand. unfold pm_mwand in H. intros. induction S. induction a. induction a. rename a into MS. rename b1 into R. rename b0 into ie. rename b into is. UnfoldStateAll. assert (MemMod.disjoint M M0). unfold MemMod.disjUnion in H0. unfold MemMod.disjUnion in H2. InvertAll. rewrite H6 in H4. eauto with PMap. apply H with (MemMod.merge M M0). unfold MemMod.disjUnion in H0. inversion_clear H0. rewrite H6 in H2. assert (MemMod.merge M MS = MemMod.merge MS M); auto with PMap. rewrite H0 in H2. auto with PMap. unfold mstar. exists M. exists M0. split; auto. unfold MemMod.disjUnion. split; auto. Qed. Hint Resolve mstar_mwand_equ_left. Lemma mstar_mwand_equ_right: forall m m' p S, pm_mwand m (pm_mwand m' p) S -> pm_mwand (mstar m m') p S. Proof. intros. unfold pm_mwand. unfold pm_mwand in H. intros. induction S. induction a. induction a. rename a into MS. rename b1 into R. rename b0 into ie. rename b into is. UnfoldStateAll. unfold mstar in H1. InvertAll. rename x into M1. rename x0 into M2. assert (MemMod.disjoint M1 MS). unfold MemMod.disjUnion in H2. inversion_clear H2. rewrite H5 in H0. unfold MemMod.disjUnion in H0. inversion_clear H0. eauto with PMap. apply H with M1 (MemMod.merge M1 MS) M2; auto. unfold MemMod.disjUnion. split; auto. assert (MemMod.disjUnion M2 M1 M). auto with PMap. unfold MemMod.disjUnion in H5. inversion_clear H5. rewrite H7 in H0. auto with PMap. Qed. Hint Resolve mstar_mwand_equ_right. Lemma mstar_commut: forall m m' M, mstar m m' M -> mstar m' m M. Proof. unfold mstar. intros. InvertAll. exists x0. exists x. split; auto with PMap. Qed. Hint Resolve mstar_commut. Lemma mstar_sym : forall M A B, (A *^* B) M -> (B *^* A) M. Proof. intros M A B [ha [hb [J [Ha Hb]]]]. exists hb; exists ha. split. auto with PMap. auto. Qed. Lemma mstar_assoc_left_right: forall M A B C, (A *^* B *^* C) M -> (A *^* (B *^* C)) M. Proof. intros. destruct H as [hab [hc [Jabc [HAB HC]]]]. destruct HAB as [ha [hb [Jab [HA HB]]]]. exists ha; exists (MemMod.merge hb hc). split. apply MemMod.disjUnion_assoc_left_right. destruct Jab; trivial. elim Jab. intros. rewrite <- H0; trivial. split_l. exists hb; exists hc; split; auto. split_r. destruct Jab. destruct Jabc. subst hab. apply MemMod.disj_merge_disj_right with ha; eauto. Qed. Implicit Arguments mstar_assoc_left_right [M A B C]. Lemma mstar_assoc_right_left: forall M A B C, (A *^* (B *^* C)) M -> (A *^* B *^* C) M. Proof. intros. apply mstar_sym. apply mstar_assoc_left_right. exact (mstar_sym (mstar_assoc_left_right (mstar_sym H))). Qed. Implicit Arguments mstar_assoc_left_right [M A B C]. Lemma leadsToInterK: forall sp h, leadsToBlk sp 6 h -> exists pc, leadsToW sp pc h. Proof. intros. unfold leadsToBlk in H. unfold ptoxBlk in H. unfold imprecM in H. unfold mstar in H. InvertAll. unfold ptox in H. InvertAll. exists x13. unfold leadsToW. unfold ptoW. unfold imprecM. unfold mstar. unfold MemMod.disjUnion in H1. unfold MemMod.disjUnion in H3. InvertAll. exists (MemMod.merge x1 x3). exists (MemMod.merge x0 x4). split. apply MemMod.disjUnion_commut. apply MemMod.disjUnion_assoc_right_left. apply MemMod.disjoint_commut. apply MemMod.disj_merge_assoc_right_left. auto. rewrite <- H15; auto. assert (MemMod.merge x3 x1 = MemMod.merge x1 x3). apply MemMod.disj_merge_commut; auto. apply MemMod.disj_merge_disj_left with x4. rewrite <- H15. apply MemMod.disjoint_commut; auto. rewrite <- H1. assert (MemMod.merge (MemMod.merge x3 x4) x1 = MemMod.merge x4 (MemMod.merge x3 x1)). apply MemMod.disj_merge_ABC_BAC; auto. rewrite <- H17. rewrite <- H15. assert (MemMod.merge x1 x2 = MemMod.merge x2 x1). apply MemMod.disj_merge_commut; auto. rewrite <- H18. rewrite <- H16. apply MemMod.disjUnion_commut; auto. split. exists x1. exists x3. split. unfold MemMod.disjUnion. split. apply MemMod.disjoint_commut. apply MemMod.disj_merge_disj_left with x4. rewrite <- H15. apply MemMod.disjoint_commut; auto. auto. split; auto. unfold mTrue; auto. Qed. Lemma ptoW_indom: forall l m h, ptoW l m h -> MemMod.in_dom l h /\ MemMod.in_dom (l+1) h. Proof. unfold ptoW. intros l m h pW. destruct pW as [M1 [M2 [djh [mM1 mM2]]]]. unfold ptox in mM2. unfold pto in *. unfold MemMod.sgltonM in *. assert (MemMod.in_dom l M1 /\ MemMod.in_dom (l+1) M2). unfold MemMod.in_dom in |- *. unfold MemMod.maps_to in *. InvertAll. split. exists m; auto. exists x; auto. unfold MemMod.disjUnion in djh. InvertAll. rewrite H4. split. apply MemMod.merge_presv_indom_left; auto. apply MemMod.merge_presv_indom_right; auto. Qed. Lemma ptoxBlk_notindom: forall l s addr h, ptoxBlk l s h -> addr < l \/ addr >= l + s -> h addr = None. Proof. intros l s. gen_clear l. induction s; intros. simpl in H. unfold Aemp in H. subst;trivial. simpl in H. destruct H as [h1 [h2 [HJh H]]]. destruct H. assert (Hx : addr < l + 1 \/ addr >= l+1+s). omega. assert (Hx0 := IHs (l+1) addr h2 H1 Hx). assert (Hx1 : h1 addr = None). unfold ptox in H. inversion H. unfold pto in H2. unfold MemMod.sgltonM in H2. destruct H2. unfold MemMod.not_in_dom in H3. apply H3. omega. unfold MemMod.disjUnion in HJh. destruct HJh. unfold MemMod.merge in H3. subst h. rewrite Hx1. trivial. Qed. Lemma ptoxBlk_split : forall s1 s2 M l, ptoxBlk l (s1 + s2) M -> mstar (ptoxBlk l s1) (ptoxBlk (l+s1) s2) M. Proof. induction s1; simpl; intros. unfold Aemp, MemMod.emp. exists MemMod.emp; exists M. split. auto with PMap. unfold MemMod.emp. split_l. replace (l+0) with l; auto with arith. destruct H as [M1 [M2 [MJM [HM1 HM2]]]]. replace (l + S s1) with (S l + s1); [idtac | omega]. assert (Hx := IHs1 s2 M2 (l+1) HM2). apply mstar_assoc_right_left. unfold mstar. exists M1; exists M2; split_l. split_l. arith_rep (S l + s1) with (l+1+s1). Qed. Lemma ptoxBlk_merge : forall s1 s2 M l, mstar (ptoxBlk l s1) (ptoxBlk (l+s1) s2) M -> ptoxBlk l (s1 + s2) M. Proof. induction s1;simpl;intros. unfold mstar, Aemp in H. InvertAll. subst. assert (x0 = M). auto with PMap. subst. arith_rep l with (l+0);assumption. assert ( (ptox l *^* (ptoxBlk (l + 1) s1 *^* ptoxBlk (l + S s1) s2)) M). apply mstar_assoc_left_right; assumption. unfold mstar at 1 in H0. InvertAll. exists x;exists x0;intuition. apply IHs1. arith_rep (l+1+s1) with (l+S s1);assumption. Qed. Lemma stkSpacePrec_split : forall sp s1 s2 M, stkSpacePrec sp (s1 + s2) M -> mstar (stkSpacePrec sp s2) (stkSpacePrec (sp-s2) s1) M. Proof. unfold stkSpacePrec. intros. destruct H. assert ((ptoxBlk (sp -(s1+s2)) s1 *^* ptoxBlk (sp-(s1+s2)+s1) s2 ) M). apply ptoxBlk_split;assumption. unfold mstar in H1;InvertAll. exists x0;exists x;intuition. arith_rep (sp-s2) with (sp-(s1+s2)+s1). arith_rep (sp-s2-s1) with (sp-(s1+s2)). Qed. Implicit Arguments stkSpacePrec_split [sp s1 s2 M]. Lemma stkSpacePrec_merge : forall sp s1 s2 M1 M2, stkSpacePrec sp s2 M1 -> stkSpacePrec (sp-s2) s1 M2 -> stkSpacePrec sp (s1 + s2) (MemMod.merge M1 M2). Proof. unfold stkSpacePrec. intros. InvertAll. intuition. apply ptoxBlk_merge. assert (MemMod.disjoint M2 M1). unfold MemMod.disjoint. unfold MemMod.not_in_dom. intros. destruct (le_lt_dec (sp-s2) x). left;apply ptoxBlk_notindom with (sp-s2-s1) s1. assumption. right;omega. right;apply ptoxBlk_notindom with (sp-s2) s2. assumption. left;assumption. exists M2;exists M1;intuition. arith_rep (sp-(s1+s2)) with (sp-s2-s1). arith_rep (sp-(s1+s2)+s1) with (sp-s2). Qed. Implicit Arguments stkSpacePrec_merge [sp s1 s2 M1 M2]. Definition uniqueM (m: MPred) : Prop := forall M M', m M -> m M' -> M = M'. coq/ListT.v0000644000107400000620000002773211000223177012307 0ustar shaosystems(***************************************************************) (* Coq code for PCAP *) (* *) (* List of Type *) (* *) (* *) (***************************************************************) Require Import Le. Require Import Coqlib. Section ListT. Variable A : Type. Set Implicit Arguments. Inductive listT : Type := | nilT : listT | consT : A -> listT -> listT. Infix "::" := consT (at level 60, right associativity) : listt_scope. Open Local Scope listt_scope. (*************************) (** Discrimination *) (*************************) Lemma nilT_consT : forall (a : A) (m : listT), nilT <> a :: m. Proof. intros; discriminate. Qed. (*************************) (** Concatenation *) (*************************) Fixpoint appT (l m : listT) {struct l} : listT:= match l with | nilT => m | a :: l1 => a :: appT l1 m end. Infix "++" := appT (right associativity, at level 60) : listt_scope. Lemma appT_nilT_end : forall l : listT, l = l ++ nilT. Proof. induction l; simpl in |- *; auto. rewrite <- IHl; auto. Qed. Hint Resolve appT_nilT_end. Ltac now_show c := change c in |- *. Lemma appT_ass : forall l m n : listT, (l ++ m) ++ n = l ++ m ++ n. Proof. intros. induction l; simpl in |- *; auto. now_show (a :: (l ++ m) ++ n = a :: l ++ m ++ n). rewrite <- IHl; auto. Qed. Hint Resolve appT_ass. Lemma ass_appT : forall l m n:listT, l ++ m ++ n = (l ++ m) ++ n. Proof. auto. Qed. Hint Resolve ass_appT. Lemma appT_comm_consT : forall (x y:listT) (a:A), a :: x ++ y = (a :: x) ++ y. Proof. auto. Qed. Lemma appT_eq_nilT : forall x y:listT, x ++ y = nilT -> x = nilT /\ y = nilT. Proof. destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ]; simpl in |- *; auto. intros H; discriminate H. intros; discriminate H. Qed. Lemma appT_consT_not_nilT : forall (x y:listT) (a:A), nilT <> x ++ a :: y. Proof. unfold not in |- *. destruct x as [| a l]; simpl in |- *; intros. discriminate H. discriminate H. Qed. Lemma appT_eq_unit : forall (x y:listT) (a:A), x ++ y = a :: nilT -> x = nilT /\ y = a :: nilT \/ x = a :: nilT /\ y = nilT. Proof. destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ]; simpl in |- *. intros a H; discriminate H. left; split; auto. right; split; auto. generalize H. generalize (appT_nilT_end l); intros E. rewrite <- E; auto. intros. injection H. intro. cut (nilT = l ++ a0 :: l0); auto. intro. generalize (appT_consT_not_nilT _ _ _ H1); intro. elim H2. Qed. Lemma appT_inj_tail : forall (x y:listT) (a b:A), x ++ a :: nilT = y ++ b :: nilT -> x = y /\ a = b. Proof. induction x as [| x l IHl]; [ destruct y as [| a l] | destruct y as [| a l0] ]; simpl in |- *; auto. intros a b H. injection H. auto. intros a0 b H. injection H; intros. generalize (appT_consT_not_nilT _ _ _ H0); destruct 1. intros a b H. injection H; intros. cut (nilT = l ++ a :: nilT); auto. intro. generalize (appT_consT_not_nilT _ _ _ H2); destruct 1. intros a0 b H. injection H; intros. destruct (IHl l0 a0 b H0). split; auto. rewrite <- H1; rewrite <- H2; reflexivity. Qed. (*************************) (** Head and tail *) (*************************) Definition head (l : listT) := match l return optionT A with | nilT => NoneT | x :: _ => SomeT x end. Definition tail (l:listT) : listT:= match l with | nilT => nilT | a :: m => m end. (****************************************) (** Length of lists *) (****************************************) Fixpoint lengthT (l:listT) : nat := match l with | nilT => 0 | _ :: m => S (lengthT m) end. (******************************) (** LengthT order of lists *) (******************************) Section lengthT_order. Definition lel (l m:listT) := lengthT l <= lengthT m. Variables a b : A. Variables l m n : listT. Lemma lel_refl : lel l l. Proof. unfold lel in |- *; auto with arith. Qed. Lemma lel_trans : lel l m -> lel m n -> lel l n. Proof. unfold lel in |- *; intros. now_show (lengthT l <= lengthT n). apply le_trans with (lengthT m); auto with arith. Qed. Lemma lel_consT_consT : lel l m -> lel (a :: l) (b :: m). Proof. unfold lel in |- *; simpl in |- *; auto with arith. Qed. Lemma lel_consT : lel l m -> lel l (b :: m). Proof. unfold lel in |- *; simpl in |- *; auto with arith. Qed. Lemma lel_tail : lel (a :: l) (b :: m) -> lel l m. Proof. unfold lel in |- *; simpl in |- *; auto with arith. Qed. Lemma lel_nilT : forall l':listT, lel l' nilT -> nilT = l'. Proof. intro l'; elim l'; auto with arith. intros a' y H H0. now_show (nilT = a' :: y). absurd (S (lengthT y) <= 0); auto with arith. Qed. End lengthT_order. Hint Resolve lel_refl lel_consT_consT lel_consT lel_nilT lel_nilT nilT_consT. (*********************************) (** The [In] predicate *) (*********************************) Fixpoint In (a:A) (l:listT) {struct l} : Prop := match l with | nilT => False | b :: m => b = a \/ In a m end. Lemma in_eq : forall (a:A) (l:listT), In a (a :: l). Proof. simpl in |- *; auto. Qed. Hint Resolve in_eq. Lemma in_consT : forall (a b:A) (l:listT), In b l -> In b (a :: l). Proof. simpl in |- *; auto. Qed. Hint Resolve in_consT. Lemma in_nilT : forall a:A, ~ In a nilT. Proof. unfold not in |- *; intros a H; inversion_clear H. Qed. Lemma in_inv : forall (a b:A) (l:listT), In b (a :: l) -> a = b \/ In b l. Proof. intros a b l H; inversion_clear H; auto. Qed. Lemma In_dec : (forall x y:A, {x = y} + {x <> y}) -> forall (a:A) (l:listT), {In a l} + {~ In a l}. Proof. intro H. induction l as [| a0 l IHl]. right; apply in_nilT. destruct (H a0 a); simpl in |- *; auto. destruct IHl; simpl in |- *; auto. right; unfold not in |- *; intros [Hc1| Hc2]; auto. Qed. Lemma in_appT_or : forall (l m:listT) (a:A), In a (l ++ m) -> In a l \/ In a m. Proof. intros l m a. elim l; simpl in |- *; auto. intros a0 y H H0. now_show ((a0 = a \/ In a y) \/ In a m). elim H0; auto. intro H1. now_show ((a0 = a \/ In a y) \/ In a m). elim (H H1); auto. Qed. Hint Immediate in_appT_or. Lemma in_or_appT : forall (l m:listT) (a:A), In a l \/ In a m -> In a (l ++ m). Proof. intros l m a. elim l; simpl in |- *; intro H. now_show (In a m). elim H; auto; intro H0. now_show (In a m). elim H0. (* subProof completed *) intros y H0 H1. now_show (H = a \/ In a (y ++ m)). elim H1; auto 4. intro H2. now_show (H = a \/ In a (y ++ m)). elim H2; auto. Qed. Hint Resolve in_or_appT. (***************************) (** Set inclusion on listT *) (***************************) Definition incl (l m:listT) := forall a:A, In a l -> In a m. Hint Unfold incl. Lemma incl_refl : forall l:listT, incl l l. Proof. auto. Qed. Hint Resolve incl_refl. Lemma incl_tl : forall (a:A) (l m:listT), incl l m -> incl l (a :: m). Proof. auto. Qed. Hint Immediate incl_tl. Lemma incl_tran : forall l m n:listT, incl l m -> incl m n -> incl l n. Proof. auto. Qed. Lemma incl_appTl : forall l m n:listT, incl l n -> incl l (n ++ m). Proof. auto. Qed. Hint Immediate incl_appTl. Lemma incl_appTr : forall l m n:listT, incl l n -> incl l (m ++ n). Proof. auto. Qed. Hint Immediate incl_appTr. Lemma incl_consT : forall (a:A) (l m:listT), In a m -> incl l m -> incl (a :: l) m. Proof. unfold incl in |- *; simpl in |- *; intros a l m H H0 a0 H1. now_show (In a0 m). elim H1. now_show (a = a0 -> In a0 m). elim H1; auto; intro H2. now_show (a = a0 -> In a0 m). elim H2; auto. (* solves subgoal *) now_show (In a0 l -> In a0 m). auto. Qed. Hint Resolve incl_consT. Lemma incl_appT : forall l m n:listT, incl l n -> incl m n -> incl (l ++ m) n. Proof. unfold incl in |- *; simpl in |- *; intros l m n H H0 a H1. now_show (In a n). elim (in_appT_or _ _ _ H1); auto. Qed. Hint Resolve incl_appT. (**************************) (** Nth element of a listT*) (**************************) Fixpoint nth (n:nat) (l:listT) (default:A) {struct l} : A := match n, l with | O, x :: l' => x | O, other => default | S m, nilT => default | S m, x :: t => nth m t default end. Fixpoint nth_ok (n:nat) (l:listT) (default:A) {struct l} : bool := match n, l with | O, x :: l' => true | O, other => false | S m, nilT => false | S m, x :: t => nth_ok m t default end. Lemma nth_in_or_default : forall (n:nat) (l:listT) (d:A), {In (nth n l d) l} + {nth n l d = d}. (* Realizer nth_ok. Program_all. *) Proof. intros n l d; generalize n; induction l; intro n0. right; case n0; trivial. case n0; simpl in |- *. auto. intro n1; elim (IHl n1); auto. Qed. Lemma nth_S_consT : forall (n:nat) (l:listT) (d a:A), In (nth n l d) l -> In (nth (S n) (a :: l) d) (a :: l). Proof. simpl in |- *; auto. Qed. (********************************) (** Decidable equality on lists *) (********************************) Lemma list_eq_dec : (forall x y:A, {x = y} + {x <> y}) -> forall x y:listT, {x = y} + {x <> y}. Proof. intro H. induction x as [| a l IHl]; destruct y as [| a0 l0]; auto. destruct (H a a0) as [e| e]. destruct (IHl l0) as [e'| e']. left; rewrite e; rewrite e'; trivial. right; red in |- *; intro. apply e'; injection H0; trivial. right; red in |- *; intro. apply e; injection H0; trivial. Qed. (*************************) (** Reverse *) (*************************) Fixpoint rev (l:listT) : listT:= match l with | nilT => nilT | x :: l' => rev l' ++ x :: nilT end. Lemma distr_rev : forall x y:listT, rev (x ++ y) = rev y ++ rev x. Proof. induction x as [| a l IHl]. destruct y as [| a l]. simpl in |- *. auto. simpl in |- *. apply appT_nilT_end; auto. intro y. simpl in |- *. rewrite (IHl y). apply (appT_ass (rev y) (rev l) (a :: nilT)). Qed. Remark rev_unit : forall (l:listT) (a:A), rev (l ++ a :: nilT) = a :: rev l. Proof. intros. apply (distr_rev l (a :: nilT)); simpl in |- *; auto. Qed. Lemma rev_involutive : forall l:listT, rev (rev l) = l. Proof. induction l as [| a l IHl]. simpl in |- *; auto. simpl in |- *. rewrite (rev_unit (rev l) a). rewrite IHl; auto. Qed. (*********************************************) (** Reverse Induction Principle on Lists *) (*********************************************) Section Reverse_Induction. Unset Implicit Arguments. Remark rev_list_ind : forall P:listT-> Prop, P nilT -> (forall (a:A) (l:listT), P (rev l) -> P (rev (a :: l))) -> forall l:listT, P (rev l). Proof. induction l; auto. Qed. Set Implicit Arguments. Lemma rev_ind : forall P:listT-> Prop, P nilT -> (forall (x:A) (l:listT), P l -> P (l ++ x :: nilT)) -> forall l:listT, P l. Proof. intros. generalize (rev_involutive l). intros E; rewrite <- E. apply (rev_list_ind P). auto. simpl in |- *. intros. apply (H0 a (rev l0)). auto. Qed. End Reverse_Induction. End ListT. Implicit Arguments nilT [A]. Hint Resolve nilT_consT appT_nilT_end ass_appT appT_ass: datatypes v62. Hint Resolve appT_comm_consT appT_consT_not_nilT: datatypes v62. Hint Immediate appT_eq_nilT: datatypes v62. Hint Resolve appT_eq_unit appT_inj_tail: datatypes v62. Hint Resolve lel_refl lel_consT_consT lel_consT lel_nilT lel_nilT nilT_consT: datatypes v62. Hint Resolve in_eq in_consT in_inv in_nilT in_appT_or in_or_appT: datatypes v62. Hint Resolve incl_refl incl_tl incl_tran incl_appTl incl_appTr incl_consT incl_appT: datatypes v62. (** Exporting listTnotations *) Infix "::" := consT (at level 60, right associativity) : listt_scope. Infix "++" := appT (right associativity, at level 60) : listt_scope. Open Scope listt_scope. (** Declare Scope list_scope with key listT*) Delimit Scope listt_scope with listT. Bind Scope listt_scope with listT. coq/Assertion_Lemmas4.v0000644000107400000620000020146211000223177014573 0ustar shaosystemsRequire Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Omega. Require Import Mem_Lemmas. Require Import Assertion_Lemmas. Set Implicit Arguments. Unset Strict Implicit. (* ************************************************) (* portage *) Definition mjudge (h:Mem) (A:MPred) := A h. Notation "M ||- A" := (mjudge M A) (at level 80). Notation Local " A ** B " := (mstar A B) (at level 67, right associativity). Notation Local "A ==> B" := (forall M, M ||- A -> M ||- B) (at level 13). Notation Local "A <==> B" := (forall M, M ||- A <-> M ||- B) (at level 13). Implicit Types A B C D : MPred. Implicit Types M h : Mem. Notation Local sconj := mstar (only parsing). Notation Local join := MemMod.disjUnion (only parsing). Notation Local emp := MemMod.emp (only parsing). Notation Local meq := mEq (only parsing). Notation Local unit := Aemp (only parsing). Lemma join_comm : forall M1 M2 M, join M1 M2 M -> join M2 M1 M. Proof. intros M1 M2 M. auto with PMap. Qed. Definition bang (A:Prop) : MPred := fun h => unit h /\ A. Require Import List. Fixpoint itr (tdata : Set) (p : tdata -> MPred) (lst : list tdata) {struct lst} : MPred := match lst with | nil => unit | cons data lst' => (p data) ** (itr p lst') end. Notation Local "! A" := (bang A) (at level 55). (* Notation Local pto := pto. *) (* Notation Local ptoW := ptoW. *) (* Notation Local ptoxW := ptoxW. *) Notation Local set := MemMod.put. Notation Local top := mTrue. (* Parameter sig : forall (l : Label) (v : nat), Mem. *) (* ************************************************) (* mjudge *) Lemma mjudge_intro : forall M A, A M -> M ||- A. Proof. unfold mjudge; trivial. Qed. Lemma mjudge_elim : forall M A, M ||- A -> A M. Proof. unfold mjudge; trivial. Qed. (* ************************************************) (* sconj *) Lemma sconj_intro : forall ha hb h A B, ha ||- A -> hb ||- B -> join ha hb h -> h ||- A ** B. Proof. intros. exists ha; exists hb; auto. Qed. Implicit Arguments sconj_intro [ha hb h A B]. Lemma sconj_elim : forall M A B, M ||- A ** B -> exists ha, exists hb, join ha hb M /\ (ha ||- A) /\ (hb ||- B). Proof. unfold sconj; trivial. Qed. Lemma sconj_sym : forall h A B, h ||- A ** B -> h ||- B ** A. Proof. intros h A B [ha [hb [J [Ha Hb]]]]. apply (sconj_intro Hb Ha (join_comm J)). Qed. Lemma sconj_mono_left : forall h A B, h ||- (A ** B) -> forall A', (A ==> A') -> h ||- (A' ** B). Proof. destruct 1 as [ha [hb [J [HA HB]]]]. exists ha; exists hb. intuition. apply H. apply HA. Qed. Lemma sconj_mono_right : forall h A B, h ||- (A ** B) -> forall B', (B ==> B') -> h ||- (A ** B'). Proof. destruct 1 as [ha [hb [J [HA HB]]]]. exists ha; exists hb. intuition. apply H. apply HB. Qed. Lemma sconj_mono : forall h A A' B B', h ||- A ** B -> (A ==> A') -> (B ==> B') -> h ||- A' ** B'. Proof. intros. assert (h ||- (A' ** B)). eapply sconj_mono_left; [eauto | assumption]. eapply sconj_mono_right; [eauto | assumption]. Qed. Lemma sconj_eqv_left : forall M A B, M ||- A ** B -> forall A', (A <==> A') -> M ||- A' ** B. Proof. intros M A A' B H H0. apply sconj_mono_left with A; trivial. intro M'. destruct (H0 M'); trivial. Qed. Implicit Arguments sconj_eqv_left [M A B]. Lemma sconj_assoc_left : forall A B C h, h ||- (A ** B) ** C -> h ||- A ** (B ** C). Proof. intros. destruct H as [hab [hc [Jabc [HAB HC]]]]. destruct HAB as [ha [hb [Jab [HA HB]]]]. apply sconj_intro with ha (MemMod.merge hb hc). trivial. apply sconj_intro with hb hc; trivial. split_r. disjoint lift_l. split_r. disjoint des. disjoint lift_l. destruct Jabc. subst h. destruct Jab. subst hab. merge assoc ha. trivial. Qed. Lemma sconj_assoc_right : forall A B C h, h ||- A ** (B ** C) -> h ||- (A ** B) ** C. Proof. intros. apply sconj_sym. apply sconj_assoc_left. exact (sconj_sym (sconj_assoc_left (sconj_sym H))). Qed. (* ************************************************) (* eqv *) (* Lemma eqv_imp : forall A A', A <==> A' -> A ==> A'. Proof. intros A A' H M. destruct (H M); auto. Qed. Implicit Arguments eqv_imp [A A']. Lemma eqv_refl : forall A, A <==> A. Proof. intros; split; auto. Qed. Lemma eqv_sym : forall A B, A <==> B -> B <==> A. Proof. intros; split; destruct (H M); auto. Qed. Hint Resolve eqv_sym : splogic. Lemma eqv_trans : forall A B C, A <==> B -> B <==> C -> A <==> C. Proof. intros A B C H1 H2; split; destruct (H1 M); destruct (H2 M); auto. Qed. Lemma eqv_elim : forall M A A', A <==> A' -> M ||- A -> M ||- A'. Proof. intros M A A' H H0; destruct (H M); auto. Qed. Implicit Arguments eqv_elim [M A A']. Lemma eqv_elim1 : forall M A A' B, A <==> A' -> M ||- A ** B -> M ||- A' ** B. Proof. intros M A A' B H H0. destruct (sconj_elim H0) as [M1 [M2 [HJM [HM1 HM2]]]]. destruct (H M1). apply sconj_intro with M1 M2; auto. Qed. Implicit Arguments eqv_elim1 [M A A' B]. *) (* ************************************************) (* unit *) Lemma unit_intro : emp ||- unit. Proof. unfold mjudge, unit, Aemp. trivial. Qed. Lemma unit_intro_left : forall h A, h ||- A -> h ||- unit ** A. Proof. intros. eapply sconj_intro. 2: apply H. apply unit_intro. unfold join. auto with PMap. Qed. Implicit Arguments unit_intro_left [h A]. Lemma unit_intro_right : forall h A, h ||- A -> h ||- A ** unit. Proof. intros. apply sconj_sym. apply (unit_intro_left H). Qed. Lemma unit_elim : forall h, h ||- unit -> h = emp. Proof. intros. symmetry. unfold emp, unit in H. rewrite H. trivial. Qed. Lemma join_emp_l : forall m1 m : Mem, join emp m1 m -> m1 = m. Proof. intros. auto with PMap. Qed. Lemma unit_elim_left : forall h A, h ||- unit ** A -> h ||- A. Proof. intros. destruct H as [h1 [h2 [HJ [H1 H2]]]]. unfold unit in H1. rewrite H1 in HJ. rewrite (join_emp_l HJ) in H2. trivial. Qed. Implicit Arguments unit_elim_left [h A]. Lemma unit_elim_right : forall h A, h ||- A ** unit -> h ||- A. Proof. intros. apply (unit_elim_left (sconj_sym H)). Qed. Implicit Arguments unit_elim_right [h A]. (* ************************************************) (* top *) Lemma top_intro : forall h, h ||- top. Proof. unfold mjudge, top, top. tauto. Qed. Lemma top_intro_left : forall h A, h ||- A -> h ||- top ** A. Proof. intros. assert (join emp h h). unfold join,emp; auto with PMap. apply (sconj_intro (top_intro emp) H H0). Qed. Implicit Arguments top_intro_left [h A]. Lemma top_intro_left1 : forall M A B, M ||- B ** A -> M ||- top ** A. Proof. intros. destruct (sconj_elim H) as [M1 [M2 [HJM [HM1 HM2]]]]. apply sconj_intro with M1 M2; auto. apply top_intro; auto. Qed. Implicit Arguments top_intro_left1 [M A B]. Lemma top_intro_right : forall M A, M ||- A -> M ||- A ** top. Proof. intros M A H. substH H with (top_intro_left H). apply sconj_sym; trivial. Qed. Implicit Arguments top_intro_right [M A]. Lemma top_intro_right1 : forall M A B, M ||- A ** B -> M ||- A ** top. Proof. intros M A B H. destruct (sconj_elim H) as [M1 [M2 [HJM [HM1 HM2]]]]. apply sconj_intro with M1 M2; auto. apply top_intro; auto. Qed. Implicit Arguments top_intro_right1 [M A B]. (* *********************************************** *) (* bang *) Lemma bang_intro : forall h (A:Prop), h ||- unit -> A -> h ||- ! A. Proof. unfold bang. intros h A Hp Aok. constructor; assumption. Qed. Lemma bang_elim1 : forall h P, h ||- ! P -> P. Proof. unfold mjudge, bang. intuition. Qed. Lemma bang_elim2 : forall h P, h ||- ! P -> h ||- unit. Proof. unfold mjudge, bang. intuition. Qed. Lemma bang_elim : forall h P, h ||- ! P -> h ||- unit /\ P. Proof. intros h P Hp. constructor. exact (bang_elim2 Hp). exact (bang_elim1 Hp). Qed. Lemma bang_elim_left : forall h P B, h ||- ! P ** B -> P /\ h ||- B. Proof. intros h A B H. assert (A /\ h ||- unit ** B). destruct H as [ha [hb [J [HA HB]]]]. constructor. apply (bang_elim1 HA). assert (HA' := bang_elim2 HA). eapply sconj_intro; eauto. intuition. intuition. apply unit_elim_left; trivial. Qed. Lemma bang_elim_left1 : forall h P B, h ||- ! P ** B -> P. Proof. intros h A B H. destruct (bang_elim_left H). assumption. Qed. Lemma bang_elim_left2 : forall h P B, h ||- ! P ** B -> h ||- B. Proof. intros h A B H. destruct (bang_elim_left H). assumption. Qed. Lemma bang_elim_right : forall h P B, h ||- B ** ! P -> P /\ h ||- B. Proof. intros h A B H. substH H with (sconj_sym H). apply bang_elim_left; auto. Qed. Lemma bang_intro_left : forall h (P:Prop) B, P -> h ||- B -> h ||- ! P ** B. Proof. intros h A B HA HB. unfold bang. assert (Q := unit_intro_left HB). eapply sconj_mono; eauto. intros M H. unfold mjudge in * . auto. Qed. Lemma bang_intro_right : forall h (P:Prop) B, P -> h ||- B -> h ||- B ** ! P. Proof. intros. apply sconj_sym. apply bang_intro_left; auto. Qed. (* *********************************************** *) (* pto *) Lemma pto_intro : forall M l w, (forall l', (l' = l -> M l' = Some w) /\ (l' <> l -> M l' = None)) -> M ||- l |-> w. Proof. intros M l w. unfold mjudge, pto, MemMod.sgltonM. unfold MemMod.maps_to, MemMod.not_in_dom. intros. split. substH H with (H l). destruct H. apply H; trivial. intros l' H0. substH H with (H l'). destruct H. apply H1; trivial. Qed. Lemma pto_elim : forall M l w, (M ||- l |-> w) -> (forall l', (l' = l -> M l' = Some w) /\ (l' <> l -> M l' = None)). Proof. intros M l w. unfold mjudge, pto, MemMod.sgltonM. unfold MemMod.maps_to, MemMod.not_in_dom. intros. split. intros. subst l'. destruct H; trivial. intros. destruct H. apply H1; trivial. Qed. Lemma pto_get_eq : forall M l w, M ||- l |-> w -> M l = Some w. Proof. intros M l w H. substH H with (pto_elim H). destruct (H l). apply H0; trivial. Qed. Lemma pto_get_eq1 : forall M l w A, M ||- l |-> w ** A -> M l = Some w. Proof. intros M l w A H. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. substH HJM with (disjUnion_elim HJM l). rewrite (pto_get_eq HM1) in HJM. destruct (M2 l). contradiction. destruct (M l); auto. contradiction. Qed. Lemma pto_update : forall M l v1 v2, M ||- l |-> v1 -> set M l v2 ||- l |-> v2. Proof. intros M l v1 v2 H. apply pto_intro. substH H with (pto_elim H). intros l'. substH H with (H l'). unfold MemMod.put. destruct (MemMod.beq_A l' l). split; intro; trivial. destruct (H0 e). split; intro; trivial. destruct (n H0). destruct H. auto. Qed. Lemma pto_update1 : forall M l v1 A, M ||- (l |-> v1 ** A) -> forall v2, set M l v2 ||- (l |-> v2 ** A). Proof. intros M l v1 A H v2. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists (set M1 l v2); exists M2. split. apply MemMod.update_presv_disjUnion_left; trivial. substH HM1 with (pto_get_eq HM1). unfold MemMod.in_dom. exists v1; trivial. split_r. apply mjudge_elim. apply pto_update with v1; trivial. Qed. Lemma pto_pto_eq : forall h x v1 v2, h ||- x |-> v1 -> h ||- x |-> v2 -> v1 = v2. Proof. intros M l v1 v2 H1 H2. substH H1 with (pto_get_eq H1). substH H2 with (pto_get_eq H2). rewrite H1 in H2. injection H2; trivial. Qed. Lemma pto_pto_eq1 : forall h x v1 v2 A B, h ||- x |-> v1 ** A -> h ||- x |-> v2 ** B -> v1 = v2. Proof. intros h x v1 v2 A B H1 H2. assert (Some v1 = Some v2). rewrite <- (pto_get_eq1 H1). rewrite <- (pto_get_eq1 H2). reflexivity. injection H; auto. Qed. (* *********************************************** *) (* ptox *) Lemma pto_ptox : forall M l v, M ||- l |-> v -> M ||- l |->_. Proof. intros M l w H. unfold ptox. unfold mjudge. exists w; trivial. Qed. Lemma pto_ptox1 : forall M l v A, M ||- l |-> v ** A -> M ||- l |->_ ** A. Proof. unfold ptox. intros M l v A H. destruct (sconj_elim H) as [M1 [M2 [HJM [HM1 HM2]]]]. apply sconj_intro with M1 M2; auto. unfold mjudge in * . exists v; trivial. Qed. Lemma ptox_pto : forall M l, (M ||- l |->_) -> exists v, M ||- l |-> v. Proof. intros M l H. unfold ptox in H. unfold mjudge in H. apply H. Qed. Lemma ptox_pto1 : forall M l A, (M ||- l |->_ ** A) -> exists v, M ||- l |-> v ** A. Proof. intros M l A H. destruct (sconj_elim H) as [M1 [M2 [HJM [HM1 HM2]]]]. destruct (ptox_pto HM1). exists x. eapply sconj_intro; eauto. Qed. (* add by Xinyu *) Lemma ptox_elim1 : forall M l A, (M ||- l |->_ *^* A) -> exists w, M ||- l |-> w *^* A. Proof. apply ptox_pto1. Qed. Lemma ptox_update : forall M l v, M ||- l |->_ -> set M l v ||- l |-> v. Proof. intros M l v H. destruct (ptox_pto H). apply pto_update with x; trivial. Qed. Lemma ptox_update1 : forall M l A, M ||- l |->_ ** A -> forall v, set M l v ||- l |-> v ** A. Proof. intros M l A H v. destruct (ptox_pto1 H). apply pto_update1 with x; trivial. Qed. (* ********************************************** *) (* leadsTo *) Lemma leadsTo_pto : forall M l v, M ||- l |~> v -> M ||- l |-> v ** top. Proof. intros M l v H. unfold mjudge, leadsTo in H. unfold imprecM in H. apply mjudge_intro; trivial. Qed. Hint Resolve leadsTo_pto : splogic. Lemma leadsTo_pto1 : forall M l v A, M ||- l |~> v ** A -> M ||- l |-> v ** top ** A. Proof. intros M l v A H. unfold leadsTo in H. unfold imprecM in H. apply sconj_assoc_left; trivial. Qed. Lemma pto_leadsTo : forall M l v, M ||- l |-> v -> M ||- l |~> v. Proof. intros M l v H. unfold leadsTo, imprecM. eapply top_intro_right; eauto. Qed. Hint Resolve pto_leadsTo : splogic. Lemma pto_leadsTo1 : forall M l v A, M ||- l |-> v ** A -> M ||- l |~> v. Proof. intros M l v A H. unfold leadsTo, imprecM. eapply top_intro_right1; eauto. Qed. Lemma leadsTo_mono : forall M l v A, M ||- l |~> v ** A -> M ||- l |~> v. Proof. intros M l v A H. substH H with (leadsTo_pto1 H). eapply pto_leadsTo1; eauto. Qed. Hint Resolve leadsTo_mono : splogic. Lemma leadsTo_get_eq : forall M l v, M ||- l |~> v -> M l = Some v. Proof. intros M l v H. substH H with (leadsTo_pto H). eapply pto_get_eq1; eauto. Qed. Lemma leadsTo_update : forall M l v1 v2, M ||- l |~> v1 -> set M l v2 ||- l |~> v2. Proof. intros M l v1 v2 H. substH H with (leadsTo_pto H). apply pto_leadsTo1 with top. eapply pto_update1; eauto. Qed. (* ********************************************** *) (* leadsTox *) Lemma leadsTox_leadsTo : forall M l, M ||- l |~>_ -> exists v, M ||- l |~> v. Proof. unfold leadsTox. intros M l H. destruct (sconj_elim H) as [M1 [M2 [HJM [HM1 HM2]]]]. substH HM1 with (ptox_pto HM1). destruct HM1 as [v HM1]. exists v. apply pto_leadsTo1 with top. apply sconj_intro with M1 M2; auto. Qed. Lemma leadsTo_leadsTox : forall M l v, M ||- l |~> v -> M ||- l |~>_. Proof. intros M l v H. substH H with (leadsTo_pto H). destruct (sconj_elim H) as [M1 [M2 [HJM [HM1 HM2]]]]. unfold leadsTox. unfold imprecM. apply sconj_intro with M1 M2; auto. apply pto_ptox with v; trivial. Qed. (* under construction *) (* ************************************************) (* WORD-wise *) (* ************************************************) (* setW *) Notation Local junk := 0. Notation Local setW := (MemUpdW) (only parsing). (* ************************************************) (* ptoW *) Lemma ptoW_pto : forall M l v, (M ||- l |->w v) -> M ||- l |-> v ** l+1 |->_ . Proof. intros M l v H. unfold ptoW in H. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. split_lr. Qed. Hint Resolve ptoW_pto : splogic. Lemma ptoW_pto1 : forall M l v A, (M ||- l |->w v ** A) -> M ||- (l |-> v ** l+1 |->_ ) ** A . Proof. intros M l v A H. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. substH HM1 with (ptoW_pto HM1). apply sconj_intro with M1 M2; auto. Qed. Lemma pto_ptoW : forall M l v, M ||- l |-> v ** l+1 |->_ -> (M ||- l |->w v). Proof. intros M l w H. unfold ptoW. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; auto. Qed. Hint Resolve pto_ptoW : splogic. Lemma pto_ptoW1 : forall M l v A, M ||- (l |-> v ** l+1 |->_ ) ** A -> (M ||- l |->w v ** A). Proof. intros M l w A H. destruct (sconj_elim H) as [M1 [M2 [HJM [HM1 HM2]]]]. apply sconj_intro with M1 M2; auto. Qed. Lemma ptoW_get_eq : forall M l v, M ||- l |->w v -> M l = Some v. Proof. intros M l v H. substH H with (ptoW_pto H). eapply pto_get_eq1; eauto. Qed. Lemma ptoW_get_eq1 : forall M l v A, M ||- l |->w v ** A -> M l = Some v. Proof. intros M l v A H. substH H with (ptoW_pto1 H). substH H with (sconj_assoc_left H). eapply pto_get_eq1; eauto. Qed. Lemma ptoW_ptoW_eq : forall M l v1 v2, M ||- l |->w v1 -> M ||- l |->w v2 -> v1 = v2. Proof. intros M l v1 v2 H1 H2. substH H1 with (ptoW_get_eq H1). substH H2 with (ptoW_get_eq H2). rewrite H1 in H2. injection H2; auto. Qed. Lemma ptoW_ptoW_eq1 : forall M l v1 v2 A B, M ||- l |->w v1 ** A -> M ||- l |->w v2 ** B -> v1 = v2. Proof. intros h x v1 v2 A B H1 H2. assert (Some v1 = Some v2). rewrite <- (ptoW_get_eq1 H1). rewrite <- (ptoW_get_eq1 H2). reflexivity. injection H; auto. Qed. (* temporary *) Lemma ptoW_pto_eq : forall M l v1 v2, M ||- l |->w v1 -> M ||- l |-> v2 -> v1 = v2. Proof. intros M l v1 v2 H1 H2. substH H1 with (ptoW_get_eq H1). substH H2 with (pto_get_eq H2). rewrite H1 in H2. injection H2; auto. Qed. (* temporary *) Lemma ptoW_pto_eq1 : forall M l v1 v2 A B, M ||- l |->w v1 ** A -> M ||- l |-> v2 ** B -> v1 = v2. Proof. intros h x v1 v2 A B H1 H2. assert (Some v1 = Some v2). rewrite <- (ptoW_get_eq1 H1). rewrite <- (pto_get_eq1 H2). reflexivity. injection H; auto. Qed. Lemma ptoW_update : forall M l v1, M ||- l |->w v1 -> forall v2 v', setW M l v2 v' ||- l |->w v2. Proof. intros M l v1 H v2 v'. unfold MemUpdW. substH H with (ptoW_pto H). unfold ptoW. substH H with (sconj_sym H). apply sconj_sym. apply pto_ptox1 with v'. apply ptox_update1; auto. substH H with (sconj_sym H). apply sconj_sym. apply pto_update1 with v1; auto. Qed. Lemma ptoW_update1 : forall M l v1 A, M ||- l |->w v1 *^* A -> forall v2 v', setW M l v2 v' ||- l |->w v2 *^* A. Proof. intros M l v1 A H v2 v'. substH H with (ptoW_pto1 H). unfold setW. apply pto_ptoW1. apply sconj_assoc_right. apply sconj_sym. apply sconj_assoc_right. assert (H1 := sconj_assoc_left H). substH H1 with (sconj_sym H1). substH H1 with (sconj_assoc_left H1). apply pto_ptox1 with v'. apply ptox_update1. apply sconj_sym. apply sconj_assoc_right. apply sconj_sym. apply sconj_assoc_right. substH H with (sconj_assoc_left H). apply pto_update1 with v1; trivial. Qed. (* add by Xinyu *) Lemma ptoW_elim : forall M l v, (M ||- l |->w v) -> exists x, M ||- l |-> v ** l+1 |-> x. Proof. intros M l v H. substH H with (ptoW_pto H). substH H with (sconj_sym H). substH H with (ptox_pto1 H). destruct H. exists x. apply sconj_sym; trivial. Qed. (* add by Xinyu *) Lemma ptoW_elim1 : forall M l v m, (M ||- l |->w v *^* m) -> exists x, M ||- l |-> v ** l+1 |-> x *^* m. Proof. intros M l v m H. substH H with (ptoW_pto1 H). substH H with (sconj_assoc_left H). substH H with (sconj_sym H). substH H with (sconj_assoc_left H). substH H with (ptox_pto1 H). destruct H. exists x. apply sconj_assoc_right. apply sconj_sym. apply sconj_assoc_right; trivial. Qed. (* add by Xinyu *) Lemma ptoW_intro : forall M l v x, M ||- l |-> v ** l+1 |-> x -> (M ||- l |->w v). Proof. intros M l v x H. apply pto_ptoW. apply sconj_sym. apply pto_ptox1 with x. apply sconj_sym; trivial. Qed. (* add by Xinyu *) Lemma ptoW_intro1 : forall M l v x m, M ||- l |-> v ** l+1 |-> x *^* m -> M ||- l |->w v *^* m. Proof. intros M l w x m H. apply pto_ptoW1. apply sconj_assoc_right. apply sconj_sym. apply sconj_assoc_right. apply pto_ptox1 with x. apply sconj_assoc_left. apply sconj_sym. apply sconj_assoc_left; trivial. Qed. (**********************************************) (* ptoxW *) Lemma ptoxW_ptoW : forall M l, M ||- l |->w_ -> exists x, M ||- l |->w x. Proof. intros M l H. unfold ptoxW in H. substH H with (ptox_pto1 H). destruct H. exists x. unfold ptoW. trivial. Qed. Lemma ptoxW_ptoW1 : forall M l A, M ||- l |->w_ ** A -> exists x, M ||- l |->w x ** A. Proof. intros M l A H. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. destruct (ptoxW_ptoW HM1). exists x. exists M1; exists M2; split_l. auto. Qed. Lemma ptoW_ptoxW : forall M l x, M ||- l |->w x -> M ||- l |->w_ . Proof. intros M l x H. unfold ptoW, ptoxW, ptox, pto in * . destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. split_r. exists x; trivial. Qed. Lemma ptoW_ptoxW1 : forall M l x A, M ||- l |->w x ** A -> M ||- l |->w_ ** A. Proof. intros M l x A H. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. split_r. apply ptoW_ptoxW with x; trivial. Qed. Lemma ptoxW_update : forall M l, M ||- l |->w_ -> forall v2 v', MemUpdW M l v2 v' ||- l |->w v2. Proof. intros M l H v2 v'. substH H with (ptoxW_ptoW H). destruct H. apply ptoW_update with x; trivial. Qed. Lemma ptoxW_update1 : forall M l A, M ||- l |->w_ *^* A -> forall v2 v', setW M l v2 v' ||- l |->w v2 *^* A. Proof. intros M l A H v2 v'. substH H with (ptoxW_ptoW1 H). destruct H. apply ptoW_update1 with x; trivial. Qed. (*********************************) (* leadsToW *) Lemma ptoW_leadsToW : forall M l v, M ||- l |->w v -> M ||- l |~>w v. Proof. intros M l v H. unfold leadsToW. unfold imprecM. exists M; exists MemMod.emp. split. auto with PMap. unfold mTrue. split_lr. Qed. Implicit Arguments ptoW_leadsToW [M l v]. Hint Resolve ptoW_leadsToW : splogic. Lemma leadsToW_ptoW : forall M l v, M ||- l |~>w v -> M ||- l |->w v ** top. Proof. unfold leadsToW. unfold imprecM. trivial. Qed. Implicit Arguments leadsToW_ptoW [M l v]. Hint Resolve leadsToW_ptoW : splogic. Lemma ptoW_leadsToW1 : forall M l v A, M ||- l |->w v ** A -> M ||- l |~>w v. Proof. intros M l v A H. unfold leadsToW. unfold imprecM. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. unfold mTrue. auto. Qed. Implicit Arguments ptoW_leadsToW1 [M l v A]. Hint Resolve ptoW_leadsToW1 : splogic. Lemma leadsToW_leadsTo : forall M l v, M ||- l |~>w v -> M ||- l |~> v /\ M ||- (l + 1) |~>_. Proof. intros M l v H. substH H with (leadsToW_ptoW H). substH H with (ptoW_pto1 H). substH H with (sconj_assoc_left H). split. eapply pto_leadsTo1; eauto. substH H with (sconj_sym H). substH H with (sconj_assoc_left H). substH H with (ptox_pto1 H). destruct H. apply leadsTo_leadsTox with x. eapply pto_leadsTo1; eauto. Qed. Implicit Arguments leadsToW_leadsTo [M l v]. Hint Resolve leadsToW_leadsTo : splogic. Lemma ptoW_leadsToW_eq1 : forall M l v v' A, M ||- l |->w v ** A -> M ||- l |~>w v' -> v = v'. Proof. intros M l v v' A H H0. substH H0 with (leadsToW_leadsTo H0). destruct H0. substH H with (ptoW_pto1 H). substH H0 with (leadsTo_pto H0). substH H with (sconj_assoc_left H). eapply pto_pto_eq1; eauto. Qed. Implicit Arguments ptoW_leadsToW_eq1 [M l v v' A]. (* temporary *) Lemma pto_leadsToW_eq1 : forall M l v v' A, M ||- l |-> v ** A -> M ||- l |~>w v' -> v = v'. Proof. intros M l v v' A H H0. substH H0 with (leadsToW_leadsTo H0). destruct H0. substH H0 with (leadsTo_pto H0). eapply pto_pto_eq1; eauto. Qed. Implicit Arguments ptoW_leadsToW_eq1 [M l v v' A]. Lemma leadsToW_get_eq : forall M l v, M ||- l |~>w v -> M l = Some v. Proof. intros. substH H with (leadsToW_ptoW H). apply ptoW_get_eq1 with top; trivial. Qed. Implicit Arguments leadsToW_get_eq [M l v]. Lemma leadsToW_leadsToW_eq : forall M l v v', M ||- l |~>w v -> M ||- l |~>w v' -> v = v'. Proof. unfold mjudge; intros. substH H with (leadsToW_ptoW H). substH H0 with (leadsToW_ptoW H0). eapply ptoW_ptoW_eq1; eauto. Qed. Implicit Arguments leadsToW_leadsToW_eq [M l v v']. Lemma leadsToW_update : forall M l v1, M ||- l |~>w v1 -> forall v2 v', setW M l v2 v' ||- l |~>w v2. Proof. intros M l v1 H v2 v'. substH H with (leadsToW_ptoW H). apply ptoW_leadsToW1 with top; trivial. apply ptoW_update1 with v1; trivial. Qed. (**********************************) (* leadsToxW *) Lemma leadsToW_leadsToxW : forall M l v, M ||- l |~>w v -> M ||- l|~>w_. Proof. unfold leadsToxW. intros M l v H. substH H with (leadsToW_ptoW H). unfold imprecM. apply ptoW_ptoxW1 with v; trivial. Qed. Implicit Arguments leadsToW_leadsToxW [M l v]. Lemma leadsToxW_leadsToW : forall M l, M ||- l |~>w_ -> exists v, M ||- l|~>w v. Proof. unfold leadsToxW. intros M l H. unfold imprecM in H. substH H with (ptoxW_ptoW1 H). destruct H. exists x. eapply ptoW_leadsToW1; eauto. Qed. Implicit Arguments leadsToxW_leadsToW [M l]. Lemma ptoW_leadsToxW1 : forall M l v A, M ||- l |->w v *^* A -> M ||- l |~>w_ . Proof. intros M l v A H. unfold leadsToxW. unfold imprecM. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. unfold mTrue. split_r. apply ptoW_ptoxW with v; trivial. Qed. Implicit Arguments ptoW_leadsToxW1 [M l v A]. Lemma ptoxW_leadsToxW1 : forall M l A, M ||- l |->w_ *^* A -> M ||- l |~>w_ . Proof. intros M l A H. unfold leadsToxW. unfold imprecM. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. unfold mTrue. auto. Qed. Implicit Arguments ptoxW_leadsToxW1 [M l A]. Lemma leadsToxW_update : forall M l, M ||- l |~>w_ -> forall v2 v', setW M l v2 v' ||- l |~>w v2. Proof. intros M l H v2 v'. substH H with (leadsToxW_leadsToW H). destruct H as [v H]. apply leadsToW_update with v; trivial. Qed. Implicit Arguments leadsToxW_update [M l]. (* ************************************************) (* meq *) Lemma meq_intro : forall M, M ||- meq M. Proof. unfold mjudge, meq; auto. Qed. Hint Resolve meq_intro : splogic. Lemma meq_elim : forall M M', M ||- meq M' -> M = M'. Proof. unfold mjudge, meq; auto. Qed. Lemma meq_update : forall M l v x, setW M l v x ||- meq (setW M l v x). Proof. intros; apply meq_intro; trivial. Qed. Lemma meq_update1 : forall M1 M l v x A, (M ||- meq M1 ** A) -> (M1 ||- l |~>w_) -> setW M l v x ||- meq (setW M1 l v x) ** A. Proof. unfold meq. intros M' M l v x A H H0. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. subst M'. substH H0 with (leadsToxW_leadsToW H0). destruct H0. substH H with (leadsToW_ptoW H). substH H with (ptoW_pto1 H). assert (MemMod.in_dom l M1). substH H with (sconj_assoc_left H). exists x0. eapply pto_get_eq1; eauto. assert (MemMod.in_dom (l+1) (set M1 l v)). substH H with (sconj_assoc_left H). substH H with (sconj_sym H). substH H with (sconj_assoc_left H). substH H with (ptox_pto1 H). destruct H. exists x1. substH H with (pto_get_eq1 H). unfold set. destruct (MemMod.beq_A (l+1) l); trivial. apply False_ind; omega. exists (MemUpdW M1 l v x); exists M2. split; auto. unfold MemUpdW. apply MemMod.update_presv_disjUnion_left; trivial. apply MemMod.update_presv_disjUnion_left; trivial. Qed. (*********************************) (* ptoxBlk *) Lemma imp_ptoxBlk_unit : forall l, (ptoxBlk l 0) ==> (unit). Proof. unfold ptoxBlk; intros l; trivial. Qed. Lemma imp_unit_ptoxBlk : forall l, (unit) ==> (ptoxBlk l 0). Proof. unfold ptoxBlk; intros l; trivial. Qed. Hint Resolve imp_ptoxBlk_unit imp_unit_ptoxBlk : splogic. Lemma imp_ptoxBlk_ptox : forall l, (ptoxBlk l 1) ==> (ptox l). Proof. unfold ptoxBlk; intro l; intros. apply unit_elim_right; trivial. Qed. Lemma imp_ptox_ptoxBlk : forall l, (ptox l) ==> (ptoxBlk l 1). Proof. unfold ptoxBlk; intro l; intros. apply unit_intro_right; trivial. Qed. Hint Resolve imp_ptoxBlk_ptox imp_ptox_ptoxBlk : splogic. Lemma imp_ptoxBlk_ptoxW : forall l, (ptoxBlk l 2) ==> (ptoxW l). Proof. unfold ptoxBlk, ptoxW; intro l; intros. apply unit_elim_right; trivial. apply sconj_assoc_right; trivial. Qed. Lemma imp_ptoxW_ptoxBlk : forall l, (ptoxW l) ==> (ptoxBlk l 2). Proof. unfold ptoxBlk, ptoxW; intro l; intros. apply sconj_assoc_left; trivial. apply unit_intro_right; trivial. Qed. Hint Resolve imp_ptoxBlk_ptoxW imp_ptoxW_ptoxBlk : splogic. Lemma ptoxBlk_split : forall s1 s2 M l, M ||- ptoxBlk l (s1 + s2) -> M||- (ptoxBlk l s1) ** (ptoxBlk (l+s1) s2). Proof. induction s1; simpl; intros. unfold Aemp, MemMod.emp. exists MemMod.emp; exists M. split. auto with PMap. unfold MemMod.emp. split_l. replace (l+0) with l; auto with arith. destruct H as [M1 [M2 [MJM [HM1 HM2]]]]. replace (l + S s1) with (S l + s1); [idtac | omega]. assert (Hx := IHs1 s2 M2 (l+1) HM2). apply sconj_assoc_right. unfold mstar. exists M1; exists M2; split_l. split_l. arith_rep (S l + s1) with (l+1+s1). Qed. Lemma ptoxBlk_merge : forall s1 s2 M l, M||- (ptoxBlk l s1) ** (ptoxBlk (l+s1) s2) -> M ||- ptoxBlk l (s1 + s2). Proof. induction s1;simpl;intros. unfold mjudge, sconj, Aemp in H. InvertAll. subst. assert (x0 = M). auto with PMap. subst. arith_rep l with (l+0); assumption. assert (M ||- (ptox l *^* (ptoxBlk (l + 1) s1 *^* ptoxBlk (l + S s1) s2))). apply sconj_assoc_left; assumption. unfold mjudge, mstar at 1 in H0. InvertAll. exists x;exists x0;intuition. apply IHs1. arith_rep (l+1+s1) with (l+S s1); assumption. Qed. Lemma imp_ptoxBlk_split : forall l s1 s2, (ptoxBlk l (s1 + s2)) ==> ((ptoxBlk l s1) ** (ptoxBlk (l+s1) s2)). Proof. intros l s1 s2 M. intro H. apply ptoxBlk_split; trivial. Qed. Lemma imp_ptoxBlk_merge : forall l s1 s2, ((ptoxBlk l s1) ** (ptoxBlk (l+s1) s2)) ==> (ptoxBlk l (s1 + s2)). Proof. intros l s1 s2 M. intro H. apply ptoxBlk_merge; trivial. Qed. Hint Resolve imp_ptoxBlk_split imp_ptoxBlk_merge : splogic. (* ******************************************************) (* Basic tactics *) (* ******************************************************) Ltac hyprep H y := let H' := fresh in (assert (H' := y); try (clear H; rename H' into H)). Ltac sep_mjudge := apply mjudge_elim. Ltac sep_mjudgeH H := hyprep H (mjudge_intro H). Ltac sep_turnon := match goal with | H : unit ?M |- _ => sep_mjudgeH H; sep_turnon | H : top ?M |- _ => sep_mjudgeH H; sep_turnon | H : (sconj ?A ?B) ?M |- _ => sep_mjudgeH H; sep_turnon | H : (ptox ?l) ?M |- _ => sep_mjudgeH H; sep_turnon | H : (pto ?l ?x) ?M |- _ => sep_mjudgeH H; sep_turnon | H : (leadsTo ?l ?x) ?M |- _ => sep_mjudgeH H; sep_turnon | H : (leadsTox ?l) ?M |- _ => sep_mjudgeH H; sep_turnon | H : (ptoxW ?l) ?M |- _ => sep_mjudgeH H; sep_turnon | H : (ptoW ?l ?x) ?M |- _ => sep_mjudgeH H; sep_turnon | H : (leadsToW ?l ?x) ?M |- _ => sep_mjudgeH H; sep_turnon | H : (leadsToxW ?l) ?M |- _ => sep_mjudgeH H; sep_turnon | H : (stkSpacePrec ?sp ?size) ?M |- _ => sep_mjudgeH H; sep_turnon | H : (stkSpace ?sp ?size) ?M |- _ => sep_mjudgeH H; sep_turnon | _ => (try sep_mjudge); idtac end. Ltac sep_turnoff := unfold mjudge in * . Tactic Notation "sep" "on" := sep_turnon. Tactic Notation "sep" "off" := sep_turnoff. (* Ltac sepelim Hp := match type of Hp with | _ ||- unit => hyprep Hp (unit_elim Hp); subst h | _ ||- bang _ => let A := fresh "A" in let Hp' := fresh "Hp" in (destruct (bang_elim Hp) as [Hp' A]; hyprep Hp' (unit_elim Hp'); subst h; clear Hp') (* | _ ||- lex _ => *) (* let x := fresh "x" in let Hp' := fresh "Hp'" in *) (* (destruct (lex_elim Hp) as [x Hp']; *) (* clear Hp; rename Hp' into Hp; sepelim Hp) *) | _ ||- sconj (bang _) _ => let A := fresh "A" in let Hp' := fresh "Hp" in (destruct (bang_elim_left Hp) as [A Hp']; clear Hp; rename Hp' into Hp; sepelim Hp) | _ ||- sconj _ (bang _) => let A := fresh "A" in let Hp' := fresh "Hp" in (destruct (bang_elim_right Hp) as [A Hp']; clear Hp; rename Hp' into Hp; sepelim Hp) | _ ||- sconj unit _ => hyprep Hp (unit_elim_left Hp); sepelim Hp | _ ||- sconj _ unit => hyprep Hp (unit_elim_right Hp); sepelim Hp | _ ||- sconj (sconj _ _) _ => hyprep Hp (sconj_assoc_left Hp); sepelim Hp | _ ||- sconj _ _ => let h1 := fresh "h" in let h2 := fresh "h" in let J := fresh "J" in let Hp1 := fresh "Hp" in let Hp2 := fresh "Hp" in (destruct Hp as [h1 [h2 [J [Hp1 Hp2]]]]; sepelim Hp1; sepelim Hp2; assert (Hp := sconj_intro Hp1 Hp2 J); clear h1 h2 J Hp1 Hp2) | _ => idtac end. *) Ltac assocl H := match type of H with | _ ||- sconj (ptoxW ?l) _ => idtac | _ ||- sconj (ptoW ?l ?x) _ => idtac | _ ||- sconj (sconj _ _) _ => hyprep H (sconj_assoc_left H); assocl H | _ => idtac end. (* Ltac assocl H := *) (* repeat (hyprep H (sconj_assoc_left H)). *) Ltac assocr := match goal with | |- _ ||- sconj (ptoxW ?l) _ => idtac | |- _ ||- sconj (ptoW ?l ?w) _ => idtac | |- _ ||- sconj (sconj _ _) _ => apply sconj_assoc_right; assocr | _ => idtac end. (* Ltac assocr := *) (* repeat (apply sconj_assoc_right). *) Ltac sep_inj := match goal with | H : ?M ||- (pto ?l ?v), H0 : ?M ||- (pto ?l ?v2) |- _ => generalize (pto_pto_eq H H0) | H : ?M ||- sconj (pto ?l ?v) _, H0 : ?M ||- sconj (pto ?l ?v2) _ |- _ => generalize (pto_pto_eq1 H H0) | H : ?M ||- (ptoW ?l ?v), H0 : ?M ||- (ptoW ?l ?v2) |- _ => generalize (ptoW_ptoW_eq H H0) | H : ?M ||- sconj (ptoW ?l ?v) _, H0 : ?M ||- sconj (ptoW ?l ?v2) _ |- _ => generalize (ptoW_ptoW_eq1 H H0) (* temporary *) | H : ?M ||- (ptoW ?l ?v), H0 : ?M ||- (pto ?l ?v2) |- _ => generalize (ptoW_pto_eq H H0) (* temporary *) | H : ?M ||- sconj (ptoW ?l ?v) _, H0 : ?M ||- sconj (pto ?l ?v2) _ |- _ => generalize (ptoW_pto_eq1 H H0) | H : ?M ||- sconj (ptoW ?l ?v) _, H0 : ?M ||- leadsToW ?l ?v2 |- _ => generalize (ptoW_leadsToW_eq1 H H0) (* temporary *) | H : ?M ||- sconj (pto ?l ?v) _, H0 : ?M ||- leadsToW ?l ?v2 |- _ => generalize (pto_leadsToW_eq1 H H0) | H : ?M ||- leadsToW ?l ?v, H0 : ?M ||- leadsToW ?l ?v2 |- _ => generalize (leadsToW_leadsToW_eq H H0) end. Tactic Notation "sep" "inj" := sep_inj. Ltac sep_update := match goal with | |- MemUpdW ?M ?l ?v ?junk ||- ptoW ?l ?v => apply ptoxW_update | |- MemUpdW ?M ?l ?v ?junk ||- ptoxW ?l => apply ptoW_ptoxW with v; apply ptoxW_update | |- MemUpdW ?M ?l ?v ?junk ||- sconj (ptoW ?l ?v) ?B => apply ptoxW_update1 | |- MemUpdW ?M ?l ?v ?junk ||- sconj (ptoxW ?l) ?B => apply ptoW_ptoxW1 with v; apply ptoxW_update1 | |- MemUpdW ?M ?l ?v ?junk ||- (leadsToW ?l ?v) => apply leadsToxW_update | |- MemUpdW ?M ?l ?v ?junk ||- (leadsToxW ?l) => apply leadsToW_leadsToxW with v; apply leadsToxW_update | |- MemUpdW ?M ?l ?v ?junk ||- sconj (meq (MemUpdW ?M1 ?l ?v ?junk)) ?B => apply meq_update1; auto | _ => fail 1 "Error: format" end. Tactic Notation "sep" "upd" := sep_update. (**************************************************************) (* memory shift *) (**************************************************************) Ltac sep_lift n := match eval compute in n with | O => assocr | _ => assocr; apply sconj_sym; sep_lift (pred n) end. Ltac sep_liftH H n := match eval compute in n with | O => assocl H | _ => assocl H; hyprep H (sconj_sym H); sep_liftH H (pred n) end. Ltac sep_shift_l n := match eval compute in n with | 0 => apply sconj_sym | _ => sep_lift (pred n); apply sconj_sym end. Tactic Notation "sep" "lift" constr (n) := sep_lift n. Tactic Notation "sep" "lift" constr (n) "in" hyp (H):= sep_liftH H n. Tactic Notation "sep" "lift" constr (n) "in" hyp (H) "as" hyp (Hx):= generalize H; intro Hx; sep_liftH Hx n. Ltac sep_searchH H C n := match eval compute in n with | O => assocl H; match type of H with | _ ||- C ** ?B => idtac | _ ||- ?A ** ?B => fail 1 "Error: Not found" | _ => fail 1 "Error:" end | _ => assocl H; match type of H with | _ ||- C ** ?B => idtac | _ ||- ?A ** ?B => hyprep H (sconj_sym H); sep_searchH H C (pred n) | _ => fail 1 "Error:" end end. Ltac sep_search C n := match eval compute in n with | O => assocr; match goal with | |- _ ||- sconj C ?B => idtac | |- _ ||- sconj ?A ?B => fail 1 "Error: Not found" | _ => fail 1 "Error:" end | _ => assocr; match goal with | |- _ ||- sconj C ?B => idtac | |- _ ||- sconj ?A ?B => apply sconj_sym; sep_search C (pred n) | _ => fail 1 "Error:" end end. Tactic Notation "sep" "search" constr (C) "in" hyp (H) "with" constr (n) := sep_searchH H C n. Tactic Notation "sep" "search" constr (C) "in" hyp (H) := sep_searchH H C 10. Tactic Notation "sep" "search" constr (C) "with" constr (n) := sep_search C n. Tactic Notation "sep" "search" constr (C) := sep_search C 30. (**************************************************************) (* stack operation *) (**************************************************************) Lemma stkSpacePrec_stkSpace : forall M sp size, M ||- (stkSpacePrec sp size) -> M ||- stkSpace sp size. Proof. intros. unfold stkSpace. unfold stkSpacePrec in H. unfold mjudge in * . destruct H. split_l. unfold leadsToBlk. unfold imprecM. exists M; exists MemMod.emp. split. auto with PMap. split_l. unfold mTrue; trivial. Qed. Implicit Arguments stkSpacePrec_stkSpace [M sp size]. Lemma stkSpacePrec_stkSpace1 : forall M sp size A, M ||- (stkSpacePrec sp size *^* A) -> M ||- stkSpace sp size. Proof. intros M sp size A H. unfold stkSpace. unfold stkSpacePrec in H. unfold mjudge in * . destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. destruct HM1. split_l. unfold leadsToBlk. unfold imprecM. exists M1; exists M2; split_l. split. auto with PMap. unfold mTrue; trivial. Qed. Implicit Arguments stkSpacePrec_stkSpace1 [M sp size A]. Lemma stkSpacePrec_ptoxW :forall M sp, M ||- stkSpacePrec sp 2 -> M ||- ptoxW (sp - 2). Proof. intros M sp H. unfold stkSpacePrec in H. unfold ptoxBlk in H. unfold ptoxW. unfold mjudge in * . unfold Aemp in H. destruct H. substH H0 with (sconj_assoc_right H0). unfold mjudge in H0. destruct H0 as [M1 [M2 [HJM [HM1 HM2]]]]. subst M2. assert (M1 = M). auto with PMap. subst M1. trivial. Qed. Lemma ptoxW_stkSpacePrec :forall M l, M ||- ptoxW l -> M ||- stkSpacePrec (l+2) 2. Proof. intros M l H. unfold stkSpacePrec, ptoxW in * . simpl. unfold mjudge. split. auto with arith. assert (l+2-2 = l). omega. rewrite H0. apply sconj_assoc_left. exists M; exists MemMod.emp. split. auto with PMap. unfold Aemp. split_r. trivial. Qed. Lemma stkSpacePrec_unit : forall M sp, M ||- stkSpacePrec sp 0 -> M ||- unit. Proof. intros M sp H. unfold stkSpacePrec in H. simpl in H. unfold mjudge in * . destruct H; trivial. Qed. Lemma stkSpacePrec_unit1 : forall M sp A, M ||- (stkSpacePrec sp 0 ** A) -> M ||- A. Proof. intros M sp A H. unfold stkSpacePrec in H. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. destruct HM1. simpl in H0. unfold Aemp in H0. subst M1. assert (M2 = M). auto with PMap. subst M2. trivial. Qed. Lemma unit_stkSpacePrec : forall M sp, M ||- unit -> M ||- stkSpacePrec sp 0. Proof. intros M sp H. unfold stkSpacePrec. unfold mjudge in * . simpl. auto with arith. Qed. Lemma unit_stkSpacePrec_unit : forall M sp A, M ||- A -> M ||- sconj (stkSpacePrec sp 0) A. Proof. intros M sp A H. exists MemMod.emp; exists M. split. auto with PMap. split. apply unit_stkSpacePrec. unfold mjudge, Aemp; trivial. trivial. Qed. (*************************) (* ** stack split ** *) Lemma stkSpacePrec_splitW : forall M sp size, M ||- stkSpacePrec (sp+2) (size+2) -> M ||- stkSpacePrec sp size *^* (sp |->w_ ). Proof. intros M sp size H. substH H with (stkSpacePrec_split H). arith_rep (sp + 2 - 2) with sp in H. substH H with (sconj_sym H). apply (sconj_mono_right H). intros Mx HMx. arith_rep sp with (sp + 2 - 2). apply stkSpacePrec_ptoxW; trivial. Qed. Implicit Arguments stkSpacePrec_splitW [M sp size]. Lemma stkSpacePrec_splitWh : forall M sp size, M ||- stkSpacePrec sp size -> size >= 2 -> M ||- stkSpacePrec (sp - 2) (size - 2) *^* (sp - 2 |->w_ ). Proof. intros M sp size H H0. assert (sp >= 2). destruct H; omega. arith_rep sp with (sp - 2 + 2) in H. arith_rep size with (size - 2 + 2) in H. apply stkSpacePrec_splitW; trivial. Qed. Implicit Arguments stkSpacePrec_splitWh [M sp size]. Lemma stkSpacePrec_splitWh1 : forall M sp size A, M ||- stkSpacePrec sp size *^* A -> size >= 2 -> M ||- stkSpacePrec (sp - 2) (size - 2) *^* (sp -2 |->w_ *^* A). Proof. intros. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. apply sconj_assoc_left. exists M1; exists M2; split_l. split_r. apply stkSpacePrec_splitWh; trivial. Qed. Implicit Arguments stkSpacePrec_splitWh1 [M sp size A]. Lemma stkSpacePrec_splitW1 : forall M sp size A, M ||- stkSpacePrec (sp + 2) (size + 2) *^* A -> M ||- stkSpacePrec sp size *^* (sp |->w_ *^* A). Proof. intros M sp size A H. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. apply sconj_assoc_left. exists M1; exists M2; split_l. split_r. apply stkSpacePrec_splitW; trivial. Qed. Implicit Arguments stkSpacePrec_splitW1 [M sp size A]. Lemma stkSpacePrec_mergeW : forall M sp size, M ||- stkSpacePrec (sp - 2) (size - 2) *^* sp - 2 |->w_ -> sp >= 2 -> size >= 2 -> M ||- stkSpacePrec sp size. Proof. intros M sp size H H0 H1. arith_rep sp with (sp - 2 + 2). arith_rep size with (size - 2 + 2). destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. assert (MemMod.disjUnion M2 M1 M). auto with PMap. destruct H. subst M. unfold mjudge. apply stkSpacePrec_merge. apply ptoxW_stkSpacePrec; trivial. arith_rep (sp - 2 + 2 - 2) with (sp - 2). Qed. Implicit Arguments stkSpacePrec_mergeW [M sp size]. Lemma stkSpacePrec_mergeW1 : forall M sp size A, M ||- stkSpacePrec (sp - 2) (size - 2) *^* (sp - 2 |->w_ *^* A) -> sp >= 2 -> size >= 2 -> M ||- stkSpacePrec sp size *^* A. Proof. intros M sp size A H1 H2 H3. substH H1 with (sconj_assoc_right H1). destruct H1 as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. split_r. apply stkSpacePrec_mergeW; trivial. Qed. Implicit Arguments stkSpacePrec_mergeW1 [M sp size A]. Lemma stkSpacePrec_mergeWh : forall M sp size, M ||- stkSpacePrec sp size *^* sp |->w_ -> M ||- stkSpacePrec (sp + 2) (size + 2). Proof. intros. unfold mjudge. substH H with (sconj_sym H). destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. destruct HJM; subst M. apply stkSpacePrec_merge. apply ptoxW_stkSpacePrec; trivial. arith_rep (sp + 2 - 2) with sp. Qed. Implicit Arguments stkSpacePrec_mergeWh [M sp size]. Lemma stkSpacePrec_mergeWh1 : forall M sp size A, M ||- stkSpacePrec sp size *^* (sp |->w_ *^* A) -> M ||- stkSpacePrec (sp + 2) (size + 2) *^* A. Proof. intros. substH H with (sconj_assoc_right H). destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. split_r. apply stkSpacePrec_mergeWh; trivial. Qed. Implicit Arguments stkSpacePrec_mergeWh1 [M sp size A]. Ltac stk_splitw := match goal with | |- _ ||- stkSpacePrec (?sp + 2) (?size + 2) => apply stkSpacePrec_mergeWh | |- _ ||- sconj (stkSpacePrec (?sp + 2) (?size +2)) _ => apply stkSpacePrec_mergeWh1 | |- _ ||- stkSpacePrec ?sp ?size => apply stkSpacePrec_mergeW; [ idtac | simpl; auto with arith; omega || fail 1 "Error: top address of stake should be >= 2" | simpl; auto with arith; omega || fail 1 "Error: size of stake should be >= 2" ] | |- _ ||- sconj (stkSpacePrec ?sp ?size) _ => apply stkSpacePrec_mergeW1; [ idtac | simpl; auto with arith; omega || fail 1 "Error: top address of stake should be >= 2" | simpl; auto with arith; omega || fail 1 "Error: size of stake should be >= 2" ] | _ => fail 1 "Error: cannot split the current goal" end. Ltac stk_splitwH H := match type of H with | _ ||- stkSpacePrec (?sp + 2) (?size + 2) => hyprep H (stkSpacePrec_splitW H) | _ ||- sconj (stkSpacePrec (?sp + 2) (?size +2)) _ => hyprep H (stkSpacePrec_splitW1 H) | _ ||- stkSpacePrec ?sp ?size => let Hx := fresh "H" in (assert (Hx : size >= 2); [ simpl; auto with arith; omega || fail 1 "Error: size of stake should be >= 2" | idtac]; hyprep H (stkSpacePrec_splitWh H Hx); clear Hx) | _ ||- sconj (stkSpacePrec ?sp ?size) _ => let Hx := fresh "H" in (assert (Hx : size >= 2); [ simpl; auto with arith; omega || fail 1 "Error: size of stake should be >= 2" | idtac]; hyprep H (stkSpacePrec_splitWh1 H Hx); clear Hx) | _ => fail 1 "Error: cannot split the current hypothesis" end. Lemma stkSpacePrec_split : forall M sp size k, M ||- stkSpacePrec (sp+k) (size+k) -> M ||- stkSpacePrec (sp+k) k *^* stkSpacePrec sp size. Proof. intros M sp size k H. substH H with (stkSpacePrec_split H). arith_rep (sp + k - k) with sp in H. Qed. Implicit Arguments stkSpacePrec_split [M sp size k]. Lemma stkSpacePrec_splith : forall M sp size k, M ||- stkSpacePrec sp size -> k <= size -> M ||- stkSpacePrec (sp - k) (size - k) *^* stkSpacePrec sp k. Proof. intros M sp size k H H0. assert (sp >= k). destruct H; omega. apply sconj_sym. arith_rep sp with (sp - k + k). arith_rep (sp - k + k - k) with (sp - k). apply stkSpacePrec_split; trivial. arith_rep (sp - k + k) with sp. arith_rep (size - k + k) with size. Qed. Implicit Arguments stkSpacePrec_splith [M sp size k]. Lemma stkSpacePrec_splith1 : forall M sp size k A, M ||- stkSpacePrec sp size *^* A -> k <= size -> M ||- stkSpacePrec sp k *^* stkSpacePrec (sp - k) (size - k) *^* A. Proof. intros M sp size k A H1 H2. destruct H1 as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. split_r. apply sconj_sym. apply stkSpacePrec_splith; trivial. Qed. Implicit Arguments stkSpacePrec_splith1 [M sp size k A]. Lemma stkSpacePrec_split1 : forall M sp size k A, M ||- stkSpacePrec (sp + k) (size + k) *^* A -> M ||- stkSpacePrec (sp+k) k *^* stkSpacePrec sp size *^* A. Proof. intros M sp size k A H. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. split_r. apply stkSpacePrec_split; trivial. Qed. Implicit Arguments stkSpacePrec_split1 [M sp size k A]. Lemma stkSpacePrec_merge : forall M sp size k, M ||- stkSpacePrec (sp - k) (size - k) *^* stkSpacePrec sp k -> sp >= k -> size >= k -> M ||- stkSpacePrec sp size. Proof. intros M sp size k H H0 H1. arith_rep sp with (sp - k + k). arith_rep size with (size - k + k). destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. assert (MemMod.disjUnion M2 M1 M). auto with PMap. destruct H. subst M. unfold mjudge. apply stkSpacePrec_merge. arith_rep (sp - k + k) with sp. arith_rep (sp - k + k - k) with (sp - k). Qed. Implicit Arguments stkSpacePrec_merge [M sp size k]. Lemma stkSpacePrec_merge1 : forall M sp size k A, M ||- stkSpacePrec (sp - k) (size - k) *^* stkSpacePrec sp k *^* A -> sp >= k -> size >= k -> M ||- stkSpacePrec sp size *^* A. Proof. intros M sp size k A H H0 H1. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. split_r. apply (stkSpacePrec_merge HM1 H0 H1); trivial. Qed. Implicit Arguments stkSpacePrec_merge1 [M sp size k A]. Lemma stkSpacePrec_mergeh : forall M sp size k, M ||- stkSpacePrec sp size *^* stkSpacePrec (sp+k) k -> M ||- stkSpacePrec (sp + k) (size + k). Proof. intros M sp size k H. unfold mjudge. substH H with (sconj_sym H). destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. destruct HJM; subst M. apply Assertion.stkSpacePrec_merge; trivial. arith_rep (sp + k - k) with sp. Qed. Implicit Arguments stkSpacePrec_mergeh [M sp size k]. Lemma stkSpacePrec_mergeh1 : forall M sp size k A, M ||- stkSpacePrec sp size *^* stkSpacePrec (sp+k) k *^* A -> M ||- stkSpacePrec (sp + k) (size + k) *^* A. Proof. intros M sp size k A H. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. split_r. apply stkSpacePrec_mergeh; trivial. Qed. Implicit Arguments stkSpacePrec_mergeh1 [M sp size k A]. Ltac stk_split k := match goal with | |- _ ||- stkSpacePrec (?sp + k) (?size + k) => apply stkSpacePrec_mergeh | |- _ ||- sconj (stkSpacePrec (?sp + k) (?size +k)) _ => apply stkSpacePrec_mergeh1 | |- _ ||- stkSpacePrec ?sp ?size => apply stkSpacePrec_merge with k; [ idtac | simpl; auto with arith; omega || fail 1 "Error: top address of stake should be >= k" | simpl; auto with arith; omega || fail 1 "Error: size of stake should be >= k" ] | |- _ ||- sconj (stkSpacePrec ?sp ?size) _ => apply stkSpacePrec_merge1 with k; [ idtac | simpl; auto with arith; omega || fail 1 "Error: top address of stake should be >= k" | simpl; auto with arith; omega || fail 1 "Error: size of stake should be >= k" ] | _ => fail 1 "Error: cannot split the current goal" end. Ltac stk_splitH H k := match type of H with | _ ||- stkSpacePrec (?sp + k) (?size + k) => hyprep H (stkSpacePrec_split H) | _ ||- sconj (stkSpacePrec (?sp + k) (?size + k)) _ => hyprep H (stkSpacePrec_split1 H) | _ ||- stkSpacePrec ?sp ?size => let Hx := fresh "H" in (assert (Hx : size >= k); [ simpl; auto with arith; omega || fail 1 "Error: size of stake should be >= k" | hyprep H (stkSpacePrec_splith H Hx); clear Hx]) | _ ||- sconj (stkSpacePrec ?sp ?size) _ => let Hx := fresh "H" in (assert (Hx : size >= k); [ simpl; auto with arith; omega || fail 1 "Error: size of stake should be >= k" | hyprep H (stkSpacePrec_splith1 H Hx); clear Hx]) | _ => fail 1 "Error: cannot split the current hypothesis" end. Tactic Notation "sep" "stksplit" := stk_splitw. Tactic Notation "sep" "stksplit" "in" hyp (H) := stk_splitwH H. Tactic Notation "sep" "stksplit" constr (k) := stk_split k. Tactic Notation "sep" "stksplit" constr (k) "in" hyp (H) := stk_splitH H k. (**************************************************************) (* memory re-order macth *) (**************************************************************) Ltac matchhp ig ih sg sh Hp := match goal with | |- _ ||- top => apply top_intro (* true *) | |- ?h ||- ?A => match type of Hp with | h ||- A => exact Hp (* assumption *) end | |- _ ||- unit => try (apply unit_intro) | |- _ ||- bang _ => apply bang_intro; auto | |- ?h ||- ptoxW ?l => (* match: ptoW |- ptoxW *) match type of Hp with | h ||- ptoW l ?v => apply (ptoW_ptoxW Hp); trivial; fail 1 "Error : unknown" end | |- _ ||- sconj _ unit => apply unit_intro_right; matchhp (pred ig) sh (pred sg) sh Hp | |- _ ||- sconj unit _ => apply unit_intro_left; matchhp (pred ig) sh (pred sg) sh Hp | |- _ ||- sconj (bang _) _ => apply bang_intro_left; [auto | matchhp (pred ig) sh (pred sg) sh Hp] | |- _ ||- sconj _ (bang _) => apply bang_intro_right; [auto | matchhp (pred ig) sh (pred sg) sh Hp] (* | [NI : ~ set_in ?x ?s |- *) (* ?h ||- fas ?P (set_add ?x ?s)] => apply fas_intro1; *) (* [assocr; matchhp (S ig) sh (S sg) sh | assumption] *) (* | [NI : ~ set_in ?x ?s |- *) (* ?h ||- sconj (fas ?P (set_add ?x ?s)) _] => apply fas_intro; *) (* [assocr; matchhp (S ig) sh (S sg) sh | assumption] *) | |- _ ||- sconj _ (bang _) => apply bang_intro_right; [auto | matchhp (pred ig) sh (pred sg) sh Hp] (* | |- ?h ||- sconj (ptoW ?l ?v) ?C => (\* match left pto *\) *) (* match type of Hp with *) (* | h ||- sconj (ptoW ptoW l ?v2) ?B => *) (* let h1 := fresh "h" in *) (* (apply (sconj_mono_left Hp); [] *) (* (clear h Hp; intros h Hp) || (clear Hp; intros h1 Hp); *) (* assocl Hp; assocr; *) (* matchhp (pred ig) (pred sh) (pred sg) (pred sh) Hp) *) (* end *) | |- ?h ||- sconj ?A ?C => (* match left *) match type of Hp with | h ||- sconj A ?B => let h1 := fresh "h" in (apply (sconj_mono_right Hp); (clear h Hp; intros h Hp) || (clear Hp; intros h1 Hp); assocl Hp; assocr; matchhp (pred ig) (pred sh) (pred sg) (pred sh) Hp) end | |- ?h ||- sconj (ptoxW ?l) ?C => (* match left: ptoW |- ptoxW *) match type of Hp with | h ||- sconj (ptoW l ?v) ?B => let h1 := fresh "h" in (apply (sconj_mono (A':=ptoxW l)(B':=C) Hp); (clear h Hp; intros h Hp) || (clear Hp; intros h1 Hp); [ apply (ptoW_ptoxW Hp); fail 1 "Error : unknown" | assocl Hp; assocr; matchhp (pred ig) (pred sh) (pred sg) (pred sh) Hp ]) end | |- ?h ||- sconj ?C ?B => (* match right *) match type of Hp with | h ||- sconj ?A B => let h' := fresh "h" in (apply (sconj_mono_left Hp); (clear h Hp; intros h Hp) || (clear Hp; intros h' Hp); assocl Hp; assocr; matchhp (pred ig) (pred sh) (pred sg) (pred sh) Hp) end | |- ?h ||- sconj ?C ?D => (* shift *) match type of Hp with | h ||- sconj ?A ?B => match eval compute in ig with | O => (* no more shift on goal *) match eval compute in ih with | O => idtac (* finished *) | _ => (* shift hyp, continue with matching *) hyprep Hp (sconj_sym Hp); assocl Hp; matchhp sg (pred ih) sg sh Hp end | _ => (* shift goal *) apply sconj_sym; assocr; matchhp (pred ig) ih sg sh Hp end end | _ => match type of Hp with | _ ||- sconj _ unit => hyprep Hp (unit_elim_right Hp); matchhp ig (pred sh) sg (pred sh) Hp | _ ||- sconj unit _ => hyprep Hp (unit_elim_left Hp); matchhp ig (pred sh) sg (pred sh) Hp | _ => idtac end (* | _ => idtac *) end. Ltac simplsep sizeg sizeh Hp := match type of Hp with | ?h ||- _ => match goal with | |- h ||- _ => assocl Hp; assocr; matchhp sizeg sizeh sizeg sizeh Hp end end. Tactic Notation "sep" "matchH" hyp (H) "with" constr (size) := simplsep size size H. (**************************************************************) (* memory macth *) (**************************************************************) Ltac sep_trivial := match goal with | |- emp ||- unit => apply unit_intro; trivial | |- ?M ||- top => apply top_intro; trivial | H: ?M ||- pto ?l ?v |- ?M ||- ptox ?l => apply pto_ptox with v; trivial | H : ?M ||- stkSpacePrec ?sp 2 |- ?M ||- ptoxW (?sp-2) => apply (stkSpacePrec_ptoxW H); trivial | H : ?M ||- ptoxW ?l |- ?M ||- stkSpacePrec (?l+2) 2 => apply (ptoxW_stkSpacePrec H); trivial | H : ?M ||- (stkSpacePrec ?sp ?size) |- ?M ||- stkSpace ?sp ?size => apply (stkSpacePrec_stkSpace H); trivial | H : ?M ||- sconj (stkSpacePrec ?sp ?size) _ |- ?M ||- stkSpace ?sp ?size => apply (stkSpacePrec_stkSpace1 H); trivial | H : ?M ||- sconj (ptoW ?l ?v) _ |- ?M ||- leadsToW ?l ?v => (* match: ptoW |- leadsToW *) apply (ptoW_leadsToW1 H); trivial | H : ?M ||- sconj (ptoW ?l ?v) _ |- ?M ||- leadsToxW ?l => (* match: ptoW, ptoxW |- leadsToxW *) apply (ptoW_leadsToxW1 H); trivial | H : ?M ||- sconj (ptoxW ?l) _ |- ?M ||- leadsToxW ?l => (* match: ptoW, ptoxW |- leadsToxW *) apply (ptoxW_leadsToxW1 H); trivial | H: ?M ||- ptoW ?l ?v |- ?M ||- ptoxW ?l => apply ptoW_ptoxW with v; trivial | H: ?M ||- leadsToW ?l ?v |- ?M ||- leadsToxW ?l => apply leadsToW_leadsToxW with v; trivial | H: ?M ||- ?A |- ?M ||- ?B => auto with splogic; fail | |- ?A ==> ?B => intros; auto with splogic; fail | _ => trivial end. Tactic Notation "sep" "trivial" := sep_trivial. Ltac sep_simpl := match goal with (* unit *) | H : ?M ||- unit ** ?A |- _ => hyprep H (unit_elim_left H) | |- ?M ||- unit ** ?A => apply unit_intro_left | H : ?M ||- ?A ** unit |- _ => hyprep H (unit_elim_right H) | |- ?M ||- ?A ** unit => apply unit_intro_right (* stkSpacePrec empty *) | H : ?M ||- (stkSpacePrec ?sp 0) ** ?A |- _ => hyprep H (stkSpacePrec_unit1 H) | H : ?M ||- stkSpacePrec ?sp 0 |- _ => hyprep H (stkSpacePrec_unit H) | |- ?M ||- sconj (stkSpacePrec ?sp 0) _ => apply stkSpacePrec_unit1 | |- ?M ||- stkSpacePrec ?sp 0 => apply stkSpacePrec_unit | _ => trivial end. Tactic Notation "sep" "simpl" := sep_simpl. (* obselete *) Ltac sep_elim_left H := match type of H with | ?M ||- unit => hyprep H (unit_elim H); subst M | ?M ||- (ptoxW ?l) => let v:= fresh "v" in (hyprep H (ptoxW_ptoW H); destruct H as [v H]) | ?M ||- sconj (ptoxW ?l) ?A => let v:= fresh "v" in (hyprep H (ptoxW_ptoW1 H); destruct H as [v H]) | _ => fail 1 "Format Error : M |- l |-> _ * _ " end. Tactic Notation "sep" "elim_left" hyp (H) := sep_elim_left H. (* new *) Ltac sep_match_left H := match goal with | |- ?M ||- sconj ?A' ?B' => match type of H with | M ||- sconj ?A ?B => let M1 := fresh "M" in (apply (sconj_mono (A':=A') (B':=B') H); (clear M H; intros M H; sep_trivial) || (clear H; intros M1 H; sep_trivial)) end end. Tactic Notation "sep" "match_left" hyp (H) := sep_match_left H. Ltac sep_subst_left A := match goal with | |- ?M ||- ?A' ** ?B' => apply sconj_mono_left with A; [ idtac | sep_trivial ] end. Ltac sep_subst_leftH H A' := match type of H with | ?M ||- ?A ** ?B => let Hx := fresh "Hx" in (assert (Hx : A ==> A'); [sep_trivial | hyprep H (sconj_mono_left H (A':=A') Hx); clear Hx]) end. Tactic Notation "sep" "subst_left" "with" constr (A) "in" hyp (H) := sep_subst_leftH H A. Tactic Notation "sep" "subst_left" "with" constr (A) := sep_subst_left A. (* new *) Ltac sep_elim H := match type of H with | ?M ||- unit => hyprep H (unit_elim H); subst M | ?M ||- unit ** ?A => hyprep H (unit_elim_left H) | ?M ||- (ptoW ?l ?v) => hyprep H (ptoW_pto H) | ?M ||- (ptoW ?l ?v) ** ?A => hyprep H (ptoW_pto1 H) | ?M ||- (ptoxW ?l) => let v:= fresh "v" in (hyprep H (ptoxW_ptoW H); destruct H as [v H]) | ?M ||- sconj (ptoxW ?l) ?A => let v:= fresh "v" in (hyprep H (ptoxW_ptoW1 H); destruct H as [v H]) | ?M ||- (leadsToxW ?l) => let v:= fresh "v" in (hyprep H (leadsToxW_leadsToW H); destruct H as [v H]) | _ => fail 1 "Format Error : M |- l |-> _ * _ " end. Tactic Notation "sep" "elim" hyp (H) := sep_elim H. Tactic Notation "sep" "destruct" hyp (H) := sep_elim H. Ltac sep_exists_left v := match goal with | |- ?M ||- sconj (ptoxW ?l) ?A => apply ptoW_ptoxW1 with v | |- ?M ||- ptoxW ?l => apply ptoW_ptoxW with v | |- ?M ||- leadsToxW ?l => apply leadsToW_leadsToxW with v | _ => fail 1 "Format Error : M |- l |-> _ * _ " end. Tactic Notation "sep" "exists_left" constr (v) := sep_exists_left v. Tactic Notation "sep" "exists" constr (v) := sep_exists_left v. (* some tactics added by Xinyu *) Ltac sep_leqv_subst m := match goal with | |- ?M ||- ?A *^* ?B => let Hx := fresh in (assert (Hx : leqvM m A); [(auto || idtac) | (apply (leqvM_app_subst (H := M) (mstar_eqv_subst_left B Hx)); auto; clear Hx) || fail 1 "failed" ]) | _ => idtac end. Tactic Notation "sep" "leqv_subst" "with" constr (m) := sep_leqv_subst m. Ltac sep_leqv_substH H m := match type of H with | ?M ||- ?A *^* ?B => let Hx := fresh in (assert (Hx : leqvM A m); [(auto || idtac) | hypreplace H (leqvM_app_subst (mstar_eqv_subst_left B Hx) H)]) | _ => idtac end. Tactic Notation "sep" "leqv_subst" "in" hyp (H) "with" constr (m) := sep_leqv_substH H m. Ltac sep_weaker_subst H m := match type of H with | ?M ||- ?A *^* ?B => let Hx := fresh in (assert (Hx : forall H, A H -> m H); [(auto || idtac) | hypreplace H (mstar_subst_weaker_left H Hx)]) | _ => idtac end. Tactic Notation "sep" "weaker_subst" "in" hyp (H) "with" constr (m) := sep_weaker_subst H m. Lemma stkSpace_sp_ge_sz: forall M sp sz, M ||- stkSpace sp sz -> sp >= sz. Proof. intros. sep off. unfold stkSpace in H. inversion H; auto. Qed. Lemma stkSpace_sp_ge_sz1: forall M sp sz B, M ||- stkSpace sp sz *^* B -> sp >= sz. Proof. intros. unfold mstar in H. sep off. InvertAll. apply stkSpace_sp_ge_sz with x; auto. Qed. Lemma stkSpacePrec_sp_ge_sz: forall M sp sz, M ||- stkSpacePrec sp sz -> sp >= sz. Proof. intros. sep off. unfold stkSpacePrec in H. inversion H; auto. Qed. Lemma stkSpacePrec_sp_ge_sz1: forall M sp sz B, M ||- stkSpacePrec sp sz *^* B -> sp >= sz. Proof. intros. sep off. unfold mstar in H. InvertAll. apply stkSpacePrec_sp_ge_sz with x; auto. Qed. Ltac sep_update2 := match goal with | |- MemUpdW ?M ?l ?v ?junk ||- ptoW ?l ?v => apply ptoxW_update | |- MemUpdW ?M ?l ?v ?junk ||- ptoxW ?l => apply ptoW_ptoxW with v; apply ptoxW_update | |- MemUpdW ?M ?l ?v ?junk ||- (ptoW ?l ?v) *^* ?B => apply ptoxW_update1 | |- MemUpdW ?M ?l ?v ?junk ||- (ptoxW ?l) *^* ?B => apply ptoW_ptoxW1 with v; apply ptoxW_update1 | |- MemUpdW ?M ?l ?v ?junk ||- (leadsToW ?l ?v) => apply leadsToxW_update | |- MemUpdW ?M ?l ?v ?junk ||- (leadsToxW ?l) => apply leadsToW_leadsToxW with v; apply leadsToxW_update | |- MemMod.put ?M ?l ?v ||- (pto ?l ?v) *^* ?B => apply ptox_update1 | _ => fail 1 "Error: format" end. Tactic Notation "sep" "upd2" := sep_update2. Lemma ptoW_precise: forall l v, precise (l |->w v). Proof. intros. unfold precise. intros. assert (exists x, M1 ||- l |-> v *^* l + 1 |-> x). apply ptoW_elim; auto. assert (exists x, M2 ||- l |-> v *^* l + 1 |-> x). apply ptoW_elim; auto. inversion_clear H3. inversion_clear H4. assert (((l |-> v) *^* (l + 1 |-> x) *^* mTrue) M). assert (exists M1', MemMod.disjUnion M1 M1' M). auto with PMap. inversion_clear H4. exists M1. exists x1. split; auto. split; auto. unfold top. auto. assert (((l |-> v) *^* (l + 1 |-> x0) *^* mTrue) M). assert (exists M2', MemMod.disjUnion M2 M2' M). auto with PMap. inversion_clear H6. exists M2. exists x1. split; auto. split; auto. unfold top. auto. assert (x = x0). sep on. sep lift 1 in H6. sep lift 1 in H4. apply pto_pto_eq1 with M (l+1) (sconj top (l |-> v)) (sconj top (l |-> v)); auto. subst x0. sep off. assert (precise (sconj (l |-> v) (l + 1 |-> x))). apply mstar_presv_prec. apply pto_precise. apply pto_precise. unfold precise in H7. apply H7 with M; auto. Qed. Lemma ptoW_indom1: forall M l v A, (l |->w v *^* A) M -> MemMod.in_dom l M /\ MemMod.in_dom (l+1) M. Proof. intros. unfold mstar in H. InvertAll. assert (MemMod.in_dom l x /\ MemMod.in_dom (l+1) x). apply ptoW_indom with v; auto. inversion_clear H1. inversion_clear H0. subst M. split; apply MemMod.merge_presv_indom_left; auto. Qed. Lemma ptoxW_indom1: forall M l A, (l |->w_ *^* A) M -> MemMod.in_dom l M /\ MemMod.in_dom (l+1) M. Proof. intros. assert (exists v, M ||- (l |->w v *^* A)). apply ptoxW_ptoW1. auto. inversion_clear H0. apply ptoW_indom1 with x A; auto. Qed. coq/OpSem_Lemmas.v0000644000107400000620000005677711000223177013604 0ustar shaosystems(****** Operational Semantics ******) Require Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Operational_Semantics. Lemma itr_enabled_dec : forall S, itr_enabled S \/ ~ itr_enabled S. Proof. intros [[[M R] fl] isr]. generalize (refl_equal (fl _IF)); pattern fl at 1; destruct (fl _IF); intro Hfl. destruct isr. right. intros [Hx Hy]. simplS in * . discriminate. left. unfold itr_enabled; simplS. auto. right. intros [Hx Hy]. simplS in * . rewrite Hfl in Hx. discriminate. Qed. (********************************************************** nextS nextPC Lemmas ***********************************************************) Lemma nextS_inversion : forall pc c M R fl isr M' R' fl' isr', nextS pc c (M, R, fl, isr) (M', R', fl', isr') -> match c with | comms _retw => (M=M') /\ (exists pc', leadsToW (R SP) pc' M /\ R' = RF_update R SP (R SP + 2)) /\ fl=fl' /\ isr=isr' | comms (_jmp f) => (M'=M) /\ (R'=R)/\ fl'=fl /\ isr'=isr | comml (_cli) => (M'=M) /\ (R'=R)/\ fl'=(Clear_Flag fl _IF) /\ isr'=isr | comml (_sti) => (M'=M) /\ (R'=R)/\ fl'=(Set_Flag fl _IF) /\ isr'=isr | comml (_call f) => (R SP >= 2 /\ leadsToBlk (R SP - 2) 2 M /\ MemUpd16 M (R SP - 2) (pc+1) M') /\ (R'= RF_update R SP (R SP - 2))/\ fl=fl' /\ isr=isr' | comml (_jne f) => (M'=M) /\ (R'=R)/\ fl'=fl /\ isr'=isr | comml (_movwp o r) => (M'=M) /\ (R'=RF_update R r (opr_eval R o)) /\ fl'=fl /\ isr'=isr | comml (_movwld a r) => (M'=M) /\ (exists x, leadsToW (addr_eval R a) x M /\ (R'=RF_update R r x)) /\ fl'=fl /\ isr'=isr | comml (_movwst o a) => (leadsToxW (addr_eval R a) M /\ MemUpd16 M (addr_eval R a) (opr_eval R o) M') /\ R'=R /\ fl'=fl /\ isr'=isr | comml (_pushwp o) => (R SP >= 2 /\ leadsToBlk (R SP - 2) 2 M /\ MemUpd16 M (R SP -2) (opr_eval R o) M') /\ R' = RF_update R SP (R SP -2) /\ fl' = fl /\ isr'=isr | comml (_pushwm a) => (exists x, leadsToW (addr_eval R a) x M /\ R SP >= 2 /\ leadsToBlk (R SP - 2) 2 M /\ MemUpd16 M (R SP -2) x M') /\ R' = RF_update R SP (R SP -2) /\ fl' = fl /\ isr'=isr | comml (_pushfw) => (R SP >= 2 /\ leadsToBlk (R SP - 2) 2 M /\ MemUpd16 M (R SP -2) (FR2nat fl) M') /\ R' = RF_update R SP (R SP -2) /\ fl' = fl /\ isr'=isr | comml (_popw r) => (M'=M) /\ (exists x, leadsToW (R SP) x M /\ R' = RF_update (RF_update R SP (R SP +2)) r x) /\ fl' = fl /\ isr'=isr | comml _popfw => (M'=M) /\ (R' = RF_update R SP (R SP +2)) /\ (exists flnum, leadsToW (R SP) flnum M /\ fl' = nat2FR flnum) /\ isr'=isr | comml (_cmpw o r) => (M'=M)/\(R'=R) /\ ((opr_eval R o = R r) /\ (fl' = Set_Flag fl _ZF) \/ (opr_eval R o <> R r) /\ (fl' = Clear_Flag fl _ZF)) /\ isr'=isr | comml (_addw o r) => (M'=M)/\(R'=RF_update R r (opr_eval R o + R r)) /\ (trash_fl fl fl' _ZF) /\ isr'=isr | comml (_subw o r) => (M'=M)/\(R'=RF_update R r (R r - opr_eval R o)) /\ (trash_fl fl fl' _ZF) /\ isr'=isr | comml _outb_eoi => (M'=M) /\ (R'=R /\ R AX = 32 /\ R DX = 32) /\ (fl'=fl) /\ (isr'=false) | comms (_iret) => (M'=M /\ leadsToBlk (R SP) 6 M) /\ R'=RF_update R SP (R SP + 6) /\ (exists flnum, fl' = nat2FR flnum /\ leadsToW (R SP + 4) flnum M) /\ isr' = isr end. Proof. induction c as [ i | s]; [destruct i | destruct s]; trivial. (* case c = cli *) intros. inversion_clear H; auto. (* case c = sti *) intros. inversion_clear H; auto. (* case c = _call f *) intros. inversion_clear H. destruct ((fun x => H0) 0). destruct H1. destruct H. subst; auto. (* case c = jne f *) intros. inversion_clear H; auto. (* case c = movwp o r *) intros. inversion_clear H; subst; auto. (* case c = movwld a r *) intros. inversion_clear H. subst. split_l. split. exists x; split_lr. split_lr. (* case c = movwst o a *) intros. inversion_clear H; subst; auto. (* case c = pushwp o *) intros. inversion_clear H. inversion_clear H1. inversion_clear H. subst. destruct H2. auto. (* case c = pushwm a *) intros. inversion_clear H. inversion_clear H2. inversion_clear H. subst. destruct H3. split. exists x. split_l; split_l; split_lr. split_l; split_lr. (* case c = pushfw *) intros. inversion_clear H. inversion_clear H0. inversion_clear H. destruct H1. auto. (* case c = popw r *) intros. inversion_clear H. inversion_clear H0. subst. split_l. split. exists x. split_lr. split_lr. (* case c = popfw *) intros. inversion_clear H. inversion_clear H0. subst. split_l. split_l. split_r. exists flnum; split_lr. (* case c = cmpw o r *) intros. inversion_clear H. destruct H0. destruct H. subst. split_l. split_l. split_r. left; split_lr. destruct H. subst. split_l. split_l. split_r. right; split_lr. (* case c = addw o r *) intros. inversion_clear H. subst. split_l. split_l. split_lr. (* case c = subw o r *) intros. inversion_clear H. subst. split_l. split_l. split_lr. (* case c = outb_eoi *) intros. inversion_clear H. split_l. split. split_l; split_lr. split_lr. (* case c = jmp f *) intros. inversion_clear H. split_l. split_l; split_lr. (* case c = _retw *) intros. inversion H; auto. (* case c = iret *) intros. inversion_clear H; subst; intuition. exists flnum; auto. Qed. Implicit Arguments nextS_inversion [pc c M R fl isr M' R' fl' isr']. Lemma nextS_injection : forall c pc M R fl isr M' R' fl' isr' M'' R'' fl'' isr'', nextS pc c (M,R,fl,isr) (M',R',fl',isr') -> nextS pc c (M,R,fl,isr) (M'',R'',fl'',isr'') -> match c with | comml (_call f) => (MemUpd16 M (R SP-2) (pc+1) M'' /\ R'=R'')/\(fl'=fl''/\isr'=isr'') | comml (_movwst o a) => (MemUpd16 M (addr_eval R a) (opr_eval R o) M'' /\ R'=R'')/\(fl'=fl''/\isr'=isr'') | comml (_pushwp o) => (MemUpd16 M (R SP-2) (opr_eval R o) M'' /\ R'=R'')/\(fl'=fl''/\isr'=isr'') | comml (_pushwm a) => ((exists x, leadsToW (addr_eval R a) x M /\ MemUpd16 M (R SP-2) x M'') /\ R'=R'') /\(fl'=fl''/\isr'=isr'') | comml (_pushfw) => (MemUpd16 M (R SP-2) (FR2nat fl) M'' /\ R'=R'') /\(fl'=fl''/\isr'=isr'') | comml (_addw o r) => (M'=M''/\R'=R'')/\ (trash_fl fl fl'' _ZF /\isr'=isr'') | comml (_subw o r) => (M'=M''/\R'=R'')/\ (trash_fl fl fl'' _ZF /\isr'=isr'') | _ => (M'=M''/\R'=R'')/\(fl'=fl''/\isr'=isr'') end. Proof. intros c pc M R fl isr M' R' fl' isr' M'' R'' fl'' isr''. intros HnextS' HnextS''. destruct c as [i | i]; destruct i; inversion HnextS'; subst; inversion HnextS''; subst; try (split; split_lr; fail). inversion H2; inversion H3. destruct H0; destruct H4. subst; split; split_lr. rewrite (leadsToW_unique H11 H12); split;split_lr. inversion H10; inversion H11. destruct H0; destruct H2. subst; split; split_lr. inversion H11; inversion H13. destruct H0; destruct H2. subst. assert (Heq := leadsToW_unique H10 H12). subst x0. split;split_lr. exists x; split_lr. inversion H2; inversion H3. destruct H0; destruct H4. subst; split; split_lr. inversion H4; inversion H3. subst. assert (Heq := leadsToW_unique H H1); subst. split; split_lr. inversion H4; inversion H3. subst. assert (Heq := leadsToW_unique H H1); subst. split; split_lr. destruct H2 as [Hx | Hx]; destruct H1 as [Hy | Hy]; destruct Hx; destruct Hy; subst; split; split_lr; contradiction. destruct H3; destruct H2. inversion H; inversion H0. subst. assert (Heq := leadsToW_unique H1 H3); subst. split; split_lr. rewrite (leadsToW_unique H10 H12); split;split_lr. Qed. Implicit Arguments nextS_injection [c pc M R fl isr M' R' fl' isr' M'' R'' fl'' isr'']. (******************************************************) Lemma nextPC_inversion : forall pc c M R fl pc', nextPC c M R fl pc pc' -> match c with | comml (_call f) => pc' = f | comms _retw => leadsToW (R SP) pc' M | comms _iret => leadsToW (R SP) pc' M /\ leadsToBlk (R SP) 6 M | comms (_jmp f) => pc' = f | comml (_jne f) => (fl _ZF = true -> pc'=pc+1) /\ (fl _ZF = false -> pc'=f) | comml _ => pc' = pc+1 end. Proof. intros pc c M R fl pc' H. destruct c as [i | i]; destruct i; inversion H; subst; auto. split; intro; trivial. rewrite H1 in H0; discriminate. split; intro; trivial. rewrite H1 in H0; discriminate. Qed. Implicit Arguments nextPC_inversion [pc c M R fl pc']. Lemma nextPC_injection : forall c M R fl pc pc' pc'', nextPC c M R fl pc pc' -> nextPC c M R fl pc pc'' -> pc' = pc''. Proof. intros c M R fl pc pc' pc'' HnextPC' HnextPC''. destruct c as [i | i]; destruct i; inversion HnextPC'; subst; inversion HnextPC''; subst; trivial. rewrite H0 in H1; discriminate. rewrite H0 in H1; discriminate. rewrite (leadsToW_unique H0 H1); trivial. rewrite (leadsToW_unique H1 H3); trivial. Qed. Implicit Arguments nextPC_injection [c M R fl pc pc' pc'']. (******************************************************) Lemma nextS_Mono : forall pc c M1 M R fl isr M1' R' fl' isr' M2, MemMod.disjUnion M1 M2 M -> nextS pc c (M1, R, fl, isr) (M1', R', fl', isr') -> exists M', MemMod.disjUnion M1' M2 M' /\ nextS pc c (M, R, fl, isr) (M', R', fl', isr'). Proof. intros. induction c as [i|i]; destruct i; destruct (nextS_inversion H0) as [HM [HR [Hfl Hisr]]]; subst. exists M; split_l. constructor. exists M; split_l. constructor. unfold stkSpace in HM. exists (MemMod.merge M1' M2). destruct HM as [H1 [H2 H3]]. destruct (leadsToBlk_MemUpd16_Mono H H2 H3) as [H4 [H5 H6]]. auto with arith. split_l. constructor. unfold pushW. unfold stkSpace. split. split_lr. eapply leadsToBlk_Mono; eauto. split. destruct (leadsToBlk_MemUpd16_Mono H H2 H3) as [H7 [H8 H9]]; auto. trivial. exists M; split_l. constructor. exists M; split_l. destruct (nextS_inversion H0) as [HM [HR [Hfl Hisr]]]. eapply nextS_movwp; eauto. destruct HR. exists M; split_l. destruct H1. eapply nextS_movwld; eauto. eapply leadsToW_Mono; eauto. exists (MemMod.merge M1' M2). destruct HM as [H1 H2]. destruct (leadsToxW_MemUpd16_Mono H H1 H2). split_l. eapply nextS_movwst; eauto. eapply leadsToxW_Mono; eauto. exists (MemMod.merge M1' M2). destruct HM as [H1 [H2 H3]]. destruct (leadsToBlk_MemUpd16_Mono H H2 H3) as [H4 [H5 H6]]. auto. split_l. eapply nextS_pushwp; eauto. split. split_lr. eapply leadsToBlk_Mono; eauto. split_lr. exists (MemMod.merge M1' M2). destruct HM as [x [H1 [H2 [H3 H4]]]]. destruct (leadsToBlk_MemUpd16_Mono H H3 H4) as [H5 [H6 H7]]. auto. split_l. apply nextS_pushwm with (addr_eval R a) x; eauto. eapply leadsToW_Mono; eauto. split. split_lr. eapply leadsToBlk_Mono; eauto. split_lr. exists (MemMod.merge M1' M2). destruct HM as [H1 [H2 H3]]. destruct (leadsToBlk_MemUpd16_Mono H H2 H3) as [H4 [H5 H6]]. auto. split_l. eapply nextS_pushfw; eauto. split. split_lr. eapply leadsToBlk_Mono; eauto. split_lr. exists M; split_l. destruct HR as [x [H1 H2]]. eapply nextS_popw; eauto. split_r. eapply leadsToW_Mono; eauto. exists M; split_l. destruct Hfl as [x [H1 H2]]. eapply nextS_popfw; eauto. split_r. eapply leadsToW_Mono; eauto. exists M; split_l. eapply nextS_cmpw; eauto. exists M; split_l. eapply nextS_addw; eauto. exists M; split_l. eapply nextS_subw; eauto. exists M; split_l. destruct HR as [H1 [H2 H3]]; subst. eapply nextS_EOI; eauto. exists M; split_l. eapply nextS_jmp; eauto. exists M; split_l. eapply nextS_retw; eauto. destruct HR. exists x; unfold popW; auto. destruct H1; split_r. eapply leadsToW_Mono; eauto. destruct HM. subst. exists M; split_l. destruct Hfl as [fln [H1 H3]]. eapply nextS_iret; eauto. replace (R SP + 0) with (R SP); auto. eapply leadsToBlk_Mono; eauto. replace (R SP + 0) with (R SP); auto. eapply leadsToW_Mono; eauto. Qed. Implicit Arguments nextS_Mono [pc c M1 M R fl isr M1' R' fl' isr' M2]. Require Omega. Lemma itr_nextS_Mono : forall pc M1 M2 M R fl isr M1' R' fl' isr', MemMod.disjUnion M1 M2 M -> itr_nextS pc (M1, R, fl, isr) (M1',R',fl',isr') -> exists M' : MemMod.Map, MemMod.disjUnion M1' M2 M' /\ itr_nextS pc (M, R, fl, isr) (M', R', fl', isr'). Proof. intros pc M1 M2 M R fl isr M1' R' fl' isr'. unfold itr_nextS. intros HJM HnextS. exists (MemMod.merge M1' M2). destruct HnextS as [sp [fln [cs [M1'' [M1''' HnextS]]]]]. destruct HnextS as [Hsp [Hk [HR' [Hfl' [Hisr' [Hfln [Hupd [Hupd' Hupd'']]]]]]]]. subst sp. destruct ((fun x => Hk) 0) as [Hsp Hlds]. destruct (leadsToBlk_MemUpd16_Mono HJM Hlds Hupd) as [HJ'' [Hlds'' HM1'']]. auto with arith. assert (Hldsx : leadsToBlk (R SP - 4) (6 - 2) M1''). replace (R SP - 4) with (R SP - 6 + 2); [ idtac | omega]. apply leadsToBlk_shrink_low; auto with arith. assert (Hldsy : leadsToBlk (R SP - 4) 4 M1''). apply leadsToBlk_shrink_high with 4; auto with arith. destruct (leadsToBlk_MemUpd16_Mono HJ'' Hldsy Hupd') as [HJ''' [Hlds''' HM1''']]. auto with arith. clear Hldsx Hldsy. assert (Hldsx : leadsToBlk (R SP - 2) (4 - 2) M1'''). replace (R SP - 2) with (R SP - 4 + 2); [ idtac | omega]. apply leadsToBlk_shrink_low; auto with arith. destruct (leadsToBlk_MemUpd16_Mono HJ''' Hldsx Hupd'') as [HJ' [Hlds' HM1']]. auto with arith. split_l. exists (R SP);exists fln; exists cs. exists (MemMod.merge M1'' M2); exists (MemMod.merge M1''' M2). split_l. split. eapply stkSpace_Mono; eauto. split_l; split_l; split_l; split_l. split_l; split_lr. Qed. Implicit Arguments itr_nextS_Mono [pc M1 M2 M R fl isr M1' R' fl' isr']. (**********************************************) Lemma nextS_DMono : forall pc c M1 M2 M R fl isr M' R' fl' isr' S0, MemMod.disjUnion M1 M2 M -> nextS pc c (M1, R, fl, isr) S0 -> nextS pc c (M, R, fl, isr) (M', R', fl', isr') -> exists M1', MemMod.disjUnion M1' M2 M' /\ nextS pc c (M1, R, fl, isr) (M1', R', fl', isr'). Proof. intros pc c M1 M2 M R fl isr M' R' fl' isr' S0. intros HJM HnextS0 HnextS. destruct S0 as [[[M10 R0] fl0] isr0]. induction c as [i|i]; destruct i; (destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]; subst); (destruct (nextS_inversion HnextS0) as [HM0 [HR0 [Hfl0 Hisr0]]]; subst). (* case i = cli *) exists M1; split_l. constructor. (* case i = sti *) exists M1; split_l. constructor. (* case i = call f *) destruct HM as [Hsp [HlM HM]]. destruct HM0 as [Hsp'[HlM1 HM1]]. destruct (leadsToBlk_MemUpd16_DMono HJM HlM1 HM) as [M1' [HJM' H3]]. exists M1'; split_l. constructor; unfold pushW, stkSpace; auto. (* case i = jne f *) exists M1; split_l. constructor. (* case i = movwp o r *) exists M1; split_l. econstructor; eauto. (* case i = movwld a r *) exists M1; split_l. destruct HR as [x [H1 H2]]. destruct HR0 as [x0 [H3 H4]]. assert (leadsToW (addr_eval R a) x M1). assert (H:=leadsToW_Mono HJM H3). assert (Heq := leadsToW_unique H1 H). subst x0. trivial. apply nextS_movwld with (addr_eval R a) x; trivial. (* case i = movwst o a *) destruct HM as [H1 H2]. destruct HM0 as [H3 H4]. destruct (leadsToxW_MemUpd16_DMono HJM H3 H2) as [M1' [HJM' H5]]. exists M1'; split_l. eapply nextS_movwst; eauto. (* case i = pushwp o *) destruct HM as [Hsp [H1 H2]]. destruct HM0 as [Hsp' [H3 H4]]. destruct (leadsToBlk_MemUpd16_DMono HJM H3 H2) as [M1' [HJM' H5]]. exists M1'; split_l. apply nextS_pushwp with (opr_eval R o); trivial. unfold pushW, stkSpace. split. split_lr. split_lr. (* case i = pushwm a *) destruct HM as [x [H1 [H2 [H3 H4]]]]. destruct HM0 as [x0 [H10 [H20 [H30 H40]]]]. assert (Heq := leadsToW_unique H1 (leadsToW_Mono HJM H10)). subst x0. destruct (leadsToBlk_MemUpd16_DMono HJM H30 H4) as [M1' [HJM' H8]]. exists M1'; split_l. apply nextS_pushwm with (addr_eval R a) x; trivial. unfold pushW, stkSpace. split. split_lr. split_lr. (* case i = pushfw *) destruct HM as [H1 [H2 H3]]. destruct HM0 as [H10 [H20 H30]]. destruct (leadsToBlk_MemUpd16_DMono HJM H20 H3) as [M1' [HJM' H8]]. exists M1'; split_l. apply nextS_pushfw. unfold pushW, stkSpace. split. split_lr. split_lr. (* case i = popw r *) destruct HR as [x [H1 H2]]. destruct HR0 as [x0 [H10 H20]]. assert (Heq := leadsToW_unique H1 (leadsToW_Mono HJM H10)). subst. exists M1; split_l. apply nextS_popw with (RF_update R SP (R SP + 2)) x0; trivial. unfold popW; auto. (* case i = popfw *) destruct Hfl as [x [H1 H2]]. destruct Hfl0 as [x0 [H10 H20]]. assert (Heq := leadsToW_unique H1 (leadsToW_Mono HJM H10)). subst. exists M1; split_l. apply nextS_popfw with x0; trivial. unfold popW; auto. (* case i = cmpw o r *) exists M1; split_l. apply nextS_cmpw; trivial. (* case i = addw o r *) exists M1; split_l. eapply nextS_addw; eauto. (* case i = subw o r *) exists M1; split_l. eapply nextS_subw; eauto. (* case i = outb eoi *) exists M1; split_l. destruct HR as [H1 [H2 H3]]. destruct HR0 as [H10 [H20 H30]]. subst. eapply nextS_EOI; eauto. (* case i = jmp f *) exists M1; split_l. eapply nextS_jmp; eauto. (* case i = retw *) destruct HR as [pcx [H1 H2]]. destruct HR0 as [pcx0 [H10 H20]]. exists M10; split_l. eapply nextS_retw; eauto. assert (Heq := leadsToW_unique H1 (leadsToW_Mono HJM H10)). subst. exists pcx0; unfold popW, stkSpace; auto. (* case i = iret *) destruct HM as [H1 H2]. destruct HM0 as [H10 H20]. destruct Hfl as [x [Hfl H3]]. destruct Hfl0 as [x0 [Hfl0 H30]]. subst. exists M1; split_l. eapply nextS_iret; eauto. replace (R SP + 0) with (R SP) ; auto. replace (R SP + 0) with (R SP) ; auto. assert (Heq := leadsToW_unique H3 (leadsToW_Mono HJM H30)). subst; trivial. Qed. Implicit Arguments nextS_DMono [pc c M1 M2 M R fl isr M' R' fl' isr' S0]. Lemma MemUpd16_3_DMono : forall M1 M2 M M'1 M'2 l x1 x2 x3 M', MemMod.disjUnion M1 M2 M -> leadsToBlk l 6 M1 -> MemUpd16 M l x1 M'1 -> MemUpd16 M'1 (l+2) x2 M'2 -> MemUpd16 M'2 (l + 4) x3 M' -> exists M1', exists M1'1, exists M1'2, MemMod.disjUnion M1' M2 M' /\ MemUpd16 M1 l x1 M1'1 /\ MemUpd16 M1'1 (l+2) x2 M1'2 /\ MemUpd16 M1'2 (l + 4) x3 M1'. Proof. intros. assert (leadsToBlk l 2 M1). apply leadsToBlk_shrink_high with 6;intuition. destruct (leadsToBlk_MemUpd16_DMono H H4 H1) as [m'1 [H5 H6]]. assert (6>=2). omega. destruct (leadsToBlk_MemUpd16_Mono H H0 H6 H7) as [H01 [H02 H03]]. assert (leadsToBlk (l+2) (6-2) m'1). apply leadsToBlk_shrink_low;intuition. arith_rep (6-2) with 4 in H8. assert (leadsToBlk (l+2) 2 m'1). apply leadsToBlk_shrink_high with 4;intuition. destruct (leadsToBlk_MemUpd16_DMono H5 H9 H2) as [m'2 [H10 H11]]. assert (4>=2). omega. destruct (leadsToBlk_MemUpd16_Mono H5 H8 H11 H12) as [H001 [H002 H003]]. assert (leadsToBlk ((l+2)+2) (4-2) m'2). apply leadsToBlk_shrink_low;intuition. arith_rep (4-2) with 2 in H13. arith_rep (l+2+2) with (l+4) in H13. destruct (leadsToBlk_MemUpd16_DMono H10 H13 H3) as [m1' [H14 H15]]. exists m1';exists m'1;exists m'2. intuition. Qed. Implicit Arguments MemUpd16_3_DMono [M1 M2 M M'1 M'2 l x1 x2 x3 M']. Lemma itr_nextS_DMono : forall pc M1 M2 M R fl isr M' R' fl' isr', MemMod.disjUnion M1 M2 M -> stkSpace (R SP) 6 M1 -> itr_nextS pc (M, R, fl, isr) (M',R',fl',isr') -> exists M1' : MemMod.Map, MemMod.disjUnion M1' M2 M' /\ itr_nextS pc (M1, R, fl, isr) (M1', R', fl', isr'). Proof. intros pc M1 M2 M R fl isr M' R' fl' isr'. intros HJM Hstk HnextS. unfold itr_nextS in HnextS. destruct HnextS as [sp [fln [cs [M'' [M''' H ]]]]]. destruct H as [Hsp [Hstk2 [HR' [Hfl' [Hisr' [Hfln [Hupd1 [Hupd2 Hupd3]]]]]]]]. unfold stkSpace in Hstk. destruct Hstk. subst sp. assert (Hx0 : R SP - 4 = R SP - 6 + 2). omega. rewrite Hx0 in Hupd2. assert (Hx1 : R SP - 2 = R SP - 6 + 4). omega. rewrite Hx1 in Hupd3. destruct (MemUpd16_3_DMono HJM H0 Hupd1 Hupd2 Hupd3) as [M1' [M1'' [M1''' [HJM' [Hupd1' [Hupd2' Hupd3']]]]]]. exists M1'; split_l. unfold itr_nextS. exists (R SP); exists fln; exists cs; exists M1''; exists M1'''. split_l. split. split; auto. split_l; split_l; split_l; split_l. rewrite Hx0. rewrite Hx1. auto. Qed. Implicit Arguments itr_nextS_DMono [pc M1 M2 M R fl isr M' R' fl' isr']. (******************************************************) Lemma nextS_eqDom : forall pc c M R fl isr M' R' fl' isr', nextS pc c (M, R, fl, isr) (M', R', fl', isr') -> MemMod.eqDom M M'. Proof. induction c as [ i | i]; destruct i; simpl; intros; destruct (nextS_inversion H) as [HM [HR [Hfl Hisr]]]; subst; auto with PMap. destruct HM as [H1 [H2 H3]]. eapply leadsToBlk_MemUpd16_eqDom; eauto. destruct HM as [H1 H2]. eapply leadsToxW_MemUpd16_eqDom; eauto. destruct HM as [H1 [H2 H3]]. eapply leadsToBlk_MemUpd16_eqDom; eauto. destruct HM as [x [H1 [H2 [H3 H4]]]]. eapply leadsToBlk_MemUpd16_eqDom; eauto. destruct HM as [H1 [H2 H3]]. eapply leadsToBlk_MemUpd16_eqDom; eauto. destruct HM. subst M'. auto with PMap. Qed. Implicit Arguments nextS_eqDom [pc c M R fl isr M' R' fl' isr']. Lemma itr_nextS_eqDom : forall pc M R fl isr M' R' fl' isr', itr_nextS pc (M, R, fl, isr) (M', R', fl', isr') -> MemMod.eqDom M M'. Proof. unfold itr_nextS. intros pc M R fl isr M' R' fl' isr' H. destruct H as [sp [fln [cs [M'1 [M'2 [Hsp [Hstk [HR' [Hfl' [Hisr' [Hfln H]]]]]]]]]]]. destruct H as [H1 [H2 H3]]. unfold stkSpace in Hstk. destruct Hstk. assert (leadsToBlk (sp - 4) 4 M). arith_rep 4 with (6 -2). arith_rep (sp - (6 - 2)) with (sp - 6 + 2). apply leadsToBlk_shrink_low; trivial. omega. assert (leadsToBlk (sp - 2) 2 M). arith_rep 2 with (6 -4). arith_rep (sp - (6 - 4)) with (sp - 6 + 4). apply leadsToBlk_shrink_low; trivial. omega. assert (leadsToxW (sp - 6) M). apply leadsToBlk_leadsToxW with 6; trivial. omega. assert (leadsToxW (sp - 4) M). apply leadsToBlk_leadsToxW with 4; trivial. omega. assert (leadsToxW (sp - 2) M). apply leadsToBlk_leadsToxW with 2; trivial. omega. apply MemMod.eqDom_trans with M'1. apply leadsToxW_MemUpd16_eqDom with (sp-6) pc; trivial. apply MemMod.eqDom_trans with M'2. apply leadsToxW_MemUpd16_eqDom with (sp-4) cs; trivial. apply leadsToxW_MemUpd16_leadsToxW_nt with (sp-6) pc M; trivial. left; omega. apply leadsToxW_MemUpd16_eqDom with (sp-2) fln; trivial. apply leadsToxW_MemUpd16_leadsToxW_nt with (sp-4) cs M'1; trivial. apply leadsToxW_MemUpd16_leadsToxW_nt with (sp-6) pc M; trivial. left; omega. left; omega. Qed. Implicit Arguments itr_nextS_eqDom [pc M R fl isr M' R' fl' isr']. coq/SCAP/0000755000107400000620000000000011000242363011572 5ustar shaosystemscoq/SCAP/READY_BLK.v0000644000107400000620000025343111000223235013322 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas4. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import Reg. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import SCAP_Itr. Require Import Linking. Require Import Linking_Lemmas. Require Import Linking_Lemmas2. Require Import Linking_Lemmas3. Require Import EqNat. Require Import Omega. Require Import List. Require Import Arith_Lemmas. Lemma prim_BLK: prim_entry _BLOCK. Proof. unfold prim_entry. right. left. auto. Qed. Hint Resolve prim_BLK. Lemma enable_blk_monotonic: forall w wqa, monotonic_p (enable_blk w wqa). Proof. intros. unfold enable_blk. set (p0 := fun S0 => (pTrue *<* (S_RF S0 SP |->w w *^* ((INV0 *^* INV1) *^* stkSpacePrec (S_RF S0 SP) (_BLK_Stk + 2)))) S0). set (p1 := fun (S0 : State) => Delta w = SomeT wqa). assert (monotonic_p p0). unfold monotonic_p. intros. induction S as (((M0, R0), fl0), isr0). unfold p0. unfold p0 in H. simplS. simplS in H. unfold S_Mem in H0. assert (exists M0', MemMod.disjUnion M0 M0' M). apply MemMod.subseteq_split; auto. unfold pmstar in H. simplS in H. InvertAll. unfold pmstar. simplS. exists (MemMod.merge x0 x). exists x1. unfold pTrue. split; auto. cut (MemMod.disjUnion x1 (MemMod.merge x0 x) M). auto with PMap. apply MemMod.disjUnion_assoc_left_right; auto. inversion_clear H1; auto with PMap. assert (MemMod.disjUnion x1 x0 M0). auto with PMap. inversion H3. rewrite H6 in H2. auto. assert (monotonic_p p1). unfold monotonic_p. intros. unfold p1. unfold p1 in H0. auto. assert (monotonic_p (fun S => p1 S /\ p0 S)). unfold monotonic_p. intros. InvertAll. split. unfold monotonic_p in H0. apply H0; auto. unfold monotonic_p in H. apply H; auto. unfold p0 in H1. unfold p1 in H1. auto. Qed. Hint Resolve enable_blk_monotonic. Lemma enable_blk_prog: forall w wqa S pc f, enable_blk w wqa S -> exists S' : State, nextS pc (comml (_call f)) S S'. Proof. intros. unfold enable_blk in H. InvertAll. apply stkSpace_call_prog with (_BLK_Stk + 2); auto. assert (((S_RF S SP |->w w *^* (INV0 *^* INV1 *^* stkSpacePrec (S_RF S SP) (_BLK_Stk + 2))) *^* mTrue) (S_Mem S)). apply pTrue_m_mTrue with pTrue; auto. assert (((INV0 *^* INV1 *^* stkSpacePrec (S_RF S SP) (_BLK_Stk + 2)) *^* mTrue) (S_Mem S)). apply mstar_mTrue with (S_RF S SP |->w w) mTrue; auto. apply mstar_mTrue with (INV0 *^* INV1) mTrue; auto. omega. Qed. Lemma NH_Call_blk_enable: forall psi pc p g n S, NH_Call_Prim psi pc _BLOCK (Ast p g n) -> imprec p S -> exists w, exists wqa, enable_blk w wqa S. Proof. intros. unfold NH_Call_Prim in H. InvertAll. inversion H1. absurd (_BLOCK <> _SWITCH); auto. inversion H3. rewrite <- H7 in H5. rewrite <- H8 in H5. rewrite <- H9 in H4. clear H7 H8 H9 H3 H tag p0 g0. induction S as (((M, R), fl), isr). unfold imprec in H0. unfold pmstar in H0. InvertAll. rename x into M1. rename x0 into M2. UnfoldStateAll. assert (exists w : nat, exists wqa : WQassert, enable_blk w wqa (M1, R, fl, isr) /\ (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (M1, R, fl, isr)) p') /\ (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (M1, R, fl, isr) |> g') (g (M1, R, fl, isr)))). apply H5; auto. InvertAll. rename x into w. rename x0 into wqa. exists w. exists wqa. assert (monotonic_p (enable_blk w wqa)). auto. unfold monotonic_p in H8. assert (enable_blk w wqa (S_Mem_Upd (M1, R, fl, isr) M)). apply H8; auto. unfold S_Mem. apply MemMod.disjUnion_subseteq_left with M2; auto. UnfoldStateAll. auto. absurd (_BLOCK <> _UNBLK); auto. Qed. Lemma NH_BLK_prog_aux : forall psi pc theta Psi rho S, NH_Call_Prim psi pc _BLOCK theta -> Itp_AIM rho theta Psi S -> rho <> rho_ih -> exists S', nextS pc (comml (_call _BLOCK)) S S'. Proof. intros. induction theta. assert (imprec (NH_pinvstar p) S). apply Itp_AIM_pinv with g n Psi rho; auto. assert (imprec p S). apply imprec_presv_imprec with (NH_pinvstar p); auto. assert (exists w, exists wqa, enable_blk w wqa S). apply NH_Call_blk_enable with psi pc p g n; auto. InvertAll. apply enable_blk_prog with x x0; auto. Qed. Lemma NH_BLK_progress: forall psi pc theta Psi a S, NH_WFcmd psi pc theta (comml (_call _BLOCK)) -> a = Itp_AIM rho_ready theta -> a Psi S -> exists S', nextS pc (comml (_call _BLOCK)) S S'. Proof. intros. unfold NH_WFcmd in H. induction theta. unfold NH_WFcmd_aux in H. inversion_clear H. clear H3. inversion H2. inversion_clear H. clear H3. apply NH_BLK_prog_aux with psi (Ast p g n) Psi rho_ready; auto. rewrite H0 in H1. auto. inversion_clear H. absurd (prim_entry _BLOCK); auto. Qed. Lemma WF_AIM_World_blk: forall Psi'0 S T B RdyQ tid p g tag w wqa, WF_AIM_World Psi'0 S T B RdyQ tid rho_ready (Ast p g tag) -> enable_blk w wqa S -> exists BlkQ, B w = Some BlkQ /\ Delta w = SomeT wqa /\ (pmstar pTrue (mstar (ptoW (S_RF S SP) w) (mstar (mstar INV0 INV1) (stkSpacePrec (S_RF S SP) (_BLK_Stk + 2)) ) ) ) S. Proof. intros. unfold enable_blk in H0. InvertAll. unfold WF_AIM_World in H. InvertAll. unfold WF_WQ_WQSpec in H4. assert (WQSetMod.in_dom w B). apply H4 with wqa; auto. unfold WQSetMod.in_dom in H9. InvertAll. exists x1. auto. Qed. Lemma WF_AIM_World_Rdy_StatusRdy: forall Psi'0 S T B RdyQ tid theta tcb, WF_AIM_World Psi'0 S T B RdyQ tid rho_ready theta -> TQMod.maps_to T tid tcb -> TCB_Status tcb = READY. Proof. intros. unfold WF_AIM_World in H. InvertAll. unfold WF_currTID in H1. InvertAll. unfold TQMod.maps_to in H12. unfold TQMod.maps_to in H0. rewrite H12 in H0. inversion H0. rewrite H15 in H14. unfold rho_tcb_consistent in H14. inversion_clear H14. apply H13; auto. Qed. Lemma WF_AIM_World_cthNotBlk: forall Psi'0 S T B RdyQ tid theta w BlkQ rho, WF_AIM_World Psi'0 S T B RdyQ tid rho theta -> B w = Some BlkQ -> WQMod.not_in_dom tid BlkQ. Proof. intros. unfold WF_AIM_World in H. InvertAll. unfold WF_currTID in H1. InvertAll. unfold unblocked in H8. apply H8 with w; auto. Qed. Lemma enable_blk_nxt_stkspace: forall pc S S' M1 M2 f w, ((pTrue *<* (S_RF (S_Mem_Upd S M1) SP |->w w *^* (INV0 *^* INV1 *^* stkSpacePrec (S_RF (S_Mem_Upd S M1) SP) (_BLK_Stk + 2)))) (S_Mem_Upd S M1)) -> nextS pc (comml (_call f)) S S' -> MemMod.disjUnion M1 M2 (S_Mem S) -> exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ (S_RF S' SP |->w (pc+1) *^* (S_RF S' SP + 2 |->w w) *^* stkSpacePrec (S_RF S' SP) 10 *^* mTrue) M1'. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. assert ((mTrue *^* (R SP |->w w *^* (INV0 *^* INV1 *^* stkSpacePrec (R SP) (_BLK_Stk + 2)))) M1). unfold pmstar in H. InvertAll. exists x. exists x0. split_l. split. unfold mTrue. auto. auto. clear H. assert (frame (nextS pc (comml (_call f)))). apply frame_call. unfold frame in H. assert (exists M1', MemMod.disjUnion M1' M2 (S_Mem (M', R', fl', isr')) /\ nextS pc (comml (_call f)) (S_Mem_Upd (M, R, fl, isr) M1) (S_Mem_Upd (M', R', fl', isr') M1')). apply H; auto. clear H. UnfoldStateAll. unfold enableS. exists (MemUpdW M1 (R SP - 2) (pc+1) 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_call. unfold pushW. split. sep on. sep lift 4 in H2. sep stksplit 2 in H2. sep lift 0 in H2. sep trivial. split; auto. apply MemUpdW_MemUpd16 with 0; auto. clear H. UnfoldStateAll. InvertAll. exists x. split_l. destruct (nextS_inversion H4). InvertAll. subst R'. reg simpl. substH H10 with (MemUpd16_MemUpdW H10). InvertAll. subst x. sep on. sep lift 0. sep upd. assert (R SP - 2 + 2 = R SP). auto. rewrite H6. sep lift 4 in H2. sep stksplit in H2. assert (_BLK_Stk + 2 - 2 = _BLK_Stk). auto. rewrite H9 in H2. sep matchH H2 with 4. Qed. Lemma enable_blk_nxt_stkspace1: forall pc S S' M1 M2 f w, ((pTrue *<* (S_RF (S_Mem_Upd S M1) SP |->w w *^* (INV0 *^* INV1 *^* stkSpacePrec (S_RF (S_Mem_Upd S M1) SP) (_BLK_Stk + 2)))) (S_Mem_Upd S M1)) -> nextS pc (comml (_call f)) S S' -> MemMod.disjUnion M1 M2 (S_Mem S) -> exists M1', exists junk1, exists junk2, MemMod.disjUnion M1' M2 (S_Mem S') /\ (S_RF S' SP |-> (pc+1) *^* S_RF S' SP + 1 |-> junk1 *^* (S_RF S' SP + 2 |-> w) *^* S_RF S' SP + 3 |-> junk2 *^* stkSpacePrec (S_RF S' SP) 10 *^* mTrue) M1'. Proof. intros. assert (exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ (S_RF S' SP |->w (pc+1) *^* (S_RF S' SP + 2 |->w w) *^* stkSpacePrec (S_RF S' SP) 10 *^* mTrue) M1'). apply enable_blk_nxt_stkspace with S M1 f; auto. destruct H2 as [M1' [Hsplit Hmem]]. exists M1'. sep on. sep lift 0 in Hmem. assert (exists junk1, M1' ||- S_RF S' SP |-> pc + 1 *^* S_RF S' SP + 1 |-> junk1 *^* (S_RF S' SP + 2 |->w w *^* (stkSpacePrec (S_RF S' SP) 10 *^* mTrue))). apply ptoW_elim1. auto. clear Hmem. destruct H2 as [junk1 Hmem]. exists junk1. sep lift 2 in Hmem. assert (exists junk2, M1' ||- S_RF S' SP + 2 |-> w *^* S_RF S' SP + 2 + 1 |-> junk2 *^* (stkSpacePrec (S_RF S' SP) 10 *^* mTrue *^* (S_RF S' SP |-> pc + 1 *^* S_RF S' SP + 1 |-> junk1))). apply ptoW_elim1; auto. assert (S_RF S' SP + 2 + 1 = S_RF S' SP + 3). omega. rewrite H3 in H2. inversion H2. exists x. split_l. sep on. sep matchH H4 with 6. Qed. Lemma merge_BLK_pre: forall pc S' M1' w T tid RdyQ B BlkQ M2 x0 x1, (S_RF S' SP |-> pc *^* S_RF S' SP + 1 |-> x0 *^* S_RF S' SP + 2 |-> w *^* S_RF S' SP + 3 |-> x1 *^* stkSpacePrec (S_RF S' SP) 10 *^* mTrue) M1' -> (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M2 -> B w = Some BlkQ -> MemMod.disjUnion M1' M2 (S_Mem S') -> (BLK_MPre T RdyQ BlkQ tid (S_RF S' SP) w pc x0 x1 *^* mTrue) (S_Mem S'). Proof. intros. induction S' as (((M, R), fl), isr). UnfoldStateAll. rename M1' into M1. unfold BLK_MPre. assert (((R SP |-> pc *^* R SP + 1 |-> x0 *^* R SP + 2 |-> w *^* R SP + 3 |-> x1 *^* stkSpacePrec (R SP) 10 *^* mTrue) *^* (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B))) M). exists M1. exists M2. split; auto. assert (forall M, embed_WQSet T B M -> (ptoTQ w (filterTQ T BlkQ) *^* mTrue) M). intros. apply enbedBlkQ_inWQSet with B; auto. sep on. sep lift 8 in H3. sep weaker_subst in H3 with (ptoTQ w (filterTQ T BlkQ) *^* mTrue); auto. clear H5. sep on. sep lift 8 in H3. sep lift 0. sep match_left H3; auto. sep lift 0 in H3. sep match_left H3; auto. sep lift 0 in H3. sep match_left H3; auto. sep lift 1 in H3. sep match_left H3; auto. sep matchH H3 with 5. Qed. Lemma enter_BLK_preMem: forall pc S S' p g tag M1 M2 Psi T B RdyQ tid wqa w BlkQ, nextS pc (comml (_call _BLOCK)) S S' -> MemMod.disjUnion M1 M2 (S_Mem S) -> WF_AIM_World Psi (S_Mem_Upd S M1) T B RdyQ tid rho_ready (Ast p g tag) -> (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M2 -> Delta w = SomeT wqa -> (pTrue *<* (S_RF (S_Mem_Upd S M1) SP |->w w *^* (INV0 *^* INV1 *^* stkSpacePrec (S_RF (S_Mem_Upd S M1) SP) (_BLK_Stk + 2)))) (S_Mem_Upd S M1) -> B w = Some BlkQ -> exists junk1, exists junk2, (BLK_MPre T RdyQ BlkQ tid (S_RF S' SP) w (pc+1) junk1 junk2 *^* mTrue) (S_Mem S'). Proof. intros. assert (exists M1', exists junk1, exists junk2, MemMod.disjUnion M1' M2 (S_Mem S') /\ (S_RF S' SP |-> (pc+1) *^* S_RF S' SP + 1 |-> junk1 *^* S_RF S' SP + 2 |-> w *^* S_RF S' SP + 3 |-> junk2 *^* stkSpacePrec (S_RF S' SP) 10 *^* mTrue) M1'). apply enable_blk_nxt_stkspace1 with S M1 _BLOCK; auto. InvertAll. rename x into M1'. exists x0. exists x1. apply merge_BLK_pre with M1' B M2; auto. Qed. Lemma enter_BLK_pre: forall psi pc theta Psi'0 S S', NH_WFcmd psi pc theta (comml (_call _BLOCK)) -> Itp_AIM rho_ready theta Psi'0 S -> nextS pc (comml (_call _BLOCK)) S S' -> BLK_Prd S'. Proof. intros. unfold BLK_Prd. induction theta. unfold Itp_AIM in H0. InvertAll. rename x into T. rename x0 into B. rename x1 into RdyQ. rename x2 into tid. exists T. exists RdyQ. unfold NH_WFcmd in H. unfold NH_WFcmd_aux in H. InvertAll. clear H. clear H4. inversion_clear H2. inversion_clear H. clear H2. unfold NH_Call_Prim in H3. inversion_clear H3. inversion H. absurd (_BLOCK <> _SWITCH); auto. inversion H4. rewrite <- H8 in H6. rewrite <- H9 in H6. clear H9 H8 H10 H3 H4 H5 tag p0 g0. rename n into tag. induction S as (((M, R), fl), isr). unfold pmstar in H0. InvertAll. rename x into M1. rename x0 into M2. assert (exists w, exists wqa, enable_blk w wqa (M1, R, fl, isr)). apply NH_Call_blk_enable with psi pc p g tag; auto. unfold NH_Call_Prim. split; auto. assert (imprec (NH_pinvstar p) (M1, R, fl, isr)). apply WF_AIM_World_pinv with Psi'0 T B RdyQ tid rho_ready g tag; auto. apply imprec_presv_imprec with (NH_pinvstar p); auto. InvertAll. rename x into w. rename x0 into wqa. assert (exists BlkQ, B w = Some BlkQ /\ Delta w = SomeT wqa /\ (pmstar pTrue (mstar (ptoW (S_RF (M1, R, fl, isr) SP) w) (mstar (mstar INV0 INV1) (stkSpacePrec (S_RF (M1, R, fl, isr) SP) (_BLK_Stk + 2)) ) ) ) (M1, R, fl, isr) ). apply WF_AIM_World_blk with Psi'0 T RdyQ tid p g tag; auto. InvertAll. rename x into BlkQ. exists BlkQ. exists tid. exists (S_RF S' SP). exists w. assert (exists tcb, TQMod.maps_to T tid tcb). apply WF_AIM_World_currTCB with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ rho_ready (Ast p g tag); auto. inversion_clear H9. rename x into tcb. exists tcb. exists (pc+1). split. apply enter_BLK_preMem with (M, R, fl, isr) p g tag M1 M2 Psi'0 B wqa; auto. split. apply WF_AIM_World_existsIdle with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B rho_ready (Ast p g tag); auto. split; auto. split. apply WF_AIM_World_RdyQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B tid rho_ready (Ast p g tag); auto. split. apply WF_AIM_World_BlkQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ready (Ast p g tag) w; auto. split. apply WF_AIM_World_Rdy_StatusRdy with Psi'0 (M1, R, fl, isr) T B RdyQ tid (Ast p g tag); auto. split; auto. split. apply WF_AIM_World_cthNotRdy with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) T B rho_ready (Ast p g tag); auto. split. apply WF_AIM_World_cthNotBlk with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) T B RdyQ (Ast p g tag) w rho_ready; auto. split. apply WF_AIM_World_RdyNotBlk with Psi'0 (M1, R, fl, isr) T B tid (Ast p g tag) w rho_ready; auto. apply WF_AIM_World_WFTQ with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ready (Ast p g tag); auto. assert (_BLOCK <> _UNBLK). auto. contradiction. inversion_clear H. absurd (prim_entry _BLOCK); auto. Qed. Lemma enter_BLK_disable: forall psi pc theta Psi'0 S S', NH_WFcmd psi pc theta (comml (_call _BLOCK)) -> Itp_AIM rho_ready theta Psi'0 S -> nextS pc (comml (_call _BLOCK)) S S' -> S_Flag S' _IF = false. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). unfold NH_WFcmd in H. induction theta. destruct H as [HWFcmd [Htmp1 Htmp2]]. clear Htmp1 Htmp2. unfold NH_WFcmd_aux in HWFcmd. inversion_clear HWFcmd. destruct H as [Hprim HWFcmd]. clear Hprim. unfold NH_Call_Prim in HWFcmd. inversion_clear HWFcmd. clear H. assert (fl _IF = false). assert (imprec (NH_pinvstar p) (M, R, fl, isr)). apply Itp_AIM_pinv with g n Psi'0 rho_ready. auto. discriminate. unfold imprec in H. unfold pmstar in H. InvertAll. unfold NH_pinvstar in H. simplS in H. unfold pmstar in H. InvertAll. simplS in H. assert (S_Flag (x1, R, fl, isr) _IF = false). apply H2; auto. UnfoldStateAll; auto. clear H0 H2. destruct (nextS_inversion H1). InvertAll. subst fl'. UnfoldStateAll. auto. inversion_clear H. assert (prim_entry _BLOCK); auto. contradiction. Qed. Lemma WF_AIM_World_blk2: forall Psi'0 S T B RdyQ tid p g tag w wqa S', WF_AIM_World Psi'0 S T B RdyQ tid rho_ready (Ast p g tag) -> enable_blk w wqa S' -> exists BlkQ, B w = Some BlkQ /\ Delta w = SomeT wqa /\ (pmstar pTrue (mstar (ptoW (S_RF S' SP) w) (mstar (mstar INV0 INV1) (stkSpacePrec (S_RF S' SP) (_BLK_Stk + 2)) ) ) ) S'. Proof. intros. unfold enable_blk in H0. InvertAll. unfold WF_AIM_World in H. InvertAll. unfold WF_WQ_WQSpec in H4. assert (WQSetMod.in_dom w B). apply H4 with wqa; auto. unfold WQSetMod.in_dom in H9. InvertAll. exists x1. auto. Qed. Lemma enter_BLK_grt_hyp0: forall sp w cthM1 R fl isr, (pTrue *<* (sp |->w w *^* (INV0 *^* INV1 *^* stkSpacePrec sp (_BLK_Stk + 2)))) (cthM1, R, fl, isr) -> exists cthM11, exists cthM12, MemMod.disjUnion cthM11 cthM12 cthM1 /\ (sp |->w w *^* stkSpacePrec sp (_BLK_Stk + 2)) cthM11 /\ (INV0 *^* INV1 *^* mTrue) cthM12. Proof. intros. assert (((sp |->w w *^* stkSpacePrec sp (_BLK_Stk + 2)) *^* (INV0 *^* INV1 *^* mTrue)) cthM1). assert ((mTrue *^* (sp |->w w *^* (INV0 *^* INV1 *^* stkSpacePrec sp (_BLK_Stk + 2)))) cthM1). unfold pmstar in H. InvertAll. exists x. exists x0. split_l. split; auto. sep on. sep lift 1 in H0. sep matchH H0 with 5. unfold mstar at 1 in H0. InvertAll. exists x. exists x0. split_l. split; auto. Qed. Lemma mem_compose_c_blk: forall cthM11' M21 M1' sp pc T tid RdyQ w BlkQ junk1 junk2, MemMod.disjUnion cthM11' M21 M1' -> (sp |-> pc *^* sp + 1 |-> junk1 *^* (sp + 2 |-> w) *^* sp + 3 |-> junk2 *^* stkSpacePrec sp _BLK_Stk) cthM11' -> (embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* ptoTQ w (filterTQ T BlkQ)) M21 -> BLK_MPre T RdyQ BlkQ tid sp w pc junk1 junk2 M1'. Proof. intros. assert (((sp |-> pc *^* sp + 1 |-> junk1 *^* sp + 2 |-> w *^* sp + 3 |-> junk2 *^* stkSpacePrec sp _BLK_Stk) *^* (embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* ptoTQ w (filterTQ T BlkQ))) M1'). exists cthM11'. exists M21. auto. unfold BLK_MPre. sep on. sep matchH H2 with 8. Qed. Lemma enter_BLK_grt2_hyp2: forall T T' B RdyQ' BlkQ' tid tid' sp sp' w tcb' pc pc' S0 S' M0' M2' M22 M12 cthM2 cthM12 cthMR TM junk1 junk2, BLK_Post_aux T' RdyQ' BlkQ' tid' sp' sp w tcb' pc junk1 junk2 (S_Mem_Upd S0 M0') -> nextS pc' (comms _retw) S0 S' -> MemMod.disjUnion M0' M2' (S_Mem S0) -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' -> embed_WQSet T (WQSetMod.remove B w) M22 -> MemSplit (ThrdMemMod.remove TM tid) M12 -> ThrdMemMod.maps_to TM tid' cthMR -> tid <> tid' -> NH_Inv (S_Flag S0) cthM2 -> (INV0 *^* INV1 *^* mTrue) cthM12 -> T' = TQMod.put T tid (sp, BLOCKED, pc) -> exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ (INV0 *^* INV1) INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ' *^* ptoTQ w (filterTQ T' BlkQ')) M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old /\ (sp |-> pc *^* sp+1 |-> junk1 *^* sp + 2 |-> w *^* sp+3 |-> junk2 *^* stkSpacePrec sp _BLK_Stk) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S'). Proof. intros. unfold mstar at 1 in H8. InvertAll. rename x into INVM. rename x0 into cthM0. exists INVM. exists cthM0. unfold BLK_Post_aux in H. InvertAll. unfold BLK_MPost in H16. assert ((embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ' *^* ptoTQ w (filterTQ T' BlkQ') *^* (sp |-> pc *^* sp+1 |-> junk1 *^* sp + 2 |-> w *^* sp+3 |-> junk2 *^* stkSpacePrec sp 10)) (S_Mem (S_Mem_Upd S0 M0'))). induction S0 as (((Mx, Rx), flx), isrx). simplS in H16. simplS. sep on. sep matchH H16 with 8. unfold mstar at 1 in H15. InvertAll. rename x into M21'. exists M21'. rename x0 into cthM_oldStk. assert (exists M122, MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122). apply memsplit_thrd_remove; auto. unfold ThrdMemMod.maps_to. unfold ThrdMemMod.remove. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. unfold ThrdMemMod.maps_to in H5. auto. InvertAll. rename x into M122. exists M122. exists (MemMod.merge (MemMod.merge cthM0 cthM2) cthM_oldStk). exists cthM_oldStk. split; auto. split; auto. split; auto. split; auto. split; auto. split. unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_aux2_hyp0 with INVM cthM12 M22 M12 M0' M2' S0 M21'; auto. split. auto. apply enter_SW_grt2_aux2_hyp1 with pc' M0' M2' S0 M12 cthM12; auto. Qed. Lemma ext_B_presv_wffTID: forall T' B B' RdyQ' BlkQ w tid tid' rho', WF_currTID tid' T' B RdyQ' rho' -> tid <> tid' -> B' = WQSetMod.put B w (addThrd BlkQ tid) -> B w = Some BlkQ -> WF_currTID tid' T' B' RdyQ' rho'. Proof. intros. unfold WF_currTID in *. destruct H as [Hunblk [HnotRdy [HinT Htcb]]]. split. unfold unblocked in *. subst B'. unfold WQSetMod.maps_to. unfold WQSetMod.put. intros. induction (WQSetMod.beq_A w0 w). inversion H. clear H H3 Q. unfold addThrd. unfold WQMod.not_in_dom. unfold WQMod.put. induction (WQMod.beq_A tid' tid). absurd (tid' <> tid); auto. assert (WQMod.not_in_dom tid' BlkQ). apply Hunblk with w. unfold WQSetMod.maps_to. auto. unfold WQMod.not_in_dom in H. auto. apply Hunblk with w0; auto. split_l. split_l. destruct Htcb as [tcb [HtcbinT [Hstatus Hconsist]]]. exists tcb. split_l. split; auto. Qed. Lemma enter_BLK_grt2_hyp4_hyp0: forall RdyQ RdyQ' tid tid' B, RdyQ = addThrd RdyQ' tid' -> tid <> tid' -> disj_RQ_WQ B RdyQ -> unblocked tid' B. Proof. intros. unfold unblocked. unfold disj_RQ_WQ in H1. intros. assert (WQMod.disjoint Q RdyQ). apply H1 with w; auto. unfold WQMod.disjoint in H3. assert (WQMod.not_in_dom tid' Q \/ WQMod.not_in_dom tid' RdyQ). apply H3; auto. clear H3. inversion_clear H4. auto. unfold WQMod.not_in_dom in H3. subst RdyQ. unfold addThrd in H3. unfold WQMod.put in H3. induction (WQMod.beq_A tid' tid'). inversion H3. absurd (tid' = tid'); auto. Qed. Lemma enter_BLK_grt2_hyp4: forall T T' B RdyQ RdyQ' tid tid' tcb tcb' rho rho', tid <> tid' -> RdyQ = addThrd RdyQ' tid' -> WF_currTID tid T B RdyQ rho -> T' = TQMod.put T tid tcb -> WQMod.not_in_dom tid' RdyQ' -> WF_TWQ T B RdyQ -> TQMod.maps_to T tid' tcb' -> TCB_Status tcb' = READY \/ TCB_Status tcb' = IDLE -> rho_tcb_consistent tcb' rho' -> WF_currTID tid' T' B RdyQ' rho'. Proof. intros. unfold WF_currTID. unfold WF_TWQ in H4. unfold WF_currTID in H1. InvertAll. split. apply enter_BLK_grt2_hyp4_hyp0 with RdyQ RdyQ' tid; auto. split; auto. rewrite H2. unfold TQMod.in_dom. unfold TQMod.put. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. split. exists tcb'. auto. exists tcb'. unfold TQMod.maps_to. induction (TQMod.beq_A tid' tid). contradiction. split; auto. Qed. Lemma enter_BLK_grt2_hyp5: forall T T' RdyQ RdyQ' tid tid' sp pc tcb, exists_Idle T RdyQ tid -> RdyQ = addThrd RdyQ' tid' -> T tid = Some tcb -> tid <> tid' -> WQMod.not_in_dom tid' RdyQ' -> WQMod.not_in_dom tid RdyQ -> T' = TQMod.put T tid (sp, BLOCKED, pc) -> TCB_Status tcb = READY -> exists_Idle T' RdyQ' tid'. Proof. intros. unfold exists_Idle. unfold exists_Idle in H. inversion_clear H. InvertAll. assert (x = tcb). unfold TQMod.maps_to in H7. rewrite H7 in H1. inversion H1. auto. rewrite H in H8. rewrite H8 in H6. inversion H6. InvertAll. rename x into tid''. rename x0 into tcb''. assert (tid' = tid'' \/ tid' <> tid''). apply nat_eq_neq_dec. inversion_clear H8. left. exists tcb''. split. rewrite <- H10 in H7. rewrite H5. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. auto. auto. right. exists tid''. exists tcb''. assert (WQMod.in_dom tid'' RdyQ'). unfold WQMod.in_dom in H. rewrite H0 in H. unfold addThrd in H. unfold WQMod.put in H. induction (WQMod.beq_A tid'' tid'). absurd (tid'' <> tid'); auto. inversion H. exists x. auto. split; auto. split; auto. rewrite H5. unfold TQMod.maps_to. unfold TQMod.put. induction (TQMod.beq_A tid'' tid). rewrite a in H8. assert (WQMod.in_dom tid RdyQ). rewrite H0. unfold addThrd. unfold WQMod.in_dom. unfold WQMod.put. induction (WQMod.beq_A tid tid'). contradiction. auto. absurd (~ WQMod.in_dom tid RdyQ); auto with PMap. auto. Qed. Lemma extT_presv_wffTQ: forall T T' tid tcb tcb', WF_TQ T -> T tid = Some tcb -> T' = TQMod.put T tid tcb' -> WF_TQ T'. Proof. intros. unfold WF_TQ in *. intros. subst T'. unfold TQMod.put in H2. unfold TQMod.in_dom in H2. induction (TQMod.beq_A tid0 tid). subst tid0. apply H; auto. unfold TQMod.in_dom. exists tcb; auto. apply H; auto. Qed. Lemma extB_presv_wffWQSet2: forall B B' tid w BlkQ, WF_WQSet2 B -> unblocked tid B -> B w = Some BlkQ -> B' = WQSetMod.put B w (addThrd BlkQ tid) -> WF_WQSet2 B'. Proof. intros. unfold WF_WQSet2 in *. rewrite H2. unfold WQSetMod.put. unfold WQSetMod.maps_to. intros. induction (WQSetMod.beq_A l w). induction (WQSetMod.beq_A l' w). rewrite <- a0 in a. contradiction. inversion H3. unfold WQMod.disjoint. unfold addThrd. unfold WQMod.put. unfold WQMod.not_in_dom. intro. induction (WQMod.beq_A x tid). right. unfold unblocked in H0. assert (WQMod.not_in_dom tid Q'). apply H0 with l'; auto. rewrite a0. auto. assert (WQMod.disjoint BlkQ Q'). apply H with w l'; auto. unfold WQMod.disjoint in H6. unfold WQMod.not_in_dom in H6. apply H6. induction (WQSetMod.beq_A l' w). inversion H4. unfold WQMod.disjoint. unfold addThrd. unfold WQMod.put. unfold WQMod.not_in_dom. intro. induction (WQMod.beq_A x tid). left. unfold unblocked in H0. assert (WQMod.not_in_dom tid Q). apply H0 with l; auto. rewrite a0. auto. assert (WQMod.disjoint BlkQ Q). apply H with w l; auto. unfold WQMod.disjoint in H6. unfold WQMod.not_in_dom in H6. assert (BlkQ x = None \/ Q x = None). apply H6. inversion H8; auto. apply H with l l'; auto. Qed. Lemma extB_RdyQ_presv_disjRQWQ: forall B B' RdyQ RdyQ' tid tid' w BlkQ, disj_RQ_WQ B RdyQ -> WQMod.not_in_dom tid RdyQ -> RdyQ = addThrd RdyQ' tid' -> B w = Some BlkQ -> B' = WQSetMod.put B w (addThrd BlkQ tid) -> disj_RQ_WQ B' RdyQ'. Proof. intros. unfold disj_RQ_WQ in *. rewrite H3. unfold WQSetMod.maps_to. unfold WQSetMod.put. intros. induction (WQSetMod.beq_A l w). inversion H4. assert (WQMod.disjoint BlkQ RdyQ). apply H with w; auto. unfold WQMod.disjoint. unfold addThrd. unfold WQMod.not_in_dom. unfold WQMod.put. intro. induction (WQMod.beq_A x tid). right. rewrite a0. rewrite H1 in H0. unfold WQMod.not_in_dom in H0. unfold addThrd in H0. unfold WQMod.put in H0. induction (WQMod.beq_A tid tid'). inversion H0. auto. unfold WQMod.disjoint in H5. assert (WQMod.not_in_dom x BlkQ \/ WQMod.not_in_dom x RdyQ). apply H5. inversion_clear H7; auto. unfold WQMod.not_in_dom in H8. right. rewrite H1 in H8. unfold addThrd in H8. unfold WQMod.put in H8. induction (WQMod.beq_A x tid'). inversion H8. auto. assert (WQMod.disjoint Q RdyQ). apply H with l; auto. unfold WQMod.disjoint in *. intro. assert (WQMod.not_in_dom x Q \/ WQMod.not_in_dom x RdyQ). apply H5. inversion_clear H6; auto. right. rewrite H1 in H7. unfold WQMod.not_in_dom in H7. unfold addThrd in H7. unfold WQMod.put in H7. induction (WQMod.beq_A x tid'). inversion H7. auto. Qed. (* changed because of the change of WF_currTID *) Lemma enter_BLK_grt2_aux6: forall RdyQ RdyQ' tid tid' tcb tcb' B B' T T' rho w BlkQ, RdyQ = addThrd RdyQ' tid' -> T tid = Some tcb -> WF_currTID tid T B RdyQ rho -> WF_TWQ T B RdyQ -> B w = Some BlkQ -> B' = WQSetMod.put B w (addThrd BlkQ tid) -> T' = TQMod.put T tid tcb' -> WQMod.not_in_dom tid RdyQ -> WF_TWQ T' B' RdyQ'. Proof. intros. unfold WF_TWQ. split. apply extT_presv_wffTQ with T tid tcb tcb'; auto. unfold WF_TWQ in H2. InvertAll. auto. unfold WF_TWQ in H2. InvertAll. split. apply extB_presv_wffWQSet2 with B tid w BlkQ; auto. unfold WF_currTID in H1. InvertAll. auto. apply extB_RdyQ_presv_disjRQWQ with B RdyQ tid tid' w BlkQ; auto. Qed. Lemma extB_presv_WF_WQ_WQSpec: forall B B' Delta w BlkQ BlkQ', WF_WQ_WQSpec B Delta -> B' = WQSetMod.put B w BlkQ' -> B w = Some BlkQ -> WF_WQ_WQSpec B' Delta. Proof. intros. unfold WF_WQ_WQSpec in *. intros. rewrite H0. unfold WQSetMod.in_dom. unfold WQSetMod.put. induction (WQSetMod.beq_A l w). exists BlkQ'. auto. assert (WQSetMod.in_dom l B). apply H with wqa; auto. auto. Qed. Lemma enter_BLK_grt2_hypd0: forall cthM1 cthM11 cthM12 R fl isr pc f, MemMod.disjUnion cthM11 cthM12 cthM1 -> stkSpace (R SP) 2 cthM11 -> exists cthM1', MemUpd16 cthM1 (R SP - 2) (pc+1) cthM1' /\ nextS pc (comml (_call f)) (cthM1, R, fl, isr) (cthM1', RF_update R SP (R SP - 2), fl, isr). Proof. intros. assert (stkSpace (R SP) 2 cthM1). apply stkSpace_Mono with cthM11 cthM12; auto. exists (MemUpdW cthM1 (R SP - 2) (pc + 1) 0). split. apply MemUpdW_MemUpd16 with 0; auto. apply nextS_call; auto. unfold pushW. split_l. split; auto. apply MemUpdW_MemUpd16 with 0; auto. Qed. Lemma enter_BLK_grt2_auxc_hyp3: forall sp sp' w0 w junk1 junk2 oldStk2 cthM11_2, (sp' |-> w0 *^* sp' + 1 |-> junk1 *^* sp' + 2 |-> w *^* sp' + 3 |-> junk2) oldStk2 -> (sp - 2 |->w_ *^* (sp |-> w *^* sp + 1 |-> junk2)) cthM11_2 -> sp = sp' + 2 -> MemUpdW cthM11_2 (sp - 2) w0 junk1 = oldStk2. Proof. intros. rewrite H1 in H0. assert (sp' + 2 - 2 = sp'). auto. rewrite H1. rewrite H2. rewrite H2 in H0. assert (sp' + 2 + 1 = sp' + 3). auto. rewrite H3 in H0. clear H1 H2 H3. clear sp. assert ((sp' |-> w0 *^* sp' + 1 |-> junk1 *^* sp' + 2 |-> w *^* sp' + 3 |-> junk2) (MemUpdW cthM11_2 sp' w0 junk1)). sep on. unfold MemUpdW. sep lift 1. sep upd2. sep lift 3. sep upd2. assert (exists x, cthM11_2 ||- sp' |->w x *^* (sp' + 2 |-> w *^* sp' + 3 |-> junk2)). apply ptoxW_ptoW1; auto. inversion H1. clear H1. assert (exists y, cthM11_2 ||- sp' |-> x *^* sp' + 1 |-> y *^* (sp' + 2 |-> w *^* sp' + 3 |-> junk2)). apply ptoW_elim1; auto. inversion_clear H1. sep matchH H3 with 4. unfold mstar in H3. sep off. InvertAll. exists x1. exists x2. unfold ptox. split_l. split. exists x. auto. exists x0. auto. assert (uniqueM (sp' |-> w0 *^* sp' + 1 |-> junk1 *^* sp' + 2 |-> w *^* sp' + 3 |-> junk2)). apply mstar_presv_uniqueM. apply mstar_presv_uniqueM. apply mstar_presv_uniqueM; apply pto_uniqueM. apply pto_uniqueM. apply pto_uniqueM. unfold uniqueM in H2. apply H2; auto. Qed. Lemma enter_BLK_grt2_auxc_hyp0: forall cthM1 cthM11 cthM12 cthM11_1 cthM11_2 INVM cthM0 cthM' sp w pc junk1 junk2, MemMod.disjUnion cthM11 cthM12 cthM1 -> MemMod.disjUnion INVM cthM0 cthM12 -> MemMod.disjUnion cthM11_1 cthM11_2 cthM11 -> (sp - 2 |->w_ *^* (sp |-> w *^* sp + 1 |-> junk2)) cthM11_2 -> cthM' = MemUpdW cthM1 (sp - 2) (pc + 1) junk1 -> MemMod.disjUnion (MemMod.merge (MemUpdW cthM11_2 (sp - 2) (pc+1) junk1) cthM0) (MemMod.merge INVM cthM11_1) cthM'. Proof. intros. assert ((eqM cthM11_1 *^* eqM cthM11_2 *^* (eqM INVM *^* eqM cthM0)) cthM1). exists cthM11. exists cthM12. split; auto. split. exists cthM11_1. exists cthM11_2. unfold eqM. auto. exists INVM. exists cthM0. unfold eqM. auto. assert (MemMod.disjUnion (MemUpdW (MemMod.merge cthM11_2 cthM0) (sp-2) (pc+1) junk1) (MemMod.merge INVM cthM11_1) cthM'). subst cthM'. unfold MemUpdW. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left. assert ((eqM cthM11_2 *^* eqM cthM0 *^* (eqM INVM *^* eqM cthM11_1)) cthM1). sep on. sep matchH H4 with 4. unfold mstar at 1 in H3. InvertAll. unfold mstar in H3. InvertAll. unfold eqM in H3, H9. subst x1 x2. inversion_clear H6. subst x. unfold mstar in H7. InvertAll. unfold eqM in H7, H9. subst x x1. inversion_clear H6. subst x0. auto. apply MemMod.merge_presv_indom_left. eapply enter_BLK_grt2_auxc_hyp01; eauto. assert (MemMod.in_dom (sp - 2 + 1) (MemMod.merge cthM11_2 cthM0)). apply MemMod.merge_presv_indom_left. eapply enter_BLK_grt2_auxc_hyp02; eauto. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (sp - 2 + 1) (sp - 2)). exists (pc+1). auto. auto. assert (MemMod.disjUnion (MemUpdW cthM11_2 (sp - 2) (pc + 1) junk1) cthM0 (MemUpdW (MemMod.merge cthM11_2 cthM0) (sp - 2) (pc + 1) junk1)). unfold MemUpdW. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left. split; auto. assert ((eqM cthM11_2 *^* eqM cthM0 *^* (eqM INVM *^* eqM cthM11_1)) cthM1). sep on. sep matchH H4 with 4. unfold mstar at 1 in H6. InvertAll. unfold mstar in H6. InvertAll. unfold eqM in H6, H11. subst x1 x2. inversion_clear H8. auto. eapply enter_BLK_grt2_auxc_hyp01; eauto. assert (MemMod.in_dom (sp - 2 + 1) cthM11_2). eapply enter_BLK_grt2_auxc_hyp02; eauto. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (sp - 2 + 1) (sp - 2)). exists (pc+1). auto. auto. inversion_clear H6. rewrite H8 in H5. auto. Qed. Lemma enter_BLK_grt2_auxc_aux4: forall pc pc' M R fl isr M' R' fl' isr' cthM1 cthM11 cthM12 INVM cthM0 M0 cthM_oldStk R0 fl0 w wqa junk1 junk2 cthM2 cthM_old M'2, nextS pc (comml (_call _BLOCK)) (M, R, fl, isr) (M', R', fl', isr') -> MemMod.disjUnion cthM11 cthM12 cthM1 -> (R SP |-> w *^* R SP + 1 |-> junk2 *^* stkSpacePrec (R SP) (_BLK_Stk + 2)) cthM11 -> MemMod.disjUnion INVM cthM0 cthM12 -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1 *^* R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk) cthM_oldStk -> (INV0 *^* INV1) INVM -> (INV0 *^* INV1 *^* wqa) M0 -> MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old -> fl0 _IF = false -> fl _IF = false -> isr = false -> R0 SP = R' SP + 2 -> wrap_fun (gblk wqa) pc _BLOCK pc' (cthM1, R, fl, isr) (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk, R0, fl0, false). Proof. intros. unfold wrap_fun. unfold conjG. exists (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk, RF_update R0 SP (R0 SP - 2), fl0, false). split. assert (nextS pc (comml (_call _BLOCK)) (cthM1, R, fl, isr) (MemUpdW cthM1 (R SP - 2) (pc+1) junk1, RF_update R SP (R SP - 2), fl, isr)). apply nextS_call. unfold pushW. split. assert ((mTrue *^* (R SP |-> w *^* R SP + 1 |-> junk2 *^* stkSpacePrec (R SP) (_BLK_Stk + 2))) cthM1). exists cthM12. exists cthM11. split; auto with PMap. unfold mTrue. split; auto. sep on. sep lift 3 in H12. sep stksplit 2 in H12. sep lift 0 in H12. sep trivial. split; auto. apply MemUpdW_MemUpd16 with junk1; auto. set (cthM' := MemUpdW cthM1 (R SP - 2) (pc + 1) junk1) in *. exists (cthM', RF_update R SP (R SP - 2), fl, isr). split; auto. assert (R SP - 2 = R' SP). apply enter_SW_grt_auxb0_hyp0 with pc M fl isr M' fl' isr' _BLOCK; auto. unfold gblk. exists (R SP - 2). simplS. reg simpl. assert (R SP = R' SP + 2). rewrite <- H13. assert (R SP >= 2). apply ge_trans with (_BLK_Stk + 2). sep on. sep lift 2 in H1. apply stkSpacePrec_sp_ge_sz1 with cthM11 (R SP |-> w *^* R SP + 1 |-> junk2); auto. auto with arith. assert (R SP - 2 + 2 = R SP). auto. auto. rename H14 into HRSP'. split. unfold prepost. simplS. sep on. sep lift 2 in H1. sep stksplit in H1. destruct H1 as [cthM11_1 [cthM11_2 [HcthM11split [HcthM11_1 HcthM11_2]]]]. exists (MemMod.merge INVM cthM11_1). exists (MemMod.merge (MemUpdW cthM11_2 (R SP - 2) (pc+1) junk1) cthM0). sep lift 4 in H3. unfold mstar at 1 in H3. sep off. InvertAll. rename x into oldStk1. rename x0 into oldStk2. exists (MemMod.merge M0 oldStk1). split. exists INVM. exists cthM11_1. split; auto. split; auto. apply enter_BLK_grt2_auxc_hyp1 with cthM1 cthM11 cthM12 cthM11_2 cthM0; auto. split. exists M0. exists oldStk1. rewrite <- H13 in H3. split; auto. split; auto. apply enter_BLK_grt2_auxc_hyp2 with M'2 cthM_old (MemMod.merge cthM0 cthM2) cthM_oldStk oldStk2; auto. split. assert (MemMod.disjUnion (MemMod.merge (MemUpdW cthM11_2 (R SP - 2) (pc + 1) junk1) cthM0) (MemMod.merge INVM cthM11_1) cthM'). apply enter_BLK_grt2_auxc_hyp0 with cthM1 cthM11 cthM12 w junk2; auto. auto with PMap. assert (MemUpdW cthM11_2 (R SP - 2) (pc + 1) junk1 = oldStk2). apply enter_BLK_grt2_auxc_hyp3 with (R' SP) w junk2; auto. rewrite H14. apply enter_BLK_grt2_auxc_hyp4 with M'2 cthM_old cthM2; auto. rewrite <- H11 in HRSP'. rewrite <- HRSP'. split; auto. rewrite <- H8 in H9. auto. apply nextS_retw. exists (pc+1). unfold popW. reg simpl. split. rewrite H11. assert (R' SP + 2 - 2 = R' SP). auto. rewrite H12. sep on. assert (cthM_oldStk ||- R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1 *^* (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk)). sep matchH H3 with 5. sep off. apply enter_BLK_grt2_auxc_hyp5 with M'2 cthM_old cthM2 junk1 (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk); auto. rewrite H11. assert (R' SP + 2 - 2 = R' SP). auto. rewrite H12. rewrite <- H11. assert (RF_update R0 SP (R0 SP) = R0). apply RF_update_prev. auto. Qed. Lemma enter_BLK_grt2_auxc: forall cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk1 junk2 M0 M'2 cthM_old R0 fl0 (p p': Pred) M M' R' fl' isr' w wqa, MemMod.disjUnion cthM1 cthM2 cthM -> p (cthM1, R, fl, isr) -> NH_Inv fl cthM2 -> MemMod.disjUnion cthM11 cthM12 cthM1 -> (R SP |-> w *^* R SP + 1 |-> junk2 *^* stkSpacePrec (R SP) (_BLK_Stk + 2)) cthM11 -> MemMod.disjUnion INVM cthM0 cthM12 -> (INV0 *^* INV1) INVM -> MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1 *^* R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk) cthM_oldStk -> (INV0 *^* INV1 *^* wqa) M0 -> MemMod.disjUnion M0 cthM_old M'2 -> (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (cthM1, R, fl, isr)) p') -> fl0 _IF = false -> fl _IF = false -> nextS pc (comml (_call _BLOCK)) (M, R, fl, isr) (M', R', fl', isr') -> R0 SP = R' SP + 2 -> isr = false -> NH_pinvstar p' (S_Mem_Upd (cthM_old, R0, fl0, false) M'2). Proof. intros. unfold NH_pinvstar. unfold pmstar. exists (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). exists cthM2. split. assert (S_Mem (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) = M'2). auto. rewrite H16. clear H16. apply enter_SW_grt2_auxc_hyp0 with cthM_old; auto. assert (MemMod.disjoint cthM12 cthM2). apply MemMod.disj_merge_disj_right with cthM11. inversion_clear H2. subst cthM1. inversion_clear H. auto. apply MemMod.disj_merge_disj_right with INVM. inversion_clear H4. subst cthM12. auto. split. simplS. unfold pimp in H10. apply H10 with 0. apply enter_BLK_grt2_auxc_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM w junk1 junk2 cthM2 cthM_old M'2; auto. simplS. unfold NH_Inv. rewrite H11. unfold NH_Inv in H1. rewrite H12 in H1. auto. Qed. Lemma enter_BLK_grt2_hyp8: forall T RdyQ RdyQ' tid' B BlkQ w, RdyQ = addThrd RdyQ' tid' -> WF_TWQ T B RdyQ -> B w = Some BlkQ -> WQMod.not_in_dom tid' BlkQ. Proof. intros. unfold WF_TWQ in H0. InvertAll. unfold disj_RQ_WQ in H4. assert (WQMod.disjoint BlkQ RdyQ). apply H4 with w; auto. unfold WQMod.disjoint in H3. assert (WQMod.not_in_dom tid' BlkQ \/ WQMod.not_in_dom tid' RdyQ). apply H3. inversion_clear H5; auto. assert (WQMod.in_dom tid' RdyQ). unfold addThrd in H. rewrite H. unfold WQMod.in_dom. unfold WQMod.put. induction (WQMod.beq_A tid' tid'); auto. exists dummy_sglton. auto. absurd (tid' = tid'); auto. absurd (~ WQMod.in_dom tid' RdyQ); auto with PMap. Qed. Lemma enter_BLK_grt2_hyp9: forall T B RdyQ Q tid l rho, WF_currTID tid T B RdyQ rho -> WQSetMod.maps_to B l Q -> WQMod.not_in_dom tid Q. Proof. intros. unfold WF_currTID in H. InvertAll. unfold unblocked in H1. apply H1 with l; auto. Qed. Lemma enter_BLK_grt2_hypa: forall M'1 M21' M22 T T' B B' RdyQ RdyQ' BlkQ BlkQ' tid tid' w tcb, MemMod.disjUnion M21' M22 M'1 -> (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ' *^* ptoTQ w (filterTQ T' BlkQ')) M21' -> embed_WQSet T (WQSetMod.remove B w) M22 -> B' = WQSetMod.put B w BlkQ' -> B w = Some BlkQ -> BlkQ' = addThrd BlkQ tid -> T' = TQMod.put T tid tcb -> RdyQ = addThrd RdyQ' tid' -> WF_currTID tid T B RdyQ rho_ready -> (embed_curr_TCB T' tid' *^* (embed_RdyQ T' RdyQ' *^* embed_WQSet T' B')) M'1. Proof. intros. assert ((embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ' *^* ptoTQ w (filterTQ T' BlkQ') *^* embed_WQSet T (WQSetMod.remove B w)) M'1). exists M21'. exists M22. split; auto. sep on. sep lift 0 in H8. sep match_left H8; auto. sep match_left H8; auto. sep off. unfold mstar in H8. InvertAll. assert (embed_WQSet T' (WQSetMod.put (WQSetMod.remove B w) w BlkQ') M). apply wq_cons with x0 x; auto with PMap. subst T'. apply ext_unblockedT_presv_WQSet; auto. unfold WF_currTID in H7. InvertAll. unfold unblocked in *. intros. apply H5 with w0. unfold WQSetMod.remove in H14. unfold WQSetMod.maps_to in H14. induction (WQSetMod.beq_A w0 w). inversion H14. auto. assert (WQSetMod.put (WQSetMod.remove B w) w BlkQ' = WQSetMod.put B w BlkQ'). auto with PMap. subst B'. rewrite <- H12. auto. Qed. Lemma enable_blk_unique_args: forall S w w' wqa wqa', enable_blk w wqa S -> enable_blk w' wqa' S -> (w = w' /\ wqa = wqa'). Proof. unfold enable_blk. intros. InvertAll. induction S as (((M, R), fl), isr). UnfoldStateAll. assert ((mTrue *^* (R SP |->w w' *^* (INV0 *^* INV1 *^* stkSpacePrec (R SP) (_BLK_Stk + 2)))) M). unfold pmstar in H2. InvertAll. exists x. exists x0. split; auto. assert ((mTrue *^* (R SP |->w w *^* (INV0 *^* INV1 *^* stkSpacePrec (R SP) (_BLK_Stk + 2)))) M). unfold pmstar in H3. InvertAll. exists x. exists x0. split; auto. assert (w = w'). sep on. sep lift 1 in H4. sep lift 1 in H. apply ptoW_ptoW_eq1 with M (R SP) (INV0 *^* INV1 *^* stkSpacePrec (R SP) (_BLK_Stk + 2) *^* mTrue) (INV0 *^* INV1 *^* stkSpacePrec (R SP) (_BLK_Stk + 2) *^* mTrue); auto. subst w. split_l. rewrite H0 in H1. inversion H1. auto. Qed. Lemma enter_BLK_grt2_auxc_hyp6: forall cthM11 cthM11' sp sp' pc junk1 w junk2, (sp |->w w *^* stkSpacePrec sp (_BLK_Stk + 2)) cthM11 -> cthM11' = MemUpdW cthM11 sp' (pc + 1) junk1 -> (sp' |-> pc + 1 *^* sp' + 1 |-> junk1 *^* sp' + 2 |-> w *^* sp' + 3 |-> junk2 *^* stkSpacePrec sp' _BLK_Stk) cthM11' -> sp = sp' + 2 -> (sp |-> w *^* sp + 1 |-> junk2 *^* stkSpacePrec sp (_BLK_Stk + 2)) cthM11. Proof. intros. subst sp. sep on. sep lift 1 in H. sep stksplit in H. sep lift 1 in H. destruct H as [cthM11_1 [cthM11_2 [HcthM11split [HcthM11_1 HcthM11_2]]]]. assert (MemMod.disjUnion (MemUpdW cthM11_1 sp' (pc+1) junk1) cthM11_2 cthM11'). subst cthM11'. unfold MemUpdW. assert (MemMod.in_dom sp' cthM11_1 /\ MemMod.in_dom (sp' + 1) cthM11_1). assert (exists v, cthM11_1 ||- sp' |->w v). apply ptoxW_ptoW; auto. sep off. inversion H. apply ptoW_indom with x; auto. inversion_clear H. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left; auto. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (sp' + 1) sp'). exists (pc+1); auto. auto. assert (cthM11' ||- sp' |-> pc + 1 *^* sp' + 1 |-> junk1 *^* (sp' + 2 |-> w *^* sp' + 3 |-> junk2 *^* stkSpacePrec sp' _BLK_Stk)). sep matchH H1 with 5. clear H1. destruct H2 as [cthM11'1 [cthM11'2 [Hsplit' [H11'1 H11'2]]]]. assert (cthM11_2 = cthM11'2). assert ((sp' + 2 |->w w *^* stkSpacePrec sp' _BLK_Stk) cthM11'2). apply ptoW_intro1 with junk2; auto. assert (sp' + 2 + 1 = sp' + 3). auto. rewrite H1. auto. assert (precise (sp' + 2 |->w w *^* stkSpacePrec sp' _BLK_Stk)). apply mstar_presv_prec. apply ptoW_precise. apply precise_stkSpacePrec. unfold precise in H2. apply H2 with cthM11'; auto. apply MemMod.disjUnion_subseteq_right with (MemUpdW cthM11_1 sp' (pc + 1) junk1); auto. apply MemMod.disjUnion_subseteq_right with cthM11'1; auto. rewrite <- H1 in H11'2. sep lift 2. sep stksplit. sep lift 1. exists cthM11_1. exists cthM11_2. split; auto. split; auto. assert (sp' + 2 + 1 = sp' + 3). auto. rewrite H2. auto. Qed. (* >>>>>>>>>>>>>> *) Lemma enter_BLK_grt: forall D psi pc theta D' Psi Psi' Psi'0 S S', NH_WFcmd psi pc theta (comml (_call _BLOCK)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> subsetCT Psi' Psi'0 -> Itp_AIM rho_ready theta Psi'0 S -> nextS pc (comml (_call _BLOCK)) S S' -> WFST D rho_prim 0 Psi'0 (scap_lift_g BLK_grt S'). Proof. intros. unfold WFST. intros. unfold scap_lift_g in H7. InvertAll. induction S' as (((M', R'), fl'), isr'). induction S as (((M, R), fl), isr). unfold S_ISR at 1 in H7. unfold S_Flag at 1 in H10. induction theta. rename n into tag. unfold Itp_AIM in H5. unfold pmstar in H5. InvertAll. rename x into T. rename x0 into B. rename x1 into RdyQ. rename x2 into tid. rename x3 into M1. rename x4 into M2. assert (exists TM, exists cthM, exists M12, exists cthM1, exists cthM2, MemMod.disjUnion M12 cthM M1 /\ MemMod.disjUnion cthM1 cthM2 cthM /\ WF_currTID tid T B RdyQ rho_ready /\ WF_TWQ T B RdyQ /\ exists_Idle T RdyQ tid /\ WF_WQ_WQSpec B Delta /\ MemSplit (ThrdMemMod.remove TM tid) M12 /\ ThrdMemMod.maps_to TM tid cthM /\ WF_Curr_Thrd Psi'0 (S_Mem_Upd (M1, R, fl, isr) cthM) rho_ready (Ast p g tag) T tid /\ WF_ReadyQ Psi'0 T RdyQ TM /\ WF_WQSet Psi'0 T B TM /\ p (cthM1, R, fl, isr) /\ NH_Inv fl cthM2 /\ (tag = 1 -> NH_WFST rho_ready Psi'0 (NH_ItpG g (cthM, R, fl, isr)))). apply decompose_World; auto. InvertAll. rename x into TM. rename x0 into cthM. rename x1 into M12. rename x2 into cthM1. rename x3 into cthM2. (* (M, R, fl, isr) ---> call ----> (M', R', fl', isr') *) (* (M', R', fl', isr') ---> BLK_grt ---> S0 *) (* M: H9 : MemMod.disjUnion M1 M2 M *) (* M1 : H5 *) (* M2 : H12 *) (* M1 : H11 : MemMod.disjUnion M12 cthM M1 *) (* M12 : H18 *) (* cthM : H19 *) (* cthM : H13 : MemMod.disjUnion cthM1 cthM2 cthM *) (* cthM1 : H23 *) (* cthM2 : H24 *) (* tid not in RdyQ *) assert (WQMod.not_in_dom tid RdyQ). unfold WF_currTID in H14. InvertAll. auto. unfold NH_WFcmd in H. inversion_clear H. clear H28. induction H27. inversion_clear H. clear H27. assert (exists w, exists wqa, enable_blk w wqa (cthM1, R, fl, isr)). apply NH_Call_blk_enable with psi pc p g tag; auto. InvertAll. rename x into w. rename x0 into wqa. unfold NH_Call_Prim in H28. inversion_clear H28. inversion H27. absurd (_BLOCK <> _SWITCH); auto. clear H28. inversion H30. subst p0 g0 tag0. clear H30. clear H27. (* BlkQ *) assert (exists BlkQ, B w = Some BlkQ /\ Delta w = SomeT wqa /\ (pmstar pTrue (mstar (ptoW (S_RF (cthM1, R, fl, isr) SP) w) (mstar (mstar INV0 INV1) (stkSpacePrec (S_RF (cthM1, R, fl, isr) SP) (_BLK_Stk + 2)) ) ) ) (cthM1, R, fl, isr)). apply WF_AIM_World_blk2 with Psi'0 (M1, R, fl, isr) T RdyQ tid p g tag; auto. InvertAll. rename x into BlkQ. unfold S_RF in H33. assert (exists cthM11, exists cthM12, MemMod.disjUnion cthM11 cthM12 cthM1 /\ (R SP |->w w *^* stkSpacePrec (R SP) (_BLK_Stk + 2)) cthM11 /\ (INV0 *^* INV1 *^* mTrue) cthM12). apply enter_BLK_grt_hyp0 with R fl isr; auto. InvertAll. rename x into cthM11. rename x0 into cthM12. (* cthM1 : H34 : MemMod.disjUnion cthM11 cthM12 cthM1 *) (* cthM11 : H30 *) (* cthM12 : H36 *) assert (disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11 :: nil) M). apply mem_list_compose_a with cthM1 cthM M1; auto. assert (exists junk, (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk *^* (R' SP + 2 |->w w) *^* (stkSpacePrec (R' SP) _BLK_Stk)) (MemUpdW cthM11 (R' SP) (pc + 1) junk) /\ disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: (MemUpdW cthM11 (R' SP) (pc + 1) junk) :: nil) M'). apply call_fun_frame2 with M R fl fl' isr isr' _BLOCK; auto. InvertAll. rename x into junk1. set (cthM11' := MemUpdW cthM11 (R' SP) (pc + 1) junk1) in *. assert (((embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* (ptoTQ w (filterTQ T BlkQ))) *^* (embed_WQSet T (WQSetMod.remove B w))) M2). apply split_blk_Q; auto. unfold mstar at 1 in H38. InvertAll. rename x into M21. rename x0 into M22. assert (exists M1', exists M2', MemMod.disjUnion cthM11' M21 M1' /\ disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' /\ MemMod.disjUnion M1' M2' M'). apply mem_list_compose_b with M2; auto. InvertAll. rename x into M1'. rename x0 into M2'. (* tid and tcb *) assert (exists tcb, T tid = Some tcb /\ TCB_Status tcb = READY). unfold WF_currTID in H14. InvertAll. exists x. unfold rho_tcb_consistent in H50. inversion_clear H50. split. unfold TQMod.maps_to in H48. auto. apply H49; auto. InvertAll. rename x into tcb. assert (exists junk2, (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1 *^* R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk) cthM11'). sep on. sep lift 2 in H37. assert (exists junk, cthM11' ||- R' SP + 2 |-> w *^* R' SP + 2 + 1|-> junk *^* (stkSpacePrec (R' SP) _BLK_Stk *^* (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1))). apply ptoW_elim1; auto. inversion H46. exists x. sep on. sep matchH H48 with 5. assert (R' SP + 2 + 1 = R' SP + 3). omega. rewrite H49 in H48. auto. substH H37 with H46. clear H46. destruct H37 as [junk2 H37]. unfold BLK_grt in H8. assert (exists M0' : MemMod.Map, exists RdyQ' : WQ, exists tid' : TID, exists sp' : nat, exists tcb' : Thread, MemMod.disjUnion M0' M2' (S_Mem S0) /\ RdyQ = addThrd RdyQ' tid' /\ BLK_Post_aux (TQMod.put T tid ((R' SP), BLOCKED, pc+1)) RdyQ' (addThrd BlkQ tid) tid' sp' (R' SP) w tcb' (pc+1) junk1 junk2 (S_Mem_Upd S0 M0')). apply H8 with M1' T BlkQ tid tcb; auto. unfold BLK_Prd_aux. split. assert (S_Mem (S_Mem_Upd (M', R', fl', isr') M1') = M1'). auto. rewrite H46. apply mem_compose_c_blk with cthM11' M21; auto. split; auto. split. auto. split. apply WF_AIM_World_RdyQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B tid rho_ready (Ast p g tag). auto. split. apply WF_AIM_World_BlkQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ready (Ast p g tag) w; auto. split; auto. split; auto. split. auto. split. apply WF_AIM_World_cthNotBlk with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) T B RdyQ (Ast p g tag) w rho_ready; auto. split. apply WF_AIM_World_RdyNotBlk with Psi'0 (M1, R, fl, isr) T B tid (Ast p g tag) w rho_ready; auto. apply WF_AIM_World_WFTQ with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ready (Ast p g tag); auto. clear H8. InvertAll. rename x into M0'. rename x0 into RdyQ'. rename x1 into tid'. rename x2 into sp'. rename x3 into tcb'. (* fl and isr *) assert ((fl _IF = false) /\ (isr = false)). assert (S_Flag (cthM1, R, fl, isr) _IF = false). apply H29; auto. split. unfold S_Flag in H48. auto. unfold WF_Curr_Thrd in H20. assert (beq_nat rho_ready rho_ih = false). simpl. auto. rewrite H50 in H20. unfold itp_NH_theta in H20. InvertAll. UnfoldStateAll. auto. inversion_clear H48. assert (tid = tid' \/ tid <> tid'). apply nat_eq_neq_dec. inversion_clear H48. (* tid = tid' : contradition *) assert (WQMod.in_dom tid' RdyQ). unfold addThrd in H8. rewrite H8. unfold WQMod.put. unfold WQMod.in_dom. induction (WQMod.beq_A tid' tid'). exists dummy_sglton. auto. absurd (tid' = tid'); auto. rewrite <- H52 in H48. absurd (~ WQMod.in_dom tid RdyQ); auto with PMap. (* tid <> tid' *) assert (WQMod.in_dom tid' RdyQ). unfold addThrd in H8. rewrite H8. unfold WQMod.put. unfold WQMod.in_dom. induction (WQMod.beq_A tid' tid'). exists dummy_sglton. auto. absurd (tid' = tid'); auto. assert (WF_ReadyQ Psi'0 T RdyQ TM). auto. unfold WF_ReadyQ in H21. assert (exists tcb : Thread, TQMod.maps_to T tid' tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid' M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi'0 M tcb \/ WF_Rdy_Thrd_IH Psi'0 M tcb))). apply H21. auto. InvertAll. rename x into tcb''. rename x0 into cthMR. clear H21. induction tcb'' as ((sp'', status''), pc''). exists pc''. assert (tcb' = (sp'', status'', pc'') /\ sp' = sp'' /\ S_RF S0 SP = sp'). unfold BLK_Post_aux in H49. InvertAll. assert (tcb' = (sp'', status'', pc'')). assert (TQMod.maps_to T tid' tcb'). unfold TQMod.maps_to in H21. unfold TQMod.put in H21. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. unfold TQMod.maps_to. auto. unfold TQMod.maps_to in H61. unfold TQMod.maps_to in H54. rewrite H61 in H54. inversion H54. auto. split; auto. split; auto. rewrite H61 in H49. auto. inversion_clear H21. inversion_clear H60. unfold TCB_PC in H56. unfold TCB_SP in H56. split. apply enter_SW_grt2_hyp1 with TM tid tid' cthMR sp'' M0' M2' M22 M12 cthM2 cthM12; auto. rewrite <- H21. auto. inversion_clear H59. (* not in interrupt handler *) unfold WF_Rdy_Thrd in H60. InvertAll. rename x into rho'. rename x0 into pR. rename x1 into gR. rename x2 into tagR. clear H62. exists (packS0 rho' (Ast pR gR tagR)). split; auto. intros. unfold Itp0. assert (D rho' = SomeT1 _ (Itp_AIM rho')). apply non_ih_spec_miniD; auto. rewrite H64. clear H64. unfold Itp_AIM. exists (TQMod.put T tid (R' SP, BLOCKED, pc + 1)). set (T' := TQMod.put T tid (R' SP, BLOCKED, pc + 1)). exists (WQSetMod.put B w (addThrd BlkQ tid)). exists RdyQ'. exists tid'. set (BlkQ' := addThrd BlkQ tid). set (B' := WQSetMod.put B w BlkQ'). assert (exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ (INV0 *^* INV1) INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ' *^* ptoTQ w (filterTQ T' BlkQ')) M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old /\ (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk1 *^* R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S')). apply enter_BLK_grt2_hyp2 with T B sp' tcb' pc' S0 M0' M2'; auto. unfold NH_Inv. rewrite <- H10. assert (S_Flag (M, R, fl, isr) _IF = S_Flag (M', R', fl', isr') _IF /\ S_ISR (M, R, fl, isr) = S_ISR (M', R', fl', isr')). apply enter_SW_grt_auxb0_hyp4 with pc _BLOCK; auto. inversion_clear H64. unfold S_Flag in H66. rewrite <- H66. unfold NH_Inv in H24. auto. InvertAll. rename x into INVM. rename x0 into cthM0. rename x1 into M21'. rename x2 into M122. rename x3 into cthM_old. rename x4 into cthM_oldStk. unfold pmstar. assert ( exists M'0, exists M'1, MemMod.disjUnion M'0 M'1 (S_Mem S') /\ MemMod.disjUnion M21' M22 M'1 /\ disjUnionList (cthMR :: INVM :: cthM_old :: M122 :: nil) M'0 ). apply enter_SW_grt2_hyp3; auto. InvertAll. rename x into M'0. rename x0 into M'1. exists M'0. exists M'1. split; auto. split. unfold WF_AIM_World. split. assert (WF_currTID tid' T' B RdyQ' rho'). apply enter_BLK_grt2_hyp4 with T RdyQ tid (R' SP, BLOCKED, pc + 1) (sp'', status'', pc'') rho_ready; auto. unfold BLK_Post_aux in H49. InvertAll. auto. apply ext_B_presv_wffTID with B BlkQ w tid; auto. split. apply enter_BLK_grt2_hyp5 with T RdyQ tid (R' SP) (pc+1) tcb; auto. unfold BLK_Post_aux in H49. InvertAll. auto. split. apply enter_BLK_grt2_aux6 with RdyQ tid tid' tcb (R' SP, BLOCKED, pc + 1) B T rho_ready w BlkQ; auto. split. apply extB_presv_WF_WQ_WQSpec with B w BlkQ BlkQ'; auto. exists (ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). set (TM' := ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). exists (MemMod.merge cthMR INVM). set (cthM' := MemMod.merge cthMR INVM). split. assert (S_Mem (S_Mem_Upd S' M'0) = M'0). auto. rewrite H75. apply enter_SW_grt2_hyp7 with cthMR INVM cthM_old M122 TM tid tid'; auto. split. unfold cthM'. unfold TM'. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. induction (ThrdMemMod.beq_A tid' tid'). auto. absurd (tid' = tid'); auto. split. unfold WF_Curr_Thrd. assert (beq_nat rho' rho_ih = false). apply neq_beq_false. inversion_clear H59. rewrite H75. discriminate. rewrite H75. discriminate. rewrite H75. unfold itp_NH_theta. assert (S_ISR S' = false). apply enter_SW_grt2_hyp8 with pc pc' M R fl isr M' R' fl' isr' S0 _BLOCK; auto. split. UnfoldStateAll. auto. assert ((INV0 *^* INV1 -* itp_NH_theta rho' (Ast pR gR tagR) Psi'0) (cthMR, S_RF S', S_Flag S', false)). apply H65. rewrite H21 in H61. apply enter_SW_grt2_hyp9 with S0 pc'; auto. assert (S_ISR (M, R, fl, isr) = S_ISR S' /\ S_Flag (M, R, fl, isr) _IF = S_Flag S' _IF). apply enter_SW_grt_hyp9 with pc pc' _BLOCK (M', R', fl', isr') S0; auto. inversion_clear H78. rewrite <- H80. unfold S_Flag. auto. assert (itp_NH_theta rho' (Ast pR gR tagR) Psi'0 (cthM', S_RF S', S_Flag S', false)). unfold cthM'. unfold pm_mwand in H78. assert ((MemMod.merge cthMR INVM, S_RF S', S_Flag S', false) = S_Mem_Upd (cthMR, S_RF S', S_Flag S', false) (MemMod.merge cthMR INVM)). auto. rewrite H79. apply H78 with INVM; auto. unfold S_Mem. assert (MemMod.disjUnion cthMR INVM (MemMod.merge cthMR INVM)). unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_hypa with M22 M21' cthM_old M122 S'; auto. auto with PMap. assert (S_Mem_Upd (S_Mem_Upd S' M'0) cthM' = (cthM', S_RF S', S_Flag S', false)). induction S' as (((M'', R''), fl''), isr''). UnfoldStateAll. auto. rewrite H77. auto. rewrite H80. clear H80. unfold itp_NH_theta in H79. inversion_clear H79. auto. split. unfold WF_ReadyQ. intros. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H77. (* tid0 = tid: contradiciton *) assert (WQMod.in_dom tid0 RdyQ). rewrite H8. unfold addThrd. unfold WQMod.in_dom, WQMod.put. induction (WQMod.beq_A tid0 tid'). rewrite a in H75. assert (WQMod.not_in_dom tid' RdyQ'). unfold BLK_Post_aux in H49. InvertAll. auto. absurd (~ WQMod.in_dom tid' RdyQ'); auto with PMap. auto. rewrite H78 in H77. absurd (~WQMod.in_dom tid RdyQ); auto with PMap. (* tid0 <> tid : other ready threads *) assert (WQMod.not_in_dom tid' RdyQ'). unfold BLK_Post_aux in H49. InvertAll. auto. unfold WF_ReadyQ in H53. assert (exists tcb : Thread, TQMod.maps_to T tid0 tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid0 M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi'0 M tcb \/ WF_Rdy_Thrd_IH Psi'0 M tcb))). apply H53; auto. rewrite H8. unfold addThrd. unfold WQMod.in_dom, WQMod.put. induction (WQMod.beq_A tid0 tid'). rewrite a in H75. absurd (~ WQMod.in_dom tid' RdyQ'); auto with PMap. auto. InvertAll. exists x. split. unfold T'. unfold TQMod.put, TQMod.maps_to. induction (TQMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold TQMod.maps_to in H79. auto. split; auto. exists x0. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). rewrite a in H75. absurd (~ WQMod.in_dom tid' RdyQ'); auto with PMap. unfold ThrdMemMod.maps_to in H82. auto. unfold WF_WQSet. intros. assert (l = w \/ l <> w). apply nat_eq_neq_dec. inversion H78. (* l = w *) clear H78. rewrite H79 in H75. unfold B' in H75. unfold WQSetMod.maps_to, WQSetMod.put in H75. induction (WQSetMod.beq_A w w). inversion H75. rewrite <- H80 in H77. rewrite H79. clear H80 H79 H75 a Q l. unfold BlkQ' in H77. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H75. (* tid0 = tid *) exists (R' SP, BLOCKED, pc + 1). exists cthM_old. rewrite H78. split. unfold T'. unfold TQMod.put, TQMod.maps_to. induction (TQMod.beq_A tid tid). auto. absurd (tid = tid); auto. split. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid tid); auto. absurd (tid = tid); auto. unfold WF_Wait_Thrd. split; auto. split. assert ((R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1 *^* (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk)) cthM_oldStk). sep on. sep matchH H71 with 5. sep on. assert (cthM_oldStk ||- R' SP |->w pc + 1 *^* (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk)). apply ptoW_intro1 with junk1; auto. clear H75 H71. assert (cthM_old ||- mTrue *^* (R' SP |->w pc + 1 *^* (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk))). exists (MemMod.merge cthM0 cthM2). exists cthM_oldStk. split; auto. split_r. unfold mTrue. auto. sep lift 1 in H71. sep trivial. exists wqa. split; auto. exists p'. exists g'. exists tag. split. apply psi_sw_lookupNPC with psi Psi Psi'; auto. intros. unfold pm_mwand. unfold S_Mem. intros. unfold itp_NH_theta. split. UnfoldStateAll. auto. split. apply enter_BLK_grt2_auxc with cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk1 junk2 M0 p M M' R' fl' isr' w wqa; auto. apply enter_BLK_grt2_auxc_hyp6 with cthM11' (R' SP) pc junk1; auto. assert (R SP - 2 = R' SP). eapply enter_SW_grt_auxb0_hyp0; eauto. assert (R SP >= 2). apply ge_trans with (_BLK_Stk + 2); auto with arith. unfold mstar in H30. InvertAll. apply stkSpacePrec_sp_ge_sz with x0; auto. rewrite <- H82. assert (R SP - 2 + 2 = R SP). auto. auto. assert (exists w : nat, exists wqa : WQassert, enable_blk w wqa (cthM1, R, fl, isr) /\ (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (cthM1, R, fl, isr)) p') /\ (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (cthM1, R, fl, isr) |> g') (g (cthM1, R, fl, isr)))). apply H32; auto. InvertAll. assert (w = x /\ wqa = x0). apply enable_blk_unique_args with (cthM1, R, fl, isr); auto. inversion_clear H84. rewrite H87. auto. (* WFST *) intro. assert (NH_WFST rho_ready Psi'0 (NH_ItpG g (cthM, R, fl, isr))). apply H26. auto. clear H26. clear H82. apply NH_WFST_strengthen with (cthM, R, fl, isr) g; auto. unfold pimp. intros. unfold NH_ItpG. unfold NH_ItpG in H26. InvertAll. rename x into M'20. rename x0 into M'21. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split; auto. split; auto. split. unfold S_Flag. auto. split. auto. assert (exists w : nat, exists wqa : WQassert, enable_blk w wqa (cthM1, R, fl, isr) /\ (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (cthM1, R, fl, isr)) p') /\ (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (cthM1, R, fl, isr) |> g') (g (cthM1, R, fl, isr)))). apply H32; auto. InvertAll. assert (w = x /\ wqa = x0). apply enable_blk_unique_args with (cthM1, R, fl, isr); auto. inversion_clear H89. rewrite <- H92 in H90. clear H92 H91 H86 H88 x0 x. unfold pimp in H90. apply H90 with pc'. clear H90. unfold linkPG. exists (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20). split; auto. assert (M'20 = MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). apply enter_SW_grt2_hype with cthM_old M'2 cthM2 M'21 fl fl0; auto. assert (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20 = (M'20, R0, fl0, false)). UnfoldStateAll. auto. rewrite H88. clear H88. rewrite H86. apply enter_BLK_grt2_auxc_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM w junk1 junk2 cthM2 cthM_old M'2; auto. apply enter_BLK_grt2_auxc_hyp6 with cthM11' (R' SP) pc junk1; auto. assert (R SP - 2 = R' SP). eapply enter_SW_grt_auxb0_hyp0; eauto. assert (R SP >= 2). apply ge_trans with (_BLK_Stk + 2); auto with arith. unfold mstar in H30. InvertAll. apply stkSpacePrec_sp_ge_sz with x0; auto. rewrite <- H88. assert (R SP - 2 + 2 = R SP). auto. auto. (* end of WFST *) assert (WQMod.in_dom tid0 BlkQ). unfold addThrd in H77. unfold WQMod.put, WQMod.in_dom in H77. induction (WQMod.beq_A tid0 tid). contradiction. auto. unfold WF_WQSet in H22. assert (exists tcb : Thread, exists M : Mem, TQMod.maps_to T tid0 tcb /\ ThrdMemMod.maps_to TM tid0 M /\ WF_Wait_Thrd Psi'0 M tcb w). apply H22 with BlkQ; auto. InvertAll. exists x. exists x0. split. unfold T'. unfold TQMod.maps_to, TQMod.put. induction (TQMod.beq_A tid0 tid). contradiction. auto. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). contradiction. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). assert (WQMod.not_in_dom tid' BlkQ). apply enter_BLK_grt2_hyp8 with T RdyQ RdyQ' B w; auto. rewrite <- a in H81. absurd (~ WQMod.in_dom tid0 BlkQ); auto with PMap. auto. absurd (w = w); auto. clear H78. assert (WQSetMod.maps_to B l Q). unfold B' in H75. unfold WQSetMod.maps_to, WQSetMod.put in H75. induction (WQSetMod.beq_A l w). contradiction. auto. unfold WF_WQSet in H22. assert (exists tcb : Thread, exists M : Mem, TQMod.maps_to T tid0 tcb /\ ThrdMemMod.maps_to TM tid0 M /\ WF_Wait_Thrd Psi'0 M tcb l). apply H22 with Q; auto. InvertAll. exists x. exists x0. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H82. assert (WQMod.not_in_dom tid Q). apply enter_BLK_grt2_hyp9 with T B RdyQ l rho_ready; auto. rewrite <- H84 in H82. absurd (~ WQMod.in_dom tid0 Q); auto with PMap. split. unfold T'. unfold TQMod.maps_to, TQMod.put. induction (TQMod.beq_A tid0 tid). contradiction. auto. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). contradiction. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). assert (WQMod.not_in_dom tid' Q). apply enter_BLK_grt2_hyp8 with T RdyQ RdyQ' B l; auto. rewrite <- a in H82. absurd (~ WQMod.in_dom tid0 Q); auto with PMap. auto. apply enter_BLK_grt2_hypa with M21' M22 T B RdyQ BlkQ BlkQ' tid w (R' SP, BLOCKED, pc+1); auto. (* tid' is in interrupt hander *) unfold WF_Rdy_Thrd_IH in H60. InvertAll. rename x into p''. rename x0 into g''. rename x1 into tag''. exists (packS0 rho_ih (Ast p'' g'' tag'')). split; auto. intros. unfold Itp0. assert (D rho_ih = SomeT1 _ (Itp_AIM rho_ih)). unfold Minimal_D in H0. InvertAll. auto. rewrite H64. clear H64. unfold Itp_AIM. exists (TQMod.put T tid (R' SP, BLOCKED, pc + 1)). set (T' := TQMod.put T tid (R' SP, BLOCKED, pc + 1)). exists (WQSetMod.put B w (addThrd BlkQ tid)). exists RdyQ'. exists tid'. set (BlkQ' := addThrd BlkQ tid). set (B' := WQSetMod.put B w BlkQ'). assert (exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ (INV0 *^* INV1) INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ' *^* ptoTQ w (filterTQ T' BlkQ')) M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old /\ (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk1 *^* R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S')). apply enter_BLK_grt2_hyp2 with T B sp' tcb' pc' S0 M0' M2'; auto. unfold NH_Inv. rewrite <- H10. assert (S_Flag (M, R, fl, isr) _IF = S_Flag (M', R', fl', isr') _IF /\ S_ISR (M, R, fl, isr) = S_ISR (M', R', fl', isr')). apply enter_SW_grt_auxb0_hyp4 with pc _BLOCK; auto. inversion_clear H64. unfold S_Flag in H65. rewrite <- H65. unfold NH_Inv in H24. auto. InvertAll. rename x into INVM. rename x0 into cthM0. rename x1 into M21'. rename x2 into M122. rename x3 into cthM_old. rename x4 into cthM_oldStk. unfold pmstar. assert ( exists M'0, exists M'1, MemMod.disjUnion M'0 M'1 (S_Mem S') /\ MemMod.disjUnion M21' M22 M'1 /\ disjUnionList (cthMR :: INVM :: cthM_old :: M122 :: nil) M'0 ). apply enter_SW_grt2_hyp3; auto. InvertAll. rename x into M'0. rename x0 into M'1. exists M'0. exists M'1. split; auto. split. unfold WF_AIM_World. assert (WQMod.not_in_dom tid' RdyQ'). unfold BLK_Post_aux in H49. InvertAll. auto. split. assert (WF_currTID tid' T' B RdyQ' rho_ih). apply enter_BLK_grt2_hyp4 with T RdyQ tid (R' SP, BLOCKED, pc + 1) (sp'', status'', pc'') rho_ready; auto. apply ext_B_presv_wffTID with B BlkQ w tid; auto. split. apply enter_BLK_grt2_hyp5 with T RdyQ tid (R' SP) (pc+1) tcb; auto. split. apply enter_BLK_grt2_aux6 with RdyQ tid tid' tcb (R' SP, BLOCKED, pc + 1) B T rho_ready w BlkQ; auto. split. apply extB_presv_WF_WQ_WQSpec with B w BlkQ BlkQ'; auto. exists (ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). set (TM' := ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). exists (MemMod.merge cthMR INVM). set (cthM' := MemMod.merge cthMR INVM). split. assert (S_Mem (S_Mem_Upd S' M'0) = M'0). auto. rewrite H76. apply enter_SW_grt2_hyp7 with cthMR INVM cthM_old M122 TM tid tid'; auto. split. unfold cthM'. unfold TM'. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. induction (ThrdMemMod.beq_A tid' tid'). auto. absurd (tid' = tid'); auto. split. unfold WF_Curr_Thrd. assert (beq_nat rho_ih rho_ih = true). simpl. auto. rewrite H76. assert ((INV0 *^* INV1 -* itp_IH_theta (Ast p'' g'' tag'') status'' Psi'0) (cthMR, S_RF S', S_Flag S', false)). apply H63. rewrite H21 in H61. apply enter_SW_grt2_hyp9 with S0 pc'; auto. assert (S_ISR (M, R, fl, isr) = S_ISR S' /\ S_Flag (M, R, fl, isr) _IF = S_Flag S' _IF). apply enter_SW_grt_hyp9 with pc pc' _BLOCK (M', R', fl', isr') S0; auto. inversion_clear H77. rewrite <- H79. unfold S_Flag. auto. exists (sp'', status'', pc''). exists status''. split. unfold TQMod.maps_to. unfold T'. unfold TQMod.put. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. auto. split; auto. unfold pm_mwand in H77. assert (S_ISR S' = false). apply enter_SW_grt2_hyp8 with pc pc' M R fl isr M' R' fl' isr' S0 _BLOCK; auto. assert (itp_IH_theta (Ast p'' g'' tag'') status'' Psi'0 (S_Mem_Upd (cthMR, S_RF S', S_Flag S', false) cthM')). apply H77 with INVM; auto. unfold S_Mem. unfold cthM'. assert (MemMod.disjUnion cthMR INVM (MemMod.merge cthMR INVM)). unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_hypa with M22 M21' cthM_old M122 S'; auto. auto with PMap. rewrite <- H78 in H79. UnfoldStateAll. auto. split. (* WF_ReadyQ *) unfold WF_ReadyQ. intros. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H77. (* tid0 = tid: contradiciton *) assert (WQMod.in_dom tid0 RdyQ). rewrite H8. unfold addThrd. unfold WQMod.in_dom, WQMod.put. induction (WQMod.beq_A tid0 tid'). rewrite a in H76. assert (WQMod.not_in_dom tid' RdyQ'). unfold BLK_Post_aux in H50. InvertAll. auto. absurd (~ WQMod.in_dom tid' RdyQ'); auto with PMap. auto. rewrite H78 in H77. absurd (~WQMod.in_dom tid RdyQ); auto with PMap. (* tid0 <> tid : other ready threads *) assert (WQMod.not_in_dom tid' RdyQ'). unfold BLK_Post_aux in H49. InvertAll. auto. unfold WF_ReadyQ in H53. assert (exists tcb : Thread, TQMod.maps_to T tid0 tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid0 M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi'0 M tcb \/ WF_Rdy_Thrd_IH Psi'0 M tcb))). apply H53; auto. rewrite H8. unfold addThrd. unfold WQMod.in_dom, WQMod.put. induction (WQMod.beq_A tid0 tid'). rewrite a in H76. absurd (~ WQMod.in_dom tid' RdyQ'); auto with PMap. auto. InvertAll. exists x. split. unfold T'. unfold TQMod.put, TQMod.maps_to. induction (TQMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold TQMod.maps_to in H79. auto. split; auto. exists x0. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). rewrite a in H76. absurd (~ WQMod.in_dom tid' RdyQ'); auto with PMap. unfold ThrdMemMod.maps_to in H82. auto. unfold WF_WQSet. intros. assert (l = w \/ l <> w). apply nat_eq_neq_dec. inversion H78. (* l = w *) clear H78. rewrite H79 in H76. unfold B' in H76. unfold WQSetMod.maps_to, WQSetMod.put in H76. induction (WQSetMod.beq_A w w). inversion H76. rewrite <- H80 in H77. rewrite H79. clear H80 H79 H76 a Q l. unfold BlkQ' in H77. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H76. (* tid0 = tid *) exists (R' SP, BLOCKED, pc + 1). exists cthM_old. rewrite H78. split. unfold T'. unfold TQMod.put, TQMod.maps_to. induction (TQMod.beq_A tid tid). auto. absurd (tid = tid); auto. split. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid tid); auto. absurd (tid = tid); auto. unfold WF_Wait_Thrd. split; auto. split. assert ((R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1 *^* (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk)) cthM_oldStk). sep on. sep matchH H70 with 5. sep on. assert (cthM_oldStk ||- R' SP |->w pc + 1 *^* (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk)). apply ptoW_intro1 with junk1; auto. assert (cthM_old ||- mTrue *^* (R' SP |->w pc + 1 *^* (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _BLK_Stk))). exists (MemMod.merge cthM0 cthM2). exists cthM_oldStk. split; auto. split_r. unfold mTrue. auto. sep lift 1 in H80. sep trivial. exists wqa. split; auto. exists p'. exists g'. exists tag. split. apply psi_sw_lookupNPC with psi Psi Psi'; auto. intros. unfold pm_mwand. unfold S_Mem. intros. unfold itp_NH_theta. split. UnfoldStateAll. auto. split. apply enter_BLK_grt2_auxc with cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk1 junk2 M0 p M M' R' fl' isr' w wqa; auto. apply enter_BLK_grt2_auxc_hyp6 with cthM11' (R' SP) pc junk1; auto. assert (R SP - 2 = R' SP). eapply enter_SW_grt_auxb0_hyp0; eauto. assert (R SP >= 2). apply ge_trans with (_BLK_Stk + 2); auto with arith. unfold mstar in H30. InvertAll. apply stkSpacePrec_sp_ge_sz with x0; auto. rewrite <- H82. assert (R SP - 2 + 2 = R SP). auto. auto. assert (exists w : nat, exists wqa : WQassert, enable_blk w wqa (cthM1, R, fl, isr) /\ (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (cthM1, R, fl, isr)) p') /\ (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (cthM1, R, fl, isr) |> g') (g (cthM1, R, fl, isr)))). apply H32; auto. InvertAll. assert (w = x /\ wqa = x0). apply enable_blk_unique_args with (cthM1, R, fl, isr); auto. inversion_clear H84. rewrite H87. auto. (* WFST *) intro. assert (NH_WFST rho_ready Psi'0 (NH_ItpG g (cthM, R, fl, isr))). apply H26. auto. clear H26. clear H82. apply NH_WFST_strengthen with (cthM, R, fl, isr) g; auto. unfold pimp. intros. unfold NH_ItpG. unfold NH_ItpG in H26. InvertAll. rename x into M'20. rename x0 into M'21. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split; auto. split; auto. split. unfold S_Flag. auto. split. auto. assert (exists w : nat, exists wqa : WQassert, enable_blk w wqa (cthM1, R, fl, isr) /\ (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (cthM1, R, fl, isr)) p') /\ (forall pc' : nat, pimp (wrap_fun (gblk wqa) pc _BLOCK pc' (cthM1, R, fl, isr) |> g') (g (cthM1, R, fl, isr)))). apply H32; auto. InvertAll. assert (w = x /\ wqa = x0). apply enable_blk_unique_args with (cthM1, R, fl, isr); auto. inversion_clear H89. rewrite <- H92 in H90. clear H92 H91 H86 H88 x x0. unfold pimp in H90. apply H90 with pc'. unfold linkPG. exists (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20). split; auto. assert (M'20 = MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). apply enter_SW_grt2_hype with cthM_old M'2 cthM2 M'21 fl fl0; auto. assert (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20 = (M'20, R0, fl0, false)). UnfoldStateAll. auto. rewrite H88. clear H88. rewrite H86. apply enter_BLK_grt2_auxc_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM w junk1 junk2 cthM2 cthM_old M'2; auto. apply enter_BLK_grt2_auxc_hyp6 with cthM11' (R' SP) pc junk1; auto. assert (R SP - 2 = R' SP). eapply enter_SW_grt_auxb0_hyp0; eauto. assert (R SP >= 2). apply ge_trans with (_BLK_Stk + 2); auto with arith. unfold mstar in H30. InvertAll. apply stkSpacePrec_sp_ge_sz with x0; auto. rewrite <- H88. assert (R SP - 2 + 2 = R SP). auto. auto. (* end of WFST *) assert (WQMod.in_dom tid0 BlkQ). unfold addThrd in H77. unfold WQMod.put, WQMod.in_dom in H77. induction (WQMod.beq_A tid0 tid). contradiction. auto. unfold WF_WQSet in H22. assert (exists tcb : Thread, exists M : Mem, TQMod.maps_to T tid0 tcb /\ ThrdMemMod.maps_to TM tid0 M /\ WF_Wait_Thrd Psi'0 M tcb w). apply H22 with BlkQ; auto. InvertAll. exists x. exists x0. split. unfold T'. unfold TQMod.maps_to, TQMod.put. induction (TQMod.beq_A tid0 tid). contradiction. auto. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). contradiction. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). assert (WQMod.not_in_dom tid' BlkQ). apply enter_BLK_grt2_hyp8 with T RdyQ RdyQ' B w; auto. rewrite <- a in H81. absurd (~ WQMod.in_dom tid0 BlkQ); auto with PMap. auto. absurd (w = w); auto. clear H78. assert (WQSetMod.maps_to B l Q). unfold B' in H76. unfold WQSetMod.maps_to, WQSetMod.put in H76. induction (WQSetMod.beq_A l w). contradiction. auto. unfold WF_WQSet in H22. assert (exists tcb : Thread, exists M : Mem, TQMod.maps_to T tid0 tcb /\ ThrdMemMod.maps_to TM tid0 M /\ WF_Wait_Thrd Psi'0 M tcb l). apply H22 with Q; auto. InvertAll. exists x. exists x0. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H82. assert (WQMod.not_in_dom tid Q). apply enter_BLK_grt2_hyp9 with T B RdyQ l rho_ready; auto. rewrite <- H84 in H82. absurd (~ WQMod.in_dom tid0 Q); auto with PMap. split. unfold T'. unfold TQMod.maps_to, TQMod.put. induction (TQMod.beq_A tid0 tid). contradiction. auto. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). contradiction. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). assert (WQMod.not_in_dom tid' Q). apply enter_BLK_grt2_hyp8 with T RdyQ RdyQ' B l; auto. rewrite <- a in H82. absurd (~ WQMod.in_dom tid0 Q); auto with PMap. auto. apply enter_BLK_grt2_hypa with M21' M22 T B RdyQ BlkQ BlkQ' tid w (R' SP, BLOCKED, pc+1); auto. absurd (_BLOCK <> _UNBLK). auto. auto. inversion_clear H. absurd (prim_entry _BLOCK); auto. Qed. Lemma enter_BLK: forall D psi pc theta D' Psi Psi' Psi'0 a S S', NH_WFcmd psi pc theta (comml (_call _BLOCK)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> a = Itp_AIM rho_ready theta -> subsetCT Psi' Psi'0 -> a Psi'0 S -> nextS pc (comml (_call _BLOCK)) S S' -> Itp0 D' BLK_Spec0 Psi'0 S'. Proof. intros. unfold Itp0. unfold BLK_Spec0. rewrite H1. simpl. rewrite H4 in H6. clear H4 a. split. apply enter_BLK_pre with psi pc theta Psi'0 S; auto. split. apply enter_BLK_disable with psi pc theta Psi'0 S; auto. exists 0. apply enter_BLK_grt with psi pc theta D' Psi Psi' S; auto. Qed. Lemma NH_BLK_Presv: forall D psi pc theta D' Psi Psi' Psi'0 a S S' f', NH_WFcmd psi pc theta (comml (_call _BLOCK)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> a = Itp_AIM rho_ready theta -> subsetCT Psi' Psi'0 -> a Psi'0 S -> nextS pc (comml (_call _BLOCK)) S S' -> nextPC (comml (_call _BLOCK)) (S_Mem S) (S_RF S) (S_Flag S) pc f' -> exists theta0 : Spec0, lookupCT Psi'0 f' theta0 /\ Itp0 D' theta0 Psi'0 S'. Proof. intros. assert (lookupCT Psi'0 _BLOCK BLK_Spec0). apply subsetCT_presv_lookupCT with Psi'; auto. rewrite H3. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with (consCT _BLOCK BLK_Spec0 Psi). apply lookupCT_consCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend2_subsetCT. apply consCT_subsetCT. inversion H8. clear H14 H13 H12 H10 H11 fl R M f pc0. exists BLK_Spec0. split; auto. apply enter_BLK with D psi pc theta Psi Psi' a S; auto. Qed. Lemma call_blk_disable_itr: forall psi Psi'0 pc theta S, NH_WFcmd psi pc theta (comml (_call _BLOCK)) -> Itp_AIM rho_ready theta Psi'0 S -> ~ itr_enabled S. Proof. intros. intro. unfold NH_WFcmd in H. induction theta. destruct H as [HWFcmd [Htmp1 Htmp2]]. clear Htmp1 Htmp2. unfold NH_WFcmd_aux in HWFcmd. inversion_clear HWFcmd. destruct H as [Hprim HWFcmd]. clear Hprim. unfold NH_Call_Prim in HWFcmd. inversion_clear HWFcmd. clear H. assert (S_Flag S _IF = false). assert (imprec (NH_pinvstar p) S). apply Itp_AIM_pinv with g n Psi'0 rho_ready. auto. discriminate. unfold imprec in H. unfold pmstar in H. InvertAll. induction S as (((M, R), fl), isr). simplS. simplS in H. unfold NH_pinvstar in H. unfold pmstar in H. InvertAll. simplS in H. assert (S_Flag (x1, R, fl, isr) _IF = false). apply H2; auto. UnfoldStateAll; auto. unfold itr_enabled in H1. InvertAll. rewrite H3 in H. inversion H. inversion_clear H. assert (prim_entry _BLOCK); auto. Qed. Lemma NH_BLK_Itp : forall D psi pc theta D' Psi Psi', NH_WFcmd psi pc theta (comml (_call _BLOCK)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) (* -> a = Itp_AIM rho_ready theta *) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_call _BLOCK)). Proof. intros. unfold WFcmd. split. unfold WFcmd_aux. intros. assert (Itp_AIM rho_ready theta Psi'0 S). unfold Itp0 in H4. rewrite H1 in H4. unfold ext_dict in H4. assert (beq_nat rho_ready rho_prim = false). simpl. auto. rewrite H6 in H4. unfold Minimal_D in H0. InvertAll. rewrite H7 in H4. auto. split. apply NH_BLK_progress with psi theta Psi'0 (Itp_AIM rho_ready theta); auto. split. intros. apply NH_BLK_Presv with D psi pc theta Psi Psi' (Itp_AIM rho_ready theta) S; auto. left. apply call_blk_disable_itr with psi Psi'0 pc theta; auto. rewrite H1. unfold Itp0. unfold ext_dict. assert (beq_nat rho_ready rho_prim = false). simpl. auto. rewrite H4. unfold Minimal_D in H0. InvertAll. rewrite H5. apply Itp_AIM_Mono_CT. Qed. coq/SCAP/SCAP_NH_Lemmas.v0000644000107400000620000022220711000223235014374 0ustar shaosystemsAdd LoadPath ".." . Add LoadPath "../CAP0" . Require Import Arith. Require Omega. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas5. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import Mem_Lemmas. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import SCAP_Itr. Require Import EqNat. Require Import Linking. Require Import Linking_Lemmas2. Lemma NH_Itr_prog : forall rho Psi pc M R fl isr p g tag, (Prd_Itr_Stk p /\ Grt_Itr_Stk g) -> fl _IF = true -> itp_NH_theta rho (Ast p g tag) Psi (M, R, fl, isr) -> exists S', itr_nextS pc (M, R, fl, isr) S'. Proof. intros rho Psi pc M R fl isr p g tag. intros HpgStk Hfl H. unfold itp_NH_theta in H. destruct H as [Hisr [Hp Hwfst]]. unfold NH_pinvstar, pmstar in Hp. simpl; simplS in * . destruct Hp as [Muk [Mis [HJM [Hp HMis]]]]. destruct HpgStk as [HpStk HgStk]. unfold Prd_Itr_Stk in HpStk. substH HpStk with (HpStk _ Hp). unfold itr_enabled in HpStk; simplS in HpStk. substH HpStk with (HpStk (conj Hfl Hisr)). destruct HpStk as [Mu [Mk [HJMuk [HMk HpStk]]]]. simplS in * . set (M'' := MemMod.put (MemMod.put M (R SP - 6) pc) (R SP - 5) 0). set (M''' := MemMod.put (MemMod.put M'' (R SP - 4) 0) (R SP - 3) 0). set (M' := MemMod.put (MemMod.put M''' (R SP - 2) (FR2nat fl)) (R SP - 1) 0). exists (M', RF_update R SP (R SP - 6), Clear_Flag fl _IF, true). exists (R SP). exists (FR2nat fl). exists 0. exists M''; exists M'''. split_l. split. destruct (stkSpacePrec_split HMk) as [Mik [Mjk [HJMk [HMik HMjk]]]]. apply stkSpace_Mono with Muk Mis; trivial. apply stkSpace_Mono_r with Mu Mk; trivial. apply stkSpace_Mono with Mik Mjk; trivial. apply stkSpacePrec_stkSpace; trivial. split_l; split_l; split_l;split_l. assert (Hsp : R SP >= 6). unfold stkSpacePrec in HMk. destruct HMk as [H _ ]. omega. split. unfold MemUpd16. exists 0. replace (R SP - 6 + 1) with (R SP - 5). trivial. clear rho Psi Hwfst HgStk Hfl Hisr. subst M'' M' M'''. clear pc M fl isr tag p g Muk Mis HJM Hp HMis Mu Mk HJMuk HMk HpStk. omega. split. unfold MemUpd16. exists 0. replace (R SP - 4 + 1) with (R SP - 3). trivial. clear rho Psi Hwfst HgStk Hfl Hisr. subst M'' M' M'''. clear pc M fl isr tag p g Muk Mis HJM Hp HMis Mu Mk HJMuk HMk HpStk. omega. unfold MemUpd16. exists 0. replace (R SP - 2 + 1) with (R SP - 1). trivial. clear rho Psi Hwfst HgStk Hfl Hisr. subst M'' M' M'''. clear pc M fl isr tag p g Muk Mis HJM Hp HMis Mu Mk HJMuk HMk HpStk. omega. Qed. Implicit Arguments NH_Itr_prog [rho Psi pc M R fl isr p g tag]. Lemma NH_Itr_prev : forall rho status Psi pc M R fl isr S' p g tag, rho = rho_ready \/ rho = rho_idle -> rho_tcb_consistent2 status rho -> (Prd_Itr_Stk p /\ Grt_Itr_Stk g) -> fl _IF = true -> itr_nextS pc (M, R, fl, isr) S' -> itp_NH_theta rho (Ast p g tag) Psi (M, R, fl, isr) -> itp_IH_theta (Ast IHpred IHgrt 0) status (consCT pc (packS0 rho (Ast p g tag)) Psi) S'. Proof. intros rho status Psi pc M R fl isr [[[M' R'] fl'] isr'] p g tag. intros Hrho Htcs HpgStk Hfl HnextS H. unfold itr_nextS in HnextS. destruct HnextS as [sp [flnum [cs [M'' [M''' [Hsp [_ [HR' [Hfl' Hitr]]]]]]]]]. destruct Hitr as [Hisr' [Hflnum HM']]. simplS in * . unfold itp_IH_theta. unfold itp_NH_theta in H. destruct H as [Hisr [Hp Hwfst]]. unfold NH_pinvstar, pmstar in Hp. simpl; simplS in * . destruct Hp as [Muk [Mis [HJM [Hp HMis]]]]. destruct HpgStk as [HpStk HgStk]. unfold Prd_Itr_Stk in HpStk. substH HpStk with (HpStk _ Hp). unfold itr_enabled in HpStk; simplS in HpStk. substH HpStk with (HpStk (conj Hfl Hisr)). destruct HpStk as [Mu [Mk [HJMuk [HMk HpStk]]]]. simplS in * . subst sp isr R' fl' isr' flnum. split_l. left. split_l. destruct (stkSpacePrec_split HMk) as [Mik [Mjk [HJMk [HMik HMjk]]]]. unfold NH_Inv, pmstar in HMis. rewrite Hfl in HMis. destruct HMis as [Mih [Msh [HJMis [HMih HMsh]]]]. assert (H : exists Mik', MemMod.disjUnion Mik' (MemMod.merge (MemMod.merge Mu Mjk) Mis) M' /\ exists M1'1, exists M1'2, MemUpd16 Mik (R SP - 6) pc M1'1 /\ MemUpd16 M1'1 (R SP - 4) cs M1'2 /\ MemUpd16 M1'2 (R SP - 2) (FR2nat fl) Mik'). assert (H : leadsToxW (R SP - 6) Mik). apply stkSpacePrec_leadsToxW with (R SP) 6; trivial; try omega. assert (H1 : MemMod.disjUnion Mik (MemMod.merge (MemMod.merge Mu Mjk) Mis) M). disjUnion shift_l. merge commut Mu. merge assoc Mik. merge rewrite HJMk. merge commut Mk. merge rewrite HJMuk. trivial. disjoint des. disjoint lift_l. destruct HM' as [HM'1 [HM'2 HM'3]]. rename M'' into M'1. rename M''' into M'2. destruct (leadsToxW_MemUpd16_DMono H1 H HM'1) as [Mik'1 [HJ1 Hupd1]]. destruct ((fun x => HMik) 0) as [Hsp _ ]. assert (H2 : leadsToxW (R SP - 4) Mik'1). apply leadsToxW_MemUpd16_leadsToxW_nt with (R SP - 6) pc Mik; trivial. apply stkSpacePrec_leadsToxW with (R SP) 6; trivial; try omega. left; omega. destruct (leadsToxW_MemUpd16_DMono HJ1 H2 HM'2) as [Mik'2 [HJ2 HMik'2]]. assert (H3 : leadsToxW (R SP - 2) Mik'2). apply leadsToxW_MemUpd16_leadsToxW_nt with (R SP - 4) cs Mik'1; trivial. apply leadsToxW_MemUpd16_leadsToxW_nt with (R SP - 6) pc Mik; trivial; try omega. apply stkSpacePrec_leadsToxW with (R SP) 6; trivial; try omega. left; omega. destruct (leadsToxW_MemUpd16_DMono HJ2 H3 HM'3) as [Mik' [HJ HMik']]. exists Mik'; split_l. exists Mik'1; exists Mik'2; auto. destruct H as [Mik' [HJM' HMik'upd]]. clear HM' M'' M'''. destruct ((fun x => HMik) 0) as [Hsp _ ]. destruct HMik'upd as [Mik'1 [Mik'2 [Hupd1 [Hupd2 Hupd3]]]]. assert (HMik'1 : stkSpacePrec (R SP) 6 Mik'1). apply stkSpacePrec_MemUpd16_stkSpacePrec with Mik (R SP - 6) pc; trivial; try omega. assert (HMik'2 : stkSpacePrec (R SP) 6 Mik'2). apply stkSpacePrec_MemUpd16_stkSpacePrec with Mik'1 (R SP - 4) cs; trivial; try omega. assert (HMik' : stkSpacePrec (R SP) 6 Mik'). apply stkSpacePrec_MemUpd16_stkSpacePrec with Mik'2 (R SP - 2) (FR2nat fl); trivial; try omega. assert (HMik'eqd : MemMod.eqDom Mik Mik'). assert (HMik'eqd1 : MemMod.eqDom Mik Mik'1). apply stkSpacePrec_MemUpd16_eqDom with (R SP) 6 (R SP - 6) pc; trivial; try omega. assert (HMik'eqd2 : MemMod.eqDom Mik'1 Mik'2). apply stkSpacePrec_MemUpd16_eqDom with (R SP) 6 (R SP - 4) cs; trivial; try omega. assert (HMik'eqd3 : MemMod.eqDom Mik'2 Mik'). apply stkSpacePrec_MemUpd16_eqDom with (R SP) 6 (R SP - 2) (FR2nat fl); trivial; try omega. apply MemMod.eqDom_trans with Mik'1; trivial. apply MemMod.eqDom_trans with Mik'2; trivial. split. unfold IHpred, pmstar. simplS. exists (MemMod.merge Mu (MemMod.merge Mih (MemMod.merge Mik' Mjk))). exists Msh. split. merge commut Mih. merge assoc Mu. disjUnion_shift_r. merge_commut Mu. merge_assoc Mik'. merge_commut Mjk. disjUnion_shift_r. merge rewrite HJMis. trivial. disjoint des. disjoint lift_lr. disjoint lift_lr. disjoint lift_llr. disjoint lift_llr. disjoint des. disjoint rep_r Mik; disjoint lift_r. disjoint lift_r. disjoint des. disjoint rep_r Mik; disjoint lift_lrr. disjoint lift_lrr. split_r. rsplit. auto. exists Mu; exists (MemMod.merge Mih (MemMod.merge Mik' Mjk)). split. split_r. disjoint des. disjoint lift_lr. disjoint rep_r Mik; disjoint lift_r. disjoint lift_r. split. unfold pTrue; trivial. exists Mih; exists (MemMod.merge Mik' Mjk). split. split_r. disjoint des. disjoint rep_r Mik. disjoint lift_lrr. disjoint lift_lrr. split_l. unfold RF_update, beq_reg. apply stkSpacePrec_downup. apply (stkSpacePrec_merge HMik' HMjk). unfold IH_ItpG. intros [[[M'' R''] fl''] isr'']. simplS. intros [Mx [My [M1'' [Msh'' H]]]]. destruct H as [HJM'_2 [HJM'' [HMy [HMsh'' Hgih]]]]. assert (HJM'_3 : MemMod.disjUnion (MemMod.merge Mik' (MemMod.merge (MemMod.merge Mu Mjk) Mih)) Msh M'). disjUnion_shift_r. merge assoc Msh. merge rewrite HJMis. trivial. disjoint des. disjoint lift_r. disjoint lift_llr. disjoint lift_llr. destruct (prec_disjUnion_inv HJM'_3 HJM'_2 HMsh HMy Prec1) as [Heq1 Heq2]. subst Mx My. clear HJM'_2 HJM'_3. unfold IHgrt in Hgih. unfold prepost in Hgih. simplS in Hgih. destruct Hgih as [Hgih [HRr Hisrr]]. subst R'' isr''. unfold RF_update, beq_reg in Hgih. destruct Hgih as [Mx [My [Mjk''ih'' [HMx [HMih''jk'' [HJMin HJM1'']]]]]]. assert (H : MemMod.disjUnion (MemMod.merge Mih Mjk) (MemMod.merge Mu Mik') (MemMod.merge Mik' (MemMod.merge (MemMod.merge Mu Mjk) Mih))). merge assoc Mih. rewrite (@merge_sym Mih Mjk). merge assoc Mik'. rewrite (@merge_sym Mik' Mu). rewrite (@merge_sym (MemMod.merge Mu Mik') (MemMod.merge Mjk Mih)). split_r. disjoint des. disjoint lift_llr. disjoint rep_r Mik. disjoint lift_lr. disjoint rep_r Mik. disjoint lift_lrr. disjoint des. disjoint lift_r. disjoint lift_lr. disjoint rep_l Mik. disjoint rep_l Mik; disjoint lift_llr. disjoint rep_l Mik; disjoint lift_l. disjoint lift_lrr. assert (H0 : mstar INV0 (stkSpacePrec (R SP - 6) IH_Stk) (MemMod.merge Mih Mjk)). exists Mih; exists Mjk. split_r by auto. split_r. disjoint lift_lrr. destruct (prec_disjUnion_inv_left HJMin H HMx H0) as [Heq1 Heq2]. apply (@mstar_presv_prec _ _ Prec0 (@precise_stkSpacePrec (R SP - 6) IH_Stk)). subst Mx My. clear HJMin H H0 HMx HMy. exists (M'', R, fl, false). assert (HJM1''2 : MemMod.disjUnion Mik' (MemMod.merge Mjk''ih'' Mu) M1''). apply disjUnion_sym. disjUnion shift_r. trivial. disjoint rep_r Mik. disjoint lift_r. split. intros pc'. apply nextS_iret with (FR2nat fl) (R SP - 6); trivial. apply leadsToBlk_Mono with M1'' Msh''; trivial. apply leadsToBlk_Mono with Mik' (MemMod.merge Mjk''ih'' Mu); trivial. apply stkSpacePrec_leadsToBlk; trivial. apply leadsToW_Mono with M1'' Msh''; trivial. apply leadsToW_Mono with Mik' (MemMod.merge Mjk''ih'' Mu); trivial. arith_rep (R SP - 6 + 4) with (R SP - 2). apply leadsToxW_MemUpd16_leadsToW with Mik'2; trivial. apply leadsToxW_MemUpd16_leadsToxW_nt with (R SP - 4) cs Mik'1; trivial. apply leadsToxW_MemUpd16_leadsToxW_nt with (R SP - 6) pc Mik; trivial. eapply stkSpacePrec_leadsToxW; eauto. omega. omega. left; omega. left; omega. rewrite (FR_nat_iso_left fl); trivial. arith_rep (R SP - 6 + 6) with (R SP). rewrite RF_update_RF_update. rewrite RF_update_prev; trivial. exists pc. split. unfold Ret_Addr. simplS. intros pcx. apply nextPC_retw with (sp:=(R SP -6)); trivial. apply leadsToW_Mono with M1'' Msh''; trivial. apply leadsToW_Mono with Mik' (MemMod.merge Mjk''ih'' Mu); trivial. apply leadsToW_MemUpd16_leadsToW_nt with (R SP - 2) (FR2nat fl) Mik'2; trivial. apply leadsToW_MemUpd16_leadsToW_nt with (R SP - 4) cs Mik'1; trivial. apply leadsToxW_MemUpd16_leadsToW with Mik; trivial. eapply stkSpacePrec_leadsToxW; eauto. omega. omega. right; omega. right; omega. exists rho. exists (Ast p g tag). split_l. split_l. split. apply lookupCT_consCT; trivial. intros pc' [[[M''' R'''] fl'''] isr'''] HnextS''. unfold itp_NH_theta. destruct (nextS_inversion HnextS'') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HM''' as [HM''' HldsM''']. destruct Hfl''' as [flnum [Hfl''' HldsM'''x]]. assert (fl''' = fl). rewrite RF_update_RF in HldsM'''x. assert (leadsToW (R SP - 2) (FR2nat fl) M''). apply leadsToW_Mono with M1'' Msh''; trivial. apply leadsToW_Mono with Mik' (MemMod.merge Mjk''ih'' Mu); trivial. apply leadsToxW_MemUpd16_leadsToW with Mik'2; trivial. apply leadsToxW_MemUpd16_leadsToxW_nt with (R SP - 4) cs Mik'1; trivial. apply leadsToxW_MemUpd16_leadsToxW_nt with (R SP - 6) pc Mik; trivial. eapply stkSpacePrec_leadsToxW; eauto. omega. omega. left; omega. left; omega. arith_rep (R SP -6 + 4) with (R SP -2) in HldsM'''x. assert (Heq := leadsToW_unique HldsM'''x H). assert (Heq' : nat2FR flnum = nat2FR (FR2nat fl)). subst flnum; trivial. subst fl'''. rewrite Heq'. rewrite (FR_nat_iso_left fl); trivial. subst M''' R''' fl''' isr'''. simplS. split_l. destruct HMih''jk'' as [Mih'' [Mjk'' [HJMih''jk'' [HMih'' HMjk'']]]]. assert (HMjk'eqd : MemMod.eqDom Mjk Mjk''). eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (HMk'' : stkSpacePrec (R SP) (IH_Stk + 6) (MemMod.merge Mik' Mjk'')). apply stkSpacePrec_merge; trivial. split. unfold NH_pinvstar, NH_Inv, pmstar. simplS. rewrite H. rewrite Hfl. exists (MemMod.merge Mu (MemMod.merge Mik' Mjk'')). exists (MemMod.merge Mih'' Msh''). split. disjUnion shift_l. merge assoc Mu. merge assoc Mih''. merge commut Mjk''. merge rewrite HJMih''jk''. merge commut Mjk''ih''. merge rewrite HJM1''. trivial. disjoint des. disjoint lift_r. disjoint lift_l Mik'. apply disjUnion_sym. split_r. disjoint rep_r Mik. disjoint lift_r. disjoint lift_r. disjoint lift_l Mu. apply disjUnion_sym. split_r. disjoint rep_l Mik. disjoint lift_l. merge commut Mu. disjoint trivial. disjoint rep_l Mik. disjoint lift_l. rewrite RF_update_RF_update. rewrite RF_update_RF. arith_rep (R SP - 6 + 6) with (R SP). rewrite RF_update_prev. split. apply HpStk; trivial. exists Mih''; exists Msh''. split; auto. split_r. disjoint lift_l. disjoint lift_l. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. assert (Hsub : subsetCT Psi (consCT pc (packS0 rho (Ast p g tag)) Psi)). apply consCT_subsetCT; trivial. apply NH_WFST_Mono_CT with Psi; trivial. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, false)); trivial. clear Hwfst. intros [[[M'''' R''''] fl''''] isr''''] [Mx1 [Mx2 [M1'''' [M2'''' Hg]]]]. simplS; simplS in Hg. destruct Hg as [Hg1 [Hg2 [Hg3 [Hg4 Hg5]]]]. unfold NH_Inv in Hg3. rewrite H in Hg3. rewrite Hfl in Hg3. assert (HJM''_2 : MemMod.disjUnion (MemMod.merge Mu (MemMod.merge Mik' Mjk'')) (MemMod.merge Mih'' Msh'') M''). disjUnion shift_l. merge assoc Mu. merge assoc Mih''. merge commut Mjk''. merge rewrite HJMih''jk''. merge commut Mjk''ih''. merge rewrite HJM1''. trivial. disjoint des. disjoint lift_r. disjoint lift_l Mik'. apply disjUnion_sym. split_r. disjoint rep_r Mik. disjoint lift_r. disjoint lift_l Mu. apply disjUnion_sym. split_r. disjoint rep_l Mik. disjoint lift_l. disjoint lift_r. merge commut Mu. disjoint trivial. disjoint rep_l Mik. disjoint lift_l. assert (H0 : mstar INV0 INV1 (MemMod.merge Mih'' Msh'')). exists Mih''; exists Msh''. split; auto. split_r. disjoint lift_l. disjoint lift_l. destruct (prec_disjUnion_inv Hg1 HJM''_2 Hg3 H0 Prec01) as [Heq1 Heq2]. subst Mx1 Mx2. clear H0 Hg3 Hg1. unfold NH_ItpG. simplS. exists (MemMod.merge Mu (MemMod.merge Mik Mjk)). exists (MemMod.merge Mih Msh). exists M1''''; exists M2''''. split. merge rewrite HJMis. merge rewrite HJMk. merge rewrite HJMuk. trivial. split_l. split. unfold NH_Inv. rewrite Hfl. exists Mih; exists Msh. split_r by auto. split_r. disjoint trivial. split_l. rewrite RF_update_RF_update in Hg5. rewrite RF_update_RF in Hg5. arith_rep (R SP - 6 + 6) with (R SP) in Hg5. rewrite RF_update_prev in Hg5. unfold Grt_Itr_Stk in HgStk. substH HgStk with (HgStk _ _ Hg5). unfold itr_enabled in HgStk. simplS in HgStk. rewrite H in HgStk. rewrite Hfl in HgStk. substH HgStk with (HgStk (conj (refl_equal _) (refl_equal _))). substH HgStk with (HgStk Mu (MemMod.merge Mik' Mjk'')). substH HgStk with (HgStk (MemMod.merge Mik Mjk)). apply HgStk; trivial. split_r. disjoint des. disjoint rep_r Mik. disjoint lift_r. disjoint rep_r Mjk. disjoint lift_r. apply stkSpacePrec_merge; trivial. Qed. Implicit Arguments NH_Itr_prev [rho status Psi pc M R fl isr S' p g tag]. Lemma NH_cli_prev : forall rho Psi M R fl isr pc p g tag p' g', lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> pimp (p |> gcli) p' -> gimp (p >o gcli oo g') g -> itp_NH_theta rho (Ast p g tag) Psi (M, R, fl, isr) -> itp_NH_theta rho (Ast p' g' tag) Psi (M, R, Clear_Flag fl _IF, isr). Proof. unfold itp_NH_theta. intros rho Psi M R fl isr pc p g tag p' g' Hlookup Hpp' Hg'g Hwf. simplS in * . destruct Hwf as [Hisr [Hpinv Hwfst]]. split_l. split. unfold NH_pinvstar in * . unfold NH_Inv in * . simpl. unfold pmstar in Hpinv |- * . destruct Hpinv as [M1 [M2 [HJM [HM1 HM2]]]]. simplS in HM2. exists M; exists MemMod.emp. split. simplS. auto with PMap. simplS. rsplit. unfold Aemp; trivial. apply Hpp'. simplS in HM1. apply linkPG_intro with (M1, R, fl, isr); trivial. unfold gcli. rsplit. split_l. split_lr. unfold prepost, choice, itr_enabled. simplS. destruct (fl _IF). (* case : fl _IF = true *) exists MemMod.emp. exists M1. exists M2. split. unfold Aemp; trivial. rsplit. split; auto with PMap. left. split_r. split_lr. (* case : fl _IF = false *) exists MemMod.emp. exists M. exists MemMod.emp. unfold Aemp in HM2. subst M2. split. unfold Aemp; trivial. rsplit. simplS in HJM. assert (M1 = M). auto with PMap. subst M1. split; auto with PMap. right. split. intros [Hx Hy]; discriminate Hx. unfold Aemp; trivial. intro Htag. substH Hwfst with (Hwfst Htag). apply NH_WFST_strengthen with (g := g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG, NH_Inv. intros [[[Mx Rx] flx] isrx] [Mx1 [Mx2 [Mx1' [Mx2' Hg]]]]. simplS; simplS in Hg. simpl in Hg. unfold NH_pinvstar, NH_Inv in Hpinv. simplS in Hpinv. unfold pmstar in Hpinv. destruct Hpinv as [M1 [M2 [HJM [HM1 HM2]]]]. simplS in HM2. exists M1; exists M2. exists Mx1'; exists Mx2'. destruct Hg as [Hg1 [Hg2 [Hg3 [Hg4 Hg5]]]]. split_l. split_l. split_l. split_l. assert (Heq : Mx1 = M). unfold Aemp in Hg3; subst Mx2. auto with PMap. subst Mx1. clear Mx2 Hg1 Hg3. apply Hg'g. apply conjG_intro with (M, R, Clear_Flag fl _IF, isr); trivial. apply conjPG_intro; trivial. unfold gcli, prepost, choice, itr_enabled. rsplit. simplS. unfold Clear_Flag; simpl. split_l; split_lr. exists MemMod.emp; exists M1; exists M2. split. unfold Aemp; trivial. rsplit. simplS. simplS in HJM. split; auto with PMap. simplS; simplS in Hisr. destruct (fl _IF); [left | right]; split_r. split_lr. intros [Hx Hy]; discriminate Hx. Qed. Implicit Arguments NH_cli_prev [rho Psi M R fl isr pc p g tag p' g']. Lemma NH_sti_prev : forall rho Psi M R fl isr pc p g tag p' g', lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> enable_sti p -> pimp (p |> gsti) p' -> gimp (p >o gsti oo g') g -> itp_NH_theta rho (Ast p g tag) Psi (M, R, fl, isr) -> itp_NH_theta rho (Ast p' g' tag) Psi (M, R, Set_Flag fl _IF, isr). Proof. intros rho Psi M R fl isr pc p g tag p' g' Hlookup Hsti Hpp' Hg'g Hwf. unfold itp_NH_theta in * . destruct Hwf as [Hisr [Hpinv Hwfst]]. split_l. split. unfold NH_pinvstar in * . unfold NH_Inv in * . simpl. unfold pmstar in Hpinv |- * . destruct Hpinv as [M1 [M2 [HJM [HM1 HM2]]]]. simplS in HM2. generalize (refl_equal (fl _IF)); pattern fl at 1; destruct (fl _IF); intro Hfl. (* case : fl _IF = true *) exists M1; exists M2. split_l. rsplit. unfold Aemp; trivial. apply Hpp'. simplS in HM1. apply linkPG_intro with (M1, R, fl, isr); trivial. unfold gsti. rsplit. split_l. split_lr. unfold prepost, choice, itr_enabled. simplS. rewrite Hfl. exists MemMod.emp; exists M1; exists MemMod.emp. rsplit. split. unfold Aemp; trivial. split; auto with PMap. left. split. split_lr. unfold Aemp; trivial. (* case : fl _IF = false *) unfold enable_sti in Hsti. substH Hsti with (Hsti _ HM1). unfold pmstar, choice, itr_enabled in Hsti. simplS in Hsti. destruct Hsti as [M11 [M12 [HJM1 [HM11 Hsti]]]]. exists M11; exists M12. assert (Heq : M1 = M). unfold Aemp in HM2; subst M2. simplS in HJM. auto with PMap. subst M1. split_l. rewrite Hfl in Hsti. destruct Hsti as [Hsti | Hsti]. destruct Hsti as [[Hx _] _]; discriminate Hx. destruct Hsti as [_ HM12]. split_r. apply Hpp'. apply linkPG_intro with (M, R, fl, isr); trivial. unfold gsti. rsplit. split_l. split_lr. unfold prepost, choice, itr_enabled. simplS. rewrite Hfl. exists M12; exists M11; exists MemMod.emp. rsplit. split. unfold Aemp; trivial. split; auto with PMap. right. split_r. intros [Hx Hy]; discriminate Hx. intro Htag. substH Hwfst with (Hwfst Htag). apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG, NH_Inv. intros [[[Mx Rx] flx] isrx] [Mx1 [Mx2 [Mx1' [Mx2' Hg]]]]. simplS; simplS in Hg. simpl in Hg. unfold NH_pinvstar, NH_Inv in Hpinv. simplS in Hpinv. unfold pmstar in Hpinv. destruct Hpinv as [M1 [M2 [HJM [HM1 HM2]]]]. simplS in HM2. exists M1; exists M2. exists Mx1'; exists Mx2'. destruct Hg as [Hg1 [Hg2 [Hg3 [Hg4 Hg5]]]]. split_l. split_l. split_l. split_l. apply Hg'g. apply conjG_intro with (Mx1, R, Set_Flag fl _IF, isr); trivial. apply conjPG_intro; trivial. unfold gsti, prepost, choice, itr_enabled. simplS. rsplit. unfold Set_Flag; simpl. split_l; split_lr. destruct (fl _IF). assert (Hprec : precise (mstar INV0 INV1)). apply Prec01. destruct (prec_disjUnion_inv HJM Hg1 HM2 Hg3 Hprec) as [Heq1 Heq2]. subst Mx1 Mx2. exists MemMod.emp; exists M1; exists MemMod.emp. rsplit. split. unfold Aemp; trivial. split; auto with PMap. left. rsplit. unfold Aemp; trivial. split_lr. assert (Heq : M1 = M). simplS in HJM. unfold Aemp in HM2; subst M2. auto with PMap. subst M1. exists Mx2; exists Mx1; exists MemMod.emp. rsplit. split. unfold Aemp; trivial. split; auto with PMap. right. split_r. intros [Hx Hy]; discriminate Hx. Qed. Implicit Arguments NH_sti_prev [rho Psi M R fl isr pc p g tag p' g']. Lemma NH_call_prog : forall rho Psi f pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_call f))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_call f)) S0 S'. Proof. intros rho Psi f pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_call_prog [rho Psi f pc S0 p g tag]. Lemma NH_nonprim_call_prev : forall rho Psi f pc S0 S' (p p' p'': Pred) (g g' g'': Grt) tag, lookupCT Psi f (packS0 rho (Ast p' g' 1)) -> lookupCT Psi (pc+1) (packS0 rho (Ast p'' g'' tag)) -> nextS pc (comml (_call f)) S0 S' -> enable p (nextS pc (comml (_call f))) -> gimp (sp_call_pred p pc f >o g') fun_frame -> pimp (p |> nextS pc (comml (_call f))) p' -> (forall pc' : nat, pimp (p |> wrap_fun g' pc f pc') p'') -> (forall pc' : nat, gimp (p >o wrap_fun g' pc f pc' oo g'') g) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' 1) Psi S'. Proof. intros rho Psi f pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' p'' g g' g'' tag. intros Hlk' Hlk'' HnextS Hen Hfun Hpp' Hg'p'' Hg''g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst R' fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_call f))) (Mnh', RF_update R SP (R SP - 2), fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. set (S := (M, R, fl, isr)) in * . set (S' := (M', RF_update R SP (R SP - 2), fl, isr)) in * . set (Snh := (Mnh, R, fl, isr)) in * . set (Snh' := (Mnh', RF_update R SP (R SP - 2), fl, isr)) in * . intros Htag; clear Htag. destruct (eq_nat_dec tag 1) as [Htag | Htag]. (* tag = 1 *) substH Hwfst with (Hwfst Htag); clear Htag. destruct Hwfst as [n Hwfst]. exists (1+n). simpl. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. unfold S' in Hg'. simplS in Hg'. destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. unfold wrap_fun in Hg'p''. simplS in * . set (S'' := (M'', R'', fl'', isr'')) in * . set (Snh'' := (Mnh'', R'', fl'', isr'')). assert (Hfunframe : fun_frame Snh' Snh''). apply Hfun. unfold sp_call_pred. apply conjPG_intro; trivial. unfold fun_frame in Hfunframe. destruct Hfunframe as [_ [ra [Hra' Hra'']]]. assert (Hrax := ra_after_call _ _ Hra' HnextSnh'). subst ra. exists (pc + 1). unfold S''. split. unfold S''. apply (Ret_Addr_Mono HJM'' Hra''). clear Hra'. exists p''; exists g''; exists tag. split_l. intros pc' S''' HnextS''. substH Hg'p'' with (Hg'p'' pc'). assert (HnextSnh''Sx : nextS pc' (comms _retw) (Mnh'', R'', fl'', isr'') (Mnh'', RF_update R'' SP (R'' SP + 2), fl'', isr'')). unfold Ret_Addr in Hra''. substH Hra'' with (Hra'' pc'). inversion_clear Hra''. subst Snh'' sp; simplS in * . apply nextS_retw. exists (pc+1). unfold popW. split_lr. destruct S''' as [[[M''' R'''] fl'''] isr''']. destruct (nextS_DMono HJM'' HnextSnh''Sx HnextS'') as [Mnh''' [HJM''' HnextSnh'']]. destruct (nextS_inversion HnextSnh'') as [HM [_ [Hfl Hisr]]]. subst Mnh''' fl''' isr'''. destruct (nextS_inversion HnextS'') as [HM _]. subst M'''. split. unfold NH_pinvstar, pmstar. exists Mnh''; exists Mih''; split_l. split_r by (apply HMih''). apply Hg'p''. apply linkPG_intro with Snh; trivial. apply conjG_intro with Snh''; trivial. apply conjG_intro with Snh'; trivial. apply (NH_WFST_aux_strengthen (S1 := (M'', R''', fl'', isr''))(g':= g'') Hwfst). substH Hg''g with (Hg''g pc' Snh). unfold NH_ItpG. intros Sx H. destruct H as [Mnh''0 [Mih''0 [Mnhx [Mihx [HJM''0 [HJMx [HMih''0 [HMihx Hg'']]]]]]]]. destruct (prec_disjUnion_inv HJM'' HJM''0 HMih'' HMih''0 (NHInv_prec fl'')) as [Heq1 Heq2]. subst Mnh''0 Mih''0. clear HJM''0 HMih''0. exists Mnh; exists Mih; exists Mnhx; exists Mihx. split_l; split_l; split_l; split_l. apply Hg''g. apply conjG_intro with (Mnh'', R''', fl'', isr''); trivial. unfold wrap_fun. apply conjPG_intro; auto. apply conjG_intro with Snh''; subst S; trivial. apply conjG_intro with Snh'; trivial. (* tag <> 1 *) exists 0. simpl. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. unfold S' in Hg'. simplS in Hg'. destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. unfold wrap_fun in Hg'p''. simplS in * . set (S'' := (M'', R'', fl'', isr'')) in * . set (Snh'' := (Mnh'', R'', fl'', isr'')). assert (Hfunframe : fun_frame Snh' Snh''). apply Hfun. unfold sp_call_pred. apply conjPG_intro; trivial. unfold fun_frame in Hfunframe. destruct Hfunframe as [_ [ra [Hra' Hra'']]]. assert (Hrax := ra_after_call _ _ Hra' HnextSnh'). subst ra. exists (pc + 1). unfold S''. split. unfold S''. apply (Ret_Addr_Mono HJM'' Hra''). clear Hra'. exists p''; exists g''; exists tag. split_l. split_l. intros pc' S''' HnextS''. substH Hg'p'' with (Hg'p'' pc'). assert (HnextSnh''Sx : nextS pc' (comms _retw) (Mnh'', R'', fl'', isr'') (Mnh'', RF_update R'' SP (R'' SP + 2), fl'', isr'')). unfold Ret_Addr in Hra''. substH Hra'' with (Hra'' pc'). inversion_clear Hra''. subst Snh'' sp; simplS in * . apply nextS_retw. exists (pc+1). unfold popW. split_lr. destruct S''' as [[[M''' R'''] fl'''] isr''']. destruct (nextS_DMono HJM'' HnextSnh''Sx HnextS'') as [Mnh''' [HJM''' HnextSnh'']]. destruct (nextS_inversion HnextSnh'') as [HM [_ [Hfl Hisr]]]. subst Mnh''' fl''' isr'''. destruct (nextS_inversion HnextS'') as [HM _]. subst M'''. unfold NH_pinvstar, pmstar. exists Mnh''; exists Mih''; split_l. split_r by (apply HMih''). apply Hg'p''. apply linkPG_intro with Snh; trivial. apply conjG_intro with Snh''; trivial. apply conjG_intro with Snh'; trivial. Qed. Implicit Arguments NH_nonprim_call_prev [rho Psi f pc S0 S' p p' p'' g g' g'' tag]. Lemma NH_jne_prog : forall rho Psi f pc S0 (p : Pred) (g : Grt) tag, itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_jne f)) S0 S'. Proof. intros rho Psi f pc [[[M R] fl] isr] p g tag. intros H. exists (M, R, fl, isr). constructor. Qed. Implicit Arguments NH_jne_prog [rho Psi f pc S0 p g tag]. Lemma NH_jne_jmp_prev : forall rho Psi f pc S0 S' (p p': Pred) (g g': Grt) tag, lookupCT Psi f (packS0 rho (Ast p' g' tag)) -> S_Flag S0 _ZF = false -> nextS pc (comml (_jne f)) S0 S' -> pimp (conjP p ZF_cl) p' -> gimp (p >o (ZF_cl >o g')) g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi f pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' Hflzf HnextS Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' fl' isr'. assert (HS' : (p |> nextS pc (comml (_jne f))) (Mnh, R, fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. constructor. split_l. split. exists Mnh; exists Mih. split_l. split_r. simplS. apply Hpp'; trivial. split; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in Hg'. destruct (prec_disjUnion_inv HJMxy HJM HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjPG_intro; trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_jne_jmp_prev [rho Psi f pc S0 S' p p' g g' tag]. Lemma NH_jne_seq_prev : forall rho Psi f pc S0 S' (p p'': Pred) (g g'': Grt) tag, lookupCT Psi (pc+1) (packS0 rho (Ast p'' g'' tag)) -> S_Flag S0 _ZF = true -> nextS pc (comml (_jne f)) S0 S' -> pimp (conjP p ZF_st) p'' -> gimp (p >o (ZF_st >o g'')) g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p'' g'' tag) Psi S'. Proof. intros rho Psi f pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p'' g g'' tag. intros Hlk'' Hflzf HnextS Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' fl' isr'. assert (HS' : (p |> nextS pc (comml (_jne f))) (Mnh, R, fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. constructor. split_l. split. exists Mnh; exists Mih. split_l. split_r. simplS. apply Hpp'; trivial. split; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in Hg'. destruct (prec_disjUnion_inv HJMxy HJM HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjPG_intro; trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_jne_seq_prev [rho Psi f pc S0 S' p p'' g g'' tag]. Lemma NH_movwp_prog : forall rho Psi o r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_movwp o r))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_movwp o r)) S0 S'. Proof. intros rho Psi o r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_movwp_prog [rho Psi o r pc S0 p g tag]. Lemma NH_movwp_prev : forall rho Psi o r pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_movwp o r)) S0 S' -> enable p (nextS pc (comml (_movwp o r))) -> pimp (p |> nextS pc (comml (_movwp o r))) p' -> gimp (p >o nextS pc (comml (_movwp o r)) oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi o r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_movwp o r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_movwp_prev [rho Psi o r pc S0 S' p p' g g' tag]. Lemma NH_movwld_prog : forall rho Psi a r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_movwld a r))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_movwld a r)) S0 S'. Proof. intros rho Psi a r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_movwld_prog [rho Psi a r pc S0 p g tag]. Lemma NH_movwld_prev : forall rho Psi a r pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_movwld a r)) S0 S' -> enable p (nextS pc (comml (_movwld a r))) -> pimp (p |> nextS pc (comml (_movwld a r))) p' -> gimp (p >o nextS pc (comml (_movwld a r)) oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi a r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_movwld a r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_movwld_prev [rho Psi a r pc S0 S' p p' g g' tag]. Lemma NH_movwst_prog : forall rho Psi a r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_movwst a r))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_movwst a r)) S0 S'. Proof. intros rho Psi a r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_movwst_prog [rho Psi a r pc S0 p g tag]. Lemma NH_movwst_prev : forall rho Psi a r pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_movwst a r)) S0 S' -> enable p (nextS pc (comml (_movwst a r))) -> pimp (p |> nextS pc (comml (_movwst a r))) p' -> gimp (p >o nextS pc (comml (_movwst a r)) oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi a r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_movwst a r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_movwst_prev [rho Psi a r pc S0 S' p p' g g' tag]. Lemma NH_pushwp_prog : forall rho Psi o pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_pushwp o))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_pushwp o)) S0 S'. Proof. intros rho Psi o pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_pushwp_prog [rho Psi o pc S0 p g tag]. Lemma NH_pushwp_prev : forall rho Psi o pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_pushwp o)) S0 S' -> enable p (nextS pc (comml (_pushwp o))) -> pimp (p |> nextS pc (comml (_pushwp o))) p' -> gimp (p >o nextS pc (comml (_pushwp o)) oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi o pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_pushwp o))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_pushwp_prev [rho Psi o pc S0 S' p p' g g' tag]. Lemma NH_pushwm_prog : forall rho Psi a pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_pushwm a))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_pushwm a)) S0 S'. Proof. intros rho Psi a pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_pushwm_prog [rho Psi a pc S0 p g tag]. Lemma NH_pushwm_prev : forall rho Psi a pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_pushwm a)) S0 S' -> enable p (nextS pc (comml (_pushwm a))) -> pimp (p |> nextS pc (comml (_pushwm a))) p' -> gimp (p >o nextS pc (comml (_pushwm a)) oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi a pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_pushwm a))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_pushwm_prev [rho Psi a pc S0 S' p p' g g' tag]. Lemma NH_pushfw_prog : forall rho Psi pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_pushfw ))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_pushfw )) S0 S'. Proof. intros rho Psi pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_pushfw_prog [rho Psi pc S0 p g tag]. Lemma NH_pushfw_prev : forall rho Psi pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_pushfw )) S0 S' -> enable p (nextS pc (comml (_pushfw ))) -> pimp (p |> nextS pc (comml (_pushfw ))) p' -> gimp (p >o nextS pc (comml (_pushfw )) oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_pushfw ))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_pushfw_prev [rho Psi pc S0 S' p p' g g' tag]. Lemma NH_popw_prog : forall rho Psi r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_popw r))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_popw r)) S0 S'. Proof. intros rho Psi r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_popw_prog [rho Psi r pc S0 p g tag]. Lemma NH_popw_prev : forall rho Psi r pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_popw r)) S0 S' -> enable p (nextS pc (comml (_popw r))) -> pimp (p |> nextS pc (comml (_popw r))) p' -> gimp (p >o nextS pc (comml (_popw r)) oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_popw r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_popw_prev [rho Psi r pc S0 S' p p' g g' tag]. Lemma NH_popfw_prog : forall rho Psi pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_popfw))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_popfw)) S0 S'. Proof. intros rho Psi pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_popfw_prog [rho Psi pc S0 p g tag]. Lemma NH_popfw_prev : forall rho Psi pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_popfw)) S0 S' -> enable p (nextS pc (comml (_popfw))) -> enable_popfw_sti (conjP p stk_IF_st) -> pimp ((conjP p stk_IF_st) |> gpopfw_sti) p' -> gimp ((conjP p stk_IF_st) >o gpopfw_sti oo g') g -> pimp ((conjP p stk_IF_cl) |> gpopfw_cli) p' -> gimp ((conjP p stk_IF_cl) >o gpopfw_cli oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hsti Hstipp' Hstig'g Hclipp' Hclig'g H. destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM' [HR' [Hfl' Hisr']]]. destruct Hfl' as [flnum [Hlds Hfl']]. subst M' fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. destruct (nextS_inversion HnextSnh') as [HMnh' _]. subst Mnh'; clear Sx HnextSSx Hen HJM'. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_popfw))) (Mnh, R', nat2FR flnum, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. unfold NH_pinvstar, pmstar. simplS. generalize (refl_equal (nat2FR flnum _IF)); pattern flnum at 1; destruct (nat2FR flnum _IF); intro Hfln; (generalize (refl_equal (fl _IF)); pattern fl at 1; destruct (fl _IF); intro Hfl). (* 1 -> 1 *) unfold NH_Inv in * . rewrite Hfl in HMih. rewrite Hfln. assert (Hgpopfw_sti : gpopfw_sti (Mnh, R, fl, isr) (Mnh, R', nat2FR flnum, isr)). unfold gpopfw_sti. simpl. unfold prepost, choice, itr_enabled. simplS. rewrite Hfl. rewrite Hfln. rsplit. auto. exists MemMod.emp; exists Mnh; exists MemMod.emp. rsplit. unfold Aemp; auto with PMap. left; unfold Aemp; auto. split. exists Mnh; exists Mih. split_l. split_r. apply Hstipp'; trivial. apply linkPG_intro with (Mnh, R, fl, isr); trivial. split; auto. destruct (nextS_inversion HnextSnh') as [_ [_ [Hflx _]]]. destruct Hflx as [x [Hx Hy]]. exists x; simplS. split_l. rewrite <- Hy; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros [[[Mx Rx] flx] isrx] [Mx1 [Mx2 [Mx1' [Mx2' Hg]]]]. simplS; simplS in Hg. destruct Hg as [Hg1 [Hg2 [Hg3 [Hg4 Hg5]]]]. unfold NH_Inv in Hg3. rewrite Hfln in Hg3. destruct (prec_disjUnion_inv HJM Hg1 HMih Hg3 (Prec01)) as [Heq1 Heq2]. subst Mx1 Mx2. exists Mnh; exists Mih. exists Mx1'; exists Mx2'. split_l. split_l. unfold NH_Inv; rewrite Hfl. split_l. split_l. apply Hstig'g. apply conjG_intro with (Mnh, R', nat2FR flnum, isr); trivial. apply conjPG_intro; trivial. split; auto. destruct (nextS_inversion HnextSnh') as [_ [_ [Hflx _]]]. destruct Hflx as [x [Hx Hy]]. exists x; simplS. split_l. rewrite <- Hy; trivial. (* 0 -> 1 *) unfold NH_Inv, Aemp in HMih. rewrite Hfl in HMih. subst Mih. assert (Mnh = M). auto with PMap. subst Mnh. clear HJM. unfold enable_popfw_sti, pmstar, pTrue, choice in Hsti. unfold conjP, stk_IF_st in Hsti. simplS in Hsti. assert (Hflnex : exists flnum : nat, leadsToW (R SP) flnum M /\ nat2FR flnum _IF = true). destruct (nextS_inversion HnextSnh') as [_ [_ [Hflx _]]]. destruct Hflx as [flnumx [Hldsx Heq]]. exists flnumx; split; auto. rewrite <- Heq; trivial. substH Hsti with (Hsti _ _ _ _ (conj HMnh Hflnex)). destruct Hsti as [Mnh [Mih [HJM [Hlds' Hsti]]]]. rewrite Hfl in Hsti. destruct Hsti as [ [H1 H2] | [H1 H2]]; [discriminate H1 | clear H1]. assert (Hgpopfw_sti : gpopfw_sti (M, R, fl, isr) (Mnh, R', nat2FR flnum, isr)). unfold gpopfw_sti. unfold prepost, choice, itr_enabled. simpl. rewrite Hfl. rewrite Hfln. rsplit. auto. exists Mih; exists Mnh; exists MemMod.emp. rsplit. unfold Aemp; auto with PMap. right; split_r. intros [Hx Hy]; discriminate Hx. split. exists Mnh; exists Mih. split_l. unfold NH_Inv. rewrite Hfln. split_r. apply Hstipp'; trivial. apply linkPG_intro with (M, R, fl, isr); trivial. split; auto. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros [[[Mx Rx] flx] isrx] [Mx1 [Mx2 [Mx1' [Mx2' Hg]]]]. simplS; simplS in Hg. destruct Hg as [Hg1 [Hg2 [Hg3 [Hg4 Hg5]]]]. unfold NH_Inv in Hg3. rewrite Hfln in Hg3. destruct (prec_disjUnion_inv HJM Hg1 H2 Hg3 (Prec01)) as [Heq1 Heq2]. subst Mx1 Mx2. exists M; exists MemMod.emp. exists Mx1'; exists Mx2'. split_l by auto with PMap. split_l. unfold NH_Inv; rewrite Hfl. split. unfold Aemp; trivial. split_l. apply Hstig'g. apply conjG_intro with (Mnh, R', nat2FR flnum, isr); trivial. apply conjPG_intro; trivial. split; auto. (* 1 -> 0 *) unfold NH_Inv in * . rewrite Hfl in HMih. rewrite Hfln. assert (Hgpopfw_cli : gpopfw_cli (Mnh, R, fl, isr) (M, R', nat2FR flnum, isr)). unfold gpopfw_cli. simplS. rsplit. auto. unfold prepost, choice, itr_enabled. simplS. rewrite Hfl. exists MemMod.emp; exists Mnh; exists Mih. unfold Aemp. split_l. rsplit. auto with PMap. left; auto. split. exists M; exists MemMod.emp. split. auto with PMap. rsplit. unfold Aemp; trivial. apply Hclipp'. apply linkPG_intro with (Mnh, R, fl, isr); trivial. split; auto. destruct (nextS_inversion HnextSnh') as [_ [_ [Hflx _]]]. destruct Hflx as [x [Hx Hy]]. exists x; simplS. split_l. rewrite <- Hy; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros [[[Mx Rx] flx] isrx] [Mx1 [Mx2 [Mx1' [Mx2' Hg]]]]. simplS; simplS in Hg. destruct Hg as [Hg1 [Hg2 [Hg3 [Hg4 Hg5]]]]. unfold NH_Inv in Hg3. rewrite Hfln in Hg3. assert (Mx2 = MemMod.emp). unfold Aemp; trivial. subst Mx2. assert (Mx1 = M). auto with PMap. subst Mx1. exists Mnh; exists Mih. exists Mx1'; exists Mx2'. split. auto with PMap. split_l. split. unfold NH_Inv; rewrite Hfl; trivial. split_l. apply Hclig'g. apply conjG_intro with (M, R', nat2FR flnum, isr); trivial. apply conjPG_intro; trivial. split; auto. destruct (nextS_inversion HnextSnh') as [_ [_ [Hflx _]]]. destruct Hflx as [x [Hx Hy]]. exists x; simplS. split_l. rewrite <- Hy; trivial. (* 0 -> 0 *) unfold NH_Inv in * . rewrite Hfl in HMih. rewrite Hfln. assert (Mih = MemMod.emp). unfold Aemp in HMih; trivial. subst Mih. assert (Mnh = M). auto with PMap. subst Mnh. assert (Hgpopfw_cli : gpopfw_cli (M, R, fl, isr) (M, R', nat2FR flnum, isr)). unfold gpopfw_cli. simplS. rsplit. auto. unfold prepost, choice, itr_enabled. unfold Aemp. simplS. rewrite Hfl. exists MemMod.emp; exists M; exists MemMod.emp. split_l. rsplit. auto with PMap. right; split_r. intros [Hx Hy]; discriminate Hx. split. exists M; exists MemMod.emp. split. auto with PMap. rsplit. unfold Aemp; trivial. apply Hclipp'; trivial. apply linkPG_intro with (M, R, fl, isr); trivial. split; auto. destruct (nextS_inversion HnextSnh') as [_ [_ [Hflx _]]]. destruct Hflx as [x [Hx Hy]]. exists x; simplS. split_l. rewrite <- Hy; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros [[[Mx Rx] flx] isrx] [Mx1 [Mx2 [Mx1' [Mx2' Hg]]]]. simplS; simplS in Hg. destruct Hg as [Hg1 [Hg2 [Hg3 [Hg4 Hg5]]]]. unfold NH_Inv in Hg3. rewrite Hfln in Hg3. assert (Mx2 = MemMod.emp). unfold Aemp; trivial. subst Mx2. assert (Mx1 = M). auto with PMap. subst Mx1. exists M; exists MemMod.emp. exists Mx1'; exists Mx2'. split. auto with PMap. split_l. split. unfold NH_Inv; rewrite Hfl; trivial. split_l. apply Hclig'g. apply conjG_intro with (M, R', nat2FR flnum, isr); trivial. apply conjPG_intro; trivial. split; auto. exists flnum; auto. Qed. Implicit Arguments NH_popfw_prev [rho Psi pc S0 S' p p' g g' tag]. Lemma NH_cmpw_prog : forall rho Psi o r pc S0 (p : Pred) (g : Grt) tag, itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_cmpw o r)) S0 S'. Proof. intros rho Psi o r pc [[[M R] fl] isr] p g tag. intros H. destruct (eq_nat_dec (opr_eval R o) (R r)). exists (M, R, Set_Flag fl _ZF, isr). constructor. left; split_lr. exists (M, R, Clear_Flag fl _ZF, isr). constructor. right; split_lr. Qed. Implicit Arguments NH_cmpw_prog [rho Psi o r pc S0 p g tag]. Lemma NH_cmpw_prev : forall rho Psi o r pc S0 S' p p' g g' tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_cmpw o r)) S0 S' -> enable p (nextS pc (comml (_cmpw o r))) -> pimp (p |> nextS pc (comml (_cmpw o r))) p' -> gimp (p >o nextS pc (comml (_cmpw o r)) oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi o r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_cmpw o r))) (Mnh', R, fl', isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. assert (HInv' : NH_Inv fl' Mih). unfold NH_Inv. destruct Hfl. destruct H; subst fl'. unfold Set_Flag. simpl. trivial. destruct H; subst fl'. unfold Clear_Flag. simpl. trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HInv' (NHInv_prec fl')) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R, fl', isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_cmpw_prev [rho Psi o r pc S0 S' p p' g g' tag]. Lemma NH_addw_prog : forall rho Psi o r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_addw o r))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_addw o r)) S0 S'. Proof. intros rho Psi o r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_addw_prog [rho Psi o r pc S0 p g tag]. Lemma NH_addw_prev : forall rho Psi o r pc S0 S' p p' g g' tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_addw o r)) S0 S' -> enable p (nextS pc (comml (_addw o r))) -> pimp (p |> nextS pc (comml (_addw o r))) p' -> gimp (p >o nextS pc (comml (_addw o r)) oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi o r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HInv' : NH_Inv fl' Mih). unfold NH_Inv. destruct Hfl; subst fl'. unfold Set_Flag. simpl. trivial. unfold Clear_Flag. simpl. trivial. assert (HS' : (p |> nextS pc (comml (_addw o r))) (Mnh', R', fl', isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. unfold NH_pinvstar, pmstar. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HInv' (NHInv_prec fl')) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl', isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_addw_prev [rho Psi o r pc S0 S' p p' g g' tag]. Lemma NH_subw_prog : forall rho Psi o r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_subw o r))) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comml (_subw o r)) S0 S'. Proof. intros rho Psi o r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments NH_subw_prog [rho Psi o r pc S0 p g tag]. Lemma NH_subw_prev : forall rho Psi o r pc S0 S' p p' g g' tag, lookupCT Psi (pc+1) (packS0 rho (Ast p' g' tag)) -> nextS pc (comml (_subw o r)) S0 S' -> enable p (nextS pc (comml (_subw o r))) -> pimp (p |> nextS pc (comml (_subw o r))) p' -> gimp (p >o nextS pc (comml (_subw o r)) oo g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi o r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HInv' : NH_Inv fl' Mih). unfold NH_Inv. destruct Hfl; subst fl'. unfold Set_Flag. simpl. trivial. unfold Clear_Flag. simpl. trivial. assert (HS' : (p |> nextS pc (comml (_subw o r))) (Mnh', R', fl', isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. unfold NH_pinvstar, pmstar. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HInv' (NHInv_prec fl')) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl', isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_subw_prev [rho Psi o r pc S0 S' p p' g g' tag]. Lemma NH_jmp_prev : forall rho Psi f pc S0 S' p p' g g' tag, lookupCT Psi f (packS0 rho (Ast p' g' tag)) -> nextS pc (comms (_jmp f)) S0 S' -> pimp p p' -> gimp (p >o g') g -> itp_NH_theta rho (Ast p g tag) Psi S0 -> itp_NH_theta rho (Ast p' g' tag) Psi S'. Proof. intros rho Psi f pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hpp' Hg'g H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' fl' isr'. split_l. split. exists Mnh; exists Mih; split_l. split_r. apply Hpp'; trivial. intros Htag. substH Hwfst with (Hwfst Htag); clear Htag. apply NH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM HMy HMih (NHInv_prec fl)) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjPG_intro; trivial. Qed. Implicit Arguments NH_jmp_prev [rho Psi f pc S0 S' p p' g g' tag]. Lemma NH_retw_prog : forall rho Psi pc S0 (p : Pred) (g : Grt) tag, tag = 1 -> (forall S, p S -> g S S) -> itp_NH_theta rho (Ast p g tag) Psi S0 -> exists S', nextS pc (comms (_retw)) S0 S'. Proof. intros rho Psi pc [[[M R] fl] isr] p g tag Htag Hpg H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . substH Hwfst with (Hwfst Htag). unfold NH_WFST in Hwfst. assert (Hg : NH_ItpG g (M, R, fl, isr) (M, R, fl, isr)). simplS. exists Mnh; exists Mih. exists Mnh; exists Mih. split_l; split_l; split_l; split_l. apply Hpg; trivial. destruct Hwfst as [n Hwfst]. destruct n as [ | n]. simpl in Hwfst. substH Hwfst with (Hwfst (M, R, fl, isr) Hg). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hlookup [Htag' Hp']]]]]]]. assert (Heq : leadsToW (R SP) ra M). unfold Ret_Addr in Hra. simpl in Hra. substH Hra with (Hra pc). inversion_clear Hra. subst sp. trivial. exists (M, RF_update R SP (R SP + 2), fl, isr). apply nextS_retw. unfold popW. exists ra; split_lr. simpl in Hwfst. substH Hwfst with (Hwfst _ Hg). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hlk Hwfst]]]]]]. assert (Heq : leadsToW (R SP) ra M). unfold Ret_Addr in Hra. simpl in Hra. substH Hra with (Hra pc). inversion_clear Hra. subst sp. trivial. exists (M, RF_update R SP (R SP + 2), fl, isr). apply nextS_retw. unfold popW. exists ra; split_lr. Qed. Implicit Arguments NH_retw_prog [rho Psi pc S0 p g tag]. Lemma NH_retw_prev : forall rho Psi pc M R fl isr pc' S' (p : Pred) (g : Grt) tag, tag = 1 -> nextPC (comms _retw) M R fl pc pc' -> nextS pc (comms _retw) (M, R, fl, isr) S' -> (forall S, p S -> g S S) -> itp_NH_theta rho (Ast p g tag) Psi (M,R,fl,isr) -> exists theta', lookupCT Psi pc' (packS0 rho theta') /\ itp_NH_theta rho theta' Psi S'. Proof. intros rho Psi pc M R fl isr pc' [[[M' R'] fl'] isr'] p g tag. intros Htag HnextPC HnextS Hpg H. unfold itp_NH_theta, NH_pinvstar, pmstar in * . destruct H as [Hisrf [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . substH Hwfst with (Hwfst Htag). destruct (nextS_inversion HnextS) as [HM' [HR' [Hfl' Hisr']]]. subst M' fl' isr'. inversion_clear HnextPC. subst sp. unfold NH_WFST in Hwfst. assert (Hg : NH_ItpG g (M, R, fl, isr) (M, R, fl, isr)). simplS. exists Mnh; exists Mih. exists Mnh; exists Mih. split_l; split_l; split_l; split_l. apply Hpg; trivial. destruct Hwfst as [n Hwfst]. destruct n as [ | n]. simpl in Hwfst. substH Hwfst with (Hwfst (M, R, fl, isr) Hg). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hlookup [Htag' Hp']]]]]]]. assert (Heq : pc' = ra). unfold Ret_Addr in Hra. simpl in Hra. substH Hra with (Hra pc). inversion_clear Hra. subst sp. eapply leadsToW_unique; eauto. subst pc'. exists (Ast p' g' tag'); split_l. split_l. simpl. substH Hp' with (Hp' _ _ HnextS). unfold NH_pinvstar, mstar in Hp'. destruct Hp' as [Mnh' [Mih' [HJM' Hp']]]. simplS in * . split. exists Mnh'; exists Mih'; split_lr. intros Htag'x. destruct (Htag' Htag'x). simpl in Hwfst. substH Hwfst with (Hwfst _ Hg). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hlk Hwfst]]]]]]. assert (Heq : pc' = ra). unfold Ret_Addr in Hra. simpl in Hra. substH Hra with (Hra pc). inversion_clear Hra. subst sp. eapply leadsToW_unique; eauto. subst pc'. exists (Ast p' g' tag'); split_l. split_l. substH Hwfst with (Hwfst _ _ HnextS). destruct Hwfst as [Hp' Hwfst]. unfold NH_pinvstar, mstar in Hp'. destruct Hp' as [Mnh' [Mih' [HJM' Hp']]]. simplS in * . split. exists Mnh'; exists Mih'; split_lr. intros Htag'. exists n; trivial. Qed. Implicit Arguments NH_retw_prev [rho Psi pc M R fl isr pc' S' p g tag]. coq/SCAP/Makefile0000644000107400000620000001132611000223235013232 0ustar shaosystems################################################################################ The Calculus of Inductive Constructions #### #### Projet Coq #### #### INRIA ENS-CNRS #### Rocquencourt Lyon #### #### Coq V7 #### #### ################################################################################# WARNING # # This Makefile has been automagically generated by coq_makefile # Edit at your own risks ! # # END OF WARNING # # This Makefile was generated by the command line : # coq_makefile -I .. -I ../CAP0 -I . AIM.v Linking.v QLib.v QLemmas.v SCAP.v SCAP_IDLE.v SCAP_Itr.v SCAP_READY.v Linking_Lemmas.v Linking_Lemmas2.v Linking_Lemmas3.v SCAP_NH_Lemmas.v SCAP_Itr_Lemmas.v READY_SW.v IH_SW.v NH_SW.v READY_BLK.v READY_UNBLK.v SCAP_IDLE_Soundness.v SCAP_Itr_Soundness.v SCAP_READY_Soundness.v SCAP_Soundness.v # ########################## # # # Variables definitions. # # # ########################## CAMLP4LIB=`camlp4 -where` COQSRC=-I $(COQTOP)/kernel -I $(COQTOP)/lib \ -I $(COQTOP)/library -I $(COQTOP)/parsing \ -I $(COQTOP)/pretyping -I $(COQTOP)/interp \ -I $(COQTOP)/proofs -I $(COQTOP)/syntax -I $(COQTOP)/tactics \ -I $(COQTOP)/toplevel -I $(COQTOP)/contrib/correctness \ -I $(COQTOP)/contrib/extraction -I $(COQTOP)/contrib/field \ -I $(COQTOP)/contrib/fourier -I $(COQTOP)/contrib/graphs \ -I $(COQTOP)/contrib/interface -I $(COQTOP)/contrib/jprover \ -I $(COQTOP)/contrib/omega -I $(COQTOP)/contrib/romega \ -I $(COQTOP)/contrib/ring -I $(COQTOP)/contrib/xml \ -I $(CAMLP4LIB) ZFLAGS=$(OCAMLLIBS) $(COQSRC) OPT= COQFLAGS=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML) COQC=$(COQBIN)coqc GALLINA=gallina COQDOC=coqdoc CAMLC=ocamlc -c CAMLOPTC=ocamlopt -c CAMLLINK=ocamlc CAMLOPTLINK=ocamlopt COQDEP=$(COQBIN)coqdep -c GRAMMARS=grammar.cma CAMLP4EXTEND=pa_extend.cmo pa_ifdef.cmo q_MLast.cmo PP=-pp "camlp4o -I . -I $(COQTOP)/parsing $(CAMLP4EXTEND) $(GRAMMARS) -impl" ######################### # # # Libraries definition. # # # ######################### OCAMLLIBS=-I .\ -I ..\ -I ../CAP0\ -I . COQLIBS=-I .\ -I ..\ -I ../CAP0\ -I . ################################### # # # Definition of the "all" target. # # # ################################### VFILES=AIM.v\ Linking.v\ QLib.v\ QLemmas.v\ SCAP.v\ SCAP_IDLE.v\ SCAP_Itr.v\ SCAP_READY.v\ Linking_Lemmas.v\ Linking_Lemmas2.v\ Linking_Lemmas3.v\ SCAP_NH_Lemmas.v\ SCAP_Itr_Lemmas.v\ AIM_Lemmas.v\ READY_SW.v\ IH_SW.v\ NH_SW.v\ READY_BLK.v\ READY_UNBLK.v\ SCAP_IDLE_Soundness.v\ SCAP_Itr_Soundness.v\ SCAP_READY_Soundness.v\ SCAP_Soundness.v VOFILES=$(VFILES:.v=.vo) VIFILES=$(VFILES:.v=.vi) GFILES=$(VFILES:.v=.g) HTMLFILES=$(VFILES:.v=.html) GHTMLFILES=$(VFILES:.v=.g.html) all: $(VOFILES) spec: $(VIFILES) gallina: $(GFILES) html: $(HTMLFILES) gallinahtml: $(GHTMLFILES) all.ps: $(VFILES) $(COQDOC) -ps -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` all-gal.ps: $(VFILES) $(COQDOC) -ps -g -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` #################### # # # Special targets. # # # #################### .PHONY: all opt byte archclean clean install depend html .SUFFIXES: .v .vo .vi .g .html .tex .g.tex .g.html .v.vo: $(COQC) $(COQDEBUG) $(COQFLAGS) $* .v.vi: $(COQC) -i $(COQDEBUG) $(COQFLAGS) $* .v.g: $(GALLINA) $< .v.tex: $(COQDOC) -latex $< -o $@ .v.html: $(COQDOC) -html $< -o $@ .v.g.tex: $(COQDOC) -latex -g $< -o $@ .v.g.html: $(COQDOC) -html -g $< -o $@ byte: $(MAKE) all "OPT=" opt: $(MAKE) all "OPT=-opt" include .depend .depend depend: rm -f .depend $(COQDEP) -i $(COQLIBS) *.v *.ml *.mli >.depend $(COQDEP) $(COQLIBS) -suffix .html *.v >>.depend install: mkdir -p `$(COQC) -where`/user-contrib cp -f *.vo `$(COQC) -where`/user-contrib clean: rm -f *.cmo *.cmi *.cmx *.o *.vo *.vi *.g *~ rm -f all.ps all-gal.ps $(HTMLFILES) $(GHTMLFILES) archclean: rm -f *.cmx *.o html: # WARNING # # This Makefile has been automagically generated by coq_makefile # Edit at your own risks ! # # END OF WARNING coq/SCAP/SCAP_IDLE_Soundness.v0000644000107400000620000026430411000223235015353 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import EqNat. Require Import Linking. Require Import Linking_Lemmas. Require Import Linking_Lemmas2. Require Import SCAP_NH_Lemmas. Require Import NH_SW. Require Import READY_BLK. Require Import READY_UNBLK. Lemma SCAP_IDLE_in_CAP0_call : forall D psi pc theta D' Psi Psi' f, IDLE_WFcmd psi pc theta (comml (_call f)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_call f)). Proof. intros D psi pc [p g tag] D' Psi Psi' f. intros Hi HD HD' Hlift HPsi'. destruct ((fun x => Hi) 0) as [Hi' Hpgik]. unfold NH_WFcmd_aux in Hi'. destruct Hi' as [[Hf Hi'] | [Hf Hi']]. (* prim_entry f *) unfold IDLE_Call_Prim in Hi'. destruct Hi' as [H1 H2]. inversion H1; subst f. (* f = _SWITCH *) eapply NH_SW_Itp; eauto. unfold NH_WFcmd, NH_WFcmd_aux; auto. (* ~ prim_entry f *) clear Hi. rename Hi' into Hi. subst D' Psi'. unfold IDLE_WFcmd in Hi. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. (* ~ prim_entry f *) simpl in Hi. destruct Hi as [p' [p'' [g' [g'' [Hlookup' [Hlookup'' Hi]]]]]]. destruct Hi as [Hcall [Hfun [Hpp' [Hpg'p'' Hg''g]]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_call_prog Hcall Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst R' fl' isr'. assert (HnextPC' := nextPC_call pc f M R fl). assert (Heq := nextPC_injection HnextPC HnextPC'). subst pc'. clear HnextPC'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' f (packS0 rho_idle (Ast p' g' 1))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. assert (Hlk'' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p'' g'' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' 1)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l. split_l. split_l. split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear Hf H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_nonprim_call_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_cli : forall D psi pc theta D' Psi Psi', IDLE_WFcmd psi pc theta (comml (_cli)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_cli)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. assert (HnextS := nextS_cli pc M R fl isr). assert (HnextPC := nextPC_cli pc M R fl). simpl in Hi. destruct Hi as [p' [g' [Hlk [Hpp' Hg'g]]]]. split. exists (M, R, Clear_Flag fl _IF, isr); trivial. intros f' S' HnextS' HnextPC'. destruct S' as [[[M' R'] fl'] isr']. assert (Heq := nextS_injection HnextS HnextS'). simpl in Heq. destruct Heq as [Heq1 Heq2]; destruct Heq1; destruct Heq2. assert (Heq := nextPC_injection HnextPC HnextPC'). subst M' R' fl' isr' f'. clear HnextS' HnextPC'. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World in * . destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. exists Mth; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM; exists Mcth. split_l. split_l. rsplit. split_lr. simplS; simplS in H7. unfold WF_Curr_Thrd in * . simpl in * . eapply NH_cli_prev; eauto. Qed. Lemma SCAP_IDLE_in_CAP0_sti : forall D psi pc theta D' Psi Psi', IDLE_WFcmd psi pc theta (comml (_sti)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_sti)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. assert (HnextS := nextS_sti pc M R fl isr). assert (HnextPC := nextPC_sti pc M R fl). simpl in Hi. destruct Hi as [p' [g' [Hlookup [Hsti [Hpp' Hg'g]]]]]. split. exists (M, R, Set_Flag fl _IF, isr); trivial. intros f' S' HnextS' HnextPC'. destruct S' as [[[M' R'] fl'] isr']. assert (Heq := nextS_injection HnextS HnextS'). simpl in Heq. destruct Heq as [Heq1 Heq2]; destruct Heq1; destruct Heq2. assert (Heq := nextPC_injection HnextPC HnextPC'). subst M' R' fl' isr' f'. clear HnextS' HnextPC'. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World in * . destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. exists Mth;exists Mq. split_l. split_r. split_l. split_l. split_l. split_l. exists TM. exists Mcth. split_l. split_l. rsplit. split_lr. simplS; simplS in H7. unfold WF_Curr_Thrd in * . simpl in * . eapply NH_sti_prev; eauto. Qed. Lemma SCAP_IDLE_in_CAP0_jne : forall D psi pc theta D' Psi Psi' f, IDLE_WFcmd psi pc theta (comml (_jne f)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_jne f)). Proof. intros D psi pc [p g tag] D' Psi Psi' f. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [p'' [g' [g'' [Hlookup' [Hlookup'' Hi]]]]]]. destruct Hi as [Hpp' [Hg'g [Hpp'' Hg''g]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_jne_prog (f:=f) (pc:=pc) Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr']]]. subst M' R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. assert (Hlk' : lookupCT Psi' f (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. assert (Hlk'' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p'' g'' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. inversion HnextPC. (* non-jmp *) subst f0 M0 R0 fl0 pc0 pc'. simplS in H0. rename H0 into Hflzf. exists (packS0 rho_idle (Ast p'' g'' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl; simplS in * . eapply NH_jne_seq_prev; eauto. simplS; trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). (* jmp *) subst f0 M0 R0 fl0 pc0 pc'. simplS in H0. rename H0 into Hflzf. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl; simplS. eapply NH_jne_jmp_prev; eauto. simplS; trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_movwp : forall D psi pc theta D' Psi Psi' o r, IDLE_WFcmd psi pc theta (comml (_movwp o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_movwp o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hmovwp Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_movwp_prog Hmovwp Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_movwp_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_movwld : forall D psi pc theta D' Psi Psi' a r, IDLE_WFcmd psi pc theta (comml (_movwld a r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_movwld a r)). Proof. intros D psi pc [p g tag] D' Psi Psi' a r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hmovwp Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_movwld_prog Hmovwp Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). destruct HR as [x [Hlds HR']]. subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_movwld_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_movwst : forall D psi pc theta D' Psi Psi' o a, IDLE_WFcmd psi pc theta (comml (_movwst o a)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_movwst o a)). Proof. intros D psi pc [p g tag] D' Psi Psi' o a. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hmovwst Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_movwst_prog Hmovwst Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_movwst_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_pushwp : forall D psi pc theta D' Psi Psi' o, IDLE_WFcmd psi pc theta (comml (_pushwp o)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_pushwp o)). Proof. intros D psi pc [p g tag] D' Psi Psi' o. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_pushwp_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_pushwp_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_pushwm : forall D psi pc theta D' Psi Psi' a, IDLE_WFcmd psi pc theta (comml (_pushwm a)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_pushwm a)). Proof. intros D psi pc [p g tag] D' Psi Psi' a. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_pushwm_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_pushwm_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_pushfw : forall D psi pc theta D' Psi Psi', IDLE_WFcmd psi pc theta (comml (_pushfw)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_pushfw)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_pushfw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_pushfw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_popw : forall D psi pc theta D' Psi Psi' r, IDLE_WFcmd psi pc theta (comml (_popw r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_popw r)). Proof. intros D psi pc [p g tag] D' Psi Psi' r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_popw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). destruct HR as [x [Hlds HR']]. subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_popw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_popfw : forall D psi pc theta D' Psi Psi', IDLE_WFcmd psi pc theta (comml (_popfw)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_popfw)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hsti [Hstipp' [Hstig'g [Hclipp' Hclig'g]]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_popfw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). destruct Hfl as [flnum [Hlds Hfl']]. subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_popfw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_cmpw : forall D psi pc theta D' Psi Psi' o r, IDLE_WFcmd psi pc theta (comml (_cmpw o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_cmpw o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_cmpw_prog (o:=o) (r:=r) (pc:=pc) Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_cmpw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_addw : forall D psi pc theta D' Psi Psi' o r, IDLE_WFcmd psi pc theta (comml (_addw o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_addw o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_addw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_addw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_subw : forall D psi pc theta D' Psi Psi' o r, IDLE_WFcmd psi pc theta (comml (_subw o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comml (_subw o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_subw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_subw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_jmp : forall D psi pc theta D' Psi Psi' f, IDLE_WFcmd psi pc theta (comms (_jmp f)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comms (_jmp f)). Proof. intros D psi pc [p g tag] D' Psi Psi' f. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. destruct Hi as [p' [g' [Hlk' [Hpp' Hg'g]]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. split. exists (M, R, fl, isr); constructor; trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. assert (HnextScth : nextS pc (comms (_jmp f)) (Mcth, R, fl, isr) (Mcth, R, fl, isr)). constructor; trivial. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear HnextScth. assert (Hlk'' : lookupCT Psi' f (packS0 rho_idle (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_idle (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_jmp_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_retw : forall D psi pc theta D' Psi Psi', IDLE_WFcmd psi pc theta (comms (_retw)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc (comms (_retw)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold IDLE_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_idle; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [Htag Hp]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_retw_prog (pc:=pc) Htag Hp Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R']fl']isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr']]]. destruct HR as [pc'x [Hlds HR]]. subst M' R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (pc' = pc'x). eapply leadsToW_unique; eauto. simplS in * ; subst; trivial. inversion_clear HnextPC. subst; trivial. subst pc'x. assert (HnextPC' : nextPC (comms _retw) Mcth R fl pc pc'). inversion_clear HnextPC. destruct (nextS_inversion HnextS') as [_ [HR [_ _]]]. destruct HR as [pc'x [Hlds' HR']]. assert (Heq : pc' = pc'x). eapply leadsToW_unique; eauto. destruct (MemSplit_Inv H5 H6) as [Moth [Hx _]]. simplS in * . apply (leadsToW_Mono (addr := sp)(x := pc'x) HJM); eauto. eapply leadsToW_Mono; eauto. subst; trivial. subst pc'x. apply nextPC_retw with (R SP); trivial. destruct (NH_retw_prev Htag HnextPC' HnextS' Hp Hwfcth) as [theta' [Hlk' Hwf]]. exists (packS0 rho_idle theta'); split_l. unfold ext_dict. simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. exists Mth'; exists Mq; split_l. split_r. unfold WF_AIM_World. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear B RdyQ HtoMcth' HTM' H1 H2 H3 H4 H5 H6 H8 H9 HMq. clear Mq Mth TM HnextS HJM HJM'. unfold WF_Curr_Thrd. simpl; simplS. trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IDLE_in_CAP0_cmd: forall D psi pc theta c D' Psi Psi', IDLE_WFcmd psi pc theta c -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_idle theta) pc c. Proof. intros D psi pc [p g tag] c D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. induction c as [ i | s]; [ induction i | induction s]. (* 19 goals remain, i = cli *) eapply SCAP_IDLE_in_CAP0_cli; eauto. (* 18 goals remain, i = sti *) eapply SCAP_IDLE_in_CAP0_sti; eauto. (* 17 goals remain, i = call f *) eapply SCAP_IDLE_in_CAP0_call; eauto. (* 16 goals remain, i = jne f *) eapply SCAP_IDLE_in_CAP0_jne; eauto. (* 15 goals remain, i = movwp o r *) eapply SCAP_IDLE_in_CAP0_movwp; eauto. (* 14 goals remain, i = movwld a r *) eapply SCAP_IDLE_in_CAP0_movwld; eauto. (* 13 goals remain, i = movwst o a *) eapply SCAP_IDLE_in_CAP0_movwst; eauto. (* 12 goals remain, i = pushwp o *) eapply SCAP_IDLE_in_CAP0_pushwp; eauto. (* 11 goals remain, i = pushwm a *) eapply SCAP_IDLE_in_CAP0_pushwm; eauto. (* 10 goals remain, i = pushfw *) eapply SCAP_IDLE_in_CAP0_pushfw; eauto. (* 9 goals remain, i = popw r *) eapply SCAP_IDLE_in_CAP0_popw; eauto. (* 8 goals remain, i = popfw *) eapply SCAP_IDLE_in_CAP0_popfw; eauto. (* 7 goals remain, i = cmpw o r *) eapply SCAP_IDLE_in_CAP0_cmpw; eauto. (* 6 goals remain, i = addw o r *) eapply SCAP_IDLE_in_CAP0_addw; eauto. (* 5 goals remain, i = subw o r *) eapply SCAP_IDLE_in_CAP0_subw; eauto. (* 4 goals remain, i = outb eoi *) destruct Hi as [Hi _]; destruct Hi. (* 3 goals remain, i = jmp f *) eapply SCAP_IDLE_in_CAP0_jmp; eauto. (* 2 goals remain, i = retw *) eapply SCAP_IDLE_in_CAP0_retw; eauto. (* 1 goals remain, i = iret *) simpl in Hi. destruct Hi as [Hi _ ]; destruct Hi. Qed. Implicit Arguments SCAP_IDLE_in_CAP0_cmd [D psi pc theta c D' Psi Psi']. Lemma SCAP_IDLE_in_CAP0_iseq : forall D psi pc theta isq D' Psi Psi', IDLE_WFiseq psi pc theta isq -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFiseq D' Psi' (packS0 rho_idle theta) pc isq. Proof. intros D psi pc theta isq D' Psi Psi'. intros Hscap HD HD' Hlift HPsi'. gen_clear theta pc Hscap HPsi'. induction isq; intros theta pc Hscap HPsi'. inversion Hscap. subst psi0 pc0 theta i0 isq0. eapply wfis_seq with (packS0 rho_idle (Ast p' g' tag)). assert (Hlift' := lift_psi_cons (f := pc+1) (spec := Ast p' g' tag) Hlift). apply WFcmd_Mono_CT with (ext_IH_Spec (ext_Prim_Specs (consCT (pc + 1) (packS0 rho_idle (Ast p' g' tag)) Psi))). subst Psi'. unfold ext_IH_Spec, ext_Prim_Specs. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. apply Psi_extend2_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply consCT_subsetCT. assert (HPsi'2 := refl_equal (ext_IH_Spec (ext_Prim_Specs (consCT (pc + 1) (packS0 rho_idle (Ast p' g' tag)) Psi)))). apply (SCAP_IDLE_in_CAP0_cmd H4 HD HD' Hlift' HPsi'2). apply IHisq; trivial. inversion Hscap. subst psi0 pc0 theta si. eapply wfis_end. apply (SCAP_IDLE_in_CAP0_cmd H3 HD HD' Hlift HPsi'). Qed. Lemma SCAP_IDLE_in_CAP0_cdhp : forall D psi C psi' D' Psi Psi' Psi'', IDLE_WFcdhp psi C psi' -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_idle Psi -> lift_psi psi' rho_idle Psi' -> sink_psi psi' rho_idle Psi' -> Psi'' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcdhp D' Psi'' C Psi'. Proof. intros D psi C psi' D' Psi Psi' Psi''. intros H HD HD' H0 H1 H2 HPsi''. intros f theta0 Hf. substH H2 with (H2 f theta0 Hf). destruct H2 as [theta [Htheta0 Hfx]]. unfold SCAP_WFcdhp in H. substH H with (H f theta Hfx). destruct H as [isq [Hisq H]]. exists isq; split_l. destruct theta0. injection Htheta0; intros; subst n s. eapply SCAP_IDLE_in_CAP0_iseq; eauto. Qed. Lemma SCAP_IDLE_in_SCAP_RDY_cmd : forall psi pc theta c, IDLE_WFcmd psi pc theta c -> NH_WFcmd psi pc theta c. Proof. intros psi pc [p g tag] c. induction c as [ i | s]; [ induction i | induction s]; unfold IDLE_WFcmd, NH_WFcmd, IDLE_WFcmd_aux, NH_WFcmd_aux, IDLE_Call_Prim; auto. intuition. Qed. Lemma SCAP_IDLE_in_SCAP_RDY_iseq : forall psi pc theta isq, IDLE_WFiseq psi pc theta isq -> NH_WFiseq psi pc theta isq. Proof. intros psi pc theta isq. gen_clear pc theta. induction isq; intros pc theta Hidle. inversion Hidle. subst psi0 pc0 theta i0 isq0. eapply nh_isq_seq with p' g'; trivial. apply SCAP_IDLE_in_SCAP_RDY_cmd; trivial. apply IHisq; trivial. inversion Hidle. subst psi0 pc0 theta si. eapply nh_isq_end. apply SCAP_IDLE_in_SCAP_RDY_cmd; trivial. Qed. Lemma SCAP_IDLE_in_SCAP_RDY_cdhp : forall psi C psi', IDLE_WFcdhp psi C psi' -> NH_WFcdhp psi C psi'. Proof. intros psi C psi' Hidle. intros f theta Hf. substH Hidle with (Hidle f theta Hf). destruct Hidle as [isq [Hisq Hidle]]. exists isq; split_l. apply SCAP_IDLE_in_SCAP_RDY_iseq; trivial. Qed. coq/SCAP/SCAP_Itr_Lemmas.v0000644000107400000620000020116111000223235014621 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas5. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_Itr. Require Import EqNat. Require Import Linking. Require Import Linking_Lemmas2. Lemma IH_iret_prog : forall status Psi pc S0 (p : Pred) (g : Grt) tag, tag = 0 -> (forall S, p S -> g S S) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comms _iret) S0 S'. Proof. intros status Psi pc [[[M R] fl] isr] p g tag Htag Hpg H. unfold itp_IH_theta in H. subst tag. destruct H as [Hisrf [Hp | [Htag _]]]; [idtac | discriminate Htag]. unfold lift_IH_PG, pmstar in Hp. destruct Hp as [_ [Hp Hwfst]]. destruct Hp as [Mih [Mnh [HJM [HMih HMnh]]]]. simplS in * . assert (Hg : IH_ItpG g (M, R, fl, isr) (M, R, fl, isr)). simplS. unfold IH_ItpG. exists Mih; exists Mnh. exists Mih; exists Mnh. split_l; split_l; split_l; split_l. apply Hpg; trivial. substH Hwfst with (Hwfst _ Hg). destruct Hwfst as [S' [HnextS [ra [Hra [rho [theta [Hrho [Hlkra Hwfst]]]]]]]]. assert (Heq : leadsToW (R SP) ra M). unfold Ret_Addr in Hra. simpl in Hra. substH Hra with (Hra pc). inversion_clear Hra. subst sp. trivial. destruct S' as [[[M' R'] fl'] isr']. exists (M', R', fl', isr'). apply HnextS. Qed. Implicit Arguments IH_iret_prog [status Psi pc S0 p g tag]. Lemma IH_iret_prev : forall status Psi pc M R fl isr pc' S' (p : Pred) (g : Grt) tag, tag = 0 -> nextPC (comms _iret) M R fl pc pc' -> nextS pc (comms _iret) (M, R, fl, isr) S' -> (forall S, p S -> g S S) -> itp_IH_theta (Ast p g tag) status Psi (M,R,fl,isr) -> exists theta', exists rho', (rho' = rho_ready \/ rho' = rho_idle) /\ rho_tcb_consistent2 status rho' /\ lookupCT Psi pc' (packS0 rho' theta') /\ itp_NH_theta rho' theta' Psi S'. Proof. intros status Psi pc M R fl isr pc' [[[M' R'] fl'] isr'] p g tag. intros Htag HnextPC HnextS Hpg H. subst tag. destruct H as [Hisrf [Hp | [Htag _]]]; [idtac | discriminate Htag]. destruct Hp as [_ [Hp Hwfst]]. destruct Hp as [Mih [Mnh [HJM [HMih HMnh]]]]. simplS in * . assert (Hg : IH_ItpG g (M, R, fl, isr) (M, R, fl, isr)). simplS. unfold IH_ItpG. exists Mih; exists Mnh. exists Mih; exists Mnh. split_l; split_l; split_l; split_l. apply Hpg; trivial. substH Hwfst with (Hwfst _ Hg). destruct (nextS_inversion HnextS) as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [HM' Hlds]. destruct Hfl' as [fln [Hfl' Hlds']]. subst M' R' fl' isr'. inversion_clear HnextPC. subst sp. destruct Hwfst as [S' [HnextS' [ra [Hra [rho [theta [Hrho [Htcb [Hlkra Hwfst]]]]]]]]]. substH Hwfst with (Hwfst pc _ HnextS). assert (Hlds2 : leadsToW (R SP) ra M). unfold Ret_Addr in Hra. simpl in Hra. substH Hra with (Hra pc). inversion_clear Hra. subst sp. trivial. assert (Heq : ra = pc'). eapply leadsToW_unique; eauto. subst pc'. exists theta; exists rho; auto. Qed. Implicit Arguments IH_iret_prev [status Psi pc M R fl isr pc' S' p g tag]. Lemma IH_call_prog : forall status Psi f pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_call f))) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_call f)) S0 S'. Proof. intros status Psi f pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. destruct Hntop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments IH_call_prog [status Psi f pc S0 p g tag]. Lemma IH_nonprim_call_prev : forall status Psi f pc S0 S' (p p' p'': Pred) (g g' g'': Grt) tag, lookupCT Psi f (packS0 rho_ih (Ast p' g' 1)) -> lookupCT Psi (pc+1) (packS0 rho_ih (Ast p'' g'' tag)) -> nextS pc (comml (_call f)) S0 S' -> enable p (nextS pc (comml (_call f))) -> gimp (sp_call_pred p pc f >o g') fun_frame -> pimp (p |> nextS pc (comml (_call f))) p' -> (forall pc' : nat, pimp (p |> wrap_fun g' pc f pc') p'') -> (forall pc' : nat, gimp (p >o wrap_fun g' pc f pc' oo g'') g) -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' 1) status Psi S'. Proof. intros status Psi f pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' p'' g g' g'' tag. intros Hlk' Hlk'' HnextS Hen Hfun Hpp' Hg'p'' Hg''g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst R' fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_call f))) (Mnh', RF_update R SP (R SP - 2), fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. right. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. set (S := (M, R, fl, isr)) in * . set (S' := (M', RF_update R SP (R SP - 2), fl, isr)) in * . set (Snh := (Mnh, R, fl, isr)) in * . set (Snh' := (Mnh', RF_update R SP (R SP - 2), fl, isr)) in * . exists O. simpl. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. unfold S' in Hg'. simplS in Hg'. destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. unfold wrap_fun in Hg'p''. simplS in * . set (S'' := (M'', R'', fl'', isr'')) in * . set (Snh'' := (Mnh'', R'', fl'', isr'')). assert (Hfunframe : fun_frame Snh' Snh''). apply Hfun. unfold sp_call_pred. apply conjPG_intro; trivial. unfold fun_frame in Hfunframe. destruct Hfunframe as [_ [ra [Hra' Hra'']]]. assert (Hrax := ra_after_call _ _ Hra' HnextSnh'). subst ra. exists (pc + 1). unfold S''. split. unfold S''. apply (Ret_Addr_Mono HJM'' Hra''). clear Hra'. exists (Ast p'' g'' tag). split_l. intros pc' S''' HnextS''. substH Hg'p'' with (Hg'p'' pc'). assert (HnextSnh''Sx : nextS pc' (comms _retw) (Mnh'', R'', fl'', isr'') (Mnh'', RF_update R'' SP (R'' SP + 2), fl'', isr'')). unfold Ret_Addr in Hra''. substH Hra'' with (Hra'' pc'). inversion_clear Hra''. subst Snh'' sp; simplS in * . apply nextS_retw. exists (pc+1). unfold popW. split_lr. destruct S''' as [[[M''' R'''] fl'''] isr''']. destruct (nextS_DMono HJM'' HnextSnh''Sx HnextS'') as [Mnh''' [HJM''' HnextSnh'']]. destruct (nextS_inversion HnextSnh'') as [HM [_ [Hfl Hisr]]]. subst Mnh''' fl''' isr'''. destruct (nextS_inversion HnextS'') as [HM _]. subst M'''. split_l. split. unfold NH_pinvstar, pmstar. exists Mnh''; exists Mih''; split_l. split_r by (apply HMih''). apply Hg'p''. apply linkPG_intro with Snh; trivial. apply conjG_intro with Snh''; trivial. apply conjG_intro with Snh'; trivial. intros Sx H. destruct H as [Mnh''0 [Mih''0 [Mnhx [Mihx [HJM''0 [HJMx [HMih''0 [HMihx Hg'']]]]]]]]. destruct (prec_disjUnion_inv HJM'' HJM''0 HMih'' HMih''0 Prec1) as [Heq1 Heq2]. subst Mnh''0 Mih''0. clear HJM''0 HMih''0. assert (IH_ItpG g S Sx). unfold IH_ItpG. exists Mnh; exists Mih; exists Mnhx; exists Mihx. split_l; split_l; split_l; split_l. apply (Hg''g pc'). apply conjG_intro with (Mnh'', R''', fl'', isr''); trivial. unfold wrap_fun. apply conjPG_intro; auto. apply conjG_intro with Snh''; subst S; trivial. apply conjG_intro with Snh'; trivial. apply (Hg _ H). destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst R' fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_call f))) (Mnh', RF_update R SP (R SP - 2), fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. right. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. set (S := (M, R, fl, isr)) in * . set (S' := (M', RF_update R SP (R SP - 2), fl, isr)) in * . set (Snh := (Mnh, R, fl, isr)) in * . set (Snh' := (Mnh', RF_update R SP (R SP - 2), fl, isr)) in * . destruct Hwfst as [n Hwfst]. exists (1+n). simpl. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. unfold S' in Hg'. simplS in Hg'. destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. unfold wrap_fun in Hg'p''. simplS in * . set (S'' := (M'', R'', fl'', isr'')) in * . set (Snh'' := (Mnh'', R'', fl'', isr'')). assert (Hfunframe : fun_frame Snh' Snh''). apply Hfun. unfold sp_call_pred. apply conjPG_intro; trivial. unfold fun_frame in Hfunframe. destruct Hfunframe as [_ [ra [Hra' Hra'']]]. assert (Hrax := ra_after_call _ _ Hra' HnextSnh'). subst ra. exists (pc + 1). unfold S''. split. unfold S''. apply (Ret_Addr_Mono HJM'' Hra''). clear Hra'. exists p''; exists g''; exists tag. split_l. split_l. intros pc' S''' HnextS''. substH Hg'p'' with (Hg'p'' pc'). assert (HnextSnh''Sx : nextS pc' (comms _retw) (Mnh'', R'', fl'', isr'') (Mnh'', RF_update R'' SP (R'' SP + 2), fl'', isr'')). unfold Ret_Addr in Hra''. substH Hra'' with (Hra'' pc'). inversion_clear Hra''. subst Snh'' sp; simplS in * . apply nextS_retw. exists (pc+1). unfold popW. split_lr. destruct S''' as [[[M''' R'''] fl'''] isr''']. destruct (nextS_DMono HJM'' HnextSnh''Sx HnextS'') as [Mnh''' [HJM''' HnextSnh'']]. destruct (nextS_inversion HnextSnh'') as [HM [_ [Hfl Hisr]]]. subst Mnh''' fl''' isr'''. destruct (nextS_inversion HnextS'') as [HM _]. subst M'''. split. unfold NH_pinvstar, pmstar. exists Mnh''; exists Mih''; split_l. split_r by (apply HMih''). apply Hg'p''. apply linkPG_intro with Snh; trivial. apply conjG_intro with Snh''; trivial. apply conjG_intro with Snh'; trivial. apply (IH_WFST_strengthen (S1 := (M'', R''', fl'', isr'')) (g':= g'') Hwfst). substH Hg''g with (Hg''g pc' Snh). unfold NH_ItpG. intros Sx H. destruct H as [Mnh''0 [Mih''0 [Mnhx [Mihx [HJM''0 [HJMx [HMih''0 [HMihx Hg'']]]]]]]]. destruct Sx as [[[Mx Rx] flx] isrx]. simplS in * . destruct (prec_disjUnion_inv HJM'' HJM''0 HMih'' HMih''0 Prec1) as [Heq1 Heq2]. subst Mnh''0 Mih''0. clear HJM''0 HMih''0. exists Mnh; exists Mih; exists Mnhx; exists Mihx. split_l; split_l; split_l; split_l. apply Hg''g. apply conjG_intro with (Mnh'', R''', fl'', isr''); trivial. unfold wrap_fun. apply conjPG_intro; auto. apply conjG_intro with Snh''; subst S; trivial. apply conjG_intro with Snh'; trivial. Qed. Implicit Arguments IH_nonprim_call_prev [status Psi f pc S0 S' p p' p'' g g' g'' tag]. Lemma IH_jne_prog : forall status Psi f pc S0 (p : Pred) (g : Grt) tag, itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_jne f)) S0 S'. Proof. intros status Psi f pc [[[M R] fl] isr] p g tag. intros H. exists (M, R, fl, isr). constructor. Qed. Implicit Arguments IH_jne_prog [status Psi f pc S0 p g tag]. Lemma IH_jne_jmp_prev : forall status Psi f pc S0 S' (p p': Pred) (g g': Grt) tag, lookupCT Psi f (packS0 rho_ih (Ast p' g' tag)) -> S_Flag S0 _ZF = false -> nextS pc (comml (_jne f)) S0 S' -> pimp (conjP p ZF_cl) p' -> gimp (p >o (ZF_cl >o g')) g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi f pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' Hflzf HnextS Hpp' Hg'g H. unfold itp_NH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' fl' isr'. assert (HS' : (p |> nextS pc (comml (_jne f))) (Mnh, R, fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. constructor. split_l. left. split_l. split. exists Mnh; exists Mih. split_l. split_r. simplS. apply Hpp'; trivial. split; trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold IH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in Hg'. destruct (prec_disjUnion_inv HJMxy HJM HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. assert (IH_ItpG g (M, R, fl, isr) (M'', R'', fl'', isr'')). unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjPG_intro; trivial. apply conjPG_intro; trivial. apply Hg; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' fl' isr'. assert (HS' : (p |> nextS pc (comml (_jne f))) (Mnh, R, fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. constructor. split_l. right. split_l. split. exists Mnh; exists Mih. split_l. split_r. simplS. apply Hpp'; trivial. split; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in Hg'. destruct (prec_disjUnion_inv HJMxy HJM HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjPG_intro; trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_jne_jmp_prev [status Psi f pc S0 S' p p' g g' tag]. Lemma IH_jne_seq_prev : forall status Psi f pc S0 S' (p p'': Pred) (g g'': Grt) tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p'' g'' tag)) -> S_Flag S0 _ZF = true -> nextS pc (comml (_jne f)) S0 S' -> pimp (conjP p ZF_st) p'' -> gimp (p >o (ZF_st >o g'')) g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p'' g'' tag) status Psi S'. Proof. intros status Psi f pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p'' g g'' tag. intros Hlk'' Hflzf HnextS Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' fl' isr'. assert (HS' : (p |> nextS pc (comml (_jne f))) (Mnh, R, fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. constructor. split_l. left. split_l. split. exists Mnh; exists Mih. split_l. split_r. simplS. apply Hpp'; trivial. split; trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold IH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in Hg'. destruct (prec_disjUnion_inv HJMxy HJM HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. assert (IH_ItpG g (M, R, fl, isr) (M'', R'', fl'', isr'')). unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjPG_intro; trivial. apply conjPG_intro; trivial. apply Hg; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' fl' isr'. assert (HS' : (p |> nextS pc (comml (_jne f))) (Mnh, R, fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. constructor. split_l. right. split_l. split. exists Mnh; exists Mih. split_l. split_r. simplS. apply Hpp'; trivial. split; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in Hg'. destruct (prec_disjUnion_inv HJMxy HJM HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjPG_intro; trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_jne_seq_prev [status Psi f pc S0 S' p p'' g g'' tag]. Lemma IH_movwp_prog : forall status Psi o r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_movwp o r))) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_movwp o r)) S0 S'. Proof. intros status Psi o r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. destruct Hntop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments IH_movwp_prog [status Psi o r pc S0 p g tag]. Lemma IH_movwp_prev : forall status Psi o r pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comml (_movwp o r)) S0 S' -> enable p (nextS pc (comml (_movwp o r))) -> pimp (p |> nextS pc (comml (_movwp o r))) p' -> gimp (p >o nextS pc (comml (_movwp o r)) oo g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi o r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_movwp o r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. left. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. simplS. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_movwp o r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. right. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_movwp_prev [status Psi o r pc S0 S' p p' g g' tag]. Lemma IH_movwld_prog : forall status Psi a r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_movwld a r))) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_movwld a r)) S0 S'. Proof. intros status Psi a r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. destruct Hntop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments IH_movwld_prog [status Psi a r pc S0 p g tag]. Lemma IH_movwld_prev : forall status Psi a r pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comml (_movwld a r)) S0 S' -> enable p (nextS pc (comml (_movwld a r))) -> pimp (p |> nextS pc (comml (_movwld a r))) p' -> gimp (p >o nextS pc (comml (_movwld a r)) oo g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi a r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_movwld a r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. left. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. simplS. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_movwld a r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. right. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_movwld_prev [status Psi a r pc S0 S' p p' g g' tag]. Lemma IH_movwst_prog : forall status Psi a r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_movwst a r))) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_movwst a r)) S0 S'. Proof. intros status Psi a r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. destruct Hntop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments IH_movwst_prog [status Psi a r pc S0 p g tag]. Lemma IH_movwst_prev : forall status Psi a r pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comml (_movwst a r)) S0 S' -> enable p (nextS pc (comml (_movwst a r))) -> pimp (p |> nextS pc (comml (_movwst a r))) p' -> gimp (p >o nextS pc (comml (_movwst a r)) oo g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi a r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_movwst a r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. left. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. simplS. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_movwst a r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. right. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_movwst_prev [status Psi a r pc S0 S' p p' g g' tag]. Lemma IH_pushwp_prog : forall status Psi o pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_pushwp o))) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_pushwp o)) S0 S'. Proof. intros status Psi o pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. destruct Hntop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments IH_pushwp_prog [status Psi o pc S0 p g tag]. Lemma IH_pushwp_prev : forall status Psi o pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comml (_pushwp o)) S0 S' -> enable p (nextS pc (comml (_pushwp o))) -> pimp (p |> nextS pc (comml (_pushwp o))) p' -> gimp (p >o nextS pc (comml (_pushwp o)) oo g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi o pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_pushwp o))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. left. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. simplS. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_pushwp o))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. right. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, NH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_pushwp_prev [status Psi o pc S0 S' p p' g g' tag]. Lemma IH_pushwm_prog : forall status Psi a pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_pushwm a))) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_pushwm a)) S0 S'. Proof. intros status Psi a pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. destruct Hntop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments IH_pushwm_prog [status Psi a pc S0 p g tag]. Lemma IH_pushwm_prev : forall status Psi a pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comml (_pushwm a)) S0 S' -> enable p (nextS pc (comml (_pushwm a))) -> pimp (p |> nextS pc (comml (_pushwm a))) p' -> gimp (p >o nextS pc (comml (_pushwm a)) oo g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi a pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_pushwm a))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. left. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. simplS. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_pushwm a))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. right. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, IH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold IH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_pushwm_prev [status Psi a pc S0 S' p p' g g' tag]. Lemma IH_popw_prog : forall status Psi r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_popw r))) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_popw r)) S0 S'. Proof. intros status Psi r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. destruct Hntop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments IH_popw_prog [status Psi r pc S0 p g tag]. Lemma IH_popw_prev : forall status Psi r pc S0 S' (p p' : Pred) (g g' : Grt) tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comml (_popw r)) S0 S' -> enable p (nextS pc (comml (_popw r))) -> pimp (p |> nextS pc (comml (_popw r))) p' -> gimp (p >o nextS pc (comml (_popw r)) oo g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_popw r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. left. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold IH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [_ [HR [Hfl Hisr]]]. subst fl' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. assert (HS' : (p |> nextS pc (comml (_popw r))) (Mnh', R', fl, isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. right. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, IH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold IH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl, isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_popw_prev [status Psi r pc S0 S' p p' g g' tag]. Lemma IH_cmpw_prog : forall status Psi o r pc S0 (p : Pred) (g : Grt) tag, itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_cmpw o r)) S0 S'. Proof. intros status Psi o r pc [[[M R] fl] isr] p g tag. intros H. destruct (eq_nat_dec (opr_eval R o) (R r)). exists (M, R, Set_Flag fl _ZF, isr). constructor. left; split_lr. exists (M, R, Clear_Flag fl _ZF, isr). constructor. right; split_lr. Qed. Implicit Arguments IH_cmpw_prog [status Psi o r pc S0 p g tag]. Lemma IH_cmpw_prev : forall status Psi o r pc S0 S' p p' g g' tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comml (_cmpw o r)) S0 S' -> enable p (nextS pc (comml (_cmpw o r))) -> pimp (p |> nextS pc (comml (_cmpw o r))) p' -> gimp (p >o nextS pc (comml (_cmpw o r)) oo g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi o r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . assert (HS' : (p |> nextS pc (comml (_cmpw o r))) (Mnh', R, fl', isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. destruct Hfl as [[H1 H2] | [H1 H2]]; subst fl'; simpl; auto. left. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. simplS. apply conjG_intro with (Mnh', R, fl', isr); trivial. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split. destruct Hfl as [[H1 H2] | [H1 H2]]; subst fl'; simpl; auto. right. split_l. assert (HS' : (p |> nextS pc (comml (_cmpw o r))) (Mnh', R, fl', isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, IH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold IH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R, fl', isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_cmpw_prev [status Psi o r pc S0 S' p p' g g' tag]. Lemma IH_addw_prog : forall status Psi o r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_addw o r))) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_addw o r)) S0 S'. Proof. intros status Psi o r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. destruct Hntop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments IH_addw_prog [status Psi o r pc S0 p g tag]. Lemma IH_addw_prev : forall status Psi o r pc S0 S' p p' g g' tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comml (_addw o r)) S0 S' -> enable p (nextS pc (comml (_addw o r))) -> pimp (p |> nextS pc (comml (_addw o r))) p' -> gimp (p >o nextS pc (comml (_addw o r)) oo g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi o r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split. unfold trash_fl in Hfl. destruct Hfl as [H1 | H1]; subst fl'; simpl; auto. left. assert (HS' : (p |> nextS pc (comml (_addw o r))) (Mnh', R', fl', isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. simplS. apply conjG_intro with (Mnh', R', fl', isr); trivial. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split. unfold trash_fl in Hfl. destruct Hfl as [H1 | H1]; subst fl'; simpl; auto. right. split_l. assert (HS' : (p |> nextS pc (comml (_addw o r))) (Mnh', R', fl', isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, IH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold IH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl', isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_addw_prev [status Psi o r pc S0 S' p p' g g' tag]. Lemma IH_subw_prog : forall status Psi o r pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_subw o r))) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml (_subw o r)) S0 S'. Proof. intros status Psi o r pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. destruct Hntop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments IH_subw_prog [status Psi o r pc S0 p g tag]. Lemma IH_subw_prev : forall status Psi o r pc S0 S' p p' g g' tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comml (_subw o r)) S0 S' -> enable p (nextS pc (comml (_subw o r))) -> pimp (p |> nextS pc (comml (_subw o r))) p' -> gimp (p >o nextS pc (comml (_subw o r)) oo g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi o r pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split. unfold trash_fl in Hfl. destruct Hfl as [H1 | H1]; subst fl'; simpl; auto. left. assert (HS' : (p |> nextS pc (comml (_subw o r))) (Mnh', R', fl', isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. simplS. apply conjG_intro with (Mnh', R', fl', isr); trivial. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' isr'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split. unfold trash_fl in Hfl. destruct Hfl as [H1 | H1]; subst fl'; simpl; auto. right. split_l. assert (HS' : (p |> nextS pc (comml (_subw o r))) (Mnh', R', fl', isr)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, IH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold IH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R', fl', isr); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_subw_prev [status Psi o r pc S0 S' p p' g g' tag]. Lemma IH_eoi_prog : forall status Psi pc S0 (p : Pred) (g : Grt) tag, enable p (nextS pc (comml (_outb_eoi))) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comml _outb_eoi) S0 S'. Proof. intros status Psi pc [[[M R] fl] isr] p g tag. intros Hen H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. destruct Hntop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (Hen _ HMnh) as [S' HnextSnh]. destruct S' as [[[Mnh' R'] fl'] isr']. destruct (nextS_Mono HJM HnextSnh) as [M' [HJM' HnextS]]. exists (M', R', fl', isr'); trivial. Qed. Implicit Arguments IH_eoi_prog [status Psi pc S0 p g tag]. Lemma IH_eoi_prev : forall status Psi pc S0 S' p p' g g' tag, lookupCT Psi (pc+1) (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comml _outb_eoi) S0 S' -> enable p (nextS pc (comml _outb_eoi)) -> pimp (p |> nextS pc (comml _outb_eoi)) p' -> gimp (p >o nextS pc (comml _outb_eoi) oo g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hen Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. destruct HR as [HR HR']. subst M' R' isr' fl'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. left. assert (HS' : (p |> nextS pc (comml _outb_eoi)) (Mnh', R, fl, false)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split_l. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. simplS. apply conjG_intro with (Mnh', R, fl, false); trivial. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. destruct HR as [HR HR']. subst M' R' isr' fl'. unfold enable in Hen. destruct (Hen _ HMnh) as [Sx HnextSSx]. destruct (nextS_DMono HJM HnextSSx HnextS) as [Mnh' [HJM' HnextSnh']]. clear Sx HnextSSx Hen. simplS in * . split_l. right. split_l. assert (HS' : (p |> nextS pc (comml _outb_eoi)) (Mnh', R, fl, false)). apply linkPG_intro with (Mnh,R,fl,isr); trivial. split. exists Mnh'; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, IH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold IH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM' HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjG_intro with (Mnh', R, fl, false); trivial. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_eoi_prev [status Psi pc S0 S' p p' g g' tag]. Lemma IH_jmp_prev : forall status Psi f pc S0 S' p p' g g' tag, lookupCT Psi f (packS0 rho_ih (Ast p' g' tag)) -> nextS pc (comms (_jmp f)) S0 S' -> pimp p p' -> gimp (p >o g') g -> itp_IH_theta (Ast p g tag) status Psi S0 -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros status Psi f pc [[[M R] fl] isr] [[[M' R'] fl'] isr'] p p' g g' tag. intros Hlk' HnextS Hpp' Hg'g H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag [Hp Hg]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' fl' isr'. split_l. left. split_l. split. exists Mnh; exists Mih; split_l. split_r. apply Hpp'; trivial. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold NH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. apply Hg. unfold IH_ItpG. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjPG_intro; trivial. destruct Hntop as [Htag [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst M' R' fl' isr'. split_l. right. split_l. split. exists Mnh; exists Mih; split_l. split_r. apply Hpp'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply IH_WFST_strengthen with (g:=g) (S0:= (M, R, fl, isr)); trivial. unfold pimp, IH_ItpG. intros S'' Hg'. destruct S'' as [[[M'' R''] fl''] isr'']. unfold IH_ItpG in Hg'. destruct Hg' as [Mx [My [Mnh'' [Mih'' [HJMxy [HJM'' [HMy [HMih'' Hg']]]]]]]]. simplS in * . destruct (prec_disjUnion_inv HJMxy HJM HMy HMih Prec1) as [Heq1 Heq2]. subst Mx My. clear HJMxy HMy. simplS. exists Mnh; exists Mih. exists Mnh''; exists Mih''. split_l; split_l; split_l; split_l. apply Hg'g. apply conjPG_intro; trivial. Qed. Implicit Arguments IH_jmp_prev [status Psi f pc S0 S' p p' g g' tag]. Lemma IH_retw_prog : forall status Psi pc S0 (p : Pred) (g : Grt) tag, tag = 1 -> (forall S, p S -> g S S) -> itp_IH_theta (Ast p g tag) status Psi S0 -> exists S', nextS pc (comms (_retw)) S0 S'. Proof. intros status Psi pc [[[M R] fl] isr] p g tag Htag Hpg H. unfold itp_IH_theta in * . destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag' [Hp Hg]]. subst tag; discriminate. destruct Hntop as [_ [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . assert (Hg : IH_ItpG g (M, R, fl, isr) (M, R, fl, isr)). simplS. exists Mnh; exists Mih. exists Mnh; exists Mih. split_l; split_l; split_l; split_l. apply Hpg; trivial. destruct Hwfst as [n Hwfst]. destruct n as [ | n]. simpl in Hwfst. substH Hwfst with (Hwfst (M, R, fl, isr) Hg). destruct Hwfst as [ra [Hra [theta' [Hlk' Htheta']]]]. assert (Heq : leadsToW (R SP) ra M). unfold Ret_Addr in Hra. simpl in Hra. substH Hra with (Hra pc). inversion_clear Hra. subst sp. trivial. exists (M, RF_update R SP (R SP + 2), fl, isr). apply nextS_retw. unfold popW. exists ra; split_lr. simpl in Hwfst. substH Hwfst with (Hwfst _ Hg). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hlk Hwfst]]]]]]. assert (Heq : leadsToW (R SP) ra M). unfold Ret_Addr in Hra. simpl in Hra. substH Hra with (Hra pc). inversion_clear Hra. subst sp. trivial. exists (M, RF_update R SP (R SP + 2), fl, isr). apply nextS_retw. unfold popW. exists ra; split_lr. Qed. Implicit Arguments IH_retw_prog [status Psi pc S0 p g tag]. Lemma IH_retw_prev : forall status Psi pc M R fl isr pc' S' (p : Pred) (g : Grt) tag, tag = 1 -> nextPC (comms _retw) M R fl pc pc' -> nextS pc (comms _retw) (M, R, fl, isr) S' -> (forall S, p S -> g S S) -> itp_IH_theta (Ast p g tag) status Psi (M,R,fl,isr) -> exists theta', lookupCT Psi pc' (packS0 rho_ih theta') /\ itp_IH_theta theta' status Psi S'. Proof. intros status Psi pc M R fl isr pc' [[[M' R'] fl'] isr'] p g tag. intros Htag HnextPC HnextS Hpg H. destruct H as [Hiff [Htop | Hntop]]. unfold lift_IH_PG in Htop. destruct Htop as [Htag' [Hp Hg]]. subst tag; discriminate. destruct Hntop as [_ [Hp Hwfst]]. destruct Hp as [Mnh [Mih [HJM [HMnh HMih]]]]. simplS in * . destruct (nextS_inversion HnextS) as [HM' [HR' [Hfl' Hisr']]]. subst M' fl' isr'. inversion_clear HnextPC. subst sp. unfold IH_WFST in Hwfst. assert (Hg : IH_ItpG g (M, R, fl, isr) (M, R, fl, isr)). simplS. exists Mnh; exists Mih. exists Mnh; exists Mih. split_l; split_l; split_l; split_l. apply Hpg; trivial. destruct Hwfst as [n Hwfst]. destruct n as [ | n]. simpl in Hwfst. substH Hwfst with (Hwfst (M, R, fl, isr) Hg). destruct Hwfst as [ra [Hra [theta' [Hlk' Htheta']]]]. assert (Heq : pc' = ra). unfold Ret_Addr in Hra. simpl in Hra. substH Hra with (Hra pc). inversion_clear Hra. subst sp. eapply leadsToW_unique; eauto. subst pc'. exists theta'; split_l. split_l. simpl. destruct theta' as [p' g' tag']. left. apply Htheta' with pc; trivial. fold IH_WFST in Hwfst. substH Hwfst with (Hwfst _ Hg). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hlk [Htag' Hwfst]]]]]]]. assert (Heq : pc' = ra). unfold Ret_Addr in Hra. simpl in Hra. substH Hra with (Hra pc). inversion_clear Hra. subst sp. eapply leadsToW_unique; eauto. subst pc'. exists (Ast p' g' tag'); split_l. split_l. right. split_l. substH Hwfst with (Hwfst _ _ HnextS). destruct Hwfst as [Hp' Hwfst]. destruct Hp' as [Mnh' [Mih' [HJM' Hp']]]. simplS in * . split. exists Mnh'; exists Mih'; split_lr. exists n; trivial. Qed. Implicit Arguments IH_retw_prev [status Psi pc M R fl isr pc' S' p g tag]. coq/SCAP/SCAP_READY_Soundness.v0000644000107400000620000026202111000223235015474 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import EqNat. Require Import Linking. Require Import Linking_Lemmas. Require Import Linking_Lemmas2. Require Import SCAP_NH_Lemmas. Require Import NH_SW. Require Import READY_BLK. Require Import READY_UNBLK. Lemma and_sym_rr : forall A B C : Prop, A /\ B /\ C -> B /\ C /\ A. Proof. tauto. Qed. Lemma SCAP_Rdy_in_CAP0_call : forall D psi pc theta D' Psi Psi' f, NH_WFcmd psi pc theta (comml (_call f)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_call f)). Proof. intros D psi pc [p g tag] D' Psi Psi' f. intros Hi HD HD' Hlift HPsi'. destruct ((fun x => Hi) 0) as [Hi' Hpgik]. unfold NH_WFcmd_aux in Hi'. destruct Hi' as [[Hf Hi'] | [Hf Hi']]. (* prim_entry f *) unfold NH_Call_Prim in Hi. destruct Hi' as [H1 H2]. inversion H1; subst f. (* f = _SWITCH *) eapply NH_SW_Itp; eauto. (* f = _BLOCK *) eapply NH_BLK_Itp; eauto. (* f = _UNBLOCK *) eapply NH_UNBLK_Itp; eauto. (* ~ prim_entry f *) clear Hi. rename Hi' into Hi. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. (* ~ prim_entry f *) simpl in Hi. destruct Hi as [p' [p'' [g' [g'' [Hlookup' [Hlookup'' Hi]]]]]]. destruct Hi as [Hcall [Hfun [Hpp' [Hpg'p'' Hg''g]]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_call_prog Hcall Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst R' fl' isr'. assert (HnextPC' := nextPC_call pc f M R fl). assert (Heq := nextPC_injection HnextPC HnextPC'). subst pc'. clear HnextPC'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' f (packS0 rho_ready (Ast p' g' 1))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. assert (Hlk'' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p'' g'' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' 1)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l. split_l. split_l. split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear Hf B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_nonprim_call_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_cli : forall D psi pc theta D' Psi Psi', NH_WFcmd psi pc theta (comml (_cli)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_cli)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. assert (HnextS := nextS_cli pc M R fl isr). assert (HnextPC := nextPC_cli pc M R fl). simpl in Hi. destruct Hi as [p' [g' [Hlk [Hpp' Hg'g]]]]. split. exists (M, R, Clear_Flag fl _IF, isr); trivial. intros f' S' HnextS' HnextPC'. destruct S' as [[[M' R'] fl'] isr']. assert (Heq := nextS_injection HnextS HnextS'). simpl in Heq. destruct Heq as [Heq1 Heq2]; destruct Heq1; destruct Heq2. assert (Heq := nextPC_injection HnextPC HnextPC'). subst M' R' fl' isr' f'. clear HnextS' HnextPC'. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World in * . destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. exists Mth; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM; exists Mcth. split_l. split_l. rsplit. split_lr. simplS; simplS in H7. unfold WF_Curr_Thrd in * . simpl in * . eapply NH_cli_prev; eauto. Qed. Lemma SCAP_Rdy_in_CAP0_sti : forall D psi pc theta D' Psi Psi', NH_WFcmd psi pc theta (comml (_sti)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_sti)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. assert (HnextS := nextS_sti pc M R fl isr). assert (HnextPC := nextPC_sti pc M R fl). simpl in Hi. destruct Hi as [p' [g' [Hlookup [Hsti [Hpp' Hg'g]]]]]. split. exists (M, R, Set_Flag fl _IF, isr); trivial. intros f' S' HnextS' HnextPC'. destruct S' as [[[M' R'] fl'] isr']. assert (Heq := nextS_injection HnextS HnextS'). simpl in Heq. destruct Heq as [Heq1 Heq2]; destruct Heq1; destruct Heq2. assert (Heq := nextPC_injection HnextPC HnextPC'). subst M' R' fl' isr' f'. clear HnextS' HnextPC'. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World in * . destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. exists Mth;exists Mq. split_l. split_r. split_l. split_l. split_l. split_l. exists TM. exists Mcth. split_l. split_l. rsplit. split_lr. simplS; simplS in H7. unfold WF_Curr_Thrd in * . simpl in * . eapply NH_sti_prev; eauto. Qed. Lemma SCAP_Rdy_in_CAP0_jne : forall D psi pc theta D' Psi Psi' f, NH_WFcmd psi pc theta (comml (_jne f)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_jne f)). Proof. intros D psi pc [p g tag] D' Psi Psi' f. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [p'' [g' [g'' [Hlookup' [Hlookup'' Hi]]]]]]. destruct Hi as [Hpp' [Hg'g [Hpp'' Hg''g]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_jne_prog (f:=f) (pc:=pc) Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr']]]. subst M' R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. assert (Hlk' : lookupCT Psi' f (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. assert (Hlk'' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p'' g'' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. inversion HnextPC. (* non-jmp *) subst f0 M0 R0 fl0 pc0 pc'. simplS in H0. rename H0 into Hflzf. exists (packS0 rho_ready (Ast p'' g'' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl; simplS in * . eapply NH_jne_seq_prev; eauto. simplS; trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). (* jmp *) subst f0 M0 R0 fl0 pc0 pc'. simplS in H0. rename H0 into Hflzf. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl; simplS. eapply NH_jne_jmp_prev; eauto. simplS; trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_movwp : forall D psi pc theta D' Psi Psi' o r, NH_WFcmd psi pc theta (comml (_movwp o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_movwp o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hmovwp Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_movwp_prog Hmovwp Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_movwp_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_movwld : forall D psi pc theta D' Psi Psi' a r, NH_WFcmd psi pc theta (comml (_movwld a r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_movwld a r)). Proof. intros D psi pc [p g tag] D' Psi Psi' a r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hmovwp Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_movwld_prog Hmovwp Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). destruct HR as [x [Hlds HR']]. subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_movwld_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_movwst : forall D psi pc theta D' Psi Psi' o a, NH_WFcmd psi pc theta (comml (_movwst o a)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_movwst o a)). Proof. intros D psi pc [p g tag] D' Psi Psi' o a. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hmovwst Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_movwst_prog Hmovwst Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_movwst_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_pushwp : forall D psi pc theta D' Psi Psi' o, NH_WFcmd psi pc theta (comml (_pushwp o)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_pushwp o)). Proof. intros D psi pc [p g tag] D' Psi Psi' o. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_pushwp_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_pushwp_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_pushwm : forall D psi pc theta D' Psi Psi' a, NH_WFcmd psi pc theta (comml (_pushwm a)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_pushwm a)). Proof. intros D psi pc [p g tag] D' Psi Psi' a. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_pushwm_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_pushwm_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_pushfw : forall D psi pc theta D' Psi Psi', NH_WFcmd psi pc theta (comml (_pushfw)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_pushfw)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_pushfw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_pushfw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_popw : forall D psi pc theta D' Psi Psi' r, NH_WFcmd psi pc theta (comml (_popw r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_popw r)). Proof. intros D psi pc [p g tag] D' Psi Psi' r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_popw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). destruct HR as [x [Hlds HR']]. subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_popw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_popfw : forall D psi pc theta D' Psi Psi', NH_WFcmd psi pc theta (comml (_popfw)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_popfw)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hsti [Hstipp' [Hstig'g [Hclipp' Hclig'g]]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_popfw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). destruct Hfl as [flnum [Hlds Hfl']]. subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_popfw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_cmpw : forall D psi pc theta D' Psi Psi' o r, NH_WFcmd psi pc theta (comml (_cmpw o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_cmpw o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_cmpw_prog (o:=o) (r:=r) (pc:=pc) Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_cmpw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_addw : forall D psi pc theta D' Psi Psi' o r, NH_WFcmd psi pc theta (comml (_addw o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_addw o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_addw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_addw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_subw : forall D psi pc theta D' Psi Psi' o r, NH_WFcmd psi pc theta (comml (_subw o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_subw o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_subw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (Hlk' : lookupCT Psi' (pc+1) (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_subw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_jmp : forall D psi pc theta D' Psi Psi' f, NH_WFcmd psi pc theta (comms (_jmp f)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comms (_jmp f)). Proof. intros D psi pc [p g tag] D' Psi Psi' f. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. destruct Hi as [p' [g' [Hlk' [Hpp' Hg'g]]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. split. exists (M, R, fl, isr); constructor; trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. assert (HnextScth : nextS pc (comms (_jmp f)) (Mcth, R, fl, isr) (Mcth, R, fl, isr)). constructor; trivial. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear HnextScth. assert (Hlk'' : lookupCT Psi' f (packS0 rho_ready (Ast p' g' tag))). apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. exists (packS0 rho_ready (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC Hpgik HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. eapply NH_jmp_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_retw : forall D psi pc theta D' Psi Psi', NH_WFcmd psi pc theta (comms (_retw)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comms (_retw)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold NH_WFcmd in Hi. destruct Hi as [Hi Hpgik]. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_Rdy; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. (* interrupt *) split. destruct (itr_enabled_dec (M, R, fl, isr)) as [Hitr | Hitr]; [right | left; intro H; destruct (Hitr H)]. destruct Hitr as [Hfl Hisr]. assert (Hih : IH_Specified Psi'). unfold IH_Specified. apply lookupCT_subsetCT with (ext_IH_Spec (ext_Prim_Specs Psi)); trivial. unfold ext_IH_Spec. apply lookupCT_consCT; trivial. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. assert (Hflx : S_Flag (Mcth, R, fl, isr) _IF = true). simplS in * ; trivial. destruct (NH_Itr_prog (pc:=pc) Hpgik Hflx Hwfcth) as [Scth' HnextScth']. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (itr_nextS_Mono2 H5 HJM H6 HnextScth') as [M' HnextS]. exists (M', R', fl', isr'); split_l. clear Mcth' R' fl' isr' HnextScth' M' HnextS. intros [[[M' R'] fl'] isr'] Hitr. exists IH_Spec0. split. apply Hsub. unfold ext_IH_Spec. unfold OPSpec.lookup. simpl. left; trivial. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. assert (Hstk : stkSpace (R SP) (IH_Stk + 6) Mcth). destruct Hpgik. eapply Prd_Itr_Stk_elim; unfold itr_enabled; eauto. destruct (itr_nextS_DMono2 H6 H5 HJM Hstk Hitr) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS HTM']]]]]]]. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split. eapply WF_CurrTID_nh_ih; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. rsplit. split. apply WF_ReadyQ_Mono_CT_consCT; trivial. apply (WF_ReadyQ_untouch H8 HTM' H1). apply WF_WQSet_Mono_CT_consCT; trivial. apply (WF_WQSet_untouch H9 HTM' H1). unfold WF_currTID in H1. destruct H1 as [_ [_ [_ [tcb [Hmto [Htcb Hrtc]]]]]]. clear B RdyQ H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear TM TM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists (TCB_Status tcb); split_l; split_l. eapply NH_Itr_prev; eauto. simpl in Hi. destruct Hi as [Htag Hp]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct (NH_retw_prog (pc:=pc) Htag Hp Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R']fl']isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr']]]. destruct HR as [pc'x [Hlds HR]]. subst M' R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (pc' = pc'x). eapply leadsToW_unique; eauto. simplS in * ; subst; trivial. inversion_clear HnextPC. subst; trivial. subst pc'x. assert (HnextPC' : nextPC (comms _retw) Mcth R fl pc pc'). inversion_clear HnextPC. destruct (nextS_inversion HnextS') as [_ [HR [_ _]]]. destruct HR as [pc'x [Hlds' HR']]. assert (Heq : pc' = pc'x). eapply leadsToW_unique; eauto. destruct (MemSplit_Inv H5 H6) as [Moth [Hx _]]. simplS in * . apply (leadsToW_Mono (addr := sp)(x := pc'x) HJM); eauto. eapply leadsToW_Mono; eauto. subst; trivial. subst pc'x. apply nextPC_retw with (R SP); trivial. destruct (NH_retw_prev Htag HnextPC' HnextS' Hp Hwfcth) as [theta' [Hlk' Hwf]]. exists (packS0 rho_ready theta'); split_l. unfold ext_dict. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. exists Mth'; exists Mq; split_l. split_r. unfold WF_AIM_World. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear HtoMcth' HTM' H1 H2 H3 H4 H5 H6 H8 H9 HMq. clear Mq Mth TM HnextS HJM HJM'. unfold WF_Curr_Thrd. simpl; simplS. trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_Rdy_in_CAP0_cmd: forall D psi pc theta c D' Psi Psi', NH_WFcmd psi pc theta c -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho_ready theta) pc c. Proof. intros D psi pc [p g tag] c D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. induction c as [ i | s]; [ induction i | induction s]. (* 19 goals remain, i = cli *) eapply SCAP_Rdy_in_CAP0_cli; eauto. (* 18 goals remain, i = sti *) eapply SCAP_Rdy_in_CAP0_sti; eauto. (* 17 goals remain, i = call f *) eapply SCAP_Rdy_in_CAP0_call; eauto. (* 16 goals remain, i = jne f *) eapply SCAP_Rdy_in_CAP0_jne; eauto. (* 15 goals remain, i = movwp o r *) eapply SCAP_Rdy_in_CAP0_movwp; eauto. (* 14 goals remain, i = movwld a r *) eapply SCAP_Rdy_in_CAP0_movwld; eauto. (* 13 goals remain, i = movwst o a *) eapply SCAP_Rdy_in_CAP0_movwst; eauto. (* 12 goals remain, i = pushwp o *) eapply SCAP_Rdy_in_CAP0_pushwp; eauto. (* 11 goals remain, i = pushwm a *) eapply SCAP_Rdy_in_CAP0_pushwm; eauto. (* 10 goals remain, i = pushfw *) eapply SCAP_Rdy_in_CAP0_pushfw; eauto. (* 9 goals remain, i = popw r *) eapply SCAP_Rdy_in_CAP0_popw; eauto. (* 8 goals remain, i = popfw *) eapply SCAP_Rdy_in_CAP0_popfw; eauto. (* 7 goals remain, i = cmpw o r *) eapply SCAP_Rdy_in_CAP0_cmpw; eauto. (* 6 goals remain, i = addw o r *) eapply SCAP_Rdy_in_CAP0_addw; eauto. (* 5 goals remain, i = subw o r *) eapply SCAP_Rdy_in_CAP0_subw; eauto. (* 4 goals remain, i = outb eoi *) destruct Hi as [Hi _]; destruct Hi. (* 3 goals remain, i = jmp f *) eapply SCAP_Rdy_in_CAP0_jmp; eauto. (* 2 goals remain, i = retw *) eapply SCAP_Rdy_in_CAP0_retw; eauto. (* 1 goals remain, i = iret *) simpl in Hi. destruct Hi as [Hi _ ]; destruct Hi. Qed. Implicit Arguments SCAP_Rdy_in_CAP0_cmd [D psi pc theta c D' Psi Psi']. Lemma SCAP_Rdy_in_CAP0_iseq : forall D psi pc theta isq D' Psi Psi', NH_WFiseq psi pc theta isq -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFiseq D' Psi' (packS0 rho_ready theta) pc isq. Proof. intros D psi pc theta isq D' Psi Psi'. intros Hscap HD HD' Hlift HPsi'. gen_clear theta pc Hscap HPsi'. induction isq; intros theta pc Hscap HPsi'. inversion Hscap. subst psi0 pc0 theta i0 isq0. eapply wfis_seq with (packS0 rho_ready (Ast p' g' tag)). assert (Hlift' := lift_psi_cons (f := pc+1) (spec := Ast p' g' tag) Hlift). apply WFcmd_Mono_CT with (ext_IH_Spec (ext_Prim_Specs (consCT (pc + 1) (packS0 rho_ready (Ast p' g' tag)) Psi))). subst Psi'. unfold ext_IH_Spec, ext_Prim_Specs. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. apply Psi_extend2_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply consCT_subsetCT. assert (HPsi'2 := refl_equal (ext_IH_Spec (ext_Prim_Specs (consCT (pc + 1) (packS0 rho_ready (Ast p' g' tag)) Psi)))). apply (SCAP_Rdy_in_CAP0_cmd H4 HD HD' Hlift' HPsi'2). apply IHisq; trivial. inversion Hscap. subst psi0 pc0 theta si. eapply wfis_end. apply (SCAP_Rdy_in_CAP0_cmd H3 HD HD' Hlift HPsi'). Qed. Lemma SCAP_Rdy_in_CAP0_cdhp : forall D psi C psi' D' Psi Psi' Psi'', NH_WFcdhp psi C psi' -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> lift_psi psi' rho_ready Psi' -> sink_psi psi' rho_ready Psi' -> Psi'' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcdhp D' Psi'' C Psi'. Proof. intros D psi C psi' D' Psi Psi' Psi''. intros H HD HD' H0 H1 H2 HPsi''. intros f theta0 Hf. substH H2 with (H2 f theta0 Hf). destruct H2 as [theta [Htheta0 Hfx]]. unfold SCAP_WFcdhp in H. substH H with (H f theta Hfx). destruct H as [isq [Hisq H]]. exists isq; split_l. destruct theta0. injection Htheta0; intros; subst n s. eapply SCAP_Rdy_in_CAP0_iseq; eauto. Qed. coq/SCAP/SCAP_Itr.v0000644000107400000620000000610411000223235013323 0ustar shaosystems(* This SCAP is used for interrupt hander *) Add LoadPath "..". Add LoadPath "../CAP0". Require Import Coqlib. Require Import Map. Require Import MultiMapT. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import CAP0. Require Import SCAP. Require Import Bool. Require Import AIM. Require Import SCAP. Require Import SCAP_READY. Set Implicit Arguments. Unset Strict Implicit. (* This is a simplified version of AIM-3 in that *) (* we do not allow the handler to enable interrupt again *) (* trashes the stack space _SW_Stk *) Definition ih_gy : Grt := fun (S S' : State) => exists sp, prepost (mstar INV0 (stkSpacePrec sp _SW_Stk)) (mstar INV0 (stkSpacePrec sp _SW_Stk)) S S' /\ S_Flag S _IF = S_Flag S' _IF /\ S_ISR S = S_ISR S' /\ S_RF S SP = sp /\ S_RF S SP = S_RF S' SP. Definition ih_enable_sw (p : Pred) : Prop := forall S, p S -> (pmstar pTrue (mstar INV0 (stkSpacePrec (S_RF S SP) (_SW_Stk + 2)))) S /\ (S_ISR S = false). Definition IH_Call_SW (psi : SCAP_PSpec) (pc f : flab) (theta : Spec) : Prop := match theta with Ast p g tag => (f = _SWITCH) /\ exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ ih_enable_sw p /\ (forall pc', pimp (p |> (wrap_fun ih_gy pc f pc')) p') /\ (forall pc', gimp (p >o (wrap_fun ih_gy pc f pc') oo g') g) end. Definition IH_WFcmd (psi : SCAP_PSpec) (pc : flab) (theta : Spec) (c : comm) : Prop := match theta with Ast p g tag => match c with comms si => match si with _iret => (tag = 0) /\ (forall S, p S -> g S S) | _retw => (tag = 1) /\ (forall S, p S -> g S S) | _ => SCAP_WFcmd psi pc theta c end | comml i => match i with | _cli => False | _sti => False | _outb_eoi => exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ enable p (nextS pc c) /\ pimp (p |> (nextS pc c)) p' /\ gimp (p >o (nextS pc c) oo g') g | _call f => (prim_entry f /\ IH_Call_SW psi pc f theta) \/ (~ (prim_entry f) /\ NH_Normal_Call psi pc f theta) | _pushfw => False | _popfw => False | _ => SCAP_WFcmd psi pc theta c end end end. Inductive IH_WFiseq : SCAP_PSpec -> flab -> Spec -> iseq -> Prop := | ih_isq_seq : forall psi pc p p' g g' i isq tag, IH_WFcmd (SCAP_consCT (pc+1) (Ast p' g' tag) psi) pc (Ast p g tag) (comml i) -> IH_WFiseq psi (pc+1) (Ast p' g' tag) isq -> IH_WFiseq psi pc (Ast p g tag) (seq i isq) | ih_isq_end : forall psi pc p g si tag, IH_WFcmd psi pc (Ast p g tag) (comms si) -> IH_WFiseq psi pc (Ast p g tag) (sseq si). Definition IH_WFcdhp (psi : SCAP_PSpec) (C: CodeHeap) (psi' : SCAP_PSpec): Prop := forall f theta, SCAP_lookupCT psi' f theta -> exists isq, lookupC C f isq /\ IH_WFiseq psi f theta isq. coq/SCAP/AIM_Lemmas.v0000644000107400000620000000160711000223235013666 0ustar shaosystemsAdd LoadPath "..". Require Import Coqlib. Require Import Machine. Require Import Assertion. Require Import AIM. Lemma choice_elim_left : forall (P : Prop) (mP mQ : MPred) M, (choice P mP mQ) M -> P -> mP M. Proof. unfold choice; intros; intuition. Qed. Implicit Arguments choice_elim_left [P mP mQ M]. Lemma choice_elim_right : forall (P : Prop) (mP mQ : MPred) M, (choice P mP mQ) M -> ~P -> mQ M. Proof. unfold choice; intros; intuition. Qed. Implicit Arguments choice_elim_right [P mP mQ M]. Lemma choice_intro_left : forall (P : Prop) (mP mQ : MPred) M, mP M -> P -> (choice P mP mQ) M. Proof. unfold choice; intros; intuition. Qed. Implicit Arguments choice_intro_left [P mP mQ M]. Lemma choice_intro_right : forall (P : Prop) (mP mQ : MPred) M, mQ M -> ~P -> (choice P mP mQ) M. Proof. unfold choice; intros; intuition. Qed. Implicit Arguments choice_intro_right [P mP mQ M]. coq/SCAP/Linking.v0000644000107400000620000007000611000235260013355 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import SCAP_Itr. Require Import EqNat. Definition TID := nat. (**************************************************) (* Definitions of TCBs *) (**************************************************) (* thread status *) Inductive TStatus : Set := IDLE (* 0 *) | READY (* 1 *) | BLOCKED. (* 2 *) (* abstract TCB : stack pointer, status, return code pointer *) Definition Thread := (Label * TStatus * PC)%type. (* Definition Thread := (Label * TStatus)%type. *) Definition TCB_SP (tcb : Thread) : Label := match tcb with (sp, _, _) => sp end. Definition TCB_PC (tcb : Thread) : PC := match tcb with (_, pc) => pc end. Definition TCB_Status (tcb : Thread) : TStatus := match tcb with (_, status, _) => status end. Definition TCB_SP_Upd (tcb : Thread) (sp : Label) : Thread := match tcb with (sp0, tst, pc) => (sp, tst, pc) end. Definition TCB_PC_Upd (tcb : Thread) (pc : PC) : Thread := match tcb with (sp, tst, pc0) => (sp, tst, pc) end. Definition TCB_Status_Upd (tcb : Thread) (tst : TStatus) : Thread := match tcb with (sp, tst0, pc) => (sp, tst, pc) end. Definition nat2Status (n : nat) : option TStatus := match n with 0 => Some IDLE | S n' => match n' with 0 => Some READY | S n'' => match n'' with 0 => Some BLOCKED | _ => None end end end. Definition Status2nat (ts : TStatus) : nat := match ts with | IDLE => 0 | READY => 1 | BLOCKED => 2 end. (* below we embed the abstract TCBs into Memory *) (* Note that this embedding does not save PC in TCB *) Definition ptoTCB (l : Label) (tcb : Thread) : MPred := fun (M : Mem) => match tcb with (sp, status, pc) => exists w, mstar (ptoW l sp) (ptoW (l+2) w) M /\ nat2Status w = Some status end. (* Below we define the relationship between PC and SP in TCB *) Definition TCB_SP2PC (tcb : Thread) : MPred := (TCB_SP tcb) |->w (TCB_PC tcb). (********************************************************) (* Definitions of thread queues *) (********************************************************) (** ThreadQ T as a Partitial Map **) Module TQSpec <: MapSpec. Definition domain := TID. Definition image := Thread. Definition beq_Domain := eq_nat_dec. End TQSpec. Module TQMod := MapFun (TQSpec). Definition TQ := TQMod.Map. (********** TQ in memory ***************) Definition ptoTQ := ptoQ Thread ptoTCB. (* Inductive embed_PCinTQ : TQ -> Mem -> Prop := PCinTQ_emp : embed_PCinTQ TQMod.emp MemMod.emp | PCinTQ_cons : forall T M tid tcb, ((embed_PCinTQ T) *^* (TCB_SP2PC tcb)) M -> TQMod.not_in_dom tid T -> embed_PCinTQ (TQMod.put T tid tcb) M. *) (** We use a partial mapping to DummyImg to implement sets **) Inductive DummyImg : Set := dummy_sglton : DummyImg. Module WQSpec <: MapSpec. Definition domain := TID. Definition image := DummyImg. Definition beq_Domain := eq_nat_dec. End WQSpec. Module WQMod := MapFun WQSpec. Definition WQ := WQMod.Map. Definition addThrd (Q : WQ) (tid : TID) : WQ := WQMod.put Q tid dummy_sglton. Definition filterTQ (T : TQ) (Q : WQ) : TQ := fun (tid : TID) => match Q tid with Some _ => T tid | None => None end. Definition subsetQ_TQ (Q : WQ) (T : TQ) : Prop := forall tid, WQMod.in_dom tid Q -> TQMod.in_dom tid T. Module WQSetSpec <: MapSpec. Definition domain := Label. Definition image := WQ. Definition beq_Domain := eq_nat_dec. End WQSetSpec. Module WQSetMod := MapFun WQSetSpec. Definition WQSet := WQSetMod.Map. (* ThrdMem is a partial mapping from Thread IDs to heaps *) (* It records the partition of memory among threads *) Module ThrdMemSpec <: MapSpec. Definition domain := TID. Definition image := Mem. Definition beq_Domain := eq_nat_dec. End ThrdMemSpec. Module ThrdMemMod := MapFun(ThrdMemSpec). Definition ThrdMem := ThrdMemMod.Map. Inductive MemSplit : ThrdMem -> Mem -> Prop := MS_empty: MemSplit ThrdMemMod.emp MemMod.emp | MS_split: forall (M M' M'' : Mem) (TM : ThrdMem) (tid : TID), MemMod.disjUnion M' M'' M -> MemSplit TM M' -> ThrdMemMod.not_in_dom tid TM -> MemSplit (ThrdMemMod.put TM tid M'') M. (****************************************************) (* Interpretations for AIM logics *) (****************************************************) Definition NH_Inv (fl : FlagR) : MPred := if (fl _IF) then mstar INV0 INV1 else Aemp. Lemma NHInv_prec : forall fl, precise (NH_Inv fl). Proof. intro. unfold NH_Inv. induction (fl _IF). apply mstar_presv_prec; auto. apply Prec0. apply Prec1. apply precise_emp. Qed. (** p*Inv **) Definition NH_pinvstar (p : Pred) : Pred := fun (S : State) => pmstar p (NH_Inv (S_Flag S)) S. Definition NH_ItpG (g : Grt) : Grt := fun (S S' : State) => exists M1, exists M2, exists M1', exists M2', MemMod.disjUnion M1 M2 (S_Mem S) /\ MemMod.disjUnion M1' M2' (S_Mem S') /\ NH_Inv (S_Flag S) M2 /\ NH_Inv (S_Flag S') M2' /\ g (S_Mem_Upd S M1) (S_Mem_Upd S' M1'). Definition rho_ready : LangID := 1. Definition rho_idle : LangID := 2. Definition rho_ih : LangID := 3. Definition rho_prim : LangID := 4. Fixpoint NH_WFST_aux (rho : LangID) (n : nat) (Psi : PSpec) (p : Pred) {struct n} : Prop := match n with 0 => forall S, p S -> exists ra, Ret_Addr ra S /\ exists p', exists g', exists tag, lookupCT Psi ra (packS0 rho (Ast p' g' tag)) /\ tag <> 1 /\ forall pc S', (nextS pc (comms _retw) S S') -> NH_pinvstar p' S' | S n' => forall S, p S -> exists ra, Ret_Addr ra S /\ exists p', exists g', exists tag, lookupCT Psi ra (packS0 rho (Ast p' g' tag)) /\ forall pc S', nextS pc (comms _retw) S S' -> NH_pinvstar p' S' /\ NH_WFST_aux rho n' Psi (NH_ItpG g' S') end. Definition NH_WFST (rho : LangID) (Psi : PSpec) (p : Pred) : Prop := exists n, NH_WFST_aux rho n Psi p. (* Definition NH_WFST2 (Psi : PSpec) (g : Grt) : Pred := *) (* fun (S : State) => NH_WFST Psi (g S). *) (* a aux interpretation of NH spec *) Definition itp_NH_theta (rho : LangID) (theta : Spec) (Psi : PSpec) (S: State) : Prop := S_ISR S = false /\ match theta with Ast p g tag => NH_pinvstar p S /\ (tag = 1 -> NH_WFST rho Psi (NH_ItpG g S)) end. Definition IH_ItpG (g : Grt) : Grt := fun (S S' : State) => exists M1, exists M2, exists M1', exists M2', MemMod.disjUnion M1 M2 (S_Mem S) /\ MemMod.disjUnion M1' M2' (S_Mem S') /\ INV1 M2 /\ INV1 M2' /\ g (S_Mem_Upd S M1) (S_Mem_Upd S' M1'). Definition rho_tcb_consistent2 (status : TStatus) (rho: LangID): Prop := (rho = rho_ready -> status = READY) /\ (rho = rho_idle -> status = IDLE). Definition lift_IH_PG (theta : Spec) (Psi : PSpec) (status: TStatus) (S : State) : Prop := match theta with Ast p g tag => tag = 0 /\ pmstar p INV1 S /\ forall S', IH_ItpG g S S' -> exists S'', (forall pc', nextS pc' (comms _iret) S' S'') /\ exists ra, Ret_Addr ra S' /\ exists rho, exists theta, (rho = rho_ready \/ rho = rho_idle) /\ rho_tcb_consistent2 status rho (* this is a new line *) /\ lookupCT Psi ra (packS0 rho theta) /\ forall pc' S'', nextS pc' (comms _iret) S' S'' -> itp_NH_theta rho theta Psi S'' end. (* Definition lift_IH_PG (theta : Spec) (Psi : PSpec) (S : State) : Prop := *) (* match theta with *) (* Ast p g tag => *) (* tag = 0 *) (* /\ pmstar p INV1 S *) (* /\ forall S', IH_ItpG g S S' -> *) (* exists S'', (forall pc', nextS pc' (comms _iret) S' S'') *) (* /\ exists ra, Ret_Addr ra S' *) (* /\ exists rho, exists theta, *) (* (rho = rho_ready \/ rho = rho_idle) *) (* /\ lookupCT Psi ra (packS0 rho theta) *) (* /\ forall pc' S'', nextS pc' (comms _iret) S' S'' *) (* -> itp_NH_theta rho theta Psi S'' *) (* end. *) Fixpoint IH_WFST (n : nat) (Psi : PSpec) (p : Pred) (status: TStatus) {struct n} : Prop := match n with 0 => forall S, p S -> exists ra, Ret_Addr ra S /\ exists theta, lookupCT Psi ra (packS0 rho_ih theta) /\ forall pc' S', nextS pc' (comms _retw) S S' -> lift_IH_PG theta Psi status S' | S n' => forall S, p S -> exists ra, Ret_Addr ra S /\ exists p', exists g', exists tag', lookupCT Psi ra (packS0 rho_ih (Ast p' g' tag')) (* modified by guoyu, every tag in stack should all be non-top (1), so we may add a constraint below, which is indispensable for the soundness proof. *) /\ tag' = 1 /\ forall pc' S', nextS pc' (comms _retw) S S' -> pmstar p' INV1 S' /\ IH_WFST n' Psi (IH_ItpG g' S') status end. (* Fixpoint IH_WFST (n : nat) (Psi : PSpec) (p : Pred) {struct n} : Prop := *) (* match n with *) (* 0 => forall S, p S -> *) (* exists ra, Ret_Addr ra S *) (* /\ exists theta, *) (* lookupCT Psi ra (packS0 rho_ih theta) *) (* /\ forall pc' S', nextS pc' (comms _retw) S S' *) (* -> lift_IH_PG theta Psi S' *) (* | S n' => *) (* forall S, p S -> *) (* exists ra, Ret_Addr ra S *) (* /\ exists p', exists g', exists tag', *) (* lookupCT Psi ra (packS0 rho_ih (Ast p' g' tag')) *) (* (* modified by guoyu, every tag in stack should all *) (* be non-top (1), so we may add a constraint below, *) (* which is indispensable for the soundness proof. *) *) (* /\ tag' = 1 *) (* /\ forall pc' S', nextS pc' (comms _retw) S S' *) (* -> pmstar p' INV1 S' /\ IH_WFST n' Psi (IH_ItpG g' S') *) (* end. *) (* a aux interpretation of IH spec *) Definition itp_IH_theta (theta : Spec) (status : TStatus) (Psi : PSpec) (S : State) : Prop := S_Flag S _IF = false /\ match theta with Ast p g tag => (lift_IH_PG theta Psi status S) \/ (tag = 1) /\ (pmstar p INV1) S /\ exists n, IH_WFST n Psi (IH_ItpG g S) status end. (* Definition itp_IH_theta (theta : Spec) (Psi : PSpec) (S: State) : Prop := *) (* S_Flag S _IF = false /\ *) (* match theta with *) (* Ast p g tag => *) (* (lift_IH_PG theta Psi S) \/ (tag = 1) /\ (pmstar p INV1) S /\ exists n, IH_WFST n Psi (IH_ItpG g S) *) (* end. *) (* Definition WF_Rdy_Thrd (Psi : PSpec) (M : Mem) (tcb : Thread) := match tcb with (X, pc) => match X with (sp, status) => exists rho, exists p, exists g, exists tag, (rho = rho_ready \/ rho = rho_idle) /\ leadsToW sp pc M /\ lookupCT Psi pc (packS0 rho (Ast p g tag)) /\ forall R fl, R SP = sp + 2 -> fl _IF = false -> (pm_mwand (mstar INV0 INV1) (itp_NH_theta rho (Ast p g tag) Psi)) (M, R, fl, false) end end. *) Definition rho_tcb_consistent (tcb : Thread) (rho: LangID): Prop := (rho = rho_ready -> TCB_Status tcb = READY) /\ (rho = rho_idle -> TCB_Status tcb = IDLE). Definition WF_Rdy_Thrd (Psi : PSpec) (M : Mem) (tcb : Thread) := match tcb with (sp, status, pc) => exists rho, exists p, exists g, exists tag, (rho = rho_ready \/ rho = rho_idle) /\ rho_tcb_consistent tcb rho /\ leadsToW sp pc M /\ lookupCT Psi pc (packS0 rho (Ast p g tag)) /\ forall R fl, R SP = sp + 2 -> fl _IF = false -> (pm_mwand (mstar INV0 INV1) (itp_NH_theta rho (Ast p g tag) Psi)) (M, R, fl, false) end. Definition WF_Rdy_Thrd_IH (Psi : PSpec) (M : Mem) (tcb : Thread) := match tcb with (sp, status, pc) => exists p, exists g, exists tag, lookupCT Psi pc (packS0 rho_ih (Ast p g tag)) /\ leadsToW sp pc M /\ forall R fl, R SP = sp + 2 -> fl _IF = false -> (pm_mwand (mstar INV0 INV1) (itp_IH_theta (Ast p g tag) status Psi )) (M, R, fl, false) end. (* Definition WF_Rdy_Thrd_IH (Psi : PSpec) (M : Mem) (tcb : Thread) := *) (* match tcb with *) (* (sp, status, pc) => *) (* exists p, exists g, exists tag, *) (* lookupCT Psi pc (packS0 rho_ih (Ast p g tag)) *) (* /\ leadsToW sp pc M *) (* /\ forall R fl, *) (* R SP = sp + 2 *) (* -> fl _IF = false *) (* -> (pm_mwand (mstar INV0 INV1) (itp_IH_theta (Ast p g tag) Psi) ) (M, R, fl, false) *) (* end. *) Definition WF_Curr_Thrd (Psi : PSpec) (S : State) (rho : LangID) (theta : Spec) (T: TQ) (tid : TID) := if beq_nat rho rho_ih then exists tcb, exists status, TQMod.maps_to T tid tcb /\ TCB_Status tcb = status /\ itp_IH_theta theta status Psi S else itp_NH_theta rho theta Psi S. (* Definition WF_Curr_Thrd (Psi : PSpec) (S : State) (rho : LangID) (theta : Spec) := *) (* if beq_nat rho rho_ih then itp_IH_theta theta Psi S *) (* else itp_NH_theta rho theta Psi S. *) Definition WF_Wait_Thrd (Psi : PSpec) (M : Mem) (tcb : Thread) (l : Label) := match tcb with (sp, status, pc) => status = BLOCKED /\ leadsToW sp pc M /\ exists wqa, Delta l = SomeT wqa /\ exists p, exists g, exists tag, lookupCT Psi pc (packS0 rho_ready (Ast p g tag)) (* /\ leadsToW sp pc M *) /\ forall R fl, R SP = sp + 2 -> fl _IF = false -> (pm_mwand (mstar (mstar INV0 INV1) wqa) (itp_NH_theta rho_ready (Ast p g tag) Psi)) (M, R, fl, false) end. Definition WF_WQ_WQSpec (B : WQSet) (Delta : WQSpec) : Prop := forall (l : Label) (wqa : WQassert), Delta l = SomeT wqa -> WQSetMod.in_dom l B. Definition WF_WQSet (Psi : PSpec) (T : TQ) (B : WQSet) (TM : ThrdMem) : Prop := forall (l : Label) (Q : WQ) (tid : TID), WQSetMod.maps_to B l Q -> WQMod.in_dom tid Q -> exists tcb : Thread, exists M : Mem, TQMod.maps_to T tid tcb /\ ThrdMemMod.maps_to TM tid M /\ WF_Wait_Thrd Psi M tcb l. Definition unblocked (tid: TID) (B: WQSet) : Prop := forall (w : Label) (Q : WQ), WQSetMod.maps_to B w Q -> WQMod.not_in_dom tid Q. (* last update by Xinyu : Dec. 8, 07 *) Definition WF_ReadyQ (Psi : PSpec) (T : TQ) (RdyQ : WQ) (TM : ThrdMem) : Prop := forall (tid : TID), WQMod.in_dom tid RdyQ -> exists tcb : Thread, TQMod.maps_to T tid tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ exists M : Mem, ThrdMemMod.maps_to TM tid M /\ leadsToW (TCB_SP tcb) (TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi M tcb \/ WF_Rdy_Thrd_IH Psi M tcb). (* Definition WF_currTID (tid : TID) (T : TQ) (B : WQSet) (RdyQ : WQ) : Prop := unblocked tid B /\ WQMod.not_in_dom tid RdyQ /\ TQMod.in_dom tid T /\ exists tcb, TQMod.maps_to T tid tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE). *) Definition WF_currTID (tid : TID) (T : TQ) (B : WQSet) (RdyQ : WQ) (rho: LangID) : Prop := unblocked tid B /\ WQMod.not_in_dom tid RdyQ /\ TQMod.in_dom tid T /\ exists tcb, TQMod.maps_to T tid tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ rho_tcb_consistent tcb rho. Definition WF_TQ (T : TQ) : Prop := forall tid, TQMod.in_dom tid T -> tid <> 0. Definition WF_WQSet2 (B : WQSet) : Prop := forall l l' Q Q', WQSetMod.maps_to B l Q -> WQSetMod.maps_to B l' Q' -> l <> l' -> WQMod.disjoint Q Q'. Definition disj_RQ_WQ (B : WQSet) (RdyQ : WQ) : Prop := forall l Q, WQSetMod.maps_to B l Q -> WQMod.disjoint Q RdyQ. Definition WF_TWQ (T : TQ) (B : WQSet) (RdyQ : WQ) : Prop := WF_TQ T /\ WF_WQSet2 B /\ disj_RQ_WQ B RdyQ. (** Specification of the Interrupte Handler **) Definition IHpred : Pred := fun (S : State) => pmstar pTrue (mstar INV0 (stkSpacePrec (S_RF S SP + 6) (IH_Stk + 6))) S /\ (S_ISR S) = true /\ (S_Flag S _IF) = false. Definition IHgrt : Grt := fun (S S' : State) => prepost (mstar INV0 (stkSpacePrec (S_RF S SP) IH_Stk)) (mstar INV0 (stkSpacePrec (S_RF S' SP) IH_Stk)) S S' /\ S_RF S = S_RF S' /\ S_ISR S' = false. Definition IH_Spec0 := (packS0 rho_ih (Ast IHpred IHgrt 0)). Definition IH_Specified (Psi : PSpec) : Prop := lookupCT Psi h_entry IH_Spec0. Definition exists_Idle (T : TQ) (Rdy : WQ) (tid : TID) : Prop := (exists tcb, TQMod.maps_to T tid tcb /\ TCB_Status tcb = IDLE) \/ (exists tid', exists tcb, WQMod.in_dom tid' Rdy /\ TQMod.maps_to T tid' tcb /\ TCB_Status tcb = IDLE). (* This is the global invariant enforced in AIM *) Definition WF_AIM_World (Psi : PSpec) (S : State) (T : TQ) (B : WQSet) (RdyQ : WQ) (tid : TID) (langid : LangID) (theta : Spec) : Prop := WF_currTID tid T B RdyQ langid /\ exists_Idle T RdyQ tid /\ WF_TWQ T B RdyQ /\ WF_WQ_WQSpec B Delta /\ exists TM : ThrdMem, exists Mcth : Mem, MemSplit TM (S_Mem S) /\ ThrdMemMod.maps_to TM tid Mcth /\ WF_Curr_Thrd Psi (S_Mem_Upd S Mcth) langid theta T tid /\ WF_ReadyQ Psi T RdyQ TM /\ WF_WQSet Psi T B TM. Inductive embed_WQSet (T : TQ) : WQSet -> Mem -> Prop := wq_emp : embed_WQSet T WQSetMod.emp MemMod.emp | wq_cons : forall B l Q M M' M'', embed_WQSet T B M -> WQSetMod.not_in_dom l B -> ptoTQ l (filterTQ T Q) M' -> MemMod.disjUnion M M' M'' -> embed_WQSet T (WQSetMod.put B l Q) M''. Definition embed_RdyQ (T : TQ) (RdyQ : WQ) : MPred := ptoTQ ready_Q (filterTQ T RdyQ). (* curr_thrd --> tid *) (* tid --> prev, next, tcb *) Definition embed_curr_TCB (T : TQ) (tid : TID) : MPred := fun (M : Mem) => exists tcb, TQMod.maps_to T tid tcb /\ (mstar (ptoW curr_thrd tid) (mstar (mstar (ptoxW tid) (ptoxW (tid+2))) (ptoTCB (tid+4) tcb)) ) M. Definition Itp_AIM (langid : LangID) (theta : Spec) (Psi : PSpec) (S : State) : Prop := exists T, exists B, exists RdyQ, exists tid, pmstar (fun S => WF_AIM_World Psi S T B RdyQ tid langid theta) (mstar (embed_curr_TCB T tid) (mstar (embed_RdyQ T RdyQ) (embed_WQSet T B) ) ) S. (* by guoyu, related lemmas are in Linking_Lemmas3.v *) Definition embed_BlkQ (l : Label) (T : TQ) (BlkQ : WQ) : MPred := ptoTQ l (filterTQ T BlkQ). (* by guoyu, related lemmas are in Linking_Lemmas3.v *) Definition embed_TCB (tid : TID) (tcb : Thread) : MPred := ( tid |->w_ ) *^* (* prev_ptr *) ( tid + 2 |->w_ ) *^* (* next_ptr *) (ptoTCB (tid+4) tcb). (* precondition for switch *) (* stack space: 4 words, not including pc *) (* here we need WF_TQ to know that all tid's are greater than 0 *) (* note we do not need to specify pc in function specifications *) Definition SW_MPre (T : TQ) (RdyQ : WQ) (tid : TID) (sp : Label) (pc : PC) (junk : int) := (embed_curr_TCB T tid) *^* (embed_RdyQ T RdyQ) *^* (sp |-> pc) *^* (sp + 1 |-> junk) *^* (stkSpacePrec sp 8). Definition SW_Prd_aux (T : TQ) (RdyQ : WQ) (tid : TID) (sp : Label) (tcb : Thread) (pc : PC) (junk : int) := fun (S : State) => (SW_MPre T RdyQ tid sp pc junk) (S_Mem S) /\ (TQMod.maps_to T tid tcb) /\ (subsetQ_TQ RdyQ T) /\ (S_RF S SP = sp) /\ (WQMod.not_in_dom tid RdyQ) /\ (WF_TQ T). Definition SW_Prd (S : State) := exists T, exists RdyQ, exists tid, exists sp, exists tcb, exists pc, (exists junk, ((SW_MPre T RdyQ tid sp pc junk)*^*mTrue) (S_Mem S)) /\ (TQMod.maps_to T tid tcb) /\ (subsetQ_TQ RdyQ T) /\ (S_RF S SP = sp) /\ (WQMod.not_in_dom tid RdyQ) /\ (WF_TQ T). Definition SW_MPost (T : TQ) (RdyQ : WQ) (tid : TID) (sp0: Label) (pc0 : PC) (junk : int) := (embed_curr_TCB T tid) *^* (embed_RdyQ T RdyQ) *^* (sp0 |-> pc0) *^* (sp0 + 1 |-> junk) *^* (stkSpacePrec sp0 8). Definition SW_Post_aux (T: TQ) (RdyQ : WQ) (tid : TID) (sp sp0 : Label) (tcb : Thread) (pc0 : PC) (junk : int) := fun (S : State) => (SW_MPost T RdyQ tid sp0 pc0 junk) (S_Mem S) /\ TQMod.maps_to T tid tcb /\ TCB_SP tcb = sp /\ S_RF S SP = sp /\ WQMod.not_in_dom tid RdyQ. Definition SW_grt (S S' : State) := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall T T' RdyQ tid sp tcb pc junk, SW_Prd_aux T RdyQ tid sp tcb pc junk (S_Mem_Upd S M0) -> T' = TQMod.put T tid (sp, TCB_Status tcb, pc) -> exists M0', exists RdyQ', exists tid', exists sp', exists tcb', MemMod.disjUnion M0' M1 (S_Mem S') /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ SW_Post_aux T' RdyQ' tid' sp' sp tcb' pc junk (S_Mem_Upd S' M0'). Definition SWITCH_Spec := Ast SW_Prd SW_grt 0. (* block function requires 10 bytes of stack space *) (* not including its own return addr. and args *) Definition BLK_MPre (T : TQ) (RdyQ BlkQ: WQ) (tid : TID) (sp l : Label) (pc : PC) (junk1 junk2 : int) := (embed_curr_TCB T tid) *^* (embed_RdyQ T RdyQ) *^* (ptoTQ l (filterTQ T BlkQ)) *^* (sp |-> pc) *^* (sp + 1 |-> junk1) *^* (sp + 2 |-> l) *^* (sp + 3 |-> junk2) *^* (stkSpacePrec sp 10). Definition BLK_MPost (T : TQ) (RdyQ BlkQ : WQ) (tid : TID) (sp0 l : Label) (pc0 : PC) (junk1 junk2 : int) := (embed_curr_TCB T tid) *^* (embed_RdyQ T RdyQ) *^* (ptoTQ l (filterTQ T BlkQ)) *^* (sp0 |-> pc0) *^* (sp0 + 1 |-> junk1) *^* (sp0 + 2 |-> l) *^* (sp0 + 3 |-> junk2) *^* (stkSpacePrec sp0 10). Definition BLK_Prd_aux (T : TQ) (RdyQ BlkQ: WQ) (tid : TID) (sp l : Label) (tcb : Thread) (pc : PC) (junk1 junk2 : int) := fun (S : State) => (BLK_MPre T RdyQ BlkQ tid sp l pc junk1 junk2) (S_Mem S) /\ exists_Idle T RdyQ tid /\ TQMod.maps_to T tid tcb /\ subsetQ_TQ RdyQ T /\ subsetQ_TQ BlkQ T /\ TCB_Status tcb = READY /\ S_RF S SP = sp /\ WQMod.not_in_dom tid RdyQ /\ WQMod.not_in_dom tid BlkQ /\ WQMod.disjoint RdyQ BlkQ /\ WF_TQ T. (* /\ S_Flag S _IF = false.*) Definition BLK_Prd (S : State) := exists T, exists RdyQ, exists BlkQ, exists tid, exists sp, exists l, exists tcb, exists pc, (exists junk1, exists junk2, ((BLK_MPre T RdyQ BlkQ tid sp l pc junk1 junk2) *^* mTrue) (S_Mem S)) /\ exists_Idle T RdyQ tid /\ TQMod.maps_to T tid tcb /\ subsetQ_TQ RdyQ T /\ subsetQ_TQ BlkQ T /\ TCB_Status tcb = READY /\ S_RF S SP = sp /\ WQMod.not_in_dom tid RdyQ /\ WQMod.not_in_dom tid BlkQ /\ WQMod.disjoint RdyQ BlkQ /\ WF_TQ T. (* Definition BLK_Prd (S : State) := exists T, exists RdyQ, exists BlkQ, exists tid, exists sp, exists l, exists tcb, exists pc, imprec (BLK_Prd_aux T RdyQ BlkQ tid sp l tcb pc) S. *) Definition BLK_Post_aux (T : TQ) (RdyQ BlkQ : WQ) (tid : TID) (sp sp0 l : Label) (tcb : Thread) (pc0 : PC) (junk1 junk2 : int) := fun (S : State) => TQMod.maps_to T tid tcb /\ TCB_SP tcb = sp /\ S_RF S SP = sp /\ WQMod.not_in_dom tid RdyQ (* /\ S_Flag S _IF = false *) /\ (BLK_MPost T RdyQ BlkQ tid sp0 l pc0 junk1 junk2) (S_Mem S). Definition BLK_grt (S S' : State) := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall T T' RdyQ BlkQ BlkQ' tid sp l tcb pc junk1 junk2, BLK_Prd_aux T RdyQ BlkQ tid sp l tcb pc junk1 junk2 (S_Mem_Upd S M0) -> T' = TQMod.put T tid (sp, BLOCKED, pc) -> BlkQ' = addThrd BlkQ tid -> exists M0', exists RdyQ', exists tid', exists sp', exists tcb', MemMod.disjUnion M0' M1 (S_Mem S') /\ RdyQ = addThrd RdyQ' tid' /\ (BLK_Post_aux T' RdyQ' BlkQ' tid' sp' sp l tcb' pc junk1 junk2) (S_Mem_Upd S' M0'). Definition BLK_Spec := Ast BLK_Prd BLK_grt 0. (* block function requires 10 bytes of stack space *) (* not including its own return addr. and args *) Definition UNBLK_MPre (T : TQ) (RdyQ BlkQ: WQ) (sp l : Label) (junk : int) := (embed_RdyQ T RdyQ) *^* (ptoTQ l (filterTQ T BlkQ)) *^* (sp + 2 |-> l) *^* (sp + 3 |-> junk) *^* (stkSpacePrec sp 10). Definition UNBLK_MPost := UNBLK_MPre. Definition UNBLK_Prd_aux (T : TQ) (RdyQ BlkQ: WQ) (sp l : Label) (junk : int) := fun (S : State) => (UNBLK_MPre T RdyQ BlkQ sp l junk) (S_Mem S) /\ subsetQ_TQ RdyQ T /\ subsetQ_TQ BlkQ T /\ S_RF S SP = sp /\ WQMod.disjoint RdyQ BlkQ /\ WF_TQ T. (* /\ S_Flag S _IF = false.*) Definition UNBLK_Prd (S : State) := exists T, exists RdyQ, exists BlkQ, exists sp, exists l, (exists junk, ((UNBLK_MPre T RdyQ BlkQ sp l junk) *^* mTrue) (S_Mem S)) /\ subsetQ_TQ RdyQ T /\ subsetQ_TQ BlkQ T /\ S_RF S SP = sp /\ WQMod.disjoint RdyQ BlkQ /\ WF_TQ T. Definition UNBLK_Post_aux (T : TQ) (RdyQ0 BlkQ0 : WQ) (sp bp l : Label) (junk : int) := fun (S : State) => S_RF S SP = sp /\ S_RF S BP = bp (* /\ S_Flag S _IF = false*) /\ (filterTQ T BlkQ0 = TQMod.emp /\ UNBLK_MPost T RdyQ0 BlkQ0 sp l junk (S_Mem S) /\ S_RF S AX = 0 \/ exists tid, exists tcb, WQMod.in_dom tid BlkQ0 /\ T tid = Some tcb /\ UNBLK_MPost (TQMod.put T tid (TCB_SP tcb, READY, TCB_PC tcb)) (addThrd RdyQ0 tid) (WQMod.remove BlkQ0 tid) sp l junk (S_Mem S) /\ S_RF S AX <> 0). (* Definition UNBLK_Post_aux (T : TQ) (RdyQ0 BlkQ0 : WQ) (sp bp l : Label) (junk : int) := fun (S : State) => S_RF S SP = sp /\ S_RF S BP = bp (* /\ S_Flag S _IF = false*) /\ (BlkQ0 = WQMod.emp /\ UNBLK_MPost T RdyQ0 BlkQ0 sp l junk (S_Mem S) /\ S_RF S AX = 0 \/ exists tid, exists tcb, WQMod.in_dom tid BlkQ0 /\ T tid = Some tcb /\ UNBLK_MPost (TQMod.put T tid (TCB_SP tcb, READY, TCB_PC tcb)) (addThrd RdyQ0 tid) (WQMod.remove BlkQ0 tid) sp l junk (S_Mem S) /\ S_RF S AX <> 0). *) Definition UNBLK_grt (S S' : State) := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall T RdyQ BlkQ sp l junk, UNBLK_Prd_aux T RdyQ BlkQ sp l junk (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ UNBLK_Post_aux T RdyQ BlkQ sp (S_RF S BP) l junk (S_Mem_Upd S' M0'). Definition UNBLK_Spec := Ast UNBLK_Prd UNBLK_grt 0. Definition SWITCH_Spec0 := packS0 rho_prim SWITCH_Spec. Definition BLK_Spec0 := packS0 rho_prim BLK_Spec. Definition UNBLK_Spec0 := packS0 rho_prim UNBLK_Spec. Definition ext_Prim_Specs (Psi : PSpec) : PSpec := consCT _UNBLK UNBLK_Spec0 (consCT _BLOCK BLK_Spec0 (consCT _SWITCH SWITCH_Spec0 Psi)). Definition Minimal_D (D : LDict) : Prop := D rho_ready = SomeT1 _ (Itp_AIM rho_ready) /\ D rho_idle = SomeT1 _ (Itp_AIM rho_idle) /\ D rho_ih = SomeT1 _ (Itp_AIM rho_ih). Definition ext_IH_Spec (Psi : PSpec) : PSpec := (consCT h_entry IH_Spec0 Psi). Definition ext_Spec (Psi : PSpec) (f : flab) (theta : Spec0) : PSpec := consCT f theta Psi. Parameter SW_BLK_neq : _SWITCH <> _BLOCK. Parameter SW_UNBLK_neq : _SWITCH <> _UNBLK. Parameter BLK_UNBLK_neq : _BLOCK <> _UNBLK. Hint Resolve SW_BLK_neq SW_UNBLK_neq BLK_UNBLK_neq. coq/SCAP/READY_UNBLK.v0000644000107400000620000026603011000223235013564 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas4. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import Reg. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import SCAP_Itr. Require Import Linking. Require Import Linking_Lemmas. Require Import Linking_Lemmas2. Require Import Linking_Lemmas3. Require Import EqNat. Require Import Omega. Require Import List. Require Import Arith_Lemmas. Lemma prim_UNBLK: prim_entry _UNBLK. Proof. unfold prim_entry. right. right. auto. Qed. Hint Resolve prim_UNBLK. Lemma enable_unblk_prog: forall w wqa S pc f, enable_unblk w wqa S -> exists S' : State, nextS pc (comml (_call f)) S S'. Proof. intros. unfold enable_unblk in H. InvertAll. apply stkSpace_call_prog with (_UNBLK_Stk + 2); auto. assert (((S_RF S SP |->w w *^* (wqa *^* stkSpacePrec (S_RF S SP) (_UNBLK_Stk + 2))) *^* mTrue) (S_Mem S)). apply pTrue_m_mTrue with pTrue; auto. assert (((wqa *^* stkSpacePrec (S_RF S SP) (_UNBLK_Stk + 2)) *^* mTrue) (S_Mem S)). apply mstar_mTrue with (S_RF S SP |->w w) mTrue; auto. apply mstar_mTrue with wqa mTrue; auto. omega. Qed. Lemma NH_Call_unblk_enable: forall psi pc p g n S, NH_Call_Prim psi pc _UNBLK (Ast p g n) -> imprec p S -> exists w, exists wqa, enable_unblk w wqa S. Proof. intros. unfold NH_Call_Prim in H. InvertAll. inversion H1. absurd (_UNBLK <> _SWITCH); auto. absurd (_UNBLK <> _BLOCK); auto. inversion H3. rewrite <- H7 in H5. rewrite <- H8 in H5. rewrite <- H9 in H4. clear H7 H8 H9 H3 H tag p0 g0. induction S as (((M, R), fl), isr). unfold imprec in H0. unfold pmstar in H0. InvertAll. rename x into M1. rename x0 into M2. UnfoldStateAll. assert (exists w : nat, exists wqa : WQassert, enable_unblk w wqa (M1, R, fl, isr) /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (M1, R, fl, isr)) p') /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (M1, R, fl, isr) |> g') (g (M1, R, fl, isr)))). apply H5; auto. InvertAll. rename x into w. rename x0 into wqa. exists w. exists wqa. assert (monotonic_p (enable_unblk w wqa)). auto. unfold monotonic_p in H8. assert (enable_unblk w wqa (S_Mem_Upd (M1, R, fl, isr) M)). apply H8; auto. unfold S_Mem. apply MemMod.disjUnion_subseteq_left with M2; auto. UnfoldStateAll. auto. Qed. Lemma NH_UNBLK_prog_aux : forall psi pc theta Psi rho S, NH_Call_Prim psi pc _UNBLK theta -> Itp_AIM rho theta Psi S -> rho <> rho_ih -> exists S', nextS pc (comml (_call _UNBLK)) S S'. Proof. intros. induction theta. assert (imprec (NH_pinvstar p) S). apply Itp_AIM_pinv with g n Psi rho; auto. assert (imprec p S). apply imprec_presv_imprec with (NH_pinvstar p); auto. assert (exists w, exists wqa, enable_unblk w wqa S). apply NH_Call_unblk_enable with psi pc p g n; auto. InvertAll. apply enable_unblk_prog with x x0; auto. Qed. Lemma NH_UNBLK_progress: forall psi pc theta Psi a S, NH_WFcmd psi pc theta (comml (_call _UNBLK)) -> a = Itp_AIM rho_ready theta -> a Psi S -> exists S', nextS pc (comml (_call _UNBLK)) S S'. Proof. intros. unfold NH_WFcmd in H. induction theta. unfold NH_WFcmd_aux in H. inversion_clear H. clear H3. inversion_clear H2. inversion_clear H. clear H2. apply NH_UNBLK_prog_aux with psi (Ast p g n) Psi rho_ready; auto. rewrite H0 in H1. auto. inversion_clear H. absurd (prim_entry _UNBLK); auto. Qed. Lemma WF_AIM_World_unblk: forall Psi'0 S T B RdyQ tid p g tag w wqa, WF_AIM_World Psi'0 S T B RdyQ tid rho_ready (Ast p g tag) -> enable_unblk w wqa S -> exists BlkQ, B w = Some BlkQ /\ Delta w = SomeT wqa /\ (pmstar pTrue (mstar (ptoW (S_RF S SP) w) (mstar wqa (stkSpacePrec (S_RF S SP) (_UNBLK_Stk + 2)) ) ) ) S. Proof. intros. unfold enable_unblk in H0. InvertAll. unfold WF_AIM_World in H. InvertAll. unfold WF_WQ_WQSpec in H4. assert (WQSetMod.in_dom w B). apply H4 with wqa; auto. unfold WQSetMod.in_dom in H9. InvertAll. exists x1. auto. Qed. Lemma enable_unblk_nxt_stkspace0: forall pc S S' M1 M2 f w wqa, ((pTrue *<* (S_RF (S_Mem_Upd S M1) SP |->w w *^* (wqa *^* stkSpacePrec (S_RF (S_Mem_Upd S M1) SP) (_UNBLK_Stk + 2)))) (S_Mem_Upd S M1)) -> nextS pc (comml (_call f)) S S' -> MemMod.disjUnion M1 M2 (S_Mem S) -> exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ ((S_RF S' SP + 2 |->w w) *^* stkSpacePrec (S_RF S' SP) _UNBLK_Stk *^* mTrue) M1'. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. assert ((mTrue *^* (R SP |->w w *^* (wqa *^* stkSpacePrec (R SP) (_UNBLK_Stk + 2)))) M1). unfold pmstar in H. InvertAll. exists x. exists x0. split_l. split. unfold mTrue. auto. auto. clear H. assert (frame (nextS pc (comml (_call f)))). apply frame_call. unfold frame in H. assert (exists M1', MemMod.disjUnion M1' M2 (S_Mem (M', R', fl', isr')) /\ nextS pc (comml (_call f)) (S_Mem_Upd (M, R, fl, isr) M1) (S_Mem_Upd (M', R', fl', isr') M1')). apply H; auto. clear H. UnfoldStateAll. unfold enableS. exists (MemUpdW M1 (R SP - 2) (pc+1) 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_call. unfold pushW. split. sep on. sep lift 3 in H2. sep stksplit 2 in H2. sep lift 0 in H2. sep trivial. split; auto. apply MemUpdW_MemUpd16 with 0; auto. clear H. UnfoldStateAll. InvertAll. exists x. split_l. destruct (nextS_inversion H4). InvertAll. subst R'. reg simpl. substH H10 with (MemUpd16_MemUpdW H10). InvertAll. subst x. sep on. sep lift 3 in H2. sep stksplit in H2. sep lift 1 in H2. assert (MemUpdW M1 (R SP - 2) (pc + 1) x0 ||- R SP - 2 |->w (pc+1) *^* (mTrue *^* R SP |->w w *^* wqa *^* stkSpacePrec (R SP - 2) (_UNBLK_Stk + 2 - 2))). sep upd. auto. assert (R SP - 2 + 2 = R SP). auto. rewrite H9. assert (MemUpdW M1 (R SP - 2) (pc + 1) x0 ||- R SP |->w w *^* stkSpacePrec (R SP - 2) (_UNBLK_Stk + 2 - 2) *^* (R SP - 2 |->w pc + 1 *^* wqa *^* mTrue)). sep matchH H6 with 5. destruct H10 as [M1x [M1y [Hsplit [HM1x HM1y]]]]. exists M1x. exists M1y. split; auto. unfold mTrue. split; auto. Qed. Lemma enable_unblk_nxt_stkspace: forall pc S S' M1 M2 f w wqa, ((pTrue *<* (S_RF (S_Mem_Upd S M1) SP |->w w *^* (wqa *^* stkSpacePrec (S_RF (S_Mem_Upd S M1) SP) (_UNBLK_Stk + 2)))) (S_Mem_Upd S M1)) -> nextS pc (comml (_call f)) S S' -> MemMod.disjUnion M1 M2 (S_Mem S) -> exists M1', exists junk, MemMod.disjUnion M1' M2 (S_Mem S') /\ ((S_RF S' SP + 2 |-> w) *^* (S_RF S' SP + 3 |-> junk) *^* stkSpacePrec (S_RF S' SP) _UNBLK_Stk *^* mTrue) M1'. Proof. intros. assert (exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ ((S_RF S' SP + 2 |->w w) *^* stkSpacePrec (S_RF S' SP) _UNBLK_Stk *^* mTrue) M1'). apply enable_unblk_nxt_stkspace0 with pc S M1 f wqa; auto. destruct H2 as [M1' [Hsplit Hmem]]. exists M1'. sep on. sep lift 0 in Hmem. assert (exists junk1, M1' ||- S_RF S' SP + 2 |-> w *^* S_RF S' SP + 2 + 1 |-> junk1 *^* (stkSpacePrec (S_RF S' SP) _UNBLK_Stk *^* mTrue)). apply ptoW_elim1. auto. clear Hmem. destruct H2 as [junk1 Hmem]. exists junk1. assert (S_RF S' SP + 2 + 1 = S_RF S' SP + 3). auto. rewrite H2 in Hmem. split; auto. Qed. Lemma merge_UNBLK_pre: forall S' M1' w T tid RdyQ B BlkQ M2 junk, (S_RF S' SP + 2 |-> w *^* S_RF S' SP + 3 |-> junk *^* stkSpacePrec (S_RF S' SP) _UNBLK_Stk *^* mTrue) M1' -> (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M2 -> B w = Some BlkQ -> MemMod.disjUnion M1' M2 (S_Mem S') -> (UNBLK_MPre T RdyQ BlkQ (S_RF S' SP) w junk *^* mTrue) (S_Mem S'). Proof. intros. induction S' as (((M, R), fl), isr). UnfoldStateAll. rename M1' into M1. unfold UNBLK_MPre. assert (((R SP + 2 |-> w *^* R SP + 3 |-> junk *^* stkSpacePrec (R SP) _UNBLK_Stk *^* mTrue) *^* (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B))) M). exists M1. exists M2. split; auto. assert (forall M, embed_WQSet T B M -> (ptoTQ w (filterTQ T BlkQ) *^* mTrue) M). intros. apply enbedBlkQ_inWQSet with B; auto. sep on. sep lift 6 in H3. sep weaker_subst in H3 with (ptoTQ w (filterTQ T BlkQ) *^* mTrue); auto. clear H5. sep on. sep lift 7 in H3. sep lift 0. sep match_left H3; auto. sep lift 0 in H3. sep match_left H3; auto. sep lift 1 in H3. sep match_left H3; auto. sep match_left H3; auto. sep matchH H3 with 2. Qed. Lemma enter_UNBLK_preMem: forall pc S S' p g tag M1 M2 Psi T B RdyQ tid wqa w BlkQ, nextS pc (comml (_call _UNBLK)) S S' (* -> enable_blk p wqa *) -> MemMod.disjUnion M1 M2 (S_Mem S) -> WF_AIM_World Psi (S_Mem_Upd S M1) T B RdyQ tid rho_ready (Ast p g tag) -> (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M2 -> Delta w = SomeT wqa -> (pTrue *<* (S_RF (S_Mem_Upd S M1) SP |->w w *^* (wqa *^* stkSpacePrec (S_RF (S_Mem_Upd S M1) SP) (_UNBLK_Stk + 2)))) (S_Mem_Upd S M1) -> B w = Some BlkQ -> exists junk, (UNBLK_MPre T RdyQ BlkQ (S_RF S' SP) w junk *^* mTrue) (S_Mem S'). Proof. intros. assert (exists M1', exists junk, MemMod.disjUnion M1' M2 (S_Mem S') /\ ((S_RF S' SP + 2 |-> w) *^* (S_RF S' SP + 3 |-> junk) *^* stkSpacePrec (S_RF S' SP) _UNBLK_Stk *^* mTrue) M1'). apply enable_unblk_nxt_stkspace with pc S M1 _UNBLK wqa; auto. InvertAll. rename x into M1'. rename x0 into junk. exists junk. apply merge_UNBLK_pre with M1' tid B M2; auto. Qed. Lemma enter_UNBLK_pre: forall psi pc theta Psi'0 S S', NH_WFcmd psi pc theta (comml (_call _UNBLK)) -> Itp_AIM rho_ready theta Psi'0 S -> nextS pc (comml (_call _UNBLK)) S S' -> UNBLK_Prd S'. Proof. intros. unfold UNBLK_Prd. induction theta. unfold Itp_AIM in H0. InvertAll. rename x into T. rename x0 into B. rename x1 into RdyQ. rename x2 into tid. exists T. exists RdyQ. unfold NH_WFcmd in H. unfold NH_WFcmd_aux in H. InvertAll. clear H. clear H4. inversion_clear H2. inversion_clear H. clear H2. unfold NH_Call_Prim in H3. inversion_clear H3. inversion H. absurd (_UNBLK <> _SWITCH); auto. absurd (_UNBLK <> _BLOCK); auto. inversion H4. rewrite <- H8 in H6. rewrite <- H9 in H6. clear H9 H8 H10 H3 H4 H5 tag p0 g0. rename n into tag. induction S as (((M, R), fl), isr). unfold pmstar in H0. InvertAll. rename x into M1. rename x0 into M2. assert (exists w, exists wqa, enable_unblk w wqa (M1, R, fl, isr)). apply NH_Call_unblk_enable with psi pc p g tag; auto. unfold NH_Call_Prim. split; auto. assert (imprec (NH_pinvstar p) (M1, R, fl, isr)). apply WF_AIM_World_pinv with Psi'0 T B RdyQ tid rho_ready g tag; auto. apply imprec_presv_imprec with (NH_pinvstar p); auto. InvertAll. rename x into w. rename x0 into wqa. assert (exists BlkQ, B w = Some BlkQ /\ Delta w = SomeT wqa /\ (pmstar pTrue (mstar (ptoW (S_RF (M1, R, fl, isr) SP) w) (mstar wqa (stkSpacePrec (S_RF (M1, R, fl, isr) SP) (_UNBLK_Stk + 2)) ) ) ) (M1, R, fl, isr) ). apply WF_AIM_World_unblk with Psi'0 T RdyQ tid p g tag; auto. InvertAll. rename x into BlkQ. exists BlkQ. exists (S_RF S' SP). exists w. split. apply enter_UNBLK_preMem with pc (M, R, fl, isr) p g tag M1 M2 Psi'0 B tid wqa; auto. split. apply WF_AIM_World_RdyQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B tid rho_ready (Ast p g tag); auto. split. apply WF_AIM_World_BlkQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ready (Ast p g tag) w; auto. split; auto. split. apply WF_AIM_World_RdyNotBlk with Psi'0 (M1, R, fl, isr) T B tid (Ast p g tag) w rho_ready; auto. apply WF_AIM_World_WFTQ with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ready (Ast p g tag); auto. inversion_clear H. absurd (prim_entry _UNBLK); auto. Qed. Lemma enter_UNBLK_disable: forall psi pc theta Psi'0 S S', NH_WFcmd psi pc theta (comml (_call _UNBLK)) -> Itp_AIM rho_ready theta Psi'0 S -> nextS pc (comml (_call _UNBLK)) S S' -> S_Flag S' _IF = false. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). unfold NH_WFcmd in H. induction theta. destruct H as [HWFcmd [Htmp1 Htmp2]]. clear Htmp1 Htmp2. unfold NH_WFcmd_aux in HWFcmd. inversion_clear HWFcmd. destruct H as [Hprim HWFcmd]. clear Hprim. unfold NH_Call_Prim in HWFcmd. inversion_clear HWFcmd. clear H. assert (fl _IF = false). assert (imprec (NH_pinvstar p) (M, R, fl, isr)). apply Itp_AIM_pinv with g n Psi'0 rho_ready. auto. discriminate. unfold imprec in H. unfold pmstar in H. InvertAll. unfold NH_pinvstar in H. simplS in H. unfold pmstar in H. InvertAll. simplS in H. assert (S_Flag (x1, R, fl, isr) _IF = false). apply H2; auto. UnfoldStateAll; auto. clear H0 H2. destruct (nextS_inversion H1). InvertAll. subst fl'. UnfoldStateAll. auto. inversion_clear H. assert (prim_entry _UNBLK); auto. contradiction. Qed. Lemma WF_AIM_World_unblk2: forall Psi'0 S T B RdyQ tid p g tag w wqa S', WF_AIM_World Psi'0 S T B RdyQ tid rho_ready (Ast p g tag) -> enable_unblk w wqa S' -> exists BlkQ, B w = Some BlkQ /\ Delta w = SomeT wqa /\ (pmstar pTrue (mstar (ptoW (S_RF S' SP) w) (mstar wqa (stkSpacePrec (S_RF S' SP) (_UNBLK_Stk + 2)) ) ) ) S'. Proof. intros. unfold enable_unblk in H0. InvertAll. unfold WF_AIM_World in H. InvertAll. unfold WF_WQ_WQSpec in H4. assert (WQSetMod.in_dom w B). apply H4 with wqa; auto. unfold WQSetMod.in_dom in H9. InvertAll. exists x1. auto. Qed. Lemma enter_UNBLK_grt_hyp0: forall sp w cthM1 R fl isr wqa, (pTrue *<* (sp |->w w *^* (wqa *^* stkSpacePrec sp (_UNBLK_Stk + 2)))) (cthM1, R, fl, isr) -> exists cthM11, exists cthM12, MemMod.disjUnion cthM11 cthM12 cthM1 /\ (sp |->w w *^* stkSpacePrec sp (_UNBLK_Stk + 2)) cthM11 /\ (wqa *^* mTrue) cthM12. Proof. intros. assert ((sp |->w w *^* stkSpacePrec sp (_UNBLK_Stk + 2) *^* (wqa *^* mTrue)) cthM1). assert ((mTrue *^* (sp |->w w *^* (wqa *^* stkSpacePrec sp (_UNBLK_Stk + 2)))) cthM1). unfold pmstar in H. InvertAll. exists x. exists x0. split_l. split; auto. sep on. sep lift 1 in H0. sep matchH H0 with 5. unfold mstar at 1 in H0. InvertAll. exists x. exists x0. split_l. split; auto. Qed. Lemma enter_UNBLK_grt_hyp1: forall sp pc w junk cthM11', (sp |-> pc *^* sp+1 |-> junk *^* (sp + 2 |->w w) *^* stkSpacePrec sp _UNBLK_Stk) cthM11' -> exists cthM11'1, exists cthM11'2, MemMod.disjUnion cthM11'1 cthM11'2 cthM11' /\ ((sp + 2 |->w w) *^* (stkSpacePrec sp _UNBLK_Stk)) cthM11'1 /\ (sp |-> pc *^* sp+1 |-> junk) cthM11'2. Proof. intros. assert ((sp + 2 |->w w *^* stkSpacePrec sp _UNBLK_Stk *^* (sp |-> pc *^* sp + 1 |-> junk)) cthM11'). sep on. sep matchH H with 4. unfold mstar at 1 in H0. InvertAll. exists x. exists x0. split; auto. Qed. Lemma split_blk_Q_2: forall T tid RdyQ B M w BlkQ, (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M -> B w = Some BlkQ -> ((embed_RdyQ T RdyQ *^* (ptoTQ w (filterTQ T BlkQ))) *^* (embed_curr_TCB T tid *^* embed_WQSet T (WQSetMod.remove B w))) M. Proof. intros. assert (((embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* (ptoTQ w (filterTQ T BlkQ))) *^* (embed_WQSet T (WQSetMod.remove B w))) M). apply split_blk_Q. auto. auto. sep on. sep matchH H1 with 4. Qed. Lemma mem_list_compose_d: forall M' M21 M22 M2 M12 cthM2 cthM12 cthM11' cthM11'1 cthM11'2, MemMod.disjUnion M21 M22 M2 -> disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11' :: nil) M' -> MemMod.disjUnion cthM11'1 cthM11'2 cthM11' -> exists M1', exists M2', MemMod.disjUnion cthM11'1 M21 M1' /\ disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: cthM11'2 :: nil) M2' /\ MemMod.disjUnion M1' M2' M'. Proof. intros. assert (DUL2mstar (M2 :: M12 :: cthM2 :: cthM12 :: cthM11' :: nil) M'). apply DUL2mstar_left; auto. unfold DUL2mstar in H2. assert ((eqM M21 *^* eqM M22 *^* (eqM M12 *^* (eqM cthM2 *^* (eqM cthM12 *^* (eqM cthM11' *^* Aemp))))) M'). unfold mstar at 1 in H2. InvertAll. exists x. exists x0. split_l. split_r. unfold eqM in H2. subst x. exists M21. exists M22. unfold eqM. split; auto. clear H2. assert ((eqM cthM11'1 *^* eqM cthM11'2 *^* (eqM M21 *^* eqM M22 *^* eqM M12 *^* eqM cthM2 *^* eqM cthM12 *^* Aemp)) M'). assert ((eqM cthM11' *^* (eqM M21 *^* eqM M22 *^* eqM M12 *^* eqM cthM2 *^* eqM cthM12 *^* Aemp)) M'). sep on. sep matchH H3 with 7. clear H3. unfold mstar at 1 in H2. InvertAll. exists x. exists x0. split_l. split_r. unfold eqM in H2. subst x. exists cthM11'1. exists cthM11'2. unfold eqM. auto. clear H3. assert ((eqM cthM11'1 *^* eqM M21 *^* (eqM M22 *^* eqM M12 *^* eqM cthM2 *^* eqM cthM12 *^* eqM cthM11'2 *^* Aemp)) M'). sep on. sep matchH H2 with 8. clear H2. unfold mstar at 1 in H3. InvertAll. exists x. exists x0. split. unfold mstar in H3. unfold eqM in H3. InvertAll. subst x1 x2. auto. split_r. assert (DUL2mstar (M22 :: M12 :: cthM2 :: cthM12 :: cthM11'2 :: nil) x0). unfold DUL2mstar. sep on. sep matchH H5 with 6. apply DUL2mstar_right; auto. Qed. Lemma mem_compose_c_unblk: forall cthM11'1 M21 M1' sp T RdyQ w junk BlkQ, MemMod.disjUnion cthM11'1 M21 M1' -> ((sp + 2 |-> w) *^* (sp + 3 |-> junk) *^* stkSpacePrec sp _UNBLK_Stk) cthM11'1 -> (embed_RdyQ T RdyQ *^* ptoTQ w (filterTQ T BlkQ)) M21 -> UNBLK_MPre T RdyQ BlkQ sp w junk M1'. Proof. intros. unfold UNBLK_MPre. assert (((sp + 2 |-> w *^* sp + 3 |-> junk *^* stkSpacePrec sp _UNBLK_Stk) *^* (embed_RdyQ T RdyQ *^* ptoTQ w (filterTQ T BlkQ))) M1'). exists cthM11'1. exists M21. split; auto. sep on. sep matchH H2 with 5. Qed. Lemma enter_UNBLK_grt_hyp3: forall S0 pc junk cthM11'2 M22 M12 cthM2 cthM12 M2' M0', (S_RF S0 SP |-> pc *^* S_RF S0 SP+1 |-> junk) cthM11'2 -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: cthM11'2 :: nil) M2' -> MemMod.disjUnion M0' M2' (S_Mem S0) -> Ret_Addr pc S0. Proof. intros. induction S0 as (((M0, R0), fl0), isr0). unfold S_Mem in H1. simplS in H. unfold Ret_Addr. intro. simplS. apply nextPC_retw with (R0 SP); auto. assert ((R0 SP |->w pc) cthM11'2). apply ptoW_intro with junk; auto. assert (DUL2mstar (M22 :: M12 :: cthM2 :: cthM12 :: cthM11'2 :: nil) M2'). apply DUL2mstar_left; auto. assert ((eqM M0' *^* DUL2mstar (M22 :: M12 :: cthM2 :: cthM12 :: cthM11'2 :: nil)) M0). exists M0'. exists M2'. split_l. split_r. unfold eqM. auto. clear H3. unfold DUL2mstar in H4. clear H. assert (forall M, eqM cthM11'2 M -> (R0 SP |->w pc) M). intros. unfold eqM in H. subst M. auto. sep on. sep lift 5 in H4. sep weaker_subst in H4 with (R0 SP |->w pc). sep on. sep trivial. Qed. Lemma enter_UNBLK_grt_hyp4: forall m1 m2 m3 m4 m5 M0', (m1 *^* m2 *^* m3 *^* m4 *^* m5) M0' -> exists M0'1, exists M0'2, MemMod.disjUnion M0'1 M0'2 M0' /\ (m1 *^* m2) M0'1 /\ (m3 *^* m4 *^* m5) M0'2. Proof. intros. assert ((m1 *^* m2 *^* (m3 *^* m4 *^* m5)) M0'). sep on. sep matchH H with 5. unfold mstar at 1 in H0. InvertAll. exists x. exists x0. split; auto. Qed. Lemma enter_UNBLK_grt_hyp5: forall S0 S' M0' M2' pc' M22 M12 cthM2 cthM12 cthM11'2 M0'1 M0'2, MemMod.disjUnion M0' M2' (S_Mem S0) -> nextS pc' (comms _retw) S0 S' -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: cthM11'2 :: nil) M2' -> MemMod.disjUnion M0'1 M0'2 M0' -> exists M'1, exists M'2, MemMod.disjUnion M0'1 M22 M'2 /\ disjUnionList (M12 :: cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) M'1 /\ MemMod.disjUnion M'1 M'2 (S_Mem S'). Proof. intros. induction S0 as (((Mx, Rx), flx), isrx). induction S' as (((My, Ry), fly), isry). UnfoldStateAll. destruct (nextS_inversion H0). clear H4 H0 Ry fly isry. subst My. assert (DUL2mstar (M22 :: M12 :: cthM2 :: cthM12 :: cthM11'2 :: nil) M2'). apply DUL2mstar_left; auto. assert ((eqM M0'1 *^* eqM M0'2 *^* DUL2mstar (M22 :: M12 :: cthM2 :: cthM12 :: cthM11'2 :: nil)) Mx). exists M0'. exists M2'. split_l. split_r. exists M0'1. exists M0'2. unfold eqM. auto. clear H0. unfold DUL2mstar in H3. assert ((eqM M0'1 *^* eqM M22 *^* (eqM M12 *^* (eqM cthM2 *^* (eqM cthM12 *^* (eqM M0'2 *^* (eqM cthM11'2 *^* Aemp)))))) Mx). sep on. sep matchH H3 with 8. clear H3. unfold mstar at 1 in H0. InvertAll. exists x0. exists x. split. unfold mstar in H0. unfold eqM in H0. InvertAll. subst x1 x2. auto. split. assert (DUL2mstar (M12 :: cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) x0). unfold DUL2mstar. auto. apply DUL2mstar_right. auto. auto with PMap. Qed. Lemma enter_UNBLK_grt_hyp6: forall cthM2 cthM12 M0'2 cthM11'2 cthM', disjUnionList (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM' -> MemMod.disjUnion (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2)) cthM2 cthM'. Proof. intros. assert (DUL2mstar (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM'). apply DUL2mstar_left; auto. unfold DUL2mstar in H0. unfold mstar at 1 in H0. InvertAll. unfold eqM in H0. subst x. unfold mstar at 1 in H3. InvertAll. unfold eqM in H2. subst x. inversion_clear H0. subst x0. unfold mstar at 1 in H4. InvertAll. unfold eqM in H3. subst x. inversion_clear H0. subst x1. unfold mstar in H5. InvertAll. unfold Aemp in H6. subst x1. assert (x = x0). auto with PMap. subst x0. unfold eqM in H4. subst x. auto with PMap. Qed. Lemma step_call_hyp_2: forall pc f M R fl isr M' R' fl' isr' cthM11 cthM12 cthM1 n w junk, nextS pc (comml (_call f)) (M, R, fl, isr) (M', R', fl', isr') -> (R SP |->w w *^* stkSpacePrec (R SP) (n + 2)) cthM11 -> MemMod.disjUnion cthM11 cthM12 cthM1 -> nextS pc (comml (_call f)) (cthM1, R, fl, isr) (MemMod.merge cthM12 (MemUpdW cthM11 (R SP - 2) (pc + 1) junk), R', fl', isr'). Proof. intros. assert (MemMod.disjUnion cthM12 (MemUpdW cthM11 (R SP - 2) (pc + 1) junk) (MemUpdW cthM1 (R SP - 2) (pc+1) junk)). assert (MemMod.in_dom (R SP - 2) cthM11 /\ MemMod.in_dom (R SP - 2 + 1) cthM11). sep on. sep lift 1 in H0. sep stksplit in H0. sep lift 1 in H0. apply ptoxW_indom1 with (R SP |->w w *^* stkSpacePrec (R SP - 2) (n + 2 - 2)); auto. inversion_clear H2. unfold MemUpdW. apply MemMod.update_presv_disjUnion_right. apply MemMod.update_presv_disjUnion_right; auto. auto with PMap. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (R SP - 2 + 1) (R SP - 2)). exists (pc+1). auto. auto. inversion_clear H2. rewrite <- H4. clear H3 H4. destruct (nextS_inversion H). InvertAll. subst fl' isr'. subst R'. apply nextS_call. unfold pushW. split. assert ((R SP |->w w *^* stkSpacePrec (R SP) (n + 2) *^* mTrue) cthM1). exists cthM11. exists cthM12. unfold mTrue. split; auto. sep on. sep lift 1 in H3. sep stksplit 2 in H3. sep lift 0 in H3. sep trivial. split; auto. apply MemUpdW_MemUpd16 with junk; auto. Qed. Lemma enter_UNBLK_grt_auxb0_hyp5: forall pc pc' S0 S' cthM2 cthM12 M0'2 cthM11'2 cthM', nextS pc' (comms _retw) S0 S' -> (S_RF S0 SP |->w pc) cthM11'2 -> disjUnionList (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM' -> nextS pc' (comms _retw) (S_Mem_Upd S0 (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))) (S_Mem_Upd S' (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))). Proof. intros. induction S0 as (((Mx, Rx), flx), isrx). induction S' as (((My, Ry), fly), isry). simplS. unfold S_RF in H0. destruct (nextS_inversion H). InvertAll. subst Ry fly isry. apply nextS_retw. exists pc. unfold popW. split_r. assert ((eqM cthM12 *^* (eqM M0'2 *^* eqM cthM11'2)) (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))). assert (DUL2mstar (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM'). apply DUL2mstar_left; auto. unfold DUL2mstar in H3. unfold mstar at 1 in H3. InvertAll. assert ((eqM cthM12 *^* (eqM M0'2 *^* (eqM cthM11'2 *^* Aemp))) x1); auto. unfold mstar at 1 in H6. InvertAll. unfold eqM in H6. subst x2. unfold mstar at 1 in H10. InvertAll. unfold eqM in H9. subst x2. inversion_clear H6. subst x3. unfold mstar in H11. InvertAll. unfold Aemp in H12. subst x3. assert (x2 = x4). auto with PMap. subst x4. unfold eqM in H10. subst x2. inversion_clear H8. subst x1. sep on. sep matchH H7 with 3. assert ((eqM cthM11'2 *^* (eqM cthM12 *^* eqM M0'2)) (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))). sep on. sep matchH H3 with 3. clear H3. assert (forall M, eqM cthM11'2 M -> (Rx SP |->w pc) M). intros. unfold eqM in H3. subst M. auto. sep on. sep weaker_subst in H5 with (Rx SP |->w pc). sep on. sep trivial. Qed. Lemma enter_UNBLK_grt_hyp8: forall S' cthM'1 cthM'2 cthM11'2 cthM12 cthM2 cthM' M0'2 fl, NH_Inv (S_Flag S') cthM'2 -> fl _IF = S_Flag S' _IF -> MemMod.disjUnion cthM'1 cthM'2 cthM' -> disjUnionList (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM' -> NH_Inv fl cthM2 -> (cthM2 = cthM'2) /\ (cthM'1 = MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2)). Proof. intros. assert (exists cthM'1', MemMod.disjUnion cthM2 cthM'1' cthM' /\ disjUnionList (cthM12 :: M0'2 :: cthM11'2 :: nil) cthM'1'). unfold disjUnionList in *. inversion_clear H2. exists x. inversion_clear H4. split; auto. InvertAll. rename x into cthM'1'. assert (cthM2 = cthM'2). unfold NH_Inv in *. rewrite <- H0 in H. induction (fl _IF). assert (precise (INV0 *^* INV1)). apply mstar_presv_prec; auto. apply Prec0. apply Prec1. unfold precise in H5. apply H5 with cthM'. apply MemMod.disjUnion_subseteq_left with cthM'1'; auto. apply MemMod.disjUnion_subseteq_right with cthM'1; auto. auto. auto. assert (precise Aemp). auto. unfold precise in H5. apply H5 with cthM'; auto. apply MemMod.disjUnion_subseteq_left with cthM'1'; auto. apply MemMod.disjUnion_subseteq_right with cthM'1; auto. split_l. assert (cthM'1' = cthM'1). rewrite <- H5 in H1. apply MemMod.disjUnion_unique with cthM2 cthM2 cthM'; auto. auto with PMap. rewrite <- H7. unfold disjUnionList in H6. InvertAll. subst x1. assert (cthM11'2 = x0). auto with PMap. subst x0. inversion_clear H10. subst x. inversion_clear H9. auto. Qed. Lemma enter_UNBLK_grt_hypa: forall M'2 M0'1 M22 T RdyQ w BlkQ B tid, MemMod.disjUnion M0'1 M22 M'2 -> (embed_RdyQ T RdyQ *^* ptoTQ w (filterTQ T BlkQ)) M0'1 -> (embed_curr_TCB T tid *^* embed_WQSet T (WQSetMod.remove B w)) M22 -> B w = Some BlkQ -> (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M'2. Proof. intros. assert ((embed_RdyQ T RdyQ *^* ptoTQ w (filterTQ T BlkQ) *^* (embed_curr_TCB T tid *^* embed_WQSet T (WQSetMod.remove B w))) M'2). exists M0'1. exists M22. auto. sep on. sep lift 2 in H3. sep match_left H3; auto. sep lift 1 in H3. sep match_left H3; auto. sep off. assert (embed_WQSet T (WQSetMod.put (WQSetMod.remove B w) w BlkQ) M). unfold mstar in H3. InvertAll. apply wq_cons with x0 x; auto with PMap. assert (B = WQSetMod.put (WQSetMod.remove B w) w BlkQ). apply WQSetMod.extensional_eqMap. intro. unfold WQSetMod.put. induction (WQSetMod.beq_A x w). subst x. auto. unfold WQSetMod.remove. induction (WQSetMod.beq_A x w). contradiction. auto. rewrite H5. auto. Qed. Lemma enter_UNBLK_grt_aux5: forall M12 cthM2 cthM12 M0'2 cthM11'2 M'1, disjUnionList (M12 :: cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) M'1 -> exists cthM', MemMod.disjUnion M12 cthM' M'1 /\ disjUnionList (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM'. Proof. intros. unfold disjUnionList in H. inversion H. exists x. inversion H0. split; auto. Qed. Lemma enter_UNBLK_grt_auxb0_hyp21: forall cthM11 cthM11' cthM12 sp w pc junk1 cthM11'1 cthM11'2 cthM11'1_1 cthM11'1_2, MemMod.disjUnion cthM11'1 cthM11'2 cthM11' -> MemMod.disjoint cthM11 cthM12 -> cthM11' = MemUpdW cthM11 sp pc junk1 -> (sp + 2 |->w w *^* stkSpacePrec (sp + 2) (_UNBLK_Stk + 2)) cthM11 -> MemMod.disjUnion cthM11'1_1 cthM11'1_2 cthM11'1 -> MemMod.disjUnion cthM11'1_1 (MemMod.merge (MemMod.merge cthM11'1_2 cthM11'2) cthM12) (MemMod.merge cthM12 cthM11'). Proof. intros. assert (MemMod.disjoint cthM11' cthM12). rewrite H1. unfold MemUpdW. assert (MemMod.in_dom sp cthM11 /\ MemMod.in_dom (sp + 1) cthM11). sep on. sep lift 1 in H2. sep stksplit in H2. sep lift 1 in H2. apply ptoxW_indom1 with (sp + 2 |->w w *^* stkSpacePrec sp _UNBLK_Stk); auto. inversion_clear H4. apply MemMod.update_presv_disj_left; auto. apply MemMod.update_presv_disj_left; auto. unfold MemMod.put. unfold MemMod.in_dom. induction (MemMod.beq_A (sp + 1) sp). exists pc; auto. auto. assert ((eqM cthM11'1_1 *^* (eqM cthM11'1_2 *^* eqM cthM11'2 *^* eqM cthM12)) (MemMod.merge cthM12 cthM11')). sep lift 3. exists cthM12. exists cthM11'. split. split; auto with PMap. split. unfold eqM. auto. sep lift 2. exists cthM11'2. exists cthM11'1. split; auto with PMap. split. unfold eqM. auto. exists cthM11'1_1. exists cthM11'1_2. unfold eqM. auto. unfold mstar at 1 in H5. InvertAll. unfold eqM in H5. subst x. unfold mstar in H8. InvertAll. unfold eqM in H7, H11. subst x2 x3. unfold eqM in H9. subst x1. inversion_clear H8. subst x. inversion_clear H5. subst x0. auto. Qed. Lemma enter_UNBLK_grt_auxb0_hyp22: forall cthM' cthM2 cthM12 M0'2 cthM11'2 M0'2_1 M0'2_2, disjUnionList (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM' -> MemMod.disjUnion M0'2_1 M0'2_2 M0'2 -> MemMod.disjUnion M0'2_1 (MemMod.merge (MemMod.merge M0'2_2 cthM11'2) cthM12) (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2)). Proof. intros. assert (exists Mx, MemMod.disjUnion cthM2 Mx cthM' /\ disjUnionList (cthM12 :: M0'2 :: cthM11'2 :: nil) Mx). unfold disjUnionList in H. inversion_clear H. exists x. inversion_clear H1. unfold disjUnionList. auto. InvertAll. rename x into Mx. assert (disjUnionList (cthM12 :: M0'2 :: cthM11'2 :: nil) Mx). auto. assert ((eqM M0'2_1 *^* (eqM M0'2_2 *^* eqM cthM11'2 *^* eqM cthM12)) Mx). assert (DUL2mstar (cthM12 :: M0'2 :: cthM11'2 :: nil) Mx). apply DUL2mstar_left; auto. unfold DUL2mstar in H4. sep on. sep lift 1 in H4. assert ((eqM M0'2_1 *^* eqM M0'2_2) M0'2). exists M0'2_1. exists M0'2_2. unfold eqM. auto. assert (forall M, eqM M0'2 M -> (eqM M0'2_1 *^* eqM M0'2_2) M). intros. unfold eqM in H6. subst M. auto. sep weaker_subst in H4 with (eqM M0'2_1 *^* eqM M0'2_2). sep on. sep matchH H4 with 5. unfold disjUnionList in H2. InvertAll. rewrite H2 in H8. assert (cthM11'2 = x0). auto with PMap. subst x0. inversion_clear H7. subst x. inversion_clear H6. rewrite <- H9. unfold mstar in H4. unfold eqM in H4. InvertAll. subst x4 x5 x3 x. inversion_clear H12. subst x2. inversion_clear H10. subst x0. auto. Qed. Lemma enter_UNBLK_grt_auxb0_hyp23: forall cthM' cthM2 cthM12 M0'2 cthM11'2 sp pc junk1, disjUnionList (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM' -> (sp |-> pc + 1 *^* sp + 1 |-> junk1) cthM11'2 -> (sp |~>w pc+1) (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2)). Proof. intros. assert (cthM11'2 ||- sp |->w pc+1). apply ptoW_intro with junk1; auto. assert (exists Mx, MemMod.disjUnion cthM2 Mx cthM' /\ disjUnionList (cthM12 :: M0'2 :: cthM11'2 :: nil) Mx). unfold disjUnionList in H. inversion_clear H. exists x. inversion_clear H2. unfold disjUnionList. auto. InvertAll. rename x into Mx. assert (disjUnionList (cthM12 :: M0'2 :: cthM11'2 :: nil) Mx). auto. assert ((eqM cthM12 *^* eqM M0'2 *^* eqM cthM11'2) Mx). assert (DUL2mstar (cthM12 :: M0'2 :: cthM11'2 :: nil) Mx). apply DUL2mstar_left; auto. unfold DUL2mstar in H5. sep on. sep matchH H5 with 3; auto. assert (forall M, eqM cthM11'2 M -> (sp |->w pc + 1) M). intros. unfold eqM in H6. subst M. auto. sep on. sep lift 2 in H5. sep weaker_subst in H5 with (sp |->w pc + 1). unfold disjUnionList in H3. InvertAll. rewrite H3 in H11. assert (cthM11'2 = x0). auto with PMap. subst x0. inversion_clear H10. subst x. inversion_clear H9. rewrite <- H12. sep on. sep trivial. Qed. Lemma enter_UNBLK_grt_auxb0: forall cthM1 R fl isr M cthM11 cthM12 S' pc pc' M' R' fl' isr' S0 wqa w M0'2 cthM11'2 cthM2 cthM' cthM11' cthM11'1 junk1 junk2, MemMod.disjUnion cthM11 cthM12 cthM1 -> (R SP |->w w *^* stkSpacePrec (R SP) (_UNBLK_Stk + 2)) cthM11 -> cthM11' = MemUpdW cthM11 (R' SP) (pc + 1) junk1 -> (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) 10) M0'2 -> (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _UNBLK_Stk) cthM11'1 -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1) cthM11'2 -> MemMod.disjUnion cthM11'1 cthM11'2 cthM11' -> nextS pc (comml (_call _UNBLK)) (M, R, fl, isr) (M', R', fl', isr') -> nextS pc' (comms _retw) S0 S' -> S_RF S0 SP = R' SP -> isr = S_ISR S' -> fl _IF = S_Flag S' _IF -> disjUnionList (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM' -> S_RF S0 AX = 0 -> wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr) (S_Mem_Upd S' (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))). Proof. intros. unfold wrap_fun. unfold conjG. exists (S_Mem_Upd S0 (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))). split. exists (MemMod.merge cthM12 (MemUpdW cthM11 (R SP - 2) (pc+1) junk1), R', fl', isr'). split. apply step_call_hyp_2 with M M' _UNBLK_Stk w; auto. unfold gunblk. exists (R' SP). split. assert (R SP - 2 = R' SP). apply enter_SW_grt_auxb0_hyp0 with pc M fl isr M' fl' isr' _UNBLK; auto. rewrite H13. rewrite <- H1. assert (S_RF S' SP = S_RF S0 SP + 2). apply enter_SW_grt_auxb0_hyp1 with pc'; auto. rewrite H8 in H14. assert (S_RF (S_Mem_Upd S0 (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))) = S_RF S0). UnfoldStateAll. auto. rewrite H15. unfold prepost. induction S0 as (((M0, R0), fl0), isr0). simplS. simplS in H12. simplS in H15. rewrite H12. clear H7 H8 H12 H15 M0 R0 fl0 isr0. assert (R SP >= 2). apply ge_trans with (_UNBLK_Stk + 2); auto with arith. sep on. sep lift 1 in H0. apply stkSpacePrec_sp_ge_sz1 with cthM11 (R SP |->w w); auto. assert (R SP = R' SP + 2). rewrite <- H13. assert (R SP - 2 + 2 = R SP). auto. auto. sep on. sep lift 2 in H2. sep lift 2 in H3. destruct H3 as [cthM11'1_1 [cthM11'1_2 [Hsplit_11'1 [HM11'1_1 HM11'1_2]]]]. destruct H2 as [M0'2_1 [M0'2_2 [Hsplit0'2 [HM0'2_1 HM0'2_2]]]]. exists cthM11'1_1. exists (MemMod.merge (MemMod.merge cthM11'1_2 cthM11'2) cthM12). exists M0'2_1. split. exists MemMod.emp. exists cthM11'1_1. split; auto with PMap. split_r. unfold choice. left. unfold Aemp. split; auto. split; auto. rewrite H8 in H0. split. apply enter_UNBLK_grt_auxb0_hyp21 with cthM11 (R' SP) w (pc + 1) junk1 cthM11'1; auto. inversion_clear H; auto. assert (cthM11'1_2 = M0'2_2). assert (R' SP + 2 + 1 = R' SP + 3). omega. apply enter_SW_grt_auxb0_hyp26 with (R' SP + 2) w junk2; auto. rewrite H2. auto. rewrite H2. auto. rewrite H2. apply enter_UNBLK_grt_auxb0_hyp22 with cthM' cthM2; auto. induction S0 as (((M0, R0), fl0), isr0). simplS. unfold S_RF in H8. induction S' as (((Mx, Rx), flx), isrx). UnfoldStateAll. destruct (nextS_inversion H6). InvertAll. subst fl' isr'. destruct (nextS_inversion H7). InvertAll. subst fl0 isr0. auto. induction S0 as (((M0, R0), fl0), isr0). induction S' as (((Mx, Rx), flx), isrx). simplS. destruct (nextS_inversion H7). InvertAll. subst flx isrx. apply nextS_retw. exists (pc+1). unfold popW. split; auto. unfold S_RF in H8. rewrite H8. apply enter_UNBLK_grt_auxb0_hyp23 with cthM' cthM2 junk1; auto. Qed. Lemma enter_UNBLK_grt_aux7: forall (p p' : Pred) cthM1 R fl isr M cthM11 cthM12 S' pc pc' M' R' fl' isr' S0 wqa w M0'2 cthM11'2 cthM2 cthM' cthM11' cthM11'1 junk1 junk2, p (cthM1, R, fl, isr) -> (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr)) p') -> MemMod.disjUnion cthM11 cthM12 cthM1 -> (R SP |->w w *^* stkSpacePrec (R SP) (_UNBLK_Stk + 2)) cthM11 -> cthM11' = MemUpdW cthM11 (R' SP) (pc + 1) junk1 -> (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) 10) M0'2 -> (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _UNBLK_Stk) cthM11'1 -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1) cthM11'2 -> MemMod.disjUnion cthM11'1 cthM11'2 cthM11' -> nextS pc (comml (_call _UNBLK)) (M, R, fl, isr) (M', R', fl', isr') -> nextS pc' (comms _retw) S0 S' -> S_RF S0 SP = R' SP -> isr = S_ISR S' -> fl _IF = S_Flag S' _IF -> disjUnionList (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM' -> S_RF S0 AX = 0 -> p' (S_Mem_Upd S' (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))). Proof. intros. unfold pimp in H0. apply H0 with pc'. apply enter_UNBLK_grt_auxb0 with M cthM11 M' R' fl' isr' S0 w cthM2 cthM' cthM11' cthM11'1 junk1 junk2; auto. Qed. Lemma enable_unblk_unique_args: forall S w w' wqa wqa', enable_unblk w wqa S -> enable_unblk w' wqa' S -> (w = w' /\ wqa = wqa'). Proof. unfold enable_unblk. intros. InvertAll. induction S as (((M, R), fl), isr). UnfoldStateAll. assert ((mTrue *^* (R SP |->w w' *^* (wqa' *^* stkSpacePrec (R SP) (_UNBLK_Stk + 2)))) M). unfold pmstar in H2. InvertAll. exists x. exists x0. split; auto. assert ((mTrue *^* (R SP |->w w *^* (wqa *^* stkSpacePrec (R SP) (_UNBLK_Stk + 2)))) M). unfold pmstar in H3. InvertAll. exists x. exists x0. split; auto. assert (w = w'). sep on. sep lift 1 in H4. sep lift 1 in H. apply ptoW_ptoW_eq1 with M (R SP) (wqa *^* stkSpacePrec (R SP) (_UNBLK_Stk + 2) *^* mTrue) (wqa' *^* stkSpacePrec (R SP) (_UNBLK_Stk + 2) *^* mTrue); auto. subst w. split_l. rewrite H0 in H1. inversion H1. auto. Qed. Lemma enter_UNBLK_grt2_hyp0: forall T tidR RdyQ tid BlkQ B w Psi'0 TM rho, WQMod.in_dom tidR BlkQ -> B w = Some BlkQ -> WF_TWQ T B RdyQ -> WF_WQSet Psi'0 T B TM -> WF_currTID tid T B RdyQ rho -> exists tcbR, TQMod.maps_to T tidR tcbR /\ WQMod.not_in_dom tidR RdyQ /\ tidR <> tid. Proof. intros. unfold WF_TWQ in H1. InvertAll. unfold WF_WQSet in H2. assert (exists tcb : Thread, exists M : Mem, TQMod.maps_to T tidR tcb /\ ThrdMemMod.maps_to TM tidR M /\ WF_Wait_Thrd Psi'0 M tcb w). apply H2 with BlkQ; auto. InvertAll. rename x into tcbR. exists tcbR. split_l. split. unfold disj_RQ_WQ in H6. assert (WQMod.disjoint BlkQ RdyQ). apply H6 with w; auto. unfold WQMod.disjoint in H8. assert (WQMod.not_in_dom tidR BlkQ \/ WQMod.not_in_dom tidR RdyQ). auto. inversion_clear H10; auto. unfold WQMod.not_in_dom in H11. unfold WQMod.in_dom in H. rewrite H11 in H. inversion H. inversion H10. (* tidR <> tid *) unfold WF_currTID in H3. InvertAll. unfold unblocked in H8. assert (tidR = tid \/ tidR <> tid). apply nat_eq_neq_dec. inversion_clear H13; auto. rewrite <- H15 in H8. assert (WQMod.not_in_dom tidR BlkQ). apply H8 with w; auto. absurd (~ WQMod.in_dom tidR BlkQ); auto with PMap. Qed. Lemma enter_UNBLK_grt2_hyp1: forall tid tidR T T' B B' RdyQ RdyQ' BlkQ BlkQ' w rho tcbR, WF_currTID tid T B RdyQ rho -> T' = TQMod.put T tidR tcbR -> B' = WQSetMod.put B w BlkQ' -> BlkQ' = WQMod.remove BlkQ tidR -> RdyQ' = addThrd RdyQ tidR -> B w = Some BlkQ -> WQMod.not_in_dom tidR RdyQ -> WQMod.in_dom tidR BlkQ -> WF_currTID tid T' B' RdyQ' rho. Proof. intros. unfold WF_currTID. split. Lemma removeB_presv_unblocked: forall tid B BlkQ tidR w, unblocked tid B -> B w = Some BlkQ -> unblocked tid (WQSetMod.put B w (WQMod.remove BlkQ tidR)). Proof. unfold unblocked. intros. unfold WQSetMod.maps_to in H1. unfold WQSetMod.put in H1. induction (WQSetMod.beq_A w0 w). inversion H1. unfold WQMod.not_in_dom. unfold WQMod.remove. induction (WQMod.beq_A tid tidR); auto. assert (WQMod.not_in_dom tid BlkQ). apply H with w; auto. auto. apply H with w0; auto. Qed. subst B'. subst BlkQ'. unfold WF_currTID in H. InvertAll. apply removeB_presv_unblocked; auto. assert (tidR <> tid). Lemma currTID_not_blocked_TID: forall B BlkQ tidR tid w, unblocked tid B -> B w = Some BlkQ -> WQMod.in_dom tidR BlkQ -> tidR <> tid. Proof. intros. assert (tidR = tid \/ tidR <> tid). apply nat_eq_neq_dec. inversion_clear H2; auto. subst tid. unfold unblocked in H. assert (WQMod.not_in_dom tidR BlkQ). apply H with w; auto. absurd (~ WQMod.in_dom tidR BlkQ); auto with PMap. Qed. apply currTID_not_blocked_TID with B BlkQ w; auto. unfold WF_currTID in H. InvertAll. auto. split. subst RdyQ'. unfold addThrd. unfold WQMod.not_in_dom. unfold WQMod.put. induction (WQMod.beq_A tid tidR). absurd (tid <> tidR); auto. unfold WF_currTID in H. InvertAll. auto. split. subst T'. unfold TQMod.put. unfold TQMod.in_dom. induction (TQMod.beq_A tid tidR). absurd (tid <> tidR); auto. unfold WF_currTID in H. InvertAll. auto. unfold WF_currTID in H. InvertAll. exists x. split; auto. subst T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid tidR); auto. absurd (tid <> tidR); auto. Qed. Lemma enter_UNBLK_grt2_hyp2: forall T T' RdyQ RdyQ' tid tidR tcbR, exists_Idle T RdyQ tid -> tidR <> tid -> WQMod.not_in_dom tidR RdyQ -> RdyQ' = addThrd RdyQ tidR -> T' = TQMod.put T tidR tcbR -> WQMod.not_in_dom tidR RdyQ -> exists_Idle T' RdyQ' tid. Proof. intros. unfold exists_Idle in *. inversion_clear H. left. InvertAll. exists x. split; auto. subst T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid tidR); auto. absurd (tid <> tidR); auto. InvertAll. right. exists x. exists x0. assert (x <> tidR). assert (x = tidR \/ x <> tidR). apply nat_eq_neq_dec. inversion H6; auto. subst x. absurd (~ WQMod.in_dom tidR RdyQ); auto with PMap. split. subst RdyQ'. unfold addThrd. unfold WQMod.in_dom. unfold WQMod.put. induction (WQMod.beq_A x tidR); auto. contradiction. split; auto. subst T'. unfold TQMod.maps_to. unfold TQMod.put. induction (TQMod.beq_A x tidR). contradiction. auto. Qed. Lemma enter_UNBLK_grt2_hyp3: forall tidR T T' B B' RdyQ RdyQ' BlkQ BlkQ' w tcbR, WF_TWQ T B RdyQ -> TQMod.in_dom tidR T -> T' = TQMod.put T tidR tcbR -> B' = WQSetMod.put B w BlkQ' -> BlkQ' = WQMod.remove BlkQ tidR -> RdyQ' = addThrd RdyQ tidR -> B w = Some BlkQ -> WQMod.in_dom tidR BlkQ -> WF_TWQ T' B' RdyQ'. Proof. unfold WF_TWQ. intros. InvertAll. split. unfold WF_TQ. unfold WF_TQ in H7. intros. rewrite H1 in H8. apply H7. unfold TQMod.in_dom in H8. unfold TQMod.put in H8. induction (TQMod.beq_A tid tidR). subst tid. auto. auto. split. unfold WF_WQSet2. subst B'. unfold WQSetMod.maps_to. unfold WQSetMod.put. intros. induction (WQSetMod.beq_A l w). inversion H2. subst Q. induction ( WQSetMod.beq_A l' w). rewrite <- a0 in a. contradiction. subst BlkQ'. unfold WF_WQSet2 in H. assert (WQMod.disjoint BlkQ Q'). apply H with w l'; auto. unfold WQMod.disjoint in H3. unfold WQMod.disjoint. intro x. assert (WQMod.not_in_dom x BlkQ \/ WQMod.not_in_dom x Q'). auto. inversion_clear H11. left. unfold WQMod.not_in_dom. unfold WQMod.remove. induction (WQMod.beq_A x tidR). auto. auto. right. auto. induction ( WQSetMod.beq_A l' w). inversion H8. subst Q'. clear H8. subst BlkQ'. unfold WF_WQSet2 in H. assert (WQMod.disjoint Q BlkQ). apply H with l w; auto. unfold WQMod.disjoint in H3. unfold WQMod.disjoint. intro x. assert (WQMod.not_in_dom x Q \/ WQMod.not_in_dom x BlkQ). auto. inversion_clear H8. left. auto. right. unfold WQMod.not_in_dom. unfold WQMod.remove. induction (WQMod.beq_A x tidR). auto. auto. unfold WF_WQSet2 in H. apply H with l l'; auto. unfold disj_RQ_WQ in *. intros. rewrite H2 in H8. unfold WQSetMod.maps_to in H8. unfold WQSetMod.put in H8. induction (WQSetMod.beq_A l w). inversion H8. subst Q. clear H8. assert (WQMod.disjoint BlkQ RdyQ). apply H9 with w; auto. unfold WQMod.disjoint. unfold WQMod.not_in_dom. intro x. rewrite H3. rewrite H4. unfold addThrd. unfold WQMod.disjoint in H8. assert (WQMod.not_in_dom x BlkQ \/ WQMod.not_in_dom x RdyQ). auto. inversion_clear H10. left. unfold WQMod.remove. induction (WQMod.beq_A x tidR); auto. unfold WQMod.put. induction (WQMod.beq_A x tidR). left. unfold WQMod.remove. induction (WQMod.beq_A x tidR); auto. contradiction. right. auto. unfold WQMod.disjoint. intro. rewrite H4. unfold addThrd. unfold WQMod.not_in_dom. unfold WQMod.put. induction (WQMod.beq_A x tidR). left. unfold WF_WQSet2 in H. assert (WQMod.disjoint Q BlkQ). apply H with l w; auto. unfold WQMod.disjoint in H10. assert (WQMod.not_in_dom x Q \/ WQMod.not_in_dom x BlkQ). auto. inversion_clear H11; auto. subst x. absurd (~ WQMod.in_dom tidR BlkQ); auto with PMap. assert (WQMod.disjoint Q RdyQ). apply H9 with l; auto. unfold WQMod.disjoint in H10. assert (WQMod.not_in_dom x Q \/ WQMod.not_in_dom x RdyQ); auto. Qed. Lemma updateB_presv_WQSpec: forall B B' w BlkQ' Delta, B' = WQSetMod.put B w BlkQ' -> WQSetMod.in_dom w B -> WF_WQ_WQSpec B Delta -> WF_WQ_WQSpec B' Delta. Proof. unfold WF_WQ_WQSpec. intros. rewrite H. unfold WQSetMod.in_dom. unfold WQSetMod.put. induction (WQSetMod.beq_A l w). exists BlkQ'; auto. assert (WQSetMod.in_dom l B). apply H1 with wqa. auto. auto. Qed. Lemma inB_indom_TM: forall Psi'0 T B TM w BlkQ tidR, WF_WQSet Psi'0 T B TM -> B w = Some BlkQ -> WQMod.in_dom tidR BlkQ -> ThrdMemMod.in_dom tidR TM. Proof. intros. unfold WF_WQSet in H. assert (exists tcb : Thread, exists M : Mem, TQMod.maps_to T tidR tcb /\ ThrdMemMod.maps_to TM tidR M /\ WF_Wait_Thrd Psi'0 M tcb w). apply H with BlkQ; auto. InvertAll. unfold ThrdMemMod.in_dom. exists x0. auto. Qed. Lemma enter_UNBLK_grt2_hyp4: forall M12 cthM2 cthM12 M0'2 cthM11'2 M'1 cthM121 cthM122 M122 rthM, MemMod.disjUnion cthM121 cthM122 cthM12 -> MemMod.disjUnion M122 rthM M12 -> disjUnionList (M12 :: cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) M'1 -> exists cthM', exists M12', MemMod.disjUnion M12' cthM' M'1 /\ disjUnionList (M122 :: cthM121 :: rthM :: nil) M12' /\ disjUnionList (cthM2 :: cthM122 :: M0'2 :: cthM11'2 :: nil) cthM'. Proof. intros. assert (DUL2mstar (M12 :: cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) M'1). apply DUL2mstar_left. auto. unfold DUL2mstar in H2. assert ((eqM M122 *^* eqM rthM *^* (eqM cthM2 *^* (eqM cthM12 *^* (eqM M0'2 *^* (eqM cthM11'2 *^* Aemp))))) M'1). unfold mstar at 1 in H2. InvertAll. exists x. exists x0. split_l. split_r. unfold eqM in H2. subst x. exists M122. exists rthM. unfold eqM. auto. clear H2. sep on. sep lift 3 in H3. assert ((eqM cthM121 *^* eqM cthM122 *^* (eqM M0'2 *^* (eqM cthM11'2 *^* Aemp) *^* (eqM M122 *^* eqM rthM *^* eqM cthM2))) M'1). sep off. unfold mstar at 1 in H3. InvertAll. exists x. exists x0. split_l. split_r. unfold eqM in H3. subst x. exists cthM121. exists cthM122. unfold eqM. auto. clear H3. sep on. assert (M'1 ||- (eqM M122 *^* (eqM cthM121 *^* (eqM rthM *^* Aemp))) *^* (eqM cthM2 *^* (eqM cthM122 *^* (eqM M0'2 *^* (eqM cthM11'2 *^* Aemp))))). sep matchH H2 with 9. clear H2. sep off. unfold mstar at 1 in H3. InvertAll. exists x0. exists x. split_l. split. cut (DUL2mstar (M122 :: cthM121 :: rthM :: nil) x). intro. apply DUL2mstar_right; auto. unfold DUL2mstar. auto. cut (DUL2mstar (cthM2 :: cthM122 :: M0'2 :: cthM11'2 :: nil) x0). intro. apply DUL2mstar_right; auto. unfold DUL2mstar. auto. Qed. Lemma enter_UNBLK_grt2_hyp5: forall TM' M'1 M12' cthM' tid tidR M122 cthM121 rthM TM, MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tidR) M122 -> MemMod.disjUnion M12' cthM' M'1 -> disjUnionList (M122 :: cthM121 :: rthM :: nil) M12' -> TM' = ThrdMemMod.put (ThrdMemMod.put TM tidR (MemMod.merge cthM121 rthM)) tid cthM' -> tidR <> tid -> MemSplit TM' M'1. Proof. intros. rewrite H2. apply enter_SW_grt_hyp6 with M12'; auto. assert (ThrdMemMod.remove (ThrdMemMod.put TM tidR (MemMod.merge cthM121 rthM)) tid = ThrdMemMod.put (ThrdMemMod.remove TM tid) tidR (MemMod.merge cthM121 rthM)). auto with PMap. rewrite H4. clear H4. apply enter_SW_grt_hyp6 with M122; auto. unfold disjUnionList in H1. inversion_clear H1. inversion_clear H4. InvertAll. subst x1. assert (rthM = x0). auto with PMap. subst x0. inversion_clear H6. subst x. auto. Qed. Lemma enter_UNBLK_grt2_hyp8: forall cthM121 rthM spR pcR M122 M12', disjUnionList (M122 :: cthM121 :: rthM :: nil) M12' -> (spR |~>w pcR) rthM -> (spR |~>w pcR) (MemMod.merge cthM121 rthM). Proof. intros. assert (MemMod.disjUnion cthM121 rthM (MemMod.merge cthM121 rthM)). unfold disjUnionList in H. InvertAll. subst x1. assert (rthM = x0). auto with PMap. subst x0. split; auto. inversion_clear H3; auto. apply leadsToW_Mono with rthM cthM121; auto. auto with PMap. Qed. Lemma mstar_mwand_elim: forall m1 m2 p M R fl isr M', ((m1 *^* m2) -* p) (M, R, fl, isr) -> m2 M' -> MemMod.disjoint M' M -> (m1 -* p) (MemMod.merge M' M, R, fl, isr). Proof. unfold pm_mwand. intros. UnfoldStateAll. assert ((eqM M0 *^* eqM M' *^* eqM M) M'0). sep on. sep lift 0. exists M0. exists (MemMod.merge M' M). unfold eqM at 1. split_l. split_l. exists M'. exists M. unfold eqM. split; auto. split; auto. apply H with (MemMod.merge M0 M'); auto. unfold mstar in H4. unfold eqM in H4. InvertAll. subst x0 x1 x2. inversion_clear H6. subst x. auto. exists M0. exists M'. split; auto. unfold mstar in H4. unfold eqM in H4. InvertAll. subst x0 x1 x2. inversion_clear H6. split; auto. Qed. Lemma enter_UNBLK_grt2_hyp9: forall M122 cthM121 rthM M12', disjUnionList (M122 :: cthM121 :: rthM :: nil) M12' -> MemMod.disjoint cthM121 rthM. Proof. intros. unfold disjUnionList in H. InvertAll. subst x1. assert (rthM = x0). auto with PMap. subst x0. inversion H2; auto. Qed. Lemma enter_UNBLK_grt2_hypa: forall T T' B B' TM TM' Psi'0 tid tidR tcbR M1 M2 w BlkQ BlkQ', T' = TQMod.put T tidR tcbR -> TM' = ThrdMemMod.put (ThrdMemMod.put TM tidR M1) tid M2 -> B' = WQSetMod.put B w BlkQ' -> BlkQ' = WQMod.remove BlkQ tidR -> B w = Some BlkQ -> unblocked tid B -> WF_WQSet Psi'0 T B TM -> WQMod.in_dom tidR BlkQ -> WF_WQSet2 B -> WF_WQSet Psi'0 T' B' TM'. Proof. unfold WF_WQSet. intros. rewrite H1 in H8. unfold WQSetMod.maps_to in H8. unfold WQSetMod.put in H8. induction (WQSetMod.beq_A l w). inversion H8. subst Q. subst l. clear H8. assert (tid0 = tidR \/ tid0 <> tidR). apply nat_eq_neq_dec. inversion H8. subst tid0. clear H8. rewrite H2 in H9. unfold WQMod.in_dom in H9. unfold WQMod.remove in H9. induction (WQMod.beq_A tidR tidR). inversion H9. inversion H8. absurd (tidR = tidR); auto. clear H8. assert (exists tcb : Thread, exists M : Mem, TQMod.maps_to T tid0 tcb /\ ThrdMemMod.maps_to TM tid0 M /\ WF_Wait_Thrd Psi'0 M tcb w). apply H5 with BlkQ; auto. rewrite H2 in H9. unfold WQMod.in_dom in H9. unfold WQMod.remove in H9. induction (WQMod.beq_A tid0 tidR). contradiction. auto. InvertAll. exists x. exists x0. split. rewrite H. unfold TQMod.maps_to. unfold TQMod.put. induction (TQMod.beq_A tid0 tidR); auto. contradiction. split. subst TM'. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). unfold unblocked in H4. assert (WQMod.not_in_dom tid BlkQ). apply H4 with w; auto. rewrite <- a in H0. assert (WQMod.not_in_dom tid0 BlkQ'). subst BlkQ'. unfold WQMod.remove. unfold WQMod.not_in_dom. induction (WQMod.beq_A tid0 tidR); auto. absurd (~ WQMod.in_dom tid0 BlkQ'); auto with PMap. induction (ThrdMemMod.beq_A tid0 tidR); auto. contradiction. auto. assert (exists tcb : Thread, exists M : Mem, TQMod.maps_to T tid0 tcb /\ ThrdMemMod.maps_to TM tid0 M /\ WF_Wait_Thrd Psi'0 M tcb l). apply H5 with Q; auto. InvertAll. exists x. exists x0. assert (tid0 <> tidR). assert (tid0 = tidR \/ tid0 <> tidR). apply nat_eq_neq_dec. inversion_clear H12; auto. unfold WF_WQSet2 in H7. assert (WQMod.disjoint BlkQ Q). apply H7 with w l; auto. assert (WQMod.not_in_dom tid0 BlkQ). unfold WQMod.disjoint in H12. assert (WQMod.not_in_dom tid0 BlkQ \/ WQMod.not_in_dom tid0 Q). auto. inversion_clear H15; auto. absurd (~ WQMod.in_dom tid0 Q); auto with PMap. subst tid0. absurd (~ WQMod.in_dom tidR BlkQ); auto with PMap. split. subst T'. unfold TQMod.maps_to. unfold TQMod.put. induction (TQMod.beq_A tid0 tidR); auto. contradiction. split. subst TM'. unfold ThrdMemMod.maps_to. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid). subst tid0. unfold unblocked in H4. assert (WQMod.not_in_dom tid Q). apply H4 with l; auto. absurd (~ WQMod.in_dom tid Q); auto with PMap. induction (ThrdMemMod.beq_A tid0 tidR); auto. contradiction. auto. Qed. Lemma enter_UNBLK_grt2_hypb: forall T T' tid tidR tcbR B B' w BlkQ BlkQ' M22, (embed_curr_TCB T tid *^* embed_WQSet T (WQSetMod.remove B w)) M22 -> T' = TQMod.put T tidR tcbR -> tidR <> tid -> B w = Some BlkQ -> WQMod.in_dom tidR BlkQ -> B' = WQSetMod.put B w BlkQ' -> WF_WQSet2 B -> (embed_curr_TCB T' tid *^* embed_WQSet T' (WQSetMod.remove B' w)) M22. Proof. intros. unfold mstar in H. InvertAll. exists x. exists x0. split_l. split. subst T'. unfold embed_curr_TCB. unfold embed_curr_TCB in H. InvertAll. exists x1. split; auto. unfold TQMod.maps_to. unfold TQMod.put. induction (TQMod.beq_A tid tidR); auto. absurd (tid <> tidR); auto. assert (WQSetMod.remove B' w = WQSetMod.remove B w). subst B'. auto with PMap. rewrite H7. rewrite H0. apply ext_unblockedT_presv_WQSet; auto. unfold unblocked. intros. unfold WF_WQSet2 in H5. assert (w <> w0). unfold WQSetMod.maps_to in H9. unfold WQSetMod.remove in H9. induction (WQSetMod.beq_A w0 w); auto. assert (WQMod.disjoint Q BlkQ). apply H5 with w0 w; auto. unfold WQSetMod.maps_to in H9. unfold WQSetMod.remove in H9. induction (WQSetMod.beq_A w0 w); auto. inversion H9. unfold WQMod.disjoint in H11. assert (WQMod.not_in_dom tidR Q \/ WQMod.not_in_dom tidR BlkQ). auto. inversion_clear H12; auto. absurd (~ WQMod.in_dom tidR BlkQ); auto with PMap. Qed. Lemma enter_UNBLK_grt2_auxb0_hyp01: forall cthM1 cthM11 cthM12 cthM11' sp w pc junk1 cthM121 cthM122 cthM11'1 cthM11'2 cthM11'1_1 cthM11'1_2, MemMod.disjUnion cthM11 cthM12 cthM1 -> cthM11' = MemUpdW cthM11 sp (pc + 1) junk1 -> (sp + 2 |->w w *^* stkSpacePrec (sp + 2) (_UNBLK_Stk + 2)) cthM11 -> MemMod.disjUnion cthM121 cthM122 cthM12 -> MemMod.disjUnion cthM11'1 cthM11'2 cthM11' -> MemMod.disjUnion cthM11'1_1 cthM11'1_2 cthM11'1 -> MemMod.disjoint cthM121 cthM11'1_1. Proof. intros. assert (MemMod.disjUnion cthM11' cthM12 (MemUpdW cthM1 sp (pc+1) junk1)). rewrite H0. unfold MemUpdW. assert (MemMod.in_dom sp cthM11 /\ MemMod.in_dom (sp+1) cthM11). sep on. sep lift 1 in H1. sep stksplit in H1. sep lift 1 in H1. apply ptoxW_indom1 with (sp + 2 |->w w *^* stkSpacePrec sp _UNBLK_Stk); auto. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left; auto. inversion_clear H5; auto. inversion_clear H5. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (sp + 1) sp); auto. exists (pc+1). auto. set (cthM1' := (MemUpdW cthM1 sp (pc + 1) junk1)) in *. assert (((eqM cthM11'1_1 *^* eqM cthM11'1_2) *^* eqM cthM11'2 *^* (eqM cthM121 *^* eqM cthM122)) cthM1'). exists cthM11'. exists cthM12. split_l. split. exists cthM11'1. exists cthM11'2. split_l. split. exists cthM11'1_1. exists cthM11'1_2. unfold eqM. auto. unfold eqM. auto. exists cthM121. exists cthM122. unfold eqM. auto. sep on. assert (cthM1' ||- (eqM cthM121 *^* eqM cthM11'1_1 *^* (eqM cthM11'1_2 *^* eqM cthM11'2 *^* eqM cthM122))). sep matchH H6 with 5. sep off. unfold mstar at 1 in H7. InvertAll. unfold mstar in H7. InvertAll. unfold eqM in H7, H12. subst x1 x2. inversion H9; auto. Qed. Lemma enter_UNBLK_grt2_auxb0_hyp02: forall cthM1 cthM11 cthM12 cthM11' sp w pc junk1 cthM121 cthM122 cthM11'1 cthM11'2 cthM11'1_1 cthM11'1_2, MemMod.disjUnion cthM11 cthM12 cthM1 -> cthM11' = MemUpdW cthM11 sp (pc + 1) junk1 -> (sp + 2 |->w w *^* stkSpacePrec (sp + 2) (_UNBLK_Stk + 2)) cthM11 -> MemMod.disjUnion cthM121 cthM122 cthM12 -> MemMod.disjUnion cthM11'1 cthM11'2 cthM11' -> MemMod.disjUnion cthM11'1_1 cthM11'1_2 cthM11'1 -> MemMod.disjUnion (MemMod.merge cthM121 cthM11'1_1) (MemMod.merge (MemMod.merge cthM11'1_2 cthM11'2) cthM122) (MemMod.merge cthM12 cthM11'). Proof. intros. assert (MemMod.disjUnion cthM11' cthM12 (MemUpdW cthM1 sp (pc+1) junk1)). rewrite H0. unfold MemUpdW. assert (MemMod.in_dom sp cthM11 /\ MemMod.in_dom (sp+1) cthM11). sep on. sep lift 1 in H1. sep stksplit in H1. sep lift 1 in H1. apply ptoxW_indom1 with (sp + 2 |->w w *^* stkSpacePrec sp _UNBLK_Stk); auto. inversion_clear H5. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left; auto. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (sp + 1) sp); auto. exists (pc+1). auto. set (cthM1' := (MemUpdW cthM1 sp (pc + 1) junk1)) in *. assert (((eqM cthM11'1_1 *^* eqM cthM11'1_2) *^* eqM cthM11'2 *^* (eqM cthM121 *^* eqM cthM122)) cthM1'). exists cthM11'. exists cthM12. split_l. split. exists cthM11'1. exists cthM11'2. split_l. split. exists cthM11'1_1. exists cthM11'1_2. unfold eqM. auto. unfold eqM. auto. exists cthM121. exists cthM122. unfold eqM. auto. sep on. assert (cthM1' ||- (eqM cthM121 *^* eqM cthM11'1_1 *^* (eqM cthM11'1_2 *^* eqM cthM11'2 *^* eqM cthM122))). sep matchH H6 with 5. clear H6. sep off. assert (MemMod.disjUnion cthM12 cthM11' cthM1'). auto with PMap. inversion_clear H6. rewrite <- H9. unfold mstar at 1 in H7. InvertAll. unfold mstar in H7. unfold eqM in H7. InvertAll. subst x1 x2. inversion_clear H10. subst x. unfold mstar at 1 in H11. InvertAll. unfold eqM in H13. subst x1. unfold mstar in H11. unfold eqM in H11. InvertAll. subst x1 x2. inversion_clear H12. subst x. inversion_clear H10. subst x0. auto. Qed. Lemma enter_UNBLK_grt2_auxb0: forall cthM1 R fl isr M cthM11 cthM12 S' pc pc' M' R' fl' isr' S0 (wqa : MPred) w M0'2 cthM11'2 cthM2 cthM' cthM121 cthM122 junk1 junk2 cthM11' cthM11'1, MemMod.disjUnion cthM11 cthM12 cthM1 -> (R SP |->w w *^* stkSpacePrec (R SP) (_UNBLK_Stk + 2)) cthM11 -> cthM11' = MemUpdW cthM11 (R' SP) (pc + 1) junk1 -> (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) 10) M0'2 -> (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _UNBLK_Stk) cthM11'1 -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1) cthM11'2 -> MemMod.disjUnion cthM11'1 cthM11'2 cthM11' -> nextS pc (comml (_call _UNBLK)) (M, R, fl, isr) (M', R', fl', isr') -> nextS pc' (comms _retw) S0 S' -> S_RF S0 SP = R' SP -> isr = S_ISR S' -> fl _IF = S_Flag S' _IF -> disjUnionList (cthM2 :: cthM122 :: M0'2 :: cthM11'2 :: nil) cthM' -> MemMod.disjUnion cthM121 cthM122 cthM12 -> wqa cthM121 -> S_RF S0 AX <> 0 -> wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr) (S_Mem_Upd S' (MemMod.merge cthM122 (MemMod.merge M0'2 cthM11'2))). Proof. intros. induction S0 as (((Mx, Rx), flx), isrx). induction S' as (((My, Ry), fly), isry). unfold wrap_fun. UnfoldStateAll. unfold conjG. exists (MemMod.merge cthM122 (MemMod.merge M0'2 cthM11'2), Rx, flx, isrx). split. exists (MemMod.merge cthM12 (MemUpdW cthM11 (R SP - 2) (pc+1) junk1), R', fl', isr'). split. apply step_call_hyp_2 with M M' _UNBLK_Stk w; auto. unfold gunblk. exists (R' SP). simplS. split. assert (R SP - 2 = R' SP). apply enter_SW_grt_auxb0_hyp0 with pc M fl isr M' fl' isr' _UNBLK; auto. rewrite H15. rewrite <- H1. assert (S_RF (My, Ry, fly, isry) SP = S_RF (Mx, Rx, flx, isrx) SP + 2). apply enter_SW_grt_auxb0_hyp1 with pc'; auto. unfold S_RF in H16. rewrite H8 in H16. unfold prepost. simplS. assert (R SP >= 2). apply ge_trans with (_UNBLK_Stk + 2); auto with arith. sep on. sep lift 1 in H0. apply stkSpacePrec_sp_ge_sz1 with cthM11 (R SP |->w w); auto. assert (R SP = R' SP + 2). rewrite <- H15. assert (R SP - 2 + 2 = R SP). auto. auto. sep on. sep lift 2 in H2. sep lift 2 in H3. destruct H3 as [cthM11'1_1 [cthM11'1_2 [Hsplit_11'1 [HM11'1_1 HM11'1_2]]]]. destruct H2 as [M0'2_1 [M0'2_2 [Hsplit0'2 [HM0'2_1 HM0'2_2]]]]. exists (MemMod.merge cthM121 cthM11'1_1). exists (MemMod.merge (MemMod.merge cthM11'1_2 cthM11'2) cthM122). exists M0'2_1. split. exists cthM121. exists cthM11'1_1. split. split; auto. apply enter_UNBLK_grt2_auxb0_hyp01 with cthM1 cthM11 cthM12 cthM11' (R' SP) w pc junk1 cthM122 cthM11'1 cthM11'2 cthM11'1_2; auto. rewrite H18 in H0; auto. split; auto. unfold choice. right. split; auto. split_l. rewrite H18 in H0. split. apply enter_UNBLK_grt2_auxb0_hyp02 with cthM1 cthM11 (R' SP) w pc junk1 cthM11'1; auto. assert (cthM11'1_2 = M0'2_2). assert (R' SP + 2 + 1 = R' SP + 3). omega. apply enter_SW_grt_auxb0_hyp26 with (R' SP + 2) w junk2; auto. rewrite H2. auto. rewrite H2. auto. rewrite H2. apply enter_UNBLK_grt_auxb0_hyp22 with cthM' cthM2; auto. destruct (nextS_inversion H6). InvertAll. subst fl' isr'. destruct (nextS_inversion H7). InvertAll. subst flx isrx. auto. destruct (nextS_inversion H7). InvertAll. subst flx isrx. apply nextS_retw. exists (pc+1). unfold popW. split; auto. rewrite H8. apply enter_UNBLK_grt_auxb0_hyp23 with cthM' cthM2 junk1; auto. Qed. Lemma enter_UNBLK_grt2_aux7: forall (p p' : Pred) cthM1 R fl isr M cthM11 cthM12 S' pc pc' M' R' fl' isr' S0 wqa w M0'2 cthM11'2 cthM2 cthM' cthM121 cthM122 junk1 junk2 cthM11' cthM11'1, p (cthM1, R, fl, isr) -> (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr)) p') -> MemMod.disjUnion cthM11 cthM12 cthM1 -> (R SP |->w w *^* stkSpacePrec (R SP) (_UNBLK_Stk + 2)) cthM11 -> cthM11' = MemUpdW cthM11 (R' SP) (pc + 1) junk1 -> (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) 10) M0'2 -> (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) _UNBLK_Stk) cthM11'1 -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk1) cthM11'2 -> MemMod.disjUnion cthM11'1 cthM11'2 cthM11' -> nextS pc (comml (_call _UNBLK)) (M, R, fl, isr) (M', R', fl', isr') -> nextS pc' (comms _retw) S0 S' -> S_RF S0 SP = R' SP -> isr = S_ISR S' -> fl _IF = S_Flag S' _IF -> disjUnionList (cthM2 :: cthM122 :: M0'2 :: cthM11'2 :: nil) cthM' -> MemMod.disjUnion cthM121 cthM122 cthM12 -> wqa cthM121 -> S_RF S0 AX <> 0 -> p' (S_Mem_Upd S' (MemMod.merge cthM122 (MemMod.merge M0'2 cthM11'2))). Proof. intros. unfold pimp in H0. apply H0 with pc'. apply enter_UNBLK_grt2_auxb0 with M cthM11 cthM12 M' R' fl' isr' S0 w cthM2 cthM' cthM121 junk1 junk2 cthM11' cthM11'1; auto. Qed. (* >>>>>>>>>>>>>>> *) Lemma enter_UNBLK_grt: forall D psi pc theta D' Psi Psi' Psi'0 S S', NH_WFcmd psi pc theta (comml (_call _UNBLK)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> subsetCT Psi' Psi'0 -> Itp_AIM rho_ready theta Psi'0 S -> nextS pc (comml (_call _UNBLK)) S S' -> WFST D rho_prim 0 Psi'0 (scap_lift_g UNBLK_grt S'). Proof. intros. unfold WFST. intros. unfold scap_lift_g in H7. InvertAll. induction S' as (((M', R'), fl'), isr'). induction S as (((M, R), fl), isr). unfold S_ISR at 1 in H7. unfold S_Flag at 1 in H10. induction theta. rename n into tag. unfold Itp_AIM in H5. unfold pmstar in H5. InvertAll. rename x into T. rename x0 into B. rename x1 into RdyQ. rename x2 into tid. rename x3 into M1. rename x4 into M2. assert (exists TM, exists cthM, exists M12, exists cthM1, exists cthM2, MemMod.disjUnion M12 cthM M1 /\ MemMod.disjUnion cthM1 cthM2 cthM /\ WF_currTID tid T B RdyQ rho_ready /\ WF_TWQ T B RdyQ /\ exists_Idle T RdyQ tid /\ WF_WQ_WQSpec B Delta /\ MemSplit (ThrdMemMod.remove TM tid) M12 /\ ThrdMemMod.maps_to TM tid cthM /\ WF_Curr_Thrd Psi'0 (S_Mem_Upd (M1, R, fl, isr) cthM) rho_ready (Ast p g tag) T tid /\ WF_ReadyQ Psi'0 T RdyQ TM /\ WF_WQSet Psi'0 T B TM /\ p (cthM1, R, fl, isr) /\ NH_Inv fl cthM2 /\ (tag = 1 -> NH_WFST rho_ready Psi'0 (NH_ItpG g (cthM, R, fl, isr)))). apply decompose_World; auto. InvertAll. rename x into TM. rename x0 into cthM. rename x1 into M12. rename x2 into cthM1. rename x3 into cthM2. assert (WQMod.not_in_dom tid RdyQ). unfold WF_currTID in H14. InvertAll. auto. unfold NH_WFcmd in H. inversion_clear H. clear H28. induction H27. inversion_clear H. clear H27. assert (exists w, exists wqa, enable_unblk w wqa (cthM1, R, fl, isr)). apply NH_Call_unblk_enable with psi pc p g tag; auto. InvertAll. rename x into w. rename x0 into wqa. unfold NH_Call_Prim in H28. inversion_clear H28. inversion H27. absurd (_UNBLK <> _SWITCH); auto. absurd (_UNBLK <> _BLOCK); auto. clear H28. inversion H30. rewrite <- H33 in H32. rewrite <- H34 in H32. rewrite <- H35 in H31. clear H30 H33 H34 H35 tag0 p0 g0. clear H27. assert (exists BlkQ, B w = Some BlkQ /\ Delta w = SomeT wqa /\ (pmstar pTrue (mstar (ptoW (S_RF (cthM1, R, fl, isr) SP) w) (mstar wqa (stkSpacePrec (S_RF (cthM1, R, fl, isr) SP) (_UNBLK_Stk + 2)) ) ) ) (cthM1, R, fl, isr)). apply WF_AIM_World_unblk2 with Psi'0 (M1, R, fl, isr) T RdyQ tid p g tag; auto. InvertAll. rename x into BlkQ. unfold S_RF in H33. assert (exists cthM11, exists cthM12, MemMod.disjUnion cthM11 cthM12 cthM1 /\ (R SP |->w w *^* stkSpacePrec (R SP) (_UNBLK_Stk + 2)) cthM11 /\ (wqa *^* mTrue) cthM12). apply enter_UNBLK_grt_hyp0 with R fl isr; auto. InvertAll. rename x into cthM11. rename x0 into cthM12. assert (disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11 :: nil) M). apply mem_list_compose_a with cthM1 cthM M1; auto. assert (exists junk, ((R' SP |-> (pc+1)) *^* (R' SP + 1 |-> junk) *^* (R' SP + 2 |->w w) *^* (stkSpacePrec (R' SP) _UNBLK_Stk)) (MemUpdW cthM11 (R' SP) (pc + 1) junk) /\ disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: (MemUpdW cthM11 (R' SP) (pc + 1) junk) :: nil) M'). apply call_fun_frame2 with M R fl fl' isr isr' _UNBLK; auto. InvertAll. rename x into junk1. set (cthM11' := MemUpdW cthM11 (R' SP) (pc + 1) junk1) in *. assert (exists cthM11'1, exists cthM11'2, MemMod.disjUnion cthM11'1 cthM11'2 cthM11' /\ ((R' SP + 2 |->w w) *^* (stkSpacePrec (R' SP) _UNBLK_Stk)) cthM11'1 /\ (R' SP |-> (pc + 1) *^* R' SP + 1 |-> junk1) cthM11'2). apply enter_UNBLK_grt_hyp1; auto. InvertAll. rename x into cthM11'1. rename x0 into cthM11'2. assert (((embed_RdyQ T RdyQ *^* (ptoTQ w (filterTQ T BlkQ))) *^* (embed_curr_TCB T tid *^* embed_WQSet T (WQSetMod.remove B w))) M2). apply split_blk_Q_2; auto. unfold mstar at 1 in H41. InvertAll. rename x into M21. rename x0 into M22. assert (exists M1', exists M2', MemMod.disjUnion cthM11'1 M21 M1' /\ disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: cthM11'2 :: nil) M2' /\ MemMod.disjUnion M1' M2' M'). apply mem_list_compose_d with M2 cthM11'; auto. InvertAll. rename x into M1'. rename x0 into M2'. assert (exists tcb, T tid = Some tcb). unfold WF_currTID in H14. InvertAll. exists x. auto. inversion_clear H47. rename x into tcb. unfold UNBLK_grt in H8. sep on. assert (exists junk2, cthM11'1 ||- R' SP + 2 |-> w *^* R' SP + 2 + 1 |-> junk2 *^* stkSpacePrec (R' SP) _UNBLK_Stk). apply ptoW_elim1; auto. inversion_clear H47. rename x into junk2. sep off. clear H38. rename H50 into H38. assert (R' SP + 2 + 1 = R' SP + 3). omega. rewrite H47 in H38. clear H47. assert (exists M0' : MemMod.Map, MemMod.disjUnion M0' M2' (S_Mem S0) /\ UNBLK_Post_aux T RdyQ BlkQ (R' SP) (S_RF (M', R', fl', isr') BP) w junk2 (S_Mem_Upd S0 M0')). apply H8 with M1'; auto. unfold UNBLK_Prd_aux. split. assert (S_Mem (S_Mem_Upd (M', R', fl', isr') M1') = M1'). auto. rewrite H47. apply mem_compose_c_unblk with cthM11'1 M21; auto. split. apply WF_AIM_World_RdyQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B tid rho_ready (Ast p g tag). auto. split. apply WF_AIM_World_BlkQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ready (Ast p g tag) w; auto. split; auto. split. apply WF_AIM_World_RdyNotBlk with Psi'0 (M1, R, fl, isr) T B tid (Ast p g tag) w rho_ready; auto. apply WF_AIM_World_WFTQ with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ready (Ast p g tag); auto. clear H8. InvertAll. rename x into M0'. assert ((fl _IF = false) /\ (isr = false)). assert (S_Flag (cthM1, R, fl, isr) _IF = false). apply H29; auto. split. unfold S_Flag in H8. auto. unfold WF_Curr_Thrd in H20. assert (beq_nat rho_ready rho_ih = false). simpl. auto. rewrite H51 in H20. unfold itp_NH_theta in H20. InvertAll. UnfoldStateAll. auto. inversion_clear H8. exists (pc + 1). assert (S_RF S0 SP = R' SP). unfold UNBLK_Post_aux in H50. InvertAll. auto. split. rewrite <- H8 in H42. apply enter_UNBLK_grt_hyp3 with junk1 cthM11'2 M22 M12 cthM2 cthM12 M2' M0'; auto. exists (packS0 rho_ready (Ast p' g' tag)). split. apply psi_sw_lookupNPC with psi Psi Psi'; auto. intros. unfold Itp0. assert (D rho_ready = SomeT1 _ (Itp_AIM rho_ready)). unfold Minimal_D in H0. InvertAll. auto. rewrite H54. clear H54. unfold Itp_AIM. unfold UNBLK_Post_aux in H50. InvertAll. clear H54. inversion_clear H56. (*two cases:*) (* case 1: blkQ is empty *) InvertAll. exists T. exists B. exists RdyQ. exists tid. unfold UNBLK_MPost in H54. unfold UNBLK_MPre in H54. assert (S_Mem (S_Mem_Upd S0 M0') = M0'). auto. rewrite H56 in H54. clear H56. assert (exists M0'1, exists M0'2, MemMod.disjUnion M0'1 M0'2 M0' /\ (embed_RdyQ T RdyQ *^* ptoTQ w (filterTQ T BlkQ)) M0'1 /\ (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) 10) M0'2). apply (enter_UNBLK_grt_hyp4 (embed_RdyQ T RdyQ) (ptoTQ w (filterTQ T BlkQ)) (R' SP + 2 |-> w) (R' SP + 3 |-> junk2) (stkSpacePrec (R' SP) 10)); auto. InvertAll. rename x into M0'1. rename x0 into M0'2. assert (exists M'1, exists M'2, MemMod.disjUnion M0'1 M22 M'2 /\ disjUnionList (M12 :: cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) M'1 /\ MemMod.disjUnion M'1 M'2 (S_Mem S')). apply enter_UNBLK_grt_hyp5 with S0 M0' M2' pc'; auto. InvertAll. rename x into M'1. rename x0 into M'2. unfold pmstar. exists M'1. exists M'2. split; auto. split. unfold WF_AIM_World. split; auto. split; auto. split; auto. split; auto. assert (exists cthM', MemMod.disjUnion M12 cthM' M'1 /\ disjUnionList (cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) cthM'). apply enter_UNBLK_grt_aux5; auto. InvertAll. rename x into cthM'. exists (ThrdMemMod.put TM tid cthM'). exists cthM'. split. assert (S_Mem (S_Mem_Upd S' M'1) = M'1). auto. rewrite H64. apply enter_SW_grt_hyp6 with M12; auto. split. auto with PMap. split. assert (S_ISR (M, R, fl, isr) = S_ISR S' /\ S_Flag (M, R, fl, isr) _IF = S_Flag S' _IF). apply enter_SW_grt_hyp9 with pc pc' _UNBLK (M', R', fl', isr') S0; auto. unfold S_ISR at 1 in H64. unfold S_Flag at 1 in H64. inversion_clear H64. unfold WF_Curr_Thrd. assert (beq_nat rho_ready rho_ih = false). apply neq_beq_false. discriminate. rewrite H64. clear H64. unfold itp_NH_theta. split. rewrite H52 in H66. rewrite H66. auto. split. unfold NH_pinvstar. unfold pmstar. exists (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2)). exists cthM2. split. assert (MemMod.disjUnion (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2)) cthM2 cthM'). apply enter_UNBLK_grt_hyp6; auto. UnfoldStateAll. auto. split; auto. assert (S_Mem_Upd (S_Mem_Upd (S_Mem_Upd S' M'1) cthM') (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2)) = S_Mem_Upd S' (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))). auto. rewrite H64. clear H64. apply enter_UNBLK_grt_aux7 with p cthM1 R fl isr M cthM11 pc pc' M' R' fl' isr' S0 wqa w cthM2 cthM' cthM11' cthM11'1 junk1 junk2; auto. assert (exists w : nat, exists wqa : WQassert, enable_unblk w wqa (cthM1, R, fl, isr) /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr)) p') /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr) |> g') (g (cthM1, R, fl, isr)))). apply H32; auto. InvertAll. assert (w = x /\ wqa = x0). apply enable_unblk_unique_args with (cthM1, R, fl, isr); auto. inversion_clear H69. rewrite H72. auto. assert (S_Flag (S_Mem_Upd (S_Mem_Upd S' M'1) cthM') = S_Flag S'). auto. rewrite H64. unfold NH_Inv. rewrite <- H67. unfold NH_Inv in H24. auto. (* WFST *) intro Tag1. assert (NH_WFST rho_ready Psi'0 (NH_ItpG g (cthM, R, fl, isr))). apply H26. auto. apply NH_WFST_strengthen with (cthM, R, fl, isr) g; auto. unfold pimp. intros. unfold NH_ItpG. assert ((S_Mem_Upd (S_Mem_Upd S' M'1) cthM') = (S_Mem_Upd S' cthM')). auto. rewrite H69 in H68. clear H69. unfold NH_ItpG in H68. InvertAll. rename x into cthM'1. rename x0 into cthM'2. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split. unfold S_Mem. auto. split. auto. split. auto. split. auto. assert (exists w : nat, exists wqa : WQassert, enable_unblk w wqa (cthM1, R, fl, isr) /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr)) p') /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr) |> g') (g (cthM1, R, fl, isr)))). apply H32; auto. InvertAll. assert (w = x /\ wqa = x0). apply enable_unblk_unique_args with (cthM1, R, fl, isr); auto. inversion_clear H75. rewrite <- H78 in H76. clear H77 H78 H72 H74 x x0. unfold pimp in H76. apply H76 with pc'. clear H76. unfold linkPG. exists (S_Mem_Upd (S_Mem_Upd S' cthM') cthM'1). split; auto. assert ((cthM2 = cthM'2) /\ (cthM'1 = MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))). apply enter_UNBLK_grt_hyp8 with S' cthM' fl; auto. inversion_clear H72. rewrite H75. assert (S_Mem_Upd (S_Mem_Upd S' cthM') (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2)) = S_Mem_Upd S' (MemMod.merge cthM12 (MemMod.merge M0'2 cthM11'2))). auto. rewrite H72. clear H72. apply enter_UNBLK_grt_auxb0 with M cthM11 M' R' fl' isr' S0 w cthM2 cthM' cthM11' cthM11'1 junk1 junk2; auto. split. apply enter_SW_grt_hypf with T tcb; auto. apply TQMod.extensional_eqMap. intros. unfold TQMod.put. induction (TQMod.beq_A x tid). rewrite a. auto. auto. apply enter_SW_grt_hypg with T tcb; auto. unfold WF_currTID in H14. InvertAll. auto. apply TQMod.extensional_eqMap. intros. unfold TQMod.put. induction (TQMod.beq_A x tid). rewrite a. auto. auto. apply enter_UNBLK_grt_hypa with M0'1 M22 w BlkQ; auto. (* case 2: blkQ is not empty *) InvertAll. rename x into tidR. rename x0 into tcbR'. assert (exists tcbR, TQMod.maps_to T tidR tcbR /\ WQMod.not_in_dom tidR RdyQ /\ tidR <> tid). apply enter_UNBLK_grt2_hyp0 with BlkQ B w Psi'0 TM rho_ready; auto. InvertAll. induction x as ((spR, statusR), pcR). assert (tcbR' = (spR, statusR, pcR)). unfold TQMod.maps_to in H57. rewrite H54 in H57. inversion H57. auto. rewrite H60 in H56. unfold TCB_SP, TCB_PC in H56. clear H60 H54 tcbR'. exists (TQMod.put T tidR (spR, READY, pcR)). set (T' := TQMod.put T tidR (spR, READY, pcR)). exists (WQSetMod.put B w (WQMod.remove BlkQ tidR)). set (BlkQ' := WQMod.remove BlkQ tidR). set (B' := WQSetMod.put B w BlkQ'). exists (addThrd RdyQ tidR). set (RdyQ' := addThrd RdyQ tidR). exists tid. unfold UNBLK_MPost in H56. unfold UNBLK_MPre in H56. assert (S_Mem (S_Mem_Upd S0 M0') = M0'). auto. rewrite H54 in H56. clear H54. assert (exists M0'1, exists M0'2, MemMod.disjUnion M0'1 M0'2 M0' /\ (embed_RdyQ T' RdyQ' *^* ptoTQ w (filterTQ T' BlkQ')) M0'1 /\ (R' SP + 2 |-> w *^* R' SP + 3 |-> junk2 *^* stkSpacePrec (R' SP) 10) M0'2). apply (enter_UNBLK_grt_hyp4 (embed_RdyQ T' RdyQ') (ptoTQ w (filterTQ T' BlkQ')) (R' SP + 2 |-> w) (R' SP + 3 |-> junk2) (stkSpacePrec (R' SP) 10)); auto. InvertAll. rename x into M0'1. rename x0 into M0'2. assert (exists M'1, exists M'2, MemMod.disjUnion M0'1 M22 M'2 /\ disjUnionList (M12 :: cthM2 :: cthM12 :: M0'2 :: cthM11'2 :: nil) M'1 /\ MemMod.disjUnion M'1 M'2 (S_Mem S')). apply enter_UNBLK_grt_hyp5 with S0 M0' M2' pc'; auto. InvertAll. rename x into M'1. rename x0 into M'2. unfold pmstar. exists M'1. exists M'2. split; auto. split. unfold WF_AIM_World. (* WF_currTID *) split. apply enter_UNBLK_grt2_hyp1 with tidR T B RdyQ BlkQ BlkQ' w (spR, READY, pcR); auto. (* exists_Idle *) split. apply enter_UNBLK_grt2_hyp2 with T RdyQ tidR (spR, READY, pcR); auto. (* WF_TWQ *) split. apply enter_UNBLK_grt2_hyp3 with tidR T B RdyQ BlkQ BlkQ' w (spR, READY, pcR); auto. unfold TQMod.in_dom. exists (spR, statusR, pcR). auto. (* WF_WQ WQSpec *) split. apply updateB_presv_WQSpec with B w BlkQ'; auto. unfold WQSetMod.in_dom. exists BlkQ. auto. (* rest *) unfold mstar in H36. InvertAll. rename x into cthM121. rename x0 into cthM122. assert (ThrdMemMod.in_dom tidR TM). apply inB_indom_TM with Psi'0 T B w BlkQ; auto. unfold ThrdMemMod.in_dom in H67. inversion_clear H67. rename x into rthM. assert (exists M122, MemMod.disjUnion M122 rthM M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tidR) M122). apply memsplit_thrd_remove; auto. unfold ThrdMemMod.maps_to, ThrdMemMod.remove. induction (ThrdMemMod.beq_A tidR tid). contradiction. auto. InvertAll. rename x into M122. assert (exists cthM', exists M12', MemMod.disjUnion M12' cthM' M'1 /\ disjUnionList (M122 :: cthM121 :: rthM :: nil) M12' /\ disjUnionList (cthM2 :: cthM122 :: M0'2 :: cthM11'2 :: nil) cthM'). apply enter_UNBLK_grt2_hyp4 with M12 cthM12; auto. InvertAll. rename x into cthM'. rename x0 into M12'. exists (ThrdMemMod.put (ThrdMemMod.put TM tidR (MemMod.merge cthM121 rthM)) tid cthM'). set (TM' := ThrdMemMod.put (ThrdMemMod.put TM tidR (MemMod.merge cthM121 rthM)) tid cthM'). exists cthM'. split. assert (S_Mem (S_Mem_Upd S' M'1) = M'1). auto. rewrite H73. clear H73. apply enter_UNBLK_grt2_hyp5 with M12' cthM' tid tidR M122 cthM121 rthM TM; auto. split. unfold TM'. auto with PMap. (* WF_Curr_Thrd *) split. assert (S_ISR (M, R, fl, isr) = S_ISR S' /\ S_Flag (M, R, fl, isr) _IF = S_Flag S' _IF). apply enter_SW_grt_hyp9 with pc pc' _UNBLK (M', R', fl', isr') S0; auto. unfold S_ISR at 1 in H73. unfold S_Flag at 1 in H73. inversion_clear H73. unfold WF_Curr_Thrd. assert (beq_nat rho_ready rho_ih = false). simpl. auto. rewrite H73. clear H73. unfold itp_NH_theta. split. rewrite H52 in H75. rewrite H75. auto. split. unfold NH_pinvstar. unfold pmstar. exists (MemMod.merge cthM122 (MemMod.merge M0'2 cthM11'2)). exists cthM2. split. assert (MemMod.disjUnion (MemMod.merge cthM122 (MemMod.merge M0'2 cthM11'2)) cthM2 cthM'). apply enter_UNBLK_grt_hyp6; auto. UnfoldStateAll. auto. split; auto. assert (S_Mem_Upd (S_Mem_Upd (S_Mem_Upd S' M'1) cthM') (MemMod.merge cthM122 (MemMod.merge M0'2 cthM11'2)) = S_Mem_Upd S' (MemMod.merge cthM122 (MemMod.merge M0'2 cthM11'2))). auto. rewrite H73. clear H73. apply enter_UNBLK_grt2_aux7 with p cthM1 R fl isr M cthM11 cthM12 pc pc' M' R' fl' isr' S0 wqa w cthM2 cthM' cthM121 junk1 junk2 cthM11' cthM11'1; auto. assert (exists w : nat, exists wqa : WQassert, enable_unblk w wqa (cthM1, R, fl, isr) /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr)) p') /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr) |> g') (g (cthM1, R, fl, isr)))). apply H32; auto. InvertAll. assert (w = x /\ wqa = x0). apply enable_unblk_unique_args with (cthM1, R, fl, isr); auto. inversion_clear H78. rewrite H81. auto. assert (S_Flag (S_Mem_Upd (S_Mem_Upd S' M'1) cthM') = S_Flag S'). auto. rewrite H73. unfold NH_Inv. rewrite <- H76. unfold NH_Inv in H24. auto. (* WFST *) intro Tag1. assert (NH_WFST rho_ready Psi'0 (NH_ItpG g (cthM, R, fl, isr))). apply H26. auto. apply NH_WFST_strengthen with (cthM, R, fl, isr) g; auto. unfold pimp. intros. unfold NH_ItpG. assert ((S_Mem_Upd (S_Mem_Upd S' M'1) cthM') = (S_Mem_Upd S' cthM')). auto. rewrite H78 in H77. clear H78. unfold NH_ItpG in H77. InvertAll. rename x into cthM'1. rename x0 into cthM'2. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split. unfold S_Mem. auto. split. auto. split. auto. split. auto. assert (exists w : nat, exists wqa : WQassert, enable_unblk w wqa (cthM1, R, fl, isr) /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr)) p') /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) pc _UNBLK pc' (cthM1, R, fl, isr) |> g') (g (cthM1, R, fl, isr)))). apply H32; auto. InvertAll. assert (w = x /\ wqa = x0). apply enable_unblk_unique_args with (cthM1, R, fl, isr); auto. inversion_clear H84. rewrite <- H87 in H85. clear H87 H86 H81 H83 x x0. unfold pimp in H85. apply H85 with pc'. unfold conjG. exists (S_Mem_Upd (S_Mem_Upd S' cthM') cthM'1). split; auto. assert ((cthM2 = cthM'2) /\ (cthM'1 = MemMod.merge cthM122 (MemMod.merge M0'2 cthM11'2))). apply enter_UNBLK_grt_hyp8 with S' cthM' fl; auto. inversion_clear H81. rewrite H84. assert (S_Mem_Upd (S_Mem_Upd S' cthM') (MemMod.merge cthM122 (MemMod.merge M0'2 cthM11'2)) = S_Mem_Upd S' (MemMod.merge cthM122 (MemMod.merge M0'2 cthM11'2))). auto. rewrite H81. clear H81. apply enter_UNBLK_grt2_auxb0 with M cthM11 cthM12 M' R' fl' isr' S0 w cthM2 cthM' cthM121 junk1 junk2 cthM11' cthM11'1; auto. (* WF_ReadyQ *) split. unfold WF_ReadyQ. intros. assert (tid0 = tidR \/ tid0 <> tidR). apply nat_eq_neq_dec. inversion_clear H75. (* tid0 = tidR *) rewrite H76. clear H73 H76 tid0. exists (spR, READY, pcR). split. unfold T'. auto. split. left. auto. exists (MemMod.merge cthM121 rthM). split. unfold TM'. unfold ThrdMemMod.put, ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tidR tid). absurd (tidR <> tid); auto. induction (ThrdMemMod.beq_A tidR tidR). auto. absurd (tidR = tidR); auto. assert (WF_Wait_Thrd Psi'0 rthM (spR, statusR, pcR) w). unfold WF_WQSet in H22. assert (exists tcb : Thread, exists M : Mem, TQMod.maps_to T tidR tcb /\ ThrdMemMod.maps_to TM tidR M /\ WF_Wait_Thrd Psi'0 M tcb w). apply H22 with BlkQ; auto. InvertAll. unfold TQMod.maps_to in H75, H57. rewrite H75 in H57. inversion H57. rewrite H78 in H77. unfold ThrdMemMod.maps_to in H73. rewrite H69 in H73. inversion H73. auto. split. unfold WF_Wait_Thrd in H73. InvertAll. unfold TCB_SP. unfold TCB_PC. apply enter_UNBLK_grt2_hyp8 with M122 M12'; auto. left. unfold WF_Rdy_Thrd. exists rho_ready. unfold WF_Wait_Thrd in H73. InvertAll. rename x into wqa'. rename x0 into pw. rename x1 into gw. rename x2 into tagw. rewrite H28 in H77. inversion H77. rewrite <- H80 in H79. clear H80 H77 wqa'. exists pw. exists gw. exists tagw. split. left. auto. split. unfold rho_tcb_consistent. split. intro. auto. intro. inversion H76. split. apply enter_UNBLK_grt2_hyp8 with M122 M12'; auto. split; auto. intros. assert ((INV0 *^* INV1 *^* wqa -* itp_NH_theta rho_ready (Ast pw gw tagw) Psi'0) (rthM, R0, fl0, false)). apply H79; auto. apply (mstar_mwand_elim (INV0 *^* INV1) wqa (itp_NH_theta rho_ready (Ast pw gw tagw) Psi'0)); auto. apply enter_UNBLK_grt2_hyp9 with M122 M12'; auto. (* tid0 <> tidR *) unfold WF_ReadyQ in H21. assert (exists tcb : Thread, TQMod.maps_to T tid0 tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid0 M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi'0 M tcb \/ WF_Rdy_Thrd_IH Psi'0 M tcb))). apply H21; auto. unfold RdyQ' in H73. unfold addThrd in H73. unfold WQMod.in_dom, WQMod.put in H73. induction (WQMod.beq_A tid0 tidR). contradiction. auto. InvertAll. exists x. split. unfold T'. unfold TQMod.maps_to, TQMod.put. induction (TQMod.beq_A tid0 tidR). contradiction. auto. split; auto. exists x0. split; auto. unfold TM'. unfold ThrdMemMod.maps_to, ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid). assert (WQMod.not_in_dom tid RdyQ'). unfold RdyQ'. unfold addThrd. unfold WQMod.not_in_dom, WQMod.put. induction (WQMod.beq_A tid tidR). absurd (tid <> tidR); auto. unfold WQMod.not_in_dom in H25. auto. rewrite a in H73. absurd (~ WQMod.in_dom tid RdyQ'); auto with PMap. induction (ThrdMemMod.beq_A tid0 tidR). contradiction. auto. (* WF_WQSet *) apply enter_UNBLK_grt2_hypa with T B TM tid tidR (spR, READY, pcR) (MemMod.merge cthM121 rthM) cthM' w BlkQ BlkQ'; auto. unfold WF_currTID in H14. InvertAll. auto. unfold WF_TWQ in H15. InvertAll; auto. apply enter_UNBLK_grt_hypa with M0'1 M22 w BlkQ'; auto. apply enter_UNBLK_grt2_hypb with T tidR (spR, READY, pcR) B BlkQ BlkQ'; auto. unfold WF_TWQ in H15. InvertAll; auto. unfold B'. auto with PMap. (* done *) inversion H. absurd (prim_entry _UNBLK); auto. Qed. Lemma enter_UNBLK: forall D psi pc theta D' Psi Psi' Psi'0 a S S', NH_WFcmd psi pc theta (comml (_call _UNBLK)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> a = Itp_AIM rho_ready theta -> subsetCT Psi' Psi'0 -> a Psi'0 S -> nextS pc (comml (_call _UNBLK)) S S' -> Itp0 D' UNBLK_Spec0 Psi'0 S'. Proof. intros. unfold Itp0. unfold UNBLK_Spec0. rewrite H1. simpl. rewrite H4 in H6. clear H4 a. split. apply enter_UNBLK_pre with psi pc theta Psi'0 S; auto. split. apply enter_UNBLK_disable with psi pc theta Psi'0 S; auto. exists 0. apply enter_UNBLK_grt with psi pc theta D' Psi Psi' S; auto. Qed. Lemma NH_UNBLK_Presv: forall D psi pc theta D' Psi Psi' Psi'0 a S S' f', NH_WFcmd psi pc theta (comml (_call _UNBLK)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> a = Itp_AIM rho_ready theta -> subsetCT Psi' Psi'0 -> a Psi'0 S -> nextS pc (comml (_call _UNBLK)) S S' -> nextPC (comml (_call _UNBLK)) (S_Mem S) (S_RF S) (S_Flag S) pc f' -> exists theta0 : Spec0, lookupCT Psi'0 f' theta0 /\ Itp0 D' theta0 Psi'0 S'. Proof. intros. assert (lookupCT Psi'0 _UNBLK UNBLK_Spec0). apply subsetCT_presv_lookupCT with Psi'; auto. rewrite H3. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with (consCT _UNBLK UNBLK_Spec0 Psi). apply lookupCT_consCT. apply Psi_extend_subsetCT. apply Psi_extend2_subsetCT. apply Psi_extend_subsetCT. apply consCT_subsetCT. inversion H8. clear H14 H13 H12 H10 H11 fl R M f pc0. exists UNBLK_Spec0. split; auto. apply enter_UNBLK with D psi pc theta Psi Psi' a S; auto. Qed. Lemma call_unblk_disable_itr: forall psi Psi'0 pc theta S, NH_WFcmd psi pc theta (comml (_call _UNBLK)) -> Itp_AIM rho_ready theta Psi'0 S -> ~ itr_enabled S. Proof. intros. unfold NH_WFcmd in H. induction theta. InvertAll. unfold NH_WFcmd_aux in H1. inversion_clear H1. unfold NH_Call_Prim in H2. InvertAll. assert (monotonic_p (fun S => S_Flag S _IF = false)). auto. assert (forall S, imprec p S -> (fun S => S_Flag S _IF = false) S). apply (imprec_presv_imp_monotonic H4 H5); auto. assert (imprec p S). apply imprec_presv_imprec with (NH_pinvstar p); auto. apply Itp_AIM_pinv with g n Psi'0 rho_ready; auto. assert ((fun S0 : State => S_Flag S0 _IF = false) S). apply (H6 S H7). intro. unfold itr_enabled in H9. assert (S_Flag S _IF = false). auto. inversion H9. rewrite H11 in H10. inversion H10. inversion H2. absurd (prim_entry _UNBLK); auto. Qed. Lemma NH_UNBLK_Itp : forall D psi pc theta D' Psi Psi', NH_WFcmd psi pc theta (comml (_call _UNBLK)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) (* -> a = Itp_AIM rho_ready theta *) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_call _UNBLK)). Proof. intros. unfold WFcmd. split. unfold WFcmd_aux. intros. assert (Itp_AIM rho_ready theta Psi'0 S). unfold Itp0 in H4. rewrite H1 in H4. unfold ext_dict in H4. assert (beq_nat rho_ready rho_prim = false). simpl. auto. rewrite H6 in H4. unfold Minimal_D in H0. InvertAll. rewrite H7 in H4. auto. split. apply NH_UNBLK_progress with psi theta Psi'0 (Itp_AIM rho_ready theta); auto. split. intros. apply NH_UNBLK_Presv with D psi pc theta Psi Psi' (Itp_AIM rho_ready theta) S; auto. left. apply call_unblk_disable_itr with psi Psi'0 pc theta; auto. rewrite H1. unfold Itp0. unfold ext_dict. assert (beq_nat rho_ready rho_prim = false). simpl. auto. rewrite H4. unfold Minimal_D in H0. InvertAll. rewrite H5. apply Itp_AIM_Mono_CT. Qed. coq/SCAP/AIM.v0000644000107400000620000000243411000223235012367 0ustar shaosystems(* This is the SCAP for non-handler code *) Add LoadPath "..". Require Import Coqlib. Require Import Machine. Require Import Assertion. Set Implicit Arguments. Unset Strict Implicit. Parameters INV0 INV1 : MPred. Parameter Prec0 : precise INV0. Parameter Prec1 : precise INV1. Lemma Prec01 : precise (mstar INV0 INV1). Proof. apply mstar_presv_prec; [apply Prec0 | apply Prec1]. Qed. Parameter curr_thrd : Label. Parameter ready_Q : Label. (* entry points for primitives *) Parameters _SWITCH _BLOCK _UNBLK : flab. (* stack spaces required by these functions *) (* Parameters _SW_Stk _BLK_Stk _UNBLK_Stk : nat.*) Notation _SW_Stk := 8 (only parsing). Notation _BLK_Stk := 10 (only parsing). Notation _UNBLK_Stk := 10 (only parsing). Definition prim_entry (f : flab) := (f = _SWITCH) \/ (f = _BLOCK) \/ (f = _UNBLK). Definition WQassert := MPred. Definition WQSpec := Label -> optionT WQassert. Parameter Delta : WQSpec. Definition disj_PM (p : Pred) (m : MPred) : Prop := exists S, pmstar p m S. Definition choice (p : Prop) (m m' : MPred) : MPred := fun (M : Mem) => (p /\ m M) \/ (~p /\ m' M). (* stack space required by interrupt handler *) (* Notation IH_Stk := (14 + 8 + 2). *) Notation IH_Stk := (24) (only parsing). (** Spec Tag of System Calls **) Parameter sctag : Label. coq/SCAP/SCAP_IDLE.v0000644000107400000620000000340711000223235013305 0ustar shaosystems(* This is the SCAP for non-handler code *) Add LoadPath "..". Add LoadPath "../CAP0". Require Import Coqlib. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import SCAP. Require Import AIM. Require Import SCAP_READY. Set Implicit Arguments. Unset Strict Implicit. Definition IDLE_Call_Prim (psi : SCAP_PSpec) (pc f: flab) (theta : Spec) : Prop := (NH_Call_Prim psi pc f theta) /\ (f = _SWITCH). Definition IDLE_WFcmd_aux (psi : SCAP_PSpec) (pc : flab) (theta : Spec) (c : comm) : Prop := match theta with Ast p g tag => match c with comms si => NH_WFcmd_aux psi pc theta c | comml i => match i with _call f => (prim_entry f /\ IDLE_Call_Prim psi pc f theta) \/ (~ (prim_entry f) /\ NH_Normal_Call psi pc f theta) | _ => NH_WFcmd_aux psi pc theta c end end end. Definition IDLE_WFcmd (psi : SCAP_PSpec) (pc : flab) (theta : Spec) (c : comm) : Prop := match theta with Ast p g tag => IDLE_WFcmd_aux psi pc theta c /\ (Prd_Itr_Stk p /\ Grt_Itr_Stk g) end. Inductive IDLE_WFiseq : SCAP_PSpec -> flab -> Spec -> iseq -> Prop := idle_isq_seq : forall psi pc p p' g g' i isq tag, IDLE_WFcmd (SCAP_consCT (pc+1) (Ast p' g' tag) psi) pc (Ast p g tag) (comml i) -> IDLE_WFiseq psi (pc+1) (Ast p' g' tag) isq -> IDLE_WFiseq psi pc (Ast p g tag) (seq i isq) | idle_isq_end : forall psi pc p g si tag, IDLE_WFcmd psi pc (Ast p g tag) (comms si) -> IDLE_WFiseq psi pc (Ast p g tag) (sseq si). Definition IDLE_WFcdhp (psi : SCAP_PSpec) (C: CodeHeap) (psi' : SCAP_PSpec): Prop := forall f theta, SCAP_lookupCT psi' f theta -> exists isq, lookupC C f isq /\ IDLE_WFiseq psi f theta isq. coq/SCAP/SCAP_Soundness.v0000644000107400000620000007677311000223235014571 0ustar shaosystems(* This is the SCAP which assumes interrupt is disabled *) Add LoadPath "..". Add LoadPath "../CAP0". Require Import Coqlib. Require Import Map. Require Import MultiMapT. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import CAP0. Require Import Link. Require Import SCAP. Lemma WFST_strengthen : forall D rho n Psi S0 g S1 g', WFST D rho n Psi (scap_lift_g g S0) -> pimp (scap_lift_g g' S1) (scap_lift_g g S0) -> WFST D rho n Psi (scap_lift_g g' S1). Proof. destruct n; simpl in * ; intros. apply H. apply H0; trivial. apply H. apply H0; trivial. Qed. Implicit Arguments WFST_strengthen [D rho n Psi S0 g S1 g']. Lemma SCAP_Mono_CT : forall D rho p g tag, Mono_CT_Itp D -> Mono_CT_assert (Generic_Itp D rho (Ast p g tag)). Proof. intros D rho p g tag HItp. unfold Mono_CT_assert, Generic_Itp. intros Psi S [Hp [Hif Hwfst]] Psi' Hsub. split; trivial. split; trivial. destruct Hwfst as [n Hwfst]. exists n. clear Hif. gen_clear p g S Hp Hwfst. induction n; intros p g S Hp Hwfst. unfold WFST in Hwfst |- * . intros S' Hg. substH Hwfst with (Hwfst S' Hg). destruct Hwfst as [ra [Hra [theta [Hthetain Hwfst]]]]. exists ra; split; trivial. exists theta; split; trivial. apply Hsub; trivial. intros pc' S'' HnextS. substH Hwfst with (Hwfst pc' S'' HnextS). substH HItp with (HItp theta). unfold Mono_CT_assert in HItp. eapply HItp; eauto. simpl in * . intros. substH Hwfst with (Hwfst S0 H). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hrax Hwfst]]]]]]. exists ra; split_l. exists p'; exists g'; exists tag'. split. apply Hsub; trivial. intros pc' S' HnextS. substH Hwfst with (Hwfst pc' S' HnextS). destruct Hwfst. split_l. apply IHn with p'; trivial. Qed. Lemma WFST_nextS : forall D rho n Psi p pc M R fl isr, WFST D rho n Psi p -> p (M, R, fl, isr) -> nextS pc (comms _retw) (M, R, fl, isr) (M, RF_update R SP (R SP + 2), fl, isr). Proof. intros. apply nextS_retw. destruct n; simpl in * . substH H with (H (M, R, fl, isr) H0); clear H0. destruct H as [ra [Hra H]]. unfold Ret_Addr in Hra. substH Hra with (Hra (R SP)). inversion_clear Hra. unfold popW. subst sp. simpl in H1. exists ra. split_lr. substH H with (H (M, R, fl, isr) H0); clear H0. destruct H as [ra [Hra H]]. unfold Ret_Addr in Hra. substH Hra with (Hra (R SP)). inversion_clear Hra. unfold popW. subst sp. simpl in H1. exists ra. split_lr. Qed. Implicit Arguments WFST_nextS [D rho n Psi p pc M R fl isr]. Lemma SCAP_IF_disable : forall D rho Psi theta S0, Generic_Itp D rho theta Psi S0 -> S_Flag S0 _IF = false. Proof. intros. destruct theta as [p g tag]. simpl in H. destruct H as [_ [H _]]; trivial. Qed. Implicit Arguments SCAP_IF_disable [D rho Psi theta S0]. Lemma SCAP_in_CAP0_call : forall D rho psi pc theta D' Psi f, SCAP_WFcmd psi pc theta (comml (_call f)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_call f)). Proof. intros D rho psi pc [p g tag] D' Psi f. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). intros Psi' S HItp Hsub. destruct Hi as [p' [p'' [g' [g'' Hi]]]]. destruct Hi as [Hf [Hf'' [Hen [Hra [Hpp' [Hg'p'' Hg''g]]]]]]. destruct S as [[[M R] fl] isr]. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. destruct (Hen _ Hp) as [S' HnextS]. exists S'; trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [HM' [HR' [Hfl' Hisr']]]. assert (Heq :=nextPC_inversion HnextPC). simpl in Heq. subst fl' isr' f'. assert (Hlk' : lookupCT Psi' f (packS0 rho (Ast p' g' tag))). apply Hsub. apply Hlift. trivial. assert (Hlk'' : lookupCT Psi' (pc+1) (packS0 rho (Ast p'' g'' tag))). apply Hsub. apply Hlift. trivial. exists (packS0 rho (Ast p' g' tag)). split_l. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_call f))) (M', R', fl, isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split; trivial. destruct Hwfst as [n Hwfst]. exists (1+n). simpl. intros S'' Hg'S'S''. unfold wrap_fun in Hg'p''. destruct Hg'S'S'' as [Hg' [Hgisr Hgfl]]. assert (Hxx : fun_frame (M',R',fl,isr) S''). apply Hra. unfold sp_call_pred. apply conjPG_intro; trivial. unfold fun_frame in Hxx. destruct Hxx as [_ [ra [Hra' Hra'']]]. assert (Hrax := ra_after_call _ _ Hra' HnextS). subst ra. exists (pc + 1). split; trivial. clear Hra' Hra''. exists p''; exists g''; exists tag. split_l. intros pc' S''' HnextS''. substH Hg'p'' with (Hg'p'' pc'). split. apply Hg'p''. apply linkPG_intro with (M,R,fl,isr); trivial. apply conjG_intro with S''; trivial. apply conjG_intro with (M',R',fl,isr); trivial. apply (WFST_strengthen (S1 := S''') (g' :=g'') Hwfst). substH Hg''g with (Hg''g pc' (M,R,fl,isr)). intros S'''' [H [H1 H2]]. split. apply Hg''g. apply conjG_intro with S'''; trivial. unfold wrap_fun. apply conjPG_intro; auto. apply conjG_intro with S''; trivial. apply conjG_intro with (M', R', fl, isr); trivial. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. destruct S'''' as [[[M'''' R''''] fl''''] isr'''']. simplS in * . destruct (nextS_inversion HnextS'') as [_ [_ [Hfl'' Hisr'']]]. subst isr'' fl''' isr'''. split_l. rewrite Hgfl; rewrite H2; trivial. Qed. Lemma SCAP_in_CAP0_jne : forall D rho psi pc theta D' Psi f, SCAP_WFcmd psi pc theta (comml (_jne f)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_jne f)). Proof. intros D rho psi pc [p g tag] D' Psi f. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [p'' [g' [g'' Hi]]]]. destruct Hi as [Hf [Hf'' [Hpp' [Hg'g [Hpp'' Hg''g]]]]]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. assert (HnextS := nextS_jne pc f M R fl isr). exists (M,R,fl,isr); trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [HM' [HR' [Hfl' Hisr']]]. subst M' R' fl' isr'. simpl in HnextPC. destruct (nextPC_inversion HnextPC) as [Hpc1 Hpc2]. generalize (refl_equal (fl _ZF)); pattern fl at 1; destruct (fl _ZF); intro Hzf. substH Hpc1 with (Hpc1 (refl_equal _)). subst f'. exists (packS0 rho (Ast p'' g'' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict; simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_jne f))) (M, R, fl, isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp''; trivial. apply conjP_intro; auto. unfold ZF_st. split_l. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M,R,fl,isr))(g':=g'')). intros S'' Hg''. destruct Hg'' as [Hg'' [H1 H2]]. split. apply Hg''g. apply conjPG_intro; trivial. apply conjPG_intro; trivial. split_lr. substH Hpc2 with (Hpc2 (refl_equal _)). subst f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict; simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_jne f))) (M, R, fl, isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. apply conjP_intro; auto. unfold ZF_cl; trivial. split; trivial. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M,R,fl,isr))(g':=g')). intros S' Hg'. destruct Hg' as [Hg' [H1 H2]]. split. apply Hg'g. apply conjPG_intro; trivial. apply conjPG_intro; trivial. split_lr. Qed. Lemma SCAP_in_CAP0_movwp : forall D rho psi pc theta D' Psi o r, SCAP_WFcmd psi pc theta (comml (_movwp o r)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_movwp o r)). Proof. intros D rho psi pc [p g tag] D' Psi o r. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [g' [Hslk' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. destruct (enable_elim Hen Hp) as [S' HnextS]. exists S'; trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [HM' [HR' [Hfl' Hisr']]]. assert (Hpc' := nextPC_inversion HnextPC). simpl in Hpc'. subst M' R' fl' isr' f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_movwp o r))) (M, RF_update R r (opr_eval R o), fl, isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split_l. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M,RF_update R r (opr_eval R o),fl,isr)) (g':=g')). intros S' Hg'. destruct Hg' as [Hg' [H1 H2]]. split. apply Hg'g. apply conjG_intro with (M, RF_update R r (opr_eval R o), fl, isr); trivial. apply conjPG_intro; trivial. split_lr. Qed. Lemma SCAP_in_CAP0_movwld : forall D rho psi pc theta D' Psi a r, SCAP_WFcmd psi pc theta (comml (_movwld a r)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_movwld a r)). Proof. intros D rho psi pc [p g tag] D' Psi a r. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [g' [Hslk' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. destruct (enable_elim Hen Hp) as [S' HnextS]. exists S'; trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [HM' [HR' [Hfl' Hisr']]]. assert (Hpc' := nextPC_inversion HnextPC). simpl in Hpc'. subst M' fl' isr' f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_movwld a r))) (M, R', fl, isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split; trivial. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M,R',fl,isr)) (g':=g')). intros S' [Hg' [H1 H2]]. split. apply Hg'g. apply conjG_intro with (M, R', fl, isr); trivial. apply conjPG_intro; trivial. split_lr. Qed. Lemma SCAP_in_CAP0_movwst : forall D rho psi pc theta D' Psi o a, SCAP_WFcmd psi pc theta (comml (_movwst o a)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_movwst o a)). Proof. intros D rho psi pc [p g tag] D' Psi o a. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [g' [Hslk' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. destruct (enable_elim Hen Hp) as [S' HnextS]. exists S'; trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [_ [_ [Hfl' Hisr']]]. assert (Hpc' := nextPC_inversion HnextPC). simpl in Hpc'. subst fl' isr' f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_movwst o a))) (M', R', fl, isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split; trivial. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M',R',fl,isr)) (g':=g')). intros S' [Hg' [H1 H2]]. split. apply Hg'g. apply conjG_intro with (M', R', fl, isr); trivial. apply conjPG_intro; trivial. split_lr. Qed. Lemma SCAP_in_CAP0_pushwp : forall D rho psi pc theta D' Psi o, SCAP_WFcmd psi pc theta (comml (_pushwp o)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_pushwp o)). Proof. intros D rho psi pc [p g tag] D' Psi o. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [g' [Hslk' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. destruct (enable_elim Hen Hp) as [S' HnextS]. exists S'; trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [_ [_ [Hfl' Hisr']]]. assert (Hpc' := nextPC_inversion HnextPC). simpl in Hpc'. subst fl' isr' f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_pushwp o))) (M', R', fl, isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split; trivial. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M',R',fl,isr)) (g':=g')). intros S' [Hg' [H1 H2]]. split. apply Hg'g. apply conjG_intro with (M', R', fl, isr); trivial. apply conjPG_intro; trivial. split_lr. Qed. Lemma SCAP_in_CAP0_pushwm : forall D rho psi pc theta D' Psi a, SCAP_WFcmd psi pc theta (comml (_pushwm a)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_pushwm a)). Proof. intros D rho psi pc [p g tag] D' Psi a. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [g' [Hslk' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. destruct (enable_elim Hen Hp) as [S' HnextS]. exists S'; trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [_ [_ [Hfl' Hisr']]]. assert (Hpc' := nextPC_inversion HnextPC). simpl in Hpc'. subst fl' isr' f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_pushwm a))) (M', R', fl, isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split_l. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M',R',fl,isr)) (g':=g')). intros S' [Hg' [H1 H2]]. split. apply Hg'g. apply conjG_intro with (M', R', fl, isr); trivial. apply conjPG_intro; trivial. split_lr. Qed. Lemma SCAP_in_CAP0_popw : forall D rho psi pc theta D' Psi r, SCAP_WFcmd psi pc theta (comml (_popw r)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_popw r)). Proof. intros D rho psi pc [p g tag] D' Psi r. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [g' [Hslk' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. destruct (enable_elim Hen Hp) as [S' HnextS]. exists S'; trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [_ [_ [Hfl' Hisr']]]. assert (Hpc' := nextPC_inversion HnextPC). simpl in Hpc'. subst fl' isr' f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_popw r))) (M', R', fl, isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split_l. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M',R',fl,isr)) (g':=g')). intros S' [Hg' [H1 H2]]. split. apply Hg'g. apply conjG_intro with (M', R', fl, isr); trivial. apply conjPG_intro; trivial. split_lr. Qed. Lemma SCAP_in_CAP0_cmpw : forall D rho psi pc theta D' Psi o r, SCAP_WFcmd psi pc theta (comml (_cmpw o r)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_cmpw o r)). Proof. intros D rho psi pc [p g tag] D' Psi o r. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [g' [Hslk' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. destruct (enable_elim Hen Hp) as [S' HnextS]. exists S'; trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [_ [_ [Hfl' Hisr']]]. assert (Hpc' := nextPC_inversion HnextPC). simpl in Hpc'. subst isr' f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_cmpw o r))) (M', R', fl', isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split. destruct Hfl' as [[Hr Hfl'] | [Hr Hfl']]; subst fl'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M',R',fl',isr)) (g':=g')). intros S' [Hg' [H1 H2]]. split. apply Hg'g. apply conjG_intro with (M', R', fl', isr); trivial. apply conjPG_intro; trivial. split_l. destruct Hfl' as [[Hr Hfl'] | [Hr Hfl']]; subst fl'; trivial. Qed. Lemma SCAP_in_CAP0_addw : forall D rho psi pc theta D' Psi o r, SCAP_WFcmd psi pc theta (comml (_addw o r)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_addw o r)). Proof. intros D rho psi pc [p g tag] D' Psi o r. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [g' [Hslk' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. destruct (enable_elim Hen Hp) as [S' HnextS]. exists S'; trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [_ [_ [Hfl' Hisr']]]. assert (Hpc' := nextPC_inversion HnextPC). simpl in Hpc'. subst isr' f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_addw o r))) (M', R', fl', isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split. destruct Hfl'; subst fl'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M',R',fl',isr)) (g':=g')). intros S' [Hg' [H1 H2]]. split. apply Hg'g. apply conjG_intro with (M', R', fl', isr); trivial. apply conjPG_intro; trivial. split_l. destruct Hfl'; subst fl'; trivial. Qed. Lemma SCAP_in_CAP0_subw : forall D rho psi pc theta D' Psi o r, SCAP_WFcmd psi pc theta (comml (_subw o r)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comml (_subw o r)). Proof. intros D rho psi pc [p g tag] D' Psi o r. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [g' [Hslk' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. destruct (enable_elim Hen Hp) as [S' HnextS]. exists S'; trivial. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [_ [_ [Hfl' Hisr']]]. assert (Hpc' := nextPC_inversion HnextPC). simpl in Hpc'. subst isr' f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comml (_subw o r))) (M', R', fl', isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split. destruct Hfl'; subst fl'; trivial. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M',R',fl',isr)) (g':=g')). intros S' [Hg' [H1 H2]]. split. apply Hg'g. apply conjG_intro with (M', R', fl', isr); trivial. apply conjPG_intro; trivial. split_l. destruct Hfl'; subst fl'; trivial. Qed. Lemma SCAP_in_CAP0_jmp : forall D rho psi pc theta D' Psi f, SCAP_WFcmd psi pc theta (comms (_jmp f)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comms (_jmp f)). Proof. intros D rho psi pc [p g tag] D' Psi f. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). destruct Hi as [p' [g' [Hslk' [Hpp' Hg'g]]]]. intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. split. exists (M,R,fl,isr); constructor. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [HM' [HR' [Hfl' Hisr']]]. assert (Hpc' := nextPC_inversion HnextPC). simpl in Hpc'. subst M' R' fl' isr' f'. exists (packS0 rho (Ast p' g' tag)). split. apply Hsub. apply Hlift; trivial. unfold ext_dict. simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. assert (HS' : (p |> nextS pc (comms (_jmp f))) (M, R, fl, isr)). apply linkPG_intro with (M,R,fl,isr); trivial. split. apply Hpp'; trivial. split_l. destruct Hwfst as [n Hwfst]. exists n. apply (WFST_strengthen Hwfst (S1:=(M,R,fl,isr)) (g':=g')). intros S' [Hg' [H1 H2]]. split. apply Hg'g. apply conjPG_intro; trivial. split_lr. Qed. (* unfinished *) Lemma SCAP_in_CAP0_retw : forall D rho psi pc theta D' Psi, SCAP_WFcmd psi pc theta (comms (_retw)) -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc (comms (_retw)). Proof. intros D rho psi pc [p g tag] D' Psi. simpl. intros Hi HDmono HD HD' Hlift. subst D'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl; rewrite <- EqNat.beq_nat_refl. split_r with (SCAP_Mono_CT D rho p g tag HDmono). intros Psi' S HItp Hsub. rrsplit. left. unfold not, itr_enabled. intros [Hx _]; rewrite (SCAP_IF_disable HItp) in Hx; discriminate Hx. destruct S as [[[M R] fl] isr]. simpl in HItp. destruct HItp as [Hp [Hfl Hwfst]]. assert (Hg : scap_lift_g g (M, R, fl, isr) (M, R, fl, isr)). split. apply Hi; trivial. split_lr. split. destruct Hwfst as [n Hwfst]. destruct n. simpl in Hwfst. substH Hwfst with (Hwfst (M, R, fl, isr) Hg). destruct Hwfst as [ra [Hra Hwfst]]. unfold Ret_Addr in Hra. substH Hra with (Hra (R SP)). exists (M, RF_update R SP (R SP + 2), fl, isr). apply nextS_retw. inversion_clear Hra. unfold popW. subst sp. simplS in * . exists ra. split_lr. substH Hwfst with (Hwfst (M, R, fl, isr) Hg). destruct Hwfst as [ra [Hra Hwfst]]. unfold Ret_Addr in Hra. substH Hra with (Hra (R SP)). exists (M, RF_update R SP (R SP + 2), fl, isr). apply nextS_retw. inversion_clear Hra. unfold popW. subst sp. simplS in * . exists ra. split_lr. intros f' [[[M' R'] fl'] isr'] HnextS HnextPC. destruct (nextS_inversion HnextS) as [HM' [HR' [Hfl' Hisr']]]. subst fl' isr'. destruct Hwfst as [n Hwfst]. destruct n as [ | n]. simpl in Hwfst. substH Hwfst with (Hwfst (M,R,fl,isr) Hg). destruct Hwfst as [ra [Hra [theta0 [Hlk Hwfst]]]]. substH Hwfst with (Hwfst pc (M',R',fl,isr) HnextS). substH Hra with (Hra pc). assert (Heq := nextPC_injection HnextPC Hra). subst f'. clear Hra. exists theta0; split_l. apply WFstate_dict_enlarge with D; trivial. apply (ext_dict_subsetD _ _ (Generic_Itp D rho) HD). simpl in Hwfst. substH Hwfst with (Hwfst (M,R,fl,isr) Hg). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hrain Hwfst]]]]]]. substH Hra with (Hra pc). assert (Heq := nextPC_injection HnextPC Hra). subst f'. clear Hra. substH Hwfst with (Hwfst pc (M',R',fl,isr) HnextS). destruct Hwfst as [Hp'S' Hwfst]. exists (packS0 rho (Ast p' g' tag')). split_l. unfold ext_dict; simpl. rewrite <- EqNat.beq_nat_refl. unfold Generic_Itp; simpl. split_l. split_l. exists n; trivial. Qed. Lemma SCAP_in_CAP0_cmd_aux: forall D rho psi pc theta c D' Psi, SCAP_WFcmd psi pc theta c -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFcmd D' Psi (packS0 rho theta) pc c. Proof. intros D rho psi pc [p g tag] c D' Psi. intros Hi HDmono HD HD' Hlift. induction c as [ i | s]; [ induction i | induction s]. (* 19 goals remain, i = cli *) destruct Hi. (* 18 goals remain, i = sti *) destruct Hi. (* 17 goals remain, i = call f *) eapply SCAP_in_CAP0_call; eauto. (* 16 goals remain, i = jne f *) eapply SCAP_in_CAP0_jne; eauto. (* 15 goals remain, i = movwp o r *) eapply SCAP_in_CAP0_movwp; eauto. (* 14 goals remain, i = movwld a r *) eapply SCAP_in_CAP0_movwld; eauto. (* 13 goals remain, i = movwst o a *) eapply SCAP_in_CAP0_movwst; eauto. (* 12 goals remain, i = pushwp o *) eapply SCAP_in_CAP0_pushwp; eauto. (* 11 goals remain, i = pushwm a *) eapply SCAP_in_CAP0_pushwm; eauto. (* 10 goals remain, i = pushfw *) destruct Hi. (* 9 goals remain, i = popw r *) eapply SCAP_in_CAP0_popw; eauto. (* 8 goals remain, i = popfw *) destruct Hi. (* 7 goals remain, i = cmpw o r *) eapply SCAP_in_CAP0_cmpw; eauto. (* 6 goals remain, i = addw o r *) eapply SCAP_in_CAP0_addw; eauto. (* 5 goals remain, i = subw o r *) eapply SCAP_in_CAP0_subw; eauto. (* 4 goals remain, i = outb eoi *) destruct Hi. (* 3 goals remain, i = jmp f *) eapply SCAP_in_CAP0_jmp; eauto. (* 2 goals remain, i = retw *) eapply SCAP_in_CAP0_retw; eauto. (* 1 goals remain, i = iret *) destruct Hi. Qed. Implicit Arguments SCAP_in_CAP0_cmd_aux [D rho psi pc theta c D' Psi]. Lemma SCAP_in_CAP0_iseq: forall D rho psi pc theta isq D' Psi, SCAP_WFiseq psi pc theta isq -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> WFiseq D' Psi (packS0 rho theta) pc isq. Proof. intros D rho psi pc theta isq D' Psi Hscap HDmono HD HD' Hlift. gen_clear theta pc Hscap. induction isq; intros theta pc Hscap. inversion Hscap. subst psi0 pc0 theta i0 isq0. eapply wfis_seq with (packS0 rho (Ast p' g' tag)). assert (Hlift' := lift_psi_cons (f := pc+1) (spec := Ast p' g' tag) Hlift). apply (SCAP_in_CAP0_cmd_aux H4 HDmono HD HD' Hlift'). apply IHisq; trivial. inversion Hscap. subst psi0 pc0 theta si. eapply wfis_end. apply (SCAP_in_CAP0_cmd_aux H3 HDmono HD HD' Hlift). Qed. Lemma SCAP_in_CAP0_cdhp: forall D rho psi C psi' D' Psi Psi', SCAP_WFcdhp psi C psi' -> Mono_CT_Itp D -> D rho = NoneT1 ITP -> D' = ext_dict D rho (Generic_Itp D rho) -> lift_psi psi rho Psi -> lift_psi psi' rho Psi' -> sink_psi psi' rho Psi' -> WFcdhp D' Psi C Psi'. Proof. intros D rho psi C psi' D' Psi Psi' H HDmono H0 H1 H2 H3 H4; unfold SCAP_WFcdhp, WFcdhp; intros f theta0 Hf. substH H4 with (H4 f theta0 Hf). destruct H4 as [theta [Htheta0 Hfx]]. unfold SCAP_WFcdhp in H. substH H with (H f theta Hfx). destruct H as [isq [Hisq H]]. exists isq; split_l. subst theta0. eapply SCAP_in_CAP0_iseq; eauto. Qed. coq/SCAP/make.sh0000644000107400000620000000071411000223235013042 0ustar shaosystems#!/bin/bash # Top rule for Makefile. # To generate top Makefile, just type: sh make.sh > Makefile # Then type: make coq_makefile -I .. -I ../CAP0 -I . \ AIM.v Linking.v QLib.v QLemmas.v SCAP.v SCAP_IDLE.v SCAP_Itr.v SCAP_READY.v \ Linking_Lemmas.v Linking_Lemmas2.v Linking_Lemmas3.v SCAP_NH_Lemmas.v SCAP_Itr_Lemmas.v \ READY_SW.v IH_SW.v NH_SW.v READY_BLK.v READY_UNBLK.v SCAP_IDLE_Soundness.v SCAP_Itr_Soundness.v \ SCAP_READY_Soundness.v SCAP_Soundness.v coq/SCAP/Linking_Lemmas.v0000644000107400000620000027065011000223235014661 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Mem_Lemmas. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas3. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import Reg. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import SCAP_Itr. Require Import Linking. Require Import EqNat. Require Import Omega. Require Import List. Require Import Arith_Lemmas. Lemma embed_WQSet_inv_cons : forall T B l Q M, embed_WQSet T (WQSetMod.put B l Q) M -> WQSetMod.not_in_dom l B -> exists M1, exists M2, MemMod.disjUnion M1 M2 M /\ embed_WQSet T B M1 /\ ptoTQ l (filterTQ T Q) M2. Proof. intros T B' l Q M H. generalize (refl_equal ( WQSetMod.put B' l Q)). pattern B' at 2. set (B := (WQSetMod.put B' l Q)) in * . simpl. generalize B B' T l Q M H. subst B. clear T B' l Q M H. intros B B' T l Q M H. generalize B' l Q; clear B' l Q. induction H. intros. apply False_ind. assert (WQSetMod.emp l = WQSetMod.put B' l Q l). rewrite H; trivial. unfold WQSetMod.emp, WQSetMod.put in H1. destruct (WQSetMod.beq_A l l). discriminate. destruct (n (refl_equal _)). intros B' l' Q' H3 H4. destruct (WQSetMod.beq_A l' l). subst l'. assert (Q = Q'). assert ((WQSetMod.put B l Q) l = (WQSetMod.put B' l Q') l). rewrite H3; trivial. unfold WQSetMod.put in H5. destruct (WQSetMod.beq_A l l). injection H5; trivial. destruct (n (refl_equal _)). subst Q'. assert (B' = B). apply WQSetMod.extensional_eqMap. intros x. assert (WQSetMod.put B l Q x = WQSetMod.put B' l Q x). rewrite H3; trivial. unfold WQSetMod.put in H5. destruct (WQSetMod.beq_A x l). subst x. unfold WQSetMod.not_in_dom in * . rewrite H0; rewrite H4; trivial. rewrite H5; trivial. subst B'. exists M; exists M'. split_l. split_lr. assert (B = WQSetMod.put (WQSetMod.remove B' l) l' Q'). rewrite <- WQSetMod.remove_ext_ext_remove; trivial. rewrite <- H3. apply WQSetMod.extensional_eqMap. unfold WQSetMod.not_in_dom in H0. unfold WQSetMod.put, WQSetMod.remove. intro x. destruct (WQSetMod.beq_A x l); trivial. subst x; trivial. assert (IH := IHembed_WQSet _ _ _ H5). assert (Hx : WQSetMod.not_in_dom l' (WQSetMod.remove B' l)). apply WQSetMod.remove_shrinks_dom; trivial. substH IH with (IH Hx). clear IHembed_WQSet. destruct IH as [M1 [M2 [HJM [HM1 HM2]]]]. exists (MemMod.merge M1 M'); exists M2. split. disjUnion shift_r. merge commut M2. disjUnion shift_l. elim HJM; intros; subst; trivial. assert (Hy : WQSetMod.maps_to B' l Q). assert ((WQSetMod.put B l Q) l = (WQSetMod.put B' l' Q') l). rewrite H3; trivial. unfold WQSetMod.maps_to. unfold WQSetMod.put in H6. destruct (WQSetMod.beq_A l l'). subst l'; destruct (n (refl_equal _)). destruct (WQSetMod.beq_A l l). auto. destruct (n1 (refl_equal _)). split_r. assert (Hz : B' = WQSetMod.put (WQSetMod.remove B' l) l Q). rewrite WQSetMod.put_cancel_remove. unfold WQSetMod.maps_to, WQSetMod.put in * . apply WQSetMod.extensional_eqMap. intros x. destruct (WQSetMod.beq_A x l); trivial. subst x; trivial. rewrite Hz. apply wq_cons with M1 M'; auto. apply WQSetMod.nid_remove. split_r. disjoint lift_l. Qed. Lemma memsplit_subheap: forall TM tid M0 M, ThrdMemMod.maps_to TM tid M0 -> MemSplit TM M -> MemMod.subseteq M0 M. Proof. intros. unfold ThrdMemMod.maps_to in H. induction H0. unfold ThrdMemMod.emp in H. inversion H. unfold ThrdMemMod.put in H. destruct (ThrdMemMod.beq_A tid tid0). inversion H. rewrite <- H4. apply MemMod.disjUnion_subseteq_right with M';assumption. substH IHMemSplit with (IHMemSplit H). apply MemMod.subseteq_transitivity with M'. assumption. apply MemMod.disjUnion_subseteq_left with M'';assumption. Qed. Lemma neq_beq_false: forall x y, x <> y -> beq_nat x y = false. Proof. double induction x y. intro H;elim H;reflexivity. intros. simpl;reflexivity. intros. simpl;reflexivity. intros. simpl;apply H0. intro P;apply H1;rewrite P;reflexivity. Qed. Lemma WF_Curr_Thrd_pinv: forall Psi S rho p g tag T tid, WF_Curr_Thrd Psi S rho (Ast p g tag) T tid -> rho <> rho_ih -> NH_pinvstar p S. Proof. intros. unfold WF_Curr_Thrd in H. assert (beq_nat rho rho_ih = false). apply neq_beq_false; auto. rewrite H1 in H. unfold itp_NH_theta in H. InvertAll. auto. Qed. Lemma WF_AIM_World_pinv: forall S Psi T B RdyQ tid rho p g tag, rho <> rho_ih -> WF_AIM_World Psi S T B RdyQ tid rho (Ast p g tag) -> imprec (NH_pinvstar p) S. Proof. intros. unfold WF_AIM_World in H0. InvertAll. assert (MemMod.subseteq x0 (S_Mem S)). apply memsplit_subheap with x tid; auto. apply imprec_monotone_S with x0; auto. apply imprec_weaker. apply WF_Curr_Thrd_pinv with Psi rho g tag T tid; auto. Qed. Lemma Itp_AIM_pinv : forall p g tag Psi S rho, Itp_AIM rho (Ast p g tag) Psi S -> rho <> rho_ih -> imprec (NH_pinvstar p) S. Proof. intros. unfold Itp_AIM in H. InvertAll. assert (imprec (fun S => WF_AIM_World Psi S x x0 x1 x2 rho (Ast p g tag)) S). apply pmstar_imprec_p with (embed_curr_TCB x x2 *^* (embed_RdyQ x x1 *^* embed_WQSet x x0)); auto. apply imprec_presv_imprec with (fun S : State => WF_AIM_World Psi S x x0 x1 x2 rho (Ast p g tag)); auto. intros. apply WF_AIM_World_pinv with Psi x x0 x1 x2 rho g tag; auto. Qed. Lemma pinv_imp_p : forall p S, (NH_pinvstar p) S -> (imprec p) S. Proof. intros. unfold NH_pinvstar. apply pmstar_imprec_p with (NH_Inv (S_Flag S)); auto. Qed. Hint Resolve pinv_imp_p. Lemma pflag_monotonic: forall b fl, monotonic_p (fun S => S_Flag S fl = b). Proof. intro. unfold monotonic_p. intros. induction S. induction a. induction a. UnfoldStateAll. auto. Qed. Hint Resolve pflag_monotonic. Lemma pisr_monotonic: forall b, monotonic_p (fun S => S_ISR S = b). Proof. intro. unfold monotonic_p. induction S as (((M, R), fl), isr). UnfoldStateAll. auto. Qed. Hint Resolve pisr_monotonic. Lemma ptrue_monotonic: forall m, monotonic_p (pTrue *<* m). Proof. unfold monotonic_p, pTrue, pmstar. intros m S M H H0. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. simplS. destruct (MemMod.subseteq_split H0) as [M3 H]. exists (MemMod.merge M1 M3); exists M2. split. elim H; intros. elim HJM; intros. split. disjoint des. disjoint lift_r. subst M; rewrite H4. merge assoc M3. merge assoc M2. merge commut M2. trivial. auto. Qed. Lemma monotonic_conj: forall p q, monotonic_p p -> monotonic_p q -> monotonic_p (fun S => p S /\ q S). Proof. unfold monotonic_p. intros p q H H0. intros S Mx H1 H2. destruct H1; split; auto. Qed. Lemma stkSpace_ra : forall sp n m M, (stkSpacePrec sp n *^* m) M -> n >= 2 -> stkSpace sp 2 M. Proof. intros sp n m M H H0. sep on. sep stksplit 2 in H. apply stkSpacePrec_stkSpace1 with mTrue. sep matchH H with 2. Qed. Lemma stkSpace_call_prog: forall S n pc f, (stkSpacePrec (S_RF S SP) n *^* mTrue) (S_Mem S) -> n >= 2 -> exists S' : State, nextS pc (comml (_call f)) S S'. Proof. intros. induction S. induction a. induction a. exists (MemMod.put (MemMod.put a (b1 SP - 2) (pc + 1)) (b1 SP - 2 + 1) 0, RF_update b1 SP (b1 SP-2), b0, b). apply nextS_call; auto. unfold pushW. unfold S_RF in H. unfold S_Mem in H. split. apply stkSpace_ra with n mTrue; auto. split; auto. unfold MemUpd16. exists 0. auto. Qed. Lemma enable_sw_prog: forall p S pc f, imprec p S -> enable_sw p -> exists S' : State, nextS pc (comml (_call f)) S S'. Proof. intros. unfold enable_sw in H0. assert (monotonic_p (fun S => (pTrue*<*(INV0 *^* INV1 *^* stkSpacePrec (S_RF S SP) (_SW_Stk + 2))) S)). unfold monotonic_p. intros. induction S0 as (((M0, R0), fl0), isr0). simplS. simplS in H1. unfold S_Mem in H2. assert (exists M0', MemMod.disjUnion M0 M0' M). apply MemMod.subseteq_split; auto. unfold pmstar in H1. simplS in H1. InvertAll. unfold pmstar. simplS. exists (MemMod.merge x0 x). exists x1. unfold pTrue. split; auto. cut (MemMod.disjUnion x1 (MemMod.merge x0 x) M). auto with PMap. apply MemMod.disjUnion_assoc_left_right; auto. inversion_clear H3; auto with PMap. assert (MemMod.disjUnion x1 x0 M0). auto with PMap. inversion H5. rewrite H8 in H4. auto. assert (forall S0 : State, imprec p S0 -> (pTrue *<* (INV0 *^* INV1 *^* stkSpacePrec (S_RF S0 SP) (_SW_Stk + 2))) S0). apply (imprec_presv_imp_monotonic H1 H0). assert ((pTrue *<* (INV0 *^* INV1 *^* stkSpacePrec (S_RF S SP) (_SW_Stk + 2))) S). apply H2; auto. clear H2 H1 H0 H. apply stkSpace_call_prog with (_SW_Stk + 2); auto. assert (((INV0 *^* INV1 *^* stkSpacePrec (S_RF S SP) (_SW_Stk + 2)) *^* mTrue) (S_Mem S)). apply pTrue_m_mTrue with pTrue; auto. apply mstar_mTrue with (INV0 *^* INV1) mTrue; auto. omega. Qed. Lemma NH_SW_prog_aux : forall psi pc theta Psi rho S, NH_Call_Prim psi pc _SWITCH theta -> Itp_AIM rho theta Psi S -> rho <> rho_ih -> exists S', nextS pc (comml (_call _SWITCH)) S S'. Proof. intros. induction theta. unfold NH_Call_Prim in H. InvertAll. inversion H2. inversion H4. rewrite <- H10 in H6. clear H8 H7 H12 H11 H10 H4 H5 H2 p0 p' g0 g' tag H. assert (imprec (NH_pinvstar p) S). apply Itp_AIM_pinv with g n Psi rho; auto. assert (imprec p S). apply imprec_presv_imprec with (NH_pinvstar p); auto. apply enable_sw_prog with p; auto. assert (_SWITCH <> _BLOCK). auto. contradiction. assert (_SWITCH <> _UNBLK). auto. contradiction. Qed. Lemma WF_Curr_Thrd_imprecp: forall Psi S rho p g tag T tid, WF_Curr_Thrd Psi S rho (Ast p g tag) T tid -> imprec p S. Proof. intros. unfold WF_Curr_Thrd in H. assert (rho = rho_ih \/ rho <> rho_ih). apply nat_eq_neq_dec. inversion_clear H0. rewrite H1 in H. assert (beq_nat rho_ih rho_ih = true). simpl. auto. rewrite H0 in H. InvertAll. unfold itp_IH_theta in H4. inversion_clear H4. inversion_clear H5. unfold lift_IH_PG in H4. InvertAll. apply pmstar_imprec_p with INV1; auto. InvertAll. apply pmstar_imprec_p with INV1; auto. assert (beq_nat rho rho_ih = false). apply neq_beq_false; auto. rewrite H0 in H. unfold itp_NH_theta in H. InvertAll. unfold NH_pinvstar in H. apply pmstar_imprec_p with (NH_Inv (S_Flag S)); auto. Qed. Lemma WF_AIM_World_imprecp: forall S Psi T B RdyQ tid rho p g tag, WF_AIM_World Psi S T B RdyQ tid rho (Ast p g tag) -> imprec p S. Proof. intros. unfold WF_AIM_World in H. InvertAll. assert (MemMod.subseteq x0 (S_Mem S)). apply memsplit_subheap with x tid; auto. apply imprec_monotone_S with x0; auto. apply WF_Curr_Thrd_imprecp with Psi rho g tag T tid; auto. Qed. Lemma Itp_AIM_imprecp : forall p g tag Psi S rho, Itp_AIM rho (Ast p g tag) Psi S -> imprec p S. Proof. intros. unfold Itp_AIM in H. InvertAll. assert (imprec (fun S => WF_AIM_World Psi S x x0 x1 x2 rho (Ast p g tag)) S). apply pmstar_imprec_p with (embed_curr_TCB x x2 *^* (embed_RdyQ x x1 *^* embed_WQSet x x0)); auto. apply imprec_presv_imprec with (fun S : State => WF_AIM_World Psi S x x0 x1 x2 rho (Ast p g tag)); auto. intros. apply WF_AIM_World_imprecp with Psi x x0 x1 x2 rho g tag; auto. Qed. Lemma call_sw_disable_itr_ih: forall psi Psi'0 pc theta S, IH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Itp_AIM rho_ih theta Psi'0 S -> ~ itr_enabled S. Proof. intros. intro. unfold itr_enabled in H1. unfold Itp_AIM in H0. InvertAll. unfold pmstar in H0. InvertAll. unfold WF_AIM_World in H0. InvertAll. unfold WF_Curr_Thrd in H10. assert (beq_nat rho_ih rho_ih = true). simpl. auto. rewrite H12 in H10. InvertAll. unfold itp_IH_theta in H16. inversion_clear H16. induction S as (((M, R), fl), isr). UnfoldStateAll. rewrite H15 in H2. inversion H2. Qed. Lemma subsetCT_presv_lookupCT : forall Psi Psi' f theta0, subsetCT Psi Psi' -> lookupCT Psi f theta0 -> lookupCT Psi' f theta0. Proof. unfold subsetCT. unfold lookupCT. intros. apply OPSpec.lookup_sub_lookup with Psi; auto. Qed. Lemma get_SW_Spec: forall Psi, lookupCT (ext_Prim_Specs Psi) _SWITCH SWITCH_Spec0. Proof. intro. unfold ext_Prim_Specs. unfold lookupCT. unfold consCT. apply OPSpec.lookup_merge_intro. right. apply OPSpec.lookup_merge_intro. right. apply OPSpec.lookup_merge_intro. left. unfold OPSpec.lookup. unfold ListT.In. unfold OPSpec.sig_map. left. auto. Qed. Hint Resolve get_SW_Spec. Lemma get_BLK_Spec: forall Psi, lookupCT (ext_Prim_Specs Psi) _BLOCK BLK_Spec0. Proof. intro. unfold ext_Prim_Specs. unfold lookupCT. unfold consCT. apply OPSpec.lookup_merge_intro. right. apply OPSpec.lookup_merge_intro. left. unfold OPSpec.lookup. unfold ListT.In. unfold OPSpec.sig_map. left. auto. Qed. Hint Resolve get_BLK_Spec. Lemma enter_SW_grt_auxb0_hyp4: forall pc' f S0 S', nextS pc' (comml (_call f)) S0 S' -> (S_Flag S0 _IF = S_Flag S' _IF) /\ (S_ISR S0 = S_ISR S'). Proof. intros pc' f S0 S' H. destruct S0 as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion H) as [HM' [HR' [Hfl' Hisr']]]. simplS. subst fl isr; auto. Qed. Lemma WF_AIM_World_currTCB: forall Psi S T B RdyQ tid rho theta, WF_AIM_World Psi S T B RdyQ tid rho theta -> exists tcb, TQMod.maps_to T tid tcb. Proof. intros. unfold WF_AIM_World in H. InvertAll. unfold WF_currTID in H0. InvertAll. unfold TQMod.in_dom in H9. unfold TQMod.maps_to. auto. Qed. Lemma enbedBlkQ_inWQSet: forall B T w BlkQ M, embed_WQSet T B M -> B w = Some BlkQ -> (ptoTQ w (filterTQ T BlkQ) *^* mTrue) M. Proof. intros. induction H. unfold WQSetMod.emp in H0. inversion H0. unfold WQSetMod.put in H0. induction (WQSetMod.beq_A w l). inversion H0. rewrite H5 in H2. exists M'. exists M. split; auto with PMap. split; auto. rewrite a. auto. unfold mTrue. auto. assert ((ptoTQ w (filterTQ T BlkQ) *^* mTrue) M). apply IHembed_WQSet; auto. assert ((ptoTQ l (filterTQ T Q) *^* (ptoTQ w (filterTQ T BlkQ) *^* mTrue)) M''). exists M'. exists M. split; auto with PMap. sep on. sep lift 1 in H5. sep matchH H5 with 2. Qed. Lemma merge_SW_pre: forall S' pc M1' M2 T tid RdyQ B junk, (S_RF S' SP |-> pc *^* S_RF S' SP + 1 |-> junk *^* stkSpacePrec (S_RF S' SP) 8 *^* mTrue) M1' -> (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M2 -> MemMod.disjUnion M1' M2 (S_Mem S') -> (embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* S_RF S' SP |-> pc *^* S_RF S' SP + 1 |-> junk *^* stkSpacePrec (S_RF S' SP) 8 *^* mTrue) (S_Mem S'). Proof. intros. induction S' as (((M, R), fl), isr). UnfoldStateAll. rename M1' into M1. assert (((R SP |-> pc *^* R SP + 1 |-> junk *^* stkSpacePrec (R SP) 8 *^* mTrue) *^* (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B))) M). exists M1. exists M2. split; auto. sep on. sep lift 4 in H2. sep lift 0. sep match_left H2; auto. sep lift 0 in H2. sep matchH H2 with 5. Qed. Lemma WF_AIM_World_RdyQinT: forall Psi S T B RdyQ tid rho theta, WF_AIM_World Psi S T B RdyQ tid rho theta -> subsetQ_TQ RdyQ T. Proof. intros. unfold subsetQ_TQ. intros. unfold WF_AIM_World in H. InvertAll. unfold WF_ReadyQ in H7. assert (exists tcb : Thread, TQMod.maps_to T tid0 tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to x tid0 M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi M tcb \/ WF_Rdy_Thrd_IH Psi M tcb))). apply H7; auto. InvertAll. unfold TQMod.in_dom. exists x1. auto. Qed. Lemma WF_AIM_World_cthNotRdy: forall Psi S T B RdyQ tid rho theta, WF_AIM_World Psi S T B RdyQ tid rho theta -> WQMod.not_in_dom tid RdyQ. Proof. intros. unfold WF_AIM_World in H. destruct H as [H H1]. unfold WF_currTID in H. destruct H as [H2 [H3 H4]]. assumption. Qed. Lemma WF_AIM_World_WFTQ: forall Psi S T B RdyQ tid rho theta, WF_AIM_World Psi S T B RdyQ tid rho theta -> WF_TQ T. Proof. intros. unfold WF_AIM_World in H. InvertAll. unfold WF_TWQ in H1. InvertAll. auto. Qed. Lemma WF_AIM_World_existsIdle: forall Psi S T B RdyQ tid rho theta, WF_AIM_World Psi S T B RdyQ tid rho theta -> exists_Idle T RdyQ tid. Proof. intros. unfold WF_AIM_World in H. InvertAll. auto. Qed. Lemma WF_AIM_World_BlkQinT: forall Psi S T B RdyQ tid rho theta w BlkQ, WF_AIM_World Psi S T B RdyQ tid rho theta -> B w = Some BlkQ -> subsetQ_TQ BlkQ T. Proof. intros. unfold subsetQ_TQ. intros. unfold WF_AIM_World in H. InvertAll. unfold WF_WQSet in H10. assert (exists tcb : Thread, exists M : Mem, TQMod.maps_to T tid0 tcb /\ ThrdMemMod.maps_to x tid0 M /\ WF_Wait_Thrd Psi M tcb w). apply H10 with BlkQ; auto. InvertAll. unfold TQMod.in_dom. exists x1. auto. Qed. Fixpoint disjUnionList (l : list Mem) (M: Mem) {struct l}: Prop := match l with nil => (M = MemMod.emp) | (M0 :: l') => exists M', disjUnionList l' M' /\ MemMod.disjUnion M0 M' M end. (* disjUnionList ==> eqM list by guoyu *) Lemma disjUnionList_elim : forall l M, disjUnionList l M -> M ||- itr mEq l. Proof. induction l; simpl; intros. subst M. sep trivial. destruct H as [M' [H1 H2]]. exists a; exists M'; split_l. split. unfold mEq; trivial. sep on. apply IHl; trivial. Qed. Implicit Arguments disjUnionList_elim [l M]. Lemma disjUnionList_intro : forall l M, M ||- itr mEq l -> disjUnionList l M. Proof. induction l; simpl; intros. sep elim H; trivial. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. unfold mEq in HM1. subst a. exists M2; auto. Qed. Implicit Arguments disjUnionList_intro [l M]. (* disjUnionList ==> eqM list by Xinyu *) Definition eqM (M M': Mem) : Prop := M = M'. Fixpoint DUL2mstar (dul : list Mem) {struct dul} : MPred := match dul with nil => Aemp | M :: dul' => eqM M *^* (DUL2mstar dul') end. Lemma DUL2mstar_left: forall dul M, disjUnionList dul M -> DUL2mstar dul M. Proof. intro dul. induction dul. unfold disjUnionList. unfold DUL2mstar. unfold Aemp. auto. unfold disjUnionList. fold disjUnionList. unfold DUL2mstar. fold DUL2mstar. intros. inversion_clear H. exists a. exists x. inversion_clear H0. split_l. unfold eqM. split_l. apply IHdul; auto. Qed. Lemma DUL2mstar_right: forall dul M, DUL2mstar dul M -> disjUnionList dul M. Proof. intro dul. induction dul. unfold disjUnionList. unfold DUL2mstar. unfold Aemp. auto. unfold disjUnionList. fold disjUnionList. unfold DUL2mstar. fold DUL2mstar. intros. unfold mstar in H. InvertAll. unfold eqM in H. subst x. exists x0. split; auto. Qed. Lemma mem_list_compose_a: forall cthM11 cthM12 cthM1 cthM2 cthM M12 M1 M2 M, MemMod.disjUnion cthM11 cthM12 cthM1 -> MemMod.disjUnion cthM1 cthM2 cthM -> MemMod.disjUnion M12 cthM M1 -> MemMod.disjUnion M1 M2 M -> disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11 :: nil) M. Proof. intros. unfold disjUnionList. exists M1. split; auto with PMap. exists cthM. split; auto. exists cthM1. split; auto with PMap. exists cthM11. split; auto with PMap. exists MemMod.emp. split; auto with PMap. Qed. Lemma ptoxW_elim1 : forall M l m, (M ||- l |->w_ *^* m) -> M ||- l |->_ *^* l+1 |->_ *^* m. Proof. intros M l m H. assert (exists x, M ||- l |->w x *^* m). apply ptoxW_ptoW1; auto. inversion_clear H0. assert (exists y, M ||- l |-> x *^* l + 1 |-> y *^* m). apply ptoW_elim1; auto. inversion H0. sep matchH H2 with 3. assert (h ||- l |->_ *^* l + 1 |-> x0). apply pto_ptox1 with x; auto. sep lift 1 in H3. sep lift 1. apply pto_ptox1 with x0; auto. Qed. Lemma call_sw_frame: forall M M' R R' fl fl' isr isr' M2 M12 cthM2 cthM12 cthM11 pc, disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11 :: nil) M -> stkSpacePrec (R SP) (8 + 2) cthM11 -> nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> (exists junk, (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk *^* (stkSpacePrec (R' SP) 8)) (MemUpdW cthM11 (R' SP) (pc + 1) junk) /\ disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: (MemUpdW cthM11 (R' SP) (pc + 1) junk) :: nil) M'). Proof. intros. destruct (nextS_inversion H1). clear H1. InvertAll. substH H7 with (MemUpd16_MemUpdW H7). destruct H7 as [junk H7]. exists junk. split. sep on. unfold MemUpdW. sep lift 1. sep upd2. sep lift 2. sep upd2. sep stksplit in H0. sep lift 1 in H0. sep lift 2. sep lift 1 in H0. subst R'. reg simpl. auto. substH H with (disjUnionList_elim H). apply disjUnionList_intro. simpl. simpl in H. subst M'. sep lift 4. subst R'. reg simpl. apply meq_update1. sep matchH H with 4. sep on. sep stksplit in H0. sep lift 1 in H0. sep trivial. Qed. Lemma mem_list_compose_b: forall M' M21 M22 M2 M12 cthM2 cthM12 cthM11', MemMod.disjUnion M21 M22 M2 -> disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11' :: nil) M' -> exists M1', exists M2', MemMod.disjUnion cthM11' M21 M1' /\ disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' /\ MemMod.disjUnion M1' M2' M'. Proof. intros. assert (disjUnionList (M21 :: cthM11' :: M22 :: M12 :: cthM2 :: cthM12 :: nil) M'). substH H0 with (disjUnionList_elim H0). apply disjUnionList_intro. unfold itr in * . sep matchH H0 with 6. exists M21;exists M22. unfold mEq. intuition. assert (M' ||- (mEq M2)). sep matchH H0 with 2. unfold mEq in H1. sep off. subst M2;assumption. clear H0. simpl in H1. destruct H1 as [MM1 [H1 H2]]. destruct H1 as [MM2 [H1 H3]]. exists (MemMod.merge M21 cthM11');exists MM2. intuition. assert (MemMod.disjoint cthM11' M21). disjoint lift_l. split. assumption. auto with PMap. destruct H3. apply MemMod.disjUnion_assoc_right_left. assumption. subst MM1;assumption. Qed. Lemma mem_compose_c: forall cthM11' M21 M1' sp pc junk T tid RdyQ, MemMod.disjUnion cthM11' M21 M1' -> (sp |-> pc *^* sp + 1 |-> junk *^* stkSpacePrec sp 8) cthM11' -> (embed_curr_TCB T tid *^* embed_RdyQ T RdyQ) M21 -> SW_MPre T RdyQ tid sp pc junk M1'. Proof. intros. sep on. assert (P := sconj_intro H0 H1 H). unfold SW_MPre. sep matchH P with 5. Qed. Lemma unique_remain: forall tid tid' RdyQ RdyQ', WQMod.not_in_dom tid RdyQ -> WQMod.not_in_dom tid' RdyQ' -> addThrd RdyQ tid = addThrd RdyQ' tid' -> tid = tid' -> RdyQ = RdyQ'. Proof. intros. rewrite H2 in H ;rewrite H2 in H1. (* inclear H2. *) apply WQMod.extensional_eqMap. intro x. unfold addThrd in H1. destruct (WQMod.beq_A tid' x). subst. unfold WQMod.not_in_dom in * . rewrite H;rewrite H0;reflexivity. substH H with (WQMod.put_noninterfere RdyQ dummy_sglton n). substH H0 with (WQMod.put_noninterfere RdyQ' dummy_sglton n). rewrite <- H;rewrite <- H0;rewrite H1;reflexivity. Qed. Lemma enter_SW_grt_aux60: forall T RdyQ tid sp tcb pc junk sp' tcb' S0 M0', SW_Post_aux (TQMod.put T tid (sp, TCB_Status tcb, pc)) RdyQ tid sp' sp tcb' pc junk (S_Mem_Upd S0 M0') -> sp' = sp. Proof. intros. unfold SW_Post_aux in H. InvertAll. assert (tcb' = (sp, TCB_Status tcb, pc)). assert (TQMod.maps_to (TQMod.put T tid (sp, TCB_Status tcb, pc)) tid (sp, TCB_Status tcb, pc)). auto with PMap. unfold TQMod.maps_to in H3. unfold TQMod.maps_to in H. rewrite H3 in H. inversion_clear H. auto. rewrite H3 in H1. unfold TCB_SP in H1. auto. Qed. Lemma enter_sw_grt_hyp1: forall T RdyQ tid sp pc junk S0 M0' M2', SW_MPost T RdyQ tid sp pc junk (S_Mem (S_Mem_Upd S0 M0')) -> S_RF (S_Mem_Upd S0 M0') SP = sp -> MemMod.disjUnion M0' M2' (S_Mem S0) -> Ret_Addr pc S0. Proof. unfold SW_MPost; unfold Ret_Addr. simpl. intros. apply nextPC_retw with sp. assumption. sep on. assert (M0' ||- sp |->w pc *^* (embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* stkSpacePrec sp 8)). apply ptoW_intro1 with junk. sep matchH H with 5. clear H. assert ((sp |~>w pc) M0'). apply ptoW_leadsToW1 with (embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* stkSpacePrec sp 8); auto. sep off. eapply leadsToW_Mono; eauto. Qed. Lemma enter_SW_grt_aux7: forall T RdyQ tid sp tcb pc junk sp' tcb' S0 M0' M2', SW_Post_aux (TQMod.put T tid (sp, TCB_Status tcb, pc)) RdyQ tid sp' sp tcb' pc junk (S_Mem_Upd S0 M0') -> MemMod.disjUnion M0' M2' (S_Mem S0) (* -> (S_RF S0 SP = sp) : need to add this line *) -> Ret_Addr pc S0. Proof. intros. assert (sp' = sp). apply enter_SW_grt_aux60 with T RdyQ tid tcb pc junk tcb' S0 M0'; auto. unfold SW_Post_aux in H. InvertAll. apply enter_sw_grt_hyp1 with (TQMod.put T tid (sp, TCB_Status tcb, pc)) RdyQ tid sp junk M0' M2'; auto. rewrite H1 in H4. auto. Qed. Lemma enter_SW_grt_hyp2: forall T RdyQ tid sp pc junk M, SW_MPost T RdyQ tid sp pc junk M -> exists M21_0, exists cthM11_0, (embed_curr_TCB T tid *^* embed_RdyQ T RdyQ) M21_0 /\ (sp |-> pc *^* sp + 1 |-> junk *^* stkSpacePrec sp 8) cthM11_0 /\ MemMod.disjUnion M21_0 cthM11_0 M. Proof. intros. unfold SW_MPost in H. sep on. assert (M ||- (embed_curr_TCB T tid *^* embed_RdyQ T RdyQ) *^* (sp |-> pc *^* sp+1 |-> junk *^* stkSpacePrec sp 8)). sep matchH H with 5. destruct H0 as [M1 [M2 P]]. exists M1;exists M2;intuition. Qed. Lemma disjUnionList_split2: forall M1 M2 M ML, disjUnionList (M1 :: M2 ::ML) M -> exists M'1, exists M'2, disjUnionList ML M'1 /\ MemMod.disjUnion M1 M2 M'2 /\ MemMod.disjUnion M'1 M'2 M. Proof. intros. destruct H as [M1' [H H1]]. destruct H as [M2' [H H2]]. exists M2';exists (MemMod.merge M1 M2). intuition. split. disjoint lift_r. reflexivity. apply (MemMod.disjUnion_commut). split. apply MemMod.disj_merge_B. disjoint lift_r. destruct H2;assumption. assert (MemMod.merge M1 (MemMod.merge M2 M2') = (MemMod.merge (MemMod.merge M1 M2) M2')). auto with PMap. rewrite <- H0. destruct H2;destruct H1. rewrite <- H3;rewrite <- H4. reflexivity. Qed. Lemma disjUnionList_merge2: forall M1 M2 M ML M1' M2', disjUnionList ML M1' -> MemMod.disjUnion M1 M2 M2' -> MemMod.disjUnion M2' M1' M -> disjUnionList (M1 :: M2 :: ML) M. Proof. intros. exists (MemMod.merge M2 M1'). split. exists M1'. intuition. split. disjoint lift_l. reflexivity. split. apply MemMod.disj_merge_A. destruct H0;assumption. disjoint lift_l. assert (MemMod.merge (MemMod.merge M1 M2) M1' = MemMod.merge M1 (MemMod.merge M2 M1')). auto with PMap. rewrite <- H2. destruct H0;destruct H1. rewrite <- H3; rewrite <- H4. reflexivity. Qed. Lemma enter_SW_grt_hyp4: forall M21_0 M22 M12 cthM2 cthM12 cthM11'' S', disjUnionList (M21_0 :: M22 :: M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) (S_Mem S') -> exists M'1, exists M'2, disjUnionList (M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) M'1 /\ MemMod.disjUnion M21_0 M22 M'2 /\ MemMod.disjUnion M'1 M'2 (S_Mem S'). Proof. intros. apply disjUnionList_split2. assumption. Qed. Lemma enter_SW_grt_aux5: forall M12 cthM2 cthM12 cthM11'' M'1, disjUnionList (M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) M'1 -> exists cthM', MemMod.disjUnion M12 cthM' M'1 /\ disjUnionList (cthM2 :: cthM12 :: cthM11'' :: nil) cthM'. Proof. intros. unfold disjUnionList in H. inversion H. exists x. inversion H0. split; auto. Qed. Hint Resolve enter_SW_grt_aux5. Lemma enter_SW_grt_hyp6: forall TM tid M12 cthM' M'1, MemSplit (ThrdMemMod.remove TM tid) M12 -> MemMod.disjUnion M12 cthM' M'1 -> MemSplit (ThrdMemMod.put TM tid cthM') M'1. Proof. intros. assert (ThrdMemMod.put TM tid cthM'= ThrdMemMod.put (ThrdMemMod.remove TM tid) tid cthM'). auto with PMap. rewrite H1. apply MS_split with M12;try assumption. auto with PMap. Qed. Lemma enter_SW_grt_aux8: forall T T' RdyQ tid sp sp' tcb tcb' pc pc' junk S0 S' M0' M2' M22 M12 cthM2 cthM12, SW_Post_aux T' RdyQ tid sp' sp tcb' pc junk (S_Mem_Upd S0 M0') -> nextS pc' (comms _retw) S0 S' -> MemMod.disjUnion M0' M2' (S_Mem S0) -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' -> T' = TQMod.put T tid (sp, TCB_Status tcb, pc) -> exists M21_0, exists cthM11'', ((S_RF S' SP - 2) |-> pc *^* (S_RF S' SP - 2 + 1) |-> junk *^* stkSpacePrec (S_RF S' SP - 2) 8) cthM11'' /\ (embed_curr_TCB T' tid *^* embed_RdyQ T' RdyQ) M21_0 /\ disjUnionList (M21_0 :: M22 :: M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) (S_Mem S'). Proof. intros. assert (sp' = sp). apply enter_SW_grt_aux60 with T RdyQ tid tcb pc junk tcb' S0 M0'; auto. rewrite H3 in H. auto. unfold SW_Post_aux in H. InvertAll. assert (exists M21_0, exists cthM11_0, (embed_curr_TCB T' tid *^* embed_RdyQ T' RdyQ) M21_0 /\ (sp |-> pc *^* sp+1 |-> junk *^* stkSpacePrec sp 8) cthM11_0 /\ MemMod.disjUnion M21_0 cthM11_0 M0'). apply enter_SW_grt_hyp2; auto. InvertAll. rename x into M21_0. rename x0 into cthM11_0. exists M21_0. induction S0 as (((Mx, Rx), flx), isrx). induction S' as (((My, Ry), fly), isry). UnfoldStateAll. subst sp'. destruct (nextS_inversion H0). subst My. clear H0. exists cthM11_0. InvertAll. subst Ry. reg simpl. assert (Rx SP + 2 - 2 = Rx SP). auto. rewrite H4. rewrite H7. split_l. split_l. assert ((eqM M21_0 *^* eqM cthM11_0 *^* (DUL2mstar (M22 :: M12 :: cthM2 :: cthM12 :: nil))) Mx). exists M0'. exists M2'. split_l. split. exists M21_0. exists cthM11_0. unfold eqM. auto. apply DUL2mstar_left; auto. cut (DUL2mstar (M21_0 :: M22 :: M12 :: cthM2 :: cthM12 :: cthM11_0 :: nil) Mx). intro. apply DUL2mstar_right; auto. unfold DUL2mstar in *. sep on. sep matchH H14 with 7. Qed. (* chaged because of the change of WF_currTID *) Lemma WF_currTID_ext_T : forall T B RdyQ tid tcb tcb' rho, WF_currTID tid T B RdyQ rho -> T tid = Some tcb -> TCB_Status tcb = TCB_Status tcb' -> WF_currTID tid (TQMod.put T tid tcb') B RdyQ rho. Proof. unfold WF_currTID. intros. InvertAll. split; auto. split; auto. split. auto with PMap. exists tcb'. rewrite <- H1. split; auto. split. unfold TQMod.maps_to in H5. rewrite H5 in H0. inversion H0. rewrite <- H8. auto. unfold rho_tcb_consistent in H7. unfold rho_tcb_consistent. rewrite <- H1. unfold TQMod.maps_to in H5. rewrite H5 in H0. inversion H0. rewrite H8 in H7. auto. Qed. Lemma WF_TWQ_ext_T: forall T B RdyQ tid tcb, WF_TWQ T B RdyQ -> (exists tcb, T tid = Some tcb) -> WQMod.not_in_dom tid RdyQ -> WF_TWQ (TQMod.put T tid tcb) B RdyQ. Proof. unfold WF_TWQ. intros. split; auto. unfold WF_TQ. intros. InvertAll. unfold WF_TQ in H3. apply H3. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H0. rewrite H6. unfold TQMod.in_dom. exists x. auto. unfold TQMod.in_dom in H2. InvertAll. unfold TQMod.put in H0. induction (TQMod.beq_A tid0 tid). contradiction. unfold TQMod.in_dom. exists x0. auto. InvertAll. split; auto. Qed. Lemma exists_Idle_ext_T: forall T RdyQ tid tcb sp pc, exists_Idle T RdyQ tid -> T tid = Some tcb -> WQMod.not_in_dom tid RdyQ -> exists_Idle (TQMod.put T tid (sp, TCB_Status tcb, pc)) RdyQ tid. Proof. unfold exists_Idle. intros. inversion_clear H. left. inversion_clear H2. inversion_clear H. unfold TQMod.maps_to in H2. rewrite H2 in H0. inversion H0. rewrite H4 in H3. rewrite H3. exists (sp, IDLE, pc). split; auto with PMap. right. InvertAll. exists x. exists x0. split; auto. split; auto. unfold TQMod.maps_to. unfold TQMod.maps_to in H2. cut (tid <> x). intro. unfold TQMod.put. induction (TQMod.beq_A x tid). absurd (x <> tid); auto. auto. unfold WQMod.not_in_dom in H1. unfold WQMod.in_dom in H. assert (tid = x \/ tid <> x). apply nat_eq_neq_dec. inversion_clear H3; auto. rewrite H5 in H1. rewrite H1 in H. InvertAll. inversion_clear H3. Qed. Lemma enter_SW_grt_hyp9: forall pc pc' f S S1 S2 S3, nextS pc (comml (_call f)) S S1 -> S_ISR S1 = S_ISR S2 -> S_Flag S1 _IF = S_Flag S2 _IF -> nextS pc' (comms _retw) S2 S3 -> S_ISR S = S_ISR S3 /\ S_Flag S _IF = S_Flag S3 _IF. Proof. intros. inversion H;subst. inversion H2;subst. simpl in * . intuition. Qed. Lemma step_call_hyp: forall pc f M R fl isr M' R' fl' isr' cthM11 cthM12 cthM1 n, nextS pc (comml (_call f)) (M, R, fl, isr) (M', R', fl', isr') -> stkSpacePrec (R SP) (n + 2) cthM11 -> MemMod.disjUnion cthM11 cthM12 cthM1 -> nextS pc (comml (_call f)) (cthM1, R, fl, isr) (MemMod.merge cthM12 (MemMod.put cthM11 (R SP - 2) (pc + 1)), R', fl', isr'). Proof. intros. inversion H;subst. apply nextS_call. unfold pushW in * . destruct H5 as [P1 [P2 P3]]. assert (stkSpace (R SP) 2 cthM11). apply stkSpace_weaken with (n+2). apply stkSpacePrec_stkSpace;assumption. omega. assert (stkSpace (R SP) 2 cthM1). apply stkSpace_Mono with cthM11 cthM12. assumption. assumption. intuition. destruct H3. assert (2>1). omega. substH H4 with (leadsToBlk_leadsToxW H4 H5). substH H4 with (leadsToxW_elim1 H4). destruct H4. exists x. assert (MemMod.put (MemMod.put cthM1 (R SP - 2) (pc + 1)) (R SP - 2 + 1) x = MemMod.put cthM1 (R SP - 2) (pc + 1)). apply MemMod.extensional_eqMap;intro. unfold MemMod.put. destruct (MemMod.beq_A x0 (R SP - 2 + 1)). destruct (MemMod.beq_A x0 (R SP -2)). rewrite <- e0 in e. assert (x0 <> x0 +1). omega. contradiction. rewrite e;symmetry;assumption. reflexivity. rewrite H6. symmetry. destruct H1. subst. assert (MemMod.disjUnion (MemMod.put cthM11 (R SP - 2) (pc + 1)) cthM12 (MemMod.put (MemMod.merge cthM11 cthM12) (R SP - 2) (pc + 1))). split. apply MemMod.disjoint_commut. apply MemMod.update_presv_disj_right. apply MemMod.disjoint_commut;assumption. destruct H2. substH H7 with (leadsToBlk_leadsToxW H7 H5). substH H7 with (leadsToxW_elim H7). unfold MemMod.in_dom;assumption. apply MemMod.put_merge_merge_put. substH H7 with (MemMod.disjUnion_commut H7). destruct H7;assumption. Qed. Lemma enter_SW_grt_auxb0_hyp0: forall pc M R fl isr M' R' fl' isr' f, nextS pc (comml (_call f)) (M, R, fl, isr) (M', R', fl', isr') -> R SP - 2 = R' SP. Proof. intros. inversion H;subst. unfold pushW in H3. destruct H3 as [H4 [H5 H6]]. subst. symmetry. apply RF_update_RF. Qed. Lemma enter_SW_grt_auxb0_hyp1: forall pc S0 S', nextS pc (comms _retw) S0 S' -> S_RF S' SP = S_RF S0 SP + 2. Proof. intros. inversion H;subst. destruct H0 as [pc' [H1 H2]]. subst. simpl. apply RF_update_RF. Qed. Lemma enter_SW_grt_auxb0_hyp3: forall pc' S0 S', nextS pc' (comms _retw) S0 S' -> (S_Flag S0 _IF = S_Flag S' _IF) /\ (S_ISR S0 = S_ISR S'). Proof. intros. inversion H;subst. simpl. intuition. Qed. Lemma enter_SW_grt_auxb0_hyp5: forall pc S0 S' M M' x y m, nextS pc (comms _retw) S0 S' -> MemMod.disjoint M M' -> (S_RF S0 SP |-> x *^* S_RF S0 SP + 1 |-> y *^* m) M -> nextS pc (comms _retw) (S_Mem_Upd S0 (MemMod.merge M' M)) (S_Mem_Upd S' (MemMod.merge M' M)). Proof. intros. inversion H;subst. unfold S_Mem_Upd. simpl. apply nextS_retw. destruct H2 as [pc' [P1 P2]]. exists x. split. assert (MemMod.disjUnion M M' (MemMod.merge M' M)). split; auto with PMap. apply leadsToW_Mono with M M'. auto. simplS in H1. assert ((R SP |->w x *^* m) M). apply ptoW_intro1 with y; auto. sep on. sep trivial. auto. Qed. Lemma enter_BLK_grt2_auxc_hyp01: forall l m M, (l |->w_ *^* m) M -> MemMod.in_dom l M. Proof. intros. assert (MemMod.in_dom l M /\ MemMod.in_dom (l+1) M). apply ptoxW_indom1 with m; auto. inversion H0; auto. Qed. Lemma enter_BLK_grt2_auxc_hyp02: forall l m M, (l |->w_ *^* m) M -> MemMod.in_dom (l+1) M. intros. assert (MemMod.in_dom l M /\ MemMod.in_dom (l+1) M). apply ptoxW_indom1 with m; auto. inversion H0; auto. Qed. Lemma step_call_hyp1: forall pc f M R fl isr M' R' fl' isr' cthM11 cthM12 cthM1 n junk, nextS pc (comml (_call f)) (M, R, fl, isr) (M', R', fl', isr') -> stkSpacePrec (R SP) (n + 2) cthM11 -> MemMod.disjUnion cthM11 cthM12 cthM1 -> nextS pc (comml (_call f)) (cthM1, R, fl, isr) (MemMod.merge cthM12 (MemUpdW cthM11 (R SP - 2) (pc + 1) junk), R', fl', isr'). Proof. intros. destruct (nextS_inversion H). InvertAll. subst isr' fl'. apply nextS_call. unfold pushW. split. assert ((stkSpacePrec (R SP) (n + 2) *^* eqM cthM12) cthM1). exists cthM11. exists cthM12. split_l. unfold eqM. split; auto. sep on. sep stksplit 2 in H3. sep lift 0 in H3. sep trivial. subst R'. split; auto. assert (MemMod.disjUnion cthM12 cthM11 cthM1). auto with PMap. clear H1. assert (MemMod.disjUnion cthM12 (MemUpdW cthM11 (R SP - 2) (pc + 1) junk) (MemUpdW cthM1 (R SP - 2) (pc + 1) junk)). sep on. sep stksplit in H0. sep lift 1 in H0. assert (MemMod.in_dom (R SP - 2) cthM11). apply enter_BLK_grt2_auxc_hyp01 with (stkSpacePrec (R SP - 2) (n + 2 - 2)). auto. assert (MemMod.in_dom (R SP - 2 + 1) cthM11). apply enter_BLK_grt2_auxc_hyp02 with (stkSpacePrec (R SP - 2) (n + 2 - 2)). auto. sep off. unfold MemUpdW. apply MemMod.update_presv_disjUnion_right. apply MemMod.update_presv_disjUnion_right. auto. auto. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (R SP - 2 + 1) (R SP - 2)). exists (pc+1). auto. auto. inversion_clear H1. rewrite <- H6. apply MemUpdW_MemUpd16 with junk; auto. Qed. Lemma enter_SW_grt_auxb0_hyp21: forall sp n M w w1, stkSpacePrec (sp + 2) (n + 2) M -> (sp |-> w *^* sp + 1 |-> w1 *^* stkSpacePrec sp n) (MemUpdW M sp w w1). Proof. intros. sep on. unfold MemUpdW. sep lift 1. sep upd2. sep lift 2. sep upd2. sep stksplit in H. sep lift 2. sep match_left H; auto. Qed. Lemma enter_SW_grt_auxb0_hyp22: forall cthM11 cthM12 cthM11' cthM12_1 cthM12_2 cthM11'_1 cthM11'_2 sp pc junk, MemMod.disjUnion cthM12_1 cthM12_2 cthM12 -> MemMod.disjoint cthM11 cthM12 -> cthM11' = MemUpdW cthM11 sp pc junk -> MemMod.disjUnion cthM11'_1 cthM11'_2 cthM11' -> stkSpacePrec (sp + 2) (8 + 2) cthM11 -> MemMod.disjoint cthM12_1 cthM11'_1. Proof. intros. assert (MemMod.disjUnion cthM11' cthM12 (MemUpdW (MemMod.merge cthM11 cthM12) sp pc junk)). subst cthM11'. unfold MemUpdW. assert (MemMod.in_dom sp cthM11 /\ MemMod.in_dom (sp+1) cthM11). sep on. sep stksplit in H3. sep lift 1 in H3. apply ptoxW_indom1 with (stkSpacePrec sp 8); auto. inversion_clear H1. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left. split; auto. auto. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (sp + 1) sp); auto. exists pc. auto. set (Mx := (MemUpdW (MemMod.merge cthM11 cthM12) sp pc junk)) in *. assert ((eqM cthM11'_1 *^* eqM cthM11'_2 *^* (eqM cthM12_1 *^* eqM cthM12_2)) Mx). exists cthM11'. exists cthM12. split_l. split. exists cthM11'_1. exists cthM11'_2. unfold eqM. auto. exists cthM12_1. exists cthM12_2. unfold eqM. auto. assert ((eqM cthM12_1 *^* eqM cthM11'_1 *^* (eqM cthM11'_2 *^* eqM cthM12_2)) Mx). sep on. sep matchH H5 with 4. unfold mstar in H6. unfold eqM in H6. InvertAll. subst x3 x4. auto. inversion H10; auto. Qed. Lemma enter_SW_grt_auxb0_hyp23: forall cthM12 cthM11'' cthM12_1 cthM12_2 cthM11''_1 cthM11''_2, MemMod.disjUnion cthM12_1 cthM12_2 cthM12 -> MemMod.disjoint cthM11'' cthM12 -> MemMod.disjUnion cthM11''_1 cthM11''_2 cthM11'' -> MemMod.disjoint cthM12_1 cthM11''_1. Proof. intros. inversion_clear H1. subst cthM11''. assert (MemMod.disjoint cthM11''_1 cthM12). apply MemMod.disj_merge_disj_left with cthM11''_2; auto. inversion_clear H. subst cthM12. apply MemMod.disj_merge_disj_left with cthM12_2; auto with PMap. Qed. Lemma enter_SW_grt_auxb0_hyp24: forall cthM11 cthM12 cthM11' cthM12_1 cthM12_2 cthM11'_1 cthM11'_2 sp pc junk, MemMod.disjUnion cthM12_1 cthM12_2 cthM12 -> MemMod.disjoint cthM11 cthM12 -> cthM11' = MemUpdW cthM11 sp pc junk -> MemMod.disjUnion cthM11'_1 cthM11'_2 cthM11' -> stkSpacePrec (sp + 2) (8 + 2) cthM11 -> MemMod.disjUnion (MemMod.merge cthM12_1 cthM11'_1) (MemMod.merge cthM12_2 cthM11'_2) (MemMod.merge cthM12 cthM11'). Proof. intros. assert (MemMod.disjUnion cthM11' cthM12 (MemUpdW (MemMod.merge cthM11 cthM12) sp pc junk)). subst cthM11'. unfold MemUpdW. assert (MemMod.in_dom sp cthM11 /\ MemMod.in_dom (sp+1) cthM11). sep on. sep stksplit in H3. sep lift 1 in H3. apply ptoxW_indom1 with (stkSpacePrec sp 8); auto. inversion_clear H1. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left; auto. split; auto. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (sp + 1) sp); auto. exists pc. auto. set (Mx := (MemUpdW (MemMod.merge cthM11 cthM12) sp pc junk)) in *. assert ((eqM cthM11'_1 *^* eqM cthM11'_2 *^* (eqM cthM12_1 *^* eqM cthM12_2)) Mx). exists cthM11'. exists cthM12. split_l. split. exists cthM11'_1. exists cthM11'_2. unfold eqM. auto. exists cthM12_1. exists cthM12_2. unfold eqM. auto. assert ((eqM cthM12_1 *^* eqM cthM11'_1 *^* (eqM cthM12_2 *^* eqM cthM11'_2)) Mx). sep on. sep matchH H5 with 4. assert (MemMod.disjUnion cthM12 cthM11' Mx); auto with PMap. inversion_clear H7. rewrite <- H9. unfold mstar in H6. unfold eqM in H6. InvertAll. subst x1 x2 x3 x4. inversion_clear H10. inversion_clear H12. subst x0 x. auto. Qed. Lemma enter_SW_grt_auxb0_hyp25: forall cthM12 cthM11'' cthM12_1 cthM12_2 cthM11''_1 cthM11''_2, MemMod.disjUnion cthM12_1 cthM12_2 cthM12 -> MemMod.disjoint cthM11'' cthM12 -> MemMod.disjUnion cthM11''_1 cthM11''_2 cthM11'' -> MemMod.disjUnion (MemMod.merge cthM12_1 cthM11''_1) (MemMod.merge cthM12_2 cthM11''_2) (MemMod.merge cthM12 cthM11''). Proof. intros. assert (MemMod.disjUnion cthM12 cthM11'' (MemMod.merge cthM12 cthM11'')). split; auto with PMap. assert ((eqM cthM12_1 *^* eqM cthM12_2 *^* (eqM cthM11''_1 *^* eqM cthM11''_2)) (MemMod.merge cthM12 cthM11'')). exists cthM12. exists cthM11''. split_l. split. exists cthM12_1. exists cthM12_2. unfold eqM. auto. exists cthM11''_1. exists cthM11''_2. unfold eqM. auto. assert ((eqM cthM12_1 *^* eqM cthM11''_1 *^* (eqM cthM12_2 *^* eqM cthM11''_2)) (MemMod.merge cthM12 cthM11'')). sep on. sep matchH H3 with 4. clear H3. unfold mstar in H4. unfold eqM in H4. InvertAll. subst x1 x2 x3 x4. inversion_clear H5. inversion_clear H7. subst x x0. auto. Qed. Lemma enter_SW_grt_auxb0_hyp26: forall sp pc junk cthM11'_2 cthM11''_2, (sp |-> pc *^* sp + 1 |-> junk) cthM11'_2 -> (sp |-> pc *^* sp + 1 |-> junk) cthM11''_2 -> cthM11'_2 = cthM11''_2. Proof. intros. assert (uniqueM (sp |-> pc *^* sp + 1 |-> junk)). apply mstar_presv_uniqueM; apply pto_uniqueM. unfold uniqueM in H1. apply H1; auto. Qed. Lemma enter_SW_grt_auxb0_hyp2: forall cthM12 cthM11 cthM11'' S' R' pc fl' isr' S0 sp junk, (INV0 *^* INV1 *^* mTrue) cthM12 -> stkSpacePrec sp (8 + 2) cthM11 -> (S_RF S' SP - 2 |-> pc *^* S_RF S' SP - 2 + 1 |-> junk *^* stkSpacePrec (S_RF S' SP - 2) 8) cthM11'' -> S_RF S' SP = (R' SP) + 2 -> sp - 2 = (R' SP) -> MemMod.disjoint cthM11 cthM12 -> MemMod.disjoint cthM11'' cthM12 -> prepost (INV0 *^* INV1 *^* stkSpacePrec (R' SP) _SW_Stk) (INV0 *^* INV1 *^* stkSpacePrec (R' SP) _SW_Stk) (MemMod.merge cthM12 (MemUpdW cthM11 (R' SP) pc junk), R', fl', isr') (S_Mem_Upd S0 (MemMod.merge cthM12 cthM11'')). Proof. unfold prepost. intros. induction S0 as (((M0, R0), fl0), isr0). simplS. clear M0 R0 fl0 isr0. destruct H as [cthM12_1 [chtM12_2 [HcthM12split [HcthM12_1 HcthM12_2]]]]. set (cthM11' := MemUpdW cthM11 (R' SP) pc junk). assert (sp >= 2). apply ge_trans with (8 + 2); auto with arith. apply stkSpacePrec_sp_ge_sz with cthM11; auto. assert (sp = R' SP + 2). rewrite <- H3. assert (sp - 2 + 2 = sp). auto. auto. rewrite H6 in H0. assert ((R' SP |-> pc *^* R' SP + 1 |-> junk *^* stkSpacePrec (R' SP) 8) cthM11'). unfold cthM11'. apply enter_SW_grt_auxb0_hyp21. auto. rewrite H2 in H1. assert (R' SP + 2 - 2 = R' SP). auto. rewrite H8 in H1. sep on. sep lift 2 in H7. sep lift 2 in H1. destruct H7 as [cthM11'_1 [cthM11'_2 [Hsplit11' [HM11'_1 HM11'_2]]]]. destruct H1 as [cthM11''_1 [cthM11''_2 [Hsplit11'' [HM11''_1 HM11''_2]]]]. exists (MemMod.merge cthM12_1 cthM11'_1). exists (MemMod.merge chtM12_2 cthM11'_2). exists (MemMod.merge cthM12_1 cthM11''_1). split. exists cthM12_1. exists cthM11'_1. split; auto. split; auto. apply enter_SW_grt_auxb0_hyp22 with cthM11 cthM12 cthM11' chtM12_2 cthM11'_2 (R' SP) pc junk; auto. split. exists cthM12_1. exists cthM11''_1. split; auto. split; auto. apply enter_SW_grt_auxb0_hyp23 with cthM12 cthM11'' chtM12_2 cthM11''_2; auto. split. apply enter_SW_grt_auxb0_hyp24 with cthM11 (R' SP) pc junk; auto. assert (cthM11'_2 = cthM11''_2). apply enter_SW_grt_auxb0_hyp26 with (R' SP) pc junk; auto. rewrite H1. apply enter_SW_grt_auxb0_hyp25; auto. Qed. Lemma enter_SW_grt_auxb0: forall cthM1 R fl isr M cthM11 cthM12 S' cthM11'' pc pc' M' R' fl' isr' junk S0, MemMod.disjUnion cthM11 cthM12 cthM1 -> (INV0 *^* INV1 *^* mTrue) cthM12 -> stkSpacePrec (R SP) (8 + 2) cthM11 -> (S_RF S' SP - 2 |-> pc + 1 *^* S_RF S' SP - 2 + 1 |-> junk *^* stkSpacePrec (S_RF S' SP - 2) 8) cthM11'' -> nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> nextS pc' (comms _retw) S0 S' -> S_RF S0 SP = R' SP -> MemMod.subseteq (MemMod.merge cthM12 cthM11'') (S_Mem S') -> isr = S_ISR S' -> fl _IF = S_Flag S' _IF -> MemMod.disjoint cthM11'' cthM12 -> wrap_fun gy pc _SWITCH pc' (cthM1, R, fl, isr) (S_Mem_Upd S' (MemMod.merge cthM12 cthM11'')). Proof. intros. unfold wrap_fun. unfold conjG. exists (S_Mem_Upd S0 (MemMod.merge cthM12 cthM11'')). split. exists (MemMod.merge cthM12 (MemUpdW cthM11 (R SP - 2) (pc+1) junk), R', fl', isr'). split. apply step_call_hyp1 with M M' _SW_Stk; auto. unfold gy. exists (R' SP). split. assert (R SP - 2 = R' SP). apply enter_SW_grt_auxb0_hyp0 with pc M fl isr M' fl' isr' _SWITCH; auto. rewrite H10. assert (S_RF S' SP = S_RF S0 SP + 2). apply enter_SW_grt_auxb0_hyp1 with pc'; auto. rewrite H5 in H11. apply enter_SW_grt_auxb0_hyp2 with S' (R SP); auto. unfold MemMod.disjUnion in H. inversion H. auto. assert ((S_Flag S0 _IF = S_Flag S' _IF) /\ (S_ISR S0 = S_ISR S')). apply enter_SW_grt_auxb0_hyp3 with pc'; auto. inversion_clear H10. assert (S_Flag (M, R, fl, isr) _IF = S_Flag (M', R', fl', isr') _IF /\ S_ISR (M, R, fl, isr) = S_ISR (M', R', fl', isr')). apply enter_SW_grt_auxb0_hyp4 with pc _SWITCH; auto. inversion_clear H10. split. assert (S_Flag (S_Mem_Upd S0 (MemMod.merge cthM12 cthM11'')) = S_Flag S0). auto. rewrite H10. rewrite H11. rewrite <- H8. UnfoldStateAll. auto. split. assert (S_ISR (S_Mem_Upd S0 (MemMod.merge cthM12 cthM11'')) = S_ISR S0). auto. rewrite H10. rewrite H12. rewrite <- H7. UnfoldStateAll. auto. split. unfold S_RF. auto. assert (S_RF (S_Mem_Upd S0 (MemMod.merge cthM12 cthM11'')) = S_RF S0). auto. rewrite H10. rewrite H5. unfold S_RF. auto. assert (S_RF S' SP = S_RF S0 SP + 2). apply enter_SW_grt_auxb0_hyp1 with pc'; auto. rewrite H10 in H2. assert (S_RF S0 SP + 2 - 2 = S_RF S0 SP). auto. rewrite H11 in H2. apply enter_SW_grt_auxb0_hyp5 with (pc + 1) junk (stkSpacePrec (S_RF S0 SP) 8); auto. Qed. Lemma enter_SW_grt_auxb: forall (p p' : Pred) cthM1 R fl isr M cthM11 cthM12 S' cthM11'' pc pc' M' R' fl' isr' junk S0, p (cthM1, R, fl, isr) -> (forall pc' : nat, pimp (p |> wrap_fun gy pc _SWITCH pc') p') -> MemMod.disjUnion cthM11 cthM12 cthM1 -> (INV0 *^* INV1 *^* mTrue) cthM12 -> stkSpacePrec (R SP) (8 + 2) cthM11 -> ((S_RF S' SP - 2 |-> pc + 1) *^* (S_RF S' SP - 2 + 1 |-> junk) *^* stkSpacePrec (S_RF S' SP - 2) 8) cthM11'' -> nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> nextS pc' (comms _retw) S0 S' -> S_RF S0 SP = R' SP -> MemMod.subseteq (MemMod.merge cthM12 cthM11'') (S_Mem S') -> isr = S_ISR S' -> fl _IF = S_Flag S' _IF -> MemMod.disjoint cthM11'' cthM12 -> p' (S_Mem_Upd S' (MemMod.merge cthM12 cthM11'')). Proof. intros. unfold pimp in H0. apply H0 with pc'. unfold linkPG. exists (cthM1, R, fl, isr). split; auto. apply enter_SW_grt_auxb0 with M cthM11 M' R' fl' isr' junk S0; auto. Qed. Lemma enter_SW_grt_hypa: forall cthM2 cthM12 cthM11'' cthM', disjUnionList (cthM2 :: cthM12 :: cthM11'' :: nil) cthM' -> MemMod.disjUnion (MemMod.merge cthM12 cthM11'') cthM2 cthM'. Proof. intros. cut (MemMod.disjUnion cthM2 (MemMod.merge cthM12 cthM11'') cthM'). intro. auto with PMap. unfold disjUnionList in H. InvertAll. subst x1. assert (cthM11'' = x0). auto with PMap. subst x0. inversion_clear H2. subst x. auto. Qed. Lemma enter_SW_grt_hypc: forall M21_0 M22 M12 cthM2 cthM12 cthM11'' S', disjUnionList (M21_0 :: M22 :: M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) (S_Mem S') -> MemMod.subseteq (MemMod.merge cthM12 cthM11'') (S_Mem S'). Proof. intros. unfold disjUnionList in H. induction S' as (((M, R), fl), isr). UnfoldStateAll. InvertAll. subst x4. assert (cthM11'' = x3). auto with PMap. subst x3. clear H6. inversion_clear H5. subst x2. clear H. apply MemMod.subseteq_transitivity with x. apply MemMod.subseteq_transitivity with x0. apply MemMod.subseteq_transitivity with x1. apply MemMod.disjUnion_subseteq_right with cthM2; auto. apply MemMod.disjUnion_subseteq_right with M12; auto. apply MemMod.disjUnion_subseteq_right with M22; auto. apply MemMod.disjUnion_subseteq_right with M21_0; auto. Qed. Lemma enter_SW_grt_hypd: forall M21_0 M22 M12 cthM2 cthM12 cthM11'' S', disjUnionList (M21_0 :: M22 :: M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) (S_Mem S') -> MemMod.disjoint cthM11'' cthM12. Proof. intros. unfold disjUnionList in H. induction S' as (((M, R), fl), isr). UnfoldStateAll. InvertAll. subst x4. assert (cthM11'' = x3). auto with PMap. subst x3. clear H6. inversion_clear H5. auto with PMap. Qed. Lemma enter_SW_grt_hypf: forall Psi'0 T RdyQ TM T' tid tcb cthM', WF_ReadyQ Psi'0 T RdyQ TM -> T' = TQMod.put T tid tcb -> WQMod.not_in_dom tid RdyQ -> WF_ReadyQ Psi'0 T' RdyQ (ThrdMemMod.put TM tid cthM'). Proof. intros. unfold WF_ReadyQ in * . intros. subst T'. intros. unfold TQMod.put. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to in * . unfold TQMod.maps_to in * . unfold TQMod.beq_A. unfold TQSpec.beq_Domain. unfold ThrdMemMod.beq_A. unfold ThrdMemSpec.beq_Domain. destruct (eq_nat_dec tid0 tid). rewrite e in H2;destruct H2. rewrite H1 in H0;inversion H0. apply H;assumption. Qed. Lemma enter_SW_grt_hypg: forall Psi'0 T B TM T' tid tcb cthM', WF_WQSet Psi'0 T B TM -> unblocked tid B -> T' = TQMod.put T tid tcb -> WF_WQSet Psi'0 T' B (ThrdMemMod.put TM tid cthM'). Proof. intros. unfold WF_WQSet in * . unfold unblocked in H0. intros. substH H0 with (H0 l Q H2). subst T'. unfold TQMod.put. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to in * . unfold TQMod.maps_to in * . unfold TQMod.beq_A. unfold TQSpec.beq_Domain. unfold ThrdMemMod.beq_A. unfold ThrdMemSpec.beq_Domain. destruct (eq_nat_dec tid0 tid). rewrite e in H3;destruct H3. rewrite H0 in H1;inversion H1. apply H with Q;assumption. Qed. Lemma enter_SW_grt_hyph: forall T T' B M tid tcb, embed_WQSet T B M -> unblocked tid B -> T' = TQMod.put T tid tcb -> embed_WQSet T' B M. Proof. intros. subst T'. induction H. apply wq_emp. assert (unblocked tid B). unfold unblocked in * . intros. apply H0 with w. unfold WQSetMod.maps_to in * . unfold WQSetMod.put. destruct (WQSetMod.beq_A w l). rewrite e in H4;rewrite H1 in H4;inversion H4. assumption. apply wq_cons with M M';try assumption. apply IHembed_WQSet. assumption. assert (filterTQ T Q = filterTQ (TQMod.put T tid tcb) Q). apply TQMod.extensional_eqMap. intros. unfold TQMod.put. unfold filterTQ. unfold unblocked in H0. destruct (TQMod.beq_A x tid). unfold WQSetMod.maps_to in H0. subst x. assert (Q tid = None). apply H0 with l. unfold WQSetMod.put. destruct (WQSetMod.beq_A l l). reflexivity. elim n;reflexivity. rewrite H5. reflexivity. reflexivity. rewrite H5 in H2;assumption. Qed. Lemma enter_SW_grt2_hyp0: forall RdyQ RdyQ' tid tid', addThrd RdyQ tid = addThrd RdyQ' tid' -> WQMod.not_in_dom tid RdyQ -> WQMod.not_in_dom tid' RdyQ' -> tid <> tid' -> (WQMod.in_dom tid RdyQ' /\ WQMod.in_dom tid' RdyQ). Proof. intros. unfold addThrd in H. split. assert (WQMod.put RdyQ tid dummy_sglton tid = WQMod.put RdyQ' tid' dummy_sglton tid). rewrite H;reflexivity. assert ( WQMod.put RdyQ' tid' dummy_sglton tid = RdyQ' tid). apply WQMod.put_noninterfere. intro;apply H2;symmetry;assumption. rewrite H4 in H3. unfold WQMod.put in H3. destruct (WQMod.beq_A tid tid). exists dummy_sglton;symmetry;assumption. elim n;reflexivity. assert (WQMod.put RdyQ tid dummy_sglton tid' = WQMod.put RdyQ' tid' dummy_sglton tid'). rewrite H;reflexivity. assert (WQMod.put RdyQ tid dummy_sglton tid' = RdyQ tid'). apply WQMod.put_noninterfere. assumption. rewrite H4 in H3. unfold WQMod.put in H3. destruct (WQMod.beq_A tid' tid'). exists dummy_sglton;assumption. elim n;reflexivity. Qed. Lemma enter_SW_grt2_hyp1: forall TM tid tid' cthMR sp'' pc'' S0 M0' M2' M22 M12 cthM2 cthM12, ThrdMemMod.maps_to TM tid' cthMR -> (sp'' |~>w pc'') cthMR -> S_RF S0 SP = sp'' -> MemMod.disjUnion M0' M2' (S_Mem S0) -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' -> MemSplit (ThrdMemMod.remove TM tid) M12 -> tid <> tid' -> Ret_Addr pc'' S0. Proof. intros. induction S0 as (((Mx, Rx), flx), isrx). UnfoldStateAll. unfold Ret_Addr. intro pc. simplS. apply nextPC_retw with sp''; auto. apply leadsToW_Mono with M2' M0'; auto. auto with PMap. assert (DUL2mstar (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2'). apply DUL2mstar_left; auto. unfold DUL2mstar in H6. sep on. sep lift 1 in H6. unfold mstar at 1 in H6. sep off. InvertAll. unfold eqM in H6. subst x. apply leadsToW_Mono with M12 x0; auto. assert (MemMod.subseteq cthMR M12). apply memsplit_subheap with (ThrdMemMod.remove TM tid) tid'; auto. unfold ThrdMemMod.maps_to. unfold ThrdMemMod.remove. induction (ThrdMemMod.beq_A tid' tid); auto. absurd (tid' <> tid); auto. assert (exists M12_2, MemMod.disjUnion cthMR M12_2 M12). auto with PMap. inversion_clear H8. apply leadsToW_Mono with cthMR x; auto. Qed. Lemma non_ih_spec_miniD: forall rho D, (rho = rho_ready \/ rho = rho_idle) -> Minimal_D D -> D rho = SomeT1 _ (Itp_AIM rho). Proof. intros. inversion_clear H. rewrite H1. unfold Minimal_D in H0. InvertAll. auto. rewrite H1. unfold Minimal_D in H0. InvertAll. auto. Qed. Lemma minimalD_elim_Rdy: forall D, Minimal_D D -> D rho_ready = SomeT1 _ (Itp_AIM rho_ready). Proof. intros. unfold Minimal_D in H. InvertAll. auto. Qed. Lemma minimalD_elim_idle: forall D, Minimal_D D -> D rho_idle = SomeT1 _ (Itp_AIM rho_idle). Proof. intros. unfold Minimal_D in H. InvertAll. auto. Qed. Lemma minimalD_elim_ih: forall D, Minimal_D D -> D rho_ih = SomeT1 _ (Itp_AIM rho_ih). Proof. intros. unfold Minimal_D in H. InvertAll. auto. Qed. Lemma enter_SW_grt2_aux2_hyp0: forall INVM cthM0 cthM12 M22 M12 cthM2 M0' M2' S0 M21' cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' -> MemMod.disjUnion M0' M2' (S_Mem S0) -> MemMod.disjUnion M21' cthM_oldStk M0' -> MemMod.disjoint (MemMod.merge cthM0 cthM2) cthM_oldStk. Proof. intros. induction S0 as (((M, R), fl), isr). simplS in H1. assert ((eqM M21' *^* eqM cthM_oldStk *^* (DUL2mstar (M22 :: M12 :: cthM2 :: cthM12 :: nil))) M). exists M0'. exists M2'. split_l. split. exists M21'. exists cthM_oldStk. unfold eqM. auto. apply DUL2mstar_left; auto. unfold DUL2mstar in H3. sep on. sep lift 5 in H3. assert (forall M, eqM cthM12 M -> (eqM INVM *^* eqM cthM0) M). intros. unfold eqM in H4. subst M0. exists INVM. exists cthM0. unfold eqM. auto. sep weaker_subst in H3 with (eqM INVM *^* eqM cthM0). assert ((eqM cthM0 *^* eqM cthM2 *^* eqM cthM_oldStk *^* mTrue) M). sep on. sep matchH H3 with 4. unfold mstar in H6. unfold eqM in H6. InvertAll. subst x2 x3 x4. inversion_clear H10. subst x1. sep off. inversion_clear H8; auto. Qed. Lemma enter_SW_grt2_aux2_hyp1: forall pc' M0' M2' S0 S' M22 M12 cthM2 cthM12 M21' cthM_oldStk M122 cthMR INVM cthM0, MemMod.disjUnion M0' M2' (S_Mem S0) -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' -> MemMod.disjUnion M21' cthM_oldStk M0' -> MemMod.disjUnion M122 cthMR M12 -> MemMod.disjUnion INVM cthM0 cthM12 -> nextS pc' (comms _retw) S0 S' -> disjUnionList (M22 :: cthMR :: INVM :: M21' :: MemMod.merge (MemMod.merge cthM0 cthM2) cthM_oldStk ::M122 :: nil) (S_Mem S'). Proof. intros. induction S0 as (((Mx, Rx), flx), isrx). induction S' as (((My, Ry), fly), isry). UnfoldStateAll. destruct (nextS_inversion H4). subst My. clear H4 H6. assert ((eqM M21' *^* eqM cthM_oldStk *^* (DUL2mstar (M22 :: M12 :: cthM2 :: cthM12 :: nil))) Mx). exists M0'. exists M2'. split_l. split. exists M21'. exists cthM_oldStk. unfold eqM. auto. apply DUL2mstar_left; auto. unfold DUL2mstar in H4. sep on. sep lift 5 in H4. assert (forall M, eqM cthM12 M -> (eqM INVM *^* eqM cthM0) M). intros. unfold eqM in H5. subst M. exists INVM. exists cthM0. unfold eqM. auto. sep weaker_subst in H4 with (eqM INVM *^* eqM cthM0). clear H5 H6. sep lift 5 in H4. assert (forall M, eqM M12 M -> (eqM M122 *^* eqM cthMR) M). intros. unfold eqM in H5. subst M. exists M122. exists cthMR. unfold eqM. auto. sep weaker_subst in H4 with (eqM M122 *^* eqM cthMR). sep off. cut (DUL2mstar (M22 :: cthMR :: INVM :: M21' :: MemMod.merge (MemMod.merge cthM0 cthM2) cthM_oldStk ::M122 :: nil) Mx). apply DUL2mstar_right. unfold DUL2mstar. sep on. sep matchH H4 with 7. sep lift 3 in H4. sep off. unfold eqM. unfold mstar in H4. unfold eqM in H4. InvertAll. subst x x1 x3. unfold Aemp in H13. subst x4. assert (cthM0 = x2). auto with PMap. subst x2. inversion_clear H8. assert (MemMod.merge cthM2 cthM0 = MemMod.merge cthM0 cthM2); auto with PMap. rewrite H8 in H9. assert (MemMod.disjUnion x0 cthM_oldStk h). auto with PMap. rewrite H9 in H11. inversion_clear H11; auto. Qed. Lemma enter_SW_grt2_hyp4_hyp0: forall RdyQ RdyQ' tid tid' B, addThrd RdyQ tid = addThrd RdyQ' tid' -> tid <> tid' -> disj_RQ_WQ B RdyQ -> unblocked tid' B. Proof. unfold unblocked;intros. unfold disj_RQ_WQ in H1. substH H1 with (H1 w Q H2). assert (WQMod.in_dom tid' RdyQ). unfold addThrd in H. assert ( WQMod.put RdyQ tid dummy_sglton tid' = RdyQ tid'). apply WQMod.put_noninterfere;assumption. rewrite H in H3. unfold WQMod.put in H3. destruct (WQMod.beq_A tid' tid'). exists dummy_sglton. symmetry;assumption. elim n;reflexivity. apply WQMod.disj_exclusive_left with RdyQ. apply WQMod.disjoint_commut;assumption. assumption. Qed. (* changed because of the change of WF_currTID *) Lemma enter_SW_grt2_hyp4: forall T T' B RdyQ RdyQ' tid tid' tcb tcb' rho rho', tid <> tid' -> addThrd RdyQ tid = addThrd RdyQ' tid' -> WF_currTID tid T B RdyQ rho -> T' = TQMod.put T tid tcb -> WQMod.not_in_dom tid' RdyQ' -> WF_TWQ T B RdyQ -> TQMod.maps_to T tid' tcb' -> TCB_Status tcb' = READY \/ TCB_Status tcb' = IDLE -> rho_tcb_consistent tcb' rho' -> WF_currTID tid' T' B RdyQ' rho'. Proof. intros. unfold WF_currTID. unfold WF_TWQ in H4. unfold WF_currTID in H1. InvertAll. split. apply enter_SW_grt2_hyp4_hyp0 with RdyQ RdyQ' tid; auto. split; auto. rewrite H2. unfold TQMod.in_dom. unfold TQMod.put. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. split. exists tcb'. auto. exists tcb'. unfold TQMod.maps_to. induction (TQMod.beq_A tid' tid). contradiction. split; auto. Qed. Lemma enter_SW_grt2_hyp5_hyp0: forall tid'' RdyQ tid tid' RdyQ', WQMod.in_dom tid'' RdyQ -> addThrd RdyQ tid = addThrd RdyQ' tid' -> tid' <> tid'' -> WQMod.in_dom tid'' RdyQ'. Proof. intros. unfold addThrd in H0. assert (WQMod.put RdyQ' tid' dummy_sglton tid'' = RdyQ' tid''). apply WQMod.put_noninterfere;assumption. rewrite <- H0 in H2. destruct H. unfold WQMod.put in H2. destruct (WQMod.beq_A tid'' tid). exists dummy_sglton. symmetry;assumption. exists x. rewrite H in H2;symmetry;assumption. Qed. Lemma enter_SW_grt2_hyp5: forall T T' RdyQ RdyQ' tid tid' sp pc tcb, exists_Idle T RdyQ tid -> addThrd RdyQ tid = addThrd RdyQ' tid' -> T tid = Some tcb (* -> T tid' = Some tcb' *) -> tid <> tid' -> WQMod.not_in_dom tid' RdyQ' -> WQMod.not_in_dom tid RdyQ -> WQMod.in_dom tid RdyQ' -> WQMod.in_dom tid' RdyQ -> T' = TQMod.put T tid (sp, TCB_Status tcb, pc) -> exists_Idle T' RdyQ' tid'. Proof. intros. unfold exists_Idle. unfold exists_Idle in H. inversion_clear H. InvertAll. assert (x = tcb). unfold TQMod.maps_to in H8. rewrite H8 in H1. inversion H1. auto. rewrite H in H9. rewrite H9 in H7. right. exists tid. exists (sp, IDLE, pc). split; auto. split; auto. rewrite H7. unfold TQMod.maps_to. unfold TQMod.put. induction (TQMod.beq_A tid tid). auto. absurd (tid = tid); auto. InvertAll. rename x into tid''. rename x0 into tcb''. assert (tid' = tid'' \/ tid' <> tid''). apply nat_eq_neq_dec. inversion_clear H9. left. exists tcb''. split. rewrite <- H11 in H8. rewrite H7. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. auto. auto. right. exists tid''. exists tcb''. split. apply enter_SW_grt2_hyp5_hyp0 with RdyQ tid tid'; auto. split; auto. rewrite H7. unfold TQMod.maps_to. unfold TQMod.put. induction (TQMod.beq_A tid'' tid). rewrite a in H. absurd (~ WQMod.in_dom tid RdyQ); auto with PMap. auto. Qed. Lemma enter_SW_grt2_aux6_hyp0: forall B RdyQ RdyQ' tid tid', disj_RQ_WQ B RdyQ -> unblocked tid B -> addThrd RdyQ tid = addThrd RdyQ' tid' -> tid <> tid' -> disj_RQ_WQ B RdyQ'. Proof. unfold addThrd;unfold disj_RQ_WQ. intros. substH H with (H l Q H3). unfold unblocked in H0. substH H0 with (H0 l Q H3). substH H with (WQMod.disjoint_commut H). assert (WQMod.disjoint Q (WQMod.put RdyQ tid dummy_sglton)). apply WQMod.disjoint_commut. apply WQMod.extend_presv_disj_left;assumption. rewrite H1 in H4. unfold WQMod.put in H4. unfold WQMod.disjoint in * . intro. destruct (H4 x). left;assumption. right. unfold WQMod.not_in_dom in * . destruct (WQMod.beq_A x tid' ). inversion H5. assumption. Qed. (* changed because of the change of WF_currTID *) Lemma enter_SW_grt2_aux6: forall RdyQ RdyQ' tid tid' tcb tcb' B T T' rho, addThrd RdyQ tid = addThrd RdyQ' tid' -> TQMod.maps_to T tid tcb -> WF_currTID tid T B RdyQ rho -> tid <> tid' -> WF_TWQ T B RdyQ -> T' = TQMod.put T tid tcb' -> WF_TWQ T' B RdyQ'. Proof. intros. unfold WF_TWQ. split. rewrite H4. unfold WF_TWQ in H3. InvertAll. unfold WF_TQ. unfold WF_TQ in H5. intros. apply H5. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H8. rewrite H9. unfold TQMod.in_dom. exists tcb. auto. unfold TQMod.put in H6. unfold TQMod.in_dom in H6. induction (TQMod.beq_A tid0 tid). contradiction. auto. unfold WF_TWQ in H3. InvertAll. split; auto. unfold WF_currTID in H1. InvertAll. apply enter_SW_grt2_aux6_hyp0 with RdyQ tid tid'; auto. Qed. Lemma enter_SW_grt2_hyp7: forall cthMR INVM cthM_old M122 M'0 TM TM' tid tid', disjUnionList (cthMR :: INVM :: cthM_old :: M122 :: nil) M'0 -> MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 -> TM' = ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old -> tid <> tid' -> MemSplit TM' M'0. Proof. intros. rewrite H1. assert (DUL2mstar (cthMR :: INVM :: cthM_old :: M122 :: nil) M'0). apply DUL2mstar_left; auto. unfold DUL2mstar in H3. sep on. sep lift 2 in H3. sep off. unfold mstar in H3. unfold eqM in H3. InvertAll. subst x x3 x4 x5. unfold Aemp in H12. subst x6. assert (M122 = x1). auto with PMap. subst x1. clear H9. apply enter_SW_grt_hyp6 with x0; auto with PMap. assert (ThrdMemMod.remove (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid = ThrdMemMod.put (ThrdMemMod.remove TM tid) tid' (MemMod.merge cthMR INVM)). auto with PMap. rewrite H3. clear H3. inversion_clear H7. subst x2. apply enter_SW_grt_hyp6 with M122; auto. Qed. Lemma enter_SW_grt2_hyp8: forall pc pc' M R fl isr M' R' fl' isr' S0 S' f, nextS pc (comml (_call f)) (M, R, fl, isr) (M', R', fl', isr') -> S_ISR (M', R', fl', isr') = S_ISR S0 -> isr = false -> nextS pc' (comms _retw) S0 S' -> S_ISR S' = false. Proof. intros. inversion H;subst. inversion H2;subst. simpl in H0;symmetry;assumption. Qed. Lemma enter_SW_grt2_hyp9: forall S0 S' sp'' pc', S_RF S0 SP = sp'' -> nextS pc' (comms _retw) S0 S' -> S_RF S' SP = sp'' + 2. Proof. intros. inversion H0;subst. simpl. destruct H1 as [pc [P1 P2]]. subst R'. rewrite (RF_update_RF R SP (R SP + 2)). reflexivity. Qed. Lemma enter_SW_grt2_hypa: forall cthMR INVM M22 M21' cthM_old M122 S', disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S') -> MemMod.disjoint cthMR INVM. Proof. intros. induction S' as (((M, R), fl), isr). simplS in H. assert (DUL2mstar (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) M). apply DUL2mstar_left. auto. clear H. assert ((eqM cthMR *^* eqM INVM *^* mTrue) M). unfold DUL2mstar in H0. sep on. sep matchH H0 with 3. unfold mstar in H. unfold eqM in H. InvertAll. subst x1 x2. inversion_clear H2; auto. Qed. Lemma enter_SW_grt2_hypb: forall M cthM_oldStk cthM_old R' pc junk, MemMod.disjUnion M cthM_oldStk cthM_old -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk *^* stkSpacePrec (R' SP) 8) cthM_oldStk -> (R' SP |~>w pc + 1) cthM_old. Proof. intros. apply leadsToW_Mono with cthM_oldStk M. auto with PMap. sep on. assert (cthM_oldStk ||- R' SP |->w pc + 1 *^* stkSpacePrec (R' SP) 8). apply ptoW_intro1 with junk; auto. sep trivial. Qed. Lemma enter_SW_grt2_hypf: forall RdyQ RdyQ' tid tid' tid0, WQMod.in_dom tid0 RdyQ' -> tid0 <> tid -> addThrd RdyQ tid = addThrd RdyQ' tid' -> WQMod.in_dom tid0 RdyQ. Proof. intros. apply enter_SW_grt2_hyp5_hyp0 with RdyQ' tid' tid; [idtac|symmetry|intro;apply H0;symmetry];assumption. Qed. (* changed because of the change of WF_currTID *) Lemma enter_SW_grt2_hypg: forall Psi T B TM TM' RdyQ RdyQ' tid tid' T' tcb M M' rho, WF_WQSet Psi T B TM -> addThrd RdyQ tid = addThrd RdyQ' tid' -> WF_currTID tid T B RdyQ rho -> WF_TWQ T B RdyQ -> T' = TQMod.put T tid tcb -> TM' = ThrdMemMod.put (ThrdMemMod.put TM tid' M') tid M -> tid <> tid' -> WF_WQSet Psi T' B TM'. Proof. unfold WF_WQSet. intros. assert ( exists tcb : Thread, exists M : Mem, TQMod.maps_to T tid0 tcb /\ ThrdMemMod.maps_to TM tid0 M /\ WF_Wait_Thrd Psi M tcb l). apply H with Q; auto. InvertAll. exists x. exists x0. assert (tid <> tid0). assert (tid = tid0 \/ tid <> tid0). apply nat_eq_neq_dec. inversion_clear H10; auto. subst tid0. unfold WF_currTID in H1. InvertAll. unfold unblocked in H10. assert (WQMod.not_in_dom tid Q). apply H10 with l; auto. absurd (~ WQMod.in_dom tid Q); auto with PMap. split. subst T'. unfold TQMod.maps_to. unfold TQMod.put. induction (TQMod.beq_A tid0 tid); auto. absurd (tid0 <> tid); auto. split_r. subst TM'. assert (tid' <> tid0). assert (tid' = tid0 \/ tid' <> tid0). apply nat_eq_neq_dec. inversion_clear H4; auto. clear H. unfold WF_TWQ in H2. InvertAll. unfold disj_RQ_WQ in H13. assert (WQMod.disjoint Q RdyQ). apply H13 with l; auto. unfold WQMod.disjoint in H4. assert (WQMod.not_in_dom tid' Q \/ WQMod.not_in_dom tid' RdyQ). auto. inversion_clear H14. rewrite H12 in H15. absurd (~ WQMod.in_dom tid0 Q); auto with PMap. assert (WQMod.in_dom tid' RdyQ). unfold addThrd in H0. assert (WQMod.maps_to (WQMod.put RdyQ' tid' dummy_sglton) tid' dummy_sglton). auto with PMap. rewrite <- H0 in H14. unfold WQMod.put in H14. unfold WQMod.maps_to in H14. induction (WQMod.beq_A tid' tid). absurd (tid' <> tid); auto. unfold WQMod.in_dom. exists dummy_sglton. auto. absurd (~ WQMod.in_dom tid' RdyQ); auto with PMap. unfold ThrdMemMod.maps_to. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. induction (ThrdMemMod.beq_A tid0 tid'); auto. absurd (tid0 <> tid'); auto. Qed. (* changed because of the change of WF_currTID *) Lemma enter_SW_grt2_hyph: forall M'1 M21' M22 T' tid' RdyQ' T B tcb RdyQ tid rho, MemMod.disjUnion M21' M22 M'1 -> (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ') M21' -> embed_WQSet T B M22 -> T' = TQMod.put T tid tcb -> WF_currTID tid T B RdyQ rho -> (embed_curr_TCB T' tid' *^* (embed_RdyQ T' RdyQ' *^* embed_WQSet T' B)) M'1. Proof. intros. assert (embed_WQSet T' B M22). destruct H3. apply enter_SW_grt_hyph with T tid tcb;assumption. sep on. assert (M'1||- (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ' *^* embed_WQSet T' B)). apply sconj_intro with M21' M22;assumption. sep matchH H5 with 3. Qed. Lemma enter_SW_grt2_hypI: forall pc pc' M R fl isr M' R' fl' isr' S0 S', nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> S_Flag (M', R', fl', isr') _IF = S_Flag S0 _IF -> fl _IF = false -> nextS pc' (comms _retw) S0 S' -> S_Flag S' _IF = false. Proof. intros. inversion H;subst. inversion H2;subst. destruct H6. simpl in H0. simpl. rewrite H0 in H1;assumption. Qed. Lemma rho_tcb_consistent_ih: forall tcb, rho_tcb_consistent tcb rho_ih. Proof. intro. unfold rho_tcb_consistent. split. intro. inversion H. intro. inversion H. Qed. Hint Resolve rho_tcb_consistent_ih. Lemma enter_SW_grt2_hyp3: forall M22 cthMR INVM M21' cthM_old M122 S', disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S') -> exists M'0, exists M'1, MemMod.disjUnion M'0 M'1 (S_Mem S') /\ MemMod.disjUnion M21' M22 M'1 /\ disjUnionList (cthMR :: INVM :: cthM_old :: M122 :: nil) M'0. Proof. intros. induction S' as (((Mx, Rx), flx), isrx). UnfoldStateAll. assert ((eqM M21' *^* eqM M22 *^* (DUL2mstar (cthMR :: INVM :: cthM_old :: M122 :: nil))) Mx). assert (DUL2mstar (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) Mx). apply DUL2mstar_left; auto. unfold DUL2mstar in *. sep on. sep matchH H0 with 7. unfold mstar at 1 in H0. InvertAll. exists x0. exists x. split. auto with PMap. split. unfold mstar in H0. unfold eqM in H0. InvertAll. subst x1 x2. auto. apply DUL2mstar_right; auto. Qed. Lemma subsetCT_presv_loopup: forall theta pc Psi Psi', subsetCT Psi Psi' -> lookupCT Psi pc theta -> lookupCT Psi' pc theta. Proof. unfold lookupCT. unfold subsetCT. intros. apply OPSpec.lookup_sub_lookup with Psi; auto. Qed. Lemma psi_sw_lookupNPC: forall rho psi Psi Psi' Psi'0 p' g' tag pc, rho = rho_ready \/ rho = rho_idle -> lift_psi psi rho Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> subsetCT Psi' Psi'0 -> SCAP_lookupCT psi pc (Ast p' g' tag) -> lookupCT Psi'0 pc (packS0 rho (Ast p' g' tag)). Proof. intros. subst Psi'. apply subsetCT_presv_loopup with (ext_IH_Spec (ext_Prim_Specs Psi)); auto. unfold lift_psi in H0. assert (lookupCT Psi pc (packS0 rho (Ast p' g' tag))). apply H0; auto. assert (subsetCT Psi (ext_IH_Spec (ext_Prim_Specs Psi))). unfold ext_Prim_Specs. unfold ext_IH_Spec. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. apply subsetCT_presv_loopup with Psi; auto. Qed. Lemma enter_SW_grt2_auxc_hyp0: forall cthM0 cthM2 cthM_oldStk cthM_old M0 M'2, MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old -> MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjoint cthM0 cthM2 -> MemMod.disjUnion (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk) cthM2 M'2. Proof. intros. assert ((eqM M0 *^* (eqM cthM0 *^* eqM cthM2 *^* eqM cthM_oldStk)) M'2). exists M0. exists cthM_old. split_l. split. unfold eqM. auto. exists (MemMod.merge cthM0 cthM2). exists cthM_oldStk. split_l. unfold eqM. split_r. exists cthM0. exists cthM2. split; auto. split; auto. assert ((eqM cthM0 *^* eqM M0 *^* eqM cthM_oldStk *^* eqM cthM2) M'2). sep on. sep matchH H2 with 4. unfold mstar in H3. unfold eqM in H3. InvertAll. subst x0 x2 x3 x4. inversion_clear H7. subst x1. inversion_clear H5. subst x. auto. Qed. Lemma enter_SW_grt2_hype: forall M0 cthM_old M'2 cthM0 cthM2 cthM_oldStk M'20 M'21 fl fl0, MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old -> MemMod.disjUnion M'20 M'21 M'2 -> NH_Inv fl0 M'21 -> NH_Inv fl cthM2 -> fl _IF = false -> fl0 _IF = false -> M'20 = MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk. Proof. intros. unfold NH_Inv in * . rewrite H4 in H3;rewrite H5 in H2. rewrite H2 in H1. rewrite H3 in H0. destruct H1. rewrite (MemMod.unit_emp_merge M'20) in H6. rewrite (MemMod.unit_emp_merge cthM0) in H0. subst. assert (MemMod.merge cthM0 M0 = MemMod.merge M0 cthM0). apply MemMod.disj_merge_commut. disjoint lift_l. rewrite H6. destruct H0;destruct H. rewrite (MemMod.merge_assoc M0 cthM0 cthM_oldStk). rewrite <- H7;rewrite <- H8;reflexivity. Qed. Lemma WF_AIM_World_RdyNotBlk: forall Psi'0 S T B RdyQ tid theta w BlkQ rho, WF_AIM_World Psi'0 S T B RdyQ tid rho theta -> B w = Some BlkQ -> WQMod.disjoint RdyQ BlkQ. Proof. intros. unfold WF_AIM_World in H. InvertAll. unfold WF_TWQ in H2. InvertAll. unfold disj_RQ_WQ in H11. assert (WQMod.disjoint BlkQ RdyQ). apply H11 with w; auto. auto with PMap. Qed. (* Lemma call_fun_frame: forall M M' R R' fl fl' isr isr' M2 M12 cthM2 cthM12 cthM11 pc f w stkspace, disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11 :: nil) M -> (R SP |->w w *^* stkSpacePrec (R SP) (stkspace + 2)) cthM11 -> nextS pc (comml (_call f)) (M, R, fl, isr) (M', R', fl', isr') -> exists cthM11', ((R' SP |->w (pc+1)) *^* (R' SP + 2 |->w w) *^* (stkSpacePrec (R' SP) stkspace)) cthM11' /\ disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11' :: nil) M'. Proof. intros. substH H1 with (nextS_inversion H1). simpl in H1. destruct H1 as [P1 [P2 [P3 P4]]]. destruct P1 as [P11 [P12 P13]]. destruct P13. exists ( MemUpdW cthM11 (R SP - 2) (pc + 1) x). assert ( (R SP-2 |->w pc + 1 *^* R SP |->w w *^* stkSpacePrec (R SP-2) stkspace) (MemUpdW cthM11 (R SP - 2) (pc + 1) x)). sep on. sep lift 0. sep upd. sep matchH H0 with 3. sep stksplit in H0. arith_rep (stkspace +2-2) with stkspace in H0. split. subst R'. rewrite (RF_update_RF R SP (R SP - 2)). arith_rep (R SP - 2 + 2) with (R SP). substH H with (disjUnionList_elim H). apply disjUnionList_intro. unfold itr in * . subst M'. sep lift 4. replace (MemMod.put (MemMod.put M (R SP - 2) (pc + 1)) (R SP - 2 + 1) x) with ((MemUpdW M (R SP - 2) (pc + 1) x)). sep upd. sep matchH H with 6. sep on. sep lift 1 in H0. sep stksplit in H0. sep lift 1 in H0. sep trivial. trivial. Qed. *) Lemma call_fun_frame2: forall M M' R R' fl fl' isr isr' M2 M12 cthM2 cthM12 cthM11 pc f w stkspace, disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11 :: nil) M -> (R SP |->w w *^* stkSpacePrec (R SP) (stkspace + 2)) cthM11 -> nextS pc (comml (_call f)) (M, R, fl, isr) (M', R', fl', isr') -> exists junk1, (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk1 *^* (R' SP + 2 |->w w) *^* (stkSpacePrec (R' SP) stkspace)) (MemUpdW cthM11 (R' SP) (pc + 1) junk1) /\ disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: (MemUpdW cthM11 (R' SP) (pc + 1) junk1) :: nil) M'. Proof. intros. assert ((eqM cthM11 *^* DUL2mstar (M2 :: M12 :: cthM2 :: cthM12 :: nil)) M). assert (DUL2mstar (M2 :: M12 :: cthM2 :: cthM12 :: cthM11 :: nil) M). apply DUL2mstar_left; auto. unfold DUL2mstar in *. sep on. sep matchH H2 with 6. unfold mstar at 1 in H2. InvertAll. unfold eqM in H2. subst x. destruct (nextS_inversion H1). InvertAll. substH H10 with (MemUpd16_MemUpdW H10). destruct H10 as [junk H10]. exists junk. split. unfold MemUpdW. sep on. sep lift 1. sep upd2. sep lift 3. sep upd2. subst R'. reg simpl. assert (R SP - 2 + 2 = R SP). auto. rewrite H6. sep lift 1 in H0. sep stksplit in H0. assert (stkspace + 2 - 2= stkspace). auto. rewrite H9 in H0. sep lift 3. sep match_left H0; auto. assert (MemMod.disjUnion (MemUpdW cthM11 (R' SP) (pc+1) junk) x0 M'). subst R'. reg simpl. assert (MemMod.in_dom (R SP - 2) cthM11 /\ MemMod.in_dom (R SP - 2 + 1) cthM11). sep on. sep lift 1 in H0. sep stksplit in H0. sep lift 1 in H0. apply ptoxW_indom1 with (R SP |->w w *^* stkSpacePrec (R SP - 2) (stkspace + 2 - 2)); auto. inversion_clear H6. subst M'. unfold MemUpdW. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left; auto. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (R SP - 2 + 1) (R SP - 2)); auto. exists (pc+1). auto. set (cthM11' := MemUpdW cthM11 (R' SP) (pc + 1) junk) in *. cut (DUL2mstar (M2 :: M12 :: cthM2 :: cthM12 :: cthM11' :: nil) M'). intro. apply DUL2mstar_right; auto. unfold DUL2mstar. sep on. sep lift 4. exists cthM11'. exists x0. split_l. split. unfold eqM. auto. unfold DUL2mstar in H5. sep on. sep matchH H5 with 5. Qed. Lemma split_blk_Q: forall T tid RdyQ B M w BlkQ, (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M -> B w = Some BlkQ -> ((embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* (ptoTQ w (filterTQ T BlkQ))) *^* (embed_WQSet T (WQSetMod.remove B w))) M. Proof. intros. sep on. sep matchH H with 3. sep off. assert (B = (WQSetMod.put (WQSetMod.remove B w) w BlkQ)). rewrite (WQSetMod.put_cancel_remove B w BlkQ). apply WQSetMod.extensional_eqMap. intro. unfold WQSetMod.put. destruct (WQSetMod.beq_A x w). rewrite e;assumption. reflexivity. rewrite H1 in H. assert (WQSetMod.not_in_dom w (WQSetMod.remove B w)). auto with PMap. substH H with (embed_WQSet_inv_cons T (WQSetMod.remove B w) w BlkQ M H H2). destruct H as [M1 [M2 [P1 [P2 P3]]]]. exists M2;exists M1. intuition. Qed. Lemma enable_unblk_monotonic: forall w wqa, monotonic_p (enable_unblk w wqa). Proof. intros. unfold enable_unblk. set (p0 := fun S0 => (pTrue *<* (S_RF S0 SP |->w w *^* (wqa *^* stkSpacePrec (S_RF S0 SP) (_UNBLK_Stk + 2)))) S0). set (p1 := fun (S0 : State) => Delta w = SomeT wqa). assert (monotonic_p p0). unfold monotonic_p. intros. induction S as (((M0, R0), fl0), isr0). unfold p0. unfold p0 in H. simplS. simplS in H. unfold S_Mem in H0. assert (exists M0', MemMod.disjUnion M0 M0' M). apply MemMod.subseteq_split; auto. unfold pmstar in H. simplS in H. InvertAll. unfold pmstar. simplS. exists (MemMod.merge x0 x). exists x1. unfold pTrue. split; auto. cut (MemMod.disjUnion x1 (MemMod.merge x0 x) M). auto with PMap. apply MemMod.disjUnion_assoc_left_right; auto. inversion_clear H1; auto with PMap. assert (MemMod.disjUnion x1 x0 M0). auto with PMap. inversion H3. rewrite H6 in H2. auto. assert (monotonic_p p1). unfold monotonic_p. intros. unfold p1. unfold p1 in H0. auto. assert (monotonic_p (fun S => p1 S /\ p0 S)). unfold monotonic_p. intros. InvertAll. split. unfold monotonic_p in H0. apply H0; auto. unfold monotonic_p in H. apply H; auto. unfold p0 in H1. unfold p1 in H1. auto. Qed. Hint Resolve enable_unblk_monotonic. Lemma enter_BLK_grt2_auxc_hyp1: forall M M1 M2 M11 M12 M21 M22, MemMod.disjUnion M1 M2 M -> MemMod.disjUnion M11 M12 M1 -> MemMod.disjUnion M21 M22 M2 -> MemMod.disjoint M21 M11. Proof. intros. assert (MemMod.disjoint M1 M21). inversion_clear H1. subst M2. inversion_clear H. apply MemMod.disj_x_merge_disj_left with M22; auto. inversion_clear H0. subst M1. cut (MemMod.disjoint M11 M21). intro. auto with PMap. apply MemMod.disj_merge_disj_left with M12; auto. Qed. Lemma enter_BLK_grt2_auxc_hyp2: forall M M1 M2 M21 M22 M221 M222, MemMod.disjUnion M1 M2 M -> MemMod.disjUnion M21 M22 M2 -> MemMod.disjUnion M221 M222 M22 -> MemMod.disjoint M1 M221. Proof. intros. assert (MemMod.disjoint M1 M22). inversion_clear H0. subst M2. apply MemMod.disj_x_merge_disj_right with M21; auto. inversion H; auto. inversion H1. subst M22. apply MemMod.disj_x_merge_disj_left with M222; auto. Qed. Lemma enter_BLK_grt2_auxc_hyp4: forall M'2 M0 cthM_old cthM0 cthM2 cthM_oldStk oldStk1 oldStk2, MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old -> MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion oldStk1 oldStk2 cthM_oldStk -> MemMod.disjUnion (MemMod.merge M0 oldStk1) (MemMod.merge oldStk2 cthM0) (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). Proof. intros. assert ((eqM cthM0 *^* eqM M0 *^* (eqM oldStk1 *^* eqM oldStk2)) (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk)). exists (MemMod.merge cthM0 M0). exists cthM_oldStk. split. split; auto. apply MemMod.disj_merge_B. inversion_clear H. apply MemMod.disj_merge_disj_left with cthM2; auto. inversion_clear H. subst cthM_old. apply MemMod.disj_x_merge_disj_right with (MemMod.merge cthM0 cthM2); auto. inversion H0; auto. split. exists cthM0. exists M0. unfold eqM. split; auto. split; auto. assert (MemMod.disjoint M0 (MemMod.merge cthM0 cthM2)). inversion_clear H. subst cthM_old. apply MemMod.disj_x_merge_disj_left with cthM_oldStk; auto. inversion H0; auto. assert (MemMod.disjoint M0 cthM0). apply MemMod.disj_x_merge_disj_left with cthM2; auto. auto with PMap. exists oldStk1. exists oldStk2. unfold eqM. auto. set (Mx := MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk) in *. assert ((eqM M0 *^* eqM oldStk1 *^* (eqM oldStk2 *^* eqM cthM0)) Mx). sep on. sep matchH H2 with 4. unfold mstar in H3. unfold eqM in H3. InvertAll. subst x1 x2 x3 x4. inversion_clear H7. inversion_clear H5. subst x x0. auto. Qed. Lemma enter_BLK_grt2_auxc_hyp5: forall M'2 M0 cthM_old cthM0 cthM2 cthM_oldStk sp w junk m, MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old -> MemMod.disjUnion M0 cthM_old M'2 -> (sp |-> w *^* sp + 1 |-> junk *^* m) cthM_oldStk -> (sp |~>w w) (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). Proof. intros. assert ((sp |->w w *^* m) cthM_oldStk). apply ptoW_intro1 with junk; auto. clear H1. assert ((eqM cthM0 *^* eqM M0 *^* eqM cthM_oldStk) (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk)). exists (MemMod.merge cthM0 M0). exists cthM_oldStk. split. split; auto. apply MemMod.disj_merge_B. inversion_clear H. apply MemMod.disj_merge_disj_left with cthM2; auto. inversion_clear H. subst cthM_old. apply MemMod.disj_x_merge_disj_right with (MemMod.merge cthM0 cthM2); auto. inversion H0; auto. split. exists cthM0. exists M0. unfold eqM. split; auto. split; auto. assert (MemMod.disjoint M0 (MemMod.merge cthM0 cthM2)). inversion_clear H. subst cthM_old. apply MemMod.disj_x_merge_disj_left with cthM_oldStk; auto. inversion H0; auto. assert (MemMod.disjoint M0 cthM0). apply MemMod.disj_x_merge_disj_left with cthM2; auto. auto with PMap. unfold eqM. auto. sep on. sep lift 2 in H1. assert (forall M, eqM cthM_oldStk M -> (sp |->w w *^* m) M). intros. unfold eqM in H3. subst M. auto. sep weaker_subst in H1 with (sp |->w w *^* m). sep on. sep lift 0 in H1. sep trivial. Qed. Lemma enter_SW_grt2_auxc_auxx: forall cthM1 cthM11 cthM12 cthM11_1 cthM11_2 INVM cthM0 cthM' sp pc junk, MemMod.disjUnion cthM11 cthM12 cthM1 -> MemMod.disjUnion INVM cthM0 cthM12 -> MemMod.disjUnion cthM11_1 cthM11_2 cthM11 -> (sp - 2 |->w_ ) cthM11_2 -> cthM' = MemUpdW cthM1 (sp - 2) (pc + 1) junk -> MemMod.disjUnion (MemMod.merge (MemUpdW cthM11_2 (sp - 2) (pc+1) junk) cthM0) (MemMod.merge INVM cthM11_1) cthM'. Proof. intros. assert ((eqM cthM11_1 *^* eqM cthM11_2 *^* (eqM INVM *^* eqM cthM0)) cthM1). exists cthM11. exists cthM12. split; auto. split. exists cthM11_1. exists cthM11_2. unfold eqM. auto. exists INVM. exists cthM0. unfold eqM. auto. assert (MemMod.disjUnion (MemUpdW (MemMod.merge cthM11_2 cthM0) (sp-2) (pc+1) junk) (MemMod.merge INVM cthM11_1) cthM'). subst cthM'. unfold MemUpdW. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left. assert ((eqM cthM11_2 *^* eqM cthM0 *^* (eqM INVM *^* eqM cthM11_1)) cthM1). sep on. sep matchH H4 with 4. unfold mstar at 1 in H3. InvertAll. unfold mstar in H3. InvertAll. unfold eqM in H3, H9. subst x1 x2. inversion_clear H6. subst x. unfold mstar in H7. InvertAll. unfold eqM in H7, H9. subst x x1. inversion_clear H6. subst x0. auto. apply MemMod.merge_presv_indom_left. eapply enter_BLK_grt2_auxc_hyp01; eauto. assert (MemMod.in_dom (sp - 2 + 1) (MemMod.merge cthM11_2 cthM0)). apply MemMod.merge_presv_indom_left. eapply enter_BLK_grt2_auxc_hyp02; eauto. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (sp - 2 + 1) (sp - 2)). exists (pc+1). auto. auto. assert (MemMod.disjUnion (MemUpdW cthM11_2 (sp - 2) (pc + 1) junk) cthM0 (MemUpdW (MemMod.merge cthM11_2 cthM0) (sp - 2) (pc + 1) junk)). unfold MemUpdW. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left. split; auto. assert ((eqM cthM11_2 *^* eqM cthM0 *^* (eqM INVM *^* eqM cthM11_1)) cthM1). sep on. sep matchH H4 with 4. unfold mstar at 1 in H6. InvertAll. unfold mstar in H6. InvertAll. unfold eqM in H6, H11. subst x1 x2. inversion_clear H8. auto. eapply enter_BLK_grt2_auxc_hyp01; eauto. assert (MemMod.in_dom (sp - 2 + 1) cthM11_2). eapply enter_BLK_grt2_auxc_hyp02; eauto. unfold MemMod.in_dom. unfold MemMod.put. induction (MemMod.beq_A (sp - 2 + 1) (sp - 2)). exists (pc+1). auto. auto. inversion_clear H6. rewrite H8 in H5. auto. Qed. Lemma enter_SW_grt2_auxc_hypx: forall sp w junk oldStk2 cthM11_2, (sp |-> w *^* sp + 1 |-> junk) oldStk2 -> (sp |->w_ ) cthM11_2 -> MemUpdW cthM11_2 sp w junk = oldStk2. Proof. intros. assert ((sp |-> w *^* sp+1 |-> junk) (MemUpdW cthM11_2 sp w junk)). sep on. sep lift 1. unfold MemUpdW. sep upd2. sep lift 1. sep upd2. auto. assert (uniqueM (sp |-> w *^* sp + 1 |-> junk)). apply mstar_presv_uniqueM; apply pto_uniqueM. unfold uniqueM in H2. apply H2; auto. Qed. Lemma ext_unblockedT_presv_WQSet: forall T tid tcb B M, embed_WQSet T B M -> unblocked tid B -> embed_WQSet (TQMod.put T tid tcb) B M. Proof. intros T tid tcb B M H. induction H. intro. apply wq_emp. intro. apply wq_cons with M M'; auto. apply IHembed_WQSet. unfold unblocked in *. intros. apply H3 with w. unfold WQSetMod.maps_to. unfold WQSetMod.put. induction (WQSetMod.beq_A w l). subst w. unfold WQSetMod.not_in_dom in H0. unfold WQSetMod.maps_to in H4. rewrite H4 in H0. inversion H0. auto. assert (filterTQ T Q = filterTQ (TQMod.put T tid tcb) Q). apply TQMod.extensional_eqMap. unfold filterTQ. intro x. assert ((exists y, Q x = Some y) \/ Q x = None). induction (Q x); auto. left. exists a. auto. inversion_clear H4. inversion_clear H5. rewrite H4. unfold TQMod.put. induction (TQMod.beq_A x tid). subst x. unfold unblocked in H3. assert (WQMod.not_in_dom tid Q). apply H3 with l. auto with PMap. unfold WQMod.not_in_dom in H5. rewrite H5 in H4. inversion H4. auto. rewrite H5. auto. rewrite <- H4. auto. Qed. Lemma enable_sw_nxt_stkspace: forall p pc S S' M1 M2, enable_sw p -> nextS pc (comml (_call _SWITCH)) S S' -> MemMod.disjUnion M1 M2 (S_Mem S) -> imprec p (S_Mem_Upd S M1) -> exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ (S_RF S' SP |->w (pc+1) *^* stkSpacePrec (S_RF S' SP) 8 *^* mTrue) M1'. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. unfold enable_sw in H. assert ((mTrue *^* (INV0 *^* INV1 *^* stkSpacePrec (R SP) (_SW_Stk + 2))) M1). unfold imprec in H2. unfold pmstar in H2. InvertAll. simplS in H3. simplS in H2. assert ((pTrue *<* (INV0 *^* INV1 *^* stkSpacePrec (S_RF (x, R, fl, isr) SP) (_SW_Stk + 2))) (x, R, fl, isr)). apply H; auto. unfold S_RF in H4. unfold pmstar in H4. InvertAll. exists (MemMod.merge x1 x0). exists x2. split. unfold S_Mem in H6. assert (MemMod.disjUnion x2 (MemMod.merge x1 x0) M1). apply MemMod.disjUnion_assoc_left_right; auto. inversion_clear H6. auto with PMap. assert (MemMod.disjUnion x2 x1 x); auto with PMap. inversion_clear H7. rewrite <- H10. auto. auto with PMap. unfold mTrue. auto. clear H. assert (frame (nextS pc (comml (_call _SWITCH)))). apply frame_call. unfold frame in H. assert (exists M1', MemMod.disjUnion M1' M2 (S_Mem (M', R', fl', isr')) /\ nextS pc (comml (_call _SWITCH)) (S_Mem_Upd (M, R, fl, isr) M1) (S_Mem_Upd (M', R', fl', isr') M1')). apply H; auto. clear H. UnfoldStateAll. unfold enableS. exists (MemUpdW M1 (R SP - 2) (pc+1) 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_call. unfold pushW. split. sep on. sep lift 3 in H3. sep stksplit 2 in H3. sep lift 0 in H3. sep trivial. split; auto. apply MemUpdW_MemUpd16 with 0; auto. clear H. UnfoldStateAll. InvertAll. exists x. split_l. destruct (nextS_inversion H5). InvertAll. subst R'. reg simpl. substH H11 with (MemUpd16_MemUpdW H11). InvertAll. subst x. sep on. sep lift 3 in H3. sep stksplit in H3. sep lift 1 in H3. assert (MemUpdW M1 (R SP - 2) (pc + 1) x0 ||- R SP - 2 |->w (pc+1) *^* (mTrue *^* (INV0 *^* INV1) *^* stkSpacePrec (R SP - 2) (_SW_Stk + 2 - 2))). sep upd. auto. assert (MemUpdW M1 (R SP - 2) (pc + 1) x0 ||- R SP - 2 |->w pc + 1 *^* stkSpacePrec (R SP - 2) (_SW_Stk + 2 - 2) *^* ((INV0 *^* INV1) *^* mTrue)). sep matchH H7 with 5. destruct H10 as [M1x [M1y [Hsplit [HM1x HM1y]]]]. exists M1x. exists M1y. split; auto. unfold mTrue. split; auto. Qed. Lemma enable_sw_stkspace: forall p S, enable_sw p -> p S -> exists M1, exists M2, MemMod.disjUnion M1 M2 (S_Mem S) /\ stkSpacePrec (S_RF S SP) (8 + 2) M1 /\ ((INV0 *^*INV1) *^* mTrue) M2. Proof. intros. unfold enable_sw in H. assert ((pTrue *<* (INV0 *^* INV1 *^* stkSpacePrec (S_RF S SP) (_SW_Stk + 2))) S). apply H; auto. induction S as (((M, R), fl), isr). simplS. simplS in H1. assert ((mTrue *^* (INV0 *^* INV1 *^* stkSpacePrec (R SP) (_SW_Stk + 2))) M). unfold pmstar in H1. InvertAll. exists x. exists x0. unfold mTrue. auto. sep on. sep lift 3 in H2. sep off. unfold mstar at 1 in H2. InvertAll. exists x. exists x0. split_l. split_l. sep on. sep matchH H5 with 3. Qed. Lemma enter_SW_grt_hype: forall S' cthM'1 cthM'2 cthM11'' cthM12 cthM2 cthM' fl, NH_Inv (S_Flag S') cthM'2 -> fl _IF = S_Flag S' _IF -> MemMod.disjUnion cthM'1 cthM'2 cthM' -> disjUnionList (cthM2 :: cthM12 :: cthM11'' :: nil) cthM' -> NH_Inv fl cthM2 -> (cthM2 = cthM'2) /\ (cthM'1 = MemMod.merge cthM12 cthM11''). Proof. intros. assert (exists cthM'1', MemMod.disjUnion cthM2 cthM'1' cthM' /\ disjUnionList (cthM12 :: cthM11'' :: nil) cthM'1'). unfold disjUnionList in *. inversion_clear H2. exists x. inversion_clear H4. split; auto. InvertAll. rename x into cthM'1'. assert (cthM2 = cthM'2). unfold NH_Inv in *. rewrite <- H0 in H. induction (fl _IF). assert (precise (INV0 *^* INV1)). apply mstar_presv_prec; auto. apply Prec0. apply Prec1. unfold precise in H5. apply H5 with cthM'. apply MemMod.disjUnion_subseteq_left with cthM'1'; auto. apply MemMod.disjUnion_subseteq_right with cthM'1; auto. auto. auto. assert (precise Aemp). auto. unfold precise in H5. apply H5 with cthM'; auto. apply MemMod.disjUnion_subseteq_left with cthM'1'; auto. apply MemMod.disjUnion_subseteq_right with cthM'1; auto. split_l. assert (cthM'1' = cthM'1). rewrite <- H5 in H1. apply MemMod.disjUnion_unique with cthM2 cthM2 cthM'; auto. auto with PMap. rewrite <- H7. unfold disjUnionList in H6. InvertAll. subst x0. assert (cthM11'' = x). auto with PMap. subst x. inversion_clear H9. auto. Qed. coq/SCAP/IH_SW.v0000644000107400000620000021264011000223235012674 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas4. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import Reg. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import SCAP_Itr. Require Import Linking. Require Import Linking_Lemmas. Require Import Linking_Lemmas2. Require Import Linking_Lemmas3. Require Import EqNat. Require Import Omega. Require Import List. Require Import Arith_Lemmas. Lemma imprec_presv_ih_enable_sw: forall p, ih_enable_sw p -> ih_enable_sw (imprec p). Proof. intro p. unfold ih_enable_sw. intro. set (Fm1 := (fun S0 => (INV0 *^* stkSpacePrec (S_RF S0 SP) (_SW_Stk + 2)))). set (p0 := (fun S0 => (pTrue *<* (Fm1 S0)) S0)). assert (monotonic_p p0). unfold monotonic_p. intros. induction S as (((M0, R0), fl0), isr0). unfold p0. unfold p0 in H0. simplS. unfold Fm1 in *. simplS in H0. unfold S_Mem in H1. assert (exists M0', MemMod.disjUnion M0 M0' M). apply MemMod.subseteq_split; auto. unfold pmstar in H0. simplS in H0. InvertAll. unfold pmstar. simplS. exists (MemMod.merge x0 x). exists x1. unfold pTrue. split; auto. cut (MemMod.disjUnion x1 (MemMod.merge x0 x) M). auto with PMap. apply MemMod.disjUnion_assoc_left_right; auto. inversion_clear H2; auto with PMap. assert (MemMod.disjUnion x1 x0 M0). auto with PMap. inversion H4. rewrite H7 in H3. auto. set (q := (fun S0 => S_ISR S0 = false)). assert (monotonic_p q). unfold q. auto. set (q' := (fun S => p0 S /\ q S)). assert (forall S0 : State, imprec p S0 -> q' S0). assert (monotonic_p q'). unfold q'. apply monotonic_conj; auto. apply (imprec_presv_imp_monotonic H2 H); auto. auto. Qed. Hint Resolve imprec_presv_ih_enable_sw. Lemma IH_SW_progress: forall psi pc theta Psi a S, IH_WFcmd psi pc theta (comml (_call _SWITCH)) -> a = Itp_AIM rho_ih theta -> a Psi S -> exists S', nextS pc (comml (_call _SWITCH)) S S'. Proof. intros. induction theta. assert (imprec p S). rewrite H0 in H1. apply Itp_AIM_imprecp with g n Psi rho_ih; auto. unfold IH_WFcmd in H. inversion_clear H. inversion_clear H3. clear H. unfold IH_Call_SW in H4. InvertAll. assert (ih_enable_sw (imprec p)). auto. unfold ih_enable_sw in H6. assert ((pTrue *<* (INV0 *^* stkSpacePrec (S_RF S SP) (_SW_Stk + 2))) S /\ S_ISR S = false). apply H6; auto. inversion_clear H8. apply stkSpace_call_prog with (_SW_Stk + 2). assert (((INV0 *^* stkSpacePrec (S_RF S SP) (_SW_Stk + 2)) *^* mTrue) (S_Mem S)). apply pTrue_m_mTrue with pTrue; auto. apply mstar_mTrue with INV0 mTrue; auto. omega. inversion H3. absurd (prim_entry _SWITCH); auto. unfold prim_entry. left. auto. Qed. Lemma enable_sw_nxt_stkspace_ih: forall p pc S S' M1 M2, ih_enable_sw p -> nextS pc (comml (_call _SWITCH)) S S' -> MemMod.disjUnion M1 M2 (S_Mem S) -> imprec p (S_Mem_Upd S M1) -> exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ (S_RF S' SP |->w (pc+1) *^* stkSpacePrec (S_RF S' SP) 8 *^* mTrue) M1'. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. unfold ih_enable_sw in H. assert ((mTrue *^* (INV0 *^* stkSpacePrec (R SP) (_SW_Stk + 2))) M1). unfold imprec in H2. unfold pmstar in H2. InvertAll. simplS in H3. simplS in H2. assert ((pTrue *<* (INV0 *^* stkSpacePrec (S_RF (x, R, fl, isr) SP) (_SW_Stk + 2))) (x, R, fl, isr) /\ S_ISR (x, R, fl, isr) = false). apply H; auto. inversion_clear H4. clear H7. rename H6 into H4. unfold S_RF in H4. unfold pmstar in H4. InvertAll. exists (MemMod.merge x1 x0). exists x2. split. unfold S_Mem in H6. assert (MemMod.disjUnion x2 (MemMod.merge x1 x0) M1). apply MemMod.disjUnion_assoc_left_right; auto. inversion_clear H6. auto with PMap. assert (MemMod.disjUnion x2 x1 x); auto with PMap. inversion_clear H7. rewrite <- H10. auto. auto with PMap. unfold mTrue. auto. clear H. assert (frame (nextS pc (comml (_call _SWITCH)))). apply frame_call. unfold frame in H. assert (exists M1', MemMod.disjUnion M1' M2 (S_Mem (M', R', fl', isr')) /\ nextS pc (comml (_call _SWITCH)) (S_Mem_Upd (M, R, fl, isr) M1) (S_Mem_Upd (M', R', fl', isr') M1')). apply H; auto. clear H. UnfoldStateAll. unfold enableS. exists (MemUpdW M1 (R SP - 2) (pc+1) 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_call. unfold pushW. split. sep on. sep lift 2 in H3. sep stksplit 2 in H3. sep lift 0 in H3. sep trivial. split; auto. apply MemUpdW_MemUpd16 with 0; auto. clear H. UnfoldStateAll. InvertAll. exists x. split_l. destruct (nextS_inversion H5). InvertAll. subst R'. reg simpl. substH H11 with (MemUpd16_MemUpdW H11). InvertAll. subst x. sep on. sep lift 0. sep upd. sep lift 2 in H3. sep stksplit in H3. sep lift 1 in H3. sep match_left H3; auto. assert (_SW_Stk + 2 - 2 = _SW_Stk). auto. rewrite H7 in H3. sep lift 2 in H3. sep match_left H3; auto. Qed. Lemma enter_SW_pre_ih: forall psi pc theta Psi'0 S S', IH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Itp_AIM rho_ih theta Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> SW_Prd S'. Proof. intros. unfold SW_Prd. induction theta. unfold Itp_AIM in H0. InvertAll. rename x into T. rename x0 into B. rename x1 into RdyQ. rename x2 into tid. exists T. exists RdyQ. exists tid. rename n into tag. unfold IH_WFcmd in H. inversion_clear H. inversion_clear H2. clear H. unfold IH_Call_SW in H3. InvertAll. clear H. induction S as (((M, R), fl), isr). exists (S_RF S' SP). unfold pmstar in H0. InvertAll. rename x1 into M1. rename x2 into M2. assert (exists tcb, TQMod.maps_to T tid tcb). apply WF_AIM_World_currTCB with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ rho_ih (Ast p g tag); auto. inversion_clear H5. rename x1 into tcb. exists tcb. exists (pc+1). split. Lemma enter_SW_preMem_ih: forall pc S S' p g tag M1 M2 Psi T B RdyQ tid, nextS pc (comml (_call _SWITCH)) S S' -> ih_enable_sw p -> MemMod.disjUnion M1 M2 (S_Mem S) -> WF_AIM_World Psi (S_Mem_Upd S M1) T B RdyQ tid rho_ih (Ast p g tag) -> (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M2 -> exists junk, (SW_MPre T RdyQ tid (S_RF S' SP) (pc+1) junk *^* mTrue) (S_Mem S'). Proof. intros. assert (imprec p (S_Mem_Upd S M1)). apply WF_AIM_World_imprecp with Psi T B RdyQ tid rho_ih g tag; auto. unfold SW_MPre. assert (exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ (S_RF S' SP |->w (pc+1) *^* stkSpacePrec (S_RF S' SP) 8 *^* mTrue) M1'). apply enable_sw_nxt_stkspace_ih with p S M1; auto. InvertAll. rename x into M1'. assert (exists junk, (S_RF S' SP |-> pc + 1 *^* S_RF S' SP + 1 |-> junk *^* stkSpacePrec (S_RF S' SP) 8 *^* mTrue) M1'). sep on. sep lift 0 in H7. assert (exists junk, M1' ||- S_RF S' SP |-> pc + 1 *^* S_RF S' SP + 1 |-> junk *^* (stkSpacePrec (S_RF S' SP) 8 *^* mTrue)). apply ptoW_elim1; auto. inversion H6. exists x. sep on. sep matchH H8 with 4. inversion_clear H6. clear H7. exists x. apply merge_SW_pre with M1' M2 B; auto. Qed. apply enter_SW_preMem_ih with (M, R, fl, isr) p g tag M1 M2 Psi'0 B; auto. split; auto. split; auto. apply WF_AIM_World_RdyQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B tid rho_ih (Ast p g tag); auto. split; auto. split. apply WF_AIM_World_cthNotRdy with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) T B rho_ih (Ast p g tag); auto. apply WF_AIM_World_WFTQ with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ih (Ast p g tag); auto. inversion_clear H2. absurd (prim_entry _SWITCH); auto. unfold prim_entry. left. auto. Qed. Lemma enable_sw_stkspace_ih: forall p S, ih_enable_sw p -> p S -> exists M1, exists M2, MemMod.disjUnion M1 M2 (S_Mem S) /\ stkSpacePrec (S_RF S SP) (8 + 2) M1 /\ (INV0 *^* mTrue) M2. Proof. intros. unfold ih_enable_sw in H. assert ((pTrue *<* (INV0 *^* stkSpacePrec (S_RF S SP) (_SW_Stk + 2))) S /\ S_ISR S = false). apply H; auto. inversion_clear H1. clear H3. rename H2 into H1. induction S as (((M, R), fl), isr). simplS. simplS in H1. assert ((mTrue *^* (INV0 *^* stkSpacePrec (R SP) (_SW_Stk + 2))) M). unfold pmstar in H1. InvertAll. exists x. exists x0. unfold mTrue. auto. sep on. sep lift 2 in H2. sep off. unfold mstar at 1 in H2. InvertAll. exists x. exists x0. split_l. split_l. sep on. sep matchH H5 with 2. Qed. Lemma decompose_World_ih: forall Psi T B RdyQ tid p g tag M1 R fl isr, WF_AIM_World Psi (M1, R, fl, isr) T B RdyQ tid rho_ih (Ast p g tag) -> exists TM, exists cthM, exists M12, exists cthM1, exists cthM2, MemMod.disjUnion M12 cthM M1 /\ MemMod.disjUnion cthM1 cthM2 cthM /\ WF_currTID tid T B RdyQ rho_ih /\ WF_TWQ T B RdyQ /\ exists_Idle T RdyQ tid /\ WF_WQ_WQSpec B Delta /\ MemSplit (ThrdMemMod.remove TM tid) M12 /\ ThrdMemMod.maps_to TM tid cthM /\ WF_Curr_Thrd Psi (S_Mem_Upd (M1, R, fl, isr) cthM) rho_ih (Ast p g tag) T tid /\ WF_ReadyQ Psi T RdyQ TM /\ WF_WQSet Psi T B TM /\ p (cthM1, R, fl, isr) /\ INV1 cthM2. Proof. intros. unfold WF_AIM_World in H. InvertAll. rename x into TM. rename x0 into cthM. exists TM. exists cthM. assert (exists M12, MemMod.disjUnion M12 cthM M1 /\ MemSplit (ThrdMemMod.remove TM tid) M12). apply memsplit_thrd_remove; auto. InvertAll. rename x into M12. exists M12. assert (pmstar p INV1 (cthM, R, fl, isr)). unfold WF_Curr_Thrd in H5. assert (beq_nat rho_ih rho_ih = true). simpl. auto. rewrite H9 in H5. InvertAll. unfold itp_IH_theta in H13. inversion_clear H13. inversion_clear H14. unfold lift_IH_PG in H13. InvertAll. UnfoldStateAll. auto. InvertAll. UnfoldStateAll. auto. unfold pmstar in H9. InvertAll. rename x into cthM1. rename x0 into cthM2. exists cthM1. exists cthM2. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. Qed. Lemma WFcallsw_enablesw_ih: forall psi pc p g tag, IH_WFcmd psi pc (Ast p g tag) (comml (_call _SWITCH)) -> ih_enable_sw p. Proof. intros. unfold IH_WFcmd in H. inversion_clear H. unfold IH_Call_SW in H0. InvertAll. auto. absurd (prim_entry _SWITCH); auto. inversion H0. auto. unfold prim_entry. left. auto. Qed. Lemma call_sw_flags_false_ih: forall p g tag psi Psi pc M M' R fl isr T tid, WF_Curr_Thrd Psi (M, R, fl, isr) rho_ih (Ast p g tag) T tid -> IH_WFcmd psi pc (Ast p g tag) (comml (_call _SWITCH)) -> p (M', R, fl, isr) -> (fl _IF = false) /\ (isr = false). Proof. intros. unfold IH_WFcmd in H0. inversion_clear H0. unfold IH_Call_SW in H2. InvertAll. unfold ih_enable_sw in H4. assert ((pTrue *<* (INV0 *^* stkSpacePrec (S_RF (M', R, fl, isr) SP) (_SW_Stk + 2))) (M', R, fl, isr) /\ S_ISR (M', R, fl, isr) = false). apply H4; auto. inversion_clear H6. unfold S_ISR in H9. split; auto. unfold WF_Curr_Thrd in H. assert (beq_nat rho_ih rho_ih = true). simpl. auto. rewrite H6 in H. InvertAll. unfold itp_IH_theta in H12. inversion_clear H12. unfold S_Flag in H11. auto. inversion H2. absurd (prim_entry _SWITCH). auto. unfold prim_entry. left. auto. Qed. Lemma call_sw_nextPC_spec_ih: forall psi pc p g tag, IH_WFcmd psi pc (Ast p g tag) (comml (_call _SWITCH)) -> exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun ih_gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun ih_gy pc _SWITCH pc') oo g') g). Proof. intros. unfold IH_WFcmd in H. inversion_clear H. unfold IH_Call_SW in H0. InvertAll. exists x. exists x0. split; auto. inversion_clear H0. absurd (prim_entry _SWITCH); auto. unfold prim_entry. left. auto. Qed. Hint Resolve call_sw_nextPC_spec_ih. Lemma psi_sw_lookupNPC_ih: forall psi Psi Psi' Psi'0 p' g' tag pc, lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> subsetCT Psi' Psi'0 -> SCAP_lookupCT psi pc (Ast p' g' tag) -> lookupCT Psi'0 pc (packS0 rho_ih (Ast p' g' tag)). Proof. intros. subst Psi'. apply subsetCT_presv_loopup with (ext_Prim_Specs Psi); auto. unfold lift_psi in H. assert (lookupCT Psi pc (packS0 rho_ih (Ast p' g' tag))). apply H; auto. assert (subsetCT Psi (ext_Prim_Specs Psi)). unfold ext_Prim_Specs. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. apply subsetCT_presv_loopup with Psi; auto. Qed. Lemma enter_SW_grt_auxb0_ih: forall cthM1 R fl isr M cthM11 cthM12 S' cthM11'' pc pc' M' R' fl' isr' junk S0, MemMod.disjUnion cthM11 cthM12 cthM1 -> (INV0 *^* mTrue) cthM12 -> stkSpacePrec (R SP) (8 + 2) cthM11 -> (S_RF S' SP - 2 |-> pc + 1 *^* S_RF S' SP - 2 + 1 |-> junk *^* stkSpacePrec (S_RF S' SP - 2) 8) cthM11'' -> nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> nextS pc' (comms _retw) S0 S' -> S_RF S0 SP = R' SP -> MemMod.subseteq (MemMod.merge cthM12 cthM11'') (S_Mem S') -> isr = S_ISR S' -> fl _IF = S_Flag S' _IF -> MemMod.disjoint cthM11'' cthM12 -> wrap_fun ih_gy pc _SWITCH pc' (cthM1, R, fl, isr) (S_Mem_Upd S' (MemMod.merge cthM12 cthM11'')). Proof. intros. unfold wrap_fun. unfold conjG. exists (S_Mem_Upd S0 (MemMod.merge cthM12 cthM11'')). split. exists (MemMod.merge cthM12 (MemUpdW cthM11 (R SP - 2) (pc+1) junk), R', fl', isr'). split. apply step_call_hyp1 with M M' _SW_Stk; auto. unfold ih_gy. exists (R' SP). split. assert (R SP - 2 = R' SP). apply enter_SW_grt_auxb0_hyp0 with pc M fl isr M' fl' isr' _SWITCH; auto. rewrite H10. assert (S_RF S' SP = S_RF S0 SP + 2). apply enter_SW_grt_auxb0_hyp1 with pc'; auto. rewrite H5 in H11. Lemma enter_SW_grt_auxb0_hyp2_ih: forall cthM12 cthM11 cthM11'' S' R' pc fl' isr' S0 sp junk, (INV0 *^* mTrue) cthM12 -> stkSpacePrec sp (8 + 2) cthM11 -> (S_RF S' SP - 2 |-> pc *^* S_RF S' SP - 2 + 1 |-> junk *^* stkSpacePrec (S_RF S' SP - 2) 8) cthM11'' -> S_RF S' SP = (R' SP) + 2 -> sp - 2 = (R' SP) -> MemMod.disjoint cthM11 cthM12 -> MemMod.disjoint cthM11'' cthM12 -> prepost (INV0 *^* stkSpacePrec (R' SP) _SW_Stk) (INV0 *^* stkSpacePrec (R' SP) _SW_Stk) (MemMod.merge cthM12 (MemUpdW cthM11 (R' SP) pc junk), R', fl', isr') (S_Mem_Upd S0 (MemMod.merge cthM12 cthM11'')). Proof. unfold prepost. intros. induction S0 as (((M0, R0), fl0), isr0). simplS. clear M0 R0 fl0 isr0. destruct H as [cthM12_1 [chtM12_2 [HcthM12split [HcthM12_1 HcthM12_2]]]]. set (cthM11' := MemUpdW cthM11 (R' SP) pc junk). assert (sp >= 2). apply ge_trans with (8 + 2); auto with arith. apply stkSpacePrec_sp_ge_sz with cthM11; auto. assert (sp = R' SP + 2). rewrite <- H3. assert (sp - 2 + 2 = sp). auto. auto. rewrite H6 in H0. assert ((R' SP |-> pc *^* R' SP + 1 |-> junk *^* stkSpacePrec (R' SP) 8) cthM11'). unfold cthM11'. apply enter_SW_grt_auxb0_hyp21. auto. rewrite H2 in H1. assert (R' SP + 2 - 2 = R' SP). auto. rewrite H8 in H1. sep on. sep lift 2 in H7. sep lift 2 in H1. destruct H7 as [cthM11'_1 [cthM11'_2 [Hsplit11' [HM11'_1 HM11'_2]]]]. destruct H1 as [cthM11''_1 [cthM11''_2 [Hsplit11'' [HM11''_1 HM11''_2]]]]. exists (MemMod.merge cthM12_1 cthM11'_1). exists (MemMod.merge chtM12_2 cthM11'_2). exists (MemMod.merge cthM12_1 cthM11''_1). split. exists cthM12_1. exists cthM11'_1. split; auto. split; auto. apply enter_SW_grt_auxb0_hyp22 with cthM11 cthM12 cthM11' chtM12_2 cthM11'_2 (R' SP) pc junk; auto. split. exists cthM12_1. exists cthM11''_1. split; auto. split; auto. apply enter_SW_grt_auxb0_hyp23 with cthM12 cthM11'' chtM12_2 cthM11''_2; auto. split. apply enter_SW_grt_auxb0_hyp24 with cthM11 (R' SP) pc junk; auto. assert (cthM11'_2 = cthM11''_2). apply enter_SW_grt_auxb0_hyp26 with (R' SP) pc junk; auto. rewrite H1. apply enter_SW_grt_auxb0_hyp25; auto. Qed. apply enter_SW_grt_auxb0_hyp2_ih with S' (R SP); auto. unfold MemMod.disjUnion in H. inversion H. auto. assert ((S_Flag S0 _IF = S_Flag S' _IF) /\ (S_ISR S0 = S_ISR S')). apply enter_SW_grt_auxb0_hyp3 with pc'; auto. inversion_clear H10. assert (S_Flag (M, R, fl, isr) _IF = S_Flag (M', R', fl', isr') _IF /\ S_ISR (M, R, fl, isr) = S_ISR (M', R', fl', isr')). apply enter_SW_grt_auxb0_hyp4 with pc _SWITCH; auto. inversion_clear H10. split. assert (S_Flag (S_Mem_Upd S0 (MemMod.merge cthM12 cthM11'')) = S_Flag S0). auto. rewrite H10. rewrite H11. rewrite <- H8. UnfoldStateAll. auto. split. assert (S_ISR (S_Mem_Upd S0 (MemMod.merge cthM12 cthM11'')) = S_ISR S0). auto. rewrite H10. rewrite H12. rewrite <- H7. UnfoldStateAll. auto. split. unfold S_RF. auto. assert (S_RF (S_Mem_Upd S0 (MemMod.merge cthM12 cthM11'')) = S_RF S0). auto. rewrite H10. rewrite H5. unfold S_RF. auto. assert (S_RF S' SP = S_RF S0 SP + 2). apply enter_SW_grt_auxb0_hyp1 with pc'; auto. rewrite H10 in H2. assert (S_RF S0 SP + 2 - 2 = S_RF S0 SP). omega. rewrite H11 in H2. apply enter_SW_grt_auxb0_hyp5 with (pc + 1) junk (stkSpacePrec (S_RF S0 SP) 8); auto. Qed. Lemma enter_SW_grt_auxb_ih: forall (p p' : Pred) cthM1 R fl isr M cthM11 cthM12 S' cthM11'' pc pc' M' R' fl' isr' junk S0, p (cthM1, R, fl, isr) -> (forall pc' : nat, pimp (p |> wrap_fun ih_gy pc _SWITCH pc') p') -> MemMod.disjUnion cthM11 cthM12 cthM1 -> (INV0 *^* mTrue) cthM12 -> stkSpacePrec (R SP) (8 + 2) cthM11 -> ((S_RF S' SP - 2 |-> pc + 1) *^* (S_RF S' SP - 2 + 1 |-> junk) *^* stkSpacePrec (S_RF S' SP - 2) 8) cthM11'' -> nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> nextS pc' (comms _retw) S0 S' -> S_RF S0 SP = R' SP -> MemMod.subseteq (MemMod.merge cthM12 cthM11'') (S_Mem S') -> isr = S_ISR S' -> fl _IF = S_Flag S' _IF -> MemMod.disjoint cthM11'' cthM12 -> p' (S_Mem_Upd S' (MemMod.merge cthM12 cthM11'')). Proof. intros. unfold pimp in H0. apply H0 with pc'. unfold linkPG. exists (cthM1, R, fl, isr). split; auto. apply enter_SW_grt_auxb0_ih with M cthM11 M' R' fl' isr' junk S0; auto. Qed. Lemma enter_SW_grt_hype_ih: forall cthM'1 cthM'2 cthM11'' cthM12 cthM2 cthM', INV1 cthM'2 -> MemMod.disjUnion cthM'1 cthM'2 cthM' -> disjUnionList (cthM2 :: cthM12 :: cthM11'' :: nil) cthM' -> INV1 cthM2 -> (cthM2 = cthM'2) /\ (cthM'1 = MemMod.merge cthM12 cthM11''). Proof. intros. assert (exists cthM'1', MemMod.disjUnion cthM2 cthM'1' cthM' /\ disjUnionList (cthM12 :: cthM11'' :: nil) cthM'1'). unfold disjUnionList in *. inversion_clear H1. exists x. inversion_clear H3. split; auto. InvertAll. rename x into cthM'1'. assert (cthM2 = cthM'2). assert (precise INV1). apply Prec1. unfold precise in H4. apply H4 with cthM'. apply MemMod.disjUnion_subseteq_left with cthM'1'; auto. apply MemMod.disjUnion_subseteq_right with cthM'1; auto. auto. auto. split_l. assert (cthM'1' = cthM'1). rewrite <- H4 in H0. apply MemMod.disjUnion_unique with cthM2 cthM2 cthM'; auto. auto with PMap. rewrite <- H6. unfold disjUnionList in H5. InvertAll. subst x0. assert (cthM11'' = x). auto with PMap. subst x. inversion_clear H8. auto. Qed. Lemma enter_SW_grt2_aux2_hyp0_ih: forall INVM cthM0 cthM12 M22 M12 cthM2 M0' M2' S0 M21' cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' -> MemMod.disjUnion M0' M2' (S_Mem S0) -> MemMod.disjUnion M21' cthM_oldStk M0' -> MemMod.disjoint cthM0 cthM_oldStk. Proof. intros. assert (MemMod.disjoint (MemMod.merge cthM0 cthM2) cthM_oldStk). apply enter_SW_grt2_aux2_hyp0 with INVM cthM12 M22 M12 M0' M2' S0 M21'; auto. apply MemMod.disj_merge_disj_left with cthM2; auto. Qed. Lemma enter_SW_grt2_aux2_hyp1_ih: forall pc' M0' M2' S0 S' M22 M12 cthM2 cthM12 M21' cthM_oldStk M122 cthMR INVM cthM0, MemMod.disjUnion M0' M2' (S_Mem S0) -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' -> MemMod.disjUnion M21' cthM_oldStk M0' -> MemMod.disjUnion M122 cthMR M12 -> MemMod.disjUnion INVM cthM0 cthM12 -> nextS pc' (comms _retw) S0 S' -> disjUnionList (M22 :: cthMR :: INVM :: M21' :: MemMod.merge cthM0 cthM_oldStk :: cthM2 :: M122 :: nil) (S_Mem S'). Proof. intros. induction S0 as (((Mx, Rx), flx), isrx). induction S' as (((My, Ry), fly), isry). UnfoldStateAll. destruct (nextS_inversion H4). subst My. clear H4 H6. assert ((eqM M21' *^* eqM cthM_oldStk *^* (DUL2mstar (M22 :: M12 :: cthM2 :: cthM12 :: nil))) Mx). exists M0'. exists M2'. split_l. split. exists M21'. exists cthM_oldStk. unfold eqM. auto. apply DUL2mstar_left; auto. unfold DUL2mstar in H4. sep on. sep lift 5 in H4. assert (forall M, eqM cthM12 M -> (eqM INVM *^* eqM cthM0) M). intros. unfold eqM in H5. subst M. exists INVM. exists cthM0. unfold eqM. auto. sep weaker_subst in H4 with (eqM INVM *^* eqM cthM0). clear H5 H6. sep lift 5 in H4. assert (forall M, eqM M12 M -> (eqM M122 *^* eqM cthMR) M). intros. unfold eqM in H5. subst M. exists M122. exists cthMR. unfold eqM. auto. sep weaker_subst in H4 with (eqM M122 *^* eqM cthMR). sep off. cut (DUL2mstar (M22 :: cthMR :: INVM :: M21' :: MemMod.merge cthM0 cthM_oldStk :: cthM2 :: M122 :: nil) Mx). apply DUL2mstar_right. unfold DUL2mstar. sep on. sep matchH H4 with 8. sep lift 2 in H4. sep off. unfold eqM. unfold mstar in H4. unfold eqM in H4. InvertAll. subst x x1. unfold Aemp in H11. subst x2. assert (cthM0 = x0). auto with PMap. subst x0. inversion_clear H7. subst h. auto with PMap. Qed. Lemma enter_SW_grt2_hyp3_ih: forall M22 cthMR INVM M21' cthM_old M122 S' cthM2, disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: cthM2 :: M122 :: nil) (S_Mem S') -> exists M'0, exists M'1, MemMod.disjUnion M'0 M'1 (S_Mem S') /\ MemMod.disjUnion M21' M22 M'1 /\ disjUnionList (cthMR :: INVM :: cthM_old :: cthM2 :: M122 :: nil) M'0. Proof. intros. induction S' as (((Mx, Rx), flx), isrx). UnfoldStateAll. assert ((eqM M21' *^* eqM M22 *^* (DUL2mstar (cthMR :: INVM :: cthM_old :: cthM2 :: M122 :: nil))) Mx). assert (DUL2mstar (M22 :: cthMR :: INVM :: M21' :: cthM_old :: cthM2 :: M122 :: nil) Mx). apply DUL2mstar_left; auto. unfold DUL2mstar in *. sep on. sep matchH H0 with 8. unfold mstar at 1 in H0. InvertAll. exists x0. exists x. split. auto with PMap. split. unfold mstar in H0. unfold eqM in H0. InvertAll. subst x1 x2. auto. apply DUL2mstar_right; auto. Qed. Lemma enter_SW_grt2_hyp7_ih: forall cthMR INVM cthM_old M122 M'0 TM TM' tid tid' cthM2, disjUnionList (cthMR :: INVM :: cthM_old :: cthM2 :: M122 :: nil) M'0 -> MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 -> TM' = ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge (MemMod.merge cthMR INVM) cthM2)) tid cthM_old -> tid <> tid' -> MemSplit TM' M'0. Proof. intros. rewrite H1. assert (DUL2mstar (cthMR :: INVM :: cthM_old :: cthM2 :: M122 :: nil) M'0). apply DUL2mstar_left; auto. unfold DUL2mstar in H3. sep on. assert (M'0 ||- eqM cthM_old *^* (eqM M122 *^* (eqM cthMR *^* eqM INVM *^* eqM cthM2))). sep matchH H3 with 5. clear H3. rename H4 into H3. sep off. unfold mstar in H3. unfold eqM in H3. InvertAll. subst x x1 x4 x5 x6. apply enter_SW_grt_hyp6 with x0; auto with PMap. assert (ThrdMemMod.remove (ThrdMemMod.put TM tid' (MemMod.merge (MemMod.merge cthMR INVM) cthM2)) tid = ThrdMemMod.put (ThrdMemMod.remove TM tid) tid' (MemMod.merge (MemMod.merge cthMR INVM) cthM2)). auto with PMap. rewrite H3. clear H3. apply enter_SW_grt_hyp6 with M122; auto. inversion_clear H9. subst x3. inversion_clear H7. subst x2. auto. Qed. Lemma enter_SW_grt2_hypa_ih: forall cthMR INVM M22 M21' cthM_old M122 cthM2 S', disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: cthM2 :: M122 :: nil) (S_Mem S') -> MemMod.disjUnion (MemMod.merge INVM cthM2) cthMR (MemMod.merge (MemMod.merge cthMR INVM) cthM2). Proof. intros. induction S' as (((Mx, Rx), flx), isrx). simplS in H. assert (DUL2mstar (M22 :: cthMR :: INVM :: M21' :: cthM_old :: cthM2 :: M122 :: nil) Mx). apply DUL2mstar_left; auto. unfold DUL2mstar in H0. assert ((eqM INVM *^* eqM cthM2 *^* eqM cthMR *^* mTrue) Mx). sep on. sep matchH H0 with 4. unfold mstar at 1 in H1. InvertAll. assert ((eqM cthMR *^* eqM INVM *^* eqM cthM2) x). sep on. sep matchH H1 with 3. unfold mstar at 1 in H1. InvertAll. unfold eqM in H7. subst x2. unfold mstar in H1. unfold eqM in H1. InvertAll. subst x2 x3. inversion_clear H6. subst x1. clear H4 H2 x0. unfold mstar in H3. unfold eqM in H3. InvertAll. subst x1 x2 x3. inversion_clear H4. subst x0. inversion_clear H2. subst x. auto. Qed. Lemma enter_SW_grt2_hypa_ih2: forall cthMR INVM M22 M21' cthM_old M122 cthM2 S', disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: cthM2 :: M122 :: nil) (S_Mem S') -> MemMod.disjoint INVM cthM2. Proof. intros. induction S' as (((M, R), fl), isr). simplS in H. assert (DUL2mstar (M22 :: cthMR :: INVM :: M21' :: cthM_old :: cthM2 :: M122 :: nil) M). apply DUL2mstar_left. auto. clear H. assert ((eqM INVM *^* eqM cthM2 *^* mTrue) M). unfold DUL2mstar in H0. sep on. sep matchH H0 with 3. unfold mstar in H. unfold eqM in H. InvertAll. subst x1 x2. inversion_clear H2; auto. Qed. Lemma enter_SW_grt2_auxc_ih_hyp0: forall M0 cthM_old M'2 M01 M02, MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion M01 M02 M0 -> MemMod.disjUnion (MemMod.merge M01 cthM_old) M02 M'2. Proof. intros. assert ((eqM M01 *^* eqM M02 *^* eqM cthM_old) M'2). exists M0. exists cthM_old. split_l. split. exists M01. exists M02. unfold eqM. auto. unfold eqM. auto. assert ((eqM M01 *^* eqM cthM_old *^* eqM M02) M'2). sep on. sep matchH H1 with 3. unfold mstar in H2. unfold eqM in H2. InvertAll. subst x0 x1 x2. inversion_clear H4. subst x. auto. Qed. Lemma enter_SW_grt2_hype_ih: forall M'2 M'20 M'21 M0 M01 M02 cthM_old, MemMod.disjUnion M'20 M'21 M'2 -> INV1 M'21 -> MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion M01 M02 M0 -> INV1 M02 -> M'20 = MemMod.merge M01 cthM_old. Proof. intros. assert (MemMod.disjUnion (MemMod.merge M01 cthM_old) M02 M'2). apply enter_SW_grt2_auxc_ih_hyp0 with M0; auto. assert (precise INV1). apply Prec1. assert (M'21 = M02). unfold precise in H5. apply H5 with M'2; auto. apply MemMod.disjUnion_subseteq_right with M'20; auto. apply MemMod.disjUnion_subseteq_right with (MemMod.merge M01 cthM_old); auto. apply MemMod.disjUnion_unique with M'21 M02 M'2; auto with PMap. Qed. Lemma enter_SW_grt2_hyp2_ih: forall T T' B RdyQ' tid tid' sp sp' tcb tcb' pc pc' S0 S' M0' M2' M22 M12 cthM2 cthM12 cthMR TM junk, SW_Post_aux T' RdyQ' tid' sp' sp tcb' pc junk (S_Mem_Upd S0 M0') -> nextS pc' (comms _retw) S0 S' -> MemMod.disjUnion M0' M2' (S_Mem S0) -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' -> embed_WQSet T B M22 -> MemSplit (ThrdMemMod.remove TM tid) M12 -> ThrdMemMod.maps_to TM tid' cthMR -> tid <> tid' -> INV1 cthM2 -> (INV0 *^* mTrue) cthM12 -> T' = TQMod.put T tid (sp, TCB_Status tcb, pc) -> exists INV0M, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INV0M cthM0 cthM12 /\ INV0 INV0M /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ') M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion cthM0 cthM_oldStk cthM_old /\ (sp |-> pc *^* sp + 1 |-> junk *^* stkSpacePrec sp 8) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INV0M :: M21' :: cthM_old :: cthM2 :: M122 :: nil) (S_Mem S'). Proof. intros. unfold mstar at 1 in H8. InvertAll. rename x into INV0M. rename x0 into cthM0. exists INV0M. exists cthM0. unfold SW_Post_aux in H. InvertAll. unfold SW_MPost in H11. assert ((embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ' *^* (sp |-> pc *^* sp + 1 |-> junk *^* stkSpacePrec sp 8)) (S_Mem (S_Mem_Upd S0 M0'))). sep on. sep matchH H11 with 4. clear H11. unfold mstar at 1 in H15. InvertAll. rename x into M21'. exists M21'. rename x0 into cthM_oldStk. assert (exists M122, MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122). apply memsplit_thrd_remove; auto. unfold ThrdMemMod.maps_to. unfold ThrdMemMod.remove. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. unfold ThrdMemMod.maps_to in H5. auto. InvertAll. rename x into M122. exists M122. exists (MemMod.merge cthM0 cthM_oldStk). exists cthM_oldStk. split; auto. split; auto. split; auto. split; auto. split; auto. split. unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_aux2_hyp0_ih with INV0M cthM12 M22 M12 cthM2 M0' M2' S0 M21'; auto. split. auto. apply enter_SW_grt2_aux2_hyp1_ih with pc' M0' M2' S0 M12 cthM12; auto. Qed. Lemma enter_SW_grt2_auxc_ih_aux4_hyp1: forall M'2 M0 cthM_old M01 M02 Mx cthM_oldStk oldStk1 oldStk2, MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion M01 M02 M0 -> MemMod.disjUnion Mx cthM_oldStk cthM_old -> MemMod.disjUnion oldStk1 oldStk2 cthM_oldStk -> MemMod.disjoint M01 oldStk1. Proof. intros. assert (MemMod.disjoint M01 cthM_old). inversion_clear H0. subst M0. inversion_clear H. apply MemMod.disj_merge_disj_left with M02; auto. inversion_clear H1. subst cthM_old. assert (MemMod.disjoint M01 cthM_oldStk). apply MemMod.disj_x_merge_disj_right with Mx; auto. inversion_clear H2. rewrite H6 in H1. apply MemMod.disj_x_merge_disj_left with oldStk2; auto. Qed. Lemma enter_SW_grt2_auxc_ih_aux4_hyp2: forall M'2 M0 cthM_old M01 M02 cthM0 cthM_oldStk oldStk1 oldStk2, MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion M01 M02 M0 -> MemMod.disjUnion cthM0 cthM_oldStk cthM_old -> MemMod.disjUnion oldStk1 oldStk2 cthM_oldStk -> MemMod.disjUnion (MemMod.merge M01 oldStk1) (MemMod.merge oldStk2 cthM0) (MemMod.merge M01 cthM_old). Proof. intros. assert ((eqM M01 *^* (eqM cthM0 *^* (eqM oldStk1 *^* eqM oldStk2))) (MemMod.merge M01 cthM_old)). exists M01. exists cthM_old. split. split; auto. inversion_clear H0. subst M0. inversion H. apply MemMod.disj_merge_disj_left with M02; auto. split. unfold eqM. auto. exists cthM0. exists cthM_oldStk. split_l. unfold eqM. split_l. unfold mstar. exists oldStk1. exists oldStk2. auto. assert ((eqM M01 *^* eqM oldStk1 *^* (eqM oldStk2 *^* eqM cthM0)) (MemMod.merge M01 cthM_old)). sep on. sep matchH H3 with 4. unfold mstar in H4. unfold eqM in H4. InvertAll. subst x1 x2 x3 x4. inversion_clear H8. subst x. inversion_clear H6. subst x0. auto. Qed. Lemma enter_SW_grt2_auxc_ih_aux4_hyp3: forall M'2 M0 M01 M02 cthM_old cthM0 cthM_oldStk sp w junk m, MemMod.disjUnion cthM0 cthM_oldStk cthM_old -> MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion M01 M02 M0 -> (sp |-> w *^* sp + 1 |-> junk *^* m) cthM_oldStk -> (sp |~>w w) (MemMod.merge M01 cthM_old). Proof. intros. assert ((eqM M01 *^* (eqM cthM0 *^* eqM cthM_oldStk)) (MemMod.merge M01 cthM_old)). exists M01. exists cthM_old. split. split; auto. inversion_clear H1. subst M0. inversion H0. apply MemMod.disj_merge_disj_left with M02; auto. split. unfold eqM. auto. exists cthM0. exists cthM_oldStk. unfold eqM. auto. sep on. sep lift 2 in H3. assert (forall M, eqM cthM_oldStk M -> (sp |->w w *^* m) M). intros. unfold eqM in H4. subst M. apply ptoW_intro1 with junk; auto. sep weaker_subst in H3 with (sp |->w w *^* m). sep on. sep lift 0 in H3. sep trivial. Qed. Lemma enter_SW_grt2_auxc_ih_aux4: forall pc pc' M R fl isr M' R' fl' isr' cthM1 cthM11 cthM12 INVM cthM0 M0 M01 M02 cthM_oldStk cthM_old R0 fl0 junk M'2, nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> MemMod.disjUnion cthM11 cthM12 cthM1 -> stkSpacePrec (R SP) (8 + 2) cthM11 -> MemMod.disjUnion INVM cthM0 cthM12 -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk *^* stkSpacePrec (R' SP) 8) cthM_oldStk -> MemMod.disjUnion cthM0 cthM_oldStk cthM_old -> INV0 INVM -> INV0 M01 -> INV1 M02 -> MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion M01 M02 M0 -> fl0 _IF = false -> fl _IF = false -> isr = false -> R0 SP = R' SP + 2 -> wrap_fun ih_gy pc _SWITCH pc' (cthM1, R, fl, isr) (MemMod.merge M01 cthM_old, R0, fl0, false). Proof. intros. unfold wrap_fun. unfold conjG at 1. exists (MemMod.merge M01 cthM_old, RF_update R0 SP (R0 SP - 2), fl0, false). split. unfold conjG. assert (nextS pc (comml (_call _SWITCH)) (cthM1, R, fl, isr) (MemUpdW cthM1 (R SP - 2) (pc+1) junk, RF_update R SP (R SP - 2), fl, isr)). apply nextS_call. unfold pushW. split. assert ((mTrue *^* stkSpacePrec (R SP) (8 + 2)) cthM1). exists cthM12. exists cthM11. split; auto with PMap. unfold mTrue. split; auto. sep on. sep lift 1 in H14. sep stksplit 2 in H14. sep lift 0 in H14. sep trivial. split; auto. apply MemUpdW_MemUpd16 with junk; auto. set (cthM' := MemUpdW cthM1 (R SP - 2) (pc + 1) junk) in *. exists (cthM', RF_update R SP (R SP - 2), fl, isr). split; auto. assert (R SP - 2 = R' SP). apply enter_SW_grt_auxb0_hyp0 with pc M fl isr M' fl' isr' _SWITCH; auto. unfold ih_gy. exists (R SP - 2). simplS. reg simpl. assert (R SP = R' SP + 2). rewrite <- H15. assert (R SP >= 2). apply ge_trans with (8 + 2). sep on. apply stkSpacePrec_sp_ge_sz with cthM11; auto. auto with arith. assert (R SP - 2 + 2 = R SP). auto. auto. rename H16 into HRSP'. split. unfold prepost. simplS. sep on. sep stksplit in H1. destruct H1 as [cthM11_1 [cthM11_2 [HcthM11split [HcthM11_1 HcthM11_2]]]]. exists (MemMod.merge INVM cthM11_1). exists (MemMod.merge (MemUpdW cthM11_2 (R SP - 2) (pc+1) junk) cthM0). sep lift 2 in H3. unfold mstar at 1 in H3. sep off. InvertAll. rename x into oldStk1. rename x0 into oldStk2. exists (MemMod.merge M01 oldStk1). split. exists INVM. exists cthM11_1. split; auto. split; auto. apply enter_BLK_grt2_auxc_hyp1 with cthM1 cthM11 cthM12 cthM11_2 cthM0; auto. split. exists M01. exists oldStk1. rewrite <- H15 in H3. split; auto. split; auto. apply enter_SW_grt2_auxc_ih_aux4_hyp1 with M'2 M0 cthM_old M02 cthM0 cthM_oldStk oldStk2; auto. split. assert (MemMod.disjUnion (MemMod.merge (MemUpdW cthM11_2 (R SP - 2) (pc + 1) junk) cthM0) (MemMod.merge INVM cthM11_1) cthM'). apply enter_SW_grt2_auxc_auxx with cthM1 cthM11 cthM12; auto. auto with PMap. assert (MemUpdW cthM11_2 (R SP - 2) (pc + 1) junk = oldStk2). rewrite H15 in HcthM11_2. rewrite H15. apply enter_SW_grt2_auxc_hypx; auto. rewrite H16. apply enter_SW_grt2_auxc_ih_aux4_hyp2 with M'2 M0 M02 cthM_oldStk; auto. rewrite <- H10 in H11. split_l. split_l. split_l. rewrite <- H13 in HRSP'. rewrite HRSP'. auto. apply nextS_retw. exists (pc+1). unfold popW. reg simpl. split. rewrite H13. assert (R' SP + 2 - 2 = R' SP). auto. rewrite H14. apply enter_SW_grt2_auxc_ih_aux4_hyp3 with M'2 M0 M02 cthM0 cthM_oldStk junk (stkSpacePrec (R' SP) 8); auto. rewrite H13. assert (R' SP + 2 - 2 = R' SP). auto. rewrite H14. rewrite <- H13. assert (RF_update R0 SP (R0 SP) = R0). apply RF_update_prev. auto. Qed. Lemma enter_SW_grt2_auxc_ih: forall cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk M0 M'2 cthM_old R0 fl0 (p p'': Pred) M M' R' fl' isr', MemMod.disjUnion cthM1 cthM2 cthM -> p (cthM1, R, fl, isr) -> INV1 cthM2 -> MemMod.disjUnion cthM11 cthM12 cthM1 -> stkSpacePrec (R SP) (8 + 2) cthM11 -> MemMod.disjUnion INVM cthM0 cthM12 -> INV0 INVM -> MemMod.disjUnion cthM0 cthM_oldStk cthM_old -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk *^* stkSpacePrec (R' SP) 8) cthM_oldStk -> (INV0 *^* INV1) M0 -> MemMod.disjUnion M0 cthM_old M'2 -> (forall pc' : nat, pimp (p |> wrap_fun ih_gy pc _SWITCH pc') p'') -> fl0 _IF = false -> fl _IF = false -> isr = false -> nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> R0 SP = R' SP + 2 -> (p'' *<* INV1) (S_Mem_Upd (cthM_old, R0, fl0, false) M'2). Proof. intros. unfold pmstar. simplS. unfold mstar in H8. InvertAll. rename x into M01. rename x0 into M02. exists (MemMod.merge M01 cthM_old). exists M02. split. apply enter_SW_grt2_auxc_ih_hyp0 with M0; auto. split; auto. unfold pimp in H10. apply H10 with 0. unfold linkPG. exists (cthM1, R, fl, isr). split; auto. apply enter_SW_grt2_auxc_ih_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM cthM0 M0 M02 cthM_oldStk junk M'2; auto. Qed. Lemma enter_SW_grt2_hypK_ih: forall cthM2 INVM cthMR M22 M21' cthM_old M122 S', disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: cthM2 :: M122 :: nil) (S_Mem S') -> MemMod.disjoint cthM2 INVM. Proof. intros. assert (MemMod.disjoint INVM cthM2). apply enter_SW_grt2_hypa_ih2 with cthMR M22 M21' cthM_old M122 S'; auto. auto with PMap. Qed. Lemma enter_SW_grt2_hypJ_ih: forall cthM' cthM2 INVM cthMR M22 M21' cthM_old M122 S', cthM' = MemMod.merge (MemMod.merge cthMR INVM) cthM2 -> disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: cthM2 :: M122 :: nil) (S_Mem S') -> MemMod.disjUnion (MemMod.merge cthM2 INVM) cthMR cthM'. Proof. intros. subst cthM'. assert (MemMod.merge cthM2 INVM = MemMod.merge INVM cthM2). assert (MemMod.disjoint cthM2 INVM). apply enter_SW_grt2_hypK_ih with cthMR M22 M21' cthM_old M122 S'; auto. auto with PMap. rewrite H. apply enter_SW_grt2_hypa_ih with M22 M21' cthM_old M122 S'; auto. Qed. Lemma enter_SW_ih_prdaux: forall M1' cthM11' M21 R' fl' isr' pc junk Psi'0 S T B RdyQ tid rho theta tcb, MemMod.disjUnion cthM11' M21 M1' -> ((R' SP) |-> pc *^* (R' SP) + 1 |-> junk *^* stkSpacePrec (R' SP) 8) cthM11' -> (embed_curr_TCB T tid *^* embed_RdyQ T RdyQ) M21 -> WF_AIM_World Psi'0 S T B RdyQ tid rho theta -> T tid = Some tcb -> SW_Prd_aux T RdyQ tid (R' SP) tcb pc junk (M1', R', fl', isr'). Proof. intros. unfold SW_Prd_aux. split. unfold S_Mem. apply mem_compose_c with cthM11' M21; auto. split; auto. split. apply WF_AIM_World_RdyQinT with Psi'0 S B tid rho theta. auto. split; auto. split. unfold WF_AIM_World in H2. InvertAll. unfold WF_currTID in H4. InvertAll. auto. apply WF_AIM_World_WFTQ with Psi'0 S B RdyQ tid rho theta. auto. Qed. Lemma enter_SW_ih_grt: forall D psi pc theta D' Psi Psi' Psi'0 S S', IH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> subsetCT Psi' Psi'0 -> Itp_AIM rho_ih theta Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> WFST D rho_prim 0 Psi'0 (scap_lift_g SW_grt S'). Proof. intros. unfold WFST. intros. unfold scap_lift_g in H7. InvertAll. induction S' as (((M', R'), fl'), isr'). induction S as (((M, R), fl), isr). induction theta. rename n into tag. unfold Itp_AIM in H5. unfold pmstar in H5. InvertAll. rename x into T. rename x0 into B. rename x1 into RdyQ. rename x2 into tid. rename x3 into M1. rename x4 into M2. assert ((embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* embed_WQSet T B) M2). apply leqvM_app_subst with (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)); auto. apply leqvM_commut. apply mstar_assoc. unfold mstar at 1 in H11. InvertAll. rename x into M21. rename x0 into M22. clear H12. assert (exists TM, exists cthM, exists M12, exists cthM1, exists cthM2, MemMod.disjUnion M12 cthM M1 /\ MemMod.disjUnion cthM1 cthM2 cthM /\ WF_currTID tid T B RdyQ rho_ih /\ WF_TWQ T B RdyQ /\ exists_Idle T RdyQ tid /\ WF_WQ_WQSpec B Delta /\ MemSplit (ThrdMemMod.remove TM tid) M12 /\ ThrdMemMod.maps_to TM tid cthM /\ WF_Curr_Thrd Psi'0 (S_Mem_Upd (M1, R, fl, isr) cthM) rho_ih (Ast p g tag) T tid /\ WF_ReadyQ Psi'0 T RdyQ TM /\ WF_WQSet Psi'0 T B TM /\ p (cthM1, R, fl, isr) /\ INV1 cthM2). apply decompose_World_ih; auto. InvertAll. rename x into TM. rename x0 into cthM. rename x1 into M12. rename x2 into cthM1. rename x3 into cthM2. assert (WQMod.not_in_dom tid RdyQ). unfold WF_currTID in H16. InvertAll. auto. assert (exists M1, exists M2, MemMod.disjUnion M1 M2 (S_Mem (cthM1, R, fl, isr)) /\ stkSpacePrec (S_RF (cthM1, R, fl, isr) SP) (8 + 2) M1 /\ (INV0 *^* mTrue) M2). apply enable_sw_stkspace_ih with p; auto. apply WFcallsw_enablesw_ih with psi pc g tag; auto. InvertAll. rename x into cthM11. rename x0 into cthM12. unfold S_Mem in H29. unfold S_RF in H28. assert (disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11 :: nil) M). apply mem_list_compose_a with cthM1 cthM M1; auto. assert (exists junk, ((R' SP |-> (pc+1)) *^* (R' SP + 1 |-> junk) *^* (stkSpacePrec (R' SP) 8)) (MemUpdW cthM11 (R' SP) (pc + 1) junk) /\ disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: (MemUpdW cthM11 (R' SP) (pc + 1) junk) :: nil) M'). apply call_sw_frame with M R fl fl' isr isr'; auto. InvertAll. rename x into junk1. set (cthM11' := MemUpdW cthM11 (R' SP) (pc + 1) junk1) in *. assert (exists M1', exists M2', MemMod.disjUnion cthM11' M21 M1' /\ disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' /\ MemMod.disjUnion M1' M2' M'). apply mem_list_compose_b with M2; auto. InvertAll. rename x into M1'. rename x0 into M2'. assert (exists tcb, T tid = Some tcb). unfold WF_currTID in H16. InvertAll. unfold TQMod.in_dom in H40. auto. inversion_clear H36. rename x into tcb. assert (exists M0' : MemMod.Map, exists RdyQ' : WQ, exists tid' : TID, exists sp' : nat, exists tcb' : Thread, MemMod.disjUnion M0' M2' (S_Mem S0) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ SW_Post_aux (TQMod.put T tid ((R' SP), TCB_Status tcb, pc+1)) RdyQ' tid' sp' (R' SP) tcb' (pc+1) junk1 (S_Mem_Upd S0 M0')). apply H8 with M1' T tcb; auto. assert (S_Mem_Upd (M', R', fl', isr') M1' = (M1', R', fl', isr')). auto. rewrite H36. apply enter_SW_ih_prdaux with cthM11' M21 Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B rho_ih (Ast p g tag); auto. clear H8. InvertAll. rename x into M0'. rename x0 into RdyQ'. rename x1 into tid'. rename x2 into sp'. rename x3 into tcb'. assert ((fl _IF = false) /\ (isr = false)). apply call_sw_flags_false_ih with p g tag psi Psi'0 pc cthM cthM1 R T tid; auto. inversion_clear H39. assert (tid = tid' \/ tid <> tid'). apply nat_eq_neq_dec. inversion_clear H39. (* tid = tid' *) (* clear H24 H27 H26 cthM11. *) assert (RdyQ = RdyQ'). assert (WQMod.not_in_dom tid' RdyQ'). unfold SW_Post_aux in H40. InvertAll. auto. apply unique_remain with tid tid'; auto. exists (pc + 1). rewrite <- H39 in H40. rewrite <- H43 in H40. clear H43 H39 H8 tid' RdyQ'. assert (S_RF S0 SP = R' SP). assert (sp' = R' SP). apply enter_SW_grt_aux60 with T RdyQ tid tcb (pc+1) junk1 tcb' S0 M0'; auto. unfold SW_Post_aux in H40. InvertAll. rewrite H8 in H44. auto. split. apply enter_SW_grt_aux7 with T RdyQ tid (R' SP) tcb junk1 sp' tcb' M0' M2'; auto. assert (exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun ih_gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun ih_gy pc _SWITCH pc') oo g') g)). auto. InvertAll. rename x into p'. rename x0 into g'. exists (packS0 rho_ih (Ast p' g' tag)). split. apply psi_sw_lookupNPC_ih with psi Psi Psi'; auto. intros. unfold Itp0. assert (D rho_ih = SomeT1 _ (Itp_AIM rho_ih)). unfold Minimal_D in H0. InvertAll. auto. rewrite H46. unfold Itp_AIM. set (T' := TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)) in * |- *. exists T'. exists B. exists RdyQ. exists tid. assert (exists M21_0, exists cthM11'', ((S_RF S' SP - 2) |-> (pc+1) *^* (S_RF S' SP - 2 + 1) |-> junk1 *^* stkSpacePrec (S_RF S' SP - 2) 8) cthM11'' /\ (embed_curr_TCB T' tid *^* embed_RdyQ T' RdyQ) M21_0 /\ disjUnionList (M21_0 :: M22 :: M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) (S_Mem S')). apply enter_SW_grt_aux8 with T (R' SP) sp' tcb tcb' pc' S0 M0' M2'; auto. InvertAll. rename x into M21_0. rename x0 into cthM11''. unfold pmstar. assert (exists M'1, exists M'2, disjUnionList (M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) M'1 /\ MemMod.disjUnion M21_0 M22 M'2 /\ MemMod.disjUnion M'1 M'2 (S_Mem S')). apply enter_SW_grt_hyp4. auto. InvertAll. rename x into M'1. rename x0 into M'2. exists M'1. exists M'2. split; auto. split. unfold WF_AIM_World. split. unfold T'. apply WF_currTID_ext_T with tcb; auto. split. unfold T'. apply exists_Idle_ext_T; auto. split. unfold T'. apply WF_TWQ_ext_T; auto. exists tcb. auto. split; auto. assert (exists cthM', MemMod.disjUnion M12 cthM' M'1 /\ disjUnionList (cthM2 :: cthM12 :: cthM11'' :: nil) cthM'). auto. InvertAll. rename x into cthM'. exists (ThrdMemMod.put TM tid cthM'). exists cthM'. split. assert (S_Mem (S_Mem_Upd S' M'1) = M'1). auto. rewrite H54. apply enter_SW_grt_hyp6 with M12; auto. split. auto with PMap. split. assert (S_ISR (M, R, fl, isr) = S_ISR S' /\ S_Flag (M, R, fl, isr) _IF = S_Flag S' _IF). apply enter_SW_grt_hyp9 with pc pc' _SWITCH (M', R', fl', isr') S0; auto. unfold S_ISR at 1 in H54. unfold S_Flag at 1 in H54. inversion_clear H54. unfold WF_Curr_Thrd. simpl. unfold WF_Curr_Thrd in H22. simpl in H22. InvertAll. exists (R' SP, TCB_Status tcb, pc + 1). exists x0. split. unfold T'. auto with PMap. split. unfold TQMod.maps_to in H54. rewrite H38 in H54. inversion H54. rewrite H22. unfold TCB_Status. auto. apply weaken_itp_IH_theta with p g (cthM, R, fl, isr); auto. rewrite H41 in H57. rewrite H57. UnfoldStateAll. auto. intro. clear H58. assert (p' (S_Mem_Upd S' (MemMod.merge cthM12 cthM11''))). apply enter_SW_grt_auxb_ih with p cthM1 R fl isr M cthM11 pc pc' M' R' fl' isr' junk1 S0; auto. apply enter_SW_grt_hypc with M21_0 M22 M12 cthM2; auto. apply enter_SW_grt_hypd with M21_0 M22 M12 cthM2 S'; auto. unfold pmstar. exists (MemMod.merge cthM12 cthM11''). exists cthM2. split. apply enter_SW_grt_hypa; auto. split; auto. assert (S_Mem_Upd (S_Mem_Upd S' M'1) cthM' = S_Mem_Upd S' cthM'). auto. rewrite H58. clear H58. unfold IH_ItpG. intros. clear H54 H22 H59 x x0. InvertAll. rename x into cthM'1. rename x0 into cthM'2. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split. unfold S_Mem. auto. (* H14 *) split. auto. split. auto. split. auto. unfold gimp in H45. apply H45 with pc'. unfold conjG. exists (S_Mem_Upd (S_Mem_Upd S' cthM') cthM'1). split; auto. assert ((cthM2 = cthM'2) /\ (cthM'1 = MemMod.merge cthM12 cthM11'')). apply enter_SW_grt_hype_ih with cthM'; auto. inversion_clear H60. rewrite H63. unfold conjPG. split; auto. assert (S_Mem_Upd (cthM, R, fl, isr) cthM1 = (cthM1, R, fl, isr)). auto. rewrite H60. clear H60. assert (S_Mem_Upd (S_Mem_Upd S' cthM') (MemMod.merge cthM12 cthM11'') = S_Mem_Upd S' (MemMod.merge cthM12 cthM11'')). auto. rewrite H60. clear H60. apply enter_SW_grt_auxb0_ih with M cthM11 M' R' fl' isr' junk1 S0; auto. apply enter_SW_grt_hypc with M21_0 M22 M12 cthM2; auto. apply enter_SW_grt_hypd with M21_0 M22 M12 cthM2 S'; auto. split. apply enter_SW_grt_hypf with T (R' SP, TCB_Status tcb, pc + 1); auto. apply enter_SW_grt_hypg with T (R' SP, TCB_Status tcb, pc + 1); auto. unfold WF_currTID in H16. InvertAll. auto. apply leqvM_app_subst with (embed_curr_TCB T' tid *^* embed_RdyQ T' RdyQ *^* embed_WQSet T' B); auto. apply mstar_assoc. unfold mstar at 1. exists M21_0. exists M22. split; auto. split; auto. apply enter_SW_grt_hyph with T tid (R' SP, TCB_Status tcb, pc + 1); auto. unfold WF_currTID in H16. InvertAll. auto. (* tid <> tid' *) assert (WQMod.not_in_dom tid' RdyQ'). unfold SW_Post_aux in H40. InvertAll. auto. assert (WQMod.in_dom tid RdyQ' /\ WQMod.in_dom tid' RdyQ). apply enter_SW_grt2_hyp0; auto. inversion_clear H44. assert (WF_ReadyQ Psi'0 T RdyQ TM). auto. unfold WF_ReadyQ in H23. assert (exists tcb', TQMod.maps_to T tid' tcb' /\ (TCB_Status tcb' = READY \/ TCB_Status tcb' = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid' M /\ (TCB_SP tcb' |~>w TCB_PC tcb') M /\ (WF_Rdy_Thrd Psi'0 M tcb' \/ WF_Rdy_Thrd_IH Psi'0 M tcb'))). apply H23. auto. InvertAll. rename x into tcb''. rename x0 into cthMR. induction tcb'' as ((sp'', status''), pc''). exists pc''. assert (tcb' = (sp'', status'', pc'') /\ sp' = sp'' /\ S_RF S0 SP = sp'). unfold SW_Post_aux in H40. InvertAll. assert (tcb' = (sp'', status'', pc'')). assert (TQMod.maps_to T tid' tcb'). unfold TQMod.maps_to in H40. unfold TQMod.put in H40. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. unfold TQMod.maps_to. auto. unfold TQMod.maps_to in H55. unfold TQMod.maps_to in H47. rewrite H55 in H47. inversion H47. auto. split; auto. split; auto. rewrite H55 in H53. auto. inversion_clear H51. inversion_clear H54. unfold TCB_PC in H49. unfold TCB_SP in H49. split. apply enter_SW_grt2_hyp1 with TM tid tid' cthMR sp'' M0' M2' M22 M12 cthM2 cthM12; auto. rewrite <- H51. auto. inversion_clear H52. (* not in interrupt handler *) unfold WF_Rdy_Thrd in H54. InvertAll. rename x into rho'. rename x0 into p'. rename x1 into g'. rename x2 into tag'. clear H56. exists (packS0 rho' (Ast p' g' tag')). split; auto. intros. unfold Itp0. assert (D rho' = SomeT1 _ (Itp_AIM rho')). apply non_ih_spec_miniD; auto. rewrite H58. clear H58. unfold Itp_AIM. exists (TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). set (T' := TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). exists B. exists RdyQ'. exists tid'. clear H23. assert (exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ INV0 INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ') M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion cthM0 cthM_oldStk cthM_old /\ (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk1 *^* stkSpacePrec (R' SP) 8) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: cthM2 :: M122 :: nil) (S_Mem S')). apply enter_SW_grt2_hyp2_ih with T B sp' tcb tcb' pc' S0 M0' M2'; auto. InvertAll. rename x into INVM. rename x0 into cthM0. rename x1 into M21'. rename x2 into M122. rename x3 into cthM_old. rename x4 into cthM_oldStk. unfold pmstar. assert ( exists M'0, exists M'1, MemMod.disjUnion M'0 M'1 (S_Mem S') /\ MemMod.disjUnion M21' M22 M'1 /\ disjUnionList (cthMR :: INVM :: cthM_old :: cthM2 :: M122 :: nil) M'0 ). apply enter_SW_grt2_hyp3_ih; auto. InvertAll. rename x into M'0. rename x0 into M'1. exists M'0. exists M'1. split; auto. split. unfold WF_AIM_World. split. apply enter_SW_grt2_hyp4 with T RdyQ tid (R' SP, TCB_Status tcb, pc + 1) (sp'', status'', pc'') rho_ih; auto. split. apply enter_SW_grt2_hyp5 with T RdyQ tid (R' SP) (pc+1) tcb; auto. split. apply enter_SW_grt2_aux6 with RdyQ tid tid' tcb (R' SP, TCB_Status tcb, pc + 1) T rho_ih; auto. split; auto. exists (ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge (MemMod.merge cthMR INVM) cthM2)) tid cthM_old). set (TM' := ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge (MemMod.merge cthMR INVM) cthM2)) tid cthM_old). exists (MemMod.merge (MemMod.merge cthMR INVM) cthM2). set (cthM' := (MemMod.merge (MemMod.merge cthMR INVM) cthM2)). split. assert (S_Mem (S_Mem_Upd S' M'0) = M'0). auto. rewrite H68. apply enter_SW_grt2_hyp7_ih with cthMR INVM cthM_old M122 TM tid tid' cthM2; auto. split. unfold cthM'. unfold TM'. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. induction (ThrdMemMod.beq_A tid' tid'). auto. absurd (tid' = tid'); auto. split. unfold WF_Curr_Thrd. assert (beq_nat rho' rho_ih = false). apply neq_beq_false. inversion_clear H52. rewrite H68. discriminate. rewrite H68. discriminate. rewrite H68. unfold itp_NH_theta. assert (S_ISR S' = false). apply enter_SW_grt2_hyp8 with pc pc' M R fl isr M' R' fl' isr' S0 _SWITCH; auto. split. UnfoldStateAll. auto. assert ((INV0 *^* INV1 -* itp_NH_theta rho' (Ast p' g' tag') Psi'0) (cthMR, S_RF S', S_Flag S', false)). apply H59. rewrite H51 in H55. apply enter_SW_grt2_hyp9 with S0 pc'; auto. assert (S_ISR (M, R, fl, isr) = S_ISR S' /\ S_Flag (M, R, fl, isr) _IF = S_Flag S' _IF). apply enter_SW_grt_hyp9 with pc pc' _SWITCH (M', R', fl', isr') S0; auto. inversion_clear H71. rewrite <- H73. unfold S_Flag. auto. assert (itp_NH_theta rho' (Ast p' g' tag') Psi'0 (cthM', S_RF S', S_Flag S', false)). unfold cthM'. unfold pm_mwand in H71. assert ((MemMod.merge (MemMod.merge cthMR INVM) cthM2, S_RF S', S_Flag S', false) = S_Mem_Upd (cthMR, S_RF S', S_Flag S', false) (MemMod.merge (MemMod.merge cthMR INVM) cthM2)). auto. rewrite H72. apply H71 with (MemMod.merge INVM cthM2); auto. unfold S_Mem. apply enter_SW_grt2_hypa_ih with M22 M21' cthM_old M122 S'; auto. unfold mstar. exists INVM. exists cthM2. split; auto. unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_hypa_ih2 with cthMR M22 M21' cthM_old M122 S'; auto. assert (S_Mem_Upd (S_Mem_Upd S' M'0) cthM' = (cthM', S_RF S', S_Flag S', false)). induction S' as (((M'', R''), fl''), isr''). UnfoldStateAll. rewrite H70. auto. rewrite H73. clear H73. unfold itp_NH_theta in H72. inversion_clear H72. auto. split. unfold WF_ReadyQ. intros. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H70. exists (R' SP, TCB_Status tcb, pc + 1). rewrite H71. split; auto. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid tid). auto. absurd (tid = tid); auto. split. unfold TCB_Status at 1. unfold TCB_Status at 2. unfold WF_currTID in H16. InvertAll. unfold TQMod.maps_to in H74. rewrite H74 in H38. inversion H38. rewrite <- H77. auto. exists cthM_old. split. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid tid); auto. absurd (tid = tid); auto. split. unfold TCB_SP. unfold TCB_PC. apply enter_SW_grt2_hypb with cthM0 cthM_oldStk junk1; auto. right. unfold WF_Rdy_Thrd_IH. assert (exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun ih_gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun ih_gy pc _SWITCH pc') oo g') g)). apply call_sw_nextPC_spec_ih; auto. InvertAll. rename x into p''. rename x0 into g''. exists p''. exists g''. exists tag. split. apply psi_sw_lookupNPC_ih with psi Psi Psi'; auto. split. apply enter_SW_grt2_hypb with cthM0 cthM_oldStk junk1; auto. intros. unfold pm_mwand. unfold S_Mem. intros. apply weaken_itp_IH_theta with p g (cthM, R, fl, isr); auto. unfold WF_Curr_Thrd in H22. simpl in H22. InvertAll. unfold TQMod.maps_to in H78. rewrite H38 in H78. inversion H78. rewrite H22. UnfoldStateAll. auto. intro. clear H78. apply enter_SW_grt2_auxc_ih with cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk1 M0 p M M' R' fl' isr'; auto. (* IH_ItpG *) intros. unfold gimp in H74. unfold IH_ItpG. unfold IH_ItpG in H78. InvertAll. rename x into M'20. rename x0 into M'21. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split; auto. split; auto. split; auto. split; auto. apply H74 with pc'. unfold conjG. exists (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20). split; auto. unfold conjPG. split; auto. unfold mstar in H77. InvertAll. rename x into M01. rename x0 into M02. assert (M'20 = MemMod.merge M01 cthM_old). apply enter_SW_grt2_hype_ih with M'2 M'21 M0 M02; auto. assert (S_Mem_Upd (cthM, R, fl, isr) cthM1 = (cthM1, R, fl, isr)). UnfoldStateAll. auto. rewrite H86. clear H86. assert (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20 = (M'20, R0, fl0, false)). UnfoldStateAll. auto. rewrite H86. clear H86. rewrite H84. apply enter_SW_grt2_auxc_ih_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM cthM0 M0 M02 cthM_oldStk junk1 M'2; auto. (* tid0 <> tid : other ready threads *) unfold WF_ReadyQ in H44. assert (exists tcb : Thread, TQMod.maps_to T tid0 tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid0 M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi'0 M tcb \/ WF_Rdy_Thrd_IH Psi'0 M tcb))). apply H44; auto. apply enter_SW_grt2_hypf with RdyQ' tid tid'; auto. InvertAll. exists x. split. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold TQMod.maps_to in H69. auto. split; auto. exists x0. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). rewrite <- a in H39. absurd (~ WQMod.in_dom tid0 RdyQ'); auto with PMap. unfold ThrdMemMod.maps_to in H73. auto. apply enter_SW_grt2_hypg with T TM RdyQ RdyQ' tid tid' (R' SP, TCB_Status tcb, pc + 1) cthM_old (MemMod.merge (MemMod.merge cthMR INVM) cthM2) rho_ih; auto. apply enter_SW_grt2_hyph with M21' M22 T (R' SP, TCB_Status tcb, pc + 1) RdyQ tid rho_ih; auto. (* tid' is in interrupt hander *) unfold WF_Rdy_Thrd_IH in H54. InvertAll. rename x into p'. rename x0 into g'. rename x1 into tag'. exists (packS0 rho_ih (Ast p' g' tag')). split; auto. intros. unfold Itp0. assert (D rho_ih = SomeT1 _ (Itp_AIM rho_ih)). unfold Minimal_D in H0. InvertAll. auto. rewrite H58. clear H58. unfold Itp_AIM. exists (TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). set (T' := TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). exists B. exists RdyQ'. exists tid'. clear H23. assert (exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ INV0 INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ') M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion cthM0 cthM_oldStk cthM_old /\ (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk1 *^* stkSpacePrec (R' SP) 8) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: cthM2 :: M122 :: nil) (S_Mem S')). apply enter_SW_grt2_hyp2_ih with T B sp' tcb tcb' pc' S0 M0' M2'; auto. InvertAll. rename x into INVM. rename x0 into cthM0. rename x1 into M21'. rename x2 into M122. rename x3 into cthM_old. rename x4 into cthM_oldStk. unfold pmstar. assert ( exists M'0, exists M'1, MemMod.disjUnion M'0 M'1 (S_Mem S') /\ MemMod.disjUnion M21' M22 M'1 /\ disjUnionList (cthMR :: INVM :: cthM_old :: cthM2 :: M122 :: nil) M'0 ). apply enter_SW_grt2_hyp3_ih; auto. InvertAll. rename x into M'0. rename x0 into M'1. exists M'0. exists M'1. split; auto. split. unfold WF_AIM_World. split. apply enter_SW_grt2_hyp4 with T RdyQ tid (R' SP, TCB_Status tcb, pc + 1) (sp'', status'', pc'') rho_ih; auto. split. apply enter_SW_grt2_hyp5 with T RdyQ tid (R' SP) (pc+1) tcb; auto. split. apply enter_SW_grt2_aux6 with RdyQ tid tid' tcb (R' SP, TCB_Status tcb, pc + 1) T rho_ih; auto. split; auto. exists (ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge (MemMod.merge cthMR INVM) cthM2)) tid cthM_old). set (TM' := ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge (MemMod.merge cthMR INVM) cthM2)) tid cthM_old). exists (MemMod.merge (MemMod.merge cthMR INVM) cthM2). set (cthM' := (MemMod.merge (MemMod.merge cthMR INVM) cthM2)). split. assert (S_Mem (S_Mem_Upd S' M'0) = M'0). auto. rewrite H67. apply enter_SW_grt2_hyp7_ih with cthMR INVM cthM_old M122 TM tid tid' cthM2; auto. split. unfold cthM'. unfold TM'. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. induction (ThrdMemMod.beq_A tid' tid'). auto. absurd (tid' = tid'); auto. split. unfold WF_Curr_Thrd. simpl. assert ((INV0 *^* INV1 -* itp_IH_theta (Ast p' g' tag') status'' Psi'0) (cthMR, S_RF S', S_Flag S', false)). apply H57. rewrite H51 in H55. apply enter_SW_grt2_hyp9 with S0 pc'; auto. apply enter_SW_grt2_hypI with pc pc' M R fl isr M' R' fl' isr' S0; auto. exists (sp'', status'', pc''). exists status''. split. unfold TQMod.maps_to. unfold T'. unfold TQMod.put. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. auto. split; auto. unfold pm_mwand in H67. assert (S_ISR S' = false). apply enter_SW_grt2_hyp8 with pc pc' M R fl isr M' R' fl' isr' S0 _SWITCH; auto. assert (itp_IH_theta (Ast p' g' tag') status'' Psi'0 (S_Mem_Upd (cthMR, S_RF S', S_Flag S', false) cthM')). apply H67 with (MemMod.merge cthM2 INVM); auto. unfold S_Mem. apply enter_SW_grt2_hypJ_ih with M22 M21' cthM_old M122 S'; auto. unfold mstar. exists INVM. exists cthM2. split; auto. assert (MemMod.disjUnion cthM2 INVM (MemMod.merge cthM2 INVM)). unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_hypK_ih with cthMR M22 M21' cthM_old M122 S'; auto. auto with PMap. UnfoldStateAll. rewrite H69. auto. split. unfold WF_ReadyQ. intros. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H69. exists (R' SP, TCB_Status tcb, pc + 1). rewrite H70. split; auto. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid tid). auto. absurd (tid = tid); auto. split. unfold TCB_Status at 1. unfold TCB_Status at 2. unfold WF_currTID in H16. InvertAll. unfold TQMod.maps_to in H73. rewrite H73 in H38. inversion H38. rewrite <- H76. auto. exists cthM_old. split. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid tid); auto. absurd (tid = tid); auto. split. unfold TCB_SP. unfold TCB_PC. apply enter_SW_grt2_hypb with cthM0 cthM_oldStk junk1; auto. right. unfold WF_Rdy_Thrd_IH. assert (exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun ih_gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun ih_gy pc _SWITCH pc') oo g') g)). apply call_sw_nextPC_spec_ih; auto. InvertAll. rename x into p''. rename x0 into g''. exists p''. exists g''. exists tag. split. apply psi_sw_lookupNPC_ih with psi Psi Psi'; auto. split. apply enter_SW_grt2_hypb with cthM0 cthM_oldStk junk1; auto. intros. unfold pm_mwand. unfold S_Mem. intros. apply weaken_itp_IH_theta with p g (cthM, R, fl, isr); auto. unfold WF_Curr_Thrd in H22. simpl in H22. InvertAll. unfold TQMod.maps_to in H77. rewrite H38 in H77. inversion H77. rewrite H22. UnfoldStateAll. auto. intro. clear H77. apply enter_SW_grt2_auxc_ih with cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk1 M0 p M M' R' fl' isr'; auto. (* IH_ItpG *) intros. unfold gimp in H73. unfold IH_ItpG. unfold IH_ItpG in H77. InvertAll. rename x into M'20. rename x0 into M'21. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split; auto. split; auto. split; auto. split; auto. apply H73 with pc'. unfold conjG. exists (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20). split; auto. unfold conjPG. split; auto. unfold mstar in H76. InvertAll. rename x into M01. rename x0 into M02. assert (M'20 = MemMod.merge M01 cthM_old). apply enter_SW_grt2_hype_ih with M'2 M'21 M0 M02; auto. assert (S_Mem_Upd (cthM, R, fl, isr) cthM1 = (cthM1, R, fl, isr)). UnfoldStateAll. auto. rewrite H85. clear H85. assert (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20 = (M'20, R0, fl0, false)). UnfoldStateAll. auto. rewrite H85. clear H85. rewrite H83. apply enter_SW_grt2_auxc_ih_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM cthM0 M0 M02 cthM_oldStk junk1 M'2; auto. (* tid0 <> tid : other ready threads *) unfold WF_ReadyQ in H44. assert (exists tcb : Thread, TQMod.maps_to T tid0 tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid0 M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi'0 M tcb \/ WF_Rdy_Thrd_IH Psi'0 M tcb))). apply H44; auto. apply enter_SW_grt2_hypf with RdyQ' tid tid'; auto. InvertAll. exists x. split. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold TQMod.maps_to in H69. auto. split; auto. exists x0. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). rewrite <- a in H39. absurd (~ WQMod.in_dom tid0 RdyQ'); auto with PMap. unfold ThrdMemMod.maps_to in H73. auto. apply enter_SW_grt2_hypg with T TM RdyQ RdyQ' tid tid' (R' SP, TCB_Status tcb, pc + 1) cthM_old (MemMod.merge (MemMod.merge cthMR INVM) cthM2) rho_ih; auto. apply enter_SW_grt2_hyph with M21' M22 T (R' SP, TCB_Status tcb, pc + 1) RdyQ tid rho_ih; auto. Qed. Lemma Itp_AIM_sw_ih_disable: forall theta Psi S, Itp_AIM rho_ih theta Psi S -> S_Flag S _IF = false. Proof. intros. unfold Itp_AIM in H. InvertAll. unfold pmstar in H. InvertAll. unfold WF_AIM_World in H. InvertAll. unfold WF_Curr_Thrd in H7. assert (beq_nat rho_ih rho_ih = true). simpl. auto. rewrite H9 in H7. unfold itp_IH_theta in H7. InvertAll. UnfoldStateAll. auto. Qed. Lemma enter_SW_disable_ih: forall pc theta Psi'0 S S', Itp_AIM rho_ih theta Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> S_Flag S' _IF = false. Proof. intros. assert (S_Flag S _IF = false). apply Itp_AIM_sw_ih_disable with theta Psi'0; auto. assert ((S_Flag S _IF = S_Flag S' _IF) /\ (S_ISR S = S_ISR S')). apply enter_SW_grt_auxb0_hyp4 with pc _SWITCH; auto. inversion H2. rewrite <- H3. auto. Qed. Lemma enter_SW_ih: forall D psi pc theta D' Psi Psi' Psi'0 a S S', IH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> a = Itp_AIM rho_ih theta -> subsetCT Psi' Psi'0 -> a Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> Itp0 D' SWITCH_Spec0 Psi'0 S'. Proof. intros. unfold Itp0. unfold SWITCH_Spec0. rewrite H1. simpl. rewrite H4 in H6. clear H4 a. split. apply enter_SW_pre_ih with psi pc theta Psi'0 S; auto. split. apply enter_SW_disable_ih with pc theta Psi'0 S; auto. exists 0. apply enter_SW_ih_grt with psi pc theta D' Psi Psi' S; auto. Qed. Lemma IH_SW_Presv: forall D psi pc theta D' Psi Psi' Psi'0 a S S' f', IH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> a = Itp_AIM rho_ih theta -> subsetCT Psi' Psi'0 -> a Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> nextPC (comml (_call _SWITCH)) (S_Mem S) (S_RF S) (S_Flag S) pc f' -> exists theta0 : Spec0, lookupCT Psi'0 f' theta0 /\ Itp0 D' theta0 Psi'0 S'. Proof. intros. assert (lookupCT Psi'0 _SWITCH SWITCH_Spec0). apply subsetCT_presv_lookupCT with Psi'; auto. rewrite H3. auto. inversion H8. clear H14 H13 H12 H10 H11 fl R M f pc0. exists SWITCH_Spec0. split; auto. apply enter_SW_ih with D psi pc theta Psi Psi' a S; auto. Qed. Lemma IH_SW_Itp : forall D psi pc theta D' Psi Psi', IH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi (* -> a = Itp_AIM rho_ready theta *) -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_call _SWITCH)). Proof. intros. unfold WFcmd. split. unfold WFcmd_aux. intros. assert (Itp_AIM rho_ih theta Psi'0 S). unfold Itp0 in H4. rewrite H1 in H4. unfold ext_dict in H4. assert (beq_nat rho_ih rho_prim = false). simpl. auto. rewrite H6 in H4. unfold Minimal_D in H0. InvertAll. rewrite H9 in H4. auto. split. apply IH_SW_progress with psi theta Psi'0 (Itp_AIM rho_ih theta); auto. split. intros. apply IH_SW_Presv with D psi pc theta Psi Psi' (Itp_AIM rho_ih theta) S; auto. left. apply call_sw_disable_itr_ih with psi Psi'0 pc theta; auto. rewrite H1. unfold Itp0. unfold ext_dict. assert (beq_nat rho_ih rho_prim = false). simpl. auto. rewrite H4. unfold Minimal_D in H0. InvertAll. rewrite H7. apply Itp_AIM_Mono_CT. Qed. coq/SCAP/READY_SW.v0000644000107400000620000014066611000223235013250 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas4. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import Reg. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import SCAP_Itr. Require Import Linking. Require Import Linking_Lemmas. Require Import Linking_Lemmas2. Require Import Linking_Lemmas3. Require Import EqNat. Require Import Omega. Require Import List. Require Import Arith_Lemmas. Lemma NH_SW_progress: forall psi pc theta Psi a S, NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> a = Itp_AIM rho_ready theta -> a Psi S -> exists S', nextS pc (comml (_call _SWITCH)) S S'. Proof. intros. unfold NH_WFcmd in H. induction theta. unfold NH_WFcmd_aux in H. inversion_clear H. inversion H2. inversion_clear H. apply NH_SW_prog_aux with psi (Ast p g n) Psi rho_ready; auto. rewrite H0 in H1. auto. inversion_clear H. unfold prim_entry in H4. assert (_SWITCH = _SWITCH \/ _SWITCH = _BLOCK \/ _SWITCH = _UNBLK). left. auto. contradiction. Qed. Lemma enter_SW_preMem: forall pc S S' p g tag M1 M2 Psi T B RdyQ tid, nextS pc (comml (_call _SWITCH)) S S' -> enable_sw p -> MemMod.disjUnion M1 M2 (S_Mem S) -> WF_AIM_World Psi (S_Mem_Upd S M1) T B RdyQ tid rho_ready (Ast p g tag) -> (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M2 -> exists junk, (SW_MPre T RdyQ tid (S_RF S' SP) (pc+1) junk *^* mTrue) (S_Mem S'). Proof. intros. assert (imprec (NH_pinvstar p) (S_Mem_Upd S M1)). apply WF_AIM_World_pinv with Psi T B RdyQ tid rho_ready g tag; auto. assert (imprec p (S_Mem_Upd S M1)). apply imprec_presv_imprec with (NH_pinvstar p); auto. unfold SW_MPre. assert (exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ (S_RF S' SP |->w (pc+1) *^* stkSpacePrec (S_RF S' SP) 8 *^* mTrue) M1'). apply enable_sw_nxt_stkspace with p S M1; auto. InvertAll. rename x into M1'. assert (exists junk, (S_RF S' SP |-> pc + 1 *^* S_RF S' SP + 1 |-> junk *^* stkSpacePrec (S_RF S' SP) 8 *^* mTrue) M1'). sep on. sep lift 0 in H8. assert (exists junk, M1' ||- S_RF S' SP |-> pc + 1 *^* S_RF S' SP + 1 |-> junk *^* (stkSpacePrec (S_RF S' SP) 8 *^* mTrue)). apply ptoW_elim1; auto. inversion H7. exists x. sep on. sep matchH H9 with 4. inversion_clear H7. clear H8. exists x. apply merge_SW_pre with M1' M2 B; auto. Qed. Lemma enter_SW_pre: forall psi pc theta Psi'0 S S', NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Itp_AIM rho_ready theta Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> SW_Prd S'. Proof. intros. unfold SW_Prd. induction theta. unfold Itp_AIM in H0. InvertAll. rename x into T. rename x0 into B. rename x1 into RdyQ. rename x2 into tid. exists T. exists RdyQ. exists tid. rename n into tag. unfold NH_WFcmd in H. unfold NH_WFcmd_aux in H. InvertAll. inversion_clear H2. inversion_clear H3. clear H2. unfold NH_Call_Prim in H5. inversion_clear H5. inversion H2. inversion H6. rewrite <- H12 in H8. clear H9 H10 H12 H13 H14 H5 H6 H7 tag0 p0 g0 p' g'. induction S as (((M, R), fl), isr). exists (S_RF S' SP). unfold pmstar in H0. InvertAll. rename x into M1. rename x0 into M2. assert (exists tcb, TQMod.maps_to T tid tcb). apply WF_AIM_World_currTCB with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ rho_ready (Ast p g tag); auto. inversion_clear H6. rename x into tcb. exists tcb. exists (pc+1). split. apply enter_SW_preMem with (M, R, fl, isr) p g tag M1 M2 Psi'0 B; auto. split; auto. split; auto. apply WF_AIM_World_RdyQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B tid rho_ready (Ast p g tag); auto. split; auto. split. apply WF_AIM_World_cthNotRdy with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) T B rho_ready (Ast p g tag); auto. apply WF_AIM_World_WFTQ with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ready (Ast p g tag); auto. assert (_SWITCH <> _BLOCK). auto. contradiction. assert (_SWITCH <> _UNBLK). auto. contradiction. assert (prim_entry _SWITCH). unfold prim_entry. left. auto. inversion_clear H3. contradiction. Qed. Lemma enter_SW_disable: forall psi pc theta Psi'0 S S', NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Itp_AIM rho_ready theta Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> S_Flag S' _IF = false. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). unfold NH_WFcmd in H. induction theta. destruct H as [HWFcmd [Htmp1 Htmp2]]. clear Htmp1 Htmp2. unfold NH_WFcmd_aux in HWFcmd. inversion_clear HWFcmd. destruct H as [Hprim HWFcmd]. clear Hprim. unfold NH_Call_Prim in HWFcmd. inversion_clear HWFcmd. clear H. assert (fl _IF = false). assert (imprec (NH_pinvstar p) (M, R, fl, isr)). apply Itp_AIM_pinv with g n Psi'0 rho_ready. auto. discriminate. unfold imprec in H. unfold pmstar in H. InvertAll. unfold NH_pinvstar in H. simplS in H. unfold pmstar in H. InvertAll. simplS in H. assert (S_Flag (x1, R, fl, isr) _IF = false). apply H2; auto. UnfoldStateAll; auto. clear H0 H2. destruct (nextS_inversion H1). InvertAll. subst fl'. UnfoldStateAll. auto. inversion_clear H. assert (prim_entry _SWITCH). unfold prim_entry. left. auto. contradiction. Qed. Lemma S_Mem_Upd_discard_interm2 : forall S M1 M2, (S_Mem_Upd (S_Mem_Upd S M2) M1) = (S_Mem_Upd S M1). Proof. induction S as (((M, R) , fl),isr). intros. UnfoldStateAll. auto. Qed. Hint Resolve S_Mem_Upd_discard_interm2. Lemma WFcallsw_enablesw: forall psi pc p g tag, NH_WFcmd psi pc (Ast p g tag) (comml (_call _SWITCH)) -> enable_sw p. Proof. intros. unfold NH_WFcmd in H. InvertAll. unfold NH_WFcmd_aux in H0. inversion_clear H0. inversion_clear H1. inversion_clear H3. inversion H1. inversion H5. auto. assert (_SWITCH <> _BLOCK). auto. contradiction. assert (_SWITCH <> _UNBLK). auto. contradiction. assert (prim_entry _SWITCH). unfold prim_entry. left. auto. inversion H1. contradiction. Qed. Lemma call_sw_nextPC_spec: forall psi pc p g tag, NH_WFcmd psi pc (Ast p g tag) (comml (_call _SWITCH)) -> exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun gy pc _SWITCH pc') oo g') g). Proof. intros. unfold NH_WFcmd in H. inversion_clear H. unfold NH_WFcmd_aux in H0. inversion_clear H0. inversion_clear H. inversion_clear H2. inversion H. exists p'. exists g'. inversion H4. split; auto. absurd (_SWITCH <> _BLOCK); auto. absurd (_SWITCH <> _UNBLK); auto. inversion_clear H. absurd (prim_entry _SWITCH); auto. unfold prim_entry. left. auto. Qed. Hint Resolve call_sw_nextPC_spec. Lemma minimalD_containsRdy: forall D, Minimal_D D -> D rho_ready = SomeT1 _ (Itp_AIM rho_ready). Proof. intros. unfold Minimal_D in H. InvertAll. auto. Qed. Hint Resolve minimalD_containsRdy. Lemma call_sw_flags_false: forall p g tag psi Psi pc M M' R fl isr T tid, WF_Curr_Thrd Psi (M, R, fl, isr) rho_ready (Ast p g tag) T tid -> NH_WFcmd psi pc (Ast p g tag) (comml (_call _SWITCH)) -> p (M', R, fl, isr) -> (fl _IF = false) /\ (isr = false). Proof. intros. unfold NH_WFcmd in H0. InvertAll. unfold NH_WFcmd_aux in H2. inversion_clear H2. inversion_clear H3. inversion_clear H5. assert (S_Flag (M', R, fl, isr) _IF = false). apply H6; auto. unfold S_Flag in H5. split; auto. unfold WF_Curr_Thrd in H. assert (beq_nat rho_ready rho_ih = false). apply neq_beq_false. discriminate. rewrite H7 in H. unfold itp_NH_theta in H. unfold S_ISR in H. InvertAll. auto. InvertAll. absurd (prim_entry _SWITCH); auto. unfold prim_entry. left. auto. Qed. Lemma enter_SW_grt2_hyp2: forall T T' B RdyQ' tid tid' sp sp' tcb tcb' pc pc' S0 S' M0' M2' M22 M12 cthM2 cthM12 cthMR TM junk, SW_Post_aux T' RdyQ' tid' sp' sp tcb' pc junk (S_Mem_Upd S0 M0') -> nextS pc' (comms _retw) S0 S' -> MemMod.disjUnion M0' M2' (S_Mem S0) -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' -> embed_WQSet T B M22 -> MemSplit (ThrdMemMod.remove TM tid) M12 -> ThrdMemMod.maps_to TM tid' cthMR -> tid <> tid' -> NH_Inv (S_Flag S0) cthM2 -> (INV0 *^* INV1 *^* mTrue) cthM12 -> T' = TQMod.put T tid (sp, TCB_Status tcb, pc) -> exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ (INV0 *^* INV1) INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ') M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old /\ (sp |-> pc *^* sp + 1 |-> junk *^* stkSpacePrec sp 8) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S'). Proof. intros. unfold mstar at 1 in H8. InvertAll. rename x into INVM. rename x0 into cthM0. exists INVM. exists cthM0. unfold SW_Post_aux in H. InvertAll. unfold SW_MPost in H11. assert ((embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ' *^* (sp |-> pc *^* sp + 1 |-> junk *^* stkSpacePrec sp 8)) (S_Mem (S_Mem_Upd S0 M0'))). sep on. sep matchH H11 with 4. clear H11. unfold mstar at 1 in H15. InvertAll. rename x into M21'. exists M21'. rename x0 into cthM_oldStk. assert (exists M122, MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122). apply memsplit_thrd_remove; auto. unfold ThrdMemMod.maps_to. unfold ThrdMemMod.remove. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. unfold ThrdMemMod.maps_to in H5. auto. InvertAll. rename x into M122. exists M122. exists (MemMod.merge (MemMod.merge cthM0 cthM2) cthM_oldStk). exists cthM_oldStk. split; auto. split; auto. split; auto. split; auto. split; auto. split. unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_aux2_hyp0 with INVM cthM12 M22 M12 M0' M2' S0 M21'; auto. split. auto. apply enter_SW_grt2_aux2_hyp1 with pc' M0' M2' S0 M12 cthM12; auto. Qed. Lemma enter_SW_grt2_auxc_aux4: forall pc pc' M R fl isr M' R' fl' isr' cthM1 cthM11 cthM12 INVM cthM0 M0 cthM_oldStk R0 fl0 junk cthM2 cthM_old M'2, nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> MemMod.disjUnion cthM11 cthM12 cthM1 -> stkSpacePrec (R SP) (8 + 2) cthM11 -> MemMod.disjUnion INVM cthM0 cthM12 -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk *^* stkSpacePrec (R' SP) 8) cthM_oldStk -> (INV0 *^* INV1) INVM -> (INV0 *^* INV1) M0 -> MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old -> fl0 _IF = false -> fl _IF = false -> isr = false -> R0 SP = R' SP + 2 -> wrap_fun gy pc _SWITCH pc' (cthM1, R, fl, isr) (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk, R0, fl0, false). Proof. intros. unfold wrap_fun. unfold conjG. exists (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk, RF_update R0 SP (R0 SP - 2), fl0, false). split. assert (nextS pc (comml (_call _SWITCH)) (cthM1, R, fl, isr) (MemUpdW cthM1 (R SP - 2) (pc+1) junk, RF_update R SP (R SP - 2), fl, isr)). apply nextS_call. unfold pushW. split. assert ((mTrue *^* stkSpacePrec (R SP) (8 + 2)) cthM1). exists cthM12. exists cthM11. split; auto with PMap. unfold mTrue. split; auto. sep on. sep lift 1 in H12. sep stksplit 2 in H12. sep lift 0 in H12. sep trivial. split; auto. apply MemUpdW_MemUpd16 with junk; auto. set (cthM' := MemUpdW cthM1 (R SP - 2) (pc + 1) junk) in *. exists (cthM', RF_update R SP (R SP - 2), fl, isr). split; auto. assert (R SP - 2 = R' SP). apply enter_SW_grt_auxb0_hyp0 with pc M fl isr M' fl' isr' _SWITCH; auto. unfold gy. exists (R SP - 2). simplS. reg simpl. assert (R SP = R' SP + 2). rewrite <- H13. assert (R SP >= 2). apply ge_trans with (8 + 2). sep on. apply stkSpacePrec_sp_ge_sz with cthM11; auto. auto with arith. assert (R SP - 2 + 2 = R SP). auto. auto. rename H14 into HRSP'. split. unfold prepost. simplS. sep on. sep stksplit in H1. destruct H1 as [cthM11_1 [cthM11_2 [HcthM11split [HcthM11_1 HcthM11_2]]]]. exists (MemMod.merge INVM cthM11_1). exists (MemMod.merge (MemUpdW cthM11_2 (R SP - 2) (pc+1) junk) cthM0). sep lift 2 in H3. unfold mstar at 1 in H3. sep off. InvertAll. rename x into oldStk1. rename x0 into oldStk2. exists (MemMod.merge M0 oldStk1). split. exists INVM. exists cthM11_1. split; auto. split; auto. apply enter_BLK_grt2_auxc_hyp1 with cthM1 cthM11 cthM12 cthM11_2 cthM0; auto. split. exists M0. exists oldStk1. rewrite <- H13 in H3. split; auto. split; auto. apply enter_BLK_grt2_auxc_hyp2 with M'2 cthM_old (MemMod.merge cthM0 cthM2) cthM_oldStk oldStk2; auto. split. assert (MemMod.disjUnion (MemMod.merge (MemUpdW cthM11_2 (R SP - 2) (pc + 1) junk) cthM0) (MemMod.merge INVM cthM11_1) cthM'). apply enter_SW_grt2_auxc_auxx with cthM1 cthM11 cthM12; auto. auto with PMap. assert (MemUpdW cthM11_2 (R SP - 2) (pc + 1) junk = oldStk2). rewrite H13 in HcthM11_2. rewrite H13. apply enter_SW_grt2_auxc_hypx; auto. rewrite H14. apply enter_BLK_grt2_auxc_hyp4 with M'2 cthM_old cthM2; auto. rewrite <- H11 in HRSP'. rewrite <- HRSP'. split; auto. rewrite <- H8 in H9. auto. apply nextS_retw. exists (pc+1). unfold popW. reg simpl. split. rewrite H11. assert (R' SP + 2 - 2 = R' SP). auto. rewrite H12. apply enter_BLK_grt2_auxc_hyp5 with M'2 cthM_old cthM2 junk (stkSpacePrec (R' SP) 8); auto. rewrite H11. assert (R' SP + 2 - 2 = R' SP). auto. rewrite H12. rewrite <- H11. assert (RF_update R0 SP (R0 SP) = R0). apply RF_update_prev. auto. Qed. Lemma enter_SW_grt2_auxc: forall cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk M0 M'2 cthM_old R0 fl0 (p p'': Pred) M M' R' fl' isr', MemMod.disjUnion cthM1 cthM2 cthM -> p (cthM1, R, fl, isr) -> NH_Inv fl cthM2 -> MemMod.disjUnion cthM11 cthM12 cthM1 -> stkSpacePrec (R SP) (8 + 2) cthM11 -> MemMod.disjUnion INVM cthM0 cthM12 -> (INV0 *^* INV1) INVM -> MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk *^* stkSpacePrec (R' SP) 8) cthM_oldStk -> (INV0 *^* INV1) M0 -> MemMod.disjUnion M0 cthM_old M'2 -> (forall pc' : nat, pimp (p |> wrap_fun gy pc _SWITCH pc') p'') -> fl0 _IF = false -> fl _IF = false -> nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') (* -> nextS pc' (comms _retw) S0 S' *) -> R0 SP = R' SP + 2 -> isr = false -> NH_pinvstar p'' (S_Mem_Upd (cthM_old, R0, fl0, false) M'2). Proof. intros. unfold NH_pinvstar. unfold pmstar. exists (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). exists cthM2. split. assert (S_Mem (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) = M'2). auto. rewrite H16. clear H16. apply enter_SW_grt2_auxc_hyp0 with cthM_old; auto. assert (MemMod.disjoint cthM12 cthM2). apply MemMod.disj_merge_disj_right with cthM11. inversion_clear H2. subst cthM1. inversion_clear H. auto. apply MemMod.disj_merge_disj_right with INVM. inversion_clear H4. subst cthM12. auto. split. simplS. unfold pimp in H10. apply H10 with 0. unfold linkPG. exists (cthM1, R, fl, isr). split; auto. apply enter_SW_grt2_auxc_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM junk cthM2 cthM_old M'2; auto. assert (S_Flag (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) = fl0). UnfoldStateAll. auto. rewrite H16. unfold NH_Inv. rewrite H11. unfold NH_Inv in H1. rewrite H12 in H1. auto. Qed. (* >>>>>>>>>>>>>>>> *) Lemma enter_SW_grt: forall D psi pc theta D' Psi Psi' Psi'0 S S', NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> subsetCT Psi' Psi'0 -> Itp_AIM rho_ready theta Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> WFST D rho_prim 0 Psi'0 (scap_lift_g SW_grt S'). Proof. intros. unfold WFST. intros. unfold scap_lift_g in H7. InvertAll. induction S' as (((M', R'), fl'), isr'). induction S as (((M, R), fl), isr). induction theta. rename n into tag. unfold Itp_AIM in H5. unfold pmstar in H5. InvertAll. rename x into T. rename x0 into B. rename x1 into RdyQ. rename x2 into tid. rename x3 into M1. rename x4 into M2. assert ((embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* embed_WQSet T B) M2). apply leqvM_app_subst with (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)); auto. apply leqvM_commut. apply mstar_assoc. unfold mstar at 1 in H11. InvertAll. rename x into M21. rename x0 into M22. clear H12. assert (exists TM, exists cthM, exists M12, exists cthM1, exists cthM2, MemMod.disjUnion M12 cthM M1 /\ MemMod.disjUnion cthM1 cthM2 cthM /\ WF_currTID tid T B RdyQ rho_ready /\ WF_TWQ T B RdyQ /\ exists_Idle T RdyQ tid /\ WF_WQ_WQSpec B Delta /\ MemSplit (ThrdMemMod.remove TM tid) M12 /\ ThrdMemMod.maps_to TM tid cthM /\ WF_Curr_Thrd Psi'0 (S_Mem_Upd (M1, R, fl, isr) cthM) rho_ready (Ast p g tag) T tid /\ WF_ReadyQ Psi'0 T RdyQ TM /\ WF_WQSet Psi'0 T B TM /\ p (cthM1, R, fl, isr) /\ NH_Inv fl cthM2 /\ (tag = 1 -> NH_WFST rho_ready Psi'0 (NH_ItpG g (cthM, R, fl, isr)))). apply decompose_World; auto. InvertAll. rename x into TM. rename x0 into cthM. rename x1 into M12. rename x2 into cthM1. rename x3 into cthM2. assert (WQMod.not_in_dom tid RdyQ). unfold WF_currTID in H16. InvertAll. auto. assert (exists M1, exists M2, MemMod.disjUnion M1 M2 (S_Mem (cthM1, R, fl, isr)) /\ stkSpacePrec (S_RF (cthM1, R, fl, isr) SP) (8 + 2) M1 /\ ((INV0 *^*INV1) *^* mTrue) M2). apply enable_sw_stkspace with p; auto. apply WFcallsw_enablesw with psi pc g tag; auto. InvertAll. rename x into cthM11. rename x0 into cthM12. unfold S_Mem in H30. unfold S_RF in H29. assert (disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11 :: nil) M). apply mem_list_compose_a with cthM1 cthM M1; auto. assert (exists junk, (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk *^* (stkSpacePrec (R' SP) 8)) (MemUpdW cthM11 (R' SP) (pc + 1) junk) /\ disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: (MemUpdW cthM11 (R' SP) (pc + 1) junk) :: nil) M'). apply call_sw_frame with M R fl fl' isr isr'; auto. InvertAll. rename x into junk1. set (cthM11' := MemUpdW cthM11 (R' SP) (pc + 1) junk1) in *. assert (exists M1', exists M2', MemMod.disjUnion cthM11' M21 M1' /\ disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' /\ MemMod.disjUnion M1' M2' M'). apply mem_list_compose_b with M2; auto. InvertAll. rename x into M1'. rename x0 into M2'. assert (exists tcb, T tid = Some tcb). unfold WF_currTID in H16. InvertAll. unfold TQMod.in_dom in H39. auto. inversion_clear H37. rename x into tcb. assert (exists M0' : MemMod.Map, exists RdyQ' : WQ, exists tid' : TID, exists sp' : nat, exists tcb' : Thread, MemMod.disjUnion M0' M2' (S_Mem S0) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ SW_Post_aux (TQMod.put T tid ((R' SP), TCB_Status tcb, pc+1)) RdyQ' tid' sp' (R' SP) tcb' (pc+1) junk1 (S_Mem_Upd S0 M0')). apply H8 with M1' T tcb; auto. unfold SW_Prd_aux. split. assert (S_Mem (S_Mem_Upd (M', R', fl', isr') M1') = M1'). auto. rewrite H37. apply mem_compose_c with cthM11' M21; auto. split; auto. split. apply WF_AIM_World_RdyQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B tid rho_ready (Ast p g tag). auto. split; auto. split; auto. apply WF_AIM_World_WFTQ with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho_ready (Ast p g tag). auto. clear H8. InvertAll. rename x into M0'. rename x0 into RdyQ'. rename x1 into tid'. rename x2 into sp'. rename x3 into tcb'. assert ((fl _IF = false) /\ (isr = false)). apply call_sw_flags_false with p g tag psi Psi'0 pc cthM cthM1 R T tid; auto. inversion_clear H40. assert (tid = tid' \/ tid <> tid'). apply nat_eq_neq_dec. inversion_clear H40. (* tid = tid' *) (* clear H24 H27 H26 cthM11. *) assert (RdyQ = RdyQ'). assert (WQMod.not_in_dom tid' RdyQ'). unfold SW_Post_aux in H41. InvertAll. auto. apply unique_remain with tid tid'; auto. exists (pc + 1). rewrite <- H40 in H41. rewrite <- H44 in H41. clear H44 H40 H8 tid' RdyQ'. assert (S_RF S0 SP = R' SP). assert (sp' = R' SP). apply enter_SW_grt_aux60 with T RdyQ tid tcb (pc+1) junk1 tcb' S0 M0'; auto. unfold SW_Post_aux in H41. InvertAll. rewrite H8 in H45. auto. split. apply enter_SW_grt_aux7 with T RdyQ tid (R' SP) tcb junk1 sp' tcb' M0' M2'; auto. assert (exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun gy pc _SWITCH pc') oo g') g)). auto. InvertAll. rename x into p'. rename x0 into g'. exists (packS0 rho_ready (Ast p' g' tag)). split. apply psi_sw_lookupNPC with psi Psi Psi'; auto. intros. unfold Itp0. assert (D rho_ready = SomeT1 _ (Itp_AIM rho_ready)). auto. rewrite H47. unfold Itp_AIM. set (T' := TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)) in * |- *. exists T'. exists B. exists RdyQ. exists tid. assert (exists M21_0, exists cthM11'', ((S_RF S' SP - 2) |-> (pc+1) *^* (S_RF S' SP - 2 + 1) |-> junk1 *^* stkSpacePrec (S_RF S' SP - 2) 8) cthM11'' /\ (embed_curr_TCB T' tid *^* embed_RdyQ T' RdyQ) M21_0 /\ disjUnionList (M21_0 :: M22 :: M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) (S_Mem S')). apply enter_SW_grt_aux8 with T (R' SP) sp' tcb tcb' pc' S0 M0' M2'; auto. InvertAll. rename x into M21_0. rename x0 into cthM11''. unfold pmstar. assert (exists M'1, exists M'2, disjUnionList (M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) M'1 /\ MemMod.disjUnion M21_0 M22 M'2 /\ MemMod.disjUnion M'1 M'2 (S_Mem S')). apply enter_SW_grt_hyp4. auto. InvertAll. rename x into M'1. rename x0 into M'2. exists M'1. exists M'2. split; auto. split. unfold WF_AIM_World. split. unfold T'. apply WF_currTID_ext_T with tcb; auto. split. unfold T'. apply exists_Idle_ext_T; auto. split. unfold T'. apply WF_TWQ_ext_T; auto. exists tcb. auto. split; auto. assert (exists cthM', MemMod.disjUnion M12 cthM' M'1 /\ disjUnionList (cthM2 :: cthM12 :: cthM11'' :: nil) cthM'). auto. InvertAll. rename x into cthM'. exists (ThrdMemMod.put TM tid cthM'). exists cthM'. split. assert (S_Mem (S_Mem_Upd S' M'1) = M'1). auto. rewrite H55. apply enter_SW_grt_hyp6 with M12; auto. split. auto with PMap. split. assert (S_ISR (M, R, fl, isr) = S_ISR S' /\ S_Flag (M, R, fl, isr) _IF = S_Flag S' _IF). apply enter_SW_grt_hyp9 with pc pc' _SWITCH (M', R', fl', isr') S0; auto. unfold S_ISR at 1 in H55. unfold S_Flag at 1 in H55. inversion_clear H55. unfold WF_Curr_Thrd. assert (beq_nat rho_ready rho_ih = false). apply neq_beq_false. discriminate. rewrite H55. clear H55. unfold itp_NH_theta. split. rewrite H43 in H57. rewrite H57. auto. split. unfold NH_pinvstar. unfold pmstar. exists (MemMod.merge cthM12 cthM11''). exists cthM2. split. assert (MemMod.disjUnion (MemMod.merge cthM12 cthM11'') cthM2 cthM'). apply enter_SW_grt_hypa; auto. UnfoldStateAll. auto. split; auto. assert (S_Mem_Upd (S_Mem_Upd (S_Mem_Upd S' M'1) cthM') (MemMod.merge cthM12 cthM11'') = S_Mem_Upd S' (MemMod.merge cthM12 cthM11'')). auto. rewrite H55. clear H55. apply enter_SW_grt_auxb with p cthM1 R fl isr M cthM11 pc pc' M' R' fl' isr' junk1 S0; auto. apply enter_SW_grt_hypc with M21_0 M22 M12 cthM2; auto. apply enter_SW_grt_hypd with M21_0 M22 M12 cthM2 S'; auto. assert (S_Flag (S_Mem_Upd (S_Mem_Upd S' M'1) cthM') = S_Flag S'). auto. rewrite H55. unfold NH_Inv. rewrite <- H58. unfold NH_Inv in H26. auto. intro Tag1. assert (NH_WFST rho_ready Psi'0 (NH_ItpG g (cthM, R, fl, isr))). apply H28. auto. apply NH_WFST_strengthen with (cthM, R, fl, isr) g; auto. unfold pimp. intros. unfold NH_ItpG. assert ((S_Mem_Upd (S_Mem_Upd S' M'1) cthM') = (S_Mem_Upd S' cthM')). auto. rewrite H60 in H59. clear H60. unfold NH_ItpG in H59. InvertAll. rename x into cthM'1. rename x0 into cthM'2. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split. unfold S_Mem. auto. (* H14 *) split. auto. split. auto. split. auto. unfold gimp in H46. apply H46 with pc'. unfold conjG. exists (S_Mem_Upd (S_Mem_Upd S' cthM') cthM'1). split; auto. assert ((cthM2 = cthM'2) /\ (cthM'1 = MemMod.merge cthM12 cthM11'')). apply enter_SW_grt_hype with S' cthM' fl; auto. inversion_clear H63. rewrite H66. unfold conjPG. split; auto. assert (S_Mem_Upd (cthM, R, fl, isr) cthM1 = (cthM1, R, fl, isr)). auto. rewrite H63. clear H63. assert (S_Mem_Upd (S_Mem_Upd S' cthM') (MemMod.merge cthM12 cthM11'') = S_Mem_Upd S' (MemMod.merge cthM12 cthM11'')). auto. rewrite H63. clear H63. apply enter_SW_grt_auxb0 with M cthM11 M' R' fl' isr' junk1 S0; auto. apply enter_SW_grt_hypc with M21_0 M22 M12 cthM2; auto. apply enter_SW_grt_hypd with M21_0 M22 M12 cthM2 S'; auto. split. apply enter_SW_grt_hypf with T (R' SP, TCB_Status tcb, pc + 1); auto. apply enter_SW_grt_hypg with T (R' SP, TCB_Status tcb, pc + 1); auto. unfold WF_currTID in H16. InvertAll. auto. apply leqvM_app_subst with (embed_curr_TCB T' tid *^* embed_RdyQ T' RdyQ *^* embed_WQSet T' B); auto. apply mstar_assoc. unfold mstar at 1. exists M21_0. exists M22. split; auto. split; auto. apply enter_SW_grt_hyph with T tid (R' SP, TCB_Status tcb, pc + 1); auto. unfold WF_currTID in H16. InvertAll. auto. (* tid <> tid' *) assert (WQMod.not_in_dom tid' RdyQ'). unfold SW_Post_aux in H41. InvertAll. auto. assert (WQMod.in_dom tid RdyQ' /\ WQMod.in_dom tid' RdyQ). apply enter_SW_grt2_hyp0; auto. inversion_clear H45. assert (WF_ReadyQ Psi'0 T RdyQ TM). auto. unfold WF_ReadyQ in H23. assert (exists tcb', TQMod.maps_to T tid' tcb' /\ (TCB_Status tcb' = READY \/ TCB_Status tcb' = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid' M /\ (TCB_SP tcb' |~>w TCB_PC tcb') M /\ (WF_Rdy_Thrd Psi'0 M tcb' \/ WF_Rdy_Thrd_IH Psi'0 M tcb'))). apply H23. auto. InvertAll. rename x into tcb''. rename x0 into cthMR. induction tcb'' as ((sp'', status''), pc''). exists pc''. assert (tcb' = (sp'', status'', pc'') /\ sp' = sp'' /\ S_RF S0 SP = sp'). unfold SW_Post_aux in H41. InvertAll. assert (tcb' = (sp'', status'', pc'')). assert (TQMod.maps_to T tid' tcb'). unfold TQMod.maps_to in H41. unfold TQMod.put in H41. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. unfold TQMod.maps_to. auto. unfold TQMod.maps_to in H56. unfold TQMod.maps_to in H48. rewrite H56 in H48. inversion H48. auto. split; auto. split; auto. rewrite H56 in H54. auto. inversion_clear H52. inversion_clear H55. unfold TCB_PC in H50. unfold TCB_SP in H50. split. apply enter_SW_grt2_hyp1 with TM tid tid' cthMR sp'' M0' M2' M22 M12 cthM2 cthM12; auto. rewrite <- H52. auto. inversion_clear H53. (* not in interrupt handler *) unfold WF_Rdy_Thrd in H55. InvertAll. rename x into rho'. rename x0 into p'. rename x1 into g'. rename x2 into tag'. clear H57. exists (packS0 rho' (Ast p' g' tag')). split; auto. intros. unfold Itp0. assert (D rho' = SomeT1 _ (Itp_AIM rho')). apply non_ih_spec_miniD; auto. rewrite H59. clear H59. unfold Itp_AIM. exists (TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). set (T' := TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). exists B. exists RdyQ'. exists tid'. clear H23. assert (exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ (INV0 *^* INV1) INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ') M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old /\ (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk1 *^* stkSpacePrec (R' SP) 8) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S')). apply enter_SW_grt2_hyp2 with T B sp' tcb tcb' pc' S0 M0' M2'; auto. unfold NH_Inv. rewrite <- H10. unfold S_Flag. assert (S_Flag (M, R, fl, isr) _IF = S_Flag (M', R', fl', isr') _IF /\ S_ISR (M, R, fl, isr) = S_ISR (M', R', fl', isr')). apply enter_SW_grt_auxb0_hyp4 with pc _SWITCH; auto. inversion_clear H23. unfold S_Flag in H59. rewrite <- H59. unfold NH_Inv in H26. auto. InvertAll. rename x into INVM. rename x0 into cthM0. rename x1 into M21'. rename x2 into M122. rename x3 into cthM_old. rename x4 into cthM_oldStk. unfold pmstar. assert ( exists M'0, exists M'1, MemMod.disjUnion M'0 M'1 (S_Mem S') /\ MemMod.disjUnion M21' M22 M'1 /\ disjUnionList (cthMR :: INVM :: cthM_old :: M122 :: nil) M'0 ). apply enter_SW_grt2_hyp3; auto. InvertAll. rename x into M'0. rename x0 into M'1. exists M'0. exists M'1. split; auto. split. unfold WF_AIM_World. split. apply enter_SW_grt2_hyp4 with T RdyQ tid (R' SP, TCB_Status tcb, pc + 1) (sp'', status'', pc'') rho_ready; auto. split. apply enter_SW_grt2_hyp5 with T RdyQ tid (R' SP) (pc+1) tcb; auto. split. apply enter_SW_grt2_aux6 with RdyQ tid tid' tcb (R' SP, TCB_Status tcb, pc + 1) T rho_ready; auto. split; auto. exists (ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). set (TM' := ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). exists (MemMod.merge cthMR INVM). set (cthM' := MemMod.merge cthMR INVM). split. assert (S_Mem (S_Mem_Upd S' M'0) = M'0). auto. rewrite H69. apply enter_SW_grt2_hyp7 with cthMR INVM cthM_old M122 TM tid tid'; auto. split. unfold cthM'. unfold TM'. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. induction (ThrdMemMod.beq_A tid' tid'). auto. absurd (tid' = tid'); auto. split. unfold WF_Curr_Thrd. assert (beq_nat rho' rho_ih = false). apply neq_beq_false. inversion_clear H53. rewrite H69. discriminate. rewrite H69. discriminate. rewrite H69. unfold itp_NH_theta. assert (S_ISR S' = false). apply enter_SW_grt2_hyp8 with pc pc' M R fl isr M' R' fl' isr' S0 _SWITCH; auto. split. UnfoldStateAll. auto. assert ((INV0 *^* INV1 -* itp_NH_theta rho' (Ast p' g' tag') Psi'0) (cthMR, S_RF S', S_Flag S', false)). apply H60. rewrite H52 in H56. apply enter_SW_grt2_hyp9 with S0 pc'; auto. assert (S_ISR (M, R, fl, isr) = S_ISR S' /\ S_Flag (M, R, fl, isr) _IF = S_Flag S' _IF). apply enter_SW_grt_hyp9 with pc pc' _SWITCH (M', R', fl', isr') S0; auto. inversion_clear H72. rewrite <- H74. unfold S_Flag. auto. assert (itp_NH_theta rho' (Ast p' g' tag') Psi'0 (cthM', S_RF S', S_Flag S', false)). unfold cthM'. unfold pm_mwand in H72. assert ((MemMod.merge cthMR INVM, S_RF S', S_Flag S', false) = S_Mem_Upd (cthMR, S_RF S', S_Flag S', false) (MemMod.merge cthMR INVM)). auto. rewrite H73. apply H72 with INVM; auto. unfold S_Mem. assert (MemMod.disjUnion cthMR INVM (MemMod.merge cthMR INVM)). unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_hypa with M22 M21' cthM_old M122 S'; auto. auto with PMap. assert (S_Mem_Upd (S_Mem_Upd S' M'0) cthM' = (cthM', S_RF S', S_Flag S', false)). induction S' as (((M'', R''), fl''), isr''). UnfoldStateAll. auto. rewrite H71. auto. rewrite H74. clear H74. unfold itp_NH_theta in H73. inversion_clear H73. auto. split. unfold WF_ReadyQ. intros. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H71. (* tid0 = tid *) exists (R' SP, TCB_Status tcb, pc + 1). rewrite H72. split; auto. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid tid). auto. absurd (tid = tid); auto. split. unfold TCB_Status at 1. unfold TCB_Status at 2. unfold WF_currTID in H16. InvertAll. unfold TQMod.maps_to in H75. rewrite H75 in H39. inversion H39. rewrite <- H78. auto. exists cthM_old. split. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid tid); auto. absurd (tid = tid); auto. split. unfold TCB_SP. unfold TCB_PC. apply enter_SW_grt2_hypb with (MemMod.merge cthM0 cthM2) cthM_oldStk junk1; auto. left. unfold WF_Rdy_Thrd. exists rho_ready. assert (exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun gy pc _SWITCH pc') oo g') g)). apply call_sw_nextPC_spec; auto. InvertAll. rename x into p''. rename x0 into g''. exists p''. exists g''. exists tag. split. left. auto. split. unfold WF_currTID in H16. InvertAll. unfold TQMod.maps_to in H78. rewrite H78 in H39. inversion H39. rewrite <- H81. unfold rho_tcb_consistent in H80. unfold rho_tcb_consistent. auto. split. apply enter_SW_grt2_hypb with (MemMod.merge cthM0 cthM2) cthM_oldStk junk1; auto. split. apply psi_sw_lookupNPC with psi Psi Psi'; auto. intros. unfold pm_mwand. unfold S_Mem. intros. unfold itp_NH_theta. split. UnfoldStateAll. auto. split. apply enter_SW_grt2_auxc with cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk1 M0 p M M' R' fl' isr'; auto. (* WFST *) intro. assert (NH_WFST rho_ready Psi'0 (NH_ItpG g (cthM, R, fl, isr))). apply H28. auto. clear H28. clear H79. apply NH_WFST_strengthen with (cthM, R, fl, isr) g; auto. unfold pimp. intros. unfold gimp in H75. unfold NH_ItpG. unfold NH_ItpG in H28. InvertAll. rename x into M'20. rename x0 into M'21. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split; auto. split; auto. split. unfold S_Flag. auto. split. auto. apply H75 with pc'. unfold conjG. exists (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20). split; auto. unfold conjPG. split; auto. assert (M'20 = MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). apply enter_SW_grt2_hype with cthM_old M'2 cthM2 M'21 fl fl0; auto. assert (S_Mem_Upd (cthM, R, fl, isr) cthM1 = (cthM1, R, fl, isr)). UnfoldStateAll. auto. rewrite H85. clear H85. assert (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20 = (M'20, R0, fl0, false)). UnfoldStateAll. auto. rewrite H85. clear H85. rewrite H83. apply enter_SW_grt2_auxc_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM junk1 cthM2 cthM_old M'2; auto. (* tid0 <> tid : other ready threads *) unfold WF_ReadyQ in H45. assert (exists tcb : Thread, TQMod.maps_to T tid0 tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid0 M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi'0 M tcb \/ WF_Rdy_Thrd_IH Psi'0 M tcb))). apply H45; auto. apply enter_SW_grt2_hypf with RdyQ' tid tid'; auto. InvertAll. exists x. split. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold TQMod.maps_to in H71. auto. split; auto. exists x0. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). rewrite <- a in H40. absurd (~ WQMod.in_dom tid0 RdyQ'); auto with PMap. unfold ThrdMemMod.maps_to in H75. auto. apply enter_SW_grt2_hypg with T TM RdyQ RdyQ' tid tid' (R' SP, TCB_Status tcb, pc + 1) cthM_old (MemMod.merge cthMR INVM) rho_ready; auto. apply enter_SW_grt2_hyph with M21' M22 T (R' SP, TCB_Status tcb, pc + 1) RdyQ tid rho_ready; auto. (* tid' is in interrupt hander *) unfold WF_Rdy_Thrd_IH in H55. InvertAll. rename x into p'. rename x0 into g'. rename x1 into tag'. exists (packS0 rho_ih (Ast p' g' tag')). split; auto. intros. unfold Itp0. assert (D rho_ih = SomeT1 _ (Itp_AIM rho_ih)). unfold Minimal_D in H0. InvertAll. auto. rewrite H59. clear H59. unfold Itp_AIM. exists (TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). set (T' := TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). exists B. exists RdyQ'. exists tid'. clear H23. assert (exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ (INV0 *^* INV1) INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ') M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old /\ (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk1 *^* stkSpacePrec (R' SP) 8) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S')). apply enter_SW_grt2_hyp2 with T B sp' tcb tcb' pc' S0 M0' M2'; auto. unfold NH_Inv. rewrite <- H10. unfold S_Flag. assert (S_Flag (M, R, fl, isr) _IF = S_Flag (M', R', fl', isr') _IF /\ S_ISR (M, R, fl, isr) = S_ISR (M', R', fl', isr')). apply enter_SW_grt_auxb0_hyp4 with pc _SWITCH; auto. inversion_clear H23. unfold S_Flag in H59. rewrite <- H59. unfold NH_Inv in H26. auto. InvertAll. rename x into INVM. rename x0 into cthM0. rename x1 into M21'. rename x2 into M122. rename x3 into cthM_old. rename x4 into cthM_oldStk. unfold pmstar. assert ( exists M'0, exists M'1, MemMod.disjUnion M'0 M'1 (S_Mem S') /\ MemMod.disjUnion M21' M22 M'1 /\ disjUnionList (cthMR :: INVM :: cthM_old :: M122 :: nil) M'0 ). apply enter_SW_grt2_hyp3; auto. InvertAll. rename x into M'0. rename x0 into M'1. exists M'0. exists M'1. split; auto. split. unfold WF_AIM_World. split. apply enter_SW_grt2_hyp4 with T RdyQ tid (R' SP, TCB_Status tcb, pc + 1) (sp'', status'', pc'') rho_ready; auto. auto. split. apply enter_SW_grt2_hyp5 with T RdyQ tid (R' SP) (pc+1) tcb; auto. split. apply enter_SW_grt2_aux6 with RdyQ tid tid' tcb (R' SP, TCB_Status tcb, pc + 1) T rho_ready; auto. split; auto. exists (ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). set (TM' := ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). exists (MemMod.merge cthMR INVM). set (cthM' := MemMod.merge cthMR INVM). split. assert (S_Mem (S_Mem_Upd S' M'0) = M'0). auto. rewrite H68. apply enter_SW_grt2_hyp7 with cthMR INVM cthM_old M122 TM tid tid'; auto. split. unfold cthM'. unfold TM'. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. induction (ThrdMemMod.beq_A tid' tid'). auto. absurd (tid' = tid'); auto. split. unfold WF_Curr_Thrd. simpl. assert (S_Flag S' _IF = false). apply enter_SW_grt2_hypI with pc pc' M R fl isr M' R' fl' isr' S0; auto. assert ((INV0 *^* INV1 -* itp_IH_theta (Ast p' g' tag') status'' Psi'0) (cthMR, S_RF S', S_Flag S', false)). apply H58. rewrite H52 in H56. apply enter_SW_grt2_hyp9 with S0 pc'; auto. auto. exists (sp'', status'', pc''). exists status''. split. unfold T'. unfold TQMod.maps_to. unfold TQMod.put. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. auto. split; auto. unfold pm_mwand in H70. assert (S_ISR S' = false). apply enter_SW_grt2_hyp8 with pc pc' M R fl isr M' R' fl' isr' S0 _SWITCH; auto. assert (itp_IH_theta (Ast p' g' tag') status'' Psi'0 (S_Mem_Upd (cthMR, S_RF S', S_Flag S', false) cthM')). apply H70 with INVM; auto. unfold S_Mem. unfold cthM'. assert (MemMod.disjUnion cthMR INVM (MemMod.merge cthMR INVM)). unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_hypa with M22 M21' cthM_old M122 S'; auto. auto with PMap. rewrite <- H71 in H72. UnfoldStateAll. auto. split. unfold WF_ReadyQ. intros. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H70. exists (R' SP, TCB_Status tcb, pc + 1). rewrite H71. split; auto. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid tid). auto. absurd (tid = tid); auto. split. unfold TCB_Status at 1. unfold TCB_Status at 2. unfold WF_currTID in H16. InvertAll. unfold TQMod.maps_to in H74. rewrite H74 in H39. inversion H39. rewrite <- H77. auto. exists cthM_old. split. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid tid); auto. absurd (tid = tid); auto. split. unfold TCB_SP. unfold TCB_PC. apply enter_SW_grt2_hypb with (MemMod.merge cthM0 cthM2) cthM_oldStk junk1; auto. left. unfold WF_Rdy_Thrd. exists rho_ready. assert (exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun gy pc _SWITCH pc') oo g') g)). apply call_sw_nextPC_spec; auto. InvertAll. rename x into p''. rename x0 into g''. exists p''. exists g''. exists tag. split. left. auto. split. unfold WF_currTID in H16. InvertAll. unfold TQMod.maps_to in H77. rewrite H77 in H39. inversion H39. rewrite <- H80. unfold rho_tcb_consistent in H79. unfold rho_tcb_consistent. auto. split. apply enter_SW_grt2_hypb with (MemMod.merge cthM0 cthM2) cthM_oldStk junk1; auto. split. apply psi_sw_lookupNPC with psi Psi Psi'; auto. intros. unfold pm_mwand. unfold S_Mem. intros. unfold itp_NH_theta. split. UnfoldStateAll. auto. split. apply enter_SW_grt2_auxc with cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk1 M0 p M M' R' fl' isr'; auto. (* WFST *) intro. assert (NH_WFST rho_ready Psi'0 (NH_ItpG g (cthM, R, fl, isr))). apply H28. auto. clear H28. clear H78. apply NH_WFST_strengthen with (cthM, R, fl, isr) g; auto. unfold pimp. intros. unfold gimp in H74. unfold NH_ItpG. unfold NH_ItpG in H28. InvertAll. rename x into M'20. rename x0 into M'21. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split; auto. split; auto. split. unfold S_Flag. auto. split. auto. apply H74 with pc'. unfold conjG. exists (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20). split; auto. unfold conjPG. split; auto. assert (M'20 = MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). apply enter_SW_grt2_hype with cthM_old M'2 cthM2 M'21 fl fl0; auto. assert (S_Mem_Upd (cthM, R, fl, isr) cthM1 = (cthM1, R, fl, isr)). UnfoldStateAll. auto. rewrite H84. clear H84. assert (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20 = (M'20, R0, fl0, false)). UnfoldStateAll. auto. rewrite H84. clear H84. rewrite H82. apply enter_SW_grt2_auxc_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM junk1 cthM2 cthM_old M'2; auto. (* tid0 <> tid : other ready threads *) unfold WF_ReadyQ in H45. assert (exists tcb : Thread, TQMod.maps_to T tid0 tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid0 M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi'0 M tcb \/ WF_Rdy_Thrd_IH Psi'0 M tcb))). apply H45; auto. apply enter_SW_grt2_hypf with RdyQ' tid tid'; auto. InvertAll. exists x. split. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold TQMod.maps_to in H70. auto. split; auto. exists x0. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). rewrite <- a in H40. absurd (~ WQMod.in_dom tid0 RdyQ'); auto with PMap. unfold ThrdMemMod.maps_to in H74. auto. apply enter_SW_grt2_hypg with T TM RdyQ RdyQ' tid tid' (R' SP, TCB_Status tcb, pc + 1) cthM_old (MemMod.merge cthMR INVM) rho_ready; auto. apply enter_SW_grt2_hyph with M21' M22 T (R' SP, TCB_Status tcb, pc + 1) RdyQ tid rho_ready; auto. Qed. Lemma enter_SW: forall D psi pc theta D' Psi Psi' Psi'0 a S S', NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> a = Itp_AIM rho_ready theta -> subsetCT Psi' Psi'0 -> a Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> Itp0 D' SWITCH_Spec0 Psi'0 S'. Proof. intros. unfold Itp0. unfold SWITCH_Spec0. rewrite H1. simpl. rewrite H4 in H6. clear H4 a. split. apply enter_SW_pre with psi pc theta Psi'0 S; auto. split. apply enter_SW_disable with psi pc theta Psi'0 S; auto. exists 0. apply enter_SW_grt with psi pc theta D' Psi Psi' S; auto. Qed. Lemma NH_SW_Presv: forall D psi pc theta D' Psi Psi' Psi'0 a S S' f', NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> a = Itp_AIM rho_ready theta -> subsetCT Psi' Psi'0 -> a Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> nextPC (comml (_call _SWITCH)) (S_Mem S) (S_RF S) (S_Flag S) pc f' -> exists theta0 : Spec0, lookupCT Psi'0 f' theta0 /\ Itp0 D' theta0 Psi'0 S'. Proof. intros. assert (lookupCT Psi'0 _SWITCH SWITCH_Spec0). apply subsetCT_presv_lookupCT with Psi'; auto. rewrite H3. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with (consCT _SWITCH SWITCH_Spec0 Psi). apply lookupCT_consCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. inversion H8. clear H14 H13 H12 H10 H11 fl R M f pc0. exists SWITCH_Spec0. split; auto. apply enter_SW with D psi pc theta Psi Psi' a S; auto. Qed. Lemma call_sw_disable_itr: forall psi Psi'0 pc theta S, NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Itp_AIM rho_ready theta Psi'0 S -> ~ itr_enabled S. Proof. intros. unfold NH_WFcmd in H. induction theta. InvertAll. unfold NH_WFcmd_aux in H1. inversion_clear H1. unfold NH_Call_Prim in H2. InvertAll. assert (monotonic_p (fun S => S_Flag S _IF = false)). auto. assert (forall S, imprec p S -> (fun S => S_Flag S _IF = false) S). apply (imprec_presv_imp_monotonic H4 H5); auto. assert (imprec p S). apply imprec_presv_imprec with (NH_pinvstar p); auto. apply Itp_AIM_pinv with g n Psi'0 rho_ready; auto. assert ((fun S0 : State => S_Flag S0 _IF = false) S). apply (H6 S H7). intro. unfold itr_enabled in H9. assert (S_Flag S _IF = false). auto. inversion H9. rewrite H11 in H10. inversion H10. inversion H2. absurd (prim_entry _SWITCH); auto. unfold prim_entry. left. auto. Qed. Lemma NH_SW_Itp : forall D psi pc theta D' Psi Psi', NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ready Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) (* -> a = Itp_AIM rho_ready theta *) -> WFcmd D' Psi' (packS0 rho_ready theta) pc (comml (_call _SWITCH)). Proof. intros. unfold WFcmd. split. unfold WFcmd_aux. intros. assert (Itp_AIM rho_ready theta Psi'0 S). unfold Itp0 in H4. rewrite H1 in H4. unfold ext_dict in H4. assert (beq_nat rho_ready rho_prim = false). simpl. auto. rewrite H6 in H4. unfold Minimal_D in H0. InvertAll. rewrite H7 in H4. auto. split. apply NH_SW_progress with psi theta Psi'0 (Itp_AIM rho_ready theta); auto. split. intros. apply NH_SW_Presv with D psi pc theta Psi Psi' (Itp_AIM rho_ready theta) S; auto. left. apply call_sw_disable_itr with psi Psi'0 pc theta; auto. rewrite H1. unfold Itp0. unfold ext_dict. assert (beq_nat rho_ready rho_prim = false). simpl. auto. rewrite H4. unfold Minimal_D in H0. InvertAll. rewrite H5. apply Itp_AIM_Mono_CT. Qed. coq/SCAP/SCAP.v0000644000107400000620000002152011000223235012504 0ustar shaosystems(* This is the SCAP which assumes interrupt is disabled *) Add LoadPath "..". Add LoadPath "../CAP0". Require Import Coqlib. Require Import Map. Require Import MultiMapT. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import CAP0. Require Import Link. Module SCAPSpec <: ONE_TYPE. Definition B := Spec. End SCAPSpec. (* psi : PSpec *) Module SPSpec := MultiMap SCAPSpec. Definition SCAP_PSpec := SPSpec.map. Definition SCAP_emptCT := SPSpec.emp_map. Definition SCAP_consCT : flab -> Spec -> SCAP_PSpec -> SCAP_PSpec := fun f theta psi => SPSpec.merge (SPSpec.sig_map f theta) psi. Definition SCAP_lookupCT : SCAP_PSpec -> flab -> Spec -> Prop := fun psi f s => SPSpec.lookup psi f s. Definition Ret_Addr (ra : PC) (S : State) : Prop := forall pc, nextPC (comms _retw) (S_Mem S) (S_RF S) (S_Flag S) pc ra. Definition NextS_Ret (S S' : State) : Prop := forall pc, nextS pc (comms _retw) S S'. Definition fun_frame : Grt := fun (S S' : State) => (S_RF S SP = S_RF S' SP) /\ exists ra, Ret_Addr ra S /\ Ret_Addr ra S'. Definition sp_call_pred (p : Pred) (pc f: flab) : Pred := p |> (nextS pc (comml (_call f))). Definition wrap_fun (g : Grt) (pc f pc': flab) : Grt := (nextS pc (comml (_call f))) oo g oo (nextS pc' (comms _retw)). Definition ZF_st : Pred := fun (S : State) => S_Flag S _ZF = true. Definition ZF_cl : Pred := fun (S : State) => S_Flag S _ZF = false. Definition conjP (p p' : Pred) : Pred := fun (S : State) => p S /\ p' S. Definition SCAP_WFcmd (psi : SCAP_PSpec) (pc : flab) (theta : Spec) (c : comm) : Prop := match theta with Ast p g tag => match c with comms si => match si with | _iret => False | _retw => forall S, p S -> g S S | _jmp f => exists p', exists g', SCAP_lookupCT psi f (Ast p' g' tag) /\ pimp p p' /\ gimp (p >o g') g end | comml i => match i with | _cli => False | _sti => False | _outb_eoi => False | _call f => exists p', exists p'', exists g', exists g'', SCAP_lookupCT psi f (Ast p' g' tag) /\ SCAP_lookupCT psi (pc+1) (Ast p'' g'' tag) /\ enable p (nextS pc (comml (_call f))) /\ gimp ((sp_call_pred p pc f) >o g') fun_frame /\ pimp (p |> (nextS pc (comml (_call f)))) p' /\ (forall pc', pimp (p |> (wrap_fun g' pc f pc')) p'') /\ (forall pc', gimp (p >o (wrap_fun g' pc f pc') oo g'') g) | _jne f => exists p', exists p'', exists g', exists g'', SCAP_lookupCT psi f (Ast p' g' tag) /\ SCAP_lookupCT psi (pc+1) (Ast p'' g'' tag) /\ pimp (conjP p ZF_cl) p' /\ gimp (p >o (ZF_cl >o g')) g /\ pimp (conjP p ZF_st) p'' /\ gimp (p >o (ZF_st >o g'')) g | _pushfw => False | _popfw => False | _ => exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ enable p (nextS pc c) /\ pimp (p |> (nextS pc c)) p' /\ gimp (p >o (nextS pc c) oo g') g end end end. Inductive SCAP_WFiseq : SCAP_PSpec -> flab -> Spec -> iseq -> Prop := scap_isq_seq : forall psi pc p p' g g' i isq tag, SCAP_WFcmd (SCAP_consCT (pc+1) (Ast p' g' tag) psi) pc (Ast p g tag) (comml i) -> SCAP_WFiseq psi (pc+1) (Ast p' g' tag) isq -> SCAP_WFiseq psi pc (Ast p g tag) (seq i isq) | scap_isq_end : forall psi pc p g si tag, SCAP_WFcmd psi pc (Ast p g tag) (comms si) -> SCAP_WFiseq psi pc (Ast p g tag) (sseq si). Definition SCAP_WFcdhp (psi : SCAP_PSpec) (C: CodeHeap) (psi' : SCAP_PSpec): Prop := forall f theta, SCAP_lookupCT psi' f theta -> exists isq, lookupC C f isq /\ SCAP_WFiseq psi f theta isq. (* scap_lift_g is necessary to link with code handling interrupts *) (* changed by Xinyu on Dec. 15, 2007 *) Definition scap_lift_g (g : Grt) := fun (S S' : State) => g S S' /\ (S_ISR S = S_ISR S') /\ (S_Flag S _IF = S_Flag S' _IF). Fixpoint WFST (D : LDict) (rho : LangID) (n : nat) (Psi : PSpec) (p : Pred) {struct n} : Prop := match n with 0 => forall S, p S -> exists ra, Ret_Addr ra S /\ exists theta0 : Spec0, lookupCT Psi ra theta0 /\ forall pc' S', nextS pc' (comms _retw) S S' -> Itp0 D theta0 Psi S' | S n' => forall S, p S -> exists ra, Ret_Addr ra S /\ exists p', exists g', exists tag, lookupCT Psi ra (packS0 rho (Ast p' g' tag)) /\ forall pc' S', nextS pc' (comms _retw) S S' -> p' S' /\ WFST D rho n' Psi ((scap_lift_g g') S') end. Definition Generic_Itp (D : LDict) (rho : LangID) : ITP := fun (theta : Spec) (Psi : PSpec) (S : State) => match theta with Ast p g tag => p S /\ S_Flag S _IF = false /\ exists n, WFST D rho n Psi ((scap_lift_g g) S) end. Definition lift_psi (psi : SCAP_PSpec) (rho : LangID) (Psi : PSpec) : Prop := forall f theta, SCAP_lookupCT psi f theta -> lookupCT Psi f (packS0 rho theta). Definition sink_psi (psi : SCAP_PSpec) (rho : LangID) (Psi : PSpec) : Prop := forall f theta0, lookupCT Psi f theta0 -> exists theta : Spec, theta0 = (packS0 rho theta) /\ SCAP_lookupCT psi f theta. Lemma enable_elim : forall S p g, enable p g -> p S -> exists S', g S S'. Proof. intros S p g Hen Hp. unfold enable in Hen. auto. Qed. Implicit Arguments enable_elim [S p g]. Lemma linkPG_intro : forall (p : Pred) (g : Grt) (S S' : State), p S -> g S S' -> linkPG p g S'. Proof. intros. unfold linkPG. exists S; split; trivial. Qed. Implicit Arguments linkPG_intro [p g S S']. Lemma conjG_intro : forall (g g' : Grt) S'' S S', g S S'' -> g' S'' S' -> conjG g g' S S'. Proof. unfold conjG. intros. exists S''; split; trivial. Qed. Implicit Arguments conjG_intro [g g' S'' S S']. Lemma conjP_intro : forall (p p' : Pred) S, p S -> p' S -> conjP p p' S. Proof. intros; split; trivial. Qed. Lemma conjPG_intro : forall (p : Pred) (g :Grt) S S', p S -> g S S' -> conjPG p g S S'. Proof. intros p g S S' Hp Hg; unfold conjPG; split; trivial. Qed. Implicit Arguments conjPG_intro [p g S S']. Lemma ra_after_call : forall pc ra f S S', Ret_Addr ra S' -> nextS pc (comml (_call f)) S S' -> ra = pc + 1. Proof. intros pc ra f S S'. intros Hra HnextS. inversion HnextS. subst pc0 f0. substH Hra with (Hra (pc+1)). inversion Hra. subst M0 R0 fl0 pc0 pc'. subst S S' sp. simpl in * . inversion H1. destruct H2. subst R'. unfold MemUpd16 in H2. destruct H2. subst M'. unfold leadsToW in H0. destruct H0. destruct H0. destruct H0. destruct H2. clear Hra. clear HnextS. clear H1 H3. unfold ptoW in H2. unfold mstar, pto,ptox,MemMod.disjUnion, MemMod.put in * . destruct H2 as [M1 [M2 [H3 [H4 H5]]]]. destruct H3. unfold MemMod.sgltonM, MemMod.maps_to in H4. destruct H4. subst x0. destruct H0. unfold RF_update in * . unfold beq_reg in * . assert (Heq := MemMod.eq_get (R SP - 2) H2). simpl in Heq. unfold MemMod.beq_A in Heq. unfold MemSpec.beq_Domain in Heq. destruct (eq_nat_dec (R SP - 2) (R SP - 2 + 1)). rewrite plus_comm in e. simpl in e. destruct (n_Sn (R SP -2) e). destruct (eq_nat_dec (R SP - 2) (R SP - 2)). unfold MemMod.merge in Heq. rewrite H3 in Heq. injection Heq;intro;subst; trivial. destruct (n0 (refl_equal (R SP - 2))). Qed. Implicit Arguments ra_after_call [pc ra f]. Lemma lift_psi_cons : forall psi Psi rho f spec, lift_psi psi rho Psi -> lift_psi (SCAP_consCT f spec psi) rho (consCT f (packS0 rho spec) Psi). Proof. unfold lift_psi; intros. inversion H0. injection H1; intros; subst; clear H1. compute. left; trivial. unfold lookupCT, consCT. apply OPSpec.lookup_merge_intro. right. apply H; trivial. Qed. Implicit Arguments lift_psi_cons [psi Psi rho f spec]. Lemma psi_cons_a_lookup_a: forall psi f theta, SCAP_lookupCT (SCAP_consCT f theta psi) f theta. Proof. intros. unfold SCAP_lookupCT. unfold SCAP_consCT. unfold SPSpec.lookup. simpl. left. auto. Qed. Hint Resolve psi_cons_a_lookup_a. Lemma psi_cons_b_lookup_a: forall psi f theta f' theta', SCAP_lookupCT psi f theta -> SCAP_lookupCT (SCAP_consCT f' theta' psi) f theta. Proof. unfold SCAP_lookupCT. unfold SCAP_consCT. unfold SPSpec.lookup. intros. simpl. right; trivial. Qed. Hint Resolve psi_cons_b_lookup_a. coq/SCAP/QLemmas.v0000644000107400000620000003103611000223235013320 0ustar shaosystems(* -----------by wangwei *) Add LoadPath "..". Require Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas3. Require Import Assertion_Lemmas4. Require Import Operational_Semantics. Require Import Mem_Lemmas. Require Import QLib. Lemma Queue_tail0_head0 : forall Node inMemNode head prev next Q M, Queue Node inMemNode head 0 prev next Q M -> head = 0. Proof. intros Node inMemNode head prev next Q M HQ. inversion HQ. reflexivity. inversion H0. inversion H3. Qed. Implicit Arguments Queue_tail0_head0 [Node inMemNode head prev next Q M]. Lemma Queue_tail0_head0_1 : forall Node inMemNode head prev next Q M A, M ||- (Queue Node inMemNode head 0 prev next Q) *^* A -> head = 0. Proof. intros Node inMemNode head prev next Q M A HQM. destruct HQM as [M1 [M2 [HdisjU [HQ HA]]]]. eapply Queue_tail0_head0; eauto. Qed. Implicit Arguments Queue_tail0_head0_1 [Node inMemNode head prev next Q M A]. Lemma Queue_head0_tail0_pre : forall Node inMemNode head tail prev next Q M, Queue Node inMemNode head tail prev next Q M -> head = 0 -> tail = 0. Proof. intros. induction H. reflexivity. auto. rewrite (IHQueue H0) in *. inversion H3. Qed. Lemma Queue_head0_tail0: forall Node inMemNode tail prev next Q M, Queue Node inMemNode 0 tail prev next Q M -> tail = 0. Proof. intros Node inMemNode tail prev next Q M HQ. eapply Queue_head0_tail0_pre; eauto. Qed. Implicit Arguments Queue_head0_tail0 [tail prev next Q M]. Lemma Queue_head0_tail0_1: forall Node inMemNode tail prev next Q M A, M ||- (Queue Node inMemNode 0 tail prev next Q) *^* A -> tail = 0. Proof. intros Node inMemNode tail prev next Q M A HM. destruct HM as [M1 [M2 [HdisjU [HQ HA]]]]. eapply Queue_head0_tail0;eauto. Qed. Implicit Arguments Queue_head0_tail0_1 [Node inMemNode tail prev next Q M A]. Lemma Queue_ptr0_emp: forall Node inMemNode prev next Q M, Queue Node inMemNode 0 0 prev next Q M -> M = MemMod.emp /\ Q = (fun l:nat => None(A:=Node)). Proof. intros Node inMemNode prev next Q M HQ. inversion HQ; subst. intuition. inversion H0. inversion H3. Qed. Implicit Arguments Queue_ptr0_emp [Node inMemNode prev next Q M]. Lemma Queue_ptr0_emp_1: forall Node inMemNode prev next Q M A, M ||- (Queue Node inMemNode 0 0 prev next Q) *^* A -> M ||- A /\ Q = (fun l:nat => None(A:=Node)). Proof. intros Node inMemNode prev next Q M A HM. destruct HM as [M1 [M2 [Hdis [HQ HA]]]]. destruct (Queue_ptr0_emp HQ). subst M1. substH Hdis with (MemMod.disjUnion_commut Hdis). substH Hdis with (MemMod.emp_disjUnion_unique Hdis). subst M2. intuition. Qed. Implicit Arguments Queue_ptr0_emp_1 [Node inMemNode prev next Q M A]. Lemma difMem_label_unequal: forall Node inMemNode l1 l2 prev1 prev2 next1 next2 tcb1 tcb2 M1 M2, ptoNode Node inMemNode l1 prev1 next1 tcb1 M1 -> ptoNode Node inMemNode l2 prev2 next2 tcb2 M2 -> MemMod.disjoint M1 M2 -> l1 <>l2. Proof. intros. unfold ptoNode in * . unfold ptoW in *. sep on. sep lift 0 in H0; sep lift 0 in H. sep off. destruct H as [M11 [M12 [P11 [P12 P13]]]]. destruct H0 as [M21 [M22 [P21 [P22 P23]]]]. destruct P22; destruct P12. intro e. unfold MemMod.maps_to in * . assert (MemMod.disjoint M11 M21). disjoint lift_lr. unfold MemMod.disjoint in * . unfold MemMod.not_in_dom in * . subst l1. substH H4 with (H4 l2). destruct H4. rewrite H4 in H2; inversion H2. rewrite H4 in H; inversion H. Qed. Implicit Arguments difMem_label_unequal [Node inMemNode l1 l2 prev1 prev2 next1 next2 tcb1 tcb2 M1 M2]. Lemma Queue_unemp_get : forall Node inMemNode head tail prev next Q M, M ||- Queue Node inMemNode head tail prev next Q -> head > 0 -> (exists Q', exists tcb, exists next', exists next'', exists tail', M ||- (ptoNode Node inMemNode head prev next' tcb *^* Queue Node inMemNode next'' tail' head next Q' ) /\ Q = (fun l' => if eq_nat_dec head l' then Some tcb else Q' l')/\ Q' head = None (A := Node)/\ (tail' = tail /\ tail' > 0 /\ next'' = next' \/ tail' = 0/\ tail = head /\ next'' = 0 /\ next' = next)). Proof. intros Node inMemNode head tail prev next Q M. intros HQ Hhead. assert (Htail : tail > 0). destruct tail. rewrite (Queue_tail0_head0 HQ) in Hhead. inversion Hhead. omega. clear Hhead. induction HQ. (* empty queue *) inversion Htail. (* singlton queue *) exists (fun l :nat => None (A := Node)); exists node; exists next; exists 0; exists 0. intuition. exists M;exists MemMod.emp. intuition. apply Q_emp. (* nodes' number >= 2 *) substH IHHQ with (IHHQ H1). clear H1 H2 HQ. destruct IHHQ as [Q' [tcb [next1 [next2 [tail' [HM1 [HQQ' [HQ'head Hdis]]]]]]]]. destruct Hdis as [[Ht't [Ht' Hnext21]] | [Ht'0 [Hth [Hnext2 Hnext1]]]]. (* nodes' number > 2*) subst next2. exists (fun l' => if eq_nat_dec l l' then Some node else Q' l'); exists tcb; exists next1;exists next1; exists l. destruct HM1 as [MM1 [MM2 [PP1 [PP2 PP3]]]]. assert (MemMod.disjoint MM1 M2). disjoint lift_l. assert (UnE := difMem_label_unequal PP2 H0 H1). intuition. exists MM1; exists (MemMod.merge MM2 M2). intuition. destruct PP1. apply MemMod.disjUnion_assoc_left_right. assumption. rewrite <- H3;assumption. subst tail'. apply (Q_cons_more (Node := Node) (inMemNode := inMemNode) next1 tail head Q' MM2 M2 (MemMod.merge MM2 M2) l next' node); try assumption. split. disjoint lift_l. reflexivity. apply extensionality. intro x. subst Q. destruct (eq_nat_dec l x); destruct (eq_nat_dec head x); try reflexivity. subst l head;elim UnE;reflexivity. destruct (eq_nat_dec l head). elim UnE;auto. assumption. (* nodes' number = 2 *) subst tail'. destruct HM1 as [MM1 [MM2 [PP1 [PP2 PP3]]]]. subst next2. destruct (Queue_ptr0_emp PP3). subst MM2 Q'. substH PP1 with (MemMod.emp_disjUnion_unique PP1). subst MM1. assert (HH := H). destruct HH. assert (UnE := difMem_label_unequal PP2 H0 H1). exists (fun l' :nat => if eq_nat_dec l l' then Some node else None); exists tcb; exists l; exists l; exists l. intuition. exists M1; exists M2. subst next1 Q tail. intuition. apply (Q_cons_fst (Node:=Node) (inMemNode:=inMemNode) l head next' node M2); assumption. apply extensionality. intro x. subst Q. destruct (eq_nat_dec l x); destruct (eq_nat_dec head x); try reflexivity. rewrite e in UnE; rewrite e0 in UnE;elim UnE; reflexivity. destruct (eq_nat_dec l head). elim UnE;auto. reflexivity. Qed. Implicit Arguments Queue_unemp_get [Node inMemNode head tail prev next Q M]. Lemma Queue_unemp_get_1 : forall Node inMemNode head tail prev next Q M A, M ||- (Queue Node inMemNode head tail prev next Q ) *^* A -> head > 0 -> (exists Q', exists tcb, exists next', exists next'', exists tail', M ||- (ptoNode Node inMemNode head prev next' tcb *^* Queue Node inMemNode next'' tail' head next Q' ) *^* A /\ Q = (fun l' => if eq_nat_dec head l' then Some tcb else Q' l')/\ Q' head = None (A := Node)/\ (tail' = tail /\ tail' > 0 /\ next'' = next' \/ tail' = 0/\ tail = head /\ next'' = 0 /\ next' = next)). Proof. intros Node inMemNode head tail prev next Q M A. intros HM Hhead. destruct HM as [M00 [M11 [HdisjU [HQ HA]]]]. substH HQ with (Queue_unemp_get HQ Hhead). destruct HQ as [Q' [tcb [next' [next'' [tail' [HM00 [HQQ' [HQ'h Htail']]]]]]]]. exists Q'; exists tcb; exists next'; exists next''; exists tail'. split. exists M00; exists M11. intuition. intuition. Qed. Implicit Arguments Queue_unemp_get_1 [Node inMemNode head tail prev next Q M A]. Lemma Queue_emp_intro_1 : forall Node inMemNode prev next M A, M ||- A -> M ||- Queue Node inMemNode 0 0 prev next (fun l => None) *^* A. Proof. intros. exists MemMod.emp; exists M. intuition. apply Q_emp. Qed. Implicit Arguments Queue_emp_intro_1 [Node inMemNode prev next M A]. Lemma Queue_cons_fst_intro_1 : forall Node inMemNode l prev next node M A, M ||- (ptoNode Node inMemNode l prev next node) *^* A -> l > 0 -> M ||- Queue Node inMemNode l l prev next (fun l' => if eq_nat_dec l l' then Some node else None) *^* A. Proof. intros. destruct H as [M1 [M2 [Hdis [Hpto HA]]]]. exists M1; exists M2. intuition. apply (Q_cons_fst (Node:=Node) (inMemNode:=inMemNode) l prev next node M1); assumption. Qed. Lemma Queue_cons_more_intro_1 : forall Node inMemNode head tail prev Q M l next' node A, M ||- (Queue Node inMemNode head tail prev l Q) *^* (ptoNode Node inMemNode l tail next' node) *^* A -> tail > 0 -> l > 0 -> M ||- Queue Node inMemNode head l prev next' (fun l' => if eq_nat_dec l l' then Some node else Q l') *^* A. Proof. intros. destruct H as [M0 [MA [Hdis1 [HM0 HA]]]]. destruct HM0 as [M1 [M2 [Hdis2 [HM1 HM2]]]]. exists M0; exists MA. intuition. apply (Q_cons_more (Node:=Node) (inMemNode:=inMemNode) head tail prev Q M1 M2 M0 l next' node ); assumption. Qed. Lemma Queue_unemp_split : forall Node inMemNode head tail prev next Q M, M ||- Queue Node inMemNode head tail prev next Q -> tail > 0 -> (exists Q', exists tcb, exists prev', exists head', exists tail', M ||- (ptoNode Node inMemNode tail prev' next tcb *^* Queue Node inMemNode head' tail' prev tail Q' ) /\ Q = (fun l' => if eq_nat_dec tail l' then Some tcb else Q' l')/\ (head' = head /\ head' > 0 /\ prev' = tail' \/ head' = 0/\ tail = head /\ prev' = prev)). Proof. intros. inversion H; subst. inversion H0. exists (fun l : nat => None (A:= Node)); exists node; exists prev; exists 0; exists 0. intuition. sep lift 1. apply Queue_emp_intro_1;assumption. exists Q0; exists node; exists tail0; exists head; exists tail0. intuition. sep lift 1. exists M1; exists M2. intuition. left. intuition. destruct head. sep on. assert (tail0 = 0). eapply Queue_head0_tail0; eauto. rewrite H6 in H4;inversion H4. omega. Qed. Implicit Arguments Queue_unemp_split [Node inMemNode head tail prev next Q M]. Lemma Queue_unemp_split_1 : forall Node inMemNode head tail prev next Q M A, M ||- Queue Node inMemNode head tail prev next Q *^* A -> tail > 0 -> (exists Q', exists tcb, exists prev', exists head', exists tail', M ||- (ptoNode Node inMemNode tail prev' next tcb *^* Queue Node inMemNode head' tail' prev tail Q' ) *^* A /\ Q = (fun l' => if eq_nat_dec tail l' then Some tcb else Q' l')/\ (head' = head /\ head' > 0 /\ prev' = tail' \/ head' = 0/\ tail = head /\ prev' = prev)). Proof. intros. destruct H as [M1 [M2 [Hdis [HM HA]]]]. substH HM with (Queue_unemp_split HM H0). destruct HM as [Q' [tcb [prev' [head' [tail' [P1 [P2 P3]]]]]]]. exists Q'; exists tcb; exists prev'; exists head'; exists tail'. split. exists M1; exists M2. intuition. intuition. Qed. Implicit Arguments Queue_unemp_split_1 [Node inMemNode head tail prev next Q M A]. Lemma Queue_upd_next_1 : forall Node inMemNode head tail prev next next' jk Q M A, M ||- Queue Node inMemNode head tail prev next Q *^* A -> tail > 0 -> MemMod.put (MemMod.put M (tail + 2) next') (tail + 2 + 1) jk ||- Queue Node inMemNode head tail prev next' Q *^* A. Proof. intros. substH H with (Queue_unemp_split_1 H H0). destruct H as [Q' [tcb [prev' [head' [tail' [HM [HQQ' Hsplit]]]]]]]. destruct Hsplit as [[Hhead' [Hht Hprev']]| [Hhead' [Hht Hprev']]]. subst head' prev' Q. assert (Htail' : tail' > 0). destruct tail'. sep lift 1 in HM. substH HM with (Queue_tail0_head0_1 HM). rewrite HM in Hht; inversion Hht. omega. apply Queue_cons_more_intro_1 with tail'. unfold ptoNode in * . assert (MemUpdW M (tail + 2) next' jk ||- Queue Node inMemNode head tail' prev tail Q' *^* (tail |->w tail' *^* tail + 2 |->w next' *^* inMemNode (tail + 4) tcb) *^* A). sep lift 2. sep upd. sep matchH HM with 10. auto. assumption. assumption. subst head' tail prev'. sep lift 1 in HM. assert (Htail' := Queue_head0_tail0_1 HM). subst tail' Q. destruct ( Queue_ptr0_emp_1 HM). subst Q'. apply Queue_cons_fst_intro_1. unfold ptoNode in * . assert (MemUpdW M (head + 2) next' jk ||- head |->w prev *^* head + 2 |->w next' *^* inMemNode (head + 4) tcb *^* A). sep lift 1. sep upd. sep matchH H with 10. auto. assumption. Qed. Implicit Arguments Queue_upd_next_1 [Node inMemNode head tail prev next Q M A]. coq/SCAP/SCAP_Itr_Soundness.v0000644000107400000620000013355111000223235015373 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_Itr. Require Import EqNat. Require Import Linking. Require Import Linking_Lemmas. Require Import Linking_Lemmas2. Require Import IH_SW. Require Import SCAP_Itr_Lemmas. Lemma IH_lookupCT_SCAP_CAP0 : forall Psi Psi' psi f p g tag, SCAP_lookupCT psi f (Ast p g tag) -> lift_psi psi rho_ih Psi -> subsetCT (ext_Prim_Specs Psi) Psi' -> lookupCT Psi' f (packS0 rho_ih (Ast p g tag)). Proof. intros Psi Psi' psi f p g tag Hpsi Hlift Hsub. apply Hsub. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with Psi. apply Hlift; trivial. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. Qed. Hint Local Resolve IH_lookupCT_SCAP_CAP0. Lemma IH_WFworld_IF_disable : forall Psi S T B RdyQ tid theta, WF_AIM_World Psi S T B RdyQ tid rho_ih theta -> S_Flag S _IF = false. Proof. intros. unfold WF_AIM_World in H. destruct H as [H0 [H1 [H2 [H3 [TM [Mcth [Hsplit [Hmto [Hcth Hq]]]]]]]]]. unfold WF_Curr_Thrd in Hcth. simpl in Hcth. unfold itp_IH_theta in Hcth. destruct S as [[[M R]fl]isr]. simplS in Hcth. destruct Hcth as [tcb [status Hcth]]. InvertAll. simplS; trivial. Qed. Implicit Arguments IH_WFworld_IF_disable [Psi S T B RdyQ tid theta]. Lemma SCAP_IH_in_CAP0_call : forall D psi pc theta f D' Psi Psi', IH_WFcmd psi pc theta (comml (_call f)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_call f)). Proof. intros D psi pc [p g tag] f D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. destruct ((fun x => Hi) 0) as [[Hf Hi'] | [Hf Hi']]. (* prim_entry f *) unfold IH_Call_SW in Hi'. destruct Hi' as [Hfeq Hi']; subst f. (* f = _SWITCH *) eapply IH_SW_Itp; eauto. (* ~ prim_entry f *) clear Hi; rename Hi' into Hi. unfold NH_Normal_Call in Hi. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [p'' [g' [g'' [Hslk' [Hslk'' Hi]]]]]]. destruct Hi as [Hcall [Hfun [Hpp' [Hpg'p'' Hg''g]]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_call_prog Hcall Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. subst R' fl' isr'. assert (HnextPC' := nextPC_call pc f M R fl). assert (Heq := nextPC_injection HnextPC HnextPC'). subst pc'. clear HnextPC'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' 1)). split_l by eauto. unfold ext_dict. simpl. unfold Itp_AIM. rewrite minimalD_elim_ih; trivial. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear Hf B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. exists tcb; exists status; split_l; split_l. eapply IH_nonprim_call_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_jne : forall D psi pc theta f D' Psi Psi', IH_WFcmd psi pc theta (comml (_jne f)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_jne f)). Proof. intros D psi pc [p g tag] f D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [p'' [g' [g'' [Hlookup' [Hlookup'' Hi]]]]]]. destruct Hi as [Hpp' [Hg'g [Hpp'' Hg''g]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_jne_prog (f:=f) (pc:=pc) Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr']]]. subst M' R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. inversion HnextPC. (* non-jmp *) subst f0 M0 R0 fl0 pc0 pc'. simplS in H0. rename H0 into Hflzf. exists (packS0 rho_ih (Ast p'' g'' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl; simplS in * . exists tcb; exists status; split_l; split_l. eapply IH_jne_seq_prev; eauto. simplS; trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). (* jmp *) subst f0 M0 R0 fl0 pc0 pc'. simplS in H0. rename H0 into Hflzf. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists status; split_l; split_l. simpl; simplS. eapply IH_jne_jmp_prev; eauto. simplS; trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_movwp : forall D psi pc theta D' Psi Psi' o r, IH_WFcmd psi pc theta (comml (_movwp o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_movwp o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. destruct Hi as [p' [g' [Hlookup' [Hmovwp Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_movwp_prog Hmovwp Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists status; split_l; split_l. simpl. eapply IH_movwp_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_movwld : forall D psi pc theta D' Psi Psi' a r, IH_WFcmd psi pc theta (comml (_movwld a r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_movwld a r)). Proof. intros D psi pc [p g tag] D' Psi Psi' a r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hmovwp Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_movwld_prog Hmovwp Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). destruct HR as [x [Hlds HR']]. subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. exists tcb; exists status; split_l; split_l. eapply IH_movwld_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_movwst : forall D psi pc theta D' Psi Psi' o a, IH_WFcmd psi pc theta (comml (_movwst o a)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_movwst o a)). Proof. intros D psi pc [p g tag] D' Psi Psi' a r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hmovwst Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_movwst_prog Hmovwst Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. exists tcb; exists status; split_l; split_l. eapply IH_movwst_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_pushwp : forall D psi pc theta D' Psi Psi' o, IH_WFcmd psi pc theta (comml (_pushwp o)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_pushwp o)). Proof. intros D psi pc [p g tag] D' Psi Psi' o. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_pushwp_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists status; split_l; split_l. simpl. eapply IH_pushwp_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_pushwm : forall D psi pc theta D' Psi Psi' a, IH_WFcmd psi pc theta (comml (_pushwm a)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_pushwm a)). Proof. intros D psi pc [p g tag] D' Psi Psi' a. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_pushwm_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists status; split_l; split_l. simpl. eapply IH_pushwm_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_popw : forall D psi pc theta D' Psi Psi' r, IH_WFcmd psi pc theta (comml (_popw r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_popw r)). Proof. intros D psi pc [p g tag] D' Psi Psi' r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_popw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). destruct HR as [x [Hlds HR']]. subst R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists status; split_l; split_l. simpl. eapply IH_popw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_cmpw : forall D psi pc theta D' Psi Psi' o r, IH_WFcmd psi pc theta (comml (_cmpw o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_cmpw o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_cmpw_prog (o:=o) (r:=r) (pc:=pc) Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. exists tcb; exists status; split_l; split_l. simpl. eapply IH_cmpw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_addw : forall D psi pc theta D' Psi Psi' o r, IH_WFcmd psi pc theta (comml (_addw o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_addw o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_addw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. exists tcb; exists status; split_l; split_l. eapply IH_addw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_subw : forall D psi pc theta D' Psi Psi' o r, IH_WFcmd psi pc theta (comml (_subw o r)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_subw o r)). Proof. intros D psi pc [p g tag] D' Psi Psi' o r. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_subw_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. exists tcb; exists status; split_l; split_l. eapply IH_subw_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_eoi : forall D psi pc theta D' Psi Psi', IH_WFcmd psi pc theta (comml (_outb_eoi)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comml (_outb_eoi)). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [p' [g' [Hlookup' [Hen Hi]]]]. destruct Hi as [Hpp' Hg'g]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_eoi_prog Hen Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). destruct HR as [HR HR']. subst M' R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. exists tcb; exists status; split_l; split_l. eapply IH_eoi_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_jmp : forall D psi pc theta D' Psi Psi' f, IH_WFcmd psi pc theta (comms (_jmp f)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comms (_jmp f)). Proof. intros D psi pc [p g tag] D' Psi Psi' f. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. destruct Hi as [p' [g' [Hlk' [Hpp' Hg'g]]]]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. split. exists (M, R, fl, isr); constructor; trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr]]]. rewrite (nextPC_inversion HnextPC). subst R' fl' isr'. assert (HnextScth : nextS pc (comms (_jmp f)) (Mcth, R, fl, isr) (Mcth, R, fl, isr)). constructor; trivial. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear HnextScth. exists (packS0 rho_ih (Ast p' g' tag)). split_l by eauto. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. unfold pmstar. unfold WF_AIM_World. simplS. destruct HM. simplS in * . exists Mth'; exists Mq; split_l; split_r. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. simplS. split. clear B RdyQ H1 H2 H3 H4 H5 H6 H8 H9 HtoMcth' HTM' HMq. clear Mq Mth TM TM' HnextPC HnextS HJM HJM' HsplitTM'. unfold WF_Curr_Thrd. simpl. exists tcb; exists status; split_l; split_l. eapply IH_jmp_prev; eauto. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_retw : forall D psi pc theta D' Psi Psi', IH_WFcmd psi pc theta (comms _retw) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comms _retw). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [Htag Hp]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_retw_prog (pc:=pc) Htag Hp Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R']fl']isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr']]]. destruct HR as [pc'x [Hlds HR]]. subst M' R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (pc' = pc'x). eapply leadsToW_unique; eauto. simplS in * ; subst; trivial. inversion_clear HnextPC. subst; trivial. subst pc'x. assert (HnextPC' : nextPC (comms _retw) Mcth R fl pc pc'). inversion_clear HnextPC. destruct (nextS_inversion HnextS') as [_ [HR [_ _]]]. destruct HR as [pc'x [Hlds' HR']]. assert (Heq : pc' = pc'x). eapply leadsToW_unique; eauto. destruct (MemSplit_Inv H5 H6) as [Moth [Hx _]]. simplS in * . apply (leadsToW_Mono (addr := sp)(x := pc'x) HJM); eauto. eapply leadsToW_Mono; eauto. subst; trivial. subst pc'x. apply nextPC_retw with (R SP); trivial. destruct (IH_retw_prev Htag HnextPC' HnextS' Hp Hwfcth) as [theta' [Hlk' Hwf]]. exists (packS0 rho_ih theta'); split_l. unfold ext_dict. simpl. rewrite minimalD_elim_ih; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. exists Mth'; exists Mq; split_l. split_r. unfold WF_AIM_World. split_l; split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear B RdyQ HtoMcth' HTM' H1 H2 H3 H4 H5 H6 H8 H9 HMq. clear Mq Mth TM HnextS HJM HJM'. unfold WF_Curr_Thrd. exists tcb; exists status; split_l; split_l. simpl; simplS. trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_iret : forall D psi pc theta D' Psi Psi', IH_WFcmd psi pc theta (comms _iret) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc (comms _iret). Proof. intros D psi pc [p g tag] D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. subst D' Psi'. unfold WFcmd, WFcmd_aux. unfold ext_dict; simpl. rewrite minimalD_elim_ih; trivial. split_r with Itp_AIM_Mono_CT. intros Psi' [[[M R] fl] isr] HItp Hsub. unfold Itp_AIM in HItp. destruct HItp as [T [B [RdyQ [tid HItp]]]]. unfold pmstar in HItp. destruct HItp as [Mth [Mq [HJM [Hwf HMq]]]]. apply and_sym_rr. split. left. intros [Hx Hy]. assert (H := IH_WFworld_IF_disable Hwf). simplS in * . rewrite Hx in H; discriminate. simpl in Hi. destruct Hi as [Htag Hp]. unfold WF_AIM_World in Hwf. destruct Hwf as [H1 [H2 [H3 [H4 [TM [Mcth [H5 [H6 [H7 [H8 H9]]]]]]]]]]. simplS in H7. rename H7 into Hwfcth. unfold WF_Curr_Thrd in Hwfcth. simpl in Hwfcth. destruct Hwfcth as [tcb [status [Hmto [Hst Hwfcth]]]]. destruct (IH_iret_prog (pc:=pc) Htag Hp Hwfcth) as [Scth' HnextScth]. split. destruct Scth' as [[[Mcth' R'] fl'] isr']. destruct (nextS_Mono2 H5 HJM H6 HnextScth) as [M' HnextS]. exists (M', R', fl', isr'); trivial. intros pc' S' HnextS HnextPC. destruct S' as [[[M' R']fl']isr']. destruct (nextS_inversion HnextS) as [HM [HR [Hfl Hisr']]]. destruct Hfl as [flnum [Hfl' Hlds]]. destruct HM as [HM' Hlds']. subst M' R' fl' isr'. destruct (nextS_DMono2 H6 H5 HJM HnextScth HnextS) as [Mcth' [Mth' [TM' [HtoMcth' [HsplitTM' [HJM' [HnextS' HTM']]]]]]]. clear Scth' HnextScth. assert (HnextPC' : nextPC (comms _iret) Mcth R fl pc pc'). inversion_clear HnextPC. destruct (nextS_inversion HnextS') as [HM [HR [_ _]]]. destruct HM as [HM' HldsB]. apply nextPC_iret with (R SP); trivial. simplS in * . subst sp. destruct (MemSplit_Inv H5 H6) as [Moth [Hx _]]. assert (Hy : MemMod.disjUnion Mcth (MemMod.merge Moth Mq) M). eapply disjUnion_assoc_lr; eauto. eapply leadsToxW_leadsToW_DMono; eauto. apply leadsToBlk_leadsToxW with 6; auto with arith. destruct (IH_iret_prev Htag HnextPC' HnextS' Hp Hwfcth) as [theta' [rho' [Hrho' [Hrtc [Hlk' Hwf]]]]]. exists (packS0 rho' theta'); split_l. unfold ext_dict. destruct Hrho'; subst rho'. simpl. rewrite minimalD_elim_Rdy; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. exists Mth'; exists Mq; split_l. split_r. unfold WF_AIM_World. split. eapply WF_CurrTID_ih_nh; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear B RdyQ HtoMcth' HTM' H1 H2 H3 H4 H5 H6 H8 H9 HMq. clear Mq Mth TM HnextS HJM HJM'. unfold WF_Curr_Thrd. simpl; simplS. trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). simpl. rewrite minimalD_elim_idle; trivial. unfold Itp_AIM. exists T; exists B; exists RdyQ; exists tid. exists Mth'; exists Mq; split_l. split_r. unfold WF_AIM_World. split. eapply WF_CurrTID_ih_nh; eauto. split_l; split_l; split_l. exists TM'; exists Mcth'; split_l. split_l. split. clear B RdyQ HtoMcth' HTM' H1 H2 H3 H4 H5 H6 H8 H9 HMq. clear Mq Mth TM HnextS HJM HJM'. unfold WF_Curr_Thrd. simpl; simplS. trivial. split. apply (WF_ReadyQ_untouch H8 HTM' H1). apply (WF_WQSet_untouch H9 HTM' H1). Qed. Lemma SCAP_IH_in_CAP0_cmd: forall D psi pc theta c D' Psi Psi', IH_WFcmd psi pc theta c -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFcmd D' Psi' (packS0 rho_ih theta) pc c. Proof. intros D psi pc [p g tag] c D' Psi Psi'. intros Hi HD HD' Hlift HPsi'. induction c as [ i | s]; [ induction i | induction s]. (* 19 goals remain, i = cli *) destruct Hi. (* 18 goals remain, i = sti *) destruct Hi. (* 17 goals remain, i = call f *) eapply SCAP_IH_in_CAP0_call; eauto. (* 16 goals remain, i = jne f *) eapply SCAP_IH_in_CAP0_jne; eauto. (* 15 goals remain, i = movwp o r *) eapply SCAP_IH_in_CAP0_movwp; eauto. (* 14 goals remain, i = movwld a r *) eapply SCAP_IH_in_CAP0_movwld; eauto. (* 13 goals remain, i = movwst o a *) eapply SCAP_IH_in_CAP0_movwst; eauto. (* 12 goals remain, i = pushwp o *) eapply SCAP_IH_in_CAP0_pushwp; eauto. (* 11 goals remain, i = pushwm a *) eapply SCAP_IH_in_CAP0_pushwm; eauto. (* 10 goals remain, i = pushfw *) destruct Hi. (* 9 goals remain, i = popw r *) eapply SCAP_IH_in_CAP0_popw; eauto. (* 8 goals remain, i = popfw *) destruct Hi. (* 7 goals remain, i = cmpw o r *) eapply SCAP_IH_in_CAP0_cmpw; eauto. (* 6 goals remain, i = addw o r *) eapply SCAP_IH_in_CAP0_addw; eauto. (* 5 goals remain, i = subw o r *) eapply SCAP_IH_in_CAP0_subw; eauto. (* 4 goals remain, i = outb eoi *) eapply SCAP_IH_in_CAP0_eoi; eauto. (* 3 goals remain, i = jmp f *) eapply SCAP_IH_in_CAP0_jmp; eauto. (* 2 goals remain, i = retw *) eapply SCAP_IH_in_CAP0_retw; eauto. (* 1 goals remain, i = iret *) eapply SCAP_IH_in_CAP0_iret; eauto. Qed. Implicit Arguments SCAP_IH_in_CAP0_cmd [D psi pc theta c D' Psi Psi']. Lemma SCAP_IH_in_CAP0_iseq: forall D psi pc theta isq D' Psi Psi', IH_WFiseq psi pc theta isq -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> Psi' = ext_Prim_Specs Psi -> WFiseq D' Psi' (packS0 rho_ih theta) pc isq. Proof. intros D psi pc theta isq D' Psi Psi'. intros Hscap HD HD' Hlift HPsi'. gen_clear theta pc Hscap HPsi'. induction isq; intros theta pc Hscap HPsi'. inversion Hscap. subst psi0 pc0 theta i0 isq0. eapply wfis_seq with (packS0 rho_ih (Ast p' g' tag)). assert (Hlift' := lift_psi_cons (f := pc+1) (spec := Ast p' g' tag) Hlift). apply WFcmd_Mono_CT with (ext_Prim_Specs (consCT (pc + 1) (packS0 rho_ih (Ast p' g' tag)) Psi)). subst Psi'. unfold ext_Prim_Specs. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. apply Psi_extend3_subsetCT; auto. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_lookupCT_consCT. apply lookupCT_consCT. assert (HPsi'2 := refl_equal (ext_Prim_Specs (consCT (pc + 1) (packS0 rho_ih (Ast p' g' tag)) Psi))). apply (SCAP_IH_in_CAP0_cmd H4 HD HD' Hlift' HPsi'2). apply IHisq; trivial. inversion Hscap. subst psi0 pc0 theta si. eapply wfis_end. apply (SCAP_IH_in_CAP0_cmd H3 HD HD' Hlift HPsi'). Qed. Lemma SCAP_IH_in_CAP0_cdhp : forall D psi C psi' D' Psi Psi' Psi'', IH_WFcdhp psi C psi' -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho_ih Psi -> lift_psi psi' rho_ih Psi' -> sink_psi psi' rho_ih Psi' -> Psi'' = ext_Prim_Specs Psi -> WFcdhp D' Psi'' C Psi'. Proof. intros D psi C psi' D' Psi Psi' Psi''. intros H HD HD' H0 H1 H2 HPsi''. intros f theta0 Hf. substH H2 with (H2 f theta0 Hf). destruct H2 as [theta [Htheta0 Hfx]]. unfold SCAP_WFcdhp in H. substH H with (H f theta Hfx). destruct H as [isq [Hisq H]]. exists isq; split_l. destruct theta0. injection Htheta0; intros; subst n s. eapply SCAP_IH_in_CAP0_iseq; eauto. Qed. coq/SCAP/NH_SW.v0000644000107400000620000014256211000223235012706 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas4. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import Reg. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import SCAP_Itr. Require Import Linking. Require Import Linking_Lemmas. Require Import Linking_Lemmas2. Require Import Linking_Lemmas3. Require Import EqNat. Require Import Omega. Require Import List. Require Import Arith_Lemmas. Lemma NH_SW_progress: forall rho psi pc theta Psi a S, rho = rho_ready \/ rho = rho_idle -> NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> a = Itp_AIM rho theta -> a Psi S -> exists S', nextS pc (comml (_call _SWITCH)) S S'. Proof. intros rho psi pc theta Psi a S Hrho. intros. unfold NH_WFcmd in H. induction theta. unfold NH_WFcmd_aux in H. inversion_clear H. inversion H2. inversion_clear H. apply NH_SW_prog_aux with psi (Ast p g n) Psi rho; auto. rewrite H0 in H1. auto. destruct Hrho; subst rho; auto. inversion_clear H. unfold prim_entry in H4. assert (_SWITCH = _SWITCH \/ _SWITCH = _BLOCK \/ _SWITCH = _UNBLK). left. auto. contradiction. Qed. Lemma enter_SW_preMem: forall rho pc S S' p g tag M1 M2 Psi T B RdyQ tid, rho = rho_ready \/ rho = rho_idle -> nextS pc (comml (_call _SWITCH)) S S' -> enable_sw p -> MemMod.disjUnion M1 M2 (S_Mem S) -> WF_AIM_World Psi (S_Mem_Upd S M1) T B RdyQ tid rho (Ast p g tag) -> (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)) M2 -> exists junk, (SW_MPre T RdyQ tid (S_RF S' SP) (pc+1) junk *^* mTrue) (S_Mem S'). Proof. intros. assert (imprec (NH_pinvstar p) (S_Mem_Upd S M1)). apply WF_AIM_World_pinv with Psi T B RdyQ tid rho g tag; auto. destruct H; subst rho; auto. assert (imprec p (S_Mem_Upd S M1)). apply imprec_presv_imprec with (NH_pinvstar p); auto. unfold SW_MPre. assert (exists M1', MemMod.disjUnion M1' M2 (S_Mem S') /\ (S_RF S' SP |->w (pc+1) *^* stkSpacePrec (S_RF S' SP) 8 *^* mTrue) M1'). apply enable_sw_nxt_stkspace with p S M1; auto. InvertAll. rename x into M1'. assert (exists junk, (S_RF S' SP |-> pc + 1 *^* S_RF S' SP + 1 |-> junk *^* stkSpacePrec (S_RF S' SP) 8 *^* mTrue) M1'). sep on. sep lift 0 in H9. assert (exists junk, M1' ||- S_RF S' SP |-> pc + 1 *^* S_RF S' SP + 1 |-> junk *^* (stkSpacePrec (S_RF S' SP) 8 *^* mTrue)). apply ptoW_elim1; auto. inversion H8. exists x. sep on. sep matchH H10 with 4. inversion_clear H8. clear H9. exists x. apply merge_SW_pre with M1' M2 B; auto. Qed. Lemma enter_SW_pre: forall rho psi pc theta Psi'0 S S', rho = rho_ready \/ rho = rho_idle -> NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Itp_AIM rho theta Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> SW_Prd S'. Proof. intros rho psi pc theta Psi'0 S S' Hrho. intros. unfold SW_Prd. induction theta. unfold Itp_AIM in H0. InvertAll. rename x into T. rename x0 into B. rename x1 into RdyQ. rename x2 into tid. exists T. exists RdyQ. exists tid. rename n into tag. unfold NH_WFcmd in H. unfold NH_WFcmd_aux in H. InvertAll. inversion_clear H2. inversion_clear H3. clear H2. unfold NH_Call_Prim in H5. inversion_clear H5. inversion H2. inversion H6. rewrite <- H12 in H8. clear H9 H10 H12 H13 H14 H5 H6 H7 tag0 p0 g0 p' g'. induction S as (((M, R), fl), isr). exists (S_RF S' SP). unfold pmstar in H0. InvertAll. rename x into M1. rename x0 into M2. assert (exists tcb, TQMod.maps_to T tid tcb). apply WF_AIM_World_currTCB with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ rho (Ast p g tag); auto. inversion_clear H6. rename x into tcb. exists tcb. exists (pc+1). split. apply enter_SW_preMem with rho (M, R, fl, isr) p g tag M1 M2 Psi'0 B; auto. split; auto. split; auto. apply WF_AIM_World_RdyQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B tid rho (Ast p g tag); auto. split; auto. split. apply WF_AIM_World_cthNotRdy with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) T B rho (Ast p g tag); auto. apply WF_AIM_World_WFTQ with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho (Ast p g tag); auto. assert (_SWITCH <> _BLOCK). auto. contradiction. assert (_SWITCH <> _UNBLK). auto. contradiction. assert (prim_entry _SWITCH). unfold prim_entry. left. auto. inversion_clear H3. contradiction. Qed. Lemma enter_SW_disable: forall rho psi pc theta Psi'0 S S', rho = rho_ready \/ rho = rho_idle -> NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Itp_AIM rho theta Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> S_Flag S' _IF = false. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). unfold NH_WFcmd in H0. induction theta. destruct H0 as [HWFcmd [Htmp1 Htmp2]]. clear Htmp1 Htmp2. unfold NH_WFcmd_aux in HWFcmd. inversion_clear HWFcmd. destruct H0 as [Hprim HWFcmd]. clear Hprim. unfold NH_Call_Prim in HWFcmd. inversion_clear HWFcmd. clear H0. assert (fl _IF = false). assert (imprec (NH_pinvstar p) (M, R, fl, isr)). apply Itp_AIM_pinv with g n Psi'0 rho. auto. inversion_clear H; subst rho; discriminate. unfold imprec in H0. unfold pmstar in H0. InvertAll. unfold NH_pinvstar in H0. simplS in H0. unfold pmstar in H0. InvertAll. simplS in H0. assert (S_Flag (x1, R, fl, isr) _IF = false). apply H3; auto. UnfoldStateAll; auto. clear H1 H3. destruct (nextS_inversion H2). InvertAll. subst fl'. UnfoldStateAll. auto. inversion_clear H0. assert (prim_entry _SWITCH). unfold prim_entry. left. auto. contradiction. Qed. Lemma S_Mem_Upd_discard_interm2 : forall S M1 M2, (S_Mem_Upd (S_Mem_Upd S M2) M1) = (S_Mem_Upd S M1). Proof. induction S as (((M, R) , fl),isr). intros. UnfoldStateAll. auto. Qed. Hint Resolve S_Mem_Upd_discard_interm2. Lemma WFcallsw_enablesw: forall psi pc p g tag, NH_WFcmd psi pc (Ast p g tag) (comml (_call _SWITCH)) -> enable_sw p. Proof. intros. unfold NH_WFcmd in H. InvertAll. unfold NH_WFcmd_aux in H0. inversion_clear H0. inversion_clear H1. inversion_clear H3. inversion H1. inversion H5. auto. assert (_SWITCH <> _BLOCK). auto. contradiction. assert (_SWITCH <> _UNBLK). auto. contradiction. assert (prim_entry _SWITCH). unfold prim_entry. left. auto. inversion H1. contradiction. Qed. Lemma call_sw_nextPC_spec: forall psi pc p g tag, NH_WFcmd psi pc (Ast p g tag) (comml (_call _SWITCH)) -> exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun gy pc _SWITCH pc') oo g') g). Proof. intros. unfold NH_WFcmd in H. inversion_clear H. unfold NH_WFcmd_aux in H0. inversion_clear H0. inversion_clear H. inversion_clear H2. inversion H. exists p'. exists g'. inversion H4. split; auto. absurd (_SWITCH <> _BLOCK); auto. absurd (_SWITCH <> _UNBLK); auto. inversion_clear H. absurd (prim_entry _SWITCH); auto. unfold prim_entry. left. auto. Qed. Hint Resolve call_sw_nextPC_spec. Lemma minimalD_containsRdy: forall D, Minimal_D D -> D rho_ready = SomeT1 _ (Itp_AIM rho_ready). Proof. intros. unfold Minimal_D in H. InvertAll. auto. Qed. Hint Resolve minimalD_containsRdy. Lemma call_sw_flags_false: forall rho p g tag psi Psi pc M M' R fl isr T tid, rho = rho_ready \/ rho = rho_idle -> WF_Curr_Thrd Psi (M, R, fl, isr) rho (Ast p g tag) T tid -> NH_WFcmd psi pc (Ast p g tag) (comml (_call _SWITCH)) -> p (M', R, fl, isr) -> (fl _IF = false) /\ (isr = false). Proof. intros rho p g tag psi Psi pc M M' R fl isr T tid Hrho. intros. unfold NH_WFcmd in H0. InvertAll. unfold NH_WFcmd_aux in H2. inversion_clear H2. inversion_clear H3. inversion_clear H5. assert (S_Flag (M', R, fl, isr) _IF = false). apply H6; auto. unfold S_Flag in H5. split; auto. unfold WF_Curr_Thrd in H. destruct Hrho; subst rho; simpl in H. unfold itp_NH_theta in H. unfold S_ISR in H. InvertAll. auto. unfold itp_NH_theta in H. unfold S_ISR in H. InvertAll. auto. InvertAll. absurd (prim_entry _SWITCH); auto. unfold prim_entry. left. auto. Qed. Lemma enter_SW_grt2_hyp2: forall T T' B RdyQ' tid tid' sp sp' tcb tcb' pc pc' S0 S' M0' M2' M22 M12 cthM2 cthM12 cthMR TM junk, SW_Post_aux T' RdyQ' tid' sp' sp tcb' pc junk (S_Mem_Upd S0 M0') -> nextS pc' (comms _retw) S0 S' -> MemMod.disjUnion M0' M2' (S_Mem S0) -> disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' -> embed_WQSet T B M22 -> MemSplit (ThrdMemMod.remove TM tid) M12 -> ThrdMemMod.maps_to TM tid' cthMR -> tid <> tid' -> NH_Inv (S_Flag S0) cthM2 -> (INV0 *^* INV1 *^* mTrue) cthM12 -> T' = TQMod.put T tid (sp, TCB_Status tcb, pc) -> exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ (INV0 *^* INV1) INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ') M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old /\ (sp |-> pc *^* sp + 1 |-> junk *^* stkSpacePrec sp 8) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S'). Proof. intros. unfold mstar at 1 in H8. InvertAll. rename x into INVM. rename x0 into cthM0. exists INVM. exists cthM0. unfold SW_Post_aux in H. InvertAll. unfold SW_MPost in H11. assert ((embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ' *^* (sp |-> pc *^* sp + 1 |-> junk *^* stkSpacePrec sp 8)) (S_Mem (S_Mem_Upd S0 M0'))). sep on. sep matchH H11 with 4. clear H11. unfold mstar at 1 in H15. InvertAll. rename x into M21'. exists M21'. rename x0 into cthM_oldStk. assert (exists M122, MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122). apply memsplit_thrd_remove; auto. unfold ThrdMemMod.maps_to. unfold ThrdMemMod.remove. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. unfold ThrdMemMod.maps_to in H5. auto. InvertAll. rename x into M122. exists M122. exists (MemMod.merge (MemMod.merge cthM0 cthM2) cthM_oldStk). exists cthM_oldStk. split; auto. split; auto. split; auto. split; auto. split; auto. split. unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_aux2_hyp0 with INVM cthM12 M22 M12 M0' M2' S0 M21'; auto. split. auto. apply enter_SW_grt2_aux2_hyp1 with pc' M0' M2' S0 M12 cthM12; auto. Qed. Lemma enter_SW_grt2_auxc_aux4: forall pc pc' M R fl isr M' R' fl' isr' cthM1 cthM11 cthM12 INVM cthM0 M0 cthM_oldStk R0 fl0 junk cthM2 cthM_old M'2, nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> MemMod.disjUnion cthM11 cthM12 cthM1 -> stkSpacePrec (R SP) (8 + 2) cthM11 -> MemMod.disjUnion INVM cthM0 cthM12 -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk *^* stkSpacePrec (R' SP) 8) cthM_oldStk -> (INV0 *^* INV1) INVM -> (INV0 *^* INV1) M0 -> MemMod.disjUnion M0 cthM_old M'2 -> MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old -> fl0 _IF = false -> fl _IF = false -> isr = false -> R0 SP = R' SP + 2 -> wrap_fun gy pc _SWITCH pc' (cthM1, R, fl, isr) (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk, R0, fl0, false). Proof. intros. unfold wrap_fun. unfold conjG. exists (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk, RF_update R0 SP (R0 SP - 2), fl0, false). split. assert (nextS pc (comml (_call _SWITCH)) (cthM1, R, fl, isr) (MemUpdW cthM1 (R SP - 2) (pc+1) junk, RF_update R SP (R SP - 2), fl, isr)). apply nextS_call. unfold pushW. split. assert ((mTrue *^* stkSpacePrec (R SP) (8 + 2)) cthM1). exists cthM12. exists cthM11. split; auto with PMap. unfold mTrue. split; auto. sep on. sep lift 1 in H12. sep stksplit 2 in H12. sep lift 0 in H12. sep trivial. split; auto. apply MemUpdW_MemUpd16 with junk; auto. set (cthM' := MemUpdW cthM1 (R SP - 2) (pc + 1) junk) in *. exists (cthM', RF_update R SP (R SP - 2), fl, isr). split; auto. assert (R SP - 2 = R' SP). apply enter_SW_grt_auxb0_hyp0 with pc M fl isr M' fl' isr' _SWITCH; auto. unfold gy. exists (R SP - 2). simplS. reg simpl. assert (R SP = R' SP + 2). rewrite <- H13. assert (R SP >= 2). apply ge_trans with (8 + 2). sep on. apply stkSpacePrec_sp_ge_sz with cthM11; auto. auto with arith. assert (R SP - 2 + 2 = R SP). auto. auto. rename H14 into HRSP'. split. unfold prepost. simplS. sep on. sep stksplit in H1. destruct H1 as [cthM11_1 [cthM11_2 [HcthM11split [HcthM11_1 HcthM11_2]]]]. exists (MemMod.merge INVM cthM11_1). exists (MemMod.merge (MemUpdW cthM11_2 (R SP - 2) (pc+1) junk) cthM0). sep lift 2 in H3. unfold mstar at 1 in H3. sep off. InvertAll. rename x into oldStk1. rename x0 into oldStk2. exists (MemMod.merge M0 oldStk1). split. exists INVM. exists cthM11_1. split; auto. split; auto. apply enter_BLK_grt2_auxc_hyp1 with cthM1 cthM11 cthM12 cthM11_2 cthM0; auto. split. exists M0. exists oldStk1. rewrite <- H13 in H3. split; auto. split; auto. apply enter_BLK_grt2_auxc_hyp2 with M'2 cthM_old (MemMod.merge cthM0 cthM2) cthM_oldStk oldStk2; auto. split. assert (MemMod.disjUnion (MemMod.merge (MemUpdW cthM11_2 (R SP - 2) (pc + 1) junk) cthM0) (MemMod.merge INVM cthM11_1) cthM'). apply enter_SW_grt2_auxc_auxx with cthM1 cthM11 cthM12; auto. auto with PMap. assert (MemUpdW cthM11_2 (R SP - 2) (pc + 1) junk = oldStk2). rewrite H13 in HcthM11_2. rewrite H13. apply enter_SW_grt2_auxc_hypx; auto. rewrite H14. apply enter_BLK_grt2_auxc_hyp4 with M'2 cthM_old cthM2; auto. rewrite <- H11 in HRSP'. rewrite <- HRSP'. split; auto. rewrite <- H8 in H9. auto. apply nextS_retw. exists (pc+1). unfold popW. reg simpl. split. rewrite H11. assert (R' SP + 2 - 2 = R' SP). auto. rewrite H12. apply enter_BLK_grt2_auxc_hyp5 with M'2 cthM_old cthM2 junk (stkSpacePrec (R' SP) 8); auto. rewrite H11. assert (R' SP + 2 - 2 = R' SP). auto. rewrite H12. rewrite <- H11. assert (RF_update R0 SP (R0 SP) = R0). apply RF_update_prev. auto. Qed. Lemma enter_SW_grt2_auxc: forall cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk M0 M'2 cthM_old R0 fl0 (p p'': Pred) M M' R' fl' isr', MemMod.disjUnion cthM1 cthM2 cthM -> p (cthM1, R, fl, isr) -> NH_Inv fl cthM2 -> MemMod.disjUnion cthM11 cthM12 cthM1 -> stkSpacePrec (R SP) (8 + 2) cthM11 -> MemMod.disjUnion INVM cthM0 cthM12 -> (INV0 *^* INV1) INVM -> MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old -> (R' SP |-> pc + 1 *^* R' SP + 1 |-> junk *^* stkSpacePrec (R' SP) 8) cthM_oldStk -> (INV0 *^* INV1) M0 -> MemMod.disjUnion M0 cthM_old M'2 -> (forall pc' : nat, pimp (p |> wrap_fun gy pc _SWITCH pc') p'') -> fl0 _IF = false -> fl _IF = false -> nextS pc (comml (_call _SWITCH)) (M, R, fl, isr) (M', R', fl', isr') -> R0 SP = R' SP + 2 -> isr = false -> NH_pinvstar p'' (S_Mem_Upd (cthM_old, R0, fl0, false) M'2). Proof. intros. unfold NH_pinvstar. unfold pmstar. exists (MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). exists cthM2. split. assert (S_Mem (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) = M'2). auto. rewrite H16. clear H16. apply enter_SW_grt2_auxc_hyp0 with cthM_old; auto. assert (MemMod.disjoint cthM12 cthM2). apply MemMod.disj_merge_disj_right with cthM11. inversion_clear H2. subst cthM1. inversion_clear H. auto. apply MemMod.disj_merge_disj_right with INVM. inversion_clear H4. subst cthM12. auto. split. simplS. unfold pimp in H10. apply H10 with 0. unfold linkPG. exists (cthM1, R, fl, isr). split; auto. apply enter_SW_grt2_auxc_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM junk cthM2 cthM_old M'2; auto. assert (S_Flag (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) = fl0). UnfoldStateAll. auto. rewrite H16. unfold NH_Inv. rewrite H11. unfold NH_Inv in H1. rewrite H12 in H1. auto. Qed. Lemma enter_SW_grt: forall rho D psi pc theta D' Psi Psi' Psi'0 S S', rho = rho_ready \/ rho = rho_idle -> NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> subsetCT Psi' Psi'0 -> Itp_AIM rho theta Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> WFST D rho_prim 0 Psi'0 (scap_lift_g SW_grt S'). Proof. intros rho D psi pc theta D' Psi Psi' Psi'0 S S' Hrho. intros. unfold WFST. intros. unfold scap_lift_g in H7. InvertAll. induction S' as (((M', R'), fl'), isr'). induction S as (((M, R), fl), isr). induction theta. rename n into tag. unfold Itp_AIM in H5. unfold pmstar in H5. InvertAll. rename x into T. rename x0 into B. rename x1 into RdyQ. rename x2 into tid. rename x3 into M1. rename x4 into M2. assert ((embed_curr_TCB T tid *^* embed_RdyQ T RdyQ *^* embed_WQSet T B) M2). apply leqvM_app_subst with (embed_curr_TCB T tid *^* (embed_RdyQ T RdyQ *^* embed_WQSet T B)); auto. apply leqvM_commut. apply mstar_assoc. unfold mstar at 1 in H11. InvertAll. rename x into M21. rename x0 into M22. clear H12. assert (exists TM, exists cthM, exists M12, exists cthM1, exists cthM2, MemMod.disjUnion M12 cthM M1 /\ MemMod.disjUnion cthM1 cthM2 cthM /\ WF_currTID tid T B RdyQ rho /\ WF_TWQ T B RdyQ /\ exists_Idle T RdyQ tid /\ WF_WQ_WQSpec B Delta /\ MemSplit (ThrdMemMod.remove TM tid) M12 /\ ThrdMemMod.maps_to TM tid cthM /\ WF_Curr_Thrd Psi'0 (S_Mem_Upd (M1, R, fl, isr) cthM) rho (Ast p g tag) T tid /\ WF_ReadyQ Psi'0 T RdyQ TM /\ WF_WQSet Psi'0 T B TM /\ p (cthM1, R, fl, isr) /\ NH_Inv fl cthM2 /\ (tag = 1 -> NH_WFST rho Psi'0 (NH_ItpG g (cthM, R, fl, isr)))). apply decompose_World; auto. InvertAll. rename x into TM. rename x0 into cthM. rename x1 into M12. rename x2 into cthM1. rename x3 into cthM2. assert (WQMod.not_in_dom tid RdyQ). unfold WF_currTID in H16. InvertAll. auto. assert (exists M1, exists M2, MemMod.disjUnion M1 M2 (S_Mem (cthM1, R, fl, isr)) /\ stkSpacePrec (S_RF (cthM1, R, fl, isr) SP) (8 + 2) M1 /\ ((INV0 *^*INV1) *^* mTrue) M2). apply enable_sw_stkspace with p; auto. apply WFcallsw_enablesw with psi pc g tag; auto. InvertAll. rename x into cthM11. rename x0 into cthM12. unfold S_Mem in H30. unfold S_RF in H29. assert (disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: cthM11 :: nil) M). apply mem_list_compose_a with cthM1 cthM M1; auto. assert (exists junk, (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk *^* (stkSpacePrec (R' SP) 8)) (MemUpdW cthM11 (R' SP) (pc + 1) junk) /\ disjUnionList (M2 :: M12 :: cthM2 :: cthM12 :: (MemUpdW cthM11 (R' SP) (pc + 1) junk) :: nil) M'). apply call_sw_frame with M R fl fl' isr isr'; auto. InvertAll. rename x into junk1. set (cthM11' := MemUpdW cthM11 (R' SP) (pc + 1) junk1) in *. assert (exists M1', exists M2', MemMod.disjUnion cthM11' M21 M1' /\ disjUnionList (M22 :: M12 :: cthM2 :: cthM12 :: nil) M2' /\ MemMod.disjUnion M1' M2' M'). apply mem_list_compose_b with M2; auto. InvertAll. rename x into M1'. rename x0 into M2'. assert (exists tcb, T tid = Some tcb). unfold WF_currTID in H16. InvertAll. unfold TQMod.in_dom in H39. auto. inversion_clear H37. rename x into tcb. assert (exists M0' : MemMod.Map, exists RdyQ' : WQ, exists tid' : TID, exists sp' : nat, exists tcb' : Thread, MemMod.disjUnion M0' M2' (S_Mem S0) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ SW_Post_aux (TQMod.put T tid ((R' SP), TCB_Status tcb, pc+1)) RdyQ' tid' sp' (R' SP) tcb' (pc+1) junk1 (S_Mem_Upd S0 M0')). apply H8 with M1' T tcb; auto. unfold SW_Prd_aux. split. assert (S_Mem (S_Mem_Upd (M', R', fl', isr') M1') = M1'). auto. rewrite H37. apply mem_compose_c with cthM11' M21; auto. split; auto. split. apply WF_AIM_World_RdyQinT with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B tid rho (Ast p g tag). auto. split; auto. split; auto. apply WF_AIM_World_WFTQ with Psi'0 (S_Mem_Upd (M, R, fl, isr) M1) B RdyQ tid rho (Ast p g tag). auto. clear H8. InvertAll. rename x into M0'. rename x0 into RdyQ'. rename x1 into tid'. rename x2 into sp'. rename x3 into tcb'. assert ((fl _IF = false) /\ (isr = false)). apply call_sw_flags_false with rho p g tag psi Psi'0 pc cthM cthM1 R T tid; auto. inversion_clear H40. assert (tid = tid' \/ tid <> tid'). apply nat_eq_neq_dec. inversion_clear H40. (* tid = tid' *) (* clear H24 H27 H26 cthM11. *) assert (RdyQ = RdyQ'). assert (WQMod.not_in_dom tid' RdyQ'). unfold SW_Post_aux in H41. InvertAll. auto. apply unique_remain with tid tid'; auto. exists (pc + 1). rewrite <- H40 in H41. rewrite <- H44 in H41. clear H44 H40 H8 tid' RdyQ'. assert (S_RF S0 SP = R' SP). assert (sp' = R' SP). apply enter_SW_grt_aux60 with T RdyQ tid tcb (pc+1) junk1 tcb' S0 M0'; auto. unfold SW_Post_aux in H41. InvertAll. rewrite H8 in H45. auto. split. apply enter_SW_grt_aux7 with T RdyQ tid (R' SP) tcb junk1 sp' tcb' M0' M2'; auto. assert (exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun gy pc _SWITCH pc') oo g') g)). auto. InvertAll. rename x into p'. rename x0 into g'. exists (packS0 rho (Ast p' g' tag)). split. apply psi_sw_lookupNPC with psi Psi Psi'; auto. intros. unfold Itp0. assert (D rho = SomeT1 _ (Itp_AIM rho)). destruct Hrho; subst rho. apply minimalD_elim_Rdy; trivial. apply minimalD_elim_idle; trivial. rewrite H47. unfold Itp_AIM. set (T' := TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)) in * |- *. exists T'. exists B. exists RdyQ. exists tid. assert (exists M21_0, exists cthM11'', ((S_RF S' SP - 2) |-> (pc+1) *^* (S_RF S' SP - 2 + 1) |-> junk1 *^* stkSpacePrec (S_RF S' SP - 2) 8) cthM11'' /\ (embed_curr_TCB T' tid *^* embed_RdyQ T' RdyQ) M21_0 /\ disjUnionList (M21_0 :: M22 :: M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) (S_Mem S')). apply enter_SW_grt_aux8 with T (R' SP) sp' tcb tcb' pc' S0 M0' M2'; auto. InvertAll. rename x into M21_0. rename x0 into cthM11''. unfold pmstar. assert (exists M'1, exists M'2, disjUnionList (M12 :: cthM2 :: cthM12 :: cthM11'' :: nil) M'1 /\ MemMod.disjUnion M21_0 M22 M'2 /\ MemMod.disjUnion M'1 M'2 (S_Mem S')). apply enter_SW_grt_hyp4. auto. InvertAll. rename x into M'1. rename x0 into M'2. exists M'1. exists M'2. split; auto. split. unfold WF_AIM_World. split. unfold T'. apply WF_currTID_ext_T with tcb; auto. split. unfold T'. apply exists_Idle_ext_T; auto. split. unfold T'. apply WF_TWQ_ext_T; auto. exists tcb. auto. split; auto. assert (exists cthM', MemMod.disjUnion M12 cthM' M'1 /\ disjUnionList (cthM2 :: cthM12 :: cthM11'' :: nil) cthM'). auto. InvertAll. rename x into cthM'. exists (ThrdMemMod.put TM tid cthM'). exists cthM'. split. assert (S_Mem (S_Mem_Upd S' M'1) = M'1). auto. rewrite H55. apply enter_SW_grt_hyp6 with M12; auto. split. auto with PMap. split. assert (S_ISR (M, R, fl, isr) = S_ISR S' /\ S_Flag (M, R, fl, isr) _IF = S_Flag S' _IF). apply enter_SW_grt_hyp9 with pc pc' _SWITCH (M', R', fl', isr') S0; auto. unfold S_ISR at 1 in H55. unfold S_Flag at 1 in H55. inversion_clear H55. unfold WF_Curr_Thrd. assert (beq_nat rho rho_ih = false). destruct Hrho; subst rho; simpl; trivial. rewrite H55. clear H55. unfold itp_NH_theta. split. rewrite H43 in H57. rewrite H57. auto. split. unfold NH_pinvstar. unfold pmstar. exists (MemMod.merge cthM12 cthM11''). exists cthM2. split. assert (MemMod.disjUnion (MemMod.merge cthM12 cthM11'') cthM2 cthM'). apply enter_SW_grt_hypa; auto. UnfoldStateAll. auto. split; auto. assert (S_Mem_Upd (S_Mem_Upd (S_Mem_Upd S' M'1) cthM') (MemMod.merge cthM12 cthM11'') = S_Mem_Upd S' (MemMod.merge cthM12 cthM11'')). auto. rewrite H55. clear H55. apply enter_SW_grt_auxb with p cthM1 R fl isr M cthM11 pc pc' M' R' fl' isr' junk1 S0; auto. apply enter_SW_grt_hypc with M21_0 M22 M12 cthM2; auto. apply enter_SW_grt_hypd with M21_0 M22 M12 cthM2 S'; auto. assert (S_Flag (S_Mem_Upd (S_Mem_Upd S' M'1) cthM') = S_Flag S'). auto. rewrite H55. unfold NH_Inv. rewrite <- H58. unfold NH_Inv in H26. auto. intro Tag1. assert (NH_WFST rho Psi'0 (NH_ItpG g (cthM, R, fl, isr))). apply H28. auto. apply NH_WFST_strengthen with (cthM, R, fl, isr) g; auto. unfold pimp. intros. unfold NH_ItpG. assert ((S_Mem_Upd (S_Mem_Upd S' M'1) cthM') = (S_Mem_Upd S' cthM')). auto. rewrite H60 in H59. clear H60. unfold NH_ItpG in H59. InvertAll. rename x into cthM'1. rename x0 into cthM'2. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split. unfold S_Mem. auto. (* H14 *) split. auto. split. auto. split. auto. unfold gimp in H46. apply H46 with pc'. unfold conjG. exists (S_Mem_Upd (S_Mem_Upd S' cthM') cthM'1). split; auto. assert ((cthM2 = cthM'2) /\ (cthM'1 = MemMod.merge cthM12 cthM11'')). apply enter_SW_grt_hype with S' cthM' fl; auto. inversion_clear H63. rewrite H66. unfold conjPG. split; auto. assert (S_Mem_Upd (cthM, R, fl, isr) cthM1 = (cthM1, R, fl, isr)). auto. rewrite H63. clear H63. assert (S_Mem_Upd (S_Mem_Upd S' cthM') (MemMod.merge cthM12 cthM11'') = S_Mem_Upd S' (MemMod.merge cthM12 cthM11'')). auto. rewrite H63. clear H63. apply enter_SW_grt_auxb0 with M cthM11 M' R' fl' isr' junk1 S0; auto. apply enter_SW_grt_hypc with M21_0 M22 M12 cthM2; auto. apply enter_SW_grt_hypd with M21_0 M22 M12 cthM2 S'; auto. split. apply enter_SW_grt_hypf with T (R' SP, TCB_Status tcb, pc + 1); auto. apply enter_SW_grt_hypg with T (R' SP, TCB_Status tcb, pc + 1); auto. unfold WF_currTID in H16. InvertAll. auto. apply leqvM_app_subst with (embed_curr_TCB T' tid *^* embed_RdyQ T' RdyQ *^* embed_WQSet T' B); auto. apply mstar_assoc. unfold mstar at 1. exists M21_0. exists M22. split; auto. split; auto. apply enter_SW_grt_hyph with T tid (R' SP, TCB_Status tcb, pc + 1); auto. unfold WF_currTID in H16. InvertAll. auto. (* tid <> tid' *) assert (WQMod.not_in_dom tid' RdyQ'). unfold SW_Post_aux in H41. InvertAll. auto. assert (WQMod.in_dom tid RdyQ' /\ WQMod.in_dom tid' RdyQ). apply enter_SW_grt2_hyp0; auto. inversion_clear H45. assert (WF_ReadyQ Psi'0 T RdyQ TM). auto. unfold WF_ReadyQ in H23. assert (exists tcb', TQMod.maps_to T tid' tcb' /\ (TCB_Status tcb' = READY \/ TCB_Status tcb' = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid' M /\ (TCB_SP tcb' |~>w TCB_PC tcb') M /\ (WF_Rdy_Thrd Psi'0 M tcb' \/ WF_Rdy_Thrd_IH Psi'0 M tcb'))). apply H23. auto. InvertAll. rename x into tcb''. rename x0 into cthMR. induction tcb'' as ((sp'', status''), pc''). exists pc''. assert (tcb' = (sp'', status'', pc'') /\ sp' = sp'' /\ S_RF S0 SP = sp'). unfold SW_Post_aux in H41. InvertAll. assert (tcb' = (sp'', status'', pc'')). assert (TQMod.maps_to T tid' tcb'). unfold TQMod.maps_to in H41. unfold TQMod.put in H41. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. unfold TQMod.maps_to. auto. unfold TQMod.maps_to in H56. unfold TQMod.maps_to in H48. rewrite H56 in H48. inversion H48. auto. split; auto. split; auto. rewrite H56 in H54. auto. inversion_clear H52. inversion_clear H55. unfold TCB_PC in H50. unfold TCB_SP in H50. split. apply enter_SW_grt2_hyp1 with TM tid tid' cthMR sp'' M0' M2' M22 M12 cthM2 cthM12; auto. rewrite <- H52. auto. inversion_clear H53. (* not in interrupt handler *) unfold WF_Rdy_Thrd in H55. InvertAll. rename x into rho'. rename x0 into p'. rename x1 into g'. rename x2 into tag'. clear H57. exists (packS0 rho' (Ast p' g' tag')). split; auto. intros. unfold Itp0. assert (D rho' = SomeT1 _ (Itp_AIM rho')). apply non_ih_spec_miniD; auto. rewrite H59. clear H59. unfold Itp_AIM. exists (TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). set (T' := TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). exists B. exists RdyQ'. exists tid'. clear H23. assert (exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ (INV0 *^* INV1) INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ') M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old /\ (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk1 *^* stkSpacePrec (R' SP) 8) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S')). apply enter_SW_grt2_hyp2 with T B sp' tcb tcb' pc' S0 M0' M2'; auto. unfold NH_Inv. rewrite <- H10. unfold S_Flag. assert (S_Flag (M, R, fl, isr) _IF = S_Flag (M', R', fl', isr') _IF /\ S_ISR (M, R, fl, isr) = S_ISR (M', R', fl', isr')). apply enter_SW_grt_auxb0_hyp4 with pc _SWITCH; auto. inversion_clear H23. unfold S_Flag in H59. rewrite <- H59. unfold NH_Inv in H26. auto. InvertAll. rename x into INVM. rename x0 into cthM0. rename x1 into M21'. rename x2 into M122. rename x3 into cthM_old. rename x4 into cthM_oldStk. unfold pmstar. assert ( exists M'0, exists M'1, MemMod.disjUnion M'0 M'1 (S_Mem S') /\ MemMod.disjUnion M21' M22 M'1 /\ disjUnionList (cthMR :: INVM :: cthM_old :: M122 :: nil) M'0 ). apply enter_SW_grt2_hyp3; auto. InvertAll. rename x into M'0. rename x0 into M'1. exists M'0. exists M'1. split; auto. split. unfold WF_AIM_World. split. apply enter_SW_grt2_hyp4 with T RdyQ tid (R' SP, TCB_Status tcb, pc + 1) (sp'', status'', pc'') rho; auto. split. apply enter_SW_grt2_hyp5 with T RdyQ tid (R' SP) (pc+1) tcb; auto. split. apply enter_SW_grt2_aux6 with RdyQ tid tid' tcb (R' SP, TCB_Status tcb, pc + 1) T rho; auto. split; auto. exists (ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). set (TM' := ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). exists (MemMod.merge cthMR INVM). set (cthM' := MemMod.merge cthMR INVM). split. assert (S_Mem (S_Mem_Upd S' M'0) = M'0). auto. rewrite H69. apply enter_SW_grt2_hyp7 with cthMR INVM cthM_old M122 TM tid tid'; auto. split. unfold cthM'. unfold TM'. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. induction (ThrdMemMod.beq_A tid' tid'). auto. absurd (tid' = tid'); auto. split. unfold WF_Curr_Thrd. assert (beq_nat rho' rho_ih = false). apply neq_beq_false. inversion_clear H53. rewrite H69. discriminate. rewrite H69. discriminate. rewrite H69. unfold itp_NH_theta. assert (S_ISR S' = false). apply enter_SW_grt2_hyp8 with pc pc' M R fl isr M' R' fl' isr' S0 _SWITCH; auto. split. UnfoldStateAll. auto. assert ((INV0 *^* INV1 -* itp_NH_theta rho' (Ast p' g' tag') Psi'0) (cthMR, S_RF S', S_Flag S', false)). apply H60. rewrite H52 in H56. apply enter_SW_grt2_hyp9 with S0 pc'; auto. assert (S_ISR (M, R, fl, isr) = S_ISR S' /\ S_Flag (M, R, fl, isr) _IF = S_Flag S' _IF). apply enter_SW_grt_hyp9 with pc pc' _SWITCH (M', R', fl', isr') S0; auto. inversion_clear H72. rewrite <- H74. unfold S_Flag. auto. assert (itp_NH_theta rho' (Ast p' g' tag') Psi'0 (cthM', S_RF S', S_Flag S', false)). unfold cthM'. unfold pm_mwand in H72. assert ((MemMod.merge cthMR INVM, S_RF S', S_Flag S', false) = S_Mem_Upd (cthMR, S_RF S', S_Flag S', false) (MemMod.merge cthMR INVM)). auto. rewrite H73. apply H72 with INVM; auto. unfold S_Mem. assert (MemMod.disjUnion cthMR INVM (MemMod.merge cthMR INVM)). unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_hypa with M22 M21' cthM_old M122 S'; auto. auto with PMap. assert (S_Mem_Upd (S_Mem_Upd S' M'0) cthM' = (cthM', S_RF S', S_Flag S', false)). induction S' as (((M'', R''), fl''), isr''). UnfoldStateAll. auto. rewrite H71. auto. rewrite H74. clear H74. unfold itp_NH_theta in H73. inversion_clear H73. auto. split. unfold WF_ReadyQ. intros. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H71. (* tid0 = tid *) exists (R' SP, TCB_Status tcb, pc + 1). rewrite H72. split; auto. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid tid). auto. absurd (tid = tid); auto. split. unfold TCB_Status at 1. unfold TCB_Status at 2. unfold WF_currTID in H16. InvertAll. unfold TQMod.maps_to in H75. rewrite H75 in H39. inversion H39. rewrite <- H78. auto. exists cthM_old. split. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid tid); auto. absurd (tid = tid); auto. split. unfold TCB_SP. unfold TCB_PC. apply enter_SW_grt2_hypb with (MemMod.merge cthM0 cthM2) cthM_oldStk junk1; auto. left. unfold WF_Rdy_Thrd. exists rho. assert (exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun gy pc _SWITCH pc') oo g') g)). apply call_sw_nextPC_spec; auto. InvertAll. rename x into p''. rename x0 into g''. exists p''. exists g''. exists tag. split. auto. split. unfold WF_currTID in H16. InvertAll. unfold TQMod.maps_to in H78. rewrite H78 in H39. inversion H39. rewrite <- H81. unfold rho_tcb_consistent in H80. unfold rho_tcb_consistent. auto. split. apply enter_SW_grt2_hypb with (MemMod.merge cthM0 cthM2) cthM_oldStk junk1; auto. split. apply psi_sw_lookupNPC with psi Psi Psi'; auto. intros. unfold pm_mwand. unfold S_Mem. intros. unfold itp_NH_theta. split. UnfoldStateAll. auto. split. apply enter_SW_grt2_auxc with cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk1 M0 p M M' R' fl' isr'; auto. (* WFST *) intro. assert (NH_WFST rho Psi'0 (NH_ItpG g (cthM, R, fl, isr))). apply H28. auto. clear H28. clear H79. apply NH_WFST_strengthen with (cthM, R, fl, isr) g; auto. unfold pimp. intros. unfold gimp in H75. unfold NH_ItpG. unfold NH_ItpG in H28. InvertAll. rename x into M'20. rename x0 into M'21. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split; auto. split; auto. split. unfold S_Flag. auto. split. auto. apply H75 with pc'. unfold conjG. exists (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20). split; auto. unfold conjPG. split; auto. assert (M'20 = MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). apply enter_SW_grt2_hype with cthM_old M'2 cthM2 M'21 fl fl0; auto. assert (S_Mem_Upd (cthM, R, fl, isr) cthM1 = (cthM1, R, fl, isr)). UnfoldStateAll. auto. rewrite H85. clear H85. assert (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20 = (M'20, R0, fl0, false)). UnfoldStateAll. auto. rewrite H85. clear H85. rewrite H83. apply enter_SW_grt2_auxc_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM junk1 cthM2 cthM_old M'2; auto. (* tid0 <> tid : other ready threads *) unfold WF_ReadyQ in H45. assert (exists tcb : Thread, TQMod.maps_to T tid0 tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid0 M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi'0 M tcb \/ WF_Rdy_Thrd_IH Psi'0 M tcb))). apply H45; auto. apply enter_SW_grt2_hypf with RdyQ' tid tid'; auto. InvertAll. exists x. split. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold TQMod.maps_to in H71. auto. split; auto. exists x0. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). rewrite <- a in H40. absurd (~ WQMod.in_dom tid0 RdyQ'); auto with PMap. unfold ThrdMemMod.maps_to in H75. auto. apply enter_SW_grt2_hypg with T TM RdyQ RdyQ' tid tid' (R' SP, TCB_Status tcb, pc + 1) cthM_old (MemMod.merge cthMR INVM) rho; auto. apply enter_SW_grt2_hyph with M21' M22 T (R' SP, TCB_Status tcb, pc + 1) RdyQ tid rho; auto. (* tid' is in interrupt hander *) unfold WF_Rdy_Thrd_IH in H55. InvertAll. rename x into p'. rename x0 into g'. rename x1 into tag'. exists (packS0 rho_ih (Ast p' g' tag')). split; auto. intros. unfold Itp0. assert (D rho_ih = SomeT1 _ (Itp_AIM rho_ih)). unfold Minimal_D in H0. InvertAll. auto. rewrite H59. clear H59. unfold Itp_AIM. exists (TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). set (T' := TQMod.put T tid (R' SP, TCB_Status tcb, pc + 1)). exists B. exists RdyQ'. exists tid'. clear H23. assert (exists INVM, exists cthM0, exists M21', exists M122, exists cthM_old, exists cthM_oldStk, MemMod.disjUnion INVM cthM0 cthM12 /\ (INV0 *^* INV1) INVM /\ (embed_curr_TCB T' tid' *^* embed_RdyQ T' RdyQ') M21' /\ MemMod.disjUnion M122 cthMR M12 /\ MemSplit (ThrdMemMod.remove (ThrdMemMod.remove TM tid) tid') M122 /\ MemMod.disjUnion (MemMod.merge cthM0 cthM2) cthM_oldStk cthM_old /\ (R' SP |-> (pc+1) *^* R' SP + 1 |-> junk1 *^* stkSpacePrec (R' SP) 8) cthM_oldStk /\ disjUnionList (M22 :: cthMR :: INVM :: M21' :: cthM_old :: M122 :: nil) (S_Mem S')). apply enter_SW_grt2_hyp2 with T B sp' tcb tcb' pc' S0 M0' M2'; auto. unfold NH_Inv. rewrite <- H10. unfold S_Flag. assert (S_Flag (M, R, fl, isr) _IF = S_Flag (M', R', fl', isr') _IF /\ S_ISR (M, R, fl, isr) = S_ISR (M', R', fl', isr')). apply enter_SW_grt_auxb0_hyp4 with pc _SWITCH; auto. inversion_clear H23. unfold S_Flag in H59. rewrite <- H59. unfold NH_Inv in H26. auto. InvertAll. rename x into INVM. rename x0 into cthM0. rename x1 into M21'. rename x2 into M122. rename x3 into cthM_old. rename x4 into cthM_oldStk. unfold pmstar. assert ( exists M'0, exists M'1, MemMod.disjUnion M'0 M'1 (S_Mem S') /\ MemMod.disjUnion M21' M22 M'1 /\ disjUnionList (cthMR :: INVM :: cthM_old :: M122 :: nil) M'0 ). apply enter_SW_grt2_hyp3; auto. InvertAll. rename x into M'0. rename x0 into M'1. exists M'0. exists M'1. split; auto. split. unfold WF_AIM_World. split. apply enter_SW_grt2_hyp4 with T RdyQ tid (R' SP, TCB_Status tcb, pc + 1) (sp'', status'', pc'') rho; auto. auto. split. apply enter_SW_grt2_hyp5 with T RdyQ tid (R' SP) (pc+1) tcb; auto. split. apply enter_SW_grt2_aux6 with RdyQ tid tid' tcb (R' SP, TCB_Status tcb, pc + 1) T rho; auto. split; auto. exists (ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). set (TM' := ThrdMemMod.put (ThrdMemMod.put TM tid' (MemMod.merge cthMR INVM)) tid cthM_old). exists (MemMod.merge cthMR INVM). set (cthM' := MemMod.merge cthMR INVM). split. assert (S_Mem (S_Mem_Upd S' M'0) = M'0). auto. rewrite H68. apply enter_SW_grt2_hyp7 with cthMR INVM cthM_old M122 TM tid tid'; auto. split. unfold cthM'. unfold TM'. unfold ThrdMemMod.put. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid' tid). absurd (tid' <> tid); auto. induction (ThrdMemMod.beq_A tid' tid'). auto. absurd (tid' = tid'); auto. split. unfold WF_Curr_Thrd. assert (beq_nat rho_ih rho_ih = true). simpl. auto. rewrite H68. assert (S_Flag S' _IF = false). apply enter_SW_grt2_hypI with pc pc' M R fl isr M' R' fl' isr' S0; auto. assert ((INV0 *^* INV1 -* itp_IH_theta (Ast p' g' tag') status'' Psi'0) (cthMR, S_RF S', S_Flag S', false)). apply H58. rewrite H52 in H56. apply enter_SW_grt2_hyp9 with S0 pc'; auto. auto. exists (sp'', status'', pc''). exists status''. split. unfold T'. unfold TQMod.maps_to. unfold TQMod.put. induction (TQMod.beq_A tid' tid). absurd (tid' <> tid); auto. auto. split; auto. unfold pm_mwand in H70. assert (S_ISR S' = false). apply enter_SW_grt2_hyp8 with pc pc' M R fl isr M' R' fl' isr' S0 _SWITCH; auto. assert (itp_IH_theta (Ast p' g' tag') status'' Psi'0 (S_Mem_Upd (cthMR, S_RF S', S_Flag S', false) cthM')). apply H71 with INVM; auto. unfold S_Mem. unfold cthM'. assert (MemMod.disjUnion cthMR INVM (MemMod.merge cthMR INVM)). unfold MemMod.disjUnion. split; auto. apply enter_SW_grt2_hypa with M22 M21' cthM_old M122 S'; auto. auto with PMap. rewrite <- H72 in H73. UnfoldStateAll. auto. split. unfold WF_ReadyQ. intros. assert (tid0 = tid \/ tid0 <> tid). apply nat_eq_neq_dec. inversion_clear H70. exists (R' SP, TCB_Status tcb, pc + 1). rewrite H71. split; auto. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid tid). auto. absurd (tid = tid); auto. split. unfold TCB_Status at 1. unfold TCB_Status at 2. unfold WF_currTID in H16. InvertAll. unfold TQMod.maps_to in H74. rewrite H74 in H39. inversion H39. rewrite <- H77. auto. exists cthM_old. split. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid tid); auto. absurd (tid = tid); auto. split. unfold TCB_SP. unfold TCB_PC. apply enter_SW_grt2_hypb with (MemMod.merge cthM0 cthM2) cthM_oldStk junk1; auto. left. unfold WF_Rdy_Thrd. exists rho. assert (exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ (forall pc', pimp (p |> (wrap_fun gy pc _SWITCH pc')) p') /\ (forall pc', gimp (p >o (wrap_fun gy pc _SWITCH pc') oo g') g)). apply call_sw_nextPC_spec; auto. InvertAll. rename x into p''. rename x0 into g''. exists p''. exists g''. exists tag. split. auto. split. unfold WF_currTID in H16. InvertAll. unfold TQMod.maps_to in H77. rewrite H77 in H39. inversion H39. rewrite <- H80. unfold rho_tcb_consistent in H79. unfold rho_tcb_consistent. simpl. auto. split. apply enter_SW_grt2_hypb with (MemMod.merge cthM0 cthM2) cthM_oldStk junk1; auto. split. apply psi_sw_lookupNPC with psi Psi Psi'; auto. intros. unfold pm_mwand. unfold S_Mem. intros. unfold itp_NH_theta. split. UnfoldStateAll. auto. split. apply enter_SW_grt2_auxc with cthM1 cthM2 cthM R fl isr cthM11 cthM12 INVM cthM0 cthM_oldStk pc junk1 M0 p M M' R' fl' isr'; auto. (* WFST *) intro. assert (NH_WFST rho Psi'0 (NH_ItpG g (cthM, R, fl, isr))). apply H28. auto. clear H28. clear H78. apply NH_WFST_strengthen with (cthM, R, fl, isr) g; auto. unfold pimp. intros. unfold gimp in H74. unfold NH_ItpG. unfold NH_ItpG in H28. InvertAll. rename x into M'20. rename x0 into M'21. rename x1 into SM1. rename x2 into SM2. exists cthM1. exists cthM2. exists SM1. exists SM2. split; auto. split; auto. split. unfold S_Flag. auto. split. auto. apply H74 with pc'. unfold conjG. exists (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20). split; auto. unfold conjPG. split; auto. assert (M'20 = MemMod.merge (MemMod.merge cthM0 M0) cthM_oldStk). apply enter_SW_grt2_hype with cthM_old M'2 cthM2 M'21 fl fl0; auto. assert (S_Mem_Upd (cthM, R, fl, isr) cthM1 = (cthM1, R, fl, isr)). UnfoldStateAll. auto. rewrite H84. clear H84. assert (S_Mem_Upd (S_Mem_Upd (cthM_old, R0, fl0, false) M'2) M'20 = (M'20, R0, fl0, false)). UnfoldStateAll. auto. rewrite H84. clear H84. rewrite H82. apply enter_SW_grt2_auxc_aux4 with M M' R' fl' isr' cthM11 cthM12 INVM junk1 cthM2 cthM_old M'2; auto. (* tid0 <> tid : other ready threads *) unfold WF_ReadyQ in H45. assert (exists tcb : Thread, TQMod.maps_to T tid0 tcb /\ (TCB_Status tcb = READY \/ TCB_Status tcb = IDLE) /\ (exists M : Mem, ThrdMemMod.maps_to TM tid0 M /\ (TCB_SP tcb |~>w TCB_PC tcb) M /\ (WF_Rdy_Thrd Psi'0 M tcb \/ WF_Rdy_Thrd_IH Psi'0 M tcb))). apply H45; auto. apply enter_SW_grt2_hypf with RdyQ' tid tid'; auto. InvertAll. exists x. split. unfold T'. unfold TQMod.put. unfold TQMod.maps_to. induction (TQMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold TQMod.maps_to in H70. auto. split; auto. exists x0. split; auto. unfold TM'. unfold ThrdMemMod.put at 1. unfold ThrdMemMod.maps_to. induction (ThrdMemMod.beq_A tid0 tid). absurd (tid0 <> tid); auto. unfold ThrdMemMod.put. induction (ThrdMemMod.beq_A tid0 tid'). rewrite <- a in H40. absurd (~ WQMod.in_dom tid0 RdyQ'); auto with PMap. unfold ThrdMemMod.maps_to in H74. auto. apply enter_SW_grt2_hypg with T TM RdyQ RdyQ' tid tid' (R' SP, TCB_Status tcb, pc + 1) cthM_old (MemMod.merge cthMR INVM) rho; auto. apply enter_SW_grt2_hyph with M21' M22 T (R' SP, TCB_Status tcb, pc + 1) RdyQ tid rho; auto. Qed. Lemma enter_SW: forall D rho psi pc theta D' Psi Psi' Psi'0 a S S', rho = rho_ready \/ rho = rho_idle -> NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> a = Itp_AIM rho theta -> subsetCT Psi' Psi'0 -> a Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> Itp0 D' SWITCH_Spec0 Psi'0 S'. Proof. intros D rho psi pc theta D' Psi Psi' Psi'0 a S S' Hrho; intros. unfold Itp0. unfold SWITCH_Spec0. rewrite H1. simpl. rewrite H4 in H6. clear H4 a. split. apply enter_SW_pre with rho psi pc theta Psi'0 S; auto. split. apply enter_SW_disable with rho psi pc theta Psi'0 S; auto. exists 0. apply enter_SW_grt with rho psi pc theta D' Psi Psi' S; auto. Qed. Lemma NH_SW_Presv: forall D rho psi pc theta D' Psi Psi' Psi'0 a S S' f', rho = rho_ready \/ rho = rho_idle -> NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> a = Itp_AIM rho theta -> subsetCT Psi' Psi'0 -> a Psi'0 S -> nextS pc (comml (_call _SWITCH)) S S' -> nextPC (comml (_call _SWITCH)) (S_Mem S) (S_RF S) (S_Flag S) pc f' -> exists theta0 : Spec0, lookupCT Psi'0 f' theta0 /\ Itp0 D' theta0 Psi'0 S'. Proof. intros D rho psi pc theta D' Psi Psi' Psi'0 a S S' f' Hrho; intros. assert (lookupCT Psi'0 _SWITCH SWITCH_Spec0). apply subsetCT_presv_lookupCT with Psi'; auto. rewrite H3. unfold ext_IH_Spec, ext_Prim_Specs. apply lookupCT_subsetCT with (consCT _SWITCH SWITCH_Spec0 Psi). apply lookupCT_consCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply Psi_extend_subsetCT. apply subsetCT_refl. inversion H8. clear H14 H13 H12 H10 H11 fl R M f pc0. exists SWITCH_Spec0. split; auto. apply enter_SW with D rho psi pc theta Psi Psi' a S; auto. Qed. Lemma call_sw_disable_itr: forall rho psi Psi'0 pc theta S, rho = rho_ready \/ rho = rho_idle -> NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Itp_AIM rho theta Psi'0 S -> ~ itr_enabled S. Proof. intros rho psi Psi'0 pc theta S Hrho. intros. unfold NH_WFcmd in H. induction theta. InvertAll. unfold NH_WFcmd_aux in H1. inversion_clear H1. unfold NH_Call_Prim in H2. InvertAll. assert (monotonic_p (fun S => S_Flag S _IF = false)). auto. assert (forall S, imprec p S -> (fun S => S_Flag S _IF = false) S). apply (imprec_presv_imp_monotonic H4 H5); auto. assert (imprec p S). apply imprec_presv_imprec with (NH_pinvstar p); auto. apply Itp_AIM_pinv with g n Psi'0 rho; auto. destruct Hrho; subst rho; auto. assert ((fun S0 : State => S_Flag S0 _IF = false) S). apply (H6 S H7). intro. unfold itr_enabled in H9. assert (S_Flag S _IF = false). auto. inversion H9. rewrite H11 in H10. inversion H10. inversion H2. absurd (prim_entry _SWITCH); auto. unfold prim_entry. left. auto. Qed. Lemma NH_SW_Itp : forall D rho psi pc theta D' Psi Psi', rho = rho_ready \/ rho = rho_idle -> NH_WFcmd psi pc theta (comml (_call _SWITCH)) -> Minimal_D D -> D' = ext_dict D rho_prim (Generic_Itp D rho_prim) -> lift_psi psi rho Psi -> Psi' = ext_IH_Spec (ext_Prim_Specs Psi) -> WFcmd D' Psi' (packS0 rho theta) pc (comml (_call _SWITCH)). Proof. intros D rho psi pc theta D' Psi Psi' Hrho; intros. unfold WFcmd. split. unfold WFcmd_aux. intros. assert (Itp_AIM rho theta Psi'0 S). unfold Itp0 in H4. rewrite H1 in H4. unfold ext_dict in H4. assert (beq_nat rho rho_prim = false). destruct Hrho; subst rho; auto. rewrite H6 in H4. assert (D rho = SomeT1 _ (Itp_AIM rho)). destruct Hrho; subst rho; unfold Minimal_D in H0; InvertAll; trivial. rewrite H7 in H4. auto. split. apply NH_SW_progress with rho psi theta Psi'0 (Itp_AIM rho theta); auto. split. intros. apply NH_SW_Presv with D rho psi pc theta Psi Psi' (Itp_AIM rho theta) S; auto. left. apply call_sw_disable_itr with rho psi Psi'0 pc theta; auto. rewrite H1. unfold Itp0. unfold ext_dict. assert (beq_nat rho rho_prim = false). destruct Hrho; subst rho; auto. rewrite H4. destruct Hrho; subst rho; unfold Minimal_D in H0; InvertAll; trivial. rewrite H5. apply Itp_AIM_Mono_CT. rewrite H0. apply Itp_AIM_Mono_CT. Qed. coq/SCAP/QLib.v0000644000107400000620000001364711000223235012620 0ustar shaosystemsAdd LoadPath "..". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Definition ptoNode (Node : Set) (inMem : Label -> Node -> MPred) (l prev next : Label) (node : Node) : MPred := mstar (mstar (ptoW l prev) (ptoW (l+2) next)) (inMem (l+4) node). (* Queue Node inMemNode head tail head_prev tail_post Q M *) (* head : head of queue; tail : tail of queue *) (* head_prev : prev field in the head node *) (* tail_next : next field in the tail node *) (* Q : corresponding abstract set of Node *) (* Inductive Queue (Node : Set) (inMemNode : Label -> Node -> MPred) : *) (* Label -> Label -> Label -> Label -> (Label -> option Node) -> Mem -> Prop := *) (* Q_emp : forall prev next, Queue Node inMemNode 0 0 prev next (fun l => None) MemMod.emp *) (* | Q_cons_fst : forall l prev next node Q M prev' next', *) (* mstar (Queue Node inMemNode 0 0 prev' next' Q) (ptoNode Node inMemNode l prev next node) M *) (* -> l > 0 *) (* -> Queue Node inMemNode l l prev next (fun l' => if eq_nat_dec l l' then Some node else Q l') M *) (* | Q_cons_more : forall head tail prev Q M l next' node, *) (* mstar (Queue Node inMemNode head tail prev l Q) (ptoNode Node inMemNode l tail next' node) M *) (* -> tail > 0 *) (* -> l > 0 *) (* -> Queue Node inMemNode head l prev next' (fun l' => if eq_nat_dec l l' then Some node else Q l') M. *) Inductive Queue (Node : Set) (inMemNode : Label -> Node -> MPred) : Label -> Label -> Label -> Label -> (Label -> option Node) -> Mem -> Prop := Q_emp : forall prev next, Queue Node inMemNode 0 0 prev next (fun l => None) MemMod.emp | Q_cons_fst : forall l prev next node M , (ptoNode Node inMemNode l prev next node) M -> l > 0 -> Queue Node inMemNode l l prev next (fun l' => if eq_nat_dec l l' then Some node else None) M | Q_cons_more : forall head tail prev Q M1 M2 M l next' node, MemMod.disjUnion M1 M2 M -> (Queue Node inMemNode head tail prev l Q) M1 -> (ptoNode Node inMemNode l tail next' node) M2 -> tail > 0 -> l > 0 -> Queue Node inMemNode head l prev next' (fun l' => if eq_nat_dec l l' then Some node else Q l') M. Implicit Arguments Q_emp [Node inMemNode]. Implicit Arguments Q_cons_fst [Node inMemNode]. Implicit Arguments Q_cons_more [Node inMemNode]. Definition ptoQ (Node : Set) (inMemNode : Label -> Node -> MPred) (l : Label) (Q : Label -> option Node) : MPred := fun (M : Mem) => exists head, exists tail, exists prev, mstar (mstar (ptoW l head) (ptoW (l+2) tail)) (Queue Node inMemNode head tail prev 0 Q) M. (* Definition enQueue_pre (Node : Set) (inMemNode : Label -> Node -> MPred) (sp l ln : Label) (node : Node) (Q : Label -> option Node) := fun (M : Mem) => exists prev, exists next, ln > 0 /\ mstar (mstar (mstar (mstar (ptoW (sp + 2) ln) (ptoW (sp + 4) l)) (ptoxW (sp - 2))) (ptoQ Node inMemNode l Q)) (ptoNode Node inMemNode ln prev next node) M. Definition p_enQueue : Pred := fun (S : State) => exists Node, exists inMemNode, exists sp, exists l, exists Q, exists ln, exists node, ((enQueue_pre Node inMemNode sp l ln node Q) *^* mTrue) (S_Mem S) /\ (S_RF S SP = sp) /\ (sp >= 2). Definition enQueue_post (Node : Set) (inMemNode : Label -> Node -> MPred) (sp l ln: Label) (node : Node) (Q : Label -> option Node) := fun (M : Mem) => mstar (mstar (mstar (ptoW (sp + 2) ln) (ptoW (sp + 4) l)) (ptoxW (sp - 2))) (ptoQ Node inMemNode l (fun l => if eq_nat_dec ln l then Some node else Q l)) M. Definition g_enQueue : Grt := fun (S S' : State) => forall Node inMemNode sp l ln node Q, forall M M0, MemMod.disjUnion M M0 (S_Mem S) -> S_RF S SP = sp -> enQueue_pre Node inMemNode sp l ln node Q M -> exists M', MemMod.disjUnion M' M0 (S_Mem S') /\ enQueue_post Node inMemNode sp l ln node Q M' /\ S_RF S SP = S_RF S' SP /\ S_RF S BP = S_RF S' BP /\ S_Flag S _IF = S_Flag S' _IF. Definition deQueue_pre (Node : Set) (inMemNode : Label -> Node -> MPred) (sp l : Label) (Q : Label -> option Node) := fun (M : Mem) => mstar (mstar (ptoW (sp+2) l) (ptoxW (sp - 2))) (ptoQ Node inMemNode l Q) M. Definition p_deQueue : Pred := fun (S : State) => exists Node, exists inMemNode, exists sp, exists l, exists Q, ((deQueue_pre Node inMemNode sp l Q) *^* mTrue) (S_Mem S) /\ (S_RF S SP = sp) /\ (sp >=2). Definition deQueue_post_a (Node : Set) (inMemNode : Label -> Node -> MPred) (sp l ln : Label) (node : Node) (Q : Label -> option Node) := fun (M : Mem) => exists prev, exists next, mstar (mstar (mstar (ptoW (sp + 2) l) (ptoxW (sp - 2))) (ptoQ Node inMemNode l Q)) (ptoNode Node inMemNode ln prev next node) M. Definition g_deQueue : Grt := fun (S S' : State) => forall Node inMemNode sp l Q, forall M M0, MemMod.disjUnion M M0 (S_Mem S) -> S_RF S SP = sp -> deQueue_pre Node inMemNode sp l Q M -> exists M', MemMod.disjUnion M' M0 (S_Mem S') /\ ((forall l, Q l = None) /\ deQueue_pre Node inMemNode sp l Q M' /\ S_RF S' AX = 0 \/ exists ln, exists node, exists Q', (Q' ln = None) /\ (fun l' => if eq_nat_dec ln l' then Some node else Q' l') = Q /\ deQueue_post_a Node inMemNode sp l ln node Q' M' /\ S_RF S' AX = ln ) /\ S_RF S SP = S_RF S' SP /\ S_RF S BP = S_RF S' BP /\ S_Flag S _IF = S_Flag S' _IF. *)coq/SCAP/Linking_Lemmas3.v0000644000107400000620000002427111000223235014740 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas4. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import SCAP_Itr. Require Import EqNat. Require Import Linking. Require Import Linking_Lemmas. Require Import Linking_Lemmas2. Lemma weaken_lift_IH_PG: forall Psi p g tag p' g' S S' status, lift_IH_PG (Ast p g tag) Psi status S -> ((p *<* INV1) S -> (p' *<* INV1) S') -> (forall S'', IH_ItpG g' S' S'' -> IH_ItpG g S S'') -> lift_IH_PG (Ast p' g' tag) Psi status S'. Proof. intros. unfold lift_IH_PG. unfold lift_IH_PG in H. InvertAll. split; auto. Qed. Lemma weaken_itp_IH_theta: forall Psi p g tag p' g' S S' status, itp_IH_theta (Ast p g tag) status Psi S -> S_Flag S' _IF = false -> ((p *<* INV1) S -> (p' *<* INV1) S') -> (forall S'', IH_ItpG g' S' S'' -> IH_ItpG g S S'') -> itp_IH_theta (Ast p' g' tag) status Psi S'. Proof. intros. unfold itp_IH_theta. split; auto. unfold itp_IH_theta in H. InvertAll. inversion H4. left. apply weaken_lift_IH_PG with p g S; auto. right. InvertAll. split; auto. split; auto. exists x. apply IH_WFST_strengthen with S g; auto. Qed. Lemma decompose_World: forall rho Psi T B RdyQ tid p g tag M1 R fl isr, rho = rho_ready \/ rho = rho_idle -> WF_AIM_World Psi (M1, R, fl, isr) T B RdyQ tid rho (Ast p g tag) -> exists TM, exists cthM, exists M12, exists cthM1, exists cthM2, MemMod.disjUnion M12 cthM M1 /\ MemMod.disjUnion cthM1 cthM2 cthM /\ WF_currTID tid T B RdyQ rho /\ WF_TWQ T B RdyQ /\ exists_Idle T RdyQ tid /\ WF_WQ_WQSpec B Delta /\ MemSplit (ThrdMemMod.remove TM tid) M12 /\ ThrdMemMod.maps_to TM tid cthM /\ WF_Curr_Thrd Psi (S_Mem_Upd (M1, R, fl, isr) cthM) rho (Ast p g tag) T tid /\ WF_ReadyQ Psi T RdyQ TM /\ WF_WQSet Psi T B TM /\ p (cthM1, R, fl, isr) /\ NH_Inv fl cthM2 /\ (tag = 1 -> NH_WFST rho Psi (NH_ItpG g (cthM, R, fl, isr))). Proof. intros rho Psi T B RdyQ tid p g tag M1 R fl isr Hrho; intros. unfold WF_AIM_World in H. InvertAll. rename x into TM. rename x0 into cthM. exists TM. exists cthM. assert (exists M12, MemMod.disjUnion M12 cthM M1 /\ MemSplit (ThrdMemMod.remove TM tid) M12). apply memsplit_thrd_remove; auto. InvertAll. rename x into M12. exists M12. assert (NH_pinvstar p (cthM, R, fl, isr)). apply WF_Curr_Thrd_pinv with Psi rho g tag T tid; auto. destruct Hrho; subst rho; auto. unfold NH_pinvstar in H9. unfold pmstar in H9. InvertAll. rename x into cthM1. rename x0 into cthM2. exists cthM1. exists cthM2. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. split; auto. unfold WF_Curr_Thrd in H5. destruct Hrho; subst rho; simpl in H5. unfold itp_NH_theta in H5. InvertAll. UnfoldStateAll. auto. unfold itp_NH_theta in H5. InvertAll. UnfoldStateAll. auto. Qed. (***********************************************) (* lemmas r.t. filterTQ by guoyu *) Lemma filterTQ_put : forall T Q tid tcb, (fun l : nat => if eq_nat_dec tid l then Some tcb else filterTQ T Q l) = (filterTQ (TQMod.put T tid tcb) (addThrd Q tid)). Proof. intros T Q tid tcb. apply (extensionality nat (option Thread) (fun l : nat => if eq_nat_dec tid l then Some tcb else filterTQ T Q l) (filterTQ (TQMod.put T tid tcb) (addThrd Q tid))). intros tidx. unfold filterTQ, TQMod.put, addThrd. unfold WQMod.put. unfold WQMod.beq_A, TQMod.beq_A. unfold WQSpec.beq_Domain, TQSpec.beq_Domain. destruct (eq_nat_dec tid tidx). subst tidx. destruct (eq_nat_dec tid tid); trivial. destruct (n (refl_equal _)). destruct (eq_nat_dec tidx tid); trivial. subst tidx. destruct (n (refl_equal _)). Qed. Lemma filterTQ_unfold : forall T Q tid tcb, TQMod.maps_to (filterTQ T Q) tid tcb -> TQMod.maps_to T tid tcb. Proof. unfold TQMod.maps_to. unfold filterTQ. intros T Q tid tcb H. destruct (Q tid); trivial. discriminate. Qed. Lemma filterTQ_unfold2 : forall T Q tid tcb, TQMod.maps_to (filterTQ T Q) tid tcb -> Q tid = Some dummy_sglton. Proof. unfold TQMod.maps_to, WQMod.in_dom. unfold filterTQ. intros T Q tid tcb H. generalize (refl_equal (Q tid)). pattern Q at 1. destruct (Q tid); intro Hx. induction b. trivial. discriminate. Qed. Lemma filterTQ_not_empty : forall T RdyQ tid tcb, exists_Idle T RdyQ tid -> TCB_Status tcb = READY -> TQMod.maps_to T tid tcb -> (forall l : TQMod.A, filterTQ T RdyQ l = None) -> False. Proof. intros T RdyQ tid tcb Hex Htcb Hmto Hemp. unfold exists_Idle in Hex. destruct Hex. destruct H as [tcbx [H0 H1]]. unfold TQMod.maps_to in * . rewrite H0 in Hmto. injection Hmto. intros H; subst tcbx. rewrite Htcb in H1. discriminate H1. unfold filterTQ in Hemp. destruct H as [tid' [tcb' [Hin [Hmto' Htcb']]]]. substH Hemp with (Hemp tid'). unfold WQMod.in_dom in Hin. destruct Hin. rewrite H in Hemp. unfold TQMod.maps_to in Hmto'. rewrite Hmto' in Hemp. discriminate. Qed. Lemma filterTQ_prev : forall T Q tid tcb T', subsetQ_TQ Q T -> WQMod.not_in_dom tid Q -> T' = TQMod.put T tid tcb -> filterTQ T' Q = filterTQ T Q. Proof. intros T RdyQ tid tcb T' H H0 H1. unfold subsetQ_TQ in H. unfold WQMod.not_in_dom in H0. unfold filterTQ. apply (extensionality TQMod.A (option TQMod.B) (fun tid0 : TID => match RdyQ tid0 with | Some _ => T' tid0 | None => None (A:=TQMod.B) end) (fun tid0 : TID => match RdyQ tid0 with | Some _ => T tid0 | None => None (A:=TQMod.B) end)). intros tidx. destruct (TQMod.beq_A tid tidx). subst tidx. rewrite H0. trivial. destruct (RdyQ tidx). subst T'. rewrite TQMod.put_noninterfere; trivial. trivial. Qed. Lemma filterTQ_prev2 : forall T Q Q' tid tcb T', subsetQ_TQ Q T -> Q' = WQMod.remove Q tid -> T' = TQMod.put T tid tcb -> filterTQ T' Q' = filterTQ T Q'. Proof. intros T Q Q' tid tcb T' H H0 H1. apply filterTQ_prev with tid tcb; trivial. unfold subsetQ_TQ in * . intros. subst Q'. apply H. unfold WQMod.in_dom, WQMod.remove in H2 |- * . destruct H2. exists x. destruct (WQMod.beq_A tid0 tid). discriminate. trivial. subst Q'. apply WQMod.nid_remove. Qed. (**********************************************) (* local spec should satify spec in Linking.v *) Lemma ptoTCB_intro1 : forall M ptr tcb tst A, M ||- (ptr |->w (TCB_SP tcb) *^* ptr + 2 |->w tst) *^* A -> nat2Status tst = Some (TCB_Status tcb) -> M ||- ptoTCB ptr tcb *^* A. Proof. intros M ptr tcb tst A H H0. destruct (sconj_elim H) as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l; split_r. unfold ptoTCB. destruct tcb as [[sp' tst'] pc']. exists tst; auto. Qed. Lemma ptoTCB_elim1 : forall M ptr tcb A, M ||- ptoTCB ptr tcb *^* A -> exists tst, (M ||- (ptr |->w (TCB_SP tcb) *^* ptr + 2 |->w tst) *^* A) /\ nat2Status tst = Some (TCB_Status tcb). Proof. intros M ptr tcb A H. destruct (sconj_elim H) as [M1 [M2 [HJM [HM1 HM2]]]]. unfold ptoTCB in HM1. destruct tcb as [[sp' tst'] pc']. sep off. destruct HM1 as [w [HM1 Hw]]. exists w. unfold TCB_Status, TCB_SP. split_r. exists M1; exists M2; auto. Qed. Implicit Arguments ptoTCB_elim1 [M ptr tcb A]. Lemma embed_curr_TCB_intro1 : forall M T tid tcb A, TQMod.maps_to T tid tcb -> M ||- (curr_thrd |->w tid *^* tid |->w_ *^* tid + 2 |->w_ *^* ptoTCB (tid + 4) tcb) *^* A -> M ||- embed_curr_TCB T tid *^* A. Proof. intros M T tid tcb A H H0. destruct (sconj_elim H0) as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l; split_r. unfold embed_curr_TCB. exists tcb; split_l. sep on. sep matchH HM1 with 4. Qed. Lemma embed_curr_TCB_elim1 : forall M T tid A, M ||- embed_curr_TCB T tid *^* A -> exists tcb, TQMod.maps_to T tid tcb /\ M ||- (curr_thrd |->w tid *^* tid |->w_ *^* tid + 2 |->w_ *^* ptoTCB (tid + 4) tcb) *^* A. Proof. intros M T tid A H. destruct (sconj_elim H) as [M1 [M2 [HJM [HM1 HM2]]]]. unfold embed_curr_TCB in HM1. sep off. destruct HM1 as [tcb [Htcb HM1]]. exists tcb; split_l. exists M1; exists M2; split_l; split_r. sep on. sep matchH HM1 with 6. Qed. Lemma ptoTQ_elim : forall Q ptr M, M ||- (ptoTQ ptr Q) -> exists head, exists tail, exists prev, M ||- (ptr |->w head *^* ptr + 2 |->w tail *^* Queue Thread ptoTCB head tail prev 0 Q). Proof. intros. sep off. unfold ptoTQ , ptoQ in H. destruct H as [head [tail [prev H]]]. exists head; exists tail; exists prev. assumption. Qed. Implicit Arguments ptoTQ_elim [Q ptr M]. Lemma ptoTQ_elim1 : forall Q ptr M A, M ||- (ptoTQ ptr Q *^* A) -> exists head, exists tail, exists prev, M ||- (ptr |->w head *^* ptr + 2 |->w tail *^* Queue Thread ptoTCB head tail prev 0 Q *^* A). Proof. intros. destruct H as [M1 [M2 [Hdis [HQ HA]]]]. destruct (ptoTQ_elim HQ) as [head [tail [prev H]]]. exists head; exists tail; exists prev. exists M1;exists M2. intuition. Qed. Implicit Arguments ptoTQ_elim1 [Q ptr M A]. Lemma ptoTQ_intro : forall head tail prev Q ptr M, M ||- (ptr |->w head *^* ptr + 2 |->w tail *^* Queue Thread ptoTCB head tail prev 0 Q) -> M ||- (ptoTQ ptr Q ). Proof. unfold ptoTQ. unfold ptoQ. sep off. intros. exists head; exists tail; exists prev. assumption. Qed. Implicit Arguments ptoTQ_intro [head tail prev Q ptr M ]. Lemma ptoTQ_intro1 : forall head tail prev Q ptr M A, M ||- (ptr |->w head *^* ptr + 2 |->w tail *^* Queue Thread ptoTCB head tail prev 0 Q *^* A) -> M ||- (ptoTQ ptr Q *^* A). Proof. intros. destruct H as [M1 [M2 [Hdis [HQ HA]]]]. substH HQ with (ptoTQ_intro HQ). exists M1; exists M2;intuition. Qed. Implicit Arguments ptoTQ_intro1 [head tail prev Q ptr M A]. coq/SCAP/SCAP_READY.v0000644000107400000620000003165411000223235013441 0ustar shaosystems(* This is the SCAP for non-handler code *) Add LoadPath "..". Add LoadPath "../CAP0". Require Import Coqlib. Require Import Map. Require Import MultiMapT. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import Bool. Set Implicit Arguments. Unset Strict Implicit. Definition Prd_Itr_Stk (p : Pred) : Prop := forall S, p S -> itr_enabled S -> exists M1, exists M2, MemMod.disjUnion M1 M2 (S_Mem S) /\ stkSpacePrec (S_RF S SP) (IH_Stk + 6) M2 /\ (forall M2', stkSpacePrec (S_RF S SP) (IH_Stk + 6) M2' -> p (S_Mem_Upd S (MemMod.merge M1 M2')) ). (* Definition Grt_Itr_Stk (g : Grt) : Prop := *) (* forall S S', g S S' -> itr_enabled S *) (* -> exists M1, exists M2, MemMod.disjUnion M1 M2 (S_Mem S) *) (* /\ stkSpacePrec (S_RF S SP) (IH_Stk + 6) M2 *) (* /\ (forall M2', stkSpacePrec (S_RF S SP) (IH_Stk + 6) M2' *) (* -> g (S_Mem_Upd S (MemMod.merge M1 M2')) S'). *) (* This definition seems to be too strong *) (* should be the following: *) Definition Grt_Itr_Stk (g : Grt) : Prop := forall S S', g S S' -> itr_enabled S -> forall M1 M2 M2', MemMod.disjUnion M1 M2 (S_Mem S) -> stkSpacePrec (S_RF S SP) (IH_Stk + 6) M2 -> stkSpacePrec (S_RF S SP) (IH_Stk + 6) M2' -> g (S_Mem_Upd S (MemMod.merge M1 M2')) S'. (* the SCAP for non-handler & READY thread *) (* trashes the stack space _SW_Stk *) Definition gy : Grt := fun (S S' : State) => exists sp, prepost (mstar (mstar INV0 INV1) (stkSpacePrec sp _SW_Stk)) (mstar (mstar INV0 INV1) (stkSpacePrec sp _SW_Stk)) S S' /\ S_Flag S _IF = S_Flag S' _IF /\ S_ISR S = S_ISR S' /\ S_RF S SP = sp /\ S_RF S SP = S_RF S' SP. (* trashes the stack space _BLK_Stk *) Definition gblk (m : MPred) : Grt := fun (S S' : State) => exists sp, prepost (mstar (mstar INV0 INV1) (stkSpacePrec sp _BLK_Stk)) (mstar (mstar (mstar INV0 INV1) m) (stkSpacePrec sp _BLK_Stk)) S S' /\ S_Flag S _IF = S_Flag S' _IF /\ S_ISR S = S_ISR S' /\ S_RF S SP = sp /\ S_RF S SP = S_RF S' SP. Definition enable_sw (p : Pred) : Prop := forall S, p S -> (pmstar pTrue (mstar (mstar INV0 INV1) (stkSpacePrec (S_RF S SP) (_SW_Stk + 2)))) S. (* (* we need to ensure that the current thread is not IDLE *) Definition enable_blk (p : Pred) (wqa : WQassert): Prop := disj_PM p wqa (* probably not necessary, double check here *) /\ forall S, p S -> exists w, (Delta w = SomeT wqa) /\ (pmstar pTrue (mstar (ptoW (S_RF S SP) w) (mstar (mstar INV0 INV1) (stkSpacePrec (S_RF S SP) (_BLK_Stk + 2)) ) ) ) S. *) Definition enable_blk (w : nat) (wqa : WQassert) (S : State) : Prop := (Delta w = SomeT wqa) /\ (pTrue *<* ((S_RF S SP |->w w) *^* ((INV0 *^* INV1) *^* (stkSpacePrec (S_RF S SP) (_BLK_Stk + 2))))) S. (* trash all registers *) Definition gunblk (m : MPred) : Grt := fun (S S' : State) => exists sp, prepost (mstar (choice (S_RF S' AX = 0) Aemp m) (stkSpacePrec sp _UNBLK_Stk)) (stkSpacePrec sp _UNBLK_Stk) S S' /\ S_Flag S _IF = S_Flag S' _IF /\ S_ISR S = S_ISR S' /\ S_RF S SP = sp /\ S_RF S SP = S_RF S' SP. (* Definition enable_unblk (p : Pred) (wqa : WQassert) : Prop := forall S, p S -> exists w, (Delta w = SomeT wqa) /\ (pmstar pTrue (mstar (ptoW (S_RF S SP) w) (mstar wqa (stkSpacePrec (S_RF S SP) (_UNBLK_Stk + 2)) ) ) ) S. *) Definition enable_unblk (w : nat) (wqa : WQassert) (S : State) : Prop := (Delta w = SomeT wqa) /\ (pTrue *<* ((S_RF S SP |->w w) *^* (wqa *^* (stkSpacePrec (S_RF S SP) (_UNBLK_Stk + 2))))) S. Inductive NH_Call_Prim_aux (psi : SCAP_PSpec) (pc f: flab) (theta : Spec) : Prop := Call_SW : forall p p' g g' tag, (f = _SWITCH) -> theta = (Ast p g tag) -> SCAP_lookupCT psi (pc+1) (Ast p' g' tag) -> enable_sw p -> (forall pc', pimp (p |> (wrap_fun gy pc f pc')) p') -> (forall pc', gimp (p >o (wrap_fun gy pc f pc') oo g') g) -> NH_Call_Prim_aux psi pc f theta | Call_BLK : forall p p' g g' tag, (f = _BLOCK) -> theta = (Ast p g tag) -> SCAP_lookupCT psi (pc+1) (Ast p' g' tag) -> (forall S, p S -> exists w, exists wqa, (enable_blk w wqa S) /\ (forall pc', pimp ((wrap_fun (gblk wqa) pc f pc') S) p') /\ (forall pc', pimp (((wrap_fun (gblk wqa) pc f pc') S) |> g') (g S)) ) -> NH_Call_Prim_aux psi pc f theta | Call_UNBLK : forall p p' g g' tag, (f = _UNBLK) -> theta = (Ast p g tag) -> SCAP_lookupCT psi (pc+1) (Ast p' g' tag) -> (forall S, p S -> exists w, exists wqa, (enable_unblk w wqa S) /\ (forall pc', pimp ((wrap_fun (gunblk wqa) pc f pc') S) p') /\ (forall pc', pimp (((wrap_fun (gunblk wqa) pc f pc') S) |> g') (g S)) ) -> NH_Call_Prim_aux psi pc f theta. (* | Call_BLK : forall p p' g g' wqa tag, (f = _BLOCK) -> theta = (Ast p g tag) -> enable_blk p wqa -> (forall pc', pimp (p |> (wrap_fun (gblk wqa) pc f pc')) p') -> (forall pc', gimp (p >o (wrap_fun (gblk wqa) pc f pc') oo g') g) -> NH_Call_Prim_aux psi pc f theta -> SCAP_lookupCT psi (pc+1) (Ast p' g' tag) | Call_UNBLK : forall p p' g g' wqa tag, (f = _UNBLK) -> theta = (Ast p g tag) -> SCAP_lookupCT psi (pc+1) (Ast p' g' tag) -> enable_unblk p wqa -> (forall pc', pimp (p |> (wrap_fun (gunblk wqa) pc f pc')) p') -> (forall pc', gimp (p >o (wrap_fun (gunblk wqa) pc f pc') oo g') g) -> NH_Call_Prim_aux psi pc f theta. *) Definition NH_Call_Prim (psi : SCAP_PSpec) (pc f: flab) (theta : Spec) : Prop := match theta with Ast p g _ => (NH_Call_Prim_aux psi pc f theta) /\ (forall S, p S -> S_Flag S _IF = false) end. Definition gcli : Grt := fun (S S' : State) => prepost Aemp (choice (itr_enabled S) (mstar INV0 INV1) Aemp) S S' /\ (S_Flag S' _IF = false) /\ (S_ISR S = S_ISR S') /\ (S_RF S = S_RF S'). (* note that this definition is for non-handler code *) (* we always assume that ISR = false *) Definition gsti : Grt := fun (S S' : State) => prepost (choice (itr_enabled S) Aemp (mstar INV0 INV1)) Aemp S S' /\ (S_Flag S' _IF = true) /\ (S_ISR S = S_ISR S') /\ (S_RF S = S_RF S'). (* note that this definition is for non-handler code *) (* we always assume that ISR = false *) Definition enable_sti (p : Pred) : Prop := forall S, p S -> (pmstar pTrue (choice (itr_enabled S) Aemp (mstar INV0 INV1))) S. (* popfw *) Definition enable_popfw_sti (p : Pred) : Prop := forall M R fl isr, p (M,R,fl,isr) -> (mstar (leadsToxW (R SP)) (choice (fl _IF=true) Aemp (mstar INV0 INV1))) M. Definition stk_IF_st : Pred := fun (S : State) => exists flnum, leadsToW ((S_RF S) SP) flnum (S_Mem S) /\ nat2FR flnum _IF = true. Definition stk_IF_cl : Pred := fun (S : State) => exists flnum, leadsToW ((S_RF S) SP) flnum (S_Mem S) /\ nat2FR flnum _IF = false. Definition gpopfw_cli : Grt := fun (S S' : State) => prepost Aemp (choice (itr_enabled S) (mstar INV0 INV1) Aemp) S S' /\ (S_Flag S' _IF = false) /\ (S_ISR S = S_ISR S') /\ (S_RF S' = RF_update (S_RF S) SP ((S_RF S) SP +2)). Definition gpopfw_sti : Grt := fun (S S' : State) => prepost (choice (itr_enabled S) Aemp (mstar INV0 INV1)) Aemp S S' /\ (S_Flag S' _IF = true) /\ (S_ISR S = S_ISR S') /\ (S_RF S' = RF_update (S_RF S) SP ((S_RF S) SP +2)). Definition NH_Normal_Call (psi : SCAP_PSpec) (pc f : flab) (theta : Spec) := match theta with Ast p g tag => exists p', exists p'', exists g', exists g'', SCAP_lookupCT psi f (Ast p' g' 1) /\ SCAP_lookupCT psi (pc+1) (Ast p'' g'' tag) /\ enable p (nextS pc (comml (_call f))) /\ gimp ((sp_call_pred p pc f) >o g') fun_frame /\ pimp (p |> (nextS pc (comml (_call f)))) p' /\ (forall pc', pimp (p |> (wrap_fun g' pc f pc')) p'') /\ (forall pc', gimp (p >o (wrap_fun g' pc f pc') oo g'') g) end. Definition NH_WFcmd_aux (psi : SCAP_PSpec) (pc : flab) (theta : Spec) (c : comm) : Prop := match theta with Ast p g tag => match c with comms si => match si with _iret => False | _retw => (tag = 1) /\ (forall S, p S -> g S S) (* tag = 1 means this is not topmost fun *) | _jmp f => exists p', exists g', SCAP_lookupCT psi f (Ast p' g' tag) /\ pimp p p' /\ gimp (p >o g') g end | comml i => match i with _call f => (prim_entry f /\ NH_Call_Prim psi pc f theta) \/ (~ (prim_entry f) /\ NH_Normal_Call psi pc f theta) | _cli => exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ pimp (p |> gcli) p' /\ gimp (p >o gcli oo g') g | _sti => exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ enable_sti p /\ pimp (p |> gsti) p' /\ gimp (p >o gsti oo g') g | _outb_eoi => False | _pushfw => exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ enable p (nextS pc c) /\ pimp (p |> (nextS pc c)) p' /\ gimp (p >o (nextS pc c) oo g') g | _popfw => exists p', exists g', SCAP_lookupCT psi (pc+1) (Ast p' g' tag) /\ enable p (nextS pc c) /\ enable_popfw_sti (conjP p stk_IF_st) /\ pimp ((conjP p stk_IF_st) |> gpopfw_sti) p' /\ gimp ((conjP p stk_IF_st) >o gpopfw_sti oo g') g /\ pimp ((conjP p stk_IF_cl) |> gpopfw_cli) p' /\ gimp ((conjP p stk_IF_cl) >o gpopfw_cli oo g') g | _ => SCAP_WFcmd psi pc theta c end end end. Definition NH_WFcmd (psi : SCAP_PSpec) (pc : flab) (theta : Spec) (c : comm) : Prop := match theta with Ast p g tag => NH_WFcmd_aux psi pc theta c /\ (Prd_Itr_Stk p /\ Grt_Itr_Stk g) end. (* Definition NH_WFcmd (psi : SCAP_PSpec) (pc : flab) (theta : Spec) (c : comm) : Prop := *) (* match theta with *) (* Ast p g tag => *) (* NH_WFcmd_aux psi pc theta c /\ (Prd_Itr_Stk p /\ Grt_Itr_Stk g) *) (* end. *) Inductive NH_WFiseq : SCAP_PSpec -> flab -> Spec -> iseq -> Prop := nh_isq_seq : forall psi pc p p' g g' i isq tag, NH_WFcmd (SCAP_consCT (pc+1) (Ast p' g' tag) psi) pc (Ast p g tag) (comml i) -> NH_WFiseq psi (pc+1) (Ast p' g' tag) isq -> NH_WFiseq psi pc (Ast p g tag) (seq i isq) | nh_isq_end : forall psi pc p g si tag, NH_WFcmd psi pc (Ast p g tag) (comms si) -> NH_WFiseq psi pc (Ast p g tag) (sseq si). Definition NH_WFcdhp (psi : SCAP_PSpec) (C: CodeHeap) (psi' : SCAP_PSpec): Prop := forall f theta, SCAP_lookupCT psi' f theta -> exists isq, lookupC C f isq /\ NH_WFiseq psi f theta isq. Lemma Prd_Itr_Stk_equal : forall (p p' : Pred), (forall S, p' S -> p S) -> (forall S, p S -> p' S) -> Prd_Itr_Stk p -> Prd_Itr_Stk p'. Proof. unfold Prd_Itr_Stk. intros p p' Hp'p Hpp' Hp. intros S HS HIS. substH Hp with (Hp S (Hp'p _ HS) HIS). destruct Hp as [M1 [M2 [HJM [HM2 Hp]]]]. exists M1; exists M2; split_l; split_l. intros. apply Hpp'. auto. Qed. Lemma Grt_Itr_Stk_equal : forall (g g' : Grt), (forall S S', g S S' -> g' S S') -> (forall S S', g' S S' -> g S S') -> Grt_Itr_Stk g -> Grt_Itr_Stk g'. Proof. unfold Grt_Itr_Stk. intros g g' Hgg' Hg'g Hg. intros S S' HSS' HIS. intros M1 M2 M2' HJM HM2 HM2'. apply Hgg'. eapply Hg; eauto. Qed. coq/SCAP/Linking_Lemmas2.v0000644000107400000620000005460011000223235014736 0ustar shaosystemsAdd LoadPath "..". Add LoadPath "../CAP0". Require Import Arith. Require Import Coqlib. Require Import Map. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import CAP0. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import SCAP_READY. Require Import SCAP_IDLE. Require Import SCAP_Itr. Require Import EqNat. Require Import Linking. Lemma Prd_Itr_Stk_elim : forall Psi rho p g tag M R fl isr, Prd_Itr_Stk p -> itr_enabled (M, R, fl, isr) -> itp_NH_theta rho (Ast p g tag) Psi (M, R, fl, isr) -> stkSpace (R SP) (IH_Stk+6) M. Proof. intros Psi rho p g tag M R fl isr Hpstk Hen Hitp. unfold itp_NH_theta in Hitp. destruct Hitp as [Hisrf [Hp Hwfst]]. unfold NH_pinvstar, pmstar, mstar in Hp. destruct Hp as [M1 [M2 [HMJM [HpM1 HM2]]]]. unfold Prd_Itr_Stk in Hpstk. simplS in HpM1. substH Hpstk with (Hpstk _ HpM1). assert (H : itr_enabled (M1, R, fl, isr)). simplS in * ; auto. substH Hpstk with (Hpstk H); clear H. destruct Hpstk as [M11 [M12 [HJM1 [HM11 HM12]]]]. simplS in * . substH HM11 with (stkSpacePrec_stkSpace HM11). apply stkSpace_Mono with M1 M2; trivial. apply stkSpace_Mono with M12 M11; trivial. auto with PMap. Qed. Implicit Arguments Prd_Itr_Stk_elim [Psi rho p g tag M R fl isr]. Lemma NH_WFST_Mono_CT : forall rho Psi Psi' p, NH_WFST rho Psi p -> subsetCT Psi Psi' -> NH_WFST rho Psi' p. Proof. unfold NH_WFST, NH_WFST_aux; fold NH_WFST_aux. intros rho Psi Psi' p Hwfst Hsub. destruct Hwfst as [n Hwfst]. exists n. generalize p Hwfst; clear p Hwfst. induction n; simpl; intros p Hwfst. intros S' Hp. substH Hwfst with (Hwfst S' Hp). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hlk [Htag' Hwfst]]]]]]]. exists ra; split_l. exists p'; exists g'; exists tag'. split. apply Hsub; trivial. split_lr. simpl in * . intros S' Hp. substH Hwfst with (Hwfst S' Hp). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hlk Hwfst]]]]]]. exists ra; split_l. exists p'; exists g'; exists tag'. split. apply Hsub; trivial. intros pc S'' HnextS'. substH Hwfst with (Hwfst pc S'' HnextS'). destruct Hwfst as [Hp' Hg']. split_l. apply IHn; trivial. Qed. Implicit Arguments NH_WFST_Mono_CT [rho Psi Psi' p]. Lemma itp_NH_theta_Mono_CT : forall rho theta, Mono_CT_assert (itp_NH_theta rho theta). Proof. unfold Mono_CT_assert, itp_NH_theta. intros rho [p g tag] Psi S H Psi' Hsub. destruct H as [Hisr [Hp Hwfst]]. split_l. split_l. intros Htag. substH Hwfst with (Hwfst Htag). eapply NH_WFST_Mono_CT; eauto. Qed. Implicit Arguments itp_NH_theta_Mono_CT [rho theta]. Lemma itp_IH_theta_Mono_CT : forall theta status, Mono_CT_assert (itp_IH_theta theta status). Proof. unfold Mono_CT_assert, itp_IH_theta. intros [p g tag] status Psi S H Psi' Hsub. destruct H as [Hif [H | [Htag [Hp Hwfst]]]]. split_l. left. unfold lift_IH_PG in * . destruct H as [Htag [Hp H]]. split_l; split_l. intros S' Hg. substH H with (H S' Hg). destruct H as [S'' [HnextS' [ra [Hra [rho [theta [Hconsis2 [Hrho [Hlk H]]]]]]]]]. exists S''; split_l. exists ra; split_l. exists rho; exists theta; split_l. split. auto. split. apply Hsub; trivial. intros pc' S''' HnextS''. substH H with (H pc' S''' HnextS''). apply (itp_NH_theta_Mono_CT Psi S''' H Psi' Hsub). split_l. right. split_l. split_l. destruct Hwfst as [n Hwfst]. exists n. generalize g S Hwfst; clear Hif Htag Hp g S Hwfst. induction n; simpl; intros g S Hwfst. intros S' Hg. substH Hwfst with (Hwfst S' Hg). destruct Hwfst as [ra [Hra [theta' [Hlk Hwfst]]]]. exists ra; split_l. exists theta'. split. apply Hsub; trivial. intros pc' S'' HnextS'. substH Hwfst with (Hwfst pc' S'' HnextS'). destruct theta' as [p' g' tag']. unfold lift_IH_PG in * . destruct Hwfst as [Htag' [Hp' Hwfst]]. split_l; split_l. intros S''' Hg'. substH Hwfst with (Hwfst S''' Hg'). destruct Hwfst as [S'''' [HS'''' [ra' [Hra' [rho [theta'' [Hrho [Hconsis2 [Hlk'' Hwfst]]]]]]]]]. exists S''''; split_l. exists ra'; split_l. exists rho; exists theta''; split_l. split; auto. split. apply Hsub; trivial. intros pc'' Sx HnextS'''. substH Hwfst with (Hwfst pc'' Sx HnextS'''). apply (itp_NH_theta_Mono_CT Psi Sx Hwfst Psi' Hsub). intros S' Hg. substH Hwfst with (Hwfst S' Hg). destruct Hwfst as [ra [Hra [p' [g' [tag' [Hlk [Htag' Hwfst]]]]]]]. exists ra; split_l. exists p'; exists g'; exists tag'. split. apply Hsub; trivial. split_l. intros pc S'' HnextS'. substH Hwfst with (Hwfst pc S'' HnextS'). destruct Hwfst as [Hp' Hg']. split_l. apply IHn; trivial. Qed. Implicit Arguments itp_IH_theta_Mono_CT [theta]. (* changed by Xinyu, because of the change of WF_ReadyQ *) Lemma WF_ReadyQ_Mono_CT : forall Psi T RdyQ TM, WF_ReadyQ Psi T RdyQ TM -> forall Psi', subsetCT Psi Psi' -> WF_ReadyQ Psi' T RdyQ TM. Proof. intros. unfold WF_ReadyQ. intros tid Hindom. substH H with (H tid Hindom). destruct H as [tcb [Hmto [Htcb H]]]. destruct H as [M [HM [Htcbsp [Hth | Hih]]]]. exists tcb; split_l; split_l. exists M; split_l; split_l. left. destruct tcb as [[l status] pc]. unfold WF_Rdy_Thrd in * . destruct Hth as [rho [p [g [tag [Hrho [Hconsis [Hlds [Hlk Hth]]]]]]]]. exists rho; exists p; exists g; exists tag. split_l; split_l; split_l. split. apply H0; trivial. intros R fl Hsp Hfl. substH Hth with (Hth R fl Hsp Hfl). unfold pm_mwand in * . simplS in * . intros M1 M' HJM' HM1. substH Hth with (Hth M1 M' HJM' HM1). apply (itp_NH_theta_Mono_CT Psi (M', R, fl, false) Hth Psi' H0). exists tcb; split_l; split_l. exists M; split_l; split_l. right. destruct tcb as [[l status] pc]. unfold WF_Rdy_Thrd_IH in * . destruct Hih as [p [g [tag [Hlk [Hlds Hih]]]]]. exists p; exists g; exists tag. split. apply H0; trivial. split_l. intros R fl HR Hfl. substH Hih with (Hih R fl HR Hfl). unfold pm_mwand in * . intros M1 M' HJM' HM1. substH Hih with (Hih M1 M' HJM' HM1). apply (itp_IH_theta_Mono_CT status Psi (S_Mem_Upd (M, R, fl, false) M') Hih Psi' H0). Qed. Lemma WF_WQSet_Mono_CT : forall Psi T Bset TM, WF_WQSet Psi T Bset TM -> forall Psi', subsetCT Psi Psi' -> WF_WQSet Psi' T Bset TM. Proof. intros Psi T Bset TM H Psi' Hsub. unfold WF_WQSet in * . intros l Q tid Hmapsto Hindom. substH H with (H l Q tid Hmapsto Hindom). clear Hmapsto Hindom. destruct H as [tcb [M [Htcb [HM Hl]]]]. exists tcb; exists M. split_l; split_l. destruct tcb as [[id status] pc]. unfold WF_Wait_Thrd in * . destruct Hl as [Hst [HidM Hl]]. destruct Hl as [wqa [Hwqa [p [g [tag [Hlk H]]]]]]. split_l; split_l. exists wqa; split_l. exists p; exists g; exists tag. split. apply Hsub; trivial. intros R fl HR Hfl. substH H with (H R fl HR Hfl). unfold pm_mwand in * . intros M1 M' HJM' HM1. substH H with (H M1 M' HJM' HM1). apply (itp_NH_theta_Mono_CT Psi (S_Mem_Upd (M, R, fl, false) M') H Psi' Hsub). Qed. Lemma Itp_AIM_Mono_CT : forall rho theta, Mono_CT_assert (Itp_AIM rho theta). Proof. unfold Mono_CT_assert, Itp_AIM. intros rho [p g tag] Psi S H Psi' Hsub. destruct S as [[[M R] fl] isr]. destruct H as [T [B [RdyQ [tid H]]]]. exists T; exists B; exists RdyQ; exists tid. unfold pmstar in * . destruct H as [M1 [M2 [HJM H]]]. destruct H as [H1 H2]. exists M1; exists M2; split_l; split_r. simplS in * . clear M M2 HJM H2. unfold WF_AIM_World in * . simplS in * . destruct H1 as [H1 [H2 [H3 [H4 H]]]]. split_l; split_l; split_l; split_l. clear H1 H2 H3 H4. destruct H as [TM [Mcth [HSplit [HTM [H1 [H2 H]]]]]]. exists TM; exists Mcth; split_l; split_l. clear HSplit HTM. split. unfold WF_Curr_Thrd in * . destruct (beq_nat rho rho_ih). InvertAll. exists x. exists x0. split_l. split_l. apply (itp_IH_theta_Mono_CT x0 Psi (Mcth, R, fl, isr) H4 Psi' Hsub). apply (itp_NH_theta_Mono_CT Psi (Mcth, R, fl, isr) H1 Psi' Hsub). split. clear rho p g tag R fl isr B M1 Mcth H1 H. eapply WF_ReadyQ_Mono_CT; eauto. clear p g tag R fl isr RdyQ M1 H1 H2. eapply WF_WQSet_Mono_CT; eauto. Qed. Implicit Arguments Itp_AIM_Mono_CT [rho theta]. Lemma itp_NH_theta_Mono_CT_consCT : forall f theta0 Psi rho theta S, itp_NH_theta rho theta Psi S -> itp_NH_theta rho theta (consCT f theta0 Psi) S. Proof. intros. assert (Hsub : subsetCT Psi (consCT f theta0 Psi)). auto. apply (itp_NH_theta_Mono_CT Psi S H _ Hsub). Qed. Lemma itp_IH_theta_Mono_CT_consCT : forall f theta0 status Psi theta S, itp_IH_theta theta status Psi S -> itp_IH_theta theta status (consCT f theta0 Psi) S. Proof. intros. assert (Hsub : subsetCT Psi (consCT f theta0 Psi)). auto. apply (itp_IH_theta_Mono_CT status Psi S H _ Hsub). Qed. Lemma WF_ReadyQ_Mono_CT_consCT : forall f theta0 Psi T RdyQ TM, WF_ReadyQ Psi T RdyQ TM -> WF_ReadyQ (consCT f theta0 Psi) T RdyQ TM. Proof. intros. assert (Hsub : subsetCT Psi (consCT f theta0 Psi)). auto. eapply WF_ReadyQ_Mono_CT; eauto. Qed. Lemma WF_WQSet_Mono_CT_consCT : forall f theta0 Psi T Bset TM, WF_WQSet Psi T Bset TM -> WF_WQSet (consCT f theta0 Psi) T Bset TM. Proof. intros. assert (Hsub : subsetCT Psi (consCT f theta0 Psi)). auto. eapply WF_WQSet_Mono_CT; eauto. Qed. Lemma memsplit_thrd_remove: forall tm m, MemSplit tm m -> forall tid m', ThrdMemMod.maps_to tm tid m' -> exists m'', MemMod.disjUnion m'' m' m /\ MemSplit (ThrdMemMod.remove tm tid) m''. Proof. intros tm m H. induction H. intros. unfold ThrdMemMod.maps_to in H. unfold ThrdMemMod.emp in H. inversion H. intros. unfold ThrdMemMod.maps_to in H2. unfold ThrdMemMod.put in H2. induction (ThrdMemMod.beq_A tid0 tid). assert (M'' = m'). inversion_clear H2; auto. rewrite H3 in H. exists M'. split; auto. rewrite a. assert (ThrdMemMod.remove (ThrdMemMod.put TM tid M'') tid = ThrdMemMod.remove TM tid). auto with PMap. rewrite H4. assert (TM = ThrdMemMod.remove TM tid). auto with PMap. rewrite <- H5. auto. assert (exists m'', MemMod.disjUnion m'' m' M' /\ MemSplit (ThrdMemMod.remove TM tid0) m''). apply IHMemSplit. unfold ThrdMemMod.maps_to. auto. InvertAll. exists (MemMod.merge x M''). assert (MemMod.disjUnion m' (MemMod.merge x M'') M). apply MemMod.disjUnion_assoc_left_right. unfold MemMod.disjUnion in H3. inversion_clear H3. auto with PMap. unfold MemMod.disjUnion in H3. inversion_clear H3. assert (MemMod.merge x m' = MemMod.merge m' x). auto with PMap. rewrite <- H3. rewrite <- H6. auto. split. auto with PMap. assert (tid <> tid0). auto. assert (ThrdMemMod.remove (ThrdMemMod.put TM tid M'') tid0 = ThrdMemMod.put (ThrdMemMod.remove TM tid0) tid M''). auto with PMap. rewrite H7. apply MS_split with x; auto. unfold MemMod.disjUnion. split; auto. unfold MemMod.disjUnion in H. inversion_clear H. unfold MemMod.disjUnion in H3. inversion_clear H3. rewrite H10 in H8. apply MemMod.disj_merge_disj_left with m'; auto. auto with PMap. Qed. Lemma MemSplit_Inv : forall TM M Mc tid, MemSplit TM M -> ThrdMemMod.maps_to TM tid Mc -> exists Mo, MemMod.disjUnion Mc Mo M /\ MemSplit (ThrdMemMod.remove TM tid) Mo. Proof. intros. destruct (memsplit_thrd_remove _ _ H tid Mc H0). destruct H1. exists x. split_r. auto with PMap. Qed. Implicit Arguments MemSplit_Inv [TM M Mc tid]. Lemma nextS_DMono2 : forall pc c tid Mcth TM Mth Mq M M' R fl isr R' fl' isr' S0, ThrdMemMod.maps_to TM tid Mcth -> MemSplit TM Mth -> MemMod.disjUnion Mth Mq M -> nextS pc c (Mcth, R, fl, isr) S0 -> nextS pc c (M, R, fl, isr) (M', R', fl', isr') -> exists Mcth', exists Mth', exists TM', ThrdMemMod.maps_to TM' tid Mcth' /\ MemSplit TM' Mth' /\ MemMod.disjUnion Mth' Mq M' /\ nextS pc c (Mcth, R, fl, isr) (Mcth', R', fl', isr') /\ (forall tidx Mx, tidx <> tid -> ThrdMemMod.maps_to TM tidx Mx -> ThrdMemMod.maps_to TM' tidx Mx). Proof. intros pc c tid Mcth TM Mth Mq M M'. intros R fl isr R' fl' isr' S0. intros HtoMcth HsplitTM HJM HnextS0 HnextS. destruct S0 as [[[M0 R0] fl0] isr0]. destruct (MemSplit_Inv HsplitTM HtoMcth) as [Moth [HJMth HsplitMoth]]. assert (Hx : MemMod.disjUnion Mcth (MemMod.merge Moth Mq) M). destruct (@disjUnion_assoc_l Mcth Moth Mq Mth (MemMod.merge Moth Mq) M) as [HJMcth2Mo HJMth']; trivial. assert (exists Mcth' : MemMod.Map, MemMod.disjUnion Mcth' (MemMod.merge Moth Mq) M' /\ nextS pc c (Mcth, R, fl, isr) (Mcth', R', fl', isr')). eapply (nextS_DMono Hx HnextS0 HnextS); eauto. destruct H as [Mcth' [HJM' HnextS1]]. clear M0 R0 fl0 isr0 HnextS0. exists Mcth'. exists (MemMod.merge Mcth' Moth). exists (ThrdMemMod.put TM tid Mcth'). assert (HeqMcth : MemMod.eqDom Mcth Mcth'). eapply nextS_eqDom; eauto. split_l. split. assert (H : MemSplit (ThrdMemMod.put (ThrdMemMod.remove TM tid) tid Mcth') (MemMod.merge Mcth' Moth)). apply (MS_split (MemMod.merge Mcth' Moth) Moth Mcth' (ThrdMemMod.remove TM tid) tid); auto with PMap. apply MemMod.disjUnion_commut. eapply disjUnion_upd_left_disjUnion; eauto. assert (Hy : ThrdMemMod.put (ThrdMemMod.remove TM tid) tid Mcth' = ThrdMemMod.put TM tid Mcth'). auto with PMap. rewrite Hy in H; trivial. split. assert (H3 : MemMod.eqDom Mcth Mcth'). eauto with PMap. set (Mth' := (MemMod.merge Mcth' Moth)). assert (HJMth' : MemMod.disjUnion Mcth' Moth Mth'). split_r. destruct HJMth. eauto with PMap. assert (H4 : MemMod.eqDom Mth Mth'). eauto with PMap. split. destruct HJM. eauto with PMap. destruct HJM'. unfold Mth'. subst M'. rewrite MemMod.merge_assoc; trivial. split_l. intros. unfold ThrdMemMod.maps_to, ThrdMemMod.put in H0 |- * . destruct (ThrdMemMod.beq_A tidx tid). destruct (H e). trivial. Qed. Implicit Arguments nextS_DMono2 [pc c tid Mcth TM Mth Mq M M' R fl isr R' fl' isr' S0]. Lemma nextS_Mono2 : forall Mcth TM tid Mth Mq M Mcth' pc c R fl isr R' fl' isr', MemSplit TM Mth -> MemMod.disjUnion Mth Mq M -> ThrdMemMod.maps_to TM tid Mcth -> nextS pc c (Mcth, R, fl, isr) (Mcth', R', fl', isr') -> exists M', nextS pc c (M, R, fl, isr) (M', R', fl', isr'). Proof. intros Mcth TM tid Mth Mq M Mcth' pc c R fl isr R' fl' isr'. intros Hsplit HJM Htid HnextS. destruct (MemSplit_Inv Hsplit Htid) as [Moth [HJMth _]]. assert (Hx : MemMod.disjUnion Mcth (MemMod.merge Moth Mq) M). destruct (@disjUnion_assoc_l Mcth Moth Mq Mth (MemMod.merge Moth Mq) M) as [HJMcth2Mo HJMth']; trivial. destruct (nextS_Mono Hx HnextS) as [M' [_ Hy]]. exists M'; trivial. Qed. Implicit Arguments nextS_Mono2 [Mcth TM tid Mth Mq M Mcth' pc c R fl isr R' fl' isr']. Lemma NH_WFST_aux_strengthen : forall rho n Psi S0 g S1 g', NH_WFST_aux rho n Psi (NH_ItpG g S0) -> pimp (NH_ItpG g' S1) (NH_ItpG g S0) -> NH_WFST_aux rho n Psi (NH_ItpG g' S1). Proof. destruct n; simpl in * ; intros. apply H. apply H0; trivial. apply H. apply H0; trivial. Qed. Implicit Arguments NH_WFST_aux_strengthen [rho n Psi S0 g S1 g']. Lemma NH_WFST_strengthen : forall rho Psi S0 g S1 g', NH_WFST rho Psi (NH_ItpG g S0) -> pimp (NH_ItpG g' S1) (NH_ItpG g S0) -> NH_WFST rho Psi (NH_ItpG g' S1). Proof. unfold NH_WFST; intros. destruct H. exists x. eapply NH_WFST_aux_strengthen; eauto. Qed. Implicit Arguments NH_WFST_strengthen [rho Psi S0 g S1 g']. Lemma IH_WFST_strengthen : forall n Psi S0 g S1 g' status, IH_WFST n Psi (IH_ItpG g S0) status -> pimp (IH_ItpG g' S1) (IH_ItpG g S0) -> IH_WFST n Psi (IH_ItpG g' S1) status. Proof. unfold IH_WFST. destruct n; simpl in * ; intros. apply H. apply H0; trivial. apply H. apply H0; trivial. Qed. Implicit Arguments IH_WFST_strengthen [n Psi S0 g S1 g' status]. Lemma WF_CurrTID_nh_ih : forall tid T B RdyQ rho, WF_currTID tid T B RdyQ rho -> WF_currTID tid T B RdyQ rho_ih. Proof. unfold WF_currTID; intros tid T B RdyQ rho H. destruct H as [HB [HRQ [HT [tcb [Hmto [Htcb Hrho]]]]]]. split_l; split_l; split_l. exists tcb; split_l; split_l. unfold rho_tcb_consistent. split; intro H; discriminate H. Qed. Implicit Arguments WF_CurrTID_nh_ih [tid T B RdyQ rho]. Lemma WF_CurrTID_ih_nh : forall tid tcb T B RdyQ rho status, WF_currTID tid T B RdyQ rho_ih -> TQMod.maps_to T tid tcb -> TCB_Status tcb = status -> rho = rho_ready \/ rho = rho_idle -> rho_tcb_consistent2 status rho -> WF_currTID tid T B RdyQ rho. Proof. unfold WF_currTID; intros tid tcb T B RdyQ rho status H Hmto Htcb Hrho Hst. destruct H as [HB [HRQ [HT [tcb' [Hmto' [Htcb' H]]]]]]. assert (tcb' = tcb). unfold TQMod.maps_to in * . rewrite Hmto' in Hmto. injection Hmto; auto. subst tcb'; clear Hmto' Htcb'. destruct H. unfold rho_tcb_consistent2 in Hst. destruct Hst. subst status. split_l; split_l; split_l. exists tcb; split_l. split. destruct Hrho; auto. unfold rho_tcb_consistent. destruct Hrho as [Hrho | Hrho]; subst rho; split; intro; auto. Qed. Implicit Arguments WF_CurrTID_ih_nh [tid tcb T B RdyQ rho status]. (* chaged by Xinyu : added rho because of the change of WF_currTID and WF_ReadyQ *) Lemma WF_ReadyQ_untouch : forall Psi T RdyQ TM TM' tid Bset rho, WF_ReadyQ Psi T RdyQ TM -> (forall tidx Mx, tidx <> tid -> ThrdMemMod.maps_to TM tidx Mx -> ThrdMemMod.maps_to TM' tidx Mx) -> WF_currTID tid T Bset RdyQ rho -> WF_ReadyQ Psi T RdyQ TM'. Proof. unfold WF_ReadyQ, WF_currTID. intros. substH H with (H tid0 H2). destruct H as [tcb [Hmto [Htcb [M [HmtoM [Htcbsp Hih]]]]]]. exists tcb; split_l; split_l. exists M. split. apply H0; trivial. destruct H1. destruct H1. intro Hf. unfold WQMod.not_in_dom in H1. unfold WQMod.in_dom in H2. destruct H2. subst tid0. rewrite H1 in H2. discriminate H2. split_lr. Qed. Implicit Arguments WF_ReadyQ_untouch [Psi T RdyQ TM TM' tid Bset rho]. (* changed by Xinyu *) Lemma WF_WQSet_untouch : forall Psi T Bset RdyQ TM TM' tid rho, WF_WQSet Psi T Bset TM -> (forall tidx Mx, tidx <> tid -> ThrdMemMod.maps_to TM tidx Mx -> ThrdMemMod.maps_to TM' tidx Mx) -> WF_currTID tid T Bset RdyQ rho -> WF_WQSet Psi T Bset TM'. Proof. unfold WF_WQSet, WF_currTID. intros. substH H with (H l Q tid0 H2 H3). destruct H as [tcb [M [H4 [H5 H6]]]]. exists tcb; exists M; split_l. split_r. destruct H1. destruct H1. apply H0; trivial. intro Hf. subst tid0. unfold unblocked in H. unfold WQMod.not_in_dom in H. unfold WQMod.in_dom in H3. destruct H3. rewrite (H _ _ H2) in H3. discriminate H3. Qed. Implicit Arguments WF_WQSet_untouch [Psi T Bset RdyQ TM TM' tid rho]. Lemma itr_nextS_Mono2 : forall Mcth TM tid Mth Mq M pc R fl isr Mcth' R' fl' isr', MemSplit TM Mth -> MemMod.disjUnion Mth Mq M -> ThrdMemMod.maps_to TM tid Mcth -> itr_nextS pc (Mcth, R, fl, isr) (Mcth', R', fl', isr') -> exists M', itr_nextS pc (M, R, fl, isr) (M', R', fl', isr'). Proof. intros Mcth TM tid Mth Mq M pc R fl isr Mcth' R' fl' isr'. intros Hsplit HJM Htid HnextS. destruct (MemSplit_Inv Hsplit Htid) as [Moth [HJMth _]]. assert (Hx : MemMod.disjUnion Mcth (MemMod.merge Moth Mq) M). destruct (@disjUnion_assoc_l Mcth Moth Mq Mth (MemMod.merge Moth Mq) M) as [HJMcth2Mo HJMth']; trivial. destruct (itr_nextS_Mono Hx HnextS) as [M' [_ Hy]]. exists M'; trivial. Qed. Implicit Arguments itr_nextS_Mono2 [Mcth TM tid Mth Mq M pc R fl isr Mcth' R' fl' isr']. Lemma itr_nextS_DMono2 : forall pc tid Mcth TM Mth Mq M M' R fl isr R' fl' isr', ThrdMemMod.maps_to TM tid Mcth -> MemSplit TM Mth -> MemMod.disjUnion Mth Mq M -> stkSpace (R SP) (IH_Stk+6) Mcth -> itr_nextS pc (M, R, fl, isr) (M', R', fl', isr') -> exists Mcth', exists Mth', exists TM', ThrdMemMod.maps_to TM' tid Mcth' /\ MemSplit TM' Mth' /\ MemMod.disjUnion Mth' Mq M' /\ itr_nextS pc (Mcth, R, fl, isr) (Mcth', R', fl', isr') /\ (forall tidx Mx, tidx <> tid -> ThrdMemMod.maps_to TM tidx Mx -> ThrdMemMod.maps_to TM' tidx Mx). Proof. intros pc tid Mcth TM Mth Mq M M'. intros R fl isr R' fl' isr'. intros HtoMcth HsplitTM HJM Hstk HnextS. destruct (MemSplit_Inv HsplitTM HtoMcth) as [Moth [HJMth HsplitMoth]]. assert (Hx : MemMod.disjUnion Mcth (MemMod.merge Moth Mq) M). destruct (@disjUnion_assoc_l Mcth Moth Mq Mth (MemMod.merge Moth Mq) M) as [HJMcth2Mo HJMth']; trivial. assert (Hstk' : stkSpace (R SP) 6 Mcth). eapply stkSpace_weaken;eauto. omega. assert (exists Mcth' : MemMod.Map, MemMod.disjUnion Mcth' (MemMod.merge Moth Mq) M' /\ itr_nextS pc (Mcth, R, fl, isr) (Mcth', R', fl', isr')). eapply (itr_nextS_DMono Hx Hstk' HnextS); eauto. destruct H as [Mcth' [HJM' HnextS1]]. exists Mcth'. exists (MemMod.merge Mcth' Moth). exists (ThrdMemMod.put TM tid Mcth'). assert (HeqMcth : MemMod.eqDom Mcth Mcth'). eapply itr_nextS_eqDom; eauto. split_l. split. assert (H : MemSplit (ThrdMemMod.put (ThrdMemMod.remove TM tid) tid Mcth') (MemMod.merge Mcth' Moth)). apply (MS_split (MemMod.merge Mcth' Moth) Moth Mcth' (ThrdMemMod.remove TM tid) tid); auto with PMap. apply MemMod.disjUnion_commut. eapply disjUnion_upd_left_disjUnion; eauto. assert (Hy : ThrdMemMod.put (ThrdMemMod.remove TM tid) tid Mcth' = ThrdMemMod.put TM tid Mcth'). auto with PMap. rewrite Hy in H; trivial. split. assert (H3 : MemMod.eqDom Mcth Mcth'). eauto with PMap. set (Mth' := (MemMod.merge Mcth' Moth)). assert (HJMth' : MemMod.disjUnion Mcth' Moth Mth'). split_r. destruct HJMth. eauto with PMap. assert (H4 : MemMod.eqDom Mth Mth'). eauto with PMap. split. destruct HJM. eauto with PMap. destruct HJM'. unfold Mth'. subst M'. rewrite MemMod.merge_assoc; trivial. split_l. intros. unfold ThrdMemMod.maps_to, ThrdMemMod.put in H0 |- * . destruct (ThrdMemMod.beq_A tidx tid). destruct (H e). trivial. Qed. Implicit Arguments itr_nextS_DMono2 [pc tid Mcth TM Mth Mq M M' R fl isr R' fl' isr']. Lemma Ret_Addr_Mono : forall f M1 M2 M R fl isr, MemMod.disjUnion M1 M2 M -> Ret_Addr f (M1, R, fl, isr) -> Ret_Addr f (M, R, fl, isr). Proof. unfold Ret_Addr; intros. substH H0 with (H0 pc). inversion_clear H0. apply nextPC_retw with sp; trivial. eapply leadsToW_Mono; eauto. Qed. Implicit Arguments Ret_Addr_Mono [f M1 M2 M R fl isr]. coq/Coqlib.v0000644000107400000620000001510011000242601012434 0ustar shaosystems(***************************************************************) (* Basci Coq lib *) (***************************************************************) Require Import Bool. (** Section 1: optionT and pairT **) Axiom extensionality: forall (A B: Set) (f g : A -> B), (forall x, f x = g x) -> f = g. Inductive OptionT (T : Type) : Type := NoneT1 : OptionT T | SomeT1 : T -> OptionT T. Inductive optionT (A : Type) : Type := | SomeT : A -> optionT A | NoneT : optionT A. Implicit Arguments SomeT [A]. Implicit Arguments NoneT [A]. Notation opt_predT := (fun opt:optionT _ => fun f => match opt with | SomeT t => f t | NoneT => False end). Notation optpT := (fun f => fun opt:optionT _ => match opt with | SomeT t => f t | NoneT => False end). Notation optgT := (fun f => fun opt:optionT _ => fun t' => match opt with | SomeT t => f t t' | NoneT => False end). Notation opt_predT2 := (fun opt:optionT _ => fun opt':optionT _ => fun f => match opt, opt' with | SomeT t, SomeT t' => f t t' | _, _ => False end). Inductive prodT (A : Set) (B : Type) : Type := pairT : A -> B -> prodT A B. Implicit Arguments pairT [A B]. Notation "( x , y , .. , z )" := (pairT .. (pairT x y) .. z) : t_type_scope. (** Section 2: Tactics **) (***************************************************************) Ltac hypreplace H y := let H' := fresh in (assert (H' := y); try (clear H; rename H' into H)). Ltac hypreplace2 H y Hn:= let H' := fresh in (assert (H' := y); try (clear H; rename H' into Hn)). Tactic Notation "substH" hyp (H) := match goal with | |- ?a -> ?b => clear H; intro H | |- _ => fail 1 "goal must be 'A -> B'." end. Tactic Notation "substH" hyp (H) "with" constr (t) := hypreplace H t. Tactic Notation "substH" hyp (H) "with" constr (t) "into" ident (Hn) := hypreplace2 H t Hn. Tactic Notation "bool_destruct" hyp (H) "as" simple_intropattern (pat) := let H0 := fresh "H" in (rename H into H0; match type of (H0) with | (andb ?a ?b = true) => destruct (andb_prop a b H0) as pat; clear H0 | (orb ?a ?b = true) => destruct (orb_prop a b H0) as pat; clear H0 | _ => fail "not destructable" end). Tactic Notation "destructH" hyp (H) "with" constr (t) := destruct t; clear H. Tactic Notation "destructH" hyp (H) "with" constr (t) "as" simple_intropattern (p) := destruct t as p; clear H. Tactic Notation "discri" := match goal with | H : ?a <> ?a |- _ => elimtype False; apply H; reflexivity | |- _ -> _ => intros; discriminate | H : False |- _ => destruct H | _ => discriminate end. Tactic Notation "gen_clear" hyp (H) := generalize H; clear H. Tactic Notation "gen_clear" hyp (H1) hyp (H2) := generalize H1 H2; clear H1 H2. Tactic Notation "gen_clear" hyp (H1) hyp (H2) hyp (H3) := generalize H1 H2 H3; clear H1 H2 H3. Tactic Notation "gen_clear" hyp (H1) hyp (H2) hyp (H3) hyp (H4) := generalize H1 H2 H3 H4; clear H1 H2 H3 H4. Tactic Notation "gen_clear" hyp (H1) hyp (H2) hyp (H3) hyp (H4) hyp (H5):= generalize H1 H2 H3 H4 H5; clear H1 H2 H3 H4 H5. Tactic Notation "gen_clear" hyp (H1) hyp (H2) hyp (H3) hyp (H4) hyp (H5) hyp (H6):= generalize H1 H2 H3 H4 H5 H6; clear H1 H2 H3 H4 H5 H6. Tactic Notation "split_l" := split; [trivial | idtac]. Tactic Notation "split_r" := split; [idtac | trivial ]. Tactic Notation "split_lr" := split; [trivial | trivial ]. Tactic Notation "split_l" "with" constr (t) := split; [apply t | idtac]. Tactic Notation "split_r" "with" constr (t) := split; [idtac | apply t ]. Tactic Notation "split_l" "by" tactic (tac) := split; [tac | idtac ]. Tactic Notation "split_r" "by" tactic (tac) := split; [idtac | tac ]. Tactic Notation "split_l_clear" "with" hyp (H) := split; [apply H | clear H]. Tactic Notation "split_r_clear" "with" hyp (H) := split; [clear H | apply H ]. Lemma and_sym : forall (A B : Prop), A /\ B -> B /\ A. Proof. intros A B [HA HB]; split; trivial. Qed. Implicit Arguments and_sym [A B]. Ltac rsplit := apply and_sym; split. Lemma and_sym_rr : forall A B C : Prop, A /\ B /\ C -> B /\ C /\ A. Proof. tauto. Qed. Ltac rrsplit := apply and_sym_rr; split. Tactic Notation "inj_hyp" hyp (H) := injection H; clear H; intro H. Tactic Notation "rew_clear" hyp (H) := rewrite H; clear H. Tactic Notation "injection" hyp (H) := injection H. Tactic Notation "injection" hyp (H) "as" simple_intropattern (pat) := injection H; intros pat. Tactic Notation "injsubst" ident (id) "in" hyp (H) := injection H; intro; subst id; clear H. Ltac InvertAll := repeat match goal with | H: _ /\ _ |- _ => inversion_clear H | H: ex _ |- _ => inversion_clear H end. Ltac arith_replace t1 t2 := (replace t1 with t2; fail "error") || (replace t1 with t2; [trivial | try omega; fail "error" ]). Ltac arith_replaceH H t1 t2 := (replace t1 with t2 in H; fail "error") || (replace t1 with t2 in H; [trivial | try omega; fail "error" ]). Tactic Notation "arith_rep" constr(t1) "with" constr (t2) := arith_replace t1 t2. Tactic Notation "arith_rep" constr(t1) "with" constr (t2) "in" hyp (H):= arith_replaceH H t1 t2. Ltac clearall := match goal with | H : _ |- _ => (clear H || (generalize H; clear H)); clearall | _ => intros end. Ltac clearall_arith := match goal with | H : ?a > ?b |- _ => (generalize H; clear H); clearall_arith | H : ?a >= ?b |- _ => (generalize H; clear H); clearall_arith | H : ?a < ?b |- _ => (generalize H; clear H); clearall_arith | H : ?a <= ?b |- _ => (generalize H; clear H); clearall_arith | H : ?a = ?b |- _ => match type of a with | nat => (generalize H; clear H); clearall_arith | _ => (clear H || (generalize H; clear H)); clearall_arith end | H : _ |- _ => (clear H || (generalize H; clear H)); clearall_arith | _ => intros end. (* *********************************************************************** *) (** * The [skip] tactic from Stephanie Weirich and Brian Andemir of UPenn *) (** The [skip] tactic will prove any goal, since we assert below that [False] is provable. This is a useful technique for skipping over troublesome parts of proofs. In a complete development, one would comment out the [skip] axiom and tactic. In the exercises below, [skip] lets us give partial proofs by using it as a placeholder for locations in the proof script where the reader should fill in the proof. *) coq/Assertion_Lemmas.v0000644000107400000620000002076211000223177014511 0ustar shaosystemsRequire Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Assertion. Require Export Assertion_Lemmas3. Require Import Omega. Set Implicit Arguments. Unset Strict Implicit. (******************************************) (* Lemmas about logic assertions *) (******************************************) Lemma weaken_presv_pmstar_m : forall (p: Pred) (m m': MPred) (S: State), (p *<* m) S -> (forall H, m H -> m' H) -> (p *<* m') S. Proof. intros. unfold pmstar. unfold pmstar in H. InvertAll. exists x. exists x0. split; auto. Qed. Lemma weaken_presv_pmstar_p : forall (p p' : Pred) (m : MPred) (S : State), (p *<* m) S -> (forall S, p S -> p' S) -> (p' *<* m) S. Proof. intros. unfold pmstar. unfold pmstar in H. InvertAll. exists x. exists x0. split; auto. Qed. Lemma mtrue_weakest : forall m H, m H -> mTrue H. Proof. intros. unfold mTrue. auto. Qed. Lemma pmstar_imprec_p : forall p m S, (p *<* m) S -> imprec p S. Proof. intros. unfold imprec. apply weaken_presv_pmstar_m with m; auto. apply mtrue_weakest. Qed. Lemma imprec_presv_imprec : forall (p p' : Pred), (forall S, p S -> imprec p' S) -> (forall S, imprec p S -> imprec p' S). Proof. intros. unfold imprec in H0. unfold pmstar in H0. InvertAll. assert (MemMod.subseteq x (S_Mem S)). eauto with PMap. induction S. induction a. induction a. apply imprec_monotone with x. apply H; auto. unfold S_Mem in H2. auto. Qed. Lemma imprec_monotone_S : forall (p : Pred) (S : State) (M : Mem), imprec p (S_Mem_Upd S M) -> MemMod.subseteq M (S_Mem S) -> imprec p S. Proof. intros. induction S. induction a. induction a. apply imprec_monotone with M; auto. Qed. Definition monotonic_p (p : Pred) : Prop := forall S M, p S -> MemMod.subseteq (S_Mem S) M -> p (S_Mem_Upd S M). Lemma S_Mem_Upd_discard_interm: forall S x, S = S_Mem_Upd (S_Mem_Upd S x) (S_Mem S). Proof. intros. induction S. induction a. induction a. UnfoldStateAll. auto. Qed. Hint Resolve S_Mem_Upd_discard_interm. Lemma S_Mem_Upd_cancel: forall S x, x = S_Mem (S_Mem_Upd S x). Proof. intros. UnfoldStateAll. auto. Qed. Hint Resolve S_Mem_Upd_cancel. Lemma imprec_presv_imp_monotonic: forall (p q : Pred) , monotonic_p q -> (forall S, p S -> q S) -> (forall S, imprec p S -> q S). Proof. intros. unfold imprec in H1. unfold pmstar in H1. InvertAll. assert (MemMod.subseteq x (S_Mem S)). eauto with PMap. assert (q (S_Mem_Upd S x)). apply H0; auto. unfold monotonic_p in H. assert (S = (S_Mem_Upd (S_Mem_Upd S x) (S_Mem S))). apply S_Mem_Upd_discard_interm. rewrite H6. apply H. auto. assert (x = S_Mem (S_Mem_Upd S x)). apply S_Mem_Upd_cancel. rewrite <- H7. auto. Qed. Lemma pTrue_m_mTrue : forall p m S, (p *<*m) S -> (m *^* mTrue) (S_Mem S). Proof. intros. induction S. induction a. induction a. unfold pmstar in H. unfold mstar. InvertAll. exists x0. exists x. UnfoldStateAll. split. auto with PMap. split; auto. unfold mTrue. auto. Qed. Definition leqvM (m m' : MPred) := forall h, m h <-> m' h. Lemma leqvM_reflex : forall m, leqvM m m. Proof. unfold leqvM. intros. split; auto. Qed. Hint Resolve leqvM_reflex. Lemma leqvM_commut : forall m m', leqvM m m' -> leqvM m' m. Proof. intros m m'. unfold leqvM. intros. assert (m h <-> m' h). apply H. inversion_clear H0. split; auto. Qed. Hint Resolve leqvM_commut. Lemma leqvM_trans : forall m m' m'', leqvM m m' -> leqvM m' m'' -> leqvM m m''. Proof. intros m m' m''. unfold leqvM. intros. assert (m h <-> m' h). apply H. assert (m' h <-> m'' h). apply H0. inversion_clear H1. inversion_clear H2. split; auto. Qed. Lemma mstar_eqv_subst_right: forall m m' m'', leqvM m' m'' -> leqvM (m *^* m') (m *^* m''). Proof. intros m m' m''. unfold leqvM. intros. split. intro. unfold mstar in H0. unfold mstar. InvertAll. exists x. exists x0. split. auto. split. auto. assert (m' x0 <-> m'' x0). apply H. inversion_clear H2. apply H4; auto. unfold mstar. intros. InvertAll. exists x. exists x0. split; auto. split; auto. assert (m' x0 <-> m'' x0). apply H. inversion_clear H2. apply H5; auto. Qed. Hint Resolve mstar_eqv_subst_right. Lemma mstar_commut2 : forall m m', leqvM (m *^* m') (m' *^* m). Proof. unfold leqvM. intros. split; auto. Qed. Hint Resolve mstar_commut2. Lemma mstar_eqv_subst_left: forall m m' m'', leqvM m m'' -> leqvM (m *^* m') (m'' *^* m'). Proof. intros. assert (leqvM (m *^* m') (m' *^* m)). auto. assert (leqvM (m' *^* m) (m' *^* m'')). auto. assert (leqvM (m *^* m') (m' *^* m'')). apply leqvM_trans with (m' *^* m); auto. assert (leqvM (m' *^* m'') (m'' *^* m')). auto. apply leqvM_trans with (m' *^* m''); auto. Qed. Hint Resolve mstar_eqv_subst_left. Lemma mstar_assoc : forall m m' m'', leqvM (m *^* m' *^* m'') (m *^* (m' *^* m'')). Proof. unfold leqvM;intros. split;unfold mstar;intros. (*forward*) repeat destruct H. repeat destruct H0. destruct H3. exists x1;exists (MemMod.merge x2 x0). subst. split. unfold MemMod.disjUnion. auto with PMap. split. assumption. exists x2;exists x0. repeat split. apply MemMod.disj_merge_disj_right with x1;assumption. assumption. assumption. (*backward*) repeat destruct H. repeat destruct H0. repeat destruct H2. subst. destruct H3. exists (MemMod.merge x x1);exists x2. repeat split. auto with PMap. auto with PMap. exists x;exists x1. repeat split;try assumption. apply MemMod.disj_x_merge_disj_left with x2;assumption. assumption. Qed. Lemma leqvM_app_subst: forall m m' H, leqvM m m' -> m H -> m' H. Proof. intros. unfold leqvM in H0. assert (m H <-> m' H). apply H0. inversion_clear H2. auto. Qed. Lemma mstar_subst_weaker: forall (m m' m'': MPred) H, (m *^* m') H -> (forall H, m' H -> m'' H) -> (m *^* m'') H. Proof. intros. unfold mstar in H0. unfold mstar. InvertAll. exists x. exists x0. split; auto. Qed. Lemma mstar_subst_weaker_left: forall (m m' m'': MPred) H, (m *^* m') H -> (forall H, m H -> m'' H) -> (m'' *^* m') H. Proof. intros. unfold mstar in H0. unfold mstar. InvertAll. exists x. exists x0. split; auto. Qed. Lemma mstar_mTrue : forall m m' m'' H, (m *^* m' *^* m'') H -> (m' *^* mTrue) H. Proof. intros. assert (leqvM (m *^* m') (m'*^*m)). auto. assert (leqvM (m *^* m' *^* m'') (m' *^* m *^* m'')). auto. assert (leqvM (m' *^* m *^* m'') (m' *^* (m *^* m''))). apply mstar_assoc. assert (leqvM (m *^* m' *^* m'') (m' *^* (m *^* m''))). apply leqvM_trans with (m' *^* m *^* m''); auto. assert ((m' *^* (m *^* m'')) H). apply leqvM_app_subst with (m *^* m' *^* m''); auto. apply mstar_subst_weaker with (m *^* m''). auto. apply mtrue_weakest. Qed. (******************) (***added by wangwei***) Lemma disjUnion_assoc_lr : forall M1 M2 M3 M12 M123, MemMod.disjUnion M1 M2 M12 -> MemMod.disjUnion M12 M3 M123 -> MemMod.disjUnion M1 (MemMod.merge M2 M3) M123. Proof. unfold MemMod.disjUnion; intros. destruct H; destruct H0. subst. split. eauto with PMap. auto with PMap. Qed. Lemma disjUnion_assoc_l : forall M1 M2 M3 M12 M23 M123, MemMod.disjUnion M1 M2 M12 -> MemMod.disjUnion M12 M3 M123 -> M23 = MemMod.merge M2 M3 -> MemMod.disjUnion M2 M3 M23 /\ MemMod.disjUnion M1 M23 M123. Proof. unfold MemMod.disjUnion; intros. destruct H; destruct H0. subst. split. split. eauto with PMap. trivial. split. eauto with PMap. auto with PMap. Qed. Lemma disjUnion_upd_left_disjUnion : forall M1 M2 M M1', MemMod.disjUnion M1 M2 M -> MemMod.eqDom M1 M1' -> MemMod.disjUnion M1' M2 (MemMod.merge M1' M2). Proof. unfold MemMod.disjUnion. intros. destruct H. split_r. subst. eapply MemMod.eqDom_disj_presv; eauto. Qed. Lemma disjUnion_disjUnion_Inv_whole : forall M1 M2 M M', MemMod.disjUnion M1 M2 M -> MemMod.disjUnion M1 M2 M' -> M = M'. Proof. unfold MemMod.disjUnion. intros. destruct H; destruct H0. rewrite <- H2 in H1. trivial. Qed. Implicit Arguments disjUnion_disjUnion_Inv_whole [M1 M2 M M']. Lemma merge_put_put_merge : forall l x M1 M2, MemMod.in_dom l M1 -> MemMod.not_in_dom l M2 -> MemMod.merge (MemMod.put M1 l x) M2 = MemMod.put (MemMod.merge M1 M2) l x. Proof. unfold MemMod.in_dom, MemMod.not_in_dom, MemMod.merge, MemMod.put. intros. apply MemMod.extensional_eqMap. intros. destruct (MemMod.beq_A x0 l). trivial. destruct H. destruct (M1 x0); trivial. Qed. Lemma nat_eq_neq_dec: forall n n' : nat, n = n' \/ n <> n'. Proof. intros. destruct (eq_nat_dec n n'). left;assumption. right;assumption. Qed. coq/make.sh0000644000107400000620000000064011000223177012317 0ustar shaosystems#!/bin/bash # Top rule for Makefile. # To generate top Makefile, just type: sh make.sh > Makefile # Then type: make coq_makefile -I . Assertion.v Assertion_Lemmas.v Assertion_Lemmas2.v Assertion_Lemmas3.v \ Assertion_Lemmas4.v Assertion_Lemmas5.v Arith_Lemmas.v \ Coqlib.v ListT.v Machine.v Map.v Mem_Lemmas.v \ MultiMapT.v OpSem_Lemmas.v OpSem_Lemmas2.v Operational_Semantics.v Reg.v \ ./CAP0 ./SCAP ./miniOS coq/MultiMapT.v0000644000107400000620000001204011000223177013106 0ustar shaosystems(***************************************************************) (* Coq code for OCAP *) (* *) (* Map *) (* using listT *) (* *) (***************************************************************) Require Import Coq.Bool.Bool. Require Import Coqlib. Require Export ListT. Set Implicit Arguments. Unset Strict Implicit. Open Local Scope listt_scope. Open Local Scope t_type_scope. Module Type ONE_TYPE. Parameter B : Type. End ONE_TYPE. Module MultiMap (BDef : ONE_TYPE). Definition A := nat. Definition B := BDef.B. (***********************) (** map *) (***********************) Definition map := listT (prodT A B). Definition emp_map : map := nilT. Definition sig_map (a : A) (b : B) := (a, b) :: nilT. Definition merge (m1 m2 : map) : map := appT m1 m2. Definition lookup (m1 : map) (a : A) (b : B) := In (a, b) m1. Definition indom (m : map) (a : A) := exists b, lookup m a b. Definition sub (m1 m2 : map) := forall (a : A) (b : B), lookup m1 a b -> lookup m2 a b. Lemma sub_refl : forall m, sub m m. Proof. unfold sub; auto. Qed. Lemma sub_trans : forall m1 m2 m3, sub m1 m2 -> sub m2 m3 -> sub m1 m3. Proof. unfold sub, lookup; intros m1 m2 m3 H12 H23. intros a b. assert (H := (@incl_tran _ m1 m2 m3)). unfold incl in H. generalize (a, b). apply H. intros a0. destruct a0. apply H12; trivial. intros a0. destruct a0. apply H23; trivial. Qed. Lemma lookup_cons_intro : forall (m : map) (a a' : A) (b b' : B), lookup m a b -> lookup (consT (a', b') m ) a b. Proof. unfold lookup; intros. simpl. right; trivial. Qed. Lemma lookup_merge_elim : forall (m1 m2 : map) (a : A) (b : B), lookup (merge m1 m2) a b -> lookup m1 a b \/ lookup m2 a b. Proof. unfold lookup, merge. intros m1 m2 a b H. apply in_appT_or; trivial. Qed. Lemma lookup_merge_intro : forall (m1 m2 : map) (a : A) (b : B), lookup m1 a b \/ lookup m2 a b -> lookup (merge m1 m2) a b. Proof. unfold lookup, merge; intros. apply in_or_appT; trivial. Qed. Lemma lookup_merge_intro_l : forall (m1 m2 : map) (a : A) (b : B), lookup m1 a b -> lookup (merge m1 m2) a b. Proof. unfold lookup, merge; intros. apply in_or_appT; trivial. left; trivial. Qed. Lemma lookup_merge_intro_r : forall (m1 m2 : map) (a : A) (b : B), lookup m2 a b -> lookup (merge m1 m2) a b. Proof. unfold lookup, merge; intros. apply in_or_appT; trivial. right; trivial. Qed. Lemma sub_merge_elim_l : forall (m1 m2 m3: map), sub (merge m1 m2) m3 -> sub m1 m3. Proof. unfold sub. intros m1 m2 m3 Hsub a b Hin1. apply Hsub. apply lookup_merge_intro. left; trivial. Qed. Implicit Arguments sub_merge_elim_l [m1 m2 m3]. Lemma sub_merge_elim_r : forall (m1 m2 m3: map), sub (merge m1 m2) m3 -> sub m2 m3. Proof. unfold sub. intros m1 m2 m3 Hsub a b Hin2. apply Hsub. apply lookup_merge_intro. right; trivial. Qed. Implicit Arguments sub_merge_elim_r [m1 m2 m3]. Lemma sub_merge_l : forall (m1 m2 : map), sub m1 (merge m1 m2). Proof. intros m1 m2. unfold sub, merge, lookup. intros a b H. apply in_or_appT. left; trivial. Qed. Lemma sub_merge_r : forall (m1 m2 : map), sub m2 (merge m1 m2). Proof. intros m1 m2. unfold sub, merge, lookup. intros a b H. apply in_or_appT. right; trivial. Qed. Lemma lookup_sub_lookup : forall (m1 m2 : map) (a : A) (b : B), lookup m1 a b -> sub m1 m2 -> lookup m2 a b. Proof. unfold sub; intros; auto. Qed. Lemma sub_merge_sub: forall (m1 m2 m3 : map), sub m1 m2 -> sub (merge m3 m1) (merge m3 m2). Proof. unfold sub. intros. assert (lookup m3 a b \/ lookup m1 a b). apply lookup_merge_elim; auto. apply lookup_merge_intro. inversion H1. left; auto. right; apply H; auto. Qed. Lemma lookup_sub_merge_l_lookup : forall (m1 m2 m3 : map) (a : A) (b : B), lookup m1 a b -> sub (merge m1 m2) m3 -> lookup m3 a b. Proof. intros m1 m2 m3 a b Hl Hsub. apply lookup_sub_lookup with m1; trivial. apply sub_merge_elim_l with m2; trivial. Qed. Implicit Arguments lookup_sub_merge_l_lookup [m1 m2 m3 a b]. Lemma lookup_sub_merge_r_lookup : forall (m1 m2 m3 : map) (a : A) (b : B), lookup m2 a b -> sub (merge m1 m2) m3 -> lookup m3 a b. Proof. intros m1 m2 m3 a b Hl Hsub. apply lookup_sub_lookup with m2; trivial. apply sub_merge_elim_r with m1; trivial. Qed. Implicit Arguments lookup_sub_merge_l_lookup [m1 m2 m3 a b]. Ltac simpl_In := match goal with | |- In (pairT ?a ?b) (consT (pairT ?c ?d) ?m) => unfold In; fold In; (left; reflexivity; fail) || (right; simpl_In) | _ => fail 1 "fail" end. Ltac lookup_solve := match goal with | |- lookup ?m ?a ?b => unfold lookup; (try unfold m); simpl_In | _ => fail 1 end. End MultiMap. Unset Implicit Arguments. coq/examples/0000755000107400000620000000000011000242177012665 5ustar shaosystemscoq/examples/cond_wait.v0000644000107400000620000031335211000223244015024 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath ".." . Add LoadPath "../CAP0" . Add LoadPath "../SCAP" . Add LoadPath "../miniOS" . Add LoadPath "../examples" . Require Import Coqlib. Require Import List. Require Import Arith. Require Import Machine. Require Import Reg. Require Import Mem_Lemmas. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas3. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas5. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import AIM. Require Import AIM_Lemmas. Require Import QLib. Require Import SCAP. Require Import SCAP_READY. Require Import Linking. Require Import Omega. Require Import Assembly. Require Import SyncUtil. Require Import Kernel. Require Import SleepSpec. Require Import lock_release. Require Import lock_acquire. (* the stack space required by cond_wait *) (* assuming: _STK_SIZE_l_acquire > 2 + IH_Stk _STK_SIZE_l_acquire > stk_l_release _STK_SIZE_l_acquire > 2 + _STK_SIZE_sleep *) Notation _STK_SIZE_cond_wait := (40 + 6 + IH_Stk) (only parsing). (* Definition _STK_SIZE_cond_wait := 6 + _STK_SIZE_l_acquire. *) Definition psi_cond_wait := SCAP_consCT l_acquire (Ast l_acquire_Prd l_acquire_grt 1) (SCAP_consCT l_release (Ast l_release_Prd l_release_grt 1) (SCAP_consCT L_sleep (Ast p_sleep g_sleep 1) SCAP_emptCT )). Definition Ast_l_release_pre (lk bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec sp stk_l_release) *^* (sp |->w pc) *^* (sp + 2 |->w lk) *^* (Gamma lk) *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition Ast_l_release_post (lk bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec sp stk_l_release) *^* (sp |->w pc) *^* (sp + 2 |->w lk) *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_l_release (S : State) : Prop := exists lk, exists bp, exists sp, exists pc, Ast_l_release_pre lk bp sp pc mTrue S. Definition g_l_release (S S' : State) : Prop := forall mP, forall lk bp sp pc, Ast_l_release_pre lk bp sp pc mP S -> Ast_l_release_post lk bp sp pc mP S'. Lemma p_l_release_sound : forall S, p_l_release S -> l_release_Prd S. Proof. intros [[[M R] fl] isr]. unfold p_l_release, l_release_Prd. unfold Ast_l_release_pre, l_release_Prd_aux. intros H. destruct H as [lk [bp [sp [pc H]]]]. exists sp; exists lk; exists pc; exists bp; exists mTrue. destruct H as [HM [HBP [HSP [Hlk [Hif Hisr]]]]]. simplS in * . unfold l_release_MPre. split_l; split_l. split. sep on. sep matchH HM with 7. auto. Qed. Lemma g_l_release_sound : forall S S', l_release_grt S S' -> g_l_release S S'. Proof. intros [[[M R] fl] isr] [[[M' R'] fl'] isr']. unfold l_release_grt, g_l_release. unfold leadstoPQ2, l_release_Prd_aux, l_release_Post_aux_0. unfold Ast_l_release_pre, Ast_l_release_post. unfold l_release_MPre, l_release_MPost. intros. simplS in * . InvertAll. assert (R SP = sp /\ R BP = bp /\ (sp |->w pc *^* sp + 2 |->w lk *^* stkSpacePrec sp stk_l_release *^* INV1 *^* INV0 *^* Gamma lk *^* mP) M /\ In lk lockSet_H /\ fl _IF = false /\ isr = false). split_l; split_l. split. sep on. sep matchH H1 with 7. auto. substH H with (H _ _ _ _ _ H5). clear H5. InvertAll. split. destruct H7 as [M1' [M2' [HJM' [HM1' HM2']]]]. destruct HM1' as [HM1' Hlk]. exists M1'; exists M2'; split_l. split_r. sep on. sep matchH HM1' with 7. auto. Qed. Definition Ast_l_acquire_pre (lk bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec sp _STK_SIZE_l_acquire) *^* (sp |->w pc) *^* (sp + 2 |->w lk) *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition Ast_l_acquire_post (lk bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec sp _STK_SIZE_l_acquire) *^* (sp |->w pc) *^* (sp + 2 |->w lk) *^* (Gamma lk) *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_l_acquire (S : State) : Prop := exists lk, exists bp, exists sp, exists pc, Ast_l_acquire_pre lk bp sp pc mTrue S. Definition g_l_acquire (S S' : State) : Prop := forall mP, forall lk bp sp pc, Ast_l_acquire_pre lk bp sp pc mP S -> Ast_l_acquire_post lk bp sp pc mP S'. Lemma p_l_acquire_sound : forall S, p_l_acquire S -> l_acquire_Prd S. Proof. intros [[[M R] fl] isr]. unfold p_l_acquire, l_acquire_Prd. unfold Ast_l_acquire_pre, l_acquire_Prd_aux. intros H. destruct H as [lk [bp [sp [pc H]]]]. exists sp; exists lk; exists pc; exists bp; exists mTrue. destruct H as [HM [HBP [HSP [Hlk [Hif Hisr]]]]]. simplS in * . unfold l_acquire_MPre. split_l; split_l. split. sep on. sep matchH HM with 7. auto. Qed. Lemma g_l_acquire_sound : forall S S', l_acquire_grt S S' -> g_l_acquire S S'. Proof. intros [[[M R] fl] isr] [[[M' R'] fl'] isr']. unfold l_acquire_grt, g_l_acquire. unfold leadstoPQ2, l_acquire_Prd_aux, l_acquire_Post_aux. unfold Ast_l_acquire_pre, Ast_l_acquire_post. unfold l_acquire_MPre, l_acquire_MPost. intros. simplS in * . InvertAll. assert (R SP = sp /\ R BP = bp /\ (sp |->w pc *^* sp + 2 |->w lk *^* stkSpacePrec sp _STK_SIZE_l_acquire *^* INV1 *^* INV0 *^* mP) M /\ In lk lockSet_H /\ fl _IF = false /\ isr = false). split_l; split_l. split. sep on. sep matchH H1 with 7. auto. substH H with (H _ _ _ _ _ H5). clear H5. InvertAll. split. unfold l_acquire_MPre in H7. sep on. sep matchH H7 with 7. auto. Qed. Definition cond_wait_MPre (sp cv l pc : Label) (M : Mem) : Prop := ((sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w l) *^* stkSpacePrec sp _STK_SIZE_cond_wait *^* (Gamma l)) M /\ In l lockSet_H /\ In cv cvSet_M. Definition cond_wait_Prd_aux (sp cv l pc bp : Label) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (cond_wait_MPre sp cv l pc) M /\ fl _IF = true /\ isr = false end. Definition cond_wait_Prd (S : State) : Prop := imprec (fun S => exists sp, exists cv, exists l, exists pc, exists bp, cond_wait_Prd_aux sp cv l pc bp S) S. Definition cond_wait_MPost := cond_wait_MPre. Definition cond_wait_Post_aux := cond_wait_Prd_aux. Definition cond_wait_grt (S S' : State) : Prop := forall sp cv l pc bp, leadstoPQ (cond_wait_Prd_aux sp cv l pc bp) (cond_wait_Post_aux sp cv l pc bp) S S'. Definition Ast_cond_wait_pre (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec sp _STK_SIZE_cond_wait *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* (Gamma lk) *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = true /\ S_ISR S = false. Definition Ast_cond_wait_post := Ast_cond_wait_pre. Definition p_cond_wait_0 (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_pre lk cv bp sp pc mTrue S. Definition g_cond_wait_0 (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_pre lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _pushwp (Opr_reg BP); *) Definition Ast_cond_wait_1 (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp - 2) (_STK_SIZE_cond_wait - 2) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* (Gamma lk) *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp - 2 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_wait_1 (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_1 lk cv bp sp pc mTrue S. Definition g_cond_wait_1 (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_1 lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _movwp (Opr_reg SP) BP; *) Definition Ast_cond_wait_2 (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp - 2) (_STK_SIZE_cond_wait - 2) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* (Gamma lk) *^* mP) (S_Mem S) /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_wait_2 (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_2 lk cv bp sp pc mTrue S. Definition g_cond_wait_2 (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_2 lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _pushwm (A_reg 6 BP); *) Definition Ast_cond_wait_3 (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp - 4) (_STK_SIZE_cond_wait - 4) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* (Gamma lk) *^* mP) (S_Mem S) /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 4 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_wait_3 (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_3 lk cv bp sp pc mTrue S. Definition g_cond_wait_3 (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_3 lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _cli; *) Definition Ast_cond_wait_4 (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec (sp - 4) (_STK_SIZE_cond_wait - 4)) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* (Gamma lk) *^* mP) (S_Mem S) /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 4 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_cond_wait_4 (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_4 lk cv bp sp pc mTrue S. Definition g_cond_wait_4 (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_4 lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _call l_release; *) Definition Ast_cond_wait_5 (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec (sp - 4) (_STK_SIZE_cond_wait - 4)) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* mP) (S_Mem S) /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 4 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_cond_wait_5 (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_5 lk cv bp sp pc mTrue S. Definition g_cond_wait_5 (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_5 lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _movwld (A_reg 4 BP) BX; *) Definition Ast_cond_wait_6 (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec (sp - 4) (_STK_SIZE_cond_wait - 4)) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* mP) (S_Mem S) /\ S_RF S BX = cv /\ S_RF S SP = sp - 4 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_cond_wait_6 (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_6 lk cv bp sp pc mTrue S. Definition g_cond_wait_6 (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_6 lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _pushwm (A_reg C_WAITING BX); *) Definition Ast_cond_wait_7 (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec (sp - 6) (_STK_SIZE_cond_wait - 6)) *^* (sp - 6 |->w_) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* mP) (S_Mem S) /\ (exists w, (sp - 6 |~>w w) (S_Mem S) /\ Delta w = SomeT Aemp) /\ S_RF S SP = sp - 6 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_cond_wait_7 (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_7 lk cv bp sp pc mTrue S. Definition g_cond_wait_7 (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_7 lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _call L_sleep; *) Definition Ast_cond_wait_8 (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec (sp - 6) (_STK_SIZE_cond_wait - 6) *^* (sp - 6 |->w_) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* mP)) (S_Mem S) /\ S_RF S SP = sp - 6 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_cond_wait_8 (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_8 lk cv bp sp pc mTrue S. Definition g_cond_wait_8 (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_8 lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _sti; *) Definition Ast_cond_wait_9 (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp - 6) (_STK_SIZE_cond_wait - 6) *^* (sp - 6 |->w_) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 6 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_wait_9 (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_9 lk cv bp sp pc mTrue S. Definition g_cond_wait_9 (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_9 lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _addw (Opr_imm 2) SP; *) Definition Ast_cond_wait_a (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp - 4) (_STK_SIZE_cond_wait - 4) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 4 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_wait_a (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_a lk cv bp sp pc mTrue S. Definition g_cond_wait_a (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_a lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _cli; *) Definition Ast_cond_wait_b (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec (sp - 4) (_STK_SIZE_cond_wait - 4)) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 4 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_cond_wait_b (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_b lk cv bp sp pc mTrue S. Definition g_cond_wait_b (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_b lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _call l_acquire; *) Definition Ast_cond_wait_c (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec (sp - 4) (_STK_SIZE_cond_wait - 4) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* (Gamma lk) *^* mP)) (S_Mem S) /\ S_RF S SP = sp - 4 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_cond_wait_c (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_c lk cv bp sp pc mTrue S. Definition g_cond_wait_c (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_c lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _sti; *) Definition Ast_cond_wait_d (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp - 4) (_STK_SIZE_cond_wait - 4) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* (Gamma lk) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 4 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_wait_d (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_d lk cv bp sp pc mTrue S. Definition g_cond_wait_d (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_d lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _addw (Opr_imm 2) SP; *) Definition Ast_cond_wait_e (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp - 2) (_STK_SIZE_cond_wait - 2) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* (Gamma lk) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_wait_e (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_e lk cv bp sp pc mTrue S. Definition g_cond_wait_e (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_e lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _popw BP; *) Definition Ast_cond_wait_f (lk cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec sp (_STK_SIZE_cond_wait) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk) *^* (Gamma lk) *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp /\ sp >= _STK_SIZE_cond_wait /\ In cv cvSet_M /\ In lk lockSet_H /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_wait_f (S : State) : Prop := exists lk, exists cv, exists bp, exists sp, exists pc, Ast_cond_wait_f lk cv bp sp pc mTrue S. Definition g_cond_wait_f (S S' : State) : Prop := forall mP, forall lk cv bp sp pc, Ast_cond_wait_f lk cv bp sp pc mP S -> Ast_cond_wait_post lk cv bp sp pc mP S'. (* : _retw;; *) Definition p_cond_wait := p_cond_wait_0. Definition g_cond_wait := g_cond_wait_0. Lemma wff_cmd_cond_wait1: NH_WFcmd (SCAP_consCT (cond_wait + 1) (Ast p_cond_wait_1 g_cond_wait_1 1) psi_cond_wait) cond_wait (Ast p_cond_wait g_cond_wait 1) (comml (_pushwp (Opr_reg BP))). Proof. unfold p_cond_wait, g_cond_wait. assert (Hpp' : forall lk cv bp sp pc mP S S', Ast_cond_wait_pre lk cv bp sp pc mP S -> nextS (cond_wait) (comml (_pushwp (Opr_reg BP))) S S' -> Ast_cond_wait_1 lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_wait_pre, Ast_cond_wait_1 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. split. subst M' R'. sep on. rewrite HBP. rewrite HSP. sep lift 1. sep upd. sep lift 0 in HM. sep stksplit in HM. sep matchH HM with 5. subst M' R' fl' isr'. reg simpl. rewrite HSP. repeat split_l; trivial. simpl. split. exists p_cond_wait_1; exists g_cond_wait_1. split_l (* lookup *). split. (* enable *) apply enable_pushwp with (_STK_SIZE_cond_wait). intros S HS. destruct S as [[[M R] fl] isr]. unfold p_cond_wait_0 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_pre in HS. destruct HS as [HM [HBP [HSP _]]]. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep trivial. omega. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_cond_wait_1, p_cond_wait_2. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. unfold g_cond_wait_0, g_cond_wait_1 in * . intros mP lk cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_1 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_1 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_wait_0. exists lk; exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_wait_pre. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_0 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_wait_pre in * . simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_wait2: NH_WFcmd (SCAP_consCT (cond_wait + 1 + 1) (Ast p_cond_wait_2 g_cond_wait_2 1) psi_cond_wait) (cond_wait + 1) (Ast p_cond_wait_1 g_cond_wait_1 1) (comml (_movwp (Opr_reg SP) BP)). Proof. assert (Hpp' : forall lk cv bp sp pc mP S S', Ast_cond_wait_1 lk cv bp sp pc mP S -> nextS (cond_wait + 1) (comml (_movwp (Opr_reg SP) BP)) S S' -> Ast_cond_wait_2 lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_wait_1, Ast_cond_wait_2 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. subst M' R' fl' isr'. reg simpl. repeat split_l; trivial. simpl. split. exists p_cond_wait_2; exists g_cond_wait_2. split_l. split. (* enable movw *) apply trivial_enable_movwp. split. (* p ==> p' *) unfold p_cond_wait_1, p_cond_wait_2. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HSS']. destruct H as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HSS'] HS'S'']]. unfold g_cond_wait_1, g_cond_wait_2 in * . intros mP lk cv bp sp pc HS. eapply HS'S''; eauto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_1 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_1 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_wait_1. exists lk; exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_wait_1. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_1 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_wait_1 in * . simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_wait3: NH_WFcmd (SCAP_consCT (cond_wait + 1 + 1 + 1) (Ast p_cond_wait_3 g_cond_wait_3 1) psi_cond_wait) (cond_wait + 1 + 1) (Ast p_cond_wait_2 g_cond_wait_2 1) (comml (_pushwm (A_reg 6 BP))). Proof. assert (Hpp' : forall lk cv bp sp pc mP S S', Ast_cond_wait_2 lk cv bp sp pc mP S -> nextS (cond_wait+1+1) (comml (_pushwm (A_reg 6 BP))) S S' -> Ast_cond_wait_3 lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_wait_2, Ast_cond_wait_3 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [wx [Hlds [Hspgt [HldsB HM']]]]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM', Hlds. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. assert (Heq : lk = wx). rewrite HBP in Hlds. arith_rep (sp - 2 + 6) with (sp + 4) in Hlds. sep on. sep lift 4 in HM. sep inj. auto. subst wx. subst M' R' fl' isr'. rewrite HSP. arith_rep (sp - 2 - 2) with (sp - 4). split. sep on. sep lift 1. sep upd. sep lift 0 in HM. sep stksplit in HM. arith_rep (sp - 2 - 2) with (sp - 4) in HM. arith_rep (_STK_SIZE_cond_wait - 2 - 2) with (_STK_SIZE_cond_wait - 4) in HM. sep matchH HM with 6. reg simpl. repeat split_l; trivial. simpl. split. exists p_cond_wait_3; exists g_cond_wait_3. split_l (* lookup *). split. (* enable *) apply enable_pushwm with (_STK_SIZE_cond_wait - 2); try omega. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_cond_wait_2 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_2 in HS. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. rewrite HSP. unfold addr_eval. rewrite HBP. split. sep on. sep lift 0 in HM. sep trivial. sep on. arith_rep (sp - 2 + 6) with (sp + 4). sep lift 4 in HM. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_cond_wait_2, p_cond_wait_3. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. unfold g_cond_wait_2, g_cond_wait_3 in * . intros mP lk cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_2 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_2 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_wait_2. exists lk; exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_wait_2. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_2 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_wait_2 in * . simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_wait4: NH_WFcmd (SCAP_consCT (cond_wait + 1 + 1 + 1 + 1) (Ast p_cond_wait_4 g_cond_wait_4 1) psi_cond_wait) (cond_wait + 1 + 1 + 1) (Ast p_cond_wait_3 g_cond_wait_3 1) (comml _cli). Proof. assert (Hpp': forall lk cv bp sp pc mP S S', Ast_cond_wait_3 lk cv bp sp pc mP S -> gcli S S' -> Ast_cond_wait_4 lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold linkPG, conjPG, conjG. unfold Ast_cond_wait_3, gcli, Ast_cond_wait_4 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct HS as [HM [HBX [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. assert (Hshift' : prepost Aemp (INV0 *^* INV1) (M, R, fl, isr) (M', R', fl', isr')). apply (prepost_weaken_post (mQ' := INV0 *^* INV1) Hshift). intros Mx H. apply (choice_elim_left H); unfold itr_enabled; auto. split. sep on. assert (HMx : S_Mem (M, R, fl, isr) ||- (Aemp) *^* (stkSpacePrec (sp - 4) (40 + 6 + IH_Stk - 4) *^* sp - 4 |->w lk *^* sp - 2 |->w bp *^* sp |->w pc *^* sp + 2 |->w cv *^* sp + 4 |->w lk *^* Gamma lk *^* mP)). sep matchH HM with 4. substH HM with (prepost_elim Hshift' precise_emp HMx). sep on. sep matchH HM with 5. simplS in * . subst R' isr'. repeat split_l; trivial. simpl. split. exists p_cond_wait_4; exists g_cond_wait_4. split_l. (* lookup *) split. (* p ==> p' *) unfold p_cond_wait_3, p_cond_wait_4. intros S' H. unfold linkPG in H. destruct H as [S [HS HSS']]. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) unfold g_cond_wait_3, g_cond_wait_4. unfold linkPG, conjPG, conjG. intros S S'' H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. intros mP lk cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_3 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_3 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_wait_3. exists lk; exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_wait_3. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_3 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_wait_3 in * . simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_wait5: NH_WFcmd (SCAP_consCT (cond_wait + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_5 g_cond_wait_5 1) psi_cond_wait) (cond_wait + 1 + 1 + 1 + 1) (Ast p_cond_wait_4 g_cond_wait_4 1) (comml (_call l_release)). Proof. assert(Hpp' : forall lk cv bp sp pc mQ mP S S', Ast_cond_wait_4 lk cv bp sp pc mP S -> nextS (cond_wait + 1 + 1 + 1 + 1) (comml (_call l_release)) S S' -> mQ = (stkSpacePrec (sp - 6 - stk_l_release) (_STK_SIZE_cond_wait - 6 - stk_l_release) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk)) -> Ast_l_release_pre lk (sp - 2) (sp - 6) (cond_wait + 1 + 1 + 1 + 1 + 1) (mQ *^* mP) S'). intros lk cv bp sp pc mQ mP S S'. intros HS HSS' HmQ. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold Ast_cond_wait_4 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspx [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. unfold Ast_l_release_pre. simplS in * . reg simpl. split. sep on. rewrite HSP. assert (H1 : sp - 4 - 2 = sp - 6). generalize Hsp; clearall. omega. rewrite H1. subst mQ. sep lift 3. sep_update. sep lift 2 in HM. sep stksplit in HM. rewrite H1 in HM. assert (H2 : _STK_SIZE_cond_wait - 4 - 2 = _STK_SIZE_cond_wait - 6). clearall; omega. rewrite H2 in HM. assert (H3 : _STK_SIZE_cond_wait - 6 >= stk_l_release). unfold stk_l_release. clearall; omega. assert (H4 : sp - 6 >= stk_l_release). unfold stk_l_release. generalize Hsp; clearall; omega. sep stksplit stk_l_release in HM. assert (H5 : sp - 6 + 2 = sp - 4). generalize Hsp; clearall; omega. rewrite H5. sep matchH HM with 11. split_l. split. rewrite HSP; omega. auto. assert (Hpp''' : forall lk cv bp sp pc pc' mP S S' S'' S''', Ast_cond_wait_4 lk cv bp sp pc mP S -> nextS (cond_wait + 1 + 1 + 1 + 1) (comml (_call l_release)) S S' -> l_release_grt S' S'' -> nextS pc' (comms (_retw)) S'' S''' -> Ast_cond_wait_5 lk cv bp sp pc mP S'''). intros lk cv bp sp pc pc' mP. intros S S' S'' S''' HS HSS' HS'S'' HS''S'''. substH HS'S'' with (g_l_release_sound _ _ HS'S''). unfold g_l_release in HS'S''. set (mQ := (stkSpacePrec (sp - 6 - stk_l_release) (_STK_SIZE_cond_wait - 6 - stk_l_release) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk))). assert (HS' : Ast_l_release_pre lk (sp - 2) (sp - 6) (cond_wait + 1 + 1 + 1 + 1 + 1) (mQ *^* mP) S'). apply Hpp' with cv bp pc S; trivial. assert (HS'' := HS'S'' _ _ _ _ _ HS'). subst mQ. clear HS'S''. unfold Ast_l_release_post in HS''. unfold Ast_cond_wait_5. unfold Ast_cond_wait_4 in HS. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. simplS in * . destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pcx [Hlds HR''']]. destruct HS'' as [HM'' [HBP'' [HSP'' [Hlkx [Hif'' Hisr'']]]]]. assert (Hpcx : pcx = cond_wait + 1 + 1 + 1 + 1 + 1). subst R' M''' R'''. subst fl' isr' fl''' isr'''. rewrite HSP'' in Hlds; clear HSP''. sep on. sep lift 3 in HM''. sep_inj. auto. subst pcx; clear Hlds. subst M''' R''' fl''' isr'''. reg simpl. rewrite HBP''. rewrite HSP''. assert (H0 : sp - 6 + 2 = sp - 4). generalize Hsp; clearall. omega. rewrite H0. rewrite H0 in HM''. split. sep on. sep matchH HM'' with 9. assert (H3 : _STK_SIZE_cond_wait - 4 >= 2). clearall; omega. assert (H4 : sp - 4 >= 2). generalize Hsp; clearall; omega. sep stksplit. assert (H1 : sp - 4 - 2 = sp - 6). generalize Hsp; clearall; omega. rewrite H1. assert (H2 : _STK_SIZE_cond_wait - 4 - 2 = _STK_SIZE_cond_wait - 6). clearall; omega. rewrite H2. clear H3 H4. assert (H3 : _STK_SIZE_cond_wait - 6 >= stk_l_release). unfold stk_l_release. clearall; omega. assert (H4 : sp - 6 >= stk_l_release). unfold stk_l_release. generalize Hsp; clearall; omega. sep stksplit stk_l_release. sep matchH HM'' with 3. repeat split_l; trivial. simpl. split. right. split. apply l_release_not_primentry. exists l_release_Prd; exists p_cond_wait_5. exists l_release_grt; exists g_cond_wait_5. split. unfold psi_cond_wait; auto. split_l. split. clear Hpp' Hpp'''. unfold enable, p_cond_wait_4. intros S HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_4 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. (* enable call *) destruct S as [[[M R] fl] isr]. simplS in * . exists (MemUpdW M (sp - 4 - 2) (cond_wait + 1 + 1 + 1 + 1 + 1) 0, RF_update R SP (sp - 4 - 2), fl, isr). apply nextS_call. unfold pushW. split. rewrite HSP. sep on. sep lift 2 in HM. sep stksplit 2 in HM. sep lift 0 in HM. sep trivial. split. rewrite HSP. apply MemUpdW_MemUpd16 with 0; trivial. rewrite HSP; trivial. split. (* g' => fun_frame *) unfold sp_call_pred, fun_frame. unfold linkPG, conjPG. intros S' S'' HS'S''. destruct HS'S'' as [H HS'S'']. destruct H as [S [HS HSS']]. substH HS'S'' with (g_l_release_sound _ _ HS'S''). unfold g_l_release in HS'S''. unfold p_cond_wait_4 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. set (mQ := (stkSpacePrec (sp - 6 - stk_l_release) (_STK_SIZE_cond_wait - 6 - stk_l_release) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk))). assert (HS' : Ast_l_release_pre lk (sp - 2) (sp - 6) (cond_wait + 1 + 1 + 1 + 1 + 1) (mQ *^* mTrue) S'). apply Hpp' with cv bp pc S; trivial. clear Hpp' HS HSS' Hpp'''. substH HS'S'' with (HS'S'' _ _ _ _ _ HS'). rename HS'S'' into HS''. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. simplS in * . unfold Ast_l_release_pre, Ast_l_release_post in * . destruct HS' as [HM' [HBP' [HSP' [Hlk' [Hif' Hisr']]]]]. destruct HS'' as [HM'' [HBP'' [HSP'' [Hlk'' [Hif'' Hisr'']]]]]. simplS in * . split. rewrite HSP'; rewrite HSP''; trivial. unfold Ret_Addr. exists (cond_wait + 1 + 1 + 1 + 1 + 1). simplS. split. intros pc''. apply nextPC_retw with (sp - 6); trivial. clear HM''. sep on. subst mQ. sep lift 3 in HM'. sep trivial. intros pc''. apply nextPC_retw with (sp - 6); trivial. clear HM'. sep on. subst mQ. sep lift 3 in HM''. sep trivial. split. (* p => p' *) intros S' H. unfold conjPG, conjG, linkPG in H. destruct H as [S [HS HnextSS']]. apply p_l_release_sound. unfold p_cond_wait_4 in HS. unfold p_l_release. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists (sp - 2); exists (sp - 6); exists (cond_wait + 1 + 1 + 1 + 1 + 1). set (mQ := (stkSpacePrec (sp - 6 - stk_l_release) (_STK_SIZE_cond_wait - 6 - stk_l_release) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk))). assert (HS' : Ast_l_release_pre lk (sp - 2) (sp - 6) (cond_wait + 1 + 1 + 1 + 1 + 1) (mQ *^* mTrue) S'). apply Hpp' with cv bp pc S; trivial. clear Hpp''' HS HnextSS'. unfold Ast_l_release_pre in * . destruct HS' as [HM' [HBP' [HSP' [Hlk' [Hif' Hisr']]]]]. split. sep on. sep matchH HM' with 10. auto. split. (* p => p''' *) intros pc' S'''. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S H]. destruct H as [HS H]. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. unfold p_cond_wait_4, p_cond_wait_5 in * . destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. eapply Hpp'''; eauto. (* g''' => g *) intros pc' S S'''' H. unfold conjPG, wrap_fun, conjG, linkPG in H. destruct H as [S''' [HS HS'''S'''']]. destruct HS as [HSx [S'' [Hx HnextS'']]]. destruct Hx as [S' [HSS' HS'S'']]. unfold g_cond_wait_4, g_cond_wait_5 in * . intros mP lk cv bp sp pc HS. eapply HS'''S''''; eauto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_4 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_4 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_4 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_cond_wait_4 in HS. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma wff_cmd_cond_wait6: NH_WFcmd (SCAP_consCT (cond_wait + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_6 g_cond_wait_6 1) psi_cond_wait) (cond_wait + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_5 g_cond_wait_5 1) (comml (_movwld (A_reg 4 BP) BX)). Proof. assert (Hpp' : forall lk cv bp sp pc mP S S', Ast_cond_wait_5 lk cv bp sp pc mP S -> nextS (cond_wait + 1 + 1 + 1 + 1 + 1) (comml (_movwld (A_reg 4 BP) BX)) S S' -> Ast_cond_wait_6 lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_wait_5, Ast_cond_wait_6 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [cvx [Hlds HR']]. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. assert (Heq : cvx = cv). unfold addr_eval in Hlds. rewrite HBP in Hlds. arith_rep (sp - 2 + 4) with (sp + 2) in Hlds. sep on. sep lift 6 in HM. sep inj. auto. subst cvx M' R' fl' isr'. reg simpl. repeat split_l; trivial. simpl. split. exists p_cond_wait_6; exists g_cond_wait_6. split_l. split. (* enable *) apply enable_movwld. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_cond_wait_5 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_5 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. simplS in * . unfold addr_eval. rewrite HBP. arith_rep (sp - 2 + 4) with (sp + 2). sep on. sep lift 6 in HM. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_cond_wait_5, p_cond_wait_6. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. unfold g_cond_wait_5, g_cond_wait_6 in * . intros mP lk cv bp sp pc HS. eapply HS'S''; eauto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_5 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_5 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_5 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_cond_wait_5 in HS. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma wff_cmd_cond_wait7: NH_WFcmd (SCAP_consCT (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_7 g_cond_wait_7 1) psi_cond_wait) (cond_wait + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_6 g_cond_wait_6 1) (comml (_pushwm (A_reg C_WAITING BX))). Proof. assert (Hpp' : forall lk cv bp sp pc mP S S', Ast_cond_wait_6 lk cv bp sp pc mP S -> nextS (cond_wait+1+1+1+1+1+1) (comml (_pushwm (A_reg C_WAITING BX))) S S' -> Ast_cond_wait_7 lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_wait_6, Ast_cond_wait_7 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [wx [Hlds [Hspgt [HldsB HM']]]]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM', Hlds. simplS in * . destruct HS as [HM [HBX [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. assert (Hw : exists w, (cv + C_WAITING |~>w w) M /\ Delta w = SomeT Aemp). assert ((CV_INV_M cv *^* mTrue) M). apply INV1_cvInv; trivial. sep on. sep matchH HM with 5. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. unfold CV_INV_M in HM1. destruct HM1 as [w [HM1 Hw]]. exists w; split_r. unfold leadsToW. unfold imprecM. exists M1; exists M2; auto. destruct Hw as [w [Hw1 Hw2]]. assert (Heq : w = wx). rewrite HBX in Hlds. sep on. sep inj. auto. subst wx. subst M' R' fl' isr'. rewrite HSP. split. sep on. sep lift 3. sep exists_left w. arith_rep (sp - 6) with (sp - 4 - 2). sep upd. sep lift 2 in HM. sep stksplit in HM. arith_rep (_STK_SIZE_cond_wait - 6) with (_STK_SIZE_cond_wait - 4 - 2). sep matchH HM with 6. reg simpl. repeat split_l; trivial. exists w; split_r. sep on. arith_rep (sp - 6) with (sp - 4 - 2). sep upd. sep lift 2 in HM. sep stksplit in HM. sep lift 1 in HM. sep trivial. omega. simpl. split. exists p_cond_wait_7; exists g_cond_wait_7. split_l (* lookup *). split. (* enable *) apply enable_pushwm with (_STK_SIZE_cond_wait - 4); try omega. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_cond_wait_6 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_6 in HS. simplS in * . destruct HS as [HM [HBX [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. rewrite HSP. unfold addr_eval. rewrite HBX. assert (Hw : exists w, (cv + C_WAITING |~>w w) M /\ Delta w = SomeT Aemp). assert ((CV_INV_M cv *^* mTrue) M). apply INV1_cvInv; trivial. sep on. sep matchH HM with 5. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. unfold CV_INV_M in HM1. destruct HM1 as [w [HM1 Hw]]. exists w; split_r. unfold leadsToW. unfold imprecM. exists M1; exists M2; auto. destruct Hw as [w [Hw1 Hw2]]. split. sep on. sep lift 2 in HM. sep trivial. sep on. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_cond_wait_6, p_cond_wait_7. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. unfold g_cond_wait_6, g_cond_wait_7 in * . intros mP lk cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_6 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_6 in HS. destruct HS as [HM [HBX [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_6 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_cond_wait_6 in HS. simplS in * . destruct HS as [HM [HBX [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma wff_cmd_cond_wait8: NH_WFcmd (SCAP_consCT (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_8 g_cond_wait_8 1) psi_cond_wait) (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_7 g_cond_wait_7 1) (comml (_call L_sleep)). Proof. assert(Hpp' : forall lk cv bp sp pc mQ mP S S', Ast_cond_wait_7 lk cv bp sp pc mP S -> nextS (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1) (comml (_call L_sleep)) S S' -> mQ = (stkSpacePrec (sp - 8 - _STK_SIZE_sleep) (_STK_SIZE_cond_wait - 8 - _STK_SIZE_sleep) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk)) -> exists w, Ast_sleep_0 w Aemp (sp - 8) (cond_wait +1 +1 +1 +1 +1 +1 +1 +1) (mQ *^* mP) S' /\ (sp - 6 |~>w w) (S_Mem S)). intros lk cv bp sp pc mQ mP S S'. intros HS HSS' HmQ. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold Ast_cond_wait_7 in HS. destruct HS as [HM [Hw [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspx [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. destruct Hw as [w [Hldsw Hw]]. exists w; split_r. unfold Ast_sleep_0. simplS in * . reg simpl. split. sep on. rewrite HSP. assert (H1 : sp - 6 - 2 = sp - 8). generalize Hsp; clearall. omega. rewrite H1. subst mQ. sep lift 3. sep_update. sep lift 2 in HM. sep stksplit in HM. rewrite H1 in HM. assert (H2 : _STK_SIZE_cond_wait - 6 - 2 = _STK_SIZE_cond_wait - 8). clearall. omega. rewrite H2 in HM. assert (H3 : 40 + 6 + IH_Stk - 8 >= _STK_SIZE_sleep). clearall. simpl. omega. sep stksplit _STK_SIZE_sleep in HM. assert (H4 : sp - 8 + 2 = sp - 6). generalize Hsp; clearall; omega. rewrite H4. sep lift 3 in HM. sep elim_left HM. sep inj. intro; subst v. sep matchH HM with 11. rewrite HSP. split. generalize Hsp; clearall; omega. split. generalize Hsp; clearall; omega. auto. assert (Hpp''' : forall lk cv bp sp pc pc' mP S S' S'' S''', Ast_cond_wait_7 lk cv bp sp pc mP S -> nextS (cond_wait +1 +1 +1 +1 +1 +1 +1) (comml (_call L_sleep)) S S' -> g_sleep S' S'' -> nextS pc' (comms (_retw)) S'' S''' -> Ast_cond_wait_8 lk cv bp sp pc mP S'''). intros lk cv bp sp pc pc' mP. intros S S' S'' S''' HS HSS' HS'S'' HS''S'''. unfold g_sleep in HS'S''. set (mQ := (stkSpacePrec (sp - 8 - _STK_SIZE_sleep) (_STK_SIZE_cond_wait - 8 - _STK_SIZE_sleep) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk))). assert (HS' : exists w, Ast_sleep_0 w Aemp (sp - 8) (cond_wait +1 +1 +1 +1 +1 +1 +1 +1) (mQ *^* mP) S' /\ (sp - 6 |~>w w) (S_Mem S)). eapply Hpp'; eauto. destruct HS' as [w [HS' Hldsw]]. assert (HS'' := HS'S'' _ _ _ _ _ HS'). clear HS'S''. destruct HS'' as [HS'' HS'S'']. subst mQ. unfold Ast_cond_wait_7, Ast_cond_wait_8 in * . destruct HS as [HM [Hw [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct Hw as [wx [Hldswx Hw]]. assert (wx = w). sep on. sep inj. auto. subst wx; clear Hldswx. unfold Ast_sleep_post in HS''. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. simplS in * . clear Hpp'. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pcx [Hlds HR''']]. destruct HS'' as [HM'' [Hif'' Hisr'']]. assert (Hpcx : pcx = cond_wait +1 +1 +1 +1 +1 +1 +1 +1). subst R' R'' M''' R'''. subst fl' isr' fl''' isr'''. sep on. sep lift 4 in HM''. reg simpl. rewrite HSP in Hlds. assert (H1 : sp - 6 - 2 = sp - 8). generalize Hsp; clearall; omega. rewrite H1 in Hlds. sep_inj. auto. subst pcx; clear Hlds. subst R' R'' M''' R''' fl''' isr'''. reg simpl. assert (H1 : sp - 8 + 2 = sp - 6). generalize Hsp; clearall; omega. rewrite H1 in HM''. split. sep on. sep matchH HM'' with 9. sep stksplit. assert (H2 : sp - 6 - 2 = sp - 8). generalize Hsp; clearall; omega. rewrite H2. assert (H3 : _STK_SIZE_cond_wait - 6 - 2 = _STK_SIZE_cond_wait - 8). clearall; omega. rewrite H3. assert (H4 : _STK_SIZE_cond_wait - 8 >= _STK_SIZE_sleep). clearall; omega. assert (H5 : sp - 8 >= _STK_SIZE_sleep). generalize Hsp; clearall; omega. sep stksplit (_STK_SIZE_sleep). sep matchH HM'' with 3. repeat split_l; trivial. rewrite HSP. generalize Hsp; clearall; omega. simpl. split. right. split. apply sleep_not_prim. exists p_sleep; exists p_cond_wait_8. exists g_sleep; exists g_cond_wait_8. split. unfold psi_cond_wait; auto. split_l. split. clear Hpp' Hpp'''. unfold enable, p_cond_wait_7. intros S HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_7 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. (* enable call *) destruct S as [[[M R] fl] isr]. simplS in * . exists (MemUpdW M (sp - 6 - 2) (cond_wait +1 +1 +1 +1 +1 +1 +1 +1) 0, RF_update R SP (sp - 6 - 2), fl, isr). apply nextS_call. unfold pushW. split. rewrite HSP. sep on. sep lift 2 in HM. sep stksplit 2 in HM. sep lift 0 in HM. sep trivial. split. rewrite HSP. apply MemUpdW_MemUpd16 with 0; trivial. rewrite HSP; trivial. split. (* g' => fun_frame *) unfold sp_call_pred, fun_frame. unfold linkPG, conjPG. intros S' S'' HS'S''. destruct HS'S'' as [H HS'S'']. destruct H as [S [HS HSS']]. unfold g_sleep in HS'S''. unfold p_cond_wait_7 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. set (mQ := (stkSpacePrec (sp - 8 - _STK_SIZE_sleep) (_STK_SIZE_cond_wait - 8 - _STK_SIZE_sleep) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk))). assert (HS' : exists w, Ast_sleep_0 w Aemp (sp - 8) (cond_wait +1 +1 +1 +1 +1 +1 +1 +1) (mQ *^* mTrue) S' /\ (sp - 6 |~>w w) (S_Mem S)). eapply Hpp'; eauto. destruct HS' as [w [HS' Hldsw]]. clear Hpp' HS HSS' Hpp'''. substH HS'S'' with (HS'S'' _ _ _ _ _ HS'). rename HS'S'' into HS''. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. simplS in * . unfold Ast_sleep_0, Ast_sleep_post in * . destruct HS' as [HM' [HSP' [Hsp' [Hif' [Hisr' Hw]]]]]. destruct HS'' as [[HM'' [Hif'' Hisr'']] HR'']. simplS in * . subst R'' isr' isr''. split_l. unfold Ret_Addr. exists (cond_wait +1 +1 +1 +1 +1 +1 +1 +1). simplS. split. intros pc''. apply nextPC_retw with (sp - 8); trivial. clear HM''. sep on. subst mQ. sep lift 3 in HM'. sep trivial. intros pc''. apply nextPC_retw with (sp - 8); trivial. clear HM'. sep on. subst mQ. sep lift 4 in HM''. sep trivial. split. (* p => p' *) intros S' H. unfold conjPG, conjG, linkPG in H. destruct H as [S [HS HnextSS']]. unfold p_cond_wait_7 in HS. unfold p_sleep. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. set (mQ := (stkSpacePrec (sp - 8 - _STK_SIZE_sleep) (_STK_SIZE_cond_wait - 8 - _STK_SIZE_sleep) *^* (sp - 4 |->w lk) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk))). assert (HS' : exists w, Ast_sleep_0 w Aemp (sp - 8) (cond_wait +1 +1 +1 +1 +1 +1 +1 +1) (mQ *^* mTrue) S' /\ (sp - 6 |~>w w) (S_Mem S)). eapply Hpp'; eauto. destruct HS' as [w [HS' Hldsw]]. exists w; exists Aemp; exists (sp - 8); exists (cond_wait +1 +1 +1 +1 +1 +1 +1 +1). clear Hpp''' HS HnextSS'. unfold Ast_sleep_0 in * . destruct HS' as [HM' [HSP' [Hsp' [Hif' [Hisr' Hw]]]]]. split. sep on. sep matchH HM' with 10. auto. split. (* p => p''' *) intros pc' S'''. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S H]. destruct H as [HS H]. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. unfold p_cond_wait_7, p_cond_wait_8 in * . destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. eapply Hpp'''; eauto. (* g''' => g *) intros pc' S S'''' H. unfold conjPG, wrap_fun, conjG, linkPG in H. destruct H as [S''' [HS HS'''S'''']]. destruct HS as [HSx [S'' [Hx HnextS'']]]. destruct Hx as [S' [HSS' HS'S'']]. unfold g_cond_wait_7, g_cond_wait_8 in * . intros mP lk cv bp sp pc HS. eapply HS'''S''''; eauto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_7 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_7 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_7 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_cond_wait_7 in HS. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma wff_cmd_cond_wait9: NH_WFcmd (SCAP_consCT (cond_wait +1 +1 +1 +1 +1 +1 +1 +1 +1) (Ast p_cond_wait_9 g_cond_wait_9 1) psi_cond_wait) (cond_wait +1 +1 +1 +1 +1 +1 +1 +1) (Ast p_cond_wait_8 g_cond_wait_8 1) (comml _sti). Proof. assert (Hpp': forall lk cv bp sp pc mP S S', Ast_cond_wait_8 lk cv bp sp pc mP S -> gsti S S' -> Ast_cond_wait_9 lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold linkPG, conjPG, conjG. unfold Ast_cond_wait_8, gsti, Ast_cond_wait_9 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. assert (Hshift' : prepost (INV0 *^* INV1) Aemp (M, R, fl, isr) (M', R', fl', isr')). apply (prepost_weaken_pre (mP':=INV0 *^* INV1) Hshift). intros Mx HMx. assert (Hitr : ~ itr_enabled (M, R, fl, isr)). unfold itr_enabled. intros [H1 H2]. simplS in * . rewrite Hif in H1; discriminate H1. eapply choice_elim_right; eauto. clear Hshift; rename Hshift' into Hshift. split. sep on. substH HM with (prepost_elim Hshift Prec01 HM). sep on. simplS in * . sep matchH HM with 6. sep trivial. simplS in * . subst R' isr'. repeat split_l; trivial. simpl. split. exists p_cond_wait_9; exists g_cond_wait_9. split_l. split. (* enable *) unfold enable_sti. intros S HS. unfold p_cond_wait_8 in HS. unfold pTrue, pmstar, choice. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_8 in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . destruct HM as [M2 [M1 [HJM [HM2 HM1]]]]. exists M1; exists M2. split. auto with PMap. split_l. right. split_r. intros [H1 H2]. simplS in * . rewrite Hif in H1; discriminate H1. split. (* p ==> p' *) unfold p_cond_wait_8, p_cond_wait_9. intros S' H. unfold linkPG in H. destruct H as [S [HS HSS']]. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) unfold g_cond_wait_8, g_cond_wait_9. unfold linkPG, conjPG, conjG. intros S S'' H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. intros mP lk cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_8 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_8 in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_8 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_cond_wait_8 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma wff_cmd_cond_waita: NH_WFcmd (SCAP_consCT (cond_wait +1 +1 +1 +1 +1 +1 +1 +1 +1 +1) (Ast p_cond_wait_a g_cond_wait_a 1) psi_cond_wait) (cond_wait +1 +1 +1 +1 +1 +1 +1 +1 +1) (Ast p_cond_wait_9 g_cond_wait_9 1) (comml (_addw (Opr_imm 2) SP)). Proof. assert (Hpp' : forall lk cv bp sp pc mP S S', Ast_cond_wait_9 lk cv bp sp pc mP S -> nextS (cond_wait +1 +1 +1 +1 +1 +1 +1 +1 +1) (comml (_addw (Opr_imm 2) SP)) S S' -> Ast_cond_wait_a lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_wait_9, Ast_cond_wait_a in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. subst M' R' isr'. split. sep on. sep matchH HM with 5. sep stksplit. assert (H1 : sp - 4 - 2 = sp - 6). generalize Hsp; clearall; omega. rewrite H1. assert (H2 : _STK_SIZE_cond_wait - 4 - 2 = _STK_SIZE_cond_wait - 6). clearall; omega. rewrite H2. sep matchH HM with 2. reg simpl. unfold opr_eval. rewrite HSP. split_l by (generalize Hsp; clearall; omega). repeat split_l; trivial. unfold trash_fl in Hfl'. destruct Hfl'; subst fl'; auto. split. simpl. exists p_cond_wait_a; exists g_cond_wait_a. split_l. split. (* enable addw *) apply trivial_enable_addw. split. (* p ==> p' *) unfold p_cond_wait_9, p_cond_wait_a. intros S' H. unfold linkPG in H. destruct H as [S H]. simpl in H. destruct H as [H HnextS]. destruct H as [lk [cv [bp [sp [pc H]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[HSx HnextS] HS'S'']]. unfold g_cond_wait_9, g_cond_wait_a in * . intros mP lk cv bp sp pc HS. eapply HS'S''; eauto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_9 in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_9 in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_wait_9. exists lk; exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_wait_9. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_9 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_wait_9 in * . simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_waitb: NH_WFcmd (SCAP_consCT (cond_wait +1 +1 +1 +1 +1 +1 +1 +1 +1 +1 +1) (Ast p_cond_wait_b g_cond_wait_b 1) psi_cond_wait) (cond_wait +1 +1 +1 +1 +1 +1 +1 +1 +1 +1) (Ast p_cond_wait_a g_cond_wait_a 1) (comml _cli). Proof. assert (Hpp': forall lk cv bp sp pc mP S S', Ast_cond_wait_a lk cv bp sp pc mP S -> gcli S S' -> Ast_cond_wait_b lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold linkPG, conjPG, conjG. unfold Ast_cond_wait_a, gcli, Ast_cond_wait_b in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. assert (Hshift' : prepost Aemp (INV0 *^* INV1) (M, R, fl, isr) (M', R', fl', isr')). apply (prepost_weaken_post (mQ' := INV0 *^* INV1) Hshift). intros Mx H. apply (choice_elim_left H); unfold itr_enabled; auto. split. sep on. assert (HMx : S_Mem (M, R, fl, isr) ||- (Aemp) *^* (stkSpacePrec (sp - 4) (40 + 6 + IH_Stk - 4) *^* sp - 4 |->w lk *^* sp - 2 |->w bp *^* sp |->w pc *^* sp + 2 |->w cv *^* sp + 4 |->w lk *^* mP)). sep matchH HM with 4. substH HM with (prepost_elim Hshift' precise_emp HMx). sep on. sep matchH HM with 5. simplS in * . subst R' isr'. repeat split_l; trivial. simpl. split. exists p_cond_wait_b; exists g_cond_wait_b. split_l. (* lookup *) split. (* p ==> p' *) unfold p_cond_wait_a, p_cond_wait_b. intros S' H. unfold linkPG in H. destruct H as [S [HS HSS']]. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) unfold g_cond_wait_a, g_cond_wait_b. unfold linkPG, conjPG, conjG. intros S S'' H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. intros mP lk cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_a in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_a in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_wait_a. exists lk; exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_wait_a. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_a in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_wait_a in * . simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_waitc: NH_WFcmd (SCAP_consCT (cond_wait +1 +1 +1 +1 +1 +1 +1 +1 +1 +1 +1 +1) (Ast p_cond_wait_c g_cond_wait_c 1) psi_cond_wait) (cond_wait +1 +1 +1 +1 +1 +1 +1 +1 +1 +1 +1) (Ast p_cond_wait_b g_cond_wait_b 1) (comml (_call l_acquire)). Proof. set (cond_wait_b := cond_wait +1 +1 +1 +1 +1 +1 +1 +1 +1 +1 +1). assert(Hpp' : forall lk cv bp sp pc mQ mP S S', Ast_cond_wait_b lk cv bp sp pc mP S -> nextS (cond_wait_b) (comml (_call l_acquire)) S S' -> mQ = (stkSpacePrec (sp - 6 - _STK_SIZE_l_acquire) (_STK_SIZE_cond_wait - 6 - _STK_SIZE_l_acquire) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk)) -> Ast_l_acquire_pre lk (S_RF S BP) (sp - 6) (cond_wait_b + 1) (mQ *^* mP) S'). intros lk cv bp sp pc mQ mP S S'. intros HS HSS' HmQ. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold Ast_cond_wait_b in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspx [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. unfold Ast_l_acquire_pre. simplS in * . reg simpl. split. sep on. rewrite HSP. assert (H1 : sp - 4 - 2 = sp - 6). generalize Hsp; clearall; omega. rewrite H1. subst mQ. sep lift 3. sep_update. sep lift 2 in HM. sep stksplit in HM. rewrite H1 in HM. assert (H2 : _STK_SIZE_cond_wait - 4 - 2 = _STK_SIZE_cond_wait - 6). clearall; omega. rewrite H2 in HM. assert (H3 : _STK_SIZE_cond_wait - 6 >= _STK_SIZE_l_acquire). unfold _STK_SIZE_l_acquire. clearall; omega. assert (H4 : sp - 6 >= _STK_SIZE_l_acquire). unfold _STK_SIZE_l_acquire. generalize Hsp; clearall; omega. sep stksplit _STK_SIZE_l_acquire in HM. assert (H5 : sp - 6 + 2 = sp - 4). generalize Hsp; clearall; omega. rewrite H5. sep matchH HM with 11. split_l. split. rewrite HSP; omega. auto. assert (Hpp''' : forall lk cv bp sp pc pc' mP S S' S'' S''', Ast_cond_wait_b lk cv bp sp pc mP S -> nextS (cond_wait_b) (comml (_call l_acquire)) S S' -> l_acquire_grt S' S'' -> nextS pc' (comms (_retw)) S'' S''' -> Ast_cond_wait_c lk cv bp sp pc mP S'''). intros lk cv bp sp pc pc' mP. intros S S' S'' S''' HS HSS' HS'S'' HS''S'''. substH HS'S'' with (g_l_acquire_sound _ _ HS'S''). unfold g_l_acquire in HS'S''. set (mQ := (stkSpacePrec (sp - 6 - _STK_SIZE_l_acquire) (_STK_SIZE_cond_wait - 6 - _STK_SIZE_l_acquire) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk))). assert (HS' : Ast_l_acquire_pre lk (S_RF S BP) (sp - 6) (cond_wait_b + 1) (mQ *^* mP) S'). eapply Hpp'; eauto. assert (HS'' := HS'S'' _ _ _ _ _ HS'). subst mQ. clear HS'S''. unfold Ast_l_acquire_post in HS''. unfold Ast_cond_wait_c. unfold Ast_cond_wait_b in HS. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. simplS in * . destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pcx [Hlds HR''']]. destruct HS'' as [HM'' [HBP'' [HSP'' [Hlkx [Hif'' Hisr'']]]]]. assert (Hpcx : pcx = cond_wait_b + 1). subst R' M''' R'''. subst fl' isr' fl''' isr'''. rewrite HSP'' in Hlds; clear HSP''. sep on. sep lift 3 in HM''. sep_inj. auto. subst pcx; clear Hlds. subst M''' R''' fl''' isr'''. reg simpl. rewrite HSP''. assert (H5 : sp - 6 + 2 = sp - 4). generalize Hsp; clearall; omega. rewrite H5 in HM''. split. sep on. sep matchH HM'' with 11. sep stksplit. assert (H1 : sp - 4 - 2 = sp - 6). generalize Hsp; clearall; omega. rewrite H1. assert (H2 : _STK_SIZE_cond_wait - 4 - 2 = _STK_SIZE_cond_wait - 6). clearall; omega. rewrite H2. assert (H3 : _STK_SIZE_cond_wait - 6 >= _STK_SIZE_l_acquire). unfold _STK_SIZE_l_acquire. clearall; omega. assert (H4 : sp - 6 >= _STK_SIZE_l_acquire). unfold _STK_SIZE_l_acquire. generalize Hsp; clearall; omega. sep stksplit _STK_SIZE_l_acquire. sep matchH HM'' with 3. repeat split_l; trivial. simpl. split. right. split. apply l_acquire_not_prim. exists l_acquire_Prd; exists p_cond_wait_c. exists l_acquire_grt; exists g_cond_wait_c. split. unfold psi_cond_wait; auto. split_l. split. clear Hpp' Hpp'''. unfold enable, p_cond_wait_b. intros S HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_b in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. (* enable call *) destruct S as [[[M R] fl] isr]. simplS in * . exists (MemUpdW M (sp - 4 - 2) (cond_wait_b+1) 0, RF_update R SP (sp - 4 - 2), fl, isr). apply nextS_call. unfold pushW. split. rewrite HSP. sep on. sep lift 2 in HM. sep stksplit 2 in HM. sep lift 0 in HM. sep trivial. split. rewrite HSP. apply MemUpdW_MemUpd16 with 0; trivial. rewrite HSP; trivial. split. (* g' => fun_frame *) unfold sp_call_pred, fun_frame. unfold linkPG, conjPG. intros S' S'' HS'S''. destruct HS'S'' as [H HS'S'']. destruct H as [S [HS HSS']]. substH HS'S'' with (g_l_acquire_sound _ _ HS'S''). unfold g_l_acquire in HS'S''. unfold p_cond_wait_b in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. set (mQ := (stkSpacePrec (sp - 6 - _STK_SIZE_l_acquire) (_STK_SIZE_cond_wait - 6 - _STK_SIZE_l_acquire) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk))). assert (HS' : Ast_l_acquire_pre lk (S_RF S BP) (sp - 6) (cond_wait_b+1) (mQ *^* mTrue) S'). eapply Hpp'; eauto. clear Hpp' HS HSS' Hpp'''. substH HS'S'' with (HS'S'' _ _ _ _ _ HS'). rename HS'S'' into HS''. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. simplS in * . unfold Ast_l_acquire_pre, Ast_l_acquire_post in * . destruct HS' as [HM' [HBP' [HSP' [Hlk' [Hif' Hisr']]]]]. destruct HS'' as [HM'' [HBP'' [HSP'' [Hlk'' [Hif'' Hisr'']]]]]. simplS in * . split. rewrite HSP'; rewrite HSP''; trivial. unfold Ret_Addr. exists (cond_wait_b + 1). simplS. split. intros pc''. apply nextPC_retw with (sp - 6); trivial. clear HM''. sep on. subst mQ. sep lift 3 in HM'. sep trivial. intros pc''. apply nextPC_retw with (sp - 6); trivial. clear HM'. sep on. subst mQ. sep lift 3 in HM''. sep trivial. split. (* p => p' *) intros S' H. unfold conjPG, conjG, linkPG in H. destruct H as [S [HS HnextSS']]. apply p_l_acquire_sound. unfold p_cond_wait_b in HS. unfold p_l_acquire. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists (S_RF S BP); exists (sp - 6); exists (cond_wait_b + 1). set (mQ := (stkSpacePrec (sp - 6 - _STK_SIZE_l_acquire) (_STK_SIZE_cond_wait - 6 - _STK_SIZE_l_acquire) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* (sp + 4 |->w lk))). assert (HS' : Ast_l_acquire_pre lk (S_RF S BP) (sp - 6) (cond_wait_b + 1) (mQ *^* mTrue) S'). eapply Hpp'; eauto. clear Hpp''' HS HnextSS'. unfold Ast_l_acquire_pre in * . destruct HS' as [HM' [HBP' [HSP' [Hlk' [Hif' Hisr']]]]]. split. sep on. sep matchH HM' with 10. auto. split. (* p => p''' *) intros pc' S'''. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S H]. destruct H as [HS H]. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. unfold p_cond_wait_b, p_cond_wait_c in * . destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. eapply Hpp'''; eauto. (* g''' => g *) intros pc' S S'''' H. unfold conjPG, wrap_fun, conjG, linkPG in H. destruct H as [S''' [HS HS'''S'''']]. destruct HS as [HSx [S'' [Hx HnextS'']]]. destruct Hx as [S' [HSS' HS'S'']]. unfold g_cond_wait_b, g_cond_wait_c in * . intros mP lk cv bp sp pc HS. eapply HS'''S''''; eauto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_b in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_b in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_b in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_cond_wait_b in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma wff_cmd_cond_waitd: NH_WFcmd (SCAP_consCT (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_d g_cond_wait_d 1) psi_cond_wait) (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_c g_cond_wait_c 1) (comml _sti). Proof. set (cond_wait_c := cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1). assert (Hpp': forall lk cv bp sp pc mP S S', Ast_cond_wait_c lk cv bp sp pc mP S -> gsti S S' -> Ast_cond_wait_d lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold linkPG, conjPG, conjG. unfold Ast_cond_wait_c, gsti, Ast_cond_wait_d in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. assert (Hshift' : prepost (INV0 *^* INV1) Aemp (M, R, fl, isr) (M', R', fl', isr')). apply (prepost_weaken_pre (mP':=INV0 *^* INV1) Hshift). intros Mx HMx. assert (Hitr : ~ itr_enabled (M, R, fl, isr)). unfold itr_enabled. intros [H1 H2]. simplS in * . rewrite Hif in H1; discriminate H1. eapply choice_elim_right; eauto. clear Hshift; rename Hshift' into Hshift. split. sep on. substH HM with (prepost_elim Hshift Prec01 HM). sep on. simplS in * . sep matchH HM with 6. sep trivial. simplS in * . subst R' isr'. repeat split_l; trivial. simpl. split. exists p_cond_wait_d; exists g_cond_wait_d. split_l. split. (* enable *) unfold enable_sti. intros S HS. unfold p_cond_wait_c in HS. unfold pTrue, pmstar, choice. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_c in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . destruct HM as [M2 [M1 [HJM [HM2 HM1]]]]. exists M1; exists M2. split. auto with PMap. split_l. right. split_r. intros [H1 H2]. simplS in * . rewrite Hif in H1; discriminate H1. split. (* p ==> p' *) unfold p_cond_wait_c, p_cond_wait_d. intros S' H. unfold linkPG in H. destruct H as [S [HS HSS']]. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) unfold g_cond_wait_c, g_cond_wait_d. unfold linkPG, conjPG, conjG. intros S S'' H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. intros mP lk cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_c in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_c in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_c in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_cond_wait_c in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma wff_cmd_cond_waite: NH_WFcmd (SCAP_consCT (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_e g_cond_wait_e 1) psi_cond_wait) (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_d g_cond_wait_d 1) (comml (_addw (Opr_imm 2) SP)). Proof. set (cond_wait_d := cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1). assert (Hpp' : forall lk cv bp sp pc mP S S', Ast_cond_wait_d lk cv bp sp pc mP S -> nextS (cond_wait_d) (comml (_addw (Opr_imm 2) SP)) S S' -> Ast_cond_wait_e lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_wait_d, Ast_cond_wait_e in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. subst M' R' isr'. split. sep on. sep matchH HM with 5. sep stksplit. assert (H1 : sp - 2 - 2 = sp - 4). generalize Hsp; clearall; omega. rewrite H1. assert (H2 : _STK_SIZE_cond_wait - 2 - 2 = _STK_SIZE_cond_wait - 4). clearall; omega. rewrite H2. sep matchH HM with 2. reg simpl. unfold opr_eval. rewrite HSP. split_l by (generalize Hsp; clearall; omega). repeat split_l; trivial. unfold trash_fl in Hfl'. destruct Hfl'; subst fl'; auto. split. simpl. exists p_cond_wait_e; exists g_cond_wait_e. split_l. split. (* enable addw *) apply trivial_enable_addw. split. (* p ==> p' *) unfold p_cond_wait_d, p_cond_wait_e. intros S' H. unfold linkPG in H. destruct H as [S H]. simpl in H. destruct H as [H HnextS]. destruct H as [lk [cv [bp [sp [pc H]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[HSx HnextS] HS'S'']]. unfold g_cond_wait_d, g_cond_wait_e in * . intros mP lk cv bp sp pc HS. eapply HS'S''; eauto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_d in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_d in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_wait_d. exists lk; exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_wait_d. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_d in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_wait_d in * . simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_waitf: NH_WFcmd (SCAP_consCT (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_f g_cond_wait_f 1) psi_cond_wait) (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_e g_cond_wait_e 1) (comml (_popw BP)). Proof. set (cond_wait_e := cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1). assert (Hpp' : forall lk cv bp sp pc mP S S', Ast_cond_wait_e lk cv bp sp pc mP S -> nextS cond_wait_e (comml (_popw BP)) S S' -> Ast_cond_wait_f lk cv bp sp pc mP S'). intros lk cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_wait_e, Ast_cond_wait_f in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [bpx [Hlds HR']]. simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. assert (Heq : bp = bpx). sep on. sep lift 1 in HM. rewrite HSP in Hlds. sep inj. auto. subst bpx. subst M' fl' R' isr'. split. sep on. sep matchH HM with 5. sep stksplit. sep matchH HM with 2. rewrite HSP. reg simpl. split_l. split_l by omega. auto. simpl. split. exists p_cond_wait_f; exists g_cond_wait_f. split_l. split. (* enable *) apply enable_popw. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_cond_wait_e in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_e in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. simplS in * . rewrite HSP. sep on. sep lift 1 in HM. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_cond_wait_e, p_cond_wait_f. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. exists lk; exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. unfold g_cond_wait_e, g_cond_wait_f in * . intros mP lk cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_e in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_e in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_wait_e. exists lk; exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_wait_e. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_8 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_wait_e in * . simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_wait10: NH_WFiseq psi_cond_wait (cond_wait + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_wait_f g_cond_wait_f 1) (sseq _retw). Proof. constructor. simpl. split. split_l. intros S HS. unfold g_cond_wait_f, p_cond_wait_f in * . unfold Ast_cond_wait_f, Ast_cond_wait_post, Ast_cond_wait_f. intros mP lk cv bp sp pc H. InvertAll. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_wait_f in HS. destruct HS as [lk [cv [bp [sp [pc HS]]]]]. unfold Ast_cond_wait_f in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_wait_f. exists lk; exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_wait_f. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_wait_f in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP lk cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_wait_f in * . simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hlk [Hif Hisr]]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cond_wait: NH_WFiseq psi_cond_wait cond_wait (Ast p_cond_wait g_cond_wait 1) I_cond_wait. Proof. unfold I_cond_wait. apply nh_isq_seq with p_cond_wait_1 g_cond_wait_1. apply wff_cmd_cond_wait1. apply nh_isq_seq with p_cond_wait_2 g_cond_wait_2. apply wff_cmd_cond_wait2. apply nh_isq_seq with p_cond_wait_3 g_cond_wait_3. apply wff_cmd_cond_wait3. apply nh_isq_seq with p_cond_wait_4 g_cond_wait_4. apply wff_cmd_cond_wait4. apply nh_isq_seq with p_cond_wait_5 g_cond_wait_5. apply wff_cmd_cond_wait5. apply nh_isq_seq with p_cond_wait_6 g_cond_wait_6. apply wff_cmd_cond_wait6. apply nh_isq_seq with p_cond_wait_7 g_cond_wait_7. apply wff_cmd_cond_wait7. apply nh_isq_seq with p_cond_wait_8 g_cond_wait_8. apply wff_cmd_cond_wait8. apply nh_isq_seq with p_cond_wait_9 g_cond_wait_9. apply wff_cmd_cond_wait9. apply nh_isq_seq with p_cond_wait_a g_cond_wait_a. apply wff_cmd_cond_waita. apply nh_isq_seq with p_cond_wait_b g_cond_wait_b. apply wff_cmd_cond_waitb. apply nh_isq_seq with p_cond_wait_c g_cond_wait_c. apply wff_cmd_cond_waitc. apply nh_isq_seq with p_cond_wait_d g_cond_wait_d. apply wff_cmd_cond_waitd. apply nh_isq_seq with p_cond_wait_e g_cond_wait_e. apply wff_cmd_cond_waite. apply nh_isq_seq with p_cond_wait_f g_cond_wait_f. apply wff_cmd_cond_waitf. apply wff_cmd_cond_wait10. Qed. coq/examples/Makefile0000644000107400000620000001071011000223244014316 0ustar shaosystems############################################################################## ## The Calculus of Inductive Constructions ## ## ## ## Projet Coq ## ## ## ## INRIA ENS-CNRS ## ## Rocquencourt Lyon ## ## ## ## Coq V7 ## ## ## ## ## ############################################################################## # WARNING # # This Makefile has been automagically generated by coq_makefile # Edit at your own risks ! # # END OF WARNING # # This Makefile was generated by the command line : # coq_makefile -I .. -I ../CAP0 -I ../SCAP -I ../miniOS -I . Assembly.v cond_signal.v cond_wait.v lock_acquire.v lock_release.v SyncUtil.v # ########################## # # # Variables definitions. # # # ########################## CAMLP4LIB=`camlp4 -where` COQSRC=-I $(COQTOP)/kernel -I $(COQTOP)/lib \ -I $(COQTOP)/library -I $(COQTOP)/parsing \ -I $(COQTOP)/pretyping -I $(COQTOP)/interp \ -I $(COQTOP)/proofs -I $(COQTOP)/syntax -I $(COQTOP)/tactics \ -I $(COQTOP)/toplevel -I $(COQTOP)/contrib/correctness \ -I $(COQTOP)/contrib/extraction -I $(COQTOP)/contrib/field \ -I $(COQTOP)/contrib/fourier -I $(COQTOP)/contrib/graphs \ -I $(COQTOP)/contrib/interface -I $(COQTOP)/contrib/jprover \ -I $(COQTOP)/contrib/omega -I $(COQTOP)/contrib/romega \ -I $(COQTOP)/contrib/ring -I $(COQTOP)/contrib/xml \ -I $(CAMLP4LIB) ZFLAGS=$(OCAMLLIBS) $(COQSRC) OPT= COQFLAGS=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML) COQC=$(COQBIN)coqc GALLINA=gallina COQDOC=$(COQBIN)coqdoc CAMLC=ocamlc -c CAMLOPTC=ocamlopt -c CAMLLINK=ocamlc CAMLOPTLINK=ocamlopt COQDEP=$(COQBIN)coqdep -c GRAMMARS=grammar.cma CAMLP4EXTEND=pa_extend.cmo pa_ifdef.cmo q_MLast.cmo PP=-pp "camlp4o -I . -I $(COQTOP)/parsing $(CAMLP4EXTEND) $(GRAMMARS) -impl" ######################### # # # Libraries definition. # # # ######################### OCAMLLIBS=-I .\ -I ..\ -I ../CAP0\ -I ../SCAP\ -I ../miniOS\ -I . COQLIBS=-I .\ -I ..\ -I ../CAP0\ -I ../SCAP\ -I ../miniOS\ -I . ################################### # # # Definition of the "all" target. # # # ################################### VFILES=Assembly.v\ cond_signal.v\ cond_wait.v\ lock_acquire.v\ lock_release.v\ SyncUtil.v VOFILES=$(VFILES:.v=.vo) VIFILES=$(VFILES:.v=.vi) GFILES=$(VFILES:.v=.g) HTMLFILES=$(VFILES:.v=.html) GHTMLFILES=$(VFILES:.v=.g.html) all: Assembly.vo\ cond_signal.vo\ cond_wait.vo\ lock_acquire.vo\ lock_release.vo\ SyncUtil.vo spec: $(VIFILES) gallina: $(GFILES) html: $(HTMLFILES) gallinahtml: $(GHTMLFILES) all.ps: $(VFILES) $(COQDOC) -ps -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` all-gal.ps: $(VFILES) $(COQDOC) -ps -g -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` #################### # # # Special targets. # # # #################### .PHONY: all opt byte archclean clean install depend html .SUFFIXES: .v .vo .vi .g .html .tex .g.tex .g.html .v.vo: $(COQC) $(COQDEBUG) $(COQFLAGS) $* .v.vi: $(COQC) -i $(COQDEBUG) $(COQFLAGS) $* .v.g: $(GALLINA) $< .v.tex: $(COQDOC) -latex $< -o $@ .v.html: $(COQDOC) -html $< -o $@ .v.g.tex: $(COQDOC) -latex -g $< -o $@ .v.g.html: $(COQDOC) -html -g $< -o $@ byte: $(MAKE) all "OPT=" opt: $(MAKE) all "OPT=-opt" include .depend .depend depend: rm -f .depend $(COQDEP) -i $(COQLIBS) $(VFILES) *.ml *.mli >.depend $(COQDEP) $(COQLIBS) -suffix .html $(VFILES) >>.depend install: mkdir -p `$(COQC) -where`/user-contrib cp -f $(VOFILES) `$(COQC) -where`/user-contrib clean: rm -f *.cmo *.cmi *.cmx *.o $(VOFILES) $(VIFILES) $(GFILES) *~ rm -f all.ps all-gal.ps $(HTMLFILES) $(GHTMLFILES) archclean: rm -f *.cmx *.o html: # WARNING # # This Makefile has been automagically generated by coq_makefile # Edit at your own risks ! # # END OF WARNING coq/examples/.depend0000644000107400000620000001442011000223405014117 0ustar shaosystemsAssembly.vo: Assembly.v ../Machine.vo ../Operational_Semantics.vo ../SCAP/AIM.vo ../miniOS/Kernel.vo Assembly.vi: Assembly.v ../Machine.vo ../Operational_Semantics.vo ../SCAP/AIM.vo ../miniOS/Kernel.vo cond_signal.vo: cond_signal.v ../Coqlib.vo ../Machine.vo ../Mem_Lemmas.vo ../Assertion.vo ../Assertion_Lemmas.vo ../Assertion_Lemmas4.vo ../Assertion_Lemmas5.vo ../Operational_Semantics.vo ../OpSem_Lemmas.vo ../OpSem_Lemmas2.vo ../Reg.vo ../SCAP/AIM.vo ../SCAP/AIM_Lemmas.vo ../SCAP/QLib.vo ../SCAP/SCAP.vo ../SCAP/SCAP_READY.vo ../SCAP/Linking.vo ../SCAP/Linking_Lemmas2.vo Assembly.vo SyncUtil.vo cond_signal.vi: cond_signal.v ../Coqlib.vo ../Machine.vo ../Mem_Lemmas.vo ../Assertion.vo ../Assertion_Lemmas.vo ../Assertion_Lemmas4.vo ../Assertion_Lemmas5.vo ../Operational_Semantics.vo ../OpSem_Lemmas.vo ../OpSem_Lemmas2.vo ../Reg.vo ../SCAP/AIM.vo ../SCAP/AIM_Lemmas.vo ../SCAP/QLib.vo ../SCAP/SCAP.vo ../SCAP/SCAP_READY.vo ../SCAP/Linking.vo ../SCAP/Linking_Lemmas2.vo Assembly.vo SyncUtil.vo cond_wait.vo: cond_wait.v ../Coqlib.vo ../Machine.vo ../Reg.vo ../Mem_Lemmas.vo ../Assertion.vo ../Assertion_Lemmas.vo ../Assertion_Lemmas3.vo ../Assertion_Lemmas4.vo ../Assertion_Lemmas5.vo ../Operational_Semantics.vo ../OpSem_Lemmas.vo ../OpSem_Lemmas2.vo ../SCAP/AIM.vo ../SCAP/AIM_Lemmas.vo ../SCAP/QLib.vo ../SCAP/SCAP.vo ../SCAP/SCAP_READY.vo ../SCAP/Linking.vo Assembly.vo SyncUtil.vo ../miniOS/Kernel.vo ../miniOS/SleepSpec.vo lock_release.vo lock_acquire.vo cond_wait.vi: cond_wait.v ../Coqlib.vo ../Machine.vo ../Reg.vo ../Mem_Lemmas.vo ../Assertion.vo ../Assertion_Lemmas.vo ../Assertion_Lemmas3.vo ../Assertion_Lemmas4.vo ../Assertion_Lemmas5.vo ../Operational_Semantics.vo ../OpSem_Lemmas.vo ../OpSem_Lemmas2.vo ../SCAP/AIM.vo ../SCAP/AIM_Lemmas.vo ../SCAP/QLib.vo ../SCAP/SCAP.vo ../SCAP/SCAP_READY.vo ../SCAP/Linking.vo Assembly.vo SyncUtil.vo ../miniOS/Kernel.vo ../miniOS/SleepSpec.vo lock_release.vo lock_acquire.vo lock_acquire.vo: lock_acquire.v ../Coqlib.vo ../Machine.vo ../Assertion.vo ../Assertion_Lemmas.vo ../Assertion_Lemmas4.vo ../Assertion_Lemmas5.vo ../Operational_Semantics.vo ../OpSem_Lemmas.vo ../OpSem_Lemmas2.vo ../Reg.vo ../Mem_Lemmas.vo ../SCAP/AIM.vo ../SCAP/QLib.vo ../SCAP/SCAP.vo ../SCAP/SCAP_READY.vo ../SCAP/Linking.vo ../SCAP/Linking_Lemmas.vo Assembly.vo SyncUtil.vo ../miniOS/Kernel.vo ../miniOS/SleepSpec.vo lock_acquire.vi: lock_acquire.v ../Coqlib.vo ../Machine.vo ../Assertion.vo ../Assertion_Lemmas.vo ../Assertion_Lemmas4.vo ../Assertion_Lemmas5.vo ../Operational_Semantics.vo ../OpSem_Lemmas.vo ../OpSem_Lemmas2.vo ../Reg.vo ../Mem_Lemmas.vo ../SCAP/AIM.vo ../SCAP/QLib.vo ../SCAP/SCAP.vo ../SCAP/SCAP_READY.vo ../SCAP/Linking.vo ../SCAP/Linking_Lemmas.vo Assembly.vo SyncUtil.vo ../miniOS/Kernel.vo ../miniOS/SleepSpec.vo lock_release.vo: lock_release.v ../Coqlib.vo ../Machine.vo ../Assertion.vo ../Assertion_Lemmas.vo ../Assertion_Lemmas4.vo ../Assertion_Lemmas5.vo ../Operational_Semantics.vo ../OpSem_Lemmas.vo ../OpSem_Lemmas2.vo ../Reg.vo ../Mem_Lemmas.vo ../SCAP/AIM.vo ../SCAP/QLib.vo ../SCAP/SCAP.vo ../SCAP/SCAP_READY.vo ../SCAP/Linking.vo ../SCAP/Linking_Lemmas.vo Assembly.vo SyncUtil.vo ../Arith_Lemmas.vo lock_release.vi: lock_release.v ../Coqlib.vo ../Machine.vo ../Assertion.vo ../Assertion_Lemmas.vo ../Assertion_Lemmas4.vo ../Assertion_Lemmas5.vo ../Operational_Semantics.vo ../OpSem_Lemmas.vo ../OpSem_Lemmas2.vo ../Reg.vo ../Mem_Lemmas.vo ../SCAP/AIM.vo ../SCAP/QLib.vo ../SCAP/SCAP.vo ../SCAP/SCAP_READY.vo ../SCAP/Linking.vo ../SCAP/Linking_Lemmas.vo Assembly.vo SyncUtil.vo ../Arith_Lemmas.vo SyncUtil.vo: SyncUtil.v ../Coqlib.vo ../Machine.vo ../Assertion.vo ../Assertion_Lemmas.vo ../Operational_Semantics.vo ../SCAP/AIM.vo ../SCAP/QLib.vo ../Assertion_Lemmas4.vo ../SCAP/SCAP.vo ../SCAP/SCAP_READY.vo ../SCAP/Linking.vo Assembly.vo ../Arith_Lemmas.vo ../miniOS/Kernel.vo SyncUtil.vi: SyncUtil.v ../Coqlib.vo ../Machine.vo ../Assertion.vo ../Assertion_Lemmas.vo ../Operational_Semantics.vo ../SCAP/AIM.vo ../SCAP/QLib.vo ../Assertion_Lemmas4.vo ../SCAP/SCAP.vo ../SCAP/SCAP_READY.vo ../SCAP/Linking.vo Assembly.vo ../Arith_Lemmas.vo ../miniOS/Kernel.vo Assembly.html: Assembly.v ../Machine.html ../Operational_Semantics.html ../SCAP/AIM.html ../miniOS/Kernel.html cond_signal.html: cond_signal.v ../Coqlib.html ../Machine.html ../Mem_Lemmas.html ../Assertion.html ../Assertion_Lemmas.html ../Assertion_Lemmas4.html ../Assertion_Lemmas5.html ../Operational_Semantics.html ../OpSem_Lemmas.html ../OpSem_Lemmas2.html ../Reg.html ../SCAP/AIM.html ../SCAP/AIM_Lemmas.html ../SCAP/QLib.html ../SCAP/SCAP.html ../SCAP/SCAP_READY.html ../SCAP/Linking.html ../SCAP/Linking_Lemmas2.html Assembly.html SyncUtil.html cond_wait.html: cond_wait.v ../Coqlib.html ../Machine.html ../Reg.html ../Mem_Lemmas.html ../Assertion.html ../Assertion_Lemmas.html ../Assertion_Lemmas3.html ../Assertion_Lemmas4.html ../Assertion_Lemmas5.html ../Operational_Semantics.html ../OpSem_Lemmas.html ../OpSem_Lemmas2.html ../SCAP/AIM.html ../SCAP/AIM_Lemmas.html ../SCAP/QLib.html ../SCAP/SCAP.html ../SCAP/SCAP_READY.html ../SCAP/Linking.html Assembly.html SyncUtil.html ../miniOS/Kernel.html ../miniOS/SleepSpec.html lock_release.html lock_acquire.html lock_acquire.html: lock_acquire.v ../Coqlib.html ../Machine.html ../Assertion.html ../Assertion_Lemmas.html ../Assertion_Lemmas4.html ../Assertion_Lemmas5.html ../Operational_Semantics.html ../OpSem_Lemmas.html ../OpSem_Lemmas2.html ../Reg.html ../Mem_Lemmas.html ../SCAP/AIM.html ../SCAP/QLib.html ../SCAP/SCAP.html ../SCAP/SCAP_READY.html ../SCAP/Linking.html ../SCAP/Linking_Lemmas.html Assembly.html SyncUtil.html ../miniOS/Kernel.html ../miniOS/SleepSpec.html lock_release.html: lock_release.v ../Coqlib.html ../Machine.html ../Assertion.html ../Assertion_Lemmas.html ../Assertion_Lemmas4.html ../Assertion_Lemmas5.html ../Operational_Semantics.html ../OpSem_Lemmas.html ../OpSem_Lemmas2.html ../Reg.html ../Mem_Lemmas.html ../SCAP/AIM.html ../SCAP/QLib.html ../SCAP/SCAP.html ../SCAP/SCAP_READY.html ../SCAP/Linking.html ../SCAP/Linking_Lemmas.html Assembly.html SyncUtil.html ../Arith_Lemmas.html SyncUtil.html: SyncUtil.v ../Coqlib.html ../Machine.html ../Assertion.html ../Assertion_Lemmas.html ../Operational_Semantics.html ../SCAP/AIM.html ../SCAP/QLib.html ../Assertion_Lemmas4.html ../SCAP/SCAP.html ../SCAP/SCAP_READY.html ../SCAP/Linking.html Assembly.html ../Arith_Lemmas.html ../miniOS/Kernel.html coq/examples/lock_release.v0000644000107400000620000045133511000223244015511 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Add LoadPath "../miniOS". Require Import Coqlib. Require Import List. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas5. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import Reg. Require Import Mem_Lemmas. Require Import AIM. Require Import QLib. Require Import SCAP. Require Import SCAP_READY. Require Import Linking. Require Import Linking_Lemmas. Require Import Omega. Require Import Assembly. Require Import SyncUtil. Require Import Arith_Lemmas. (* NOTE: in List lib, there is also a definition of "seq" *) (* so we have to import List earlier than Machine to shadow *) (* the "seq" defined in List *) (* the stack space required by l_release *) Definition stk_l_release := 6 + _UNBLK_Stk. Definition l_release_MPost (sp l pc : Label) (M : Mem) : Prop := ((sp |->w pc) *^* (sp + 2 |->w l) *^* stkSpacePrec sp stk_l_release *^* INV1 *^* INV0) M /\ In l lockSet_H. Definition l_release_MPre (sp l pc: Label) : MPred := (sp |->w pc) *^* (sp + 2 |->w l) *^* stkSpacePrec sp stk_l_release *^* INV1 *^* INV0 *^* Gamma l. Definition l_release_MPre_tmp (sp l pc: Label) : MPred := (l_release_MPost sp l pc) *^* (Gamma l). Definition l_release_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ ((l_release_MPre sp l pc) *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_release_Prd_aux_tmp (sp l pc bp : Label) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (l_release_MPre_tmp sp l pc) M /\ fl _IF = false /\ isr = false end. Definition l_release_Prd (S : State) : Prop := exists sp, exists l, exists pc, exists bp, exists mP, l_release_Prd_aux sp l pc bp mP S. Definition l_release_Prd_tmp (S : State) : Prop := imprec (fun S => exists sp, exists l, exists pc, exists bp, l_release_Prd_aux_tmp sp l pc bp S) S. Lemma adapt_Prd_0: forall S, l_release_Prd S -> l_release_Prd_tmp S. Proof. intros. induction S as (((M, R), fl), isr). unfold l_release_Prd in H. unfold l_release_Prd_tmp. unfold l_release_Prd_aux in H. InvertAll. destruct H1 as [M1 [M2 [HMsplit [Hmem Hframe]]]]. unfold imprec. unfold pmstar. exists M1. exists M2. split_l. unfold mTrue. split_r. exists x. exists x0. exists x1. exists x2. unfold l_release_Prd_aux_tmp. UnfoldStateAll. split_l. split_l. split; auto. unfold l_release_MPre_tmp. unfold l_release_MPre in Hmem. unfold l_release_MPost. apply sep_pure_b. split; auto. Qed. Definition l_release_Post_aux (sp l pc bp : Label) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (l_release_MPost sp l pc) M /\ fl _IF = false /\ isr = false end. Definition l_release_Post_aux_0 (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ ((l_release_MPost sp l pc) *^* mP) M /\ fl _IF = false /\ isr = false end. Definition l_release_grt_tmp (S S' : State) : Prop := forall sp l pc bp, leadstoPQ (l_release_Prd_aux_tmp sp l pc bp) (l_release_Post_aux sp l pc bp) S S'. Definition l_release_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_release_Prd_aux sp l pc bp) (l_release_Post_aux_0 sp l pc bp) S S'. Lemma adapt_Grt_0: forall S S', l_release_grt_tmp S S' -> l_release_grt S S'. Proof. unfold l_release_grt_tmp. unfold l_release_grt. intros. unfold leadstoPQ2. intros. assert (leadstoPQ (l_release_Prd_aux_tmp sp l pc bp) (l_release_Post_aux sp l pc bp) S S'). apply H. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). unfold leadstoPQ in H1. unfold l_release_Prd_aux in H0. InvertAll. destruct H3 as [M1 [M2 [HMsplit [Hmem Hframe]]]]. assert (exists M1' : MemMod.Map, MemMod.disjUnion M1' M2 M' /\ l_release_Post_aux sp l pc bp (M1', R', fl', isr')). apply H1 with M1; auto. unfold l_release_Prd_aux_tmp. split_l. split_l. split; auto. unfold l_release_MPre_tmp. unfold l_release_MPost. apply sep_pure_b. split; auto. InvertAll. unfold l_release_Post_aux in H8. InvertAll. unfold l_release_Post_aux_0. split_l. split_l. split; auto. exists x. exists M2. split; auto. Qed. Definition l_rel_done_MPre (sp l pc : Label) (bp : int) : MPred := (sp |->w bp) *^* (sp+2 |->w pc) *^* (sp + 4 |->w l) *^* stkSpacePrec sp (stk_l_release - 2) *^* INV1 *^* INV0. Definition l_rel_done_Prd_aux (sp l pc : Label) (bp : int) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (l_rel_done_MPre (R SP) l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_rel_done_Prd (S : State) : Prop := exists sp, exists l, exists pc, exists bp, exists mP, l_rel_done_Prd_aux sp l pc bp mP S. Definition l_rel_done_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_rel_done_Prd_aux sp l pc bp) (l_release_Post_aux_0 (sp+2) l pc bp) S S'. Definition l_rel_done_spec := Ast l_rel_done_Prd l_rel_done_grt 1. Definition psi := SCAP_consCT l_rel_done l_rel_done_spec SCAP_emptCT. Lemma l_rel_done_in_psi: SCAP_lookupCT psi l_rel_done l_rel_done_spec. Proof. unfold SCAP_lookupCT. unfold psi. unfold SCAP_consCT. unfold SPSpec.lookup. simpl. left. auto. Qed. Definition l_release_spec := Ast l_release_Prd l_release_grt 1. (* spec for the next instruction *) Definition l_release1_MPre (sp l pc bp : Label) := fun (M : Mem) => l_release_MPre_tmp (sp + 2) l pc M /\ (sp |~>w bp) M. Definition l_release1_Prd_aux (sp l pc bp : Label) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ l_release1_MPre (R SP) l pc (R BP) M /\ fl _IF = false /\ isr = false end. Definition l_release1_Prd (S : State) := imprec (fun S => exists sp, exists l, exists pc, exists bp, l_release1_Prd_aux sp l pc bp S) S. Definition l_release1_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ (l_release1_Prd_aux sp l pc bp) (l_release_Post_aux (sp +2) l pc bp) S S'. Lemma l_release_MPost_stkSpace: forall M sp l pc m, (l_release_MPost sp l pc *^* m) M -> stkSpace sp stk_l_release M. Proof. intros. unfold l_release_MPost in H. assert ((sp |->w pc *^* sp + 2 |->w l *^* stkSpacePrec sp stk_l_release *^* INV1 *^* INV0 *^* m) M). unfold mstar at 1. unfold mstar at 1 in H. InvertAll. exists x. exists x0. split; auto. sep on. sep lift 2 in H0. sep trivial. Qed. Lemma l_release_Prd_aux_stkSpace: forall sp l pc bp S, l_release_Prd_aux_tmp sp l pc bp S -> stkSpace (S_RF S SP) stk_l_release (S_Mem S). Proof. intros. unfold l_release_Prd_aux_tmp in H. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. unfold l_release_MPre_tmp in H1. apply l_release_MPost_stkSpace with l pc (Gamma l). rewrite H0. auto. Qed. Lemma stk_l_rel_gt_2: stk_l_release >= 2. Proof. unfold stk_l_release. omega. Qed. Hint Resolve stk_l_rel_gt_2. Lemma stk_l_rel_N2_gt_2: stk_l_release - 2 >= 2. Proof. unfold stk_l_release. omega. Qed. Hint Resolve stk_l_rel_N2_gt_2. Lemma stk_l_rel_match_UNBLK: stk_l_release - 2 - 2 >= _UNBLK_Stk + 2. Proof. unfold stk_l_release. omega. Qed. Hint Resolve stk_l_rel_match_UNBLK. Lemma l_release_step1_Prd: forall sp l pc bp, pimp ((l_release_Prd_aux_tmp sp l pc bp) |> nextS l_release (comml (_pushwp (Opr_reg BP)))) (l_release1_Prd_aux (sp - 2) l pc bp). Proof. intros. unfold pimp. intros. unfold linkPG in H. InvertAll. induction x as (((M0, R0), fl0), isr0). induction S as (((M, R), fl), isr). unfold l_release1_Prd_aux. unfold l_release1_MPre. unfold l_release_Prd_aux_tmp in H. InvertAll. destruct (nextS_inversion H1) as [HM' [HR' [Hfl' Hisr']]]. rewrite H0 in HR'. rewrite HR'. split. reg simpl. auto. split. reg simpl. auto. split. unfold l_release_MPre_tmp. unfold l_release_MPre_tmp in H2. unfold l_release_MPost. unfold l_release_MPost in H2. substH H2 with (sep_pure_a (sp |->w pc *^* sp + 2 |->w l *^* stkSpacePrec sp stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) M0 H2). split. apply sep_pure_b. inversion_clear H2. split; auto. InvertAll. substH H9 with (MemUpd16_MemUpdW H9). destruct H9 as [junk H9]. simpl in H9. subst M. sep on. rewrite H. reg simpl. rewrite H0. rewrite H0 in H2. assert (sp - 2 + 2 = sp + 2 - 2). auto. assert (sp + 2 - 2 = sp). auto. rewrite H9 in H7. rewrite H7. sep lift 2. sep stk upd. sep lift 2 in H4. auto. reg simpl. rewrite H. InvertAll. simpl in H9. rewrite H0 in H9. rewrite H in H9. substH H9 with (MemUpd16_MemUpdW H9). destruct H9 as [junk H9]. subst M. sep on. sep upd. sep lift 2 in H4. assert (stk_l_release >= 2). auto. sep stksplit in H4. sep lift 1 in H4. sep_blur. subst fl isr. auto. Qed. Lemma l_release_sp_gt2: forall sp l pc bp S, l_release_Prd_aux_tmp sp l pc bp S -> sp - 2 + 2 = sp. Proof. intros. unfold l_release_Prd_aux_tmp in H. induction S as (((M, R), fl), isr). unfold l_release_MPre_tmp in H. unfold l_release_MPost in H. InvertAll. substH H1 with (sep_pure_a (sp |->w pc *^* sp + 2 |->w l *^* stkSpacePrec sp stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) M H1). inversion_clear H1. sep on. sep lift 2 in H3. assert (sp >= stk_l_release). apply stkSpacePrec_sp_ge_sz1 with M (INV1 *^* (INV0 *^* Gamma l) *^* (sp |->w pc *^* sp + 2 |->w l)); auto. assert (stk_l_release >= 2). auto. assert (sp >= 2). apply ge_trans with stk_l_release; auto. assert (sp - 2 + 2 = sp + 2 - 2). auto. rewrite H8. auto. Qed. Lemma l_release_Prd_IF_false: forall S : State, l_release_Prd S -> S_Flag S _IF = false. Proof. unfold l_release1_Prd. intros. induction S as (((M, R), fl), isr). unfold l_release_Prd in H. unfold l_release_Prd_aux in H. InvertAll. UnfoldStateAll. auto. Qed. Lemma l_release_Grt_Itr_Stk: Grt_Itr_Stk l_release_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_release_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H9 in H8. inversion H8. Qed. Lemma wff_cmd_l_release1: NH_WFcmd (SCAP_consCT (l_release + 1) (Ast l_release1_Prd l_release1_grt 1) psi) l_release (Ast l_release_Prd l_release_grt 1) (comml (_pushwp (Opr_reg BP))). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_release1_Prd. exists l_release1_grt. split. auto. assert (forall sp l pc bp, enable (l_release_Prd_aux_tmp sp l pc bp) (nextS l_release (comml (_pushwp (Opr_reg BP))))). intros. apply enable_pushwp with stk_l_release; auto. apply l_release_Prd_aux_stkSpace. assert (enable l_release_Prd_tmp (nextS l_release (comml (_pushwp (Opr_reg BP)))) /\ pimp (l_release_Prd_tmp |> nextS l_release (comml (_pushwp (Opr_reg BP)))) l_release1_Prd /\ gimp (l_release_Prd_tmp >o nextS l_release (comml (_pushwp (Opr_reg BP))) oo l_release1_grt) l_release_grt_tmp). unfold l_release_Prd_tmp. set (p := (fun S => exists sp, exists l, exists pc, exists bp, l_release_Prd_aux_tmp sp l pc bp S)). assert (enable p (nextS l_release (comml (_pushwp (Opr_reg BP))))). unfold p. apply forall_enable_exists_l_release; auto. assert (safe_mono (nextS l_release (comml (_pushwp (Opr_reg BP))))). apply safe_mono_pushwp; auto. split. unfold safe_mono in H1. apply H1; auto. assert (forall sp l pc bp, pimp ((l_release_Prd_aux_tmp sp l pc bp) |> nextS l_release (comml (_pushwp (Opr_reg BP)))) (l_release1_Prd_aux (sp - 2) l pc bp)). apply l_release_step1_Prd. split. unfold l_release1_Prd. set (p' := (fun S0 : State => exists sp : nat, exists l : nat, exists pc : nat, exists bp : nat, l_release1_Prd_aux sp l pc bp S0)). apply forall_pimp_exists_l_release with l_release_Prd_aux_tmp l_release1_Prd_aux; auto. intros. exists (a - 2). exists b. exists c. exists d. apply H2; auto. apply frame_pushwp. apply gimp_l_release with (fun x => x - 2) (fun x => x + 2) l_release_Prd_aux_tmp l_release1_Prd_aux l_release_Post_aux; auto. apply frame_pushwp. unfold gimp. unfold l_release_grt_tmp. intros. unfold leadstoPQ. intros. unfold leadstoPQ in H3. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). intros. assert (exists M1' : MemMod.Map, MemMod.disjUnion M1' M2 M' /\ l_release_Post_aux (sp - 2 + 2) l pc bp (M1', R', fl', isr')). apply H3 with M1; auto. InvertAll. exists x. split; auto. assert (sp - 2 + 2 = sp). apply l_release_sp_gt2 with l pc bp (M1, R, fl, isr); auto. rewrite H7 in H8. auto. InvertAll. split. unfold enable. unfold enable in H1. intros. apply H1. apply adapt_Prd_0; auto. split. unfold pimp. clear H1. unfold pimp in H0. intros. apply H0. unfold linkPG in H1. unfold linkPG. InvertAll. exists x. split; auto. apply adapt_Prd_0; auto. unfold gimp. intros. apply adapt_Grt_0. unfold gimp in H3. apply H3. clear H1 H0 H3. clear H. unfold conjG in *. unfold conjPG in *. InvertAll. exists x. split; auto. split; auto. apply adapt_Prd_0; auto. split. apply IF_false_Prd_Itr_Stk. apply l_release_Prd_IF_false. apply l_release_Grt_Itr_Stk. Qed. Definition l_release2_Prd_aux (sp l pc bp : Label) (S : State) : Prop := match S with (M, R, fl, isr) => R BP = sp /\ l_release1_Prd_aux sp l pc bp (M, RF_update R BP bp, fl, isr) end. Definition l_release2_Prd (S : State) := imprec (fun S => exists sp, exists l, exists pc, exists bp, l_release2_Prd_aux sp l pc bp S) S. Definition l_release2_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ (l_release2_Prd_aux sp l pc bp) (l_release_Post_aux (sp +2) l pc bp) S S'. Lemma l_release_step2_Prd: forall sp l pc bp : nat, pimp (l_release1_Prd_aux sp l pc bp |> nextS (l_release + 1) (comml (_movwp (Opr_reg SP) BP))) (l_release2_Prd_aux sp l pc bp). Proof. intros. unfold pimp. unfold l_release1_Prd_aux. unfold l_release2_Prd_aux. intros. induction S as (((M, R), fl), isr). unfold linkPG in H. InvertAll. induction x as (((M0, R0), fl0), isr0). destruct (nextS_inversion H1). InvertAll. simpl in H3. subst M R. split. reg simpl. auto. rewrite <- H. assert (RF_update (RF_update R0 BP (R0 SP)) BP (R0 BP) = R0). reg simpl. apply RF_update_prev; auto. rewrite H0. rewrite <- H4. unfold l_release1_Prd_aux. split; auto. split; auto. split; auto. subst fl isr. auto. Qed. Lemma l_release1_Grt_Itr_Stk: Grt_Itr_Stk l_release1_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_release1_grt. unfold leadstoPQ. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release1_Prd_aux in H5. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H9 in H8. inversion H8. Qed. Lemma l_release1_Prd_IF_false: forall S : State, l_release1_Prd S -> S_Flag S _IF = false. Proof. unfold l_release1_Prd. intros. induction S as (((M, R), fl), isr). unfold imprec in H. unfold pmstar in H. InvertAll. unfold l_release1_Prd_aux in H. UnfoldStateAll. InvertAll. auto. Qed. Hint Resolve l_release1_Prd_IF_false. Lemma wff_cmd_l_release2: NH_WFcmd (SCAP_consCT (l_release + 1 + 1) (Ast l_release2_Prd l_release2_grt 1) psi) (l_release + 1) (Ast l_release1_Prd l_release1_grt 1) (comml (_movwp (Opr_reg SP) BP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_release2_Prd. exists l_release2_grt. split. auto. split; auto. (* enable *) assert (forall sp l pc bp, pimp ((l_release1_Prd_aux sp l pc bp) |> nextS (l_release+1) (comml (_movwp (Opr_reg SP) BP))) (l_release2_Prd_aux sp l pc bp)). apply l_release_step2_Prd. unfold l_release1_Prd. set (p := (fun S0 : State => exists sp : nat, exists l : nat, exists pc : nat, exists bp : nat, l_release1_Prd_aux sp l pc bp S0)). split. unfold l_release2_Prd. set (p' := (fun S0 : State => exists sp : nat, exists l : nat, exists pc : nat, exists bp : nat, l_release2_Prd_aux sp l pc bp S0)). apply frame_rule_1; auto. unfold pimp. intros. unfold linkPG in H0. unfold p in H0. InvertAll. rename x into S0. rename x0 into sp. rename x1 into l. rename x2 into pc. rename x3 into bp. unfold p'. exists sp. exists l. exists pc. exists bp. unfold pimp in H. apply H. unfold linkPG. exists S0. split; auto. apply frame_movwp. unfold gimp. unfold conjG. unfold conjPG. intros. InvertAll. rename x into S0. unfold l_release1_grt. intros. unfold l_release2_grt in H2. assert (leadstoPQ (l_release2_Prd_aux sp l pc bp) (l_release_Post_aux (sp + 2) l pc bp) S0 S'). apply H2. clear H2. assert (pimp (l_release1_Prd_aux sp l pc bp |> nextS (l_release+1) (comml (_movwp (Opr_reg SP) BP))) (l_release2_Prd_aux sp l pc bp)). apply H. clear H. assert (gimp (nextS (l_release + 1) (comml (_movwp (Opr_reg SP) BP)) oo (leadstoPQ (l_release2_Prd_aux sp l pc bp) (l_release_Post_aux (sp+2) l pc bp))) (leadstoPQ (l_release1_Prd_aux sp l pc bp) (l_release_Post_aux (sp+2) l pc bp))). apply leadstoPQ_sameQ_reverseP; auto. apply frame_movwp. unfold gimp in H. apply H. unfold conjG. exists S0. split; auto. split. apply IF_false_Prd_Itr_Stk. auto. apply l_release1_Grt_Itr_Stk. Qed. (* _movwld (A_reg 4 BP) BX *) Definition l_release3_Prd_aux (sp l pc bp : Label) (S : State) : Prop := match S with (M, R, fl, isr) => R BX = l /\ exists bx, l_release2_Prd_aux sp l pc bp (M, RF_update R BX bx, fl, isr) end. Definition l_release3_Prd (S : State) := imprec (fun S => exists sp, exists l, exists pc, exists bp, l_release3_Prd_aux sp l pc bp S) S. Definition l_release3_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ (l_release3_Prd_aux sp l pc bp) (l_release_Post_aux (sp +2) l pc bp) S S'. Lemma l_release2_Prd_1: forall sp l pc bp S0, l_release2_Prd_aux sp l pc bp S0 -> ((addr_eval (S_RF S0) (A_reg 4 BP)) |~>w l) (S_Mem S0). Proof. unfold l_release2_Prd_aux. intros. induction S0 as (((M, R), fl), isr). unfold l_release1_Prd_aux in H. unfold l_release1_MPre in H. unfold S_RF. unfold S_Mem. reg simpl. unfold addr_eval. unfold l_release_MPre in H. unfold l_release_MPost in H. InvertAll. rewrite H0. rewrite H in H4. substH H4 with (sep_pure_a (sp + 2 |->w pc *^* sp + 2 + 2 |->w l *^* stkSpacePrec (sp + 2) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) M H4). inversion_clear H4. sep on. sep lift 1 in H2. assert (sp + 2 + 2 = sp + 4). auto. rewrite H4 in H2. sep_blur. Qed. Lemma l_release_step3_Prd: forall sp l pc bp : nat, pimp (l_release2_Prd_aux sp l pc bp |> nextS (l_release + 1 + 1) (comml (_movwld (A_reg 4 BP) BX))) (l_release3_Prd_aux sp l pc bp). Proof. unfold pimp. unfold linkPG. unfold l_release2_Prd_aux. unfold l_release3_Prd_aux. intros. induction S as (((M, R), fl), isr). InvertAll. induction x as (((M0, R0), fl0), isr0). InvertAll. destruct (nextS_inversion H1). InvertAll. split. assert (((addr_eval (S_RF (M0, R0, fl0, isr0)) (A_reg 4 BP)) |~>w l) (S_Mem (M0, R0, fl0, isr0))). apply l_release2_Prd_1 with sp pc bp. unfold l_release2_Prd_aux. split; auto. unfold S_Mem in H5. unfold S_RF in H5. subst R. reg simpl. sep on. apply leadsToW_leadsToW_eq with M0 (addr_eval R0 (A_reg 4 BP)); auto. exists (R0 BX). subst R. assert (RF_update (RF_update R0 BX x) BX (R0 BX) = RF_update R0 BX (R0 BX)). apply set_set_eq; auto. rewrite H5. assert (RF_update R0 BX (R0 BX) = R0). apply RF_update_prev; auto. rewrite H7. unfold l_release2_Prd_aux. split; auto. subst M fl isr. auto. Qed. Lemma l_release2_Prd_IF_false: forall S : State, l_release2_Prd S -> S_Flag S _IF = false. Proof. unfold l_release2_Prd. intros. induction S as (((M, R), fl), isr). unfold imprec in H. unfold pmstar in H. unfold l_release2_Prd_aux in H. UnfoldStateAll. InvertAll. unfold l_release1_Prd_aux in H3. InvertAll. auto. Qed. Hint Resolve l_release2_Prd_IF_false. Lemma l_release2_Grt_Itr_Stk: Grt_Itr_Stk l_release2_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_release2_grt. unfold leadstoPQ. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release2_Prd_aux in H5. unfold l_release1_Prd_aux in H5. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H10 in H9. inversion H9. Qed. Lemma wff_cmd_l_release3: NH_WFcmd (SCAP_consCT (l_release + 1 + 1 + 1) (Ast l_release3_Prd l_release3_grt 1) psi) (l_release + 1 + 1) (Ast l_release2_Prd l_release2_grt 1) (comml (_movwld (A_reg 4 BP) BX)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_release3_Prd. exists l_release3_grt. split. auto. (* enable *) assert (forall sp l pc bp, enable (l_release2_Prd_aux sp l pc bp) (nextS (l_release + 1 + 1) (comml (_movwld (A_reg 4 BP) BX)))). intros. apply enable_movwld. intros. assert (((addr_eval (S_RF S) (A_reg 4 BP)) |~>w l) (S_Mem S)). apply l_release2_Prd_1 with sp pc bp; auto. apply leadsToW_leadsToxW with l; auto. unfold l_release2_Prd. set (p := (fun S0 : State => exists sp : nat, exists l : nat, exists pc : nat, exists bp : nat, l_release2_Prd_aux sp l pc bp S0)). assert (enable p (nextS (l_release+1+1) (comml (_movwld (A_reg 4 BP) BX)))). unfold enable. unfold enable in H. intros. unfold p in H0. InvertAll. apply H with x x0 x1 x2; auto. assert (safe_mono (nextS (l_release + 1 + 1) (comml (_movwld (A_reg 4 BP) BX)))). apply safe_mono_movwld; auto. split. unfold safe_mono in H1. apply H1; auto. assert (forall sp l pc bp, pimp ((l_release2_Prd_aux sp l pc bp) |> nextS (l_release+1+1) (comml (_movwld (A_reg 4 BP) BX))) (l_release3_Prd_aux sp l pc bp)). apply l_release_step3_Prd. split. unfold l_release3_Prd. set (p' := (fun S0 : State => exists sp : nat, exists l : nat, exists pc : nat, exists bp : nat, l_release3_Prd_aux sp l pc bp S0)). apply frame_rule_1; auto. unfold pimp. intros. unfold linkPG in H3. unfold p in H3. InvertAll. rename x into S0. rename x0 into sp. rename x1 into l. rename x2 into pc. rename x3 into bp. unfold p'. exists sp. exists l. exists pc. exists bp. unfold pimp in H2. apply H2. unfold linkPG. exists S0. split; auto. apply frame_movwld. unfold gimp. unfold conjG. unfold conjPG. intros. InvertAll. rename x into S0. unfold l_release2_grt. intros. unfold l_release3_grt in H5. assert (leadstoPQ (l_release3_Prd_aux sp l pc bp) (l_release_Post_aux (sp + 2) l pc bp) S0 S'). apply H5. clear H5. assert (pimp (l_release2_Prd_aux sp l pc bp |> nextS (l_release+1+1) (comml (_movwld (A_reg 4 BP) BX))) (l_release3_Prd_aux sp l pc bp)). apply H2. clear H2. assert (gimp (nextS (l_release + 1 +1) (comml (_movwld (A_reg 4 BP) BX)) oo (leadstoPQ (l_release3_Prd_aux sp l pc bp) (l_release_Post_aux (sp+2) l pc bp))) (leadstoPQ (l_release2_Prd_aux sp l pc bp) (l_release_Post_aux (sp+2) l pc bp))). apply leadstoPQ_sameQ_reverseP; auto. apply frame_movwld. unfold gimp in H2. apply H2. unfold conjG. exists S0. split; auto. split. apply IF_false_Prd_Itr_Stk. auto. apply l_release2_Grt_Itr_Stk. Qed. (* spec for the next instruction *) (* _pushwm (A_reg L_WAITING BX) *) Definition l_release4_MPre (sp l pc bp : Label) := fun (M : Mem) => exists w, l_release_MPre_tmp (sp + 4) l pc M /\ ((sp +2 |->w bp) *^* (sp |->w w) *^* (l + L_WAITING |->w w) *^* mTrue) M. Definition l_release4_Prd_aux (sp l pc bp : Label) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = sp + 2 /\ l_release4_MPre (R SP) l pc bp M /\ fl _IF = false /\ isr = false end. Definition l_release4_Prd (S : State) := imprec (fun S => exists sp, exists l, exists pc, exists bp, l_release4_Prd_aux sp l pc bp S) S. Definition l_release4_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ (l_release4_Prd_aux sp l pc bp) (l_release_Post_aux (sp +4) l pc bp) S S'. Lemma l_release3_Prd_1: forall sp l pc bp S0, l_release3_Prd_aux sp l pc bp S0 -> exists w, ((addr_eval (S_RF S0) (A_reg L_WAITING BX)) |~>w w) (S_Mem S0). Proof. intros. induction S0 as (((M, R), fl), isr). unfold l_release3_Prd_aux in H. unfold S_RF. unfold S_Mem. unfold addr_eval. inversion_clear H. rewrite H0. inversion_clear H1. unfold l_release2_Prd_aux in H. unfold l_release1_Prd_aux in H. unfold l_release1_MPre in H. unfold l_release_MPre in H. reg simpl. InvertAll. unfold l_release_MPost in H5. rewrite H in H5. substH H5 with (sep_pure_a (sp + 2 |->w pc *^* sp + 2 + 2 |->w l *^* stkSpacePrec (sp + 2) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) M H5). inversion_clear H5. sep on. sep lift 3 in H3. assert (forall M, INV1 M -> (l + L_WAITING |->w_ *^* mTrue) M). intros. apply INV1_lock_wid; auto. sep weaker_subst in H3 with (l + L_WAITING |->w_ *^* mTrue). sep on. sep lift 0 in H3. assert (exists w, M ||- l + L_WAITING |->w w *^* (mTrue *^* (INV0 *^* Gamma l *^* (sp + 2 |->w pc *^* sp + 2 + 2 |->w l *^* stkSpacePrec (sp + 2) stk_l_release)))). apply ptoxW_ptoW1. auto. clear H3. inversion_clear H10. exists x0. sep on. sep trivial. Qed. Lemma l_release3_Prd_enable: forall sp l pc bp : nat, enable (l_release3_Prd_aux sp l pc bp) (nextS (l_release + 3) (comml (_pushwm (A_reg L_WAITING BX)))). Proof. unfold enable. intros. assert (exists w, ((addr_eval (S_RF S) (A_reg L_WAITING BX)) |~>w w) (S_Mem S)). apply l_release3_Prd_1 with sp l pc bp; auto. inversion_clear H0. rename x into w. induction S as (((M, R), fl), isr). exists (MemUpdW M (R SP - 2) w 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_pushwm with (addr_eval R (A_reg L_WAITING BX)) w. auto. auto. unfold pushW. split. unfold l_release3_Prd_aux in H. InvertAll. unfold l_release2_Prd_aux in H. unfold l_release1_Prd_aux in H. reg simpl. InvertAll. unfold l_release1_MPre in H4. unfold l_release_MPre in H4. inversion_clear H4. unfold l_release_MPost in H6. rewrite H in H6. substH H6 with (sep_pure_a (sp + 2 |->w pc *^* sp + 2 + 2 |->w l *^* stkSpacePrec (sp + 2) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) M H6). inversion_clear H6. assert (stk_l_release >= 2). auto. sep on. sep lift 2 in H4. sep stksplit in H4. rewrite H. assert (sp + 2 - 2 = sp). auto. rewrite H10 in H4. assert (stk_l_release - 2 >= 2). auto. sep stksplit 2 in H4. sep lift 0 in H4. apply stkSpacePrec_stkSpace1 with (stkSpacePrec (sp - 2) (stk_l_release - 2 - 2) *^* (sp |->w_ *^* (INV1 *^* (INV0 *^* Gamma l) *^* (sp + 2 |->w pc *^* sp + 2 + 2 |->w l)))); auto. split; auto. apply MemUpdW_MemUpd16 with 0; auto. Qed. Lemma l_release_step4_Prd: forall sp l pc bp : nat, pimp (l_release3_Prd_aux sp l pc bp |> nextS (l_release + 3) (comml (_pushwm (A_reg L_WAITING BX)))) (l_release4_Prd_aux (sp - 2) l pc bp). Proof. unfold pimp. unfold linkPG. intros. InvertAll. induction x as (((M0, R0), fl0), isr0). induction S as (((M, R), fl), isr). destruct (nextS_inversion H1). InvertAll. rename x into w0. substH H8 with (MemUpd16_MemUpdW H8). destruct H8 as [junk H8]. subst M R fl isr. unfold l_release4_Prd_aux. unfold l_release3_Prd_aux in H. unfold l_release2_Prd_aux in H. unfold l_release1_Prd_aux in H. InvertAll. reg simpl. split; auto. rewrite H3. split. rewrite H in H4. assert (sp - 2 + 2 = sp + 2 - 2). auto. rewrite H9. auto. split; auto. unfold l_release4_MPre. clear H1. exists w0. rewrite H. rewrite H in H4. assert (sp - 2 + 2 = sp + 2 - 2); auto. assert (sp - 2 + 4 = sp + 4 - 2); auto. rewrite H1. rewrite H9. split. unfold l_release1_MPre in H7. unfold l_release_MPre_tmp in *. unfold l_release_MPost in *. inversion_clear H7. rewrite H in H11. substH H11 with (sep_pure_a (sp + 2 |->w pc *^* sp + 2 + 2 |->w l *^* stkSpacePrec (sp + 2) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) M0 H11). apply sep_pure_b. inversion_clear H11. split; auto. sep on. sep lift 2. (* unfold stk_l_release in *. *) sep stksplit. assert (sp + 4 - 2 - 2 = sp). auto. rewrite H11. sep stk upd. assert (sp + 4 - 2 = sp + 2). auto. rewrite H14. sep lift 2 in H7. sep stksplit in H7. assert (sp + 2 - 2 = sp). auto. rewrite H15 in H7. auto. unfold l_release1_MPre in H7. unfold l_release_MPre_tmp in *. unfold l_release_MPost in *. inversion_clear H7. rewrite H in H11. substH H11 with (sep_pure_a (sp + 2 |->w pc *^* sp + 2 + 2 |->w l *^* stkSpacePrec (sp + 2) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) M0 H11). inversion_clear H11. sep on. sep lift 1. sep upd. sep lift 2 in H7. sep stksplit in H7. sep lift 1 in H7. assert (sp = sp + 2 - 2). auto. rewrite H in H12. rewrite H11 in H12. assert (M0 ||- sp + 2 - 2 |->w bp *^* (INV1 *^* (INV0 *^* Gamma l) *^* (sp + 2 |->w pc *^* sp + 2 + 2 |->w l) *^* stkSpacePrec (sp + 2 - 2) (stk_l_release - 2))). apply leadsToW_ptoxW_unique. auto. auto. clear H7. rewrite <- H11 in *. unfold addr_eval in H0. rewrite H2 in H0. sep lift 6 in H14. sep stksplit in H14. sep lift 3 in H14. assert (forall M, INV1 M -> (l + L_WAITING |->w_ *^* mTrue) M). intros. apply INV1_lock_wid; auto. sep weaker_subst in H14 with (l + L_WAITING |->w_ *^* mTrue). sep on. sep lift 0 in H14. assert (M0 ||- l + L_WAITING |->w w0 *^* (mTrue *^* (INV0 *^* Gamma l *^* (sp + 2 |->w pc *^* sp + 2 + 2 |->w l *^* (stkSpacePrec (sp - 2) (stk_l_release - 2 - 2) *^* sp - 2 |->w_ *^* sp |->w bp))))). apply leadsToW_ptoxW_unique; auto. clear H14. sep lift 1. sep match_left H16. auto. sep lift 1. sep lift 7 in H16. sep match_left H16; auto. sep lift 6 in H16. sep match_left H16; auto. Qed. Lemma l_release3_sp_gt2: forall sp l pc bp S, l_release3_Prd_aux sp l pc bp S -> sp - 2 + 4 = sp + 2. Proof. unfold l_release3_Prd_aux. intros. induction S as (((M, R), fl), isr). unfold l_release2_Prd_aux in H. unfold l_release1_Prd_aux in H. unfold l_release1_MPre in H. InvertAll. reg simpl. unfold l_release_MPre_tmp in H5. unfold l_release_MPost in H5. rewrite H in H5. substH H5 with (sep_pure_a (sp + 2 |->w pc *^* sp + 2 + 2 |->w l *^* stkSpacePrec (sp + 2) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) M H5). inversion_clear H5. sep on. sep lift 2 in H3. sep stksplit in H3. assert (sp + 2 - 2 >= stk_l_release - 2). apply stkSpacePrec_sp_ge_sz1 with M (sp + 2 - 2 |->w_ *^* (INV1 *^* (INV0 *^* Gamma l) *^* (sp + 2 |->w pc *^* sp + 2 + 2 |->w l))); auto. assert (sp + 2 - 2 = sp). auto. rewrite H9 in H5. assert (sp >= 2). apply ge_trans with (stk_l_release - 2); auto. assert (sp - 2 + 4 = sp + 4 - 2). auto. rewrite H11. auto. Qed. Lemma l_release3_Grt_Itr_Stk: Grt_Itr_Stk l_release3_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_release3_grt. unfold leadstoPQ. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release3_Prd_aux in H5. unfold l_release2_Prd_aux in H5. unfold l_release1_Prd_aux in H5. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H11 in H10. inversion H10. Qed. Lemma wff_cmd_l_release4: NH_WFcmd (SCAP_consCT (l_release + 1 + 1 + 1 + 1) (Ast l_release4_Prd l_release4_grt 1) psi) (l_release + 1 + 1 + 1) (Ast l_release3_Prd l_release3_grt 1) (comml (_pushwm (A_reg L_WAITING BX))). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_release4_Prd. exists l_release4_grt. split. auto. assert (l_release + 1 + 1 + 1 = l_release + 3). omega. rewrite H. clear H. assert (forall sp l pc bp, enable (l_release3_Prd_aux sp l pc bp) (nextS (l_release+3) (comml (_pushwm (A_reg L_WAITING BX))))). apply l_release3_Prd_enable. unfold l_release3_Prd. set (p := fun S0 : State => exists sp : nat, exists l : nat, exists pc : nat, exists bp : nat, l_release3_Prd_aux sp l pc bp S0). assert (enable p (nextS (l_release+3) (comml (_pushwm (A_reg L_WAITING BX))))). unfold p. apply forall_enable_exists_l_release; auto. assert (safe_mono (nextS (l_release+3) (comml (_pushwm (A_reg L_WAITING BX))))). apply safe_mono_pushwm; auto. split. unfold safe_mono in H1. apply H1; auto. assert (forall sp l pc bp, pimp ((l_release3_Prd_aux sp l pc bp) |> nextS (l_release+3) (comml (_pushwm (A_reg L_WAITING BX)))) (l_release4_Prd_aux (sp - 2) l pc bp)). apply l_release_step4_Prd. split. unfold l_release4_Prd. set (p' := fun S0 : State => exists sp : nat, exists l : nat, exists pc : nat, exists bp : nat, l_release4_Prd_aux sp l pc bp S0). apply forall_pimp_exists_l_release with l_release3_Prd_aux l_release4_Prd_aux; auto. intros. exists (a - 2). exists b. exists c. exists d. apply H2; auto. apply frame_pushwm. apply gimp_l_release with (fun x => x - 2) (fun x => x + 4) l_release3_Prd_aux l_release4_Prd_aux l_release_Post_aux; auto. apply frame_pushwm. unfold gimp. unfold l_release3_grt. intros. unfold leadstoPQ. unfold leadstoPQ in H3. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). intros. assert (exists M1' : MemMod.Map, MemMod.disjUnion M1' M2 M' /\ l_release_Post_aux (sp - 2 + 4) l pc bp (M1', R', fl', isr')). apply H3 with M1; auto. InvertAll. exists x. split; auto. assert (sp - 2 + 4 = sp + 2). apply l_release3_sp_gt2 with l pc bp (M1, R, fl, isr); auto. rewrite H7 in H8. auto. split. unfold Prd_Itr_Stk. intros. induction S as (((M, R), fl), isr). unfold l_release3_Prd in H. unfold imprec in H. unfold pmstar in H. InvertAll. unfold l_release3_Prd_aux in H. UnfoldStateAll. InvertAll. unfold l_release2_Prd_aux in H. unfold l_release1_Prd_aux in H. InvertAll. unfold itr_enabled in H0. inversion_clear H0. unfold S_Flag in H8. rewrite H7 in H8. inversion H8. apply l_release3_Grt_Itr_Stk. Qed. Lemma l_release_MPost_Lock_INV: forall sp l pc M, M ||- l_release_MPost sp l pc -> M ||- Lock_INV_H l *^* mTrue. Proof. intros. unfold l_release_MPost in H. inversion_clear H. sep on. sep lift 3 in H0. assert (forall M, INV1 M -> (Lock_INV_H l *^* mTrue) M). intros. apply INV1_lockInv1; auto. sep weaker_subst in H0 with (Lock_INV_H l *^* mTrue). sep on. sep lift 0 in H0. sep match_left H0. Qed. Definition l_release_MPre_4 (sp l pc bp wid : Label) := (sp |->w wid) *^* (sp + 2 |->w bp) *^* (sp + 4|->w pc) *^* (sp + 6 |->w l) *^* stkSpacePrec sp (stk_l_release - 4) *^* INV1 *^* INV0 *^* (Gamma l). Definition l_release_Prd_4_aux (sp l pc bp : Label) (mP: MPred) (S : State) := match S with (M, R, fl, isr) => R SP = sp /\ (exists w, (l_release_MPre_4 (R SP) l pc bp w *^* mP) M /\ (l + L_WAITING |~>w w) M) /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_release_Prd_4 (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_release_Prd_4_aux sp l pc bp mP S. Lemma adapt_Prd_4_aux: forall sp l pc bp M, l_release4_MPre sp l pc bp M -> exists w, l_release_MPre_4 sp l pc bp w M. Proof. intros. unfold l_release_MPre_4. unfold l_release4_MPre in H. destruct H as [w [Hmem1 Hmem2]]. exists w. unfold l_release_MPre_tmp in Hmem1. unfold l_release_MPost in Hmem1. substH Hmem1 with (sep_pure_a (sp + 4 |->w pc *^* sp + 4 + 2 |->w l *^* stkSpacePrec (sp + 4) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) M Hmem1). destruct Hmem1 as [Hmem1 Hlock]. sep on. sep lift 2 in Hmem1. sep stksplit in Hmem1. sep stksplit in Hmem1. assert (sp + 4 - 2 - 2 = sp). auto. rewrite H in Hmem1. assert (stk_l_release - 2 - 2 = stk_l_release - 4). auto with arith. rewrite H0 in Hmem1. sep lift 1 in Hmem1. sep lift 1 in Hmem2. sep mem_dec Hmem2 Hmem1. assert (sp + 4 - 2 = sp + 2). auto. rewrite H1 in Hmem1. sep lift 1 in Hmem1. sep lift 3 in Hmem2. sep mem_dec Hmem2 Hmem1. assert (sp + 4 + 2 = sp + 6). auto. rewrite H2 in Hmem1. sep matchH Hmem1 with 8. Qed. Lemma adapt_Prd_4: forall S, l_release4_Prd S -> l_release_Prd_4 S. Proof. unfold l_release4_Prd. unfold l_release_Prd_4. intros. induction S as (((M, R), fl), isr). unfold imprec in H. unfold pmstar in H. InvertAll. exists x1. exists x2. exists x3. exists x4. exists mTrue. unfold l_release_Prd_4_aux. unfold l_release4_Prd_aux in H. UnfoldStateAll. InvertAll. split; auto. unfold l_release4_MPre in H3. destruct H3 as [w [Hmem1 Hmem2]]. unfold l_release_MPre_tmp in Hmem1. unfold l_release_MPost in Hmem1. rename x1 into sp. rewrite H1. rewrite H1 in Hmem1, Hmem2. rename x3 into pc. rename x2 into l. substH Hmem1 with (sep_pure_a (sp + 4 |->w pc *^* sp + 4 + 2 |->w l *^* stkSpacePrec (sp + 4) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) x Hmem1). destruct Hmem1 as [Hmem1 Hlock]. split; auto. exists w. split. exists x. exists x0. split_l. split_r. unfold l_release_MPre_4. sep on. sep lift 2 in Hmem1. sep stksplit in Hmem1. sep stksplit in Hmem1. assert (sp + 4 - 2 - 2 = sp). auto. rewrite H3 in Hmem1. assert (stk_l_release - 2 - 2 = stk_l_release - 4). auto with arith. rewrite H5 in Hmem1. sep lift 1 in Hmem1. sep lift 1 in Hmem2. sep mem_dec Hmem2 Hmem1. assert (sp + 4 - 2 = sp + 2). auto. rewrite H7 in Hmem1. sep lift 1 in Hmem1. sep lift 3 in Hmem2. sep mem_dec Hmem2 Hmem1. assert (sp + 4 + 2 = sp + 6). auto. rewrite H8 in Hmem1. sep matchH Hmem1 with 8. assert ((l + L_WAITING |~>w w) x). sep on. sep lift 2 in Hmem2. sep trivial. apply leadsToW_Mono with x x0; auto. Qed. Definition l_release_grt_4 (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_release_Prd_4_aux sp l pc bp) (l_release_Post_aux_0 (sp + 4) l pc bp) S S'. Lemma adapt_Grt_4: forall S S', l_release_grt_4 S S' -> l_release4_grt S S'. Proof. unfold l_release_grt_4. unfold l_release4_grt. intros. unfold leadstoPQ. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). intros. unfold leadstoPQ2 in H. assert (l_release_Post_aux_0 (sp+4) l pc bp (fun M => M = M2) (M', R', fl', isr')). apply H. unfold l_release4_Prd_aux in H1. unfold l_release_Prd_4_aux. InvertAll. split_l. rewrite H2 in H3. rewrite H2. unfold l_release4_MPre in H3. destruct H3 as [w [Hmem1 Hmem2]]. unfold l_release_MPre_tmp in Hmem1. unfold l_release_MPost in Hmem1. substH Hmem1 with (sep_pure_a (sp + 4 |->w pc *^* sp + 4 + 2 |->w l *^* stkSpacePrec (sp + 4) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (Gamma l) M1 Hmem1). destruct Hmem1 as [Hmem1 Hlock]. split; auto. exists w. split. exists M1. exists M2. split_l. split_r. unfold l_release_MPre_4. sep on. sep lift 2 in Hmem1. sep stksplit in Hmem1. sep stksplit in Hmem1. assert (sp + 4 - 2 - 2 = sp). auto. rewrite H3 in Hmem1. assert (stk_l_release - 2 - 2 = stk_l_release - 4). auto with arith. rewrite H5 in Hmem1. sep lift 1 in Hmem1. sep lift 1 in Hmem2. sep mem_dec Hmem2 Hmem1. assert (sp + 4 - 2 = sp + 2). auto. rewrite H7 in Hmem1. sep lift 1 in Hmem1. sep lift 3 in Hmem2. sep mem_dec Hmem2 Hmem1. assert (sp + 4 + 2 = sp + 6). auto. rewrite H8 in Hmem1. sep matchH Hmem1 with 8. assert ((l + L_WAITING |~>w w) M1). sep on. sep lift 2 in Hmem2. sep trivial. apply leadsToW_Mono with M1 M2; auto. unfold l_release_Post_aux_0 in H2. InvertAll. unfold mstar in H4. InvertAll. exists x. subst x0. split; auto. unfold l_release_Post_aux. auto. Qed. (* _call _UNBLK *) Definition l_release5_MPre (sp l pc bp ax : Label) : MPred := (sp + 2 |->w bp) *^* (sp + 4|->w pc) *^* (sp + 6 |->w l) *^* stkSpacePrec (sp + 2) (stk_l_release - 2) *^* INV1 *^* INV0 *^* (choice (ax=0) (Gamma l) Aemp). Definition l_release_Prd_5_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (l_release5_MPre (R SP) l pc bp (R AX) *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_release_Prd_5 (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_release_Prd_5_aux sp l pc bp mP S. Definition l_release_grt_5 (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_release_Prd_5_aux sp l pc bp) (l_release_Post_aux_0 (sp +4) l pc bp) S S'. Lemma l_release4_enable_unblk_aux: forall sp l pc bp mP S, l_release_Prd_4_aux sp l pc bp mP S -> exists w, enable_unblk w (Gamma l) S. Proof. intros. induction S as (((M, R), fl), isr). unfold l_release_Prd_4_aux in H. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. destruct Hmem as [w [Hmem1 Hmem2]]. exists w. unfold enable_unblk. unfold l_release_MPre_4 in Hmem1. rewrite HRsp in Hmem1. UnfoldStateAll. rewrite HRsp. sep on. sep lift 5 in Hmem1. assert (forall M, INV1 M -> (Lock_INV_H l *^* mTrue) M). intros. apply INV1_lockInv1; auto. sep weaker_subst in Hmem1 with (Lock_INV_H l *^* mTrue). sep on. sep lift 0 in Hmem1. assert (exists b, exists w0, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w0) *^* (choice (b=0) Aemp (Gamma l)) *^* (mTrue *^* (INV0 *^* (Gamma l *^* mP) *^* (sp |->w w *^* sp + 2 |->w bp *^* sp + 4 |->w pc *^* sp + 6 |->w l *^* stkSpacePrec sp (stk_l_release - 4)))) ) /\ Delta w0 = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H; auto. clear Hmem1. destruct H1 as [b [w0 [Hmem1 Hdelta]]]. assert (w0 = w). sep lift 1 in Hmem1. apply ptoW_leadsToW_eq1 with M (l + L_WAITING) (choice (b = 0) Aemp (Gamma l) *^* (mTrue *^* (INV0 *^* (Gamma l *^* mP) *^* (sp |->w w *^* sp + 2 |->w bp *^* sp + 4 |->w pc *^* sp + 6 |->w l *^* stkSpacePrec sp (stk_l_release - 4)))) *^* l + L_AVAIL |->w b); auto. subst w0. split_l. assert (((sp |->w w *^* (Gamma l *^* stkSpacePrec sp (_UNBLK_Stk + 2))) *^* mTrue) M). sep on. sep lift 7 in Hmem1. sep lift 0. sep match_left Hmem1; auto. sep lift 0. sep lift 9 in Hmem1. sep match_left Hmem1; auto. sep lift 4 in Hmem1. assert (stk_l_release - 4 = _UNBLK_Stk + 2). auto. rewrite H1 in Hmem1. sep match_left Hmem1; auto. sep trivial. unfold mstar at 1 in H1. InvertAll. unfold pmstar. exists x0. exists x. UnfoldStateAll. split; auto with PMap. Qed. Lemma stk_l_release_ge6: stk_l_release >= 6. Proof. unfold stk_l_release. auto with arith. Qed. Hint Resolve stk_l_release_ge6. Lemma l_release4_pgp_aux: forall sp l pc bp mP S f f', l_release_Prd_4_aux sp l pc bp mP S -> pimp (wrap_fun (gunblk (Gamma l)) f _UNBLK f' S) (l_release_Prd_5_aux sp l pc bp mP). Proof. intros. rename H into Hpre. unfold pimp. intros S3 Hwrap. unfold l_release_Prd_4_aux in Hpre. induction S as (((M, R), fl), isr). unfold l_release_MPre_4 in Hpre. destruct Hpre as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. destruct Hmem as [w [Hmem1 Hmem2]]. unfold l_release_Prd_5_aux. induction S3 as (((M3, R3), fl3), isr3). unfold wrap_fun in Hwrap. unfold conjG in Hwrap. destruct Hwrap as [S2 [Hcall Hret]]. destruct Hcall as [S1 [Hcall Hunblk]]. induction S1 as (((M1, R1), fl1), isr1). induction S2 as (((M2, R2), fl2), isr2). destruct (nextS_inversion Hcall). clear Hcall. destruct H as [HRspgt2 [Hstkpc HMM1]]. destruct H0 as [HR1 [Hfl1 Hisr1]]. subst R1. subst fl1 isr1. substH HMM1 with (MemUpd16_MemUpdW HMM1). destruct HMM1 as [junk HMM1]. destruct (nextS_inversion Hret). subst M2. destruct H0 as [H1 [H2 H3]]. destruct H1 as [pc' [HM3 HR3]]. subst fl2 isr2. clear Hret. unfold gunblk in Hunblk. UnfoldStateAll. reg simpl. destruct Hunblk as [sp' [Hpp [HIFeq [Hisreq [HR0sp HRspeq]]]]]. subst isr3 sp'. assert (R3 SP = sp). rewrite HR3. reg simpl. rewrite <- HRspeq. rewrite HRsp. rewrite HRsp in HRspgt2. auto. split_l. rewrite <- HIFeq. split; auto. assert (stk_l_release - 4 >= 2). unfold stk_l_release. omega. assert ((R SP |->w w *^* R SP + 2 |->w bp *^* R SP + 4 |->w pc *^* R SP + 6 |->w l *^* stkSpacePrec (R SP) (stk_l_release - 4) *^* INV1 *^* INV0 *^* Gamma l *^* mP) M1). sep on. sep lift 4. rewrite HMM1. sep stk upd. sep matchH Hmem1 with 9. rename H0 into HstkN4. rename H1 into HM1mem1. unfold l_release5_MPre. unfold prepost in Hpp. unfold S_Mem in Hpp. subst R3. reg simpl. destruct Hpp as [M1_1 [M1_F [M3_1 [HM1_1 [HM3_1 [HsplitM1 HsplitM3]]]]]]. sep on. sep lift 4 in HM1mem1. sep stksplit in HM1mem1. assert (stk_l_release - 4 - 2 = _UNBLK_Stk). unfold stk_l_release. auto with arith. rewrite H0 in HM1mem1. assert (R2 AX = 0 \/ R2 AX <> 0). apply nat_eq_neq_dec. inversion_clear H1. (* R2 AX = 0 *) unfold mstar at 1 in HM1mem1. destruct HM1mem1 as [M1_1' [M1_F' [HsplitM1' [HM1_1' HM1_F']]]]. unfold mstar in HM1_1. destruct HM1_1 as [M1_1_emp [M1_1_1 [HM1_1_split [Hchoice HM1_1_1]]]]. unfold choice in Hchoice. inversion_clear Hchoice. destruct H1 as [Hax0 Hemp]. clear H2. assert (M1_1_emp = MemMod.emp). auto. rewrite H1 in HM1_1_split. assert (M1_1_1 = M1_1). auto with PMap. rewrite H2 in HM1_1_1. clear H1 H2 Hemp HM1_1_split M1_1_emp. assert (precise (stkSpacePrec (R SP - 2) _UNBLK_Stk)). apply precise_stkSpacePrec. assert (M1_1 = M1_1'). unfold precise in H1. apply H1 with M1; auto. apply MemMod.disjUnion_subseteq_left with M1_F; auto. apply MemMod.disjUnion_subseteq_left with M1_F'; auto. assert (M1_F = M1_F'). apply MemMod.disjUnion_unique with M1_1 M1_1' M1; auto. sep on. sep lift 3. sep stksplit. sep stksplit. rewrite H. assert (sp + 2 - 2 - 2 = sp - 2). auto with arith. rewrite H4. clear H4. assert (stk_l_release - 2 - 2 - 2 = _UNBLK_Stk). unfold stk_l_release. auto with arith. rewrite H4. clear H4. unfold mstar at 1. sep off. exists M3_1. exists M1_F. split; auto. split. rewrite <- HRsp. auto. sep on. rewrite H3. rewrite HRsp in HM1_F'. assert (sp + 2 - 2 = sp). auto. rewrite H4. clear H4. sep matchH HM1_F' with 9. sep off. unfold choice. left. split; auto. inversion H1. contradiction. (* R2 AX <> 0 *) assert ( M1 ||- stkSpacePrec (R SP - 2) _UNBLK_Stk *^* Gamma l *^* (R SP - 2 |->w_ *^* (INV1 *^* (INV0 *^* mP) *^* (R SP |->w w *^* R SP + 2 |->w bp *^* R SP + 4 |->w pc *^* R SP + 6 |->w l)))). sep matchH HM1mem1 with 9. clear HM1mem1. rename H1 into HM1mem1. unfold mstar at 1 in HM1mem1. destruct HM1mem1 as [M1_1' [M1_F' [HsplitM1' [HM1_1' HM1_F']]]]. assert ((stkSpacePrec (R SP - 2) _UNBLK_Stk *^* Gamma l) M1_1). unfold mstar in HM1_1. sep off. unfold mstar. InvertAll. exists x0. exists x. split; auto with PMap. split_l. unfold choice in H3. inversion_clear H3. inversion H4. contradiction. inversion H4. auto. assert (M1_F = M1_F'). apply MemMod.disjUnion_unique with M1_1 M1_1' M1; auto. assert (precise (Gamma l *^* stkSpacePrec (R SP - 2) _UNBLK_Stk)). apply mstar_presv_prec. apply precGamma. apply precise_stkSpacePrec. unfold precise in H3. apply H3 with M1; auto. apply MemMod.disjUnion_subseteq_left with M1_F; auto. apply MemMod.disjUnion_subseteq_left with M1_F'; auto. sep on. sep lift 3. sep stksplit. sep stksplit. rewrite H. assert (sp + 2 - 2 - 2 = sp - 2). auto with arith. rewrite H4. clear H4. assert (stk_l_release - 2 - 2 - 2 = _UNBLK_Stk). unfold stk_l_release. auto with arith. rewrite H4. clear H4. unfold mstar at 1. sep off. exists M3_1. exists M1_F. split; auto. split. rewrite <- HRsp. auto. sep on. rewrite H3. rewrite HRsp in HM1_F'. assert (sp + 2 - 2 = sp). auto. rewrite H4. clear H4. sep matchH HM1_F' with 9. sep off. unfold mstar. exists MemMod.emp. exists h. split. auto with PMap. split_r. unfold choice. right. split; auto. unfold Aemp. auto. Qed. Lemma Prd_4_Unique_auxvar: forall sp sp' l l' pc pc' bp bp' mP mP' S, l_release_Prd_4_aux sp l pc bp mP S -> l_release_Prd_4_aux sp' l' pc' bp' mP' S -> l = l'. Proof. intros. induction S as (((M, R), fl), isr). unfold l_release_Prd_4_aux in *. InvertAll. unfold l_release_MPre_4 in *. sep on. sep lift 3 in H0. sep lift 3 in H. apply ptoW_ptoW_eq1 with M (R SP + 6) (stkSpacePrec (R SP) (stk_l_release - 4) *^* (INV1 *^* (INV0 *^* (Gamma l *^* mP))) *^* (R SP |->w x *^* R SP + 2 |->w bp *^* R SP + 4 |->w pc)) (stkSpacePrec (R SP) (stk_l_release - 4) *^* (INV1 *^* (INV0 *^* (Gamma l' *^* mP'))) *^* (R SP |->w x0 *^* R SP + 2 |->w bp' *^* R SP + 4 |->w pc')); auto. Qed. Lemma l_release4_pggg_aux: forall sp l pc bp mP S f f', l_release_Prd_4_aux sp l pc bp mP S -> pimp (wrap_fun (gunblk (Gamma l)) f _UNBLK f' S |> l_release_grt_5) (l_release4_grt S). Proof. intros. rename H into Hpre. unfold pimp. intros S2 Hcomp. unfold linkPG in Hcomp. destruct Hcomp as [S1 [Hwrap Hgrt5]]. cut (l_release_grt_4 S S2). apply adapt_Grt_4. unfold l_release_grt_4. unfold leadstoPQ2. intros sp0 l0 pc0 bp0 mP0 Hpre2. assert (l = l0). apply Prd_4_Unique_auxvar with sp sp0 pc pc0 bp bp0 mP mP0 S; auto. rewrite H in Hwrap. unfold l_release_grt_5 in Hgrt5. unfold leadstoPQ2 in Hgrt5. apply Hgrt5. assert ( pimp (wrap_fun (gunblk (Gamma l0)) f _UNBLK f' S) (l_release_Prd_5_aux sp0 l0 pc0 bp0 mP0)). apply l_release4_pgp_aux; auto. unfold pimp in H0. apply H0; auto. Qed. Lemma l_release4_call_unblk: forall S0 : State, l_release4_Prd S0 -> exists w : nat, exists wqa : WQassert, enable_unblk w wqa S0 /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) (l_release + 1 + 1 + 1 + 1) _UNBLK pc' S0) l_release_Prd_5) /\ (forall pc' : nat, pimp (wrap_fun (gunblk wqa) (l_release + 1 + 1 + 1 + 1) _UNBLK pc' S0 |> l_release_grt_5) (l_release4_grt S0)). Proof. intros. assert (l_release_Prd_4 S0). apply adapt_Prd_4; auto. clear H. unfold l_release_Prd_4 in H0. destruct H0 as [sp [l [pc [bp [mP Hpre]]]]]. assert (exists w, enable_unblk w (Gamma l) S0). apply l_release4_enable_unblk_aux with sp pc bp mP; auto. InvertAll. rename x into w. exists w. exists (Gamma l). split_l. split. intros. unfold pimp. intros. unfold l_release_Prd_5. exists sp. exists l. exists pc. exists bp. exists mP. assert (pimp (wrap_fun (gunblk (Gamma l)) (l_release + 1 + 1 + 1 + 1) _UNBLK pc' S0) (l_release_Prd_5_aux sp l pc bp mP)). apply l_release4_pgp_aux; auto. unfold pimp in H1. apply H1; auto. intros. apply l_release4_pggg_aux with sp pc bp mP; auto. Qed. Lemma l_release4_Grt_Itr_Stk: Grt_Itr_Stk l_release4_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_release4_grt. unfold leadstoPQ. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release4_Prd_aux in H5. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H9 in H8. inversion H8. Qed. Lemma l_release4_Prd_IF_false: forall S : State, l_release4_Prd S -> S_Flag S _IF = false. Proof. intros. induction S as (((M, R), fl), isr). unfold l_release4_Prd in H. unfold imprec in H. unfold pmstar in H. InvertAll. unfold l_release4_Prd_aux in H. UnfoldStateAll. InvertAll. auto. Qed. Lemma wff_cmd_l_release5: NH_WFcmd (SCAP_consCT (l_release + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_5 l_release_grt_5 1) psi) (l_release + 1 + 1 + 1 + 1) (Ast l_release4_Prd l_release4_grt 1) (comml (_call _UNBLK)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. left. split; auto. unfold prim_entry. right. right. auto. unfold NH_Call_Prim. assert (forall S : State, l_release4_Prd S -> S_Flag S _IF = false). apply l_release4_Prd_IF_false. split; auto. apply Call_UNBLK with l_release4_Prd l_release_Prd_5 l_release4_grt l_release_grt_5 1. auto. auto. auto. apply l_release4_call_unblk. split. apply IF_false_Prd_Itr_Stk. apply l_release4_Prd_IF_false. apply l_release4_Grt_Itr_Stk. Qed. (* _addw (Opr_imm 2) SP *) Definition l_release_Prd_6_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ sp >= 2 /\ l_release_Prd_5_aux (sp - 2) l pc bp mP (M, RF_update R SP (sp - 2), fl, isr) end. Definition l_release_Prd_6 (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_release_Prd_6_aux sp l pc bp mP S. Definition l_release_grt_6 (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_release_Prd_6_aux sp l pc bp) (l_release_Post_aux_0 (sp +2) l pc bp) S S'. Lemma l_release5_Grt_Itr_Stk: Grt_Itr_Stk l_release_grt_5. Proof. unfold Grt_Itr_Stk. intros. unfold l_release_grt_5. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release_Prd_5_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H8 in H7. inversion H7. Qed. Lemma l_release5_Prd_IF_false: forall S : State, l_release_Prd_5 S -> S_Flag S _IF = false. Proof. intros. unfold l_release_Prd_5 in H. InvertAll. unfold l_release_Prd_5_aux in H0. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. auto. Qed. Lemma l_release_step6_Prd: forall f sp l pc bp mP S S', l_release_Prd_5_aux sp l pc bp mP S -> nextS f (comml (_addw (Opr_imm 2) SP)) S S' -> l_release_Prd_6_aux (sp + 2) l pc bp mP S'. Proof. intros f sp l pc bp mP S S' Hpre Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). clear Htrans. InvertAll. subst M' R' isr'. rename H0 into Hfl'. unfold trash_fl in Hfl'. unfold opr_eval. unfold l_release_Prd_6_aux. unfold l_release_Prd_5_aux in Hpre. destruct Hpre as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. split. reg simpl. rewrite HRsp. auto with arith. split. auto with arith. reg simpl. assert (sp + 2 - 2 = sp). auto. rewrite H. rewrite <- HRsp. assert (RF_update R SP (R SP) = R). apply RF_update_prev. rewrite H0. unfold l_release_Prd_5_aux. split; auto. split; auto. split_l. split_r. inversion_clear Hfl'. subst fl'. unfold Set_Flag. simpl. auto. subst fl'. unfold Clear_Flag. simpl. auto. Qed. Lemma wff_cmd_l_release6: NH_WFcmd (SCAP_consCT (l_release + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_6 l_release_grt_6 1) psi) (l_release + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_5 l_release_grt_5 1) (comml (_addw (Opr_imm 2) SP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_release_Prd_6. exists l_release_grt_6. split. auto. generalize (l_release + 1 + 1 + 1 + 1 + 1). intro f. split. apply trivial_enable_addw. split. unfold pimp. unfold l_release_Prd_5. unfold linkPG. intros. destruct H as [S0 [Hpre Hgrt]]. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold l_release_Prd_6. exists (sp + 2). exists l. exists pc. exists bp. exists mP. apply l_release_step6_Prd with f S0; auto. unfold gimp. intros S S' Htmp. unfold conjG in Htmp. unfold conjPG in Htmp. destruct Htmp as [S0 [Htmp Hgrt6]]. unfold l_release_grt_5. unfold leadstoPQ2. intros sp l pc bp mP Hpre. assert (sp + 2 + 2 = sp + 4); auto. rewrite <- H. unfold l_release_grt_6 in Hgrt6. unfold leadstoPQ2 in Hgrt6. apply Hgrt6. apply l_release_step6_Prd with f S; auto. inversion_clear Htmp; auto. split. apply IF_false_Prd_Itr_Stk. apply l_release5_Prd_IF_false. apply l_release5_Grt_Itr_Stk. Qed. (* _cmpw (Opr_imm 0) AX *) Definition l_release_Prd_7_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => exists fl', l_release_Prd_6_aux sp l pc bp mP (M, R, fl', isr) /\ ((R AX = 0) /\ (fl = Set_Flag fl' _ZF) \/ (R AX <> 0) /\ (fl = Clear_Flag fl' _ZF)) end. Definition l_release_Prd_7 (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_release_Prd_7_aux sp l pc bp mP S. Definition l_release_grt_7 (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_release_Prd_7_aux sp l pc bp) (l_release_Post_aux_0 (sp + 2) l pc bp) S S'. Lemma l_release6_Prd_IF_false: forall S : State, l_release_Prd_6 S -> S_Flag S _IF = false. Proof. intros. unfold l_release_Prd_6 in H. InvertAll. unfold l_release_Prd_6_aux in H0. unfold l_release_Prd_5_aux in H0. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. auto. Qed. Lemma l_release_step7_Prd: forall sp l pc bp mP S S' f, l_release_Prd_6_aux sp l pc bp mP S -> nextS f (comml (_cmpw (Opr_imm 0) AX)) S S' -> l_release_Prd_7_aux sp l pc bp mP S'. Proof. intros. rename H into Hpre. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). InvertAll. subst M'. subst R' isr'. unfold l_release_Prd_7_aux. exists fl. unfold opr_eval in H0. split; auto. inversion_clear H0. left. inversion H. split; auto. inversion H. right. split; auto. Qed. Lemma l_release6_Grt_Itr_Stk: Grt_Itr_Stk l_release_grt_6. Proof. unfold Grt_Itr_Stk. intros. unfold l_release_grt_6. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release_Prd_6_aux in H4. unfold l_release_Prd_5_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H10 in H9. inversion H9. Qed. Lemma wff_cmd_l_release7: NH_WFcmd (SCAP_consCT (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_7 l_release_grt_7 1) psi) (l_release + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_6 l_release_grt_6 1) (comml (_cmpw (Opr_imm 0) AX)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_release_Prd_7. exists l_release_grt_7. split. auto. generalize (l_release + 1 + 1 + 1 + 1 + 1 + 1). intro f. split. apply trivial_enable_cmpw. split. unfold pimp. unfold linkPG. intros S1 Htmp. destruct Htmp as [S0 [Hpre Htrans]]. unfold l_release_Prd_7. unfold l_release_Prd_6 in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. exists sp. exists l. exists pc. exists bp. exists mP. apply l_release_step7_Prd with S0 f. auto. auto. unfold gimp. unfold conjG. unfold conjPG. intros. destruct H as [S0 [Htmp Hgrt7]]. destruct Htmp as [Hpre Htrans]. unfold l_release_grt_6. unfold leadstoPQ2. intros. unfold l_release_grt_7 in Hgrt7. unfold leadstoPQ2 in Hgrt7. apply Hgrt7. apply l_release_step7_Prd with S f; auto. split. apply IF_false_Prd_Itr_Stk. apply l_release6_Prd_IF_false. apply l_release6_Grt_Itr_Stk. Qed. (* _jne l_rel_done *) Definition l_release_Prd_8_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => exists fl', l_release_Prd_6_aux sp l pc bp mP (M, R, fl', isr) /\ (R AX = 0) /\ (fl = Set_Flag fl' _ZF) end. Definition l_release_Prd_8 (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_release_Prd_8_aux sp l pc bp mP S. Definition l_release_grt_8 (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_release_Prd_8_aux sp l pc bp) (l_release_Post_aux_0 (sp +2) l pc bp) S S'. Lemma l_release7_Grt_Itr_Stk: Grt_Itr_Stk l_release_grt_7. Proof. unfold Grt_Itr_Stk. intros. unfold l_release_grt_7. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release_Prd_7_aux in H4. unfold l_release_Prd_6_aux in H4. unfold l_release_Prd_5_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. inversion_clear H6. inversion_clear H0. rewrite H14 in H11. unfold Set_Flag in H11. simpl in H11. rewrite H11 in H10. inversion H10. inversion_clear H0. rewrite H14 in H11. unfold Clear_Flag in H11. simpl in H11. rewrite H11 in H10. inversion H10. Qed. Lemma l_release7_Prd_IF_false: forall S : State, l_release_Prd_7 S -> S_Flag S _IF = false. Proof. unfold l_release_Prd_7. intros. induction S as (((M, R), fl), isr). InvertAll. unfold l_release_Prd_7_aux in H0. UnfoldStateAll. InvertAll. unfold l_release_Prd_6_aux in H0. unfold l_release_Prd_5_aux in H0. InvertAll. inversion_clear H1. inversion_clear H6. rewrite H8. unfold Set_Flag. simpl. auto. inversion_clear H6. rewrite H8. unfold Clear_Flag. simpl. auto. Qed. Lemma l_release_step8_a: forall sp l pc bp mP S, l_release_Prd_7_aux sp l pc bp mP S -> ZF_cl S -> l_rel_done_Prd_aux sp l pc bp mP S. Proof. intros. unfold l_release_Prd_7_aux in H. induction S as (((M, R), fl), isr). destruct H as [fl' [Hpre6 Hcases]]. unfold ZF_cl in H0. unfold S_Flag in H0. inversion_clear Hcases. inversion_clear H. rewrite H2 in H0. unfold Set_Flag in H0. simpl in H0. inversion H0. inversion_clear H. rename H1 into Hax0. rename H0 into Hzffalse. rename H2 into Hfl. unfold l_release_Prd_6_aux in Hpre6. unfold l_release_Prd_5_aux in Hpre6. reg simpl. destruct Hpre6 as [Hsp [Hspgt2 [Hjunk [Hmem [Hlock [Hfl' Hisr]]]]]]. clear Hjunk. unfold l_rel_done_Prd_aux. split_l. split. unfold l_release5_MPre in Hmem. unfold l_rel_done_MPre. sep on. assert (sp - 2 + 2 = sp). auto. rewrite H in Hmem. clear H. assert (sp - 2 + 4 = sp + 2). assert (sp - 2 + 4 = sp + 4 - 2); auto. rewrite H in Hmem. assert (sp - 2 + 6 = sp + 6 - 2). auto. assert (sp + 6 - 2 = sp + 4). omega. rewrite H1 in H0. rewrite H0 in Hmem. clear H H0 H1. rewrite Hsp. sep matchH Hmem with 8. sep off. unfold mstar in Hmem. InvertAll. unfold choice in H0. inversion_clear H0. inversion H1. contradiction. inversion_clear H1. unfold Aemp in H3. rewrite H3 in H. assert (x0 = M). auto with PMap. rewrite H1 in H2. auto. split_l. split_r. subst fl. unfold Clear_Flag. simpl. auto. Qed. Lemma l_release_step8_b: forall sp l pc bp mP S, l_release_Prd_7_aux sp l pc bp mP S -> ZF_st S -> l_release_Prd_8_aux sp l pc bp mP S. Proof. intros. unfold l_release_Prd_7_aux in H. induction S as (((M, R), fl), isr). destruct H as [fl' [Hpre6 Hcases]]. unfold ZF_st in H0. unfold S_Flag in H0. inversion_clear Hcases. inversion_clear H. rename H1 into Hax0. rename H0 into Hzftrue. rename H2 into Hfl. unfold l_release_Prd_8_aux. exists fl'. split; auto. inversion_clear H. rewrite H2 in H0. unfold Clear_Flag in H0. simpl in H0. inversion H0. Qed. Lemma wff_cmd_l_release8: NH_WFcmd (SCAP_consCT (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_8 l_release_grt_8 1) psi) (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_7 l_release_grt_7 1) (comml (_jne l_rel_done)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_rel_done_Prd. exists l_release_Prd_8. exists l_rel_done_grt. exists l_release_grt_8. split. unfold SCAP_lookupCT. unfold SCAP_consCT. unfold SPSpec.lookup. unfold ListT.In. right. assert (SCAP_lookupCT psi l_rel_done l_rel_done_spec). apply l_rel_done_in_psi. auto. split; auto. split. unfold conjP. unfold pimp. intros. destruct H as [Hpre Hzf]. unfold l_release_Prd_7 in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold l_rel_done_Prd. exists sp. exists l. exists pc. exists bp. exists mP. apply l_release_step8_a; auto. split. unfold gimp. unfold conjPG. intros. destruct H as [Hpre [Hzf Hgrtdone]]. unfold l_release_grt_7. unfold leadstoPQ2. intros. unfold l_rel_done_grt in Hgrtdone. unfold leadstoPQ2 in Hgrtdone. apply Hgrtdone. apply l_release_step8_a. auto. auto. unfold conjP. split. unfold pimp. intros. destruct H as [Hpre Hzf]. unfold l_release_Prd_7 in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold l_release_Prd_8. exists sp. exists l. exists pc. exists bp. exists mP. apply l_release_step8_b; auto. unfold gimp. unfold conjPG. intros. destruct H as [Hpre [Hzf Hgrtdone]]. unfold l_release_grt_7. unfold leadstoPQ2. intros. unfold l_release_grt_8 in Hgrtdone. unfold leadstoPQ2 in Hgrtdone. apply Hgrtdone. apply l_release_step8_b; auto. split. apply IF_false_Prd_Itr_Stk. apply l_release7_Prd_IF_false. apply l_release7_Grt_Itr_Stk. Qed. (* _movwp (Opr_reg SP) BP; *) Definition l_release_Prd_8b_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R BP = sp /\ exists bp0, l_release_Prd_8_aux sp l pc bp mP (M, RF_update R BP bp0, fl, isr) end. Definition l_release_Prd_8b (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_release_Prd_8b_aux sp l pc bp mP S. Definition l_release_grt_8b (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_release_Prd_8b_aux sp l pc bp) (l_release_Post_aux_0 (sp +2) l pc bp) S S'. Lemma wff_cmd_l_release8b: NH_WFcmd (SCAP_consCT (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_8b l_release_grt_8b 1) psi) (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_8 l_release_grt_8 1) (comml (_movwp (Opr_reg SP) BP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_release_Prd_8b. exists l_release_grt_8b. split. auto. split; auto. (* enable *) generalize (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1). intro f. Lemma l_release_step_8b: forall f sp l pc bp mP S S', l_release_Prd_8_aux sp l pc bp mP S -> nextS f (comml (_movwp (Opr_reg SP) BP)) S S' -> l_release_Prd_8b_aux sp l pc bp mP S'. Proof. intros. rename H0 into Htrans. unfold l_release_Prd_8_aux in H. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct H as [fl'' [Hpre6 [Hax0 Hfl]]]. destruct (nextS_inversion Htrans). subst M'. destruct H0 as [HR' [Hfl' Hisr']]. subst R' fl' isr'. unfold l_release_Prd_8b_aux. reg simpl. unfold opr_eval. split. unfold l_release_Prd_6_aux in Hpre6. InvertAll. auto. exists (R BP). assert (RF_update (RF_update R BP (R SP)) BP (R BP) = RF_update R BP (R BP)). apply RF_update_RF_update. rewrite H. assert (RF_update R BP (R BP) = R). apply RF_update_prev. rewrite H0. unfold l_release_Prd_8_aux. exists fl''. auto. Qed. split. unfold linkPG. unfold pimp. intros. destruct H as [S0 [Hpre Htrans]]. unfold l_release_Prd_8 in Hpre. InvertAll. unfold l_release_Prd_8b. exists x. exists x0. exists x1. exists x2. exists x3. apply l_release_step_8b with f S0; auto. unfold gimp. unfold conjPG. unfold conjG. intros. destruct H as [S'' [[Hpre Htrans] Hgrt8b]]. unfold l_release_grt_8. unfold leadstoPQ2. intros. unfold l_release_grt_8b in Hgrt8b. unfold leadstoPQ2 in Hgrt8b. apply Hgrt8b. apply l_release_step_8b with f S; auto. split. apply IF_false_Prd_Itr_Stk. Lemma l_release8_Prd_IF_false: forall S : State, l_release_Prd_8 S -> S_Flag S _IF = false. Proof. unfold l_release_Prd_8. intro S. induction S as (((M, R), fl), isr). intros. InvertAll. unfold l_release_Prd_8_aux in H0. unfold l_release_Prd_6_aux in H0. unfold l_release_Prd_5_aux in H0. UnfoldStateAll. InvertAll. rewrite H2. unfold Set_Flag. simpl. auto. Qed. apply l_release8_Prd_IF_false. Lemma l_release8_Grt_Itr_Stk: Grt_Itr_Stk l_release_grt_8. Proof. unfold Grt_Itr_Stk. intros. unfold l_release_grt_8. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release_Prd_8_aux in H4. unfold l_release_Prd_7_aux in H4. unfold l_release_Prd_6_aux in H4. unfold l_release_Prd_5_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H7 in H12. unfold Set_Flag in H12. simpl in H12. rewrite H12 in H11. inversion H11. Qed. apply l_release8_Grt_Itr_Stk. Qed. (* _movwld (A_reg 4 BP) BX *) Definition l_release_Prd_9_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R BX = l /\ exists bx, l_release_Prd_8b_aux sp l pc bp mP (M, RF_update R BX bx, fl, isr) end. Definition l_release_Prd_9 (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_release_Prd_9_aux sp l pc bp mP S. Definition l_release_grt_9 (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_release_Prd_9_aux sp l pc bp) (l_release_Post_aux_0 (sp +2) l pc bp) S S'. Lemma l_release8b_Prd_1: forall sp l pc bp mP S, l_release_Prd_8b_aux sp l pc bp mP S -> ((addr_eval (S_RF S) (A_reg 4 BP)) |~>w l) (S_Mem S). Proof. intros. unfold l_release_Prd_8b_aux in H. induction S as (((M, R), fl), isr). unfold l_release_Prd_8_aux in H. unfold l_release_Prd_6_aux in H. unfold l_release_Prd_5_aux in H. unfold l_release5_MPre in H. InvertAll. reg simpl. unfold addr_eval. unfold S_RF. unfold S_Mem. rewrite H0. assert (sp - 2 + 6 = sp + 6 - 2). auto. assert (sp + 6 - 2 = sp + 4). omega. rewrite H10 in H8. rewrite H8 in H5. sep on. sep lift 2 in H5. sep trivial. Qed. Lemma l_release_step_9: forall f sp l pc bp mP S S', l_release_Prd_8b_aux sp l pc bp mP S -> nextS f (comml (_movwld (A_reg 4 BP) BX)) S S' -> l_release_Prd_9_aux sp l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [[x [Hmemx HR']] [Hfl' Hisr']]. assert (x = l). assert ((addr_eval (S_RF (M, R, fl, isr)) (A_reg 4 BP) |~>w l) (S_Mem (M, R, fl, isr))). apply l_release8b_Prd_1 with sp pc bp mP; auto. UnfoldStateAll. apply leadsToW_unique with (addr_eval R (A_reg 4 BP)) M; auto. subst x. subst R' fl' isr'. unfold l_release_Prd_9_aux. split. reg simpl. auto. exists (R BX). assert (RF_update (RF_update R BX l) BX (R BX) = R). assert (RF_update (RF_update R BX l) BX (R BX) = RF_update R BX (R BX)). apply RF_update_RF_update. rewrite H0. apply RF_update_prev. rewrite H0. auto. Qed. Lemma l_release8b_Prd_IF_false: forall S : State, l_release_Prd_8b S -> S_Flag S _IF = false. Proof. intros. unfold l_release_Prd_8b in H. unfold l_release_Prd_8b_aux in H. induction S as (((M, R), fl), isr). unfold l_release_Prd_8_aux in H. unfold l_release_Prd_6_aux in H. unfold l_release_Prd_5_aux in H. InvertAll. reg simpl. unfold S_Flag. rewrite H3. unfold Set_Flag. simpl. auto. Qed. Lemma l_release8b_Grt_Itr_Stk: Grt_Itr_Stk l_release_grt_8b. Proof. unfold Grt_Itr_Stk. intros. unfold l_release_grt_8b. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release_Prd_8b_aux in H4. unfold l_release_Prd_8_aux in H4. unfold l_release_Prd_6_aux in H4. unfold l_release_Prd_5_aux in H4. InvertAll. reg simpl. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H8 in H13. unfold Set_Flag in H13. simpl in H13. rewrite H13 in H12. inversion H12. Qed. Lemma wff_cmd_l_release9: NH_WFcmd (SCAP_consCT (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_9 l_release_grt_9 1) psi) (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_8b l_release_grt_8b 1) (comml (_movwld (A_reg 4 BP) BX)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_release_Prd_9. exists l_release_grt_9. split. auto. generalize (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1). intro f. (* enable *) assert (forall sp l pc bp mP, enable (l_release_Prd_8b_aux sp l pc bp mP) (nextS f (comml (_movwld (A_reg 4 BP) BX)))). intros. apply enable_movwld. intros. assert (((addr_eval (S_RF S) (A_reg 4 BP)) |~>w l) (S_Mem S)). apply l_release8b_Prd_1 with sp pc bp mP; auto. apply leadsToW_leadsToxW with l; auto. split. unfold enable in *. intros. unfold l_release_Prd_8b in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_release_Prd_8b in H0. InvertAll. unfold l_release_Prd_9. exists x0. exists x1. exists x2. exists x3. exists x4. apply l_release_step_9 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_release_grt_8b. unfold leadstoPQ2. intros. unfold l_release_grt_9 in H2. unfold leadstoPQ2 in H2. apply H2. apply l_release_step_9 with f S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_release8b_Prd_IF_false; auto. apply l_release8b_Grt_Itr_Stk. Qed. Lemma l_release9_Prd_IF_false: forall S : State, l_release_Prd_9 S -> S_Flag S _IF = false. Proof. unfold l_release_Prd_9. intros. induction S as (((M, R), fl), isr). unfold l_release_Prd_9_aux in H. unfold l_release_Prd_8b_aux in H. unfold l_release_Prd_8_aux in H. unfold l_release_Prd_6_aux in H. unfold l_release_Prd_5_aux in H. InvertAll. reg simpl. unfold S_Flag. rewrite H4. unfold Set_Flag. simpl. auto. Qed. Lemma l_release9_Grt_Itr_Stk: Grt_Itr_Stk l_release_grt_9. Proof. unfold Grt_Itr_Stk. intros. unfold l_release_grt_9. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release_Prd_9_aux in H4. unfold l_release_Prd_8b_aux in H4. unfold l_release_Prd_8_aux in H4. unfold l_release_Prd_6_aux in H4. unfold l_release_Prd_5_aux in H4. InvertAll. reg simpl. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H9 in H14. unfold Set_Flag in H14. simpl in H14. rewrite H14 in H13. inversion H13. Qed. Lemma l_release9_Prd_1: forall sp l pc bp mP S, l_release_Prd_9_aux sp l pc bp mP S -> (addr_eval (S_RF S) (A_reg L_AVAIL BX) |~>w_) (S_Mem S). Proof. intros. unfold addr_eval. unfold l_release_Prd_9_aux in H. induction S as (((M, R), fl), isr). InvertAll. UnfoldStateAll. rewrite H0. unfold l_release_Prd_8b_aux in H. unfold l_release_Prd_8_aux in H. unfold l_release_Prd_6_aux in H. unfold l_release_Prd_5_aux in H. InvertAll. reg simpl. unfold l_release5_MPre in H6. sep on. sep lift 4 in H6. assert (forall M, INV1 M -> (Lock_INV_H l *^* mTrue) M). intros. apply INV1_lockInv1; auto. sep weaker_subst in H6 with (Lock_INV_H l *^* mTrue). sep on. sep lift 0 in H6. assert (exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* (mTrue *^* (INV0 *^* (choice (R AX = 0) (Gamma l) Aemp *^* mP) *^* (sp - 2 + 2 |->w bp *^* sp - 2 + 4 |->w pc *^* sp - 2 + 6 |->w l *^* stkSpacePrec (sp - 2 + 2) (stk_l_release - 2))))) /\ Delta w = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H; auto. clear H6. InvertAll. sep lift 0 in H6. sep trivial. Qed. Lemma l_release_step_a: forall f sp l pc bp mP S S', l_release_Prd_9_aux sp l pc bp mP S -> nextS f (comml (_movwst (Opr_imm 1) (A_reg L_AVAIL BX))) S S' -> l_rel_done_Prd_aux sp l pc bp mP S'. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion H0). clear H0. InvertAll. subst R' fl' isr'. rename H3 into Htargetx. rename H5 into Hnewmem. unfold addr_eval in *. unfold opr_eval in *. substH Hnewmem with (MemUpd16_MemUpdW Hnewmem). destruct Hnewmem as [junk HM']. unfold l_rel_done_Prd_aux. unfold l_release_Prd_9_aux in H. destruct H as [HRbx [bx0 Hpre]]. unfold l_release_Prd_8b_aux in Hpre. destruct Hpre as [Hbp [bp0 Hpre]]. reg simpl. unfold l_release_Prd_8_aux in Hpre. destruct Hpre as [fl' [Hpre [Hax0 Hfl]]]. reg simpl. unfold l_release_Prd_6_aux in Hpre. destruct Hpre as [HRsp [HRspgt2 Hpre]]. reg simpl. split_l. unfold l_release_Prd_5_aux in Hpre. destruct Hpre as [Htmp [Hmem [Hlock [Hfl' Hisr]]]]. clear Htmp. reg simpl. split. unfold l_rel_done_MPre. unfold l_release5_MPre in Hmem. sep on. rewrite HRsp. assert (exists m, leqvM INV1 (Lock_INV_H l *^* m)). apply INV1_decom_l; auto. destruct H as [mP' Hleqv]. sep lift 4. sep leqv_subst with (Lock_INV_H l *^* mP'). sep lift 4 in Hmem. sep leqv_subst in Hmem with (Lock_INV_H l *^* mP'). sep on. assert (M ||- Lock_INV_H l *^* (Gamma l) *^* (mP' *^* INV0 *^* mP *^* (sp - 2 + 2 |->w bp *^* sp - 2 + 4 |->w pc *^* sp - 2 + 6 |->w l *^* stkSpacePrec (sp - 2 + 2) (stk_l_release - 2)))). sep matchH Hmem with 9. sep off. unfold choice in Hmem. inversion_clear Hmem. inversion H0; auto. inversion H0. contradiction. rewrite HRbx in HM'. assert (sp - 2 + 2 = sp). assert (sp - 2 + 2 = sp + 2 - 2). auto. assert (sp + 2 - 2 = sp). auto. rewrite H2 in H1; auto. rewrite H1 in H0. rewrite H1 in Hmem. clear H1. assert (sp - 2 + 4 = sp + 2). assert (sp - 2 + 4 = sp + 4 - 2); auto. assert (sp + 4 - 2 = sp + 2). auto. rewrite H1 in Hmem. auto. rewrite H1 in H0. clear H1. assert (sp - 2 + 6 = sp + 4). assert (sp - 2 + 6 = sp + 6 - 2); auto. assert (sp + 6 - 2 = sp + 4). omega. rewrite H1 in Hmem. rewrite H1 in H0. assert (M' ||- Lock_INV_H l *^* (mP' *^* INV0 *^* mP *^* (sp |->w bp *^* sp + 2 |->w pc *^* sp + 4 |->w l *^* stkSpacePrec sp (stk_l_release - 2)))). subst M'. apply Lock_INV_convert_a; auto. sep matchH H4 with 8. split_l. split_r. subst fl. unfold Set_Flag. simpl. auto. Qed. Lemma wff_cmd_l_releasea: NH_WFcmd (SCAP_consCT (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_rel_done_Prd l_rel_done_grt 1) psi) (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Prd_9 l_release_grt_9 1) (comml (_movwst (Opr_imm 1) (A_reg L_AVAIL BX))). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_rel_done_Prd. exists l_rel_done_grt. split. auto. generalize (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1). intro f. assert (forall sp l pc bp mP, enable (l_release_Prd_9_aux sp l pc bp mP) (nextS f (comml (_movwst (Opr_imm 1) (A_reg L_AVAIL BX))))). intros. apply enable_movwst. intros. apply l_release9_Prd_1 with sp l pc bp mP. auto. split. unfold enable in *. intros. unfold l_release_Prd_9 in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_rel_done_Prd. unfold l_release_Prd_9 in H0. InvertAll. exists x0. exists x1. exists x2. exists x3. exists x4. apply l_release_step_a with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_release_grt_9. unfold leadstoPQ2. intros. unfold l_rel_done_grt in H2. unfold leadstoPQ2 in H2. apply H2. apply l_release_step_a with f S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_release9_Prd_IF_false. apply l_release9_Grt_Itr_Stk. Qed. Definition l_release_Post (S : State) : Prop := exists sp, exists l, exists pc, exists bp, exists mP, l_release_Post_aux_0 sp l pc bp mP S. Definition l_release_last_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_release_Post_aux_0 sp l pc bp) (l_release_Post_aux_0 sp l pc bp) S S'. Lemma l_rel_done_Prd_IF_false: forall S : State, l_rel_done_Prd S -> S_Flag S _IF = false. Proof. intros. induction S as (((M, R), fl), isr). unfold l_rel_done_Prd in H. InvertAll. unfold l_rel_done_Prd_aux in H0. UnfoldStateAll. InvertAll. auto. Qed. Lemma l_rel_done_Grt_Itr_Stk: Grt_Itr_Stk l_rel_done_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_rel_done_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_rel_done_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H8 in H7. inversion H7. Qed. Lemma wff_cmd_l_rel_done_1: NH_WFcmd (SCAP_consCT (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Post l_release_last_grt 1) psi) (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_rel_done_Prd l_rel_done_grt 1) (comml (_popw BP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_release_Post. exists l_release_last_grt. split. auto. generalize (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1). intro f. assert (forall sp l pc bp mP, enable (l_rel_done_Prd_aux sp l pc bp mP) (nextS f (comml (_popw BP)))). intros. apply enable_popw. intros. assert ((S_RF S SP |~>w bp) (S_Mem S)). Lemma l_rel_done_Prd_1: forall sp l pc bp mP S, l_rel_done_Prd_aux sp l pc bp mP S -> (S_RF S SP |~>w bp) (S_Mem S). Proof. intros. unfold l_rel_done_Prd_aux in H. induction S as (((M, R), fl), isr). InvertAll. UnfoldStateAll. unfold l_rel_done_MPre in H. sep on. sep lift 0 in H. sep trivial. Qed. apply l_rel_done_Prd_1 with sp l pc mP. auto. apply leadsToW_leadsToxW with bp; auto. split. unfold enable in *. intros. unfold l_rel_done_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. Lemma l_rel_done_step1: forall f sp l pc bp mP S S', l_rel_done_Prd_aux sp l pc bp mP S -> nextS f (comml (_popw BP)) S S' -> l_release_Post_aux_0 (sp + 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [[x [Hmemx HR']] [Hfl' Hisr']]. assert (x = bp). assert ((S_RF (M, R, fl, isr) SP |~>w bp) (S_Mem (M, R, fl, isr))). apply l_rel_done_Prd_1 with sp l pc mP; auto. UnfoldStateAll. apply leadsToW_unique with (R SP) M; auto. subst x. subst R' fl' isr'. unfold l_release_Post_aux_0. reg simpl. clear Htrans. unfold l_rel_done_Prd_aux in H. InvertAll. split. rewrite H0. auto. split_l. split; auto. rewrite H0 in H. unfold l_rel_done_MPre in H. unfold l_release_MPost. apply sep_pure_b. split; auto. sep on. sep lift 2. sep stksplit. assert (sp + 2 - 2 = sp). auto. rewrite H3. sep lift 1. sep matchH H with 7. assert (sp + 2 + 2 = sp + 4). auto with arith. rewrite H5. auto. Qed. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_rel_done_Prd in H0. InvertAll. unfold l_release_Post. exists (x0 + 2). exists x1. exists x2. exists x3. exists x4. apply l_rel_done_step1 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_rel_done_grt. unfold leadstoPQ2. intros. unfold l_release_last_grt in H2. unfold leadstoPQ2 in H2. apply H2. apply l_rel_done_step1 with f S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_rel_done_Prd_IF_false. apply l_rel_done_Grt_Itr_Stk. Qed. Lemma l_release_last_Grt_Itr_Stk: Grt_Itr_Stk l_release_last_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_release_last_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_release_Post_aux_0 in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H8 in H7. inversion H7. Qed. Lemma l_release_Post_IF_false: forall S : State, l_release_Post S -> S_Flag S _IF = false. Proof. intros. induction S as (((M, R), fl), isr). unfold l_release_Post in H. InvertAll. unfold l_release_Post_aux_0 in H0. UnfoldStateAll. InvertAll. auto. Qed. Lemma wff_cmd_l_rel_done_2: NH_WFiseq psi (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_release_Post l_release_last_grt 1) (sseq _retw). Proof. apply nh_isq_end. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. split; auto. intros. unfold l_release_last_grt. unfold leadstoPQ2. auto. split. apply IF_false_Prd_Itr_Stk. apply l_release_Post_IF_false. apply l_release_last_Grt_Itr_Stk. Qed. Lemma wff_l_rel_done: NH_WFiseq psi (l_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_rel_done_Prd l_rel_done_grt 1) I_l_rel_done. Proof. unfold I_l_rel_done. apply nh_isq_seq with l_release_Post l_release_last_grt. apply wff_cmd_l_rel_done_1. apply wff_cmd_l_rel_done_2. Qed. Lemma wff_l_release: NH_WFiseq psi l_release l_release_spec I_l_release. Proof. unfold I_l_release. unfold l_release_spec. apply nh_isq_seq with l_release1_Prd l_release1_grt. apply wff_cmd_l_release1. apply nh_isq_seq with l_release2_Prd l_release2_grt. apply wff_cmd_l_release2. apply nh_isq_seq with l_release3_Prd l_release3_grt. apply wff_cmd_l_release3. apply nh_isq_seq with l_release4_Prd l_release4_grt. apply wff_cmd_l_release4. apply nh_isq_seq with l_release_Prd_5 l_release_grt_5. apply wff_cmd_l_release5. apply nh_isq_seq with l_release_Prd_6 l_release_grt_6. apply wff_cmd_l_release6. apply nh_isq_seq with l_release_Prd_7 l_release_grt_7. apply wff_cmd_l_release7. apply nh_isq_seq with l_release_Prd_8 l_release_grt_8. apply wff_cmd_l_release8. apply nh_isq_seq with l_release_Prd_8b l_release_grt_8b. apply wff_cmd_l_release8b. apply nh_isq_seq with l_release_Prd_9 l_release_grt_9. apply wff_cmd_l_release9. apply nh_isq_seq with l_rel_done_Prd l_rel_done_grt. apply wff_cmd_l_releasea. apply wff_l_rel_done. Qed. (* the stack space required by l_release *) Definition stk_lock_release := 6 + IH_Stk + stk_l_release. Definition lock_release_MPost (sp l pc : Label) : MPred := (sp |->w pc) *^* (sp + 2 |->w l) *^* stkSpacePrec sp stk_lock_release. Definition lock_release_MPre (sp l pc: Label) : MPred := (lock_release_MPost sp l pc) *^* (Gamma l). Definition lock_release_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ ((lock_release_MPre sp l pc) *^* mP) M /\ In l lockSet_H /\ fl _IF = true /\ isr = false end. Definition lock_release_Prd (S : State) : Prop := exists sp, exists l, exists pc, exists bp, exists mP, lock_release_Prd_aux sp l pc bp mP S. Definition lock_release_Post_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (lock_release_MPost sp l pc *^* mP) M /\ In l lockSet_H /\ fl _IF = true /\ isr = false end. Definition lock_release_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_release_Prd_aux sp l pc bp) (lock_release_Post_aux sp l pc bp) S S'. Definition lock_release_psi := SCAP_consCT l_release (Ast l_release_Prd l_release_grt 1) SCAP_emptCT. Lemma lock_release_in_psi: SCAP_lookupCT lock_release_psi l_release (Ast l_release_Prd l_release_grt 1). Proof. unfold SCAP_lookupCT. unfold lock_release_psi. unfold SCAP_consCT. unfold SPSpec.lookup. simpl. left. auto. Qed. Hint Resolve lock_release_in_psi. (* spec for the next instruction *) (* _pushwp (Opr_reg BP) *) Definition lock_release1_MPre (sp l pc bp : Label) : MPred := (sp |->w bp) *^* (sp + 2 |->w pc) *^* (sp + 4 |->w l) *^* stkSpacePrec sp (stk_lock_release - 2) *^* (Gamma l). Definition lock_release1_Prd_aux (sp l pc bp : Label) (mP: MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (lock_release1_MPre (R SP) l pc (R BP) *^* mP) M /\ In l lockSet_H /\ fl _IF = true /\ isr = false end. Definition lock_release1_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_release1_Prd_aux sp l pc bp mP S. Definition lock_release1_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_release1_Prd_aux sp l pc bp) (lock_release_Post_aux (sp +2) l pc bp) S S'. Definition lock_release2_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R BP = sp /\ exists bp0, lock_release1_Prd_aux sp l pc bp mP (M, RF_update R BP bp0, fl, isr) end. Definition lock_release2_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_release2_Prd_aux sp l pc bp mP S. Definition lock_release2_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_release2_Prd_aux sp l pc bp) (lock_release_Post_aux (sp +2) l pc bp) S S'. Definition lock_release3_MPre (sp l pc bp : Label) := (sp |->w l) *^* (sp + 2 |->w bp) *^* (sp + 4 |->w pc) *^* (sp + 6 |->w l) *^* stkSpacePrec sp (stk_lock_release - 4) *^* (Gamma l). Definition lock_release3_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (lock_release3_MPre (R SP) l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = true /\ isr = false end. Definition lock_release3_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_release3_Prd_aux sp l pc bp mP S. Definition lock_release3_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_release3_Prd_aux sp l pc bp) (lock_release_Post_aux (sp + 4) l pc bp) S S'. Definition lock_release4_MPre (sp l pc bp : Label) := ((lock_release3_MPre sp l pc bp) *^* (INV1 *^* INV0)). Definition lock_release4_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (lock_release4_MPre (R SP) l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition lock_release4_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_release4_Prd_aux sp l pc bp mP S. Definition lock_release4_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_release4_Prd_aux sp l pc bp) (lock_release_Post_aux (sp + 4) l pc bp) S S'. Definition lock_release6_MPre (sp l pc bp : Label) := (sp |->w_) *^* (sp + 2 |->w bp) *^* (sp + 4 |->w pc) *^* (sp + 6 |->w l) *^* stkSpacePrec sp (stk_lock_release - 4). Definition lock_release5_MPre (sp l pc bp : Label) := (lock_release6_MPre sp l pc bp) *^* (INV1 *^* INV0). Definition lock_release5_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (lock_release5_MPre (R SP) l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition lock_release5_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_release5_Prd_aux sp l pc bp mP S. Definition lock_release5_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_release5_Prd_aux sp l pc bp) (lock_release_Post_aux (sp + 4) l pc bp) S S'. Definition lock_release6_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (lock_release6_MPre (R SP) l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = true /\ isr = false end. Definition lock_release6_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_release6_Prd_aux sp l pc bp mP S. Definition lock_release6_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_release6_Prd_aux sp l pc bp) (lock_release_Post_aux (sp + 4) l pc bp) S S'. (* _addw (Opr_imm 2) SP *) Definition lock_release7_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ sp >= 2 /\ lock_release6_Prd_aux (sp - 2) l pc bp mP (M, RF_update R SP (sp - 2), fl, isr) end. Definition lock_release7_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_release7_Prd_aux sp l pc bp mP S. Definition lock_release7_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_release7_Prd_aux sp l pc bp) (lock_release_Post_aux (sp +2) l pc bp) S S'. Definition lock_release_Post (S : State) : Prop := exists sp, exists l, exists pc, exists bp, exists mP, lock_release_Post_aux sp l pc bp mP S. Definition lock_release_last_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_release_Post_aux sp l pc bp) (lock_release_Post_aux sp l pc bp) S S'. Lemma lock_release_stk_ge2: stk_lock_release >= 2. Proof. unfold stk_lock_release. omega. Qed. Hint Resolve lock_release_stk_ge2. Lemma lock_release_Prd_aux_stkSpace: forall sp l pc bp mP S, lock_release_Prd_aux sp l pc bp mP S -> stkSpace (S_RF S SP) stk_lock_release (S_Mem S). Proof. intros. unfold lock_release_Prd_aux in H. induction S as (((M, R), fl), isr). unfold lock_release_MPre in H. unfold lock_release_MPost in H. InvertAll. sep on. sep lift 2 in H1. UnfoldStateAll. rewrite H0. sep trivial. Qed. Lemma lock_release_step1: forall f sp l pc bp mP S S', lock_release_Prd_aux sp l pc bp mP S -> nextS f (comml (_pushwp (Opr_reg BP))) S S' -> lock_release1_Prd_aux (sp - 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). destruct H0 as [Hspgt2 [Hmemblk HM']]. destruct H1 as [HR' [Hfl' Hisr']]. subst R' fl' isr'. clear Htrans. unfold opr_eval in HM'. unfold lock_release_Prd_aux in H. destruct H as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_release_MPre in Hmem. unfold lock_release_MPost in Hmem. unfold lock_release1_Prd_aux. reg simpl. rewrite HRsp. split_l; split_l. split; auto. unfold lock_release1_MPre. rewrite HRbp. rewrite HRsp in Hspgt2. assert (sp - 2 + 2 = sp). assert (sp - 2 + 2 = sp + 2 - 2). auto. assert (sp + 2 - 2 = sp). auto. rewrite H0 in H. auto. rewrite H. clear H. assert (sp - 2 + 4 = sp + 2). assert (sp - 2 + 4 = sp + 4 - 2). auto. assert (sp + 4 - 2 = sp + 2); auto. rewrite H. clear H. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M'. sep on. rewrite HRsp. rewrite HRbp. sep lift 0. sep upd2. sep lift 2 in Hmem. sep stksplit in Hmem. sep matchH Hmem with 6. Qed. Lemma lock_release_stk_geIH: stk_lock_release >= IH_Stk + 6. Proof. unfold stk_lock_release. omega. Qed. Hint Resolve lock_release_stk_geIH. Lemma lock_release_Prd_Itr_Stk: Prd_Itr_Stk lock_release_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_release_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_release_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. rewrite HRsp. unfold lock_release_MPre in Hmem. unfold lock_release_MPost in Hmem. sep on. sep lift 2 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' Hmem1'. unfold lock_release_Prd. mexists5 sp l pc bp mP. unfold lock_release_Prd_aux. unfold lock_release_MPre. unfold lock_release_MPost. split_l. split_l. split; auto. sep on. sep lift 2. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 6. Qed. Lemma lock_release_Grt_Itr_Stk: Grt_Itr_Stk lock_release_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_release_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_release_Prd_aux in * . simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. split_l. split_l. split; auto. unfold lock_release_MPre in *. unfold lock_release_MPost in *. sep on. sep lift 2 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 2. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HRsp in HM2'. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HRsp in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_lock_release1: NH_WFcmd (SCAP_consCT (lock_release + 1) (Ast lock_release1_Prd lock_release1_grt 1) lock_release_psi) lock_release (Ast lock_release_Prd lock_release_grt 1) (comml (_pushwp (Opr_reg BP))). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists lock_release1_Prd. exists lock_release1_grt. split. auto. assert (forall sp l pc bp mP, enable (lock_release_Prd_aux sp l pc bp mP) (nextS lock_release (comml (_pushwp (Opr_reg BP))))). intros. apply enable_pushwp with stk_lock_release; auto. apply lock_release_Prd_aux_stkSpace. split. unfold enable in *. intros. unfold lock_release_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_release_Prd in H0. InvertAll. unfold lock_release1_Prd. mexists5 (x0 - 2) x1 x2 x3 x4. apply lock_release_step1 with lock_release x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold lock_release_grt. unfold leadstoPQ2. intros. unfold lock_release1_grt in H2. unfold leadstoPQ2 in H2. assert (lock_release_Post_aux (sp - 2 + 2) l pc bp mP S'). apply H2. apply lock_release_step1 with lock_release S; auto. induction S as (((M, R), fl), isr). induction x as (((M', R'), fl'), isr'). destruct (nextS_inversion H3). InvertAll. unfold lock_release_Prd_aux in H0. InvertAll. rewrite H10 in H8. assert (sp - 2 + 2 = sp). auto. rewrite H15 in H4. auto. split. apply lock_release_Prd_Itr_Stk. apply lock_release_Grt_Itr_Stk. Qed. Lemma lock_release_step2: forall f sp l pc bp mP S S', lock_release1_Prd_aux sp l pc bp mP S -> nextS f (comml (_movwp (Opr_reg SP) BP)) S S' -> lock_release2_Prd_aux sp l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [HR' [Hfl' Hisr']]. unfold opr_eval in HR'. subst R' fl' isr'. clear Htrans. unfold lock_release1_Prd_aux in H. destruct H as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_release2_Prd_aux. reg simpl. rewrite HRsp. split_l. exists (R BP). assert (RF_update (RF_update R BP sp) BP (R BP) = R). assert (RF_update (RF_update R BP sp) BP (R BP) = RF_update R BP (R BP)). apply RF_update_RF_update. rewrite H. apply RF_update_prev. rewrite H. clear H. unfold lock_release1_Prd_aux. split_l; split_l. split; auto. Qed. Lemma stk_lock_release_N2_geIH: stk_lock_release - 2 >= (IH_Stk + 6). Proof. unfold stk_lock_release. unfold stk_l_release. omega. Qed. Hint Resolve stk_lock_release_N2_geIH. Lemma lock_release1_Prd_Itr_Stk: Prd_Itr_Stk lock_release1_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_release1_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_release1_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. rewrite HRsp. rewrite HRsp in Hmem. unfold lock_release1_MPre in Hmem. sep on. sep lift 3 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' Hmem1'. unfold lock_release1_Prd. mexists5 sp l pc bp mP. unfold lock_release1_Prd_aux. unfold lock_release1_MPre. split_l. split_l. split; auto. sep on. sep lift 3. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. rewrite HRsp. split_l. sep on. sep matchH Hmem2 with 7. Qed. Lemma lock_release1_Grt_Itr_Stk: Grt_Itr_Stk lock_release1_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_release1_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_release1_Prd_aux in * . simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. split_l. split_l. split; auto. unfold lock_release1_MPre in *. sep on. sep lift 3 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 3. assert (R SP >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. split_l. sep on. sep matchH HM1x with 6. Qed. Lemma wff_cmd_lock_release2: NH_WFcmd (SCAP_consCT (lock_release + 1 + 1) (Ast lock_release2_Prd lock_release2_grt 1) lock_release_psi) (lock_release + 1) (Ast lock_release1_Prd lock_release1_grt 1) (comml (_movwp (Opr_reg SP) BP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists lock_release2_Prd. exists lock_release2_grt. split. auto. split; auto. (* enable *) split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_release1_Prd in H. InvertAll. unfold lock_release2_Prd. mexists5 x0 x1 x2 x3 x4. apply lock_release_step2 with (lock_release + 1) x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold lock_release1_grt. unfold leadstoPQ2. intros. unfold lock_release2_grt in H1. unfold leadstoPQ2 in H1. apply H1. apply lock_release_step2 with (lock_release + 1) S; auto. split. apply lock_release1_Prd_Itr_Stk. apply lock_release1_Grt_Itr_Stk. Qed. Lemma stk_lock_release_N2_ge2: stk_lock_release - 2 >= 2. Proof. unfold stk_lock_release. omega. Qed. Hint Resolve stk_lock_release_N2_ge2. Lemma lock_release2_Prd_1: forall sp l pc bp mP S, lock_release2_Prd_aux sp l pc bp mP S -> ((addr_eval (S_RF S) (A_reg 4 BP)) |~>w l) (S_Mem S). Proof. intros. induction S as (((M, R), fl), isr). unfold lock_release2_Prd_aux in H. unfold S_RF. unfold S_Mem. unfold addr_eval. inversion_clear H. rewrite H0. inversion_clear H1. unfold lock_release1_Prd_aux in H. unfold lock_release1_MPre in H. reg simpl. InvertAll. rewrite <- H1. sep on. sep lift 2 in H2. sep trivial. Qed. Lemma lock_release2_Prd_enable: forall f sp l pc bp mP, enable (lock_release2_Prd_aux sp l pc bp mP) (nextS f (comml (_pushwm (A_reg 4 BP)))). Proof. unfold enable. intros. assert (((addr_eval (S_RF S) (A_reg 4 BP)) |~>w l) (S_Mem S)). apply lock_release2_Prd_1 with sp pc bp mP; auto. induction S as (((M, R), fl), isr). exists (MemUpdW M (R SP - 2) l 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_pushwm with (addr_eval R (A_reg 4 BP)) l. auto. auto. unfold pushW. unfold lock_release2_Prd_aux in H. destruct H as [HRbp [junk Hpre]]. unfold lock_release1_Prd_aux in Hpre. unfold lock_release1_MPre in Hpre. reg simpl. destruct Hpre as [HRsp [Hjunk [Hmem [Hlock [Hfl Hisr]]]]]. split. sep on. sep lift 3 in Hmem. sep stksplit 2 in Hmem. sep lift 0 in Hmem. sep trivial. split; auto. apply MemUpdW_MemUpd16 with 0; auto. Qed. Lemma lock_release_step3: forall f sp l pc bp mP S S', lock_release2_Prd_aux sp l pc bp mP S -> nextS f (comml (_pushwm (A_reg 4 BP))) S S' -> lock_release3_Prd_aux (sp - 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). destruct H0 as [w [Hsrc [Hspgt2 [Hmemblk HM']]]]. destruct H1 as [HR' [Hfl' Hisr']]. subst R' fl' isr'. clear Htrans. assert ((addr_eval (S_RF (M, R, fl, isr)) (A_reg 4 BP) |~>w l) (S_Mem (M, R, fl, isr))). apply lock_release2_Prd_1 with sp pc bp mP; auto. UnfoldStateAll. assert (w = l). apply leadsToW_leadsToW_eq with M (addr_eval R (A_reg 4 BP)); auto. subst w. clear H0. unfold addr_eval in Hsrc. unfold lock_release2_Prd_aux in H. destruct H as [HRbp [bp0 Hpre]]. unfold lock_release1_Prd_aux in Hpre. unfold lock_release1_MPre in Hpre. reg simpl. destruct Hpre as [HRsp [Htmp [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_release3_Prd_aux. reg simpl. split. rewrite HRsp. auto. split; auto. unfold lock_release3_MPre. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M'. sep on. sep lift 0. sep upd2. sep lift 3 in Hmem. sep stksplit in Hmem. sep lift 1 in Hmem. assert (R SP - 2 + 2 = R SP). auto. rewrite H. clear H. assert (R SP - 2 + 4 = R SP + 2). assert (R SP - 2 + 4 = R SP + 4 - 2). auto. assert (R SP + 4 - 2 = R SP + 2); auto. rewrite H. clear H. assert (R SP - 2 + 6 = R SP + 4). assert (R SP - 2 + 6 = R SP + 6 - 2). auto. assert (R SP + 6 - 2 = R SP + 4). auto. rewrite H0 in H. auto. rewrite H. clear H. rewrite Htmp in Hmem. assert (stk_lock_release - 2 - 2 = stk_lock_release - 4). auto with arith. rewrite H in Hmem. sep matchH Hmem with 7. Qed. Lemma lock_release2_Prd_Itr_Stk: Prd_Itr_Stk lock_release2_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_release2_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_release2_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRbp [bp0 Hpre]]. unfold lock_release1_Prd_aux in Hpre. reg simpl. destruct Hpre as [HRsp [Hbp0 [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_release1_MPre in Hmem. sep on. sep lift 3 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' Hmem1'. unfold lock_release2_Prd. mexists5 sp l pc bp mP. unfold lock_release2_Prd_aux. split_l. exists bp0. unfold lock_release1_Prd_aux. unfold lock_release1_MPre. reg simpl. split_l. split_l. split; auto. sep on. sep lift 3. assert (R SP >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 6. Qed. Lemma lock_release2_Grt_Itr_Stk: Grt_Itr_Stk lock_release2_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_release2_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_release2_Prd_aux in * . simplS in * . destruct Hpre as [HRbp [bp0 Hpre]]. unfold lock_release1_Prd_aux in *. reg simpl. destruct Hpre as [HRsp [HRbp0 [Hmem [Hlock [Hfl Hisr]]]]]. split_l. exists bp0. reg simpl. split_l. split_l. split; auto. unfold lock_release1_MPre in *. sep on. sep lift 3 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 3. assert (R SP >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. split_l. sep on. sep matchH HM1x with 6. Qed. Lemma wff_cmd_lock_release3: NH_WFcmd (SCAP_consCT (lock_release + 1 + 1 + 1) (Ast lock_release3_Prd lock_release3_grt 1) lock_release_psi) (lock_release + 1 + 1) (Ast lock_release2_Prd lock_release2_grt 1) (comml (_pushwm (A_reg 4 BP))). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists lock_release3_Prd. exists lock_release3_grt. split. auto. generalize (lock_release + 1 + 1). intro f. split. assert (forall f sp l pc bp mP, enable (lock_release2_Prd_aux sp l pc bp mP) (nextS f (comml (_pushwm (A_reg 4 BP))))). apply lock_release2_Prd_enable. unfold enable in *. intros. unfold lock_release2_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_release2_Prd in H. InvertAll. unfold lock_release3_Prd. mexists5 (x0 - 2) x1 x2 x3 x4. apply lock_release_step3 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold lock_release2_grt. unfold leadstoPQ2. intros. unfold lock_release3_grt in H1. unfold leadstoPQ2 in H1. assert (lock_release_Post_aux (sp - 2 + 4) l pc bp mP S'). apply H1. apply lock_release_step3 with f S; auto. induction S as (((M, R), fl), isr). induction x as (((M', R'), fl'), isr'). destruct (nextS_inversion H2). InvertAll. unfold lock_release2_Prd_aux in H. unfold lock_release1_Prd_aux in H. InvertAll. reg simpl. rewrite <- H12. rewrite <- H12 in H3. assert (R SP - 2 + 4 = R SP + 2). assert (R SP - 2 + 4 = R SP + 4 - 2); auto. assert (R SP + 4 - 2 = R SP + 2); auto. rewrite H16 in H3. auto. split. apply lock_release2_Prd_Itr_Stk. apply lock_release2_Grt_Itr_Stk. Qed. Lemma lock_release_step4: forall sp l pc bp mP S S', lock_release3_Prd_aux sp l pc bp mP S -> gcli S S' -> lock_release4_Prd_aux sp l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). unfold gcli in Htrans. UnfoldStateAll. destruct Htrans as [Hpp [Hfl' [Hisr' HR']]]. subst R' isr'. unfold prepost in Hpp. destruct Hpp as [M1 [M2 [M1' [HM1 [HM1' [HsplitM HsplitM']]]]]]. UnfoldStateAll. unfold lock_release4_Prd_aux. unfold lock_release3_Prd_aux in H. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. split_l. split; auto. unfold lock_release4_MPre. assert ((INV1 *^* INV0 *^* (lock_release3_MPre (R SP) l pc bp *^* mP)) M'). exists M1'. exists M2. split_l. unfold Aemp in HM1. rewrite HM1 in HsplitM. assert (M2 = M); auto with PMap. subst M2. split; auto. unfold choice in HM1'. inversion_clear HM1'. inversion H; auto. inversion H. assert (itr_enabled (M, R, fl, isr)). unfold itr_enabled. UnfoldStateAll. auto. contradiction. sep on. sep matchH H with 4. Qed. Lemma lock_release3_Prd_Itr_Stk: Prd_Itr_Stk lock_release3_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_release3_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_release3_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. unfold lock_release3_MPre in Hmem. sep on. sep lift 4 in Hmem. Lemma stk_lock_release_N4_geIH: stk_lock_release - 4 >= IH_Stk + 6. Proof. unfold stk_lock_release. unfold stk_l_release. omega. Qed. Hint Resolve stk_lock_release_N4_geIH. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' Hmem1'. unfold lock_release3_Prd. mexists5 sp l pc bp mP. unfold lock_release3_Prd_aux. split_l. split; auto. unfold lock_release3_MPre. sep on. sep lift 4. assert (R SP >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 7. Qed. Lemma lock_release3_Grt_Itr_Stk : Grt_Itr_Stk lock_release3_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_release3_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_release3_Prd_aux in * . simplS in * . destruct Hpre as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. split_l. unfold lock_release3_MPre in *. split; auto. sep on. sep lift 4 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 4. assert (R SP >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. split_l. sep on. sep matchH HM1x with 7. Qed. Lemma wff_cmd_lock_release4: NH_WFcmd (SCAP_consCT (lock_release + 1 + 1 + 1 + 1) (Ast lock_release4_Prd lock_release4_grt 1) lock_release_psi) (lock_release + 1 + 1 + 1) (Ast lock_release3_Prd lock_release3_grt 1) (comml _cli). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. exists lock_release4_Prd. exists lock_release4_grt. split. auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_release3_Prd in H. InvertAll. unfold lock_release4_Prd. mexists5 x0 x1 x2 x3 x4. apply lock_release_step4 with x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold lock_release3_grt. unfold leadstoPQ2. intros. unfold lock_release4_grt in H1. unfold leadstoPQ2 in H1. apply H1. apply lock_release_step4 with S; auto. split. apply lock_release3_Prd_Itr_Stk. apply lock_release3_Grt_Itr_Stk. Qed. Parameter l_release_not_primentry: ~ prim_entry l_release. Lemma lock_release4_enable: forall f sp l pc bp mP, enable (lock_release4_Prd_aux sp l pc bp mP) (nextS f (comml (_call l_release))). Proof. intros. unfold enable. intros. unfold lock_release4_Prd_aux in H. induction S as (((M, R), fl), isr). exists (MemUpdW M (R SP - 2) (f+1) 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_call. unfold pushW. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. split. unfold lock_release4_MPre in Hmem. unfold lock_release3_MPre in Hmem. sep on. sep lift 4 in Hmem. sep stksplit 2 in Hmem. sep lift 0 in Hmem. sep trivial. split; auto. apply MemUpdW_MemUpd16 with 0; auto. Qed. Definition l_release_closure_step5 (sp l pc bp : int) (mP: MPred) : MPred := (sp + 2 |->w bp *^* sp + 4 |->w pc *^* sp + 6 |->w l) *^* stkSpacePrec (sp - 2 - stk_l_release) IH_Stk *^* mP. Lemma stk_lock_release_call1: stk_lock_release - 4 - 2 - stk_l_release = IH_Stk. Proof. unfold stk_lock_release. omega. Qed. Hint Resolve stk_lock_release_call1. Lemma stk_lock_release_call2: stk_lock_release - 4 - 2 >= stk_l_release. Proof. unfold stk_lock_release. omega. Qed. Hint Resolve stk_lock_release_call2. Lemma lock_release_step5_call3: forall f sp l pc bp mP S S', lock_release4_Prd_aux sp l pc bp mP S -> nextS f (comml (_call l_release)) S S' -> l_release_Prd_aux (sp - 2) l (f + 1) (S_RF S' BP) (l_release_closure_step5 sp l pc bp mP) S'. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion H0). destruct H1 as [Hspgt2 [Hpcspace HM']]. destruct H2 as [HR' [Hfl' Hisr']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. clear H0. UnfoldStateAll. reg simpl. unfold lock_release4_Prd_aux in H. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. rewrite HRsp in Hmem. unfold lock_release4_MPre in Hmem. unfold lock_release3_MPre in Hmem. unfold l_release_Prd_aux. reg simpl. rewrite HRsp. split_l. split_l. split; auto. unfold l_release_MPre. unfold l_release_closure_step5. sep on. sep lift 0. sep upd2. sep lift 4 in Hmem. sep stksplit in Hmem. sep stksplit stk_l_release in Hmem. assert (stk_lock_release - 4 - 2 - stk_l_release = IH_Stk). auto. rewrite H in Hmem. rewrite HRsp in Hspgt2. assert (sp - 2 + 2 = sp). auto. rewrite H0. sep matchH Hmem with 11. Qed. Lemma lock_release_step5_call2: forall f, gimp (sp_call_pred lock_release4_Prd f l_release >o l_release_grt) fun_frame. Proof. unfold gimp. unfold sp_call_pred. unfold conjPG. unfold linkPG. intros. destruct H as [[S0 [Hpre Htrans]] Hgrt]. unfold lock_release4_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. assert (l_release_Prd_aux (sp - 2) l (f + 1) (S_RF S BP) (l_release_closure_step5 sp l pc bp mP) S). apply lock_release_step5_call3 with S0; auto. rename H into HFpre. unfold l_release_grt in Hgrt. unfold leadstoPQ2 in Hgrt. assert (l_release_Post_aux_0 (sp - 2) l (f+1) (S_RF S BP) (l_release_closure_step5 sp l pc bp mP) S'). apply Hgrt; auto. clear Hgrt. unfold fun_frame. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). unfold l_release_Prd_aux in HFpre. unfold l_release_Post_aux_0 in H. UnfoldStateAll. destruct HFpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. destruct H as [HRsp' [HRbp' [Hmem' [Hfl' Hisr']]]]. split. rewrite HRsp. rewrite HRsp'. auto. exists (f + 1). unfold Ret_Addr. UnfoldStateAll. split. intro. apply nextPC_retw with (sp - 2). auto. unfold l_release_MPre in Hmem. sep on. sep lift 0 in Hmem. sep trivial. intro. apply nextPC_retw with (sp - 2); auto. unfold l_release_MPost in Hmem'. substH Hmem' with (sep_pure_a (sp - 2 |->w f + 1 *^* sp - 2 + 2 |->w l *^* stkSpacePrec (sp - 2) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (l_release_closure_step5 sp l pc bp mP) M' Hmem'). inversion_clear Hmem'. sep on. sep lift 0 in H. sep trivial. Qed. Lemma lock_release_step5_call4_aux: forall f f' sp l pc bp mP S S', lock_release4_Prd_aux sp l pc bp mP S -> wrap_fun l_release_grt f l_release f' S S' -> lock_release5_Prd_aux sp l pc bp mP S'. Proof. intros. rename H into Hpre. unfold wrap_fun in H0. unfold conjG in H0. destruct H0 as [S2 [[S1 [Hcall Hgrt]] Hretw]]. assert (sp >= 2). unfold lock_release4_Prd_aux in Hpre. induction S as (((M, R), fl), isr). induction S1 as (((M', R'), fl'), isr'). InvertAll. destruct (nextS_inversion Hcall). InvertAll. rewrite H in H7; auto. rename H into Hspge2. assert (l_release_Prd_aux (sp - 2) l (f + 1) (S_RF S1 BP) (l_release_closure_step5 sp l pc bp mP) S1). apply lock_release_step5_call3 with S; auto. clear Hpre. rename H into HFpre. unfold l_release_grt in Hgrt. unfold leadstoPQ2 in Hgrt. assert (l_release_Post_aux_0 (sp - 2) l (f+1) (S_RF S1 BP) (l_release_closure_step5 sp l pc bp mP) S2). apply Hgrt; auto. clear HFpre Hgrt Hcall. rename H into Hpre. induction S2 as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Hretw). subst M'. destruct H0 as [[pc'' [HMpc HR']] [Hfl' Hisr']]. subst fl' isr' R'. clear Hretw. clear HMpc. unfold l_release_Post_aux_0 in Hpre. destruct Hpre as [HRsp [HRbp [Hmem [Hfl Hisr]]]]. unfold lock_release5_Prd_aux. reg simpl. unfold l_release_MPost in Hmem. substH Hmem with (sep_pure_a (sp - 2 |->w f + 1 *^* sp - 2 + 2 |->w l *^* stkSpacePrec (sp - 2) stk_l_release *^* INV1 *^* INV0) (In l lockSet_H) (l_release_closure_step5 sp l pc bp mP) M Hmem). destruct Hmem as [Hmem Hlock]. assert (R SP + 2 = sp). rewrite HRsp. assert (sp - 2 + 2 = sp + 2 - 2). auto. rewrite H. auto. split_l. split; auto. rewrite H. unfold lock_release5_MPre. unfold lock_release6_MPre. unfold l_release_closure_step5 in Hmem. sep on. sep lift 4. sep stksplit. sep lift 2 in Hmem. assert (sp - 2 >= stk_l_release). eapply stkSpacePrec_sp_ge_sz1; eauto. assert (stk_lock_release - 4 - 2 >= stk_l_release). auto. sep stksplit stk_l_release. assert (stk_lock_release - 4 - 2 - stk_l_release = IH_Stk). auto. rewrite H2. assert (sp - 2 + 2 = sp). auto. rewrite H3 in Hmem. sep matchH Hmem with 10. Qed. Lemma lock_release_step5_call4: forall f pc' : nat, pimp (lock_release4_Prd |> wrap_fun l_release_grt f l_release pc') lock_release5_Prd. Proof. unfold pimp. unfold linkPG. intros. destruct H as [S0 [Hpre Htrans]]. unfold lock_release4_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_release5_Prd. mexists5 sp l pc bp mP. apply lock_release_step5_call4_aux with f pc' S0; auto. Qed. Lemma lock_release_step5_call5: forall f pc' : nat, gimp (lock_release4_Prd >o wrap_fun l_release_grt f l_release pc' oo lock_release5_grt) lock_release4_grt. Proof. intros. unfold gimp. unfold conjPG. unfold conjG. intros. destruct H as [S'' [[Hpre Hfun] Htrans5]]. unfold lock_release4_grt. unfold leadstoPQ2. intros. unfold lock_release5_grt in Htrans5. unfold leadstoPQ2 in Htrans5. apply Htrans5. apply lock_release_step5_call4_aux with f pc' S; auto. Qed. Lemma lock_release4_Prd_IF_false: forall S : State, lock_release4_Prd S -> S_Flag S _IF = false. Proof. intros. unfold lock_release4_Prd in H. unfold lock_release4_Prd_aux in H. induction S as (((M, R), fl), isr). InvertAll. unfold S_Flag. auto. Qed. Lemma lock_release4_Grt_Itr_Stk: Grt_Itr_Stk lock_release4_grt. Proof. unfold Grt_Itr_Stk. intros. induction S as (((M, R), fl), isr). unfold lock_release4_grt. unfold leadstoPQ2. intros. unfold lock_release4_Prd_aux in H4. UnfoldStateAll. InvertAll. unfold itr_enabled in H0. inversion_clear H0. UnfoldStateAll. rewrite H8 in H7. inversion H7. Qed. Lemma wff_cmd_lock_release5: NH_WFcmd (SCAP_consCT (lock_release + 1 + 1 + 1 + 1 + 1) (Ast lock_release5_Prd lock_release5_grt 1) lock_release_psi) (lock_release + 1 + 1 + 1 + 1) (Ast lock_release4_Prd lock_release4_grt 1) (comml (_call l_release)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. right. split. apply l_release_not_primentry. unfold NH_Normal_Call. exists l_release_Prd. exists lock_release5_Prd. exists l_release_grt. exists lock_release5_grt. split. unfold SCAP_lookupCT. unfold SCAP_consCT. unfold SPSpec.lookup. unfold ListT.In. right. assert (SCAP_lookupCT lock_release_psi l_release (Ast l_release_Prd l_release_grt 1)). auto. auto. split; auto. generalize (lock_release + 1 + 1 + 1 + 1). intro f. split. assert (forall sp l pc bp mP, enable (lock_release4_Prd_aux sp l pc bp mP) (nextS f (comml (_call l_release)))). apply lock_release4_enable. unfold enable in *. intros. unfold lock_release4_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. apply lock_release_step5_call2. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_release4_Prd in H. InvertAll. unfold l_release_Prd. mexists5 (x0 - 2) x1 (f+1) (S_RF S BP) (l_release_closure_step5 x0 x1 x2 x3 x4). apply lock_release_step5_call3 with x; auto. split. intro. apply lock_release_step5_call4. intro. apply lock_release_step5_call5. split. apply IF_false_Prd_Itr_Stk. apply lock_release4_Prd_IF_false. apply lock_release4_Grt_Itr_Stk. Qed. Lemma lock_release_step6_enable: enable_sti lock_release5_Prd. Proof. unfold lock_release5_Prd. unfold enable_sti. unfold lock_release5_Prd_aux. intros. induction S as (((M, R), fl), isr). destruct H as [sp [l [pc [bp [m [HRsp [Hmem [Hlock [Hfl Hisr]]]]]]]]]. unfold lock_release5_MPre in Hmem. assert ((INV1 *^* INV0 *^* (lock_release6_MPre (R SP) l pc bp *^* m)) M). sep on. sep matchH Hmem with 4. clear Hmem. rename H into Hmem. destruct Hmem as [M1 [M2 [HMsplit [Hinv Hrest]]]]. exists M2. exists M1. UnfoldStateAll. split; auto with PMap. split. unfold pTrue. auto. unfold choice. right. split; auto. intro. unfold itr_enabled in H. UnfoldStateAll. inversion H. rewrite H0 in Hfl. inversion Hfl. Qed. Lemma lock_release_step6_Prd_aux: forall sp l pc bp mP S S', lock_release5_Prd_aux sp l pc bp mP S -> gsti S S' -> lock_release6_Prd_aux sp l pc bp mP S'. Proof. unfold lock_release5_Prd_aux. intros. induction S as (((M, R), fl), isr). destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. rename H0 into Htrans. induction S' as (((M', R'), fl'), isr'). unfold gsti in Htrans. UnfoldStateAll. destruct Htrans as [Hpp [Hfl' [Hisr' HR']]]. subst R' isr'. unfold prepost in Hpp. destruct Hpp as [M1 [M2 [M1' [HM1 [Hm1' [HsplitM HsplitM']]]]]]. UnfoldStateAll. assert (M2 = M'). unfold Aemp in Hm1'. rewrite Hm1' in HsplitM'. auto with PMap. subst M'. clear HsplitM' Hm1' M1'. unfold choice in HM1. inversion_clear HM1. inversion H. unfold itr_enabled in H0. inversion_clear H0. unfold S_Flag in H2. rewrite H2 in Hfl. inversion Hfl. inversion_clear H. clear H0. rename H1 into Hinv. unfold lock_release5_MPre in Hmem. assert ((INV1 *^* INV0 *^* (lock_release6_MPre (R SP) l pc bp *^* mP)) M). sep on. sep matchH Hmem with 4. clear Hmem. rename H into Hmem. destruct Hmem as [M1x [M2x [HMsplit' [Hinv' Hrest]]]]. assert (M1 = M1x). assert (precise (INV1 *^* INV0)). apply mstar_presv_prec; auto. apply Prec1. apply Prec0. unfold precise in H. apply H with M; auto. apply MemMod.disjUnion_subseteq_left with M2; auto. apply MemMod.disjUnion_subseteq_left with M2x; auto. assert (M2 = M2x). apply MemMod.disjUnion_unique with M1 M1x M; auto. subst M2. unfold lock_release6_Prd_aux. split_l. split; auto. Qed. Lemma lock_release5_Prd_IF_false: forall S : State, lock_release5_Prd S -> S_Flag S _IF = false. Proof. unfold lock_release5_Prd. intros. destruct H as [sp [l [oc [bp [mP Hpre]]]]]. unfold lock_release5_Prd_aux in Hpre. induction S as (((M, R), fl), isr). InvertAll. auto. Qed. Lemma lock_release5_Grt_Itr_Stk: Grt_Itr_Stk lock_release5_grt. Proof. unfold Grt_Itr_Stk. intros. induction S as (((M, R), fl), isr). unfold lock_release5_grt. unfold leadstoPQ2. intros. unfold lock_release5_Prd_aux in H4. UnfoldStateAll. InvertAll. unfold itr_enabled in H0. inversion_clear H0. UnfoldStateAll. rewrite H8 in H7. inversion H7. Qed. Lemma wff_cmd_lock_release6: NH_WFcmd (SCAP_consCT (lock_release + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_release6_Prd lock_release6_grt 1) lock_release_psi) (lock_release + 1 + 1 + 1 + 1 + 1) (Ast lock_release5_Prd lock_release5_grt 1) (comml _sti). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. exists lock_release6_Prd. exists lock_release6_grt. split; auto. split. apply lock_release_step6_enable. split. unfold pimp. unfold linkPG. intros. destruct H as [S0 [Hpre Htrans]]. unfold lock_release5_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_release6_Prd. mexists5 sp l pc bp mP. apply lock_release_step6_Prd_aux with S0; auto. unfold gimp. unfold conjG. unfold conjPG. intros. destruct H as [S'' [[Hpre Htrans] Hgrt6]]. unfold lock_release5_grt. unfold lock_release6_grt in Hgrt6. unfold leadstoPQ2 in *. intros. apply Hgrt6. apply lock_release_step6_Prd_aux with S; auto. split. apply IF_false_Prd_Itr_Stk. apply lock_release5_Prd_IF_false. apply lock_release5_Grt_Itr_Stk. Qed. Lemma lock_release_step7: forall f sp l pc bp mP S S', lock_release6_Prd_aux sp l pc bp mP S -> nextS f (comml (_addw (Opr_imm 2) SP)) S S' -> lock_release7_Prd_aux (sp + 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [HR' [Hfl' Hisr']]. unfold opr_eval in HR'. subst R' isr'. clear Htrans. unfold lock_release6_Prd_aux in H. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. unfold lock_release7_Prd_aux. reg simpl. rewrite HRsp. split; auto. auto with arith. split; auto with arith. assert (sp + 2 - 2 = sp). auto. rewrite H. rewrite <- HRsp. assert (RF_update R SP (R SP) = R). apply RF_update_prev. rewrite H0. unfold lock_release6_Prd_aux. split_l. split; auto. split_l. split_r. unfold trash_fl in Hfl'. inversion Hfl'. subst fl'. unfold Set_Flag. simpl. auto. subst fl'. unfold Clear_Flag. simpl. auto. Qed. Lemma lock_release6_Prd_Itr_Stk: Prd_Itr_Stk lock_release6_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_release6_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_release6_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. unfold lock_release6_MPre in Hmem. sep on. sep lift 4 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' Hmem1'. unfold lock_release6_Prd. mexists5 sp l pc bp mP. unfold lock_release6_Prd_aux. unfold lock_release6_MPre. split_l. split; auto. sep on. sep lift 4. assert (R SP >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 6. Qed. Lemma lock_release6_Grt_Itr_Stk: Grt_Itr_Stk lock_release6_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_release6_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_release6_Prd_aux in * . simplS in * . destruct Hpre as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. split_l. split; auto. unfold lock_release6_MPre in *. sep on. sep lift 4 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 4. assert (R SP >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. split_l. sep on. sep matchH HM1x with 6. Qed. Lemma wff_cmd_lock_release7: NH_WFcmd (SCAP_consCT (lock_release + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_release7_Prd lock_release7_grt 1) lock_release_psi) (lock_release + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_release6_Prd lock_release6_grt 1) (comml (_addw (Opr_imm 2) SP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists lock_release7_Prd. exists lock_release7_grt. split. auto. generalize (lock_release + 1 + 1 + 1 + 1 + 1 + 1). intro f. split. apply trivial_enable_addw. split. unfold pimp. unfold linkPG. intros. destruct H as [S0 [Hpre Htrans]]. unfold lock_release6_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_release7_Prd. mexists5 (sp + 2) l pc bp mP. apply lock_release_step7 with f S0; auto. unfold gimp. unfold conjG. unfold conjPG. intros. destruct H as [S'' [[Hpre Htrans] Hgrt7]]. unfold lock_release6_grt. unfold lock_release7_grt in Hgrt7. unfold leadstoPQ2 in *. intros. assert (sp + 2 + 2 = sp + 4). auto. rewrite <- H0. apply Hgrt7. apply lock_release_step7 with f S; auto. split. apply lock_release6_Prd_Itr_Stk. apply lock_release6_Grt_Itr_Stk. Qed. Lemma wff_cmd_lock_release8: NH_WFcmd (SCAP_consCT (lock_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_release_Post lock_release_last_grt 1) lock_release_psi) (lock_release + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_release7_Prd lock_release7_grt 1) (comml (_popw BP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists lock_release_Post. exists lock_release_last_grt. split. auto. generalize (lock_release + 1 + 1 + 1 + 1 + 1 + 1 + 1). intro f. assert (forall sp l pc bp mP, enable (lock_release7_Prd_aux sp l pc bp mP) (nextS f (comml (_popw BP)))). intros. apply enable_popw. intros. assert ((S_RF S SP |~>w bp) (S_Mem S)). Lemma lock_release7_Prd_1: forall sp l pc bp mP S, lock_release7_Prd_aux sp l pc bp mP S -> (S_RF S SP |~>w bp) (S_Mem S). Proof. intros. unfold lock_release7_Prd_aux in H. induction S as (((M, R), fl), isr). InvertAll. UnfoldStateAll. unfold lock_release6_Prd_aux in H2. unfold lock_release6_MPre in H2. reg simpl. InvertAll. sep on. assert (sp - 2 + 2 = sp). auto. rewrite H5 in H2. sep lift 1 in H2. rewrite H0. sep trivial. Qed. apply lock_release7_Prd_1 with sp l pc mP. auto. apply leadsToW_leadsToxW with bp; auto. split. unfold enable in *. intros. unfold lock_release7_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. Lemma lock_release_step8: forall f sp l pc bp mP S S', lock_release7_Prd_aux sp l pc bp mP S -> nextS f (comml (_popw BP)) S S' -> lock_release_Post_aux (sp + 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [[x [Hmemx HR']] [Hfl' Hisr']]. assert (x = bp). assert ((S_RF (M, R, fl, isr) SP |~>w bp) (S_Mem (M, R, fl, isr))). apply lock_release7_Prd_1 with sp l pc mP; auto. UnfoldStateAll. apply leadsToW_unique with (R SP) M; auto. subst x. subst R' fl' isr'. unfold lock_release_Post_aux. reg simpl. clear Htrans. unfold lock_release7_Prd_aux in H. InvertAll. split. rewrite H0. auto. split_l. unfold lock_release6_Prd_aux in H2. reg simpl. InvertAll. split; auto. unfold lock_release6_MPre in H2. unfold lock_release_MPost. sep on. sep lift 2. sep stksplit. assert (sp + 2 - 2 = sp). auto. rewrite H5. sep stksplit. assert (sp - 2 + 2 = sp). auto. rewrite H7 in H2. assert (stk_lock_release - 2 - 2 = stk_lock_release - 4). auto. rewrite H8. assert (sp + 2 + 2 = sp + 4). auto. rewrite H9. assert (sp - 2 + 4 = sp + 4 - 2). auto. rewrite H10 in H2. assert (sp + 4 - 2 = sp + 2). auto. rewrite H11 in H2. assert (sp - 2 + 6 = sp + 6 - 2). auto. rewrite H12 in H2. assert (sp + 6 - 2 = sp + 4). auto. rewrite H13 in H2. sep matchH H2 with 6. Qed. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_release7_Prd in H0. InvertAll. unfold lock_release_Post. exists (x0 + 2). exists x1. exists x2. exists x3. exists x4. apply lock_release_step8 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold lock_release7_grt. unfold leadstoPQ2. intros. unfold lock_release_last_grt in H2. unfold leadstoPQ2 in H2. apply H2. apply lock_release_step8 with f S; auto. Lemma lock_release7_Prd_Itr_Stk: Prd_Itr_Stk lock_release7_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_release7_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_release7_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold lock_release6_Prd_aux in Hpre. unfold itr_enabled in Henable. simplS in * . reg simpl. destruct Hpre as [HRsp [Hspgt2 [Htmp [Hmem [Hlock [Hfl Hisr]]]]]]. unfold lock_release6_MPre in Hmem. sep on. sep lift 4 in Hmem. assert (stk_lock_release - 4 >= IH_Stk + 6 - 2). unfold stk_lock_release. unfold stk_l_release. omega. sep stksplit (IH_Stk + 6 - 2) in Hmem. sep lift 0 in Hmem. assert (M ||- stkSpacePrec (sp - 2) (IH_Stk + 6 - 2) *^* sp - 2 |->w_ *^* (stkSpacePrec (sp - 2 - (IH_Stk + 6 - 2)) (stk_lock_release - 4 - (IH_Stk + 6 - 2)) *^* (mP *^* (sp - 2 + 2 |->w bp *^* sp - 2 + 4 |->w pc *^* sp - 2 + 6 |->w l)))). sep matchH Hmem with 8. clear Hmem. rename H0 into Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. split. rewrite HRsp. sep on. sep stksplit. auto. intros M1' Hmem1'. unfold lock_release7_Prd. mexists5 sp l pc bp mP. unfold lock_release7_Prd_aux. unfold lock_release6_Prd_aux. unfold lock_release6_MPre. reg simpl. split_l. split; auto. split_l. split; auto. sep on. sep lift 4. assert (sp - 2 >= IH_Stk + 6 - 2). apply stkSpacePrec_sp_ge_sz1 with M1 (sp - 2 |->w_); auto. sep stksplit (IH_Stk + 6 - 2). sep lift 1. assert (MemMod.merge M2 M1' ||- stkSpacePrec (sp - 2) (IH_Stk + 6 - 2) *^* sp - 2 |->w_ *^* (mP *^* (sp - 2 + 2 |->w bp *^* sp - 2 + 4 |->w pc *^* sp - 2 + 6 |->w l) *^* stkSpacePrec (sp - 2 - (IH_Stk + 6 - 2)) (stk_lock_release - 4 - (IH_Stk + 6 - 2)))). exists M1'; exists M2. assert (stkSpacePrec (R SP) (IH_Stk + 6) M1). rewrite HRsp. sep on. sep stksplit. auto. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. split. sep on. assert (M1' ||- stkSpacePrec (R SP) (IH_Stk + 6)). auto. rewrite HRsp in H2. sep stksplit in H2. auto. sep on. sep matchH Hmem2 with 5. sep matchH H1 with 7. Qed. Lemma lock_release7_Grt_Itr_Stk: Grt_Itr_Stk lock_release7_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_release7_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_release7_Prd_aux in * . unfold lock_release6_Prd_aux in * . simplS in * . reg simpl. destruct Hpre as [HRsp [Hspgt2 [Htmp [Hmem [Hlock [Hfl Hisr]]]]]]. split_l. split_l. split_l. split; auto. unfold lock_release6_MPre in *. sep on. sep lift 4 in Hmem. assert (stk_lock_release - 4 >= IH_Stk + 6 - 2). unfold stk_lock_release. unfold stk_l_release. omega. sep stksplit (IH_Stk + 6 - 2) in Hmem. sep lift 0 in Hmem. assert (MemMod.merge M1 M2' ||- stkSpacePrec (sp - 2) (IH_Stk + 6 - 2) *^* sp - 2 |->w_ *^* (stkSpacePrec (sp - 2 - (IH_Stk + 6 - 2)) (stk_lock_release - 4 - (IH_Stk + 6 - 2)) *^* (mP *^* (sp - 2 + 2 |->w bp *^* sp - 2 + 4 |->w pc *^* sp - 2 + 6 |->w l)))). sep matchH Hmem with 8. clear Hmem. rename H0 into Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 4. assert (sp - 2 >= IH_Stk + 6 - 2). apply stkSpacePrec_sp_ge_sz1 with M2x (sp - 2 |->w_); auto. sep stksplit (IH_Stk + 6 - 2). sep lift 1. assert (M ||- stkSpacePrec (sp - 2) (IH_Stk + 6 - 2) *^* sp - 2 |->w_ *^* (mP *^* (sp - 2 + 2 |->w bp *^* sp - 2 + 4 |->w pc *^* sp - 2 + 6 |->w l) *^* stkSpacePrec (sp - 2 - (IH_Stk + 6 - 2)) (stk_lock_release - 4 - (IH_Stk + 6 - 2)))). assert (M2x = M2' /\ M1x = M1). assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (M2x ||- stkSpacePrec (R SP) (IH_Stk + 6)). rewrite HRsp. sep stksplit. sep on. auto. assert (Hx := prec_disjUnion_inv H1 H2 HM2' H3 (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H1; subst M1x M2x. exists M2; exists M1. split. auto with PMap. split. assert (M2 ||- stkSpacePrec (R SP) (IH_Stk + 6)). auto. sep on. rewrite HRsp in H1. sep stksplit in H1. auto. sep on. sep matchH HM1x with 5. sep matchH H1 with 7. Qed. split. apply lock_release7_Prd_Itr_Stk. apply lock_release7_Grt_Itr_Stk. Qed. Lemma lock_releasePost_Prd_Itr_Stk : Prd_Itr_Stk lock_release_Post. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_release_Post in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_release_Post_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_release_MPost in Hmem. sep on. sep lift 2 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. rewrite HRsp. split_l. intros M1' Hmem1'. unfold lock_release_Post. mexists5 sp l pc bp mP. unfold lock_release_Post_aux. unfold lock_release_MPost. split_l. split_l. split; auto. sep on. sep lift 2. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 3. Qed. Lemma lock_releasePost_Grt_Itr_Stk : Grt_Itr_Stk lock_release_last_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_release_last_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_release_Post_aux in * . simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. split_l. split_l. split; auto. unfold lock_release_MPost in *. sep on. sep lift 2 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 2. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). rewrite HRsp in HM2. rewrite HRsp in HM2'. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HRsp in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_lock_release9: NH_WFiseq lock_release_psi (lock_release + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_release_Post lock_release_last_grt 1) (sseq _retw). Proof. apply nh_isq_end. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. split; auto. intros. unfold lock_release_last_grt. unfold leadstoPQ2. auto. split. apply lock_releasePost_Prd_Itr_Stk. apply lock_releasePost_Grt_Itr_Stk. Qed. Lemma wff_lock_release: NH_WFiseq lock_release_psi lock_release (Ast lock_release_Prd lock_release_grt 1) I_lock_release. Proof. unfold I_lock_release. apply nh_isq_seq with lock_release1_Prd lock_release1_grt. apply wff_cmd_lock_release1. apply nh_isq_seq with lock_release2_Prd lock_release2_grt. apply wff_cmd_lock_release2. apply nh_isq_seq with lock_release3_Prd lock_release3_grt. apply wff_cmd_lock_release3. apply nh_isq_seq with lock_release4_Prd lock_release4_grt. apply wff_cmd_lock_release4. apply nh_isq_seq with lock_release5_Prd lock_release5_grt. apply wff_cmd_lock_release5. apply nh_isq_seq with lock_release6_Prd lock_release6_grt. apply wff_cmd_lock_release6. apply nh_isq_seq with lock_release7_Prd lock_release7_grt. apply wff_cmd_lock_release7. apply nh_isq_seq with lock_release_Post lock_release_last_grt. apply wff_cmd_lock_release8. apply wff_cmd_lock_release9. Qed. coq/examples/SyncUtil.v0000644000107400000620000005723011000223244014627 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Add LoadPath "../miniOS". Require Import Coqlib. Require Import List. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Operational_Semantics. Require Import AIM. Require Import QLib. Require Import Assertion_Lemmas4. Require Import SCAP. Require Import SCAP_READY. Require Import Linking. Require Import Assembly. Require Import Omega. Require Import Arith_Lemmas. Require Import Kernel. Require Import Classical. Lemma Memp_dec: forall M, M = MemMod.emp \/ M <> MemMod.emp. Proof. intro. apply classic. Qed. Lemma not_Memp_indom: forall M, M <> MemMod.emp -> exists l, MemMod.in_dom l M. Proof. intros. assert ((forall l, MemMod.not_in_dom l M) \/ ~ (forall l, MemMod.not_in_dom l M)). apply classic. inversion H0. assert (M = MemMod.emp). apply MemMod.extensional_eqMap. intro. unfold MemMod.emp. assert (MemMod.not_in_dom x M). apply H1. unfold MemMod.not_in_dom in H2. auto. contradiction. assert (exists l, ~ MemMod.not_in_dom l M). apply (not_all_ex_not MemMod.A (fun l => MemMod.not_in_dom l M)). auto. inversion H2. exists x. auto with PMap. Qed. Lemma disj_eq_emp: forall M1 M2, MemMod.disjoint M1 M2 -> M1 = M2 -> M1 = MemMod.emp. Proof. intros. assert (M1 = MemMod.emp \/ M1 <> MemMod.emp). apply Memp_dec. inversion_clear H1; auto. assert (exists l, MemMod.in_dom l M1). apply not_Memp_indom. auto. unfold MemMod.disjoint in H. inversion H1. assert (MemMod.not_in_dom x M1 \/ MemMod.not_in_dom x M2). apply H. inversion_clear H4. absurd (~ MemMod.in_dom x M1); auto with PMap. rewrite <- H0 in H5. absurd (~ MemMod.in_dom x M1); auto with PMap. Qed. (* Note here we define Gamma as a total mapping *) (* if a lock l is not specified in Gamma, we let *) (* Gamma l = Aemp *) Parameter Gamma : Label -> MPred. Parameter precGamma : forall l, precise (Gamma l). Definition Lock_INV_H_aux (l : Label) (b w : int) : MPred := fun (M : Mem) => ((l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l))) M /\ Delta w = SomeT (Gamma l). (* Hoare style invariant assotiated with lock l *) Definition Lock_INV_H (l :Label) : MPred := fun (M : Mem) => exists b, exists w, ((l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l))) M /\ Delta w = SomeT (Gamma l). Definition Lock_INV_H_0 (l : Label) : MPred := fun (M : Mem) => exists w, ((l + L_AVAIL |->w 0) *^* (l + L_WAITING |->w w)) M /\ Delta w = SomeT (Gamma l). Definition Lock_INV_H_1 (l :Label) : MPred := fun (M : Mem) => exists w, ((l + L_AVAIL |->w 1) *^* (l + L_WAITING |->w w) *^* (Gamma l)) M /\ Delta w = SomeT (Gamma l). Definition LockSet := list Label. (* Hoare style, Mesa style and spin locks *) Parameters lockSet_H lockSet_M lockSet_Spin : LockSet. Fixpoint WF_lockSet_H (ls : LockSet) {struct ls} : MPred := match ls with nil => Aemp | l :: ls' => (Lock_INV_H l) *^* WF_lockSet_H ls' end. (* set of condition variables *) Definition CVSet := list Label. (* Mesa-style condition variables *) Parameter cvSet_M : CVSet. Definition CV_INV_M (cv : Label) : MPred := fun (M : Mem) => exists w, (cv + C_WAITING |->w w) M /\ Delta w = SomeT Aemp. Fixpoint removeFirstL (l : Label) (ls : LockSet) {struct ls} : LockSet := match ls with nil => nil | l' :: ls' => if (eq_nat_dec l l') then ls' else l' :: (removeFirstL l ls') end. Lemma WF_LockSet_decomp: forall l ls, In l ls -> leqvM (WF_lockSet_H ls) ((Lock_INV_H l) *^* (WF_lockSet_H (removeFirstL l ls))). Proof. intros. induction ls. unfold In in H. absurd False; auto. unfold In in H. inversion_clear H. subst a. clear IHls. unfold leqvM. intros. split. intro WFLset. unfold WF_lockSet_H in WFLset. fold WF_lockSet_H in WFLset. unfold removeFirstL. induction (eq_nat_dec l l). auto. absurd (l = l); auto. intro. unfold removeFirstL in H. induction (eq_nat_dec l l). unfold WF_lockSet_H. fold WF_lockSet_H. auto. absurd (l = l); auto. assert (leqvM (WF_lockSet_H ls) (Lock_INV_H l *^* WF_lockSet_H (removeFirstL l ls))). apply IHls; auto. unfold leqvM in *. unfold removeFirstL. induction (eq_nat_dec l a). rewrite <- a0. intro h. unfold WF_lockSet_H at 1. fold WF_lockSet_H. split; auto. fold removeFirstL. unfold WF_lockSet_H at 2. fold WF_lockSet_H. intro. unfold WF_lockSet_H at 1. fold WF_lockSet_H. split. intro. sep on. sep lift 1. destruct H1 as [M1 [M2 [HMsplit [HM1 HM2]]]]. exists M1. exists M2. split_l. split_l. assert (WF_lockSet_H ls M2 <-> (Lock_INV_H l *^* WF_lockSet_H (removeFirstL l ls)) M2). apply H. inversion_clear H1. assert ((Lock_INV_H l *^* WF_lockSet_H (removeFirstL l ls)) M2). apply H2; auto. sep on. sep matchH H1 with 2. intro. sep on. sep lift 1 in H1. destruct H1 as [M1 [M2 [HMsplit [HM1 HM2]]]]. exists M1. exists M2. split_l. split_l. assert (WF_lockSet_H ls M2 <-> (Lock_INV_H l *^* WF_lockSet_H (removeFirstL l ls)) M2). apply H. inversion_clear H1. apply H3. sep on. sep matchH HM2 with 2. Qed. Fixpoint WF_cvSet_M (cvs : CVSet) {struct cvs} : MPred := match cvs with nil => Aemp | cv :: cvs' => (CV_INV_M cv) *^* WF_cvSet_M cvs' end. Parameter lock_inv : exists m, leqvM INV1 ((WF_lockSet_H lockSet_H) *^* (WF_cvSet_M cvSet_M) *^* m). Fixpoint removeFirstCV (l : Label) (cvs : CVSet) {struct cvs} : LockSet := match cvs with nil => nil | l' :: cvs' => if (eq_nat_dec l l') then cvs' else l' :: (removeFirstCV l cvs') end. Lemma WF_CVSet_decomp: forall cv cvs, In cv cvs -> leqvM (WF_cvSet_M cvs) ((CV_INV_M cv) *^* (WF_cvSet_M (removeFirstCV cv cvs))). Proof. intros. induction cvs. unfold In in H. absurd False; auto. unfold In in H. inversion_clear H. subst a. clear IHcvs. unfold leqvM. intro. split. intro WFCVset. unfold WF_cvSet_M in WFCVset. fold WF_cvSet_M in WFCVset. unfold removeFirstCV. induction (eq_nat_dec cv cv). auto. absurd (cv = cv); auto. intro. unfold removeFirstCV in H. induction (eq_nat_dec cv cv). unfold WF_cvSet_M. fold WF_cvSet_M. auto. absurd (cv = cv); auto. assert (leqvM (WF_cvSet_M cvs) (CV_INV_M cv *^* WF_cvSet_M (removeFirstCV cv cvs))). apply IHcvs; auto. unfold leqvM in *. unfold removeFirstCV. induction (eq_nat_dec cv a). rewrite <- a0. intro h. unfold WF_cvSet_M at 1. fold WF_cvSet_M. split; auto. fold removeFirstCV. unfold WF_cvSet_M. fold WF_cvSet_M. intro. split. intro. sep on. sep lift 1. destruct H1 as [M1 [M2 [HMsplit [HM1 HM2]]]]. exists M1. exists M2. split_l. split_l. assert (WF_cvSet_M cvs M2 <-> (CV_INV_M cv *^* WF_cvSet_M (removeFirstCV cv cvs)) M2). apply H. inversion_clear H1. assert ((CV_INV_M cv *^* WF_cvSet_M (removeFirstCV cv cvs)) M2). apply H2; auto. sep on. sep matchH H1 with 2. intro. sep on. sep lift 1 in H1. destruct H1 as [M1 [M2 [HMsplit [HM1 HM2]]]]. exists M1. exists M2. split_l. split_l. assert (WF_cvSet_M cvs M2 <-> (CV_INV_M cv *^* WF_cvSet_M (removeFirstCV cv cvs)) M2). apply H. inversion_clear H1. apply H3. sep on. sep matchH HM2 with 2. Qed. Lemma decomp_ex_Lock_INV_H: forall M l m, M ||- Lock_INV_H l *^* m -> exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* m) /\ Delta w = SomeT (Gamma l). Proof. intros. unfold mjudge in *. unfold mstar in H. InvertAll. unfold Lock_INV_H in H. InvertAll. exists x1. exists x2. split; auto. unfold mstar at 1. exists x. exists x0. auto. Qed. Lemma decomp_ex_Lock_INV_H1: forall M l m, (exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* m) /\ Delta w = SomeT (Gamma l)) -> M ||- Lock_INV_H l *^* m. Proof. intros. unfold mjudge in *. unfold mstar at 1 in H. InvertAll. unfold mstar. exists x1. exists x2. split_l. split; auto. unfold Lock_INV_H. exists x. exists x0. split; auto. Qed. Lemma INV1_cvInv: forall M cv, (INV1 *^* mTrue) M -> In cv cvSet_M -> (CV_INV_M cv *^* mTrue) M. Proof. intros. assert (exists m, leqvM INV1 ((WF_lockSet_H lockSet_H) *^* (WF_cvSet_M cvSet_M) *^* m)). apply lock_inv. destruct H1 as [mP Heqv]. sep on. sep leqv_subst in H with (WF_lockSet_H lockSet_H *^* WF_cvSet_M cvSet_M *^* mP). assert (leqvM (WF_cvSet_M cvSet_M) ((CV_INV_M cv) *^* (WF_cvSet_M (removeFirstCV cv cvSet_M)))). apply WF_CVSet_decomp; auto. sep on. sep lift 1 in H. sep leqv_subst in H with (CV_INV_M cv *^* WF_cvSet_M (removeFirstCV cv cvSet_M)). sep on. sep lift 0 in H. sep matchH H with 2. Qed. Lemma INV1_decom_l: forall l, In l lockSet_H -> exists m, leqvM INV1 (Lock_INV_H l *^* m). Proof. intros. assert (exists m, leqvM INV1 ((WF_lockSet_H lockSet_H) *^* (WF_cvSet_M cvSet_M) *^* m)). apply lock_inv. destruct H0 as [mP Heqv]. assert (leqvM (WF_lockSet_H lockSet_H) ((Lock_INV_H l) *^* (WF_lockSet_H (removeFirstL l lockSet_H)))). apply WF_LockSet_decomp; auto. exists (WF_lockSet_H (removeFirstL l lockSet_H) *^* WF_cvSet_M cvSet_M *^* mP). unfold leqvM. intro M. unfold leqvM in Heqv. assert (INV1 M <-> (WF_lockSet_H lockSet_H *^* WF_cvSet_M cvSet_M *^* mP) M). apply Heqv. inversion_clear H1. split. intro. assert ((WF_lockSet_H lockSet_H *^* WF_cvSet_M cvSet_M *^* mP) M). apply H2; auto. sep on. sep lift 0 in H4. sep leqv_subst in H4 with (Lock_INV_H l *^* WF_lockSet_H (removeFirstL l lockSet_H)). sep on. sep matchH H4 with 4. intro. apply H3. sep on. sep lift 0. sep leqv_subst with (Lock_INV_H l *^* WF_lockSet_H (removeFirstL l lockSet_H)). sep on. sep matchH H1 with 4. Qed. Lemma INV1_lockInv1: forall M l, INV1 M -> In l lockSet_H -> (Lock_INV_H l *^* mTrue) M. Proof. intros. assert (exists m, leqvM INV1 (Lock_INV_H l *^* m)). apply INV1_decom_l; auto. destruct H1 as [mp Heqv]. assert ((Lock_INV_H l *^* mp) M). apply leqvM_app_subst with INV1; auto. clear H. sep on. sep matchH H1 with 2. Qed. Lemma psi_cons_a_lookup_a: forall psi f theta, SCAP_lookupCT (SCAP_consCT f theta psi) f theta. Proof. intros. unfold SCAP_lookupCT. unfold SCAP_consCT. unfold SPSpec.lookup. simpl. left. auto. Qed. Hint Resolve psi_cons_a_lookup_a. Lemma forall_enable_exists_l_release: forall (P : nat -> nat -> nat -> nat -> Pred) (g : Grt), (forall a b c d, enable (P a b c d) g) -> enable (fun S => exists a, exists b, exists c, exists d, P a b c d S) g. Proof. intros. unfold enable. unfold enable in H. intros. InvertAll. apply H with x x0 x1 x2; auto. Qed. Lemma forall_pimp_exists_l_release: forall (P Q : nat -> nat -> nat -> nat -> Pred) (g : Grt) (p p' : Pred), (forall a b c d, exists a', exists b', exists c', exists d', pimp ((P a b c d) |> g) (Q a' b' c' d')) -> frame g -> p = (fun S => exists a, exists b, exists c, exists d, P a b c d S) -> p' = (fun S => exists a, exists b, exists c, exists d, Q a b c d S) -> enable p g -> pimp ((fun S=> imprec p S) |> g) (fun S => imprec p' S). Proof. intros. apply frame_rule_1; auto. unfold pimp. intros. unfold linkPG in H4. rewrite H1 in H4. InvertAll. rename x into S0. assert (exists a' : nat, exists b' : nat, exists c' : nat, exists d' : nat, pimp (P x0 x1 x2 x3 |> g) (Q a' b' c' d')). apply H. clear H. InvertAll. rewrite H2. exists x. exists x4. exists x5. exists x6. unfold pimp in H5. apply H5. unfold linkPG. exists S0. split; auto. Qed. Lemma Lock_INV_convert_a: forall l m M w, M ||- Lock_INV_H l *^* Gamma l *^* m -> (MemUpdW M (l + L_AVAIL) 1 w) ||- Lock_INV_H l *^* m. Proof. intros. sep lift 0 in H. assert (exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* (Gamma l *^* m)) /\ Delta w = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H; auto. destruct H0 as [b [w0 [Hmem Hdelta]]]. cut (exists b, exists w0, (MemUpdW M (l + L_AVAIL) 1 w ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w0) *^* (choice (b=0) Aemp (Gamma l)) *^* m) /\ Delta w0 = SomeT (Gamma l)). intro. apply decomp_ex_Lock_INV_H1; auto. exists 1. exists w0. split; auto. sep lift 0. sep upd. sep lift 0 in Hmem. sep match_left Hmem; auto. sep trivial. sep match_left Hmem; auto. sep lift 1. sep lift 2 in Hmem. sep match_left Hmem; auto. unfold choice in *. destruct Hmem as [M01 [M02 [HM0split [HM01 HM02]]]]. sep off. right. split; auto. assert (b = 0 \/ b <> 0). apply nat_eq_neq_dec. inversion_clear H0. subst b. inversion_clear HM01. inversion_clear H0. unfold Aemp in H2. subst M01. assert (M02 = M0). auto with PMap. subst M02. auto. inversion_clear H0. absurd (0 = 0); auto. inversion_clear HM01. inversion H0. contradiction. inversion_clear H0. assert (M01 = M02). assert (precise (Gamma l)). apply precGamma. unfold precise in H0. apply H0 with M0; auto. apply MemMod.disjUnion_subseteq_left with M02; auto. apply MemMod.disjUnion_subseteq_right with M01; auto. assert (MemMod.disjoint M01 M02). inversion_clear HM0split; auto. assert (M01 = MemMod.emp). apply disj_eq_emp with M02; auto. rewrite H5 in HM0split. assert (M02 = M0). auto with PMap. rewrite <- H6. auto. Qed. Lemma gimp_l_release: forall (f f' : nat -> nat) (P P' Q : nat -> nat -> nat -> nat -> Pred) (g g' g'': Grt) (p : Pred), (forall a b c d, pimp ((P a b c d) |> g) (P' (f a) b c d)) -> frame g -> p = (fun S => exists a, exists b, exists c, exists d, P a b c d S) -> enable p g -> g' = (fun S S' => forall sp l pc bp, leadstoPQ (P' sp l pc bp) (Q (f' sp) l pc bp) S S') -> gimp (fun S S' => forall sp l pc bp, leadstoPQ (P sp l pc bp) (Q (f' (f sp)) l pc bp) S S') g'' -> gimp ((fun S : State => imprec p S) >o g oo g') g''. Proof. intros f f' P P' Q g g' g'' p. set (g''' := fun S S' => forall sp l pc bp, leadstoPQ (P sp l pc bp) (Q (f' (f sp)) l pc bp) S S'). intros. apply gimp_transt with g'''; auto. unfold gimp. unfold conjG, conjPG. intros. InvertAll. rename x into S0. unfold g'''. intros. rewrite H3 in H7. clear H3. assert (leadstoPQ (P' (f sp) l pc bp) (Q (f' (f sp) ) l pc bp) S0 S'). apply H7. clear H7. assert (gimp (g oo (leadstoPQ (P' (f sp) l pc bp) (Q (f' (f sp)) l pc bp))) (leadstoPQ (P sp l pc bp) (Q (f' (f sp)) l pc bp))). apply leadstoPQ_sameQ_reverseP; auto. rewrite H1 in H2. unfold enable. unfold enable in H2. intros. apply H2. exists sp. exists l. exists pc. exists bp. auto. unfold gimp in H5. apply H5. unfold conjG. exists S0. split; auto. Qed. Lemma sep_pure: forall m p m' M, ((fun M => m M /\ p) *^* m') M <-> (m *^* m') M /\ p. Proof. split. intros. unfold mstar in H. InvertAll. split; auto. unfold mstar. exists x. exists x0. auto. intro. unfold mstar in H. InvertAll. unfold mstar. exists x. exists x0. auto. Qed. Lemma sep_pure_a: forall m p m' M, ((fun M => m M /\ p) *^* m') M -> (m *^* m') M /\ p. Proof. intros. assert (((fun M => m M /\ p) *^* m') M <-> (m *^* m') M /\ p). apply sep_pure. inversion_clear H0. apply H1; auto. Qed. Lemma sep_pure_b: forall m p m' M, (m *^* m') M /\ p -> ((fun M => m M /\ p) *^* m') M. Proof. intros. assert (((fun M => m M /\ p) *^* m') M <-> (m *^* m') M /\ p). apply sep_pure. inversion_clear H0. apply H2; auto. Qed. Lemma INV1_lock_wid: forall M l, In l lockSet_H -> INV1 M -> (l + L_WAITING |->w_ *^* mTrue) M. Proof. intros. assert ((Lock_INV_H l *^* mTrue) M). apply INV1_lockInv1; auto. unfold Lock_INV_H in H1. assert (exists b, exists w, (l + L_AVAIL |->w b *^* l + L_WAITING |->w w *^* choice (b = 0) Aemp (Gamma l) *^* mTrue) M). unfold mstar at 1 in H1. InvertAll. exists x1. exists x2. unfold mstar at 1. exists x. exists x0. auto. InvertAll. clear H1. sep on. sep lift 1 in H2. sep matchH H2 with 4. Qed. Lemma IF_false_Prd_Itr_Stk: forall (p : Pred), (forall S, p S -> S_Flag S _IF = false) -> Prd_Itr_Stk p. Proof. intros. unfold Prd_Itr_Stk. intros. unfold itr_enabled in H1. inversion_clear H1. assert (S_Flag S _IF = false). apply H; auto. rewrite H1 in H2. inversion H2. Qed. Lemma leadstoPP_ID: forall p S, leadstoPQ p p S S. Proof. unfold leadstoPQ. induction S as (((M, R), fl), isr). intros. exists M1. split; auto. Qed. Parameter L_sleep_neq_sw: L_sleep <> _SWITCH. Parameter L_sleep_neq_blk: L_sleep <> _BLOCK. Parameter L_sleep_neq_unblk: L_sleep <> _UNBLK. Hint Resolve L_sleep_neq_sw L_sleep_neq_blk L_sleep_neq_unblk. Lemma ptoW_ptoxW_decide: forall M l v A B, M ||- l |->w v *^* A -> M ||- l |->w_ *^* B -> M ||- l |->w v *^* B. Proof. intros. assert (exists v', M ||- l |->w v' *^* B). apply ptoxW_ptoW1; auto. inversion H1. assert (x = v). apply ptoW_ptoW_eq1 with M l B A; auto. subst x. auto. Qed. Lemma leadsToW_ptoxW_unique: forall M l v A, M ||- l |->w_ *^* A -> M ||- l |~>w v -> M ||- l |->w v *^* A. Proof. intros. assert (M ||- l |->w v *^* mTrue). apply leadsToW_ptoW. auto. apply ptoW_ptoxW_decide with mTrue; auto. Qed. Definition leadstoPQ2 (P Q : MPred -> Pred) : Grt := fun (S S' : State) => forall mP, P mP S -> Q mP S'. Lemma stkUpd_presv_stkSpace: forall M sp x x' sz, sz >= 2 -> M ||- stkSpacePrec sp sz -> MemUpdW M (sp - 2) x x' ||- stkSpacePrec sp sz. Proof. intros. assert (sp >= sz). apply stkSpacePrec_sp_ge_sz with M; auto. assert (sp >= 2). apply ge_trans with sz; auto. sep stksplit. sep stksplit in H0. sep lift 1. sep upd2. sep lift 1 in H0. auto. Qed. Lemma stkUpd_presv_stkSpace1: forall M sp x x' sz B, sz >= 2 -> M ||- stkSpacePrec sp sz *^* B -> MemUpdW M (sp - 2) x x' ||- stkSpacePrec sp sz *^* B. Proof. intros. assert (sp >= sz). apply stkSpacePrec_sp_ge_sz1 with M B; auto. assert (sp >= 2). apply ge_trans with sz; auto. sep stksplit. sep stksplit in H0. sep lift 1. sep upd2. sep lift 1 in H0. auto. Qed. Ltac sep_stk_update := match goal with | |- MemUpdW ?M (?l - 2) ?v ?junk ||- stkSpacePrec ?l ?sz *^* ?B => apply stkUpd_presv_stkSpace1; [(auto with arith || omega || (unfold sz; omega) || idtac) | idtac] | |- MemUpdW ?M (?l - 2) ?v ?junk ||- stkSpacePrec ?l ?sz => apply stkUpd_presv_stkSpace; [(auto with arith || omega || (unfold sz; omega) || idtac) | idtac] | _ => fail 1 "Error: format" end. Tactic Notation "sep" "stk" "upd" := sep_stk_update. Ltac sep_blur := match goal with | H : ?M ||- ?l |->w_ *^* ?B |- ?M ||- ?l |~>w_ => (apply ptoxW_leadsToxW1 with B; auto) || idtac | H : ?M ||- ?l |->w ?v *^* ?B |- ?M ||- ?l |~>w ?v => (apply ptoW_leadsToW1 with B; auto) || idtac | H : ?M ||- ?l |->w ?v *^* ?B |- ?M ||- ?l |~>w_ => (apply ptoW_leadsToxW1 with B; auto) || idtac | _ => fail 1 "format error; tactic cannot apply" end. Ltac sep_mem_dec H H' := match type of H with | ?M ||- (?l |->w ?v) *^* ?A => match type of H' with | M ||- (l |->w_) *^* ?B => substH H' with (ptoW_ptoxW_decide M l v A B H H') end end. Tactic Notation "sep" "mem_dec" hyp (H) hyp (H') := sep_mem_dec H H'. Ltac mexists5 x x0 x1 x2 x3 := exists x; exists x0; exists x1; exists x2; exists x3. (* (* Lemmas below are proved but not used *) Lemma ptoW_indom: forall l v (M: Mem), (l |->w v) M -> MemMod.in_dom l M. Proof. unfold MemMod.in_dom. intros. unfold ptoW in H. unfold mstar in H. InvertAll. unfold pto in H. unfold MemMod.sgltonM in H. inversion_clear H. inversion_clear H0. exists v. subst M. unfold MemMod.merge. unfold MemMod.maps_to in H1. rewrite H1; auto. Qed. Lemma ptoW_indom1: forall l v m (M: Mem), (l |->w v *^* m) M -> MemMod.in_dom l M. Proof. intros. unfold mstar in H. InvertAll. assert (MemMod.in_dom l x). apply ptoW_indom with v. auto. inversion_clear H0. rewrite H4. auto with PMap. Qed. Lemma ptoW_linearity: forall l v v' M, ~ (l |->w v *^* l |->w v') M. Proof. intros. intro. unfold mstar in H. InvertAll. inversion_clear H0. unfold MemMod.disjoint in H1. assert (MemMod.not_in_dom l x \/ MemMod.not_in_dom l x0). apply H1. clear H1. inversion_clear H0. assert (MemMod.in_dom l x). apply ptoW_indom with v. auto. absurd (MemMod.in_dom l x); auto with PMap. assert (MemMod.in_dom l x0). apply ptoW_indom with v'; auto. absurd (MemMod.in_dom l x0); auto with PMap. Qed. Lemma ptoW_linearity1: forall l v v' m M, ~ (l |->w v *^* l |->w v' *^* m) M. Proof. intros. intro. unfold mstar at 1 in H.enbedBlkQ_inWQSet InvertAll. absurd (~ (l |->w v *^* l |->w v') x); auto. apply ptoW_linearity. Qed. Lemma Lock_INV_linearity: forall l M, ~ (Lock_INV_H l *^* Lock_INV_H l) M. Proof. intros. intro. sep on. assert (exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* Lock_INV_H l) /\ Delta w = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H. auto. InvertAll. sep lift 3 in H1. assert (exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* (l + L_AVAIL |->w x *^* l + L_WAITING |->w x0 *^* choice (x = 0) Aemp (Gamma l)) ) /\ Delta w = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H. auto. InvertAll. assert (M ||- l + L_AVAIL |->w x1 *^* l + L_AVAIL |->w x *^* mTrue). sep matchH H3 with 3. sep off. assert (~ (l + L_AVAIL |->w x1 *^* l + L_AVAIL |->w x *^* mTrue) M). apply ptoW_linearity1. contradiction. Qed. Lemma Lock_INV_linearity1: forall l m M, ~ (Lock_INV_H l *^* Lock_INV_H l *^* m) M. Proof. intros. intro. unfold mstar at 1 in H. InvertAll. assert (~ (Lock_INV_H l *^* Lock_INV_H l) x). apply Lock_INV_linearity. contradiction. Qed. Lemma WF_LockSet_unique: forall l ls M, WF_lockSet_H (l :: ls) M -> ~ In l ls. Proof. intros l ls. induction ls. intros. intro. unfold In. auto. intros. intro. assert (a = l \/ In l ls). apply in_inv. auto. inversion_clear H1. subst a. unfold WF_lockSet_H in H. fold WF_lockSet_H in H. sep on. assert (M ||- Lock_INV_H l *^* Lock_INV_H l *^* WF_lockSet_H ls). sep matchH H with 3. clear H. sep off. assert (~ (Lock_INV_H l *^* Lock_INV_H l *^* WF_lockSet_H ls) M). apply Lock_INV_linearity1. contradiction. assert (~ In l ls). unfold WF_lockSet_H in H. fold WF_lockSet_H in H. sep on. sep lift 1 in H. destruct H as [M1 [M2 [HMsplit [HM1 HM2]]]]. apply IHls with M2. unfold WF_lockSet_H. fold WF_lockSet_H. sep on. sep matchH HM2 with 2. contradiction. Qed. Lemma remove_notin_presv: forall (l : nat) ls, ~ In l ls -> remove eq_nat_dec l ls = ls. Proof. intros l ls. induction ls. unfold remove. auto. intros. unfold remove. induction (eq_nat_dec l a). subst l. assert (In a (a :: ls)). unfold In. left. auto. contradiction. cut (remove eq_nat_dec l ls = ls). intro. unfold remove in H0. rewrite H0. auto. apply IHls. intro. assert (In l (a :: ls)). unfold In. right. auto. contradiction. Qed. *) coq/examples/lock_acquire.v0000644000107400000620000037336411000223244015527 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Add LoadPath "../miniOS". Require Import Coqlib. Require Import List. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas5. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import Reg. Require Import Mem_Lemmas. Require Import AIM. Require Import QLib. Require Import SCAP. Require Import SCAP_READY. Require Import Linking. Require Import Linking_Lemmas. Require Import Omega. Require Import Assembly. Require Import SyncUtil. Require Import Kernel. Require Import SleepSpec. (* the stack space required by l_release *) Definition _STK_SIZE_l_acquire := 6 + _STK_SIZE_sleep. Definition l_acquire_MPre (sp l pc : Label) : MPred := (sp |->w pc) *^* (sp + 2 |->w l) *^* stkSpacePrec sp _STK_SIZE_l_acquire *^* INV1 *^* INV0. Definition l_acquire_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (l_acquire_MPre sp l pc *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_acquire_Prd (S : State) : Prop := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire_Prd_aux sp l pc bp mP S. Definition l_acquire_MPost (sp l pc: Label) : MPred := (l_acquire_MPre sp l pc) *^* (Gamma l). Definition l_acquire_Post_aux (sp l pc bp : Label) (mP :MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (l_acquire_MPost sp l pc *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_acquire_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire_Prd_aux sp l pc bp) (l_acquire_Post_aux sp l pc bp) S S'. Definition l_setacq_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BX = l /\ ((sp |->w bp) *^* (sp + 2 |->w pc) *^* (sp + 4 |->w l) *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 2) *^* INV1 *^* INV0 *^* mP) M /\ (exists avail, (l + L_AVAIL |~>w avail) M /\ R DX = avail /\ avail <> 0) /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_setacq_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_setacq_Prd_aux sp l pc bp mP S. Definition l_setacq_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_setacq_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +2) l pc bp) S S'. Definition l_acquire_psi := SCAP_consCT L_sleep (Ast L_sleep_0_p L_sleep_0_g 1) (SCAP_consCT l_setacq (Ast l_setacq_Prd l_setacq_grt 1) SCAP_emptCT). Lemma L_sleep_in_psi: SCAP_lookupCT l_acquire_psi L_sleep (Ast L_sleep_0_p L_sleep_0_g 1). Proof. unfold SCAP_lookupCT. unfold l_acquire_psi. unfold SCAP_consCT at 1. unfold SPSpec.lookup. simpl. left. auto. Qed. Lemma l_setacq_in_psi: SCAP_lookupCT l_acquire_psi l_setacq (Ast l_setacq_Prd l_setacq_grt 1). Proof. unfold SCAP_lookupCT. unfold l_acquire_psi. unfold SCAP_consCT at 1. unfold SPSpec.lookup. simpl. right. left. auto. Qed. (* spec for the next instruction *) Definition l_acquire1_MPre (sp l pc bp : Label) := (sp |->w bp) *^* (sp + 2 |->w pc) *^* (sp + 4 |->w l) *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 2) *^* INV1 *^* INV0. Definition l_acquire1_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (l_acquire1_MPre (R SP) l pc (R BP) *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_acquire1_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire1_Prd_aux sp l pc bp mP S. Definition l_acquire1_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire1_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +2) l pc bp) S S'. Lemma l_acquire_Prd_IF_false: forall S : State, l_acquire_Prd S -> S_Flag S _IF = false. Proof. unfold l_acquire_Prd. intros. induction S as (((M, R), fl), isr). unfold l_acquire_Prd_aux in H. InvertAll. UnfoldStateAll. auto. Qed. Lemma l_acquire_Grt_Itr_Stk: Grt_Itr_Stk l_acquire_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire_grt. unfold leadstoPQ2. intros. unfold l_acquire_Prd_aux in H4. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. unfold itr_enabled in H0. inversion_clear H0. UnfoldStateAll. rewrite H9 in H8. inversion H8. Qed. Lemma _STI_SIZE_acq_ge2: _STK_SIZE_l_acquire >= 2. Proof. unfold _STK_SIZE_l_acquire. omega. Qed. Hint Resolve _STI_SIZE_acq_ge2. Lemma l_acquire_Prd_aux_stkSpace: forall sp l pc bp mP S, l_acquire_Prd_aux sp l pc bp mP S -> stkSpace (S_RF S SP) _STK_SIZE_l_acquire (S_Mem S). Proof. intros. unfold l_acquire_Prd_aux in H. induction S as (((M, R), fl), isr). unfold l_acquire_MPre in H. InvertAll. sep on. sep lift 2 in H1. UnfoldStateAll. rewrite H0. sep trivial. Qed. Lemma l_acquire_step1: forall f sp l pc bp mP S S', l_acquire_Prd_aux sp l pc bp mP S -> nextS f (comml (_pushwp (Opr_reg BP))) S S' -> l_acquire1_Prd_aux (sp - 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). destruct H0 as [Hspgt2 [Hmemblk HM']]. destruct H1 as [HR' [Hfl' Hisr']]. subst R' fl' isr'. clear Htrans. unfold opr_eval in HM'. unfold l_acquire_Prd_aux in H. destruct H as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. unfold l_acquire_MPre in Hmem. unfold l_acquire1_Prd_aux. reg simpl. rewrite HRsp. split_l; split_l. split; auto. unfold l_acquire1_MPre. rewrite HRsp in Hspgt2. assert (sp - 2 + 2 = sp). auto. rewrite H. clear H. assert (sp - 2 + 4 = sp + 2). auto. rewrite H. clear H. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M'. sep on. rewrite HRsp. rewrite HRbp. sep lift 0. sep upd2. sep lift 2 in Hmem. sep stksplit in Hmem. sep matchH Hmem with 7. Qed. Lemma wff_cmd_l_acquire1: NH_WFcmd (SCAP_consCT (l_acquire + 1) (Ast l_acquire1_Prd l_acquire1_grt 1) l_acquire_psi) l_acquire (Ast l_acquire_Prd l_acquire_grt 1) (comml (_pushwp (Opr_reg BP))). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_acquire1_Prd. exists l_acquire1_grt. split. auto. assert (forall sp l pc bp mP, enable (l_acquire_Prd_aux sp l pc bp mP) (nextS l_acquire (comml (_pushwp (Opr_reg BP))))). intros. apply enable_pushwp with _STK_SIZE_l_acquire; auto. apply l_acquire_Prd_aux_stkSpace. auto. split. unfold enable in *. intros. unfold l_acquire_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_acquire_Prd in H0. InvertAll. unfold l_acquire1_Prd. mexists5 (x0 - 2) x1 x2 x3 x4. apply l_acquire_step1 with l_acquire x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_acquire_grt. unfold leadstoPQ2. intros. unfold l_acquire1_grt in H2. unfold leadstoPQ2 in H2. assert (l_acquire_Post_aux (sp - 2 + 2) l pc bp mP S'). apply H2. apply l_acquire_step1 with l_acquire S; auto. induction S as (((M, R), fl), isr). induction x as (((M', R'), fl'), isr'). destruct (nextS_inversion H3). InvertAll. unfold l_acquire_Prd_aux in H0. InvertAll. rewrite H10 in H8. assert (sp - 2 + 2 = sp). auto. rewrite H15 in H4. auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire_Prd_IF_false. apply l_acquire_Grt_Itr_Stk. Qed. Definition l_acquire2_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R BP = sp /\ l_acquire1_Prd_aux sp l pc bp mP (M, RF_update R BP bp, fl, isr) end. Definition l_acquire2_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire2_Prd_aux sp l pc bp mP S. Definition l_acquire2_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire2_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +2) l pc bp) S S'. Lemma l_acquire1_Prd_IF_false: forall S : State, l_acquire1_Prd S -> S_Flag S _IF = false. Proof. unfold l_acquire1_Prd. intros. induction S as (((M, R), fl), isr). unfold l_acquire1_Prd_aux in H. UnfoldStateAll. InvertAll. auto. Qed. Lemma l_acquire1_Grt_Itr_Stk: Grt_Itr_Stk l_acquire1_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire1_grt. unfold leadstoPQ2. intros. unfold l_acquire1_Prd_aux in H4. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. unfold itr_enabled in H0. inversion_clear H0. UnfoldStateAll. rewrite H9 in H8. inversion H8. Qed. Lemma l_acquire_step2: forall f sp l pc bp mP S S', l_acquire1_Prd_aux sp l pc bp mP S -> nextS f (comml (_movwp (Opr_reg SP) BP)) S S' -> l_acquire2_Prd_aux sp l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [HR' [Hfl' Hisr']]. unfold opr_eval in HR'. subst R' fl' isr'. clear Htrans. unfold l_acquire1_Prd_aux in H. destruct H as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. unfold l_acquire2_Prd_aux. reg simpl. rewrite HRsp. split_l. unfold l_acquire1_Prd_aux. split_l; split_l. split; auto. reg simpl. rewrite HRbp in Hmem. auto. Qed. Lemma wff_cmd_l_acquire2: NH_WFcmd (SCAP_consCT (l_acquire + 1 + 1) (Ast l_acquire2_Prd l_acquire2_grt 1) l_acquire_psi) (l_acquire + 1) (Ast l_acquire1_Prd l_acquire1_grt 1) (comml (_movwp (Opr_reg SP) BP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_acquire2_Prd. exists l_acquire2_grt. split. auto. split; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_acquire1_Prd in H. InvertAll. unfold l_acquire2_Prd. mexists5 x0 x1 x2 x3 x4. apply l_acquire_step2 with (l_acquire + 1) x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_acquire1_grt. unfold leadstoPQ2. intros. unfold l_acquire2_grt in H1. unfold leadstoPQ2 in H1. apply H1. apply l_acquire_step2 with (l_acquire + 1) S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire1_Prd_IF_false. apply l_acquire1_Grt_Itr_Stk. Qed. (* _movwld (A_reg 4 BP) BX *) Definition l_acquire3_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R BX = l /\ exists bx, l_acquire2_Prd_aux sp l pc bp mP (M, RF_update R BX bx, fl, isr) end. Definition l_acquire3_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire3_Prd_aux sp l pc bp mP S. Definition l_acquire3_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire3_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +2) l pc bp) S S'. Lemma l_acquire2_Prd_IF_false: forall S : State, l_acquire2_Prd S -> S_Flag S _IF = false. Proof. unfold l_acquire2_Prd. intros. induction S as (((M, R), fl), isr). unfold l_acquire2_Prd_aux in H. unfold l_acquire1_Prd_aux in H. UnfoldStateAll. InvertAll. auto. Qed. Lemma l_acquire2_Grt_Itr_Stk: Grt_Itr_Stk l_acquire2_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire2_grt. unfold leadstoPQ2. intros. unfold l_acquire2_Prd_aux in H4. induction S as (((M, R), fl), isr). UnfoldStateAll. unfold l_acquire1_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. inversion_clear H0. UnfoldStateAll. rewrite H10 in H9. inversion H9. Qed. Lemma STK_SZ_acq_N2_ge2: _STK_SIZE_l_acquire - 2 >= 2. Proof. unfold _STK_SIZE_l_acquire. omega. Qed. Hint Resolve STK_SZ_acq_N2_ge2. Lemma l_acquire2_Prd_1: forall sp l pc bp mP S, l_acquire2_Prd_aux sp l pc bp mP S -> ((addr_eval (S_RF S) (A_reg 4 BP)) |~>w l) (S_Mem S). Proof. intros. unfold l_acquire2_Prd_aux in H. induction S as (((M, R), fl), isr). unfold l_acquire1_Prd_aux in H. unfold l_acquire1_MPre in H. InvertAll. reg simpl. unfold addr_eval. unfold S_RF. unfold S_Mem. sep on. sep lift 2 in H2. rewrite H0. rewrite H in H2. sep trivial. Qed. Lemma l_acquire_step3: forall f sp l pc bp mP S S', l_acquire2_Prd_aux sp l pc bp mP S -> nextS f (comml (_movwld (A_reg 4 BP) BX)) S S' -> l_acquire3_Prd_aux sp l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [[x [Hmemx HR']] [Hfl' Hisr']]. assert (x = l). assert ((addr_eval (S_RF (M, R, fl, isr)) (A_reg 4 BP) |~>w l) (S_Mem (M, R, fl, isr))). apply l_acquire2_Prd_1 with sp pc bp mP; auto. UnfoldStateAll. apply leadsToW_unique with (addr_eval R (A_reg 4 BP)) M; auto. subst x. subst R' fl' isr'. unfold l_acquire3_Prd_aux. split. reg simpl. auto. exists (R BX). assert (RF_update (RF_update R BX l) BX (R BX) = R). assert (RF_update (RF_update R BX l) BX (R BX) = RF_update R BX (R BX)). apply RF_update_RF_update. rewrite H0. apply RF_update_prev. rewrite H0. auto. Qed. Lemma wff_cmd_l_acquire3: NH_WFcmd (SCAP_consCT (l_acquire + 1 + 1 + 1) (Ast l_acquire3_Prd l_acquire3_grt 1) l_acquire_psi) (l_acquire + 1 + 1) (Ast l_acquire2_Prd l_acquire2_grt 1) (comml (_movwld (A_reg 4 BP) BX)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_acquire3_Prd. exists l_acquire3_grt. split. auto. (* enable *) generalize (l_acquire + 1 + 1). intro f. assert (forall sp l pc bp mP, enable (l_acquire2_Prd_aux sp l pc bp mP) (nextS f (comml (_movwld (A_reg 4 BP) BX)))). intros. apply enable_movwld. intros. assert (((addr_eval (S_RF S) (A_reg 4 BP)) |~>w l) (S_Mem S)). apply l_acquire2_Prd_1 with sp pc bp mP; auto. apply leadsToW_leadsToxW with l; auto. split. unfold enable in *. intros. unfold l_acquire2_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_acquire2_Prd in H0. InvertAll. unfold l_acquire3_Prd. exists x0. exists x1. exists x2. exists x3. exists x4. apply l_acquire_step3 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_acquire2_grt. unfold leadstoPQ2. intros. unfold l_acquire3_grt in H2. unfold leadstoPQ2 in H2. apply H2. apply l_acquire_step3 with f S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire2_Prd_IF_false. apply l_acquire2_Grt_Itr_Stk. Qed. Definition l_acquire4_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BX = l /\ (l_acquire1_MPre sp l pc bp *^* mP) M /\ (exists avail, (l + L_AVAIL |~>w avail) M /\ R DX = avail) /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_acquire4_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire4_Prd_aux sp l pc bp mP S. Definition l_acquire4_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire4_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +2) l pc bp) S S'. Lemma l_acquire3_Prd_1: forall sp l pc bp mP S, l_acquire3_Prd_aux sp l pc bp mP S -> ((addr_eval (S_RF S) (A_reg L_AVAIL BX)) |~>w_) (S_Mem S). Proof. intros. unfold l_acquire3_Prd_aux in H. induction S as (((M, R), fl), isr). unfold l_acquire2_Prd_aux in H. unfold l_acquire1_Prd_aux in H. unfold l_acquire1_MPre in H. InvertAll. reg simpl. unfold addr_eval. unfold S_RF. unfold S_Mem. sep on. sep lift 4 in H3. assert (forall M, INV1 M -> (Lock_INV_H l *^* mTrue) M). intros. apply INV1_lockInv1; auto. sep weaker_subst in H3 with (Lock_INV_H l *^* mTrue). sep on. sep lift 0 in H3. assert (exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* (mTrue *^* (INV0 *^* mP *^* (R SP |->w bp *^* R SP + 2 |->w pc *^* R SP + 4 |->w l *^* stkSpacePrec (R SP) (_STK_SIZE_l_acquire - 2)))) ) /\ Delta w = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H; auto. InvertAll. rewrite H0. sep lift 0 in H10. sep trivial. Qed. Lemma l_acquire_step4: forall f sp l pc bp mP S S', l_acquire3_Prd_aux sp l pc bp mP S -> nextS f (comml (_movwld (A_reg L_AVAIL BX) DX)) S S' -> l_acquire4_Prd_aux sp l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [[x [Hmemx HR']] [Hfl' Hisr']]. unfold l_acquire4_Prd_aux. subst R' fl' isr'. reg simpl. unfold l_acquire3_Prd_aux in H. destruct H as [HRbx [bx0 Hpre]]. unfold l_acquire2_Prd_aux in Hpre. reg simpl. unfold l_acquire1_Prd_aux in Hpre. reg simpl. destruct Hpre as [HRbp [HRsp [Htmp [Hmem [Hlock [Hfl Hisr]]]]]]. split_l. split_l. split. rewrite HRsp in Hmem. auto. split; auto. exists x. split; auto. unfold addr_eval in Hmemx. rewrite HRbx in Hmemx. auto. Qed. Lemma l_acquire3_Prd_IF_false: forall S : State, l_acquire3_Prd S -> S_Flag S _IF = false. Proof. unfold l_acquire3_Prd. intros. induction S as (((M, R), fl), isr). unfold l_acquire3_Prd_aux in H. unfold l_acquire2_Prd_aux in H. unfold l_acquire1_Prd_aux in H. InvertAll. auto. Qed. Lemma l_acquire3_Grt_Itr_Stk: Grt_Itr_Stk l_acquire3_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire3_grt. unfold leadstoPQ2. intros. unfold l_acquire3_Prd_aux in H4. induction S as (((M, R), fl), isr). UnfoldStateAll. unfold l_acquire2_Prd_aux in H4. unfold l_acquire1_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. inversion_clear H0. UnfoldStateAll. rewrite H11 in H10. inversion H10. Qed. Lemma wff_cmd_l_acquire4: NH_WFcmd (SCAP_consCT (l_acquire + 1 + 1 + 1 + 1) (Ast l_acquire4_Prd l_acquire4_grt 1) l_acquire_psi) (l_acquire + 1 + 1 + 1) (Ast l_acquire3_Prd l_acquire3_grt 1) (comml (_movwld (A_reg L_AVAIL BX) DX)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_acquire4_Prd. exists l_acquire4_grt. split. auto. (* enable *) generalize (l_acquire + 1 + 1 + 1). intro f. assert (forall sp l pc bp mP, enable (l_acquire3_Prd_aux sp l pc bp mP) (nextS f (comml (_movwld (A_reg L_AVAIL BX) DX)))). intros. apply enable_movwld. intros. apply l_acquire3_Prd_1 with sp l pc bp mP; auto. split. unfold enable in *. intros. unfold l_acquire3_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_acquire3_Prd in H0. InvertAll. unfold l_acquire4_Prd. exists x0. exists x1. exists x2. exists x3. exists x4. apply l_acquire_step4 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_acquire3_grt. unfold leadstoPQ2. intros. unfold l_acquire4_grt in H2. unfold leadstoPQ2 in H2. apply H2. apply l_acquire_step4 with f S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire3_Prd_IF_false. apply l_acquire3_Grt_Itr_Stk. Qed. Definition l_acquire5_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => exists fl', l_acquire4_Prd_aux sp l pc bp mP (M, R, fl', isr) /\ ((R DX = 0) /\ (fl = Set_Flag fl' _ZF) \/ (R DX <> 0) /\ (fl = Clear_Flag fl' _ZF)) end. Definition l_acquire5_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire5_Prd_aux sp l pc bp mP S. Definition l_acquire5_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire5_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +2) l pc bp) S S'. Lemma l_acquire_step5: forall f sp l pc bp mP S S', l_acquire4_Prd_aux sp l pc bp mP S -> nextS f (comml (_cmpw (Opr_imm 0) DX)) S S' -> l_acquire5_Prd_aux sp l pc bp mP S'. Proof. intros. rename H into Hpre. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). InvertAll. subst M'. subst R' isr'. unfold l_acquire5_Prd_aux. exists fl. unfold opr_eval in H0. split; auto. inversion_clear H0. left. inversion H. split; auto. inversion H. right. split; auto. Qed. Lemma l_acquire4_Prd_IF_false: forall S : State, l_acquire4_Prd S -> S_Flag S _IF = false. Proof. intros. unfold l_acquire4_Prd in H. InvertAll. unfold l_acquire4_Prd_aux in H0. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. auto. Qed. Lemma l_acquire4_Grt_Itr_Stk: Grt_Itr_Stk l_acquire4_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire4_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_acquire4_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H10 in H9. inversion H9. Qed. Lemma wff_cmd_l_acquire5: NH_WFcmd (SCAP_consCT (l_acquire + 1 + 1 + 1 + 1 + 1) (Ast l_acquire5_Prd l_acquire5_grt 1) l_acquire_psi) (l_acquire + 1 + 1 + 1 + 1) (Ast l_acquire4_Prd l_acquire4_grt 1) (comml (_cmpw (Opr_imm 0) DX)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_acquire5_Prd. exists l_acquire5_grt. split. auto. generalize (l_acquire + 1 + 1 + 1 + 1). intro f. split. apply trivial_enable_cmpw. split. unfold pimp. unfold linkPG. intros S1 Htmp. destruct Htmp as [S0 [Hpre Htrans]]. unfold l_acquire5_Prd. unfold l_acquire4_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. exists sp. exists l. exists pc. exists bp. exists mP. apply l_acquire_step5 with f S0. auto. auto. unfold gimp. unfold conjG. unfold conjPG. intros. destruct H as [S0 [Htmp Hgrt5]]. destruct Htmp as [Hpre Htrans]. unfold l_acquire4_grt. unfold leadstoPQ2. intros. unfold l_acquire5_grt in Hgrt5. unfold leadstoPQ2 in Hgrt5. apply Hgrt5. apply l_acquire_step5 with f S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire4_Prd_IF_false. apply l_acquire4_Grt_Itr_Stk. Qed. Definition l_acquire6_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => (l_acquire4_Prd_aux sp l pc bp mP (M, R, fl, isr)) /\ R DX = 0 end. Definition l_acquire6_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire6_Prd_aux sp l pc bp mP S. Definition l_acquire6_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire6_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +2) l pc bp) S S'. Lemma l_acquire5_Prd_IF_false: forall S : State, l_acquire5_Prd S -> S_Flag S _IF = false. Proof. unfold l_acquire5_Prd. unfold l_acquire5_Prd_aux. unfold l_acquire4_Prd_aux. intros. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. inversion_clear H1. InvertAll. rewrite H9. unfold Set_Flag. simpl. auto. InvertAll. rewrite H9. unfold Clear_Flag. simpl. auto. Qed. Lemma l_acquire5_Grt_Itr_Stk: Grt_Itr_Stk l_acquire5_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire5_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_acquire5_Prd_aux in H4. unfold l_acquire4_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. inversion_clear H6. inversion_clear H0. rewrite H15 in H11. unfold Set_Flag in H11. simpl in H11. rewrite H11 in H10. inversion H10. inversion_clear H0. rewrite H15 in H11. unfold Clear_Flag in H11. simpl in H11. rewrite H11 in H10. inversion H10. Qed. Lemma l_acquire_step6_a: forall sp l pc bp mP S, l_acquire5_Prd_aux sp l pc bp mP S -> ZF_cl S -> l_setacq_Prd_aux sp l pc bp mP S. Proof. intros. unfold l_acquire5_Prd_aux in H. induction S as (((M, R), fl), isr). destruct H as [fl' [Hpre4 Hcases]]. unfold ZF_cl in H0. unfold S_Flag in H0. inversion_clear Hcases. inversion_clear H. rewrite H2 in H0. unfold Set_Flag in H0. simpl in H0. inversion H0. inversion_clear H. rename H1 into Hdx0. rename H0 into Hzffalse. rename H2 into Hfl. unfold l_acquire4_Prd_aux in Hpre4. destruct Hpre4 as [Hsp [Hbx [Hmem1 [Hmem2 [Hlock [Hfl' Hisr]]]]]]. unfold l_setacq_Prd_aux. split_l. split_l. split. unfold l_acquire1_MPre in Hmem1. auto. rewrite Hfl. unfold Clear_Flag. simpl. split; auto. destruct Hmem2 as [avail [Hinmem Hinreg]]. exists avail. split_l. split_l. rewrite <- Hinreg. auto. Qed. Lemma l_acquire_step6_b: forall sp l pc bp mP S, l_acquire5_Prd_aux sp l pc bp mP S -> ZF_st S -> l_acquire6_Prd_aux sp l pc bp mP S. Proof. intros. unfold l_acquire5_Prd_aux in H. induction S as (((M, R), fl), isr). destruct H as [fl' [Hpre6 Hcases]]. unfold ZF_st in H0. unfold S_Flag in H0. inversion_clear Hcases. inversion_clear H. rename H1 into Hax0. rename H0 into Hzftrue. rename H2 into Hfl. unfold l_acquire6_Prd_aux. split; auto. unfold l_acquire4_Prd_aux in *. InvertAll. split_l. split_l. split_l. rewrite Hfl. unfold Set_Flag. simpl. split; auto. exists x. split; auto. inversion_clear H. rewrite H2 in H0. unfold Clear_Flag in H0. simpl in H0. inversion H0. Qed. Lemma wff_cmd_l_acquire6: NH_WFcmd (SCAP_consCT (l_acquire + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_acquire6_Prd l_acquire6_grt 1) l_acquire_psi) (l_acquire + 1 + 1 + 1 + 1 + 1) (Ast l_acquire5_Prd l_acquire5_grt 1) (comml (_jne l_setacq)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_setacq_Prd. exists l_acquire6_Prd. exists l_setacq_grt. exists l_acquire6_grt. split. unfold SCAP_lookupCT. unfold SCAP_consCT. unfold SPSpec.lookup. unfold ListT.In. right. assert (SCAP_lookupCT l_acquire_psi l_setacq (Ast l_setacq_Prd l_setacq_grt 1)). apply l_setacq_in_psi. auto. split; auto. split. unfold conjP. unfold pimp. intros. destruct H as [Hpre Hzf]. unfold l_acquire5_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold l_setacq_Prd. exists sp. exists l. exists pc. exists bp. exists mP. apply l_acquire_step6_a; auto. split. unfold gimp. unfold conjPG. intros. destruct H as [Hpre [Hzf Hgrtdone]]. unfold l_acquire5_grt. unfold leadstoPQ2. intros. unfold l_setacq_grt in Hgrtdone. unfold leadstoPQ2 in Hgrtdone. apply Hgrtdone. apply l_acquire_step6_a; auto. unfold conjP. split. unfold pimp. intros. destruct H as [Hpre Hzf]. unfold l_acquire5_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold l_acquire6_Prd. exists sp. exists l. exists pc. exists bp. exists mP. apply l_acquire_step6_b; auto. unfold gimp. unfold conjPG. intros. destruct H as [Hpre [Hzf Hgrtdone]]. unfold l_acquire5_grt. unfold leadstoPQ2. intros. unfold l_acquire6_grt in Hgrtdone. unfold leadstoPQ2 in Hgrtdone. apply Hgrtdone. apply l_acquire_step6_b; auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire5_Prd_IF_false. apply l_acquire5_Grt_Itr_Stk. Qed. Definition l_acquire7_MPre (sp l pc bp wid : Label) := (sp |->w wid) *^* (sp +2 |->w bp) *^* (sp + 4|->w pc) *^* (sp + 6 |->w l) *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 4) *^* INV1 *^* INV0. Definition l_acquire7_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (exists w, (l_acquire7_MPre sp l pc bp w *^* mP) M /\ ((sp |->w w) *^* (l + L_WAITING |->w w) *^* (l + L_AVAIL |->w 0) *^* mTrue) M) /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_acquire7_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire7_Prd_aux sp l pc bp mP S. Definition l_acquire7_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire7_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +4) l pc bp) S S'. Lemma l_acquire6_Prd_IF_false: forall S : State, l_acquire6_Prd S -> S_Flag S _IF = false. Proof. unfold l_acquire6_Prd. unfold l_acquire6_Prd_aux. intros. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. unfold l_acquire4_Prd_aux in H. InvertAll. auto. Qed. Lemma l_acquire6_Grt_Itr_Stk: Grt_Itr_Stk l_acquire6_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire6_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_acquire6_Prd_aux in H4. unfold l_acquire4_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H11 in H10. inversion H10. Qed. Lemma l_acquire7_Prd_IF_false: forall S : State, l_acquire7_Prd S -> S_Flag S _IF = false. Proof. unfold l_acquire7_Prd. unfold l_acquire7_Prd_aux. intros. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. auto. Qed. Lemma l_acquire7_Grt_Itr_Stk: Grt_Itr_Stk l_acquire7_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire7_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_acquire7_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H8 in H7. inversion H7. Qed. Lemma l_acquire6_Prd_enable: forall f sp l pc bp mP, enable (l_acquire6_Prd_aux sp l pc bp mP) (nextS f (comml (_pushwm (A_reg L_WAITING BX)))). Proof. unfold enable. intros. unfold l_acquire6_Prd_aux in H. induction S as (((M, R), fl), isr). destruct H as [Hpre HRdx0]. unfold l_acquire4_Prd_aux in Hpre. destruct Hpre as [HRsp [HRbx [Hmem1 [Hmem2 [Hlock [Hfl Hisr]]]]]]. unfold l_acquire1_MPre in Hmem1. sep on. sep lift 4 in Hmem1. assert (forall M, INV1 M -> (Lock_INV_H l *^* mTrue) M). intros. apply INV1_lockInv1; auto. sep weaker_subst in Hmem1 with (Lock_INV_H l *^* mTrue). sep on. sep lift 0 in Hmem1. assert (exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* (mTrue *^* (INV0 *^* mP *^* (sp |->w bp *^* sp + 2 |->w pc *^* sp + 4 |->w l *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 2)))) ) /\ Delta w = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H; auto. InvertAll. exists (MemUpdW M (R SP - 2) x0 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_pushwm with (addr_eval R (A_reg L_WAITING BX)) x0. auto. unfold addr_eval. rewrite HRbx. sep on. sep lift 1 in H2. sep trivial. unfold pushW. split. rewrite HRsp. sep on. sep lift 9 in H2. sep stksplit 2 in H2. sep lift 0 in H2. sep trivial. split; auto. apply MemUpdW_MemUpd16 with 0; auto. Qed. Lemma l_acquire_step7: forall f sp l pc bp mP S S', l_acquire6_Prd_aux sp l pc bp mP S -> nextS f (comml (_pushwm (A_reg L_WAITING BX))) S S' -> l_acquire7_Prd_aux (sp - 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). destruct H0 as [w [Hsrc [Hspgt2 [Hmemblk HM']]]]. destruct H1 as [HR' [Hfl' Hisr']]. subst R' fl' isr'. clear Htrans. unfold l_acquire7_Prd_aux. unfold l_acquire6_Prd_aux in H. unfold l_acquire4_Prd_aux in H. destruct H as [[HRsp [HRbx [Hmem1 [Hmem2 [Hlock [Hfl Hisr]]]]]] HRdx0]. reg simpl. split. rewrite HRsp. auto. split; auto. exists w. split. unfold l_acquire7_MPre. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M'. rewrite HRsp. sep on. sep lift 0. sep upd. unfold l_acquire1_MPre in Hmem1. sep lift 3 in Hmem1. sep stksplit in Hmem1. assert (_STK_SIZE_l_acquire - 2 - 2 = _STK_SIZE_l_acquire - 4); auto. rewrite H in Hmem1. rewrite HRsp in Hspgt2. assert (sp - 2 + 2 = sp); auto. rewrite H0. clear H0. assert (sp - 2 + 4 = sp + 2); auto. rewrite H0; clear H0. assert (sp - 2 + 6 = sp + 4). auto. rewrite H0; clear H0. sep matchH Hmem1 with 8. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M'. rewrite HRsp. sep on. sep lift 0. sep upd. unfold l_acquire1_MPre in Hmem1. sep lift 4 in Hmem1. assert (forall M, INV1 M -> (Lock_INV_H l *^* mTrue) M). intros. apply INV1_lockInv1; auto. sep weaker_subst in Hmem1 with (Lock_INV_H l *^* mTrue). sep on. sep lift 0 in Hmem1. assert (exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* (mTrue *^* (INV0 *^* mP *^* (sp |->w bp *^* sp + 2 |->w pc *^* sp + 4 |->w l *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 2)))) ) /\ Delta w = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H; auto. InvertAll. assert (x = x1). sep lift 0 in H2. apply ptoW_leadsToW_eq1 with M (l + L_AVAIL) (l + L_WAITING |->w x0 *^* (choice (x = 0) Aemp (Gamma l) *^* (mTrue *^* (INV0 *^* mP *^* (sp |->w bp *^* sp + 2 |->w pc *^* sp + 4 |->w l *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 2)))))); auto. rewrite <- H5 in H1. rewrite HRdx0 in H1. rewrite H1 in H2. unfold addr_eval in Hsrc. rewrite HRbx in Hsrc. assert (x0 = w). sep lift 1 in H2. apply ptoW_leadsToW_eq1 with M (l + L_WAITING) (choice (0 = 0) Aemp (Gamma l) *^* (mTrue *^* (INV0 *^* mP *^* (sp |->w bp *^* sp + 2 |->w pc *^* sp + 4 |->w l *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 2)))) *^* l + L_AVAIL |->w 0); auto. rewrite <- H6. sep lift 9 in H2. sep stksplit in H2. sep lift 1 in H2. sep match_left H2. auto. sep lift 1 in H2. sep match_left H2; auto. sep lift 8 in H2. sep match_left H2; auto. Qed. Lemma wff_cmd_l_acquire7: NH_WFcmd (SCAP_consCT (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_acquire7_Prd l_acquire7_grt 1) l_acquire_psi) (l_acquire + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_acquire6_Prd l_acquire6_grt 1) (comml (_pushwm (A_reg L_WAITING BX))). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_acquire7_Prd. exists l_acquire7_grt. split. auto. generalize (l_acquire + 1 + 1 + 1 + 1 + 1 + 1). intro f. assert (forall sp l pc bp mP, enable (l_acquire6_Prd_aux sp l pc bp mP) (nextS f (comml (_pushwm (A_reg L_WAITING BX))))). apply l_acquire6_Prd_enable. split. unfold enable in *. intros. unfold l_acquire6_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_acquire6_Prd in H0. InvertAll. unfold l_acquire7_Prd. mexists5 (x0 - 2) x1 x2 x3 x4. apply l_acquire_step7 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_acquire6_grt. unfold leadstoPQ2. intros. unfold l_acquire7_grt in H2. unfold leadstoPQ2 in H2. assert (l_acquire_Post_aux (sp - 2 + 4) l pc bp mP S'). apply H2. apply l_acquire_step7 with f S; auto. induction S as (((M, R), fl), isr). induction x as (((M', R'), fl'), isr'). destruct (nextS_inversion H3). InvertAll. unfold l_acquire6_Prd_aux in H0. unfold l_acquire4_Prd_aux in H0. InvertAll. reg simpl. rewrite <- H0. rewrite <- H0 in H4. assert (R SP - 2 + 4 = R SP + 2). auto. rewrite H18 in H4. auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire6_Prd_IF_false. apply l_acquire6_Grt_Itr_Stk. Qed. Definition l_acquire8_MPre (sp l pc bp : Label) := (sp + 2 |->w bp) *^* (sp + 4 |->w pc) *^* (sp + 6 |->w l) *^* stkSpacePrec (sp + 2) (_STK_SIZE_l_acquire - 2) *^* INV1 *^* INV0 *^* Gamma l. Definition l_acquire8_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (l_acquire8_MPre (R SP) l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_acquire8_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire8_Prd_aux sp l pc bp mP S. Definition l_acquire8_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire8_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +4) l pc bp) S S'. Lemma _STK_SZ_acq_N4_ge2: _STK_SIZE_l_acquire - 4 >= 2. Proof. unfold _STK_SIZE_l_acquire. omega. Qed. Hint Resolve _STK_SZ_acq_N4_ge2. Lemma _STK_SZ_acq_N4_N2_eqsleep: _STK_SIZE_l_acquire - 4 - 2 = _STK_SIZE_sleep. Proof. unfold _STK_SIZE_l_acquire. omega. Qed. Hint Resolve _STK_SZ_acq_N4_N2_eqsleep. Definition L_sleep_closure_acq (sp l pc bp : int) (mP : MPred) := sp + 2 |->w bp *^* sp + 4 |->w pc *^* sp + 6 |->w l *^* mP. Lemma l_acquire_step8_call2: forall f sp l pc bp mP S S', l_acquire7_Prd_aux sp l pc bp mP S -> nextS f (comml (_call L_sleep)) S S' -> exists w, Ast_sleep_0 w (Gamma l) (sp - 2) (f + 1) (L_sleep_closure_acq sp l pc bp mP) S'. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion H0). destruct H1 as [Hspgt2 [Hpcspace HM']]. destruct H2 as [HR' [Hfl' Hisr']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. clear H0. unfold l_acquire7_Prd_aux in H. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. destruct Hmem as [w [Hmem1 Hmem2]]. rewrite HRsp. exists w. unfold Ast_sleep_0. UnfoldStateAll. reg simpl. split. unfold l_acquire7_MPre in Hmem1. rewrite HRsp in Hspgt2. sep on. sep lift 3. sep upd. assert (sp - 2 + 2 = sp). auto. rewrite H. clear H. sep lift 4 in Hmem1. sep stksplit in Hmem1. assert (_STK_SIZE_l_acquire - 4 - 2 = _STK_SIZE_sleep); auto. rewrite H in Hmem1. unfold L_sleep_closure_acq. sep matchH Hmem1 with 9. split_l. split. unfold l_acquire7_MPre in Hmem1. sep on. sep lift 4 in Hmem1. sep stksplit in Hmem1. assert (sp - 2 >= _STK_SIZE_l_acquire - 4 - 2). apply stkSpacePrec_sp_ge_sz1 with M (sp - 2 |->w_ *^* (INV1 *^* (INV0 *^* mP) *^* (sp |->w w *^* sp + 2 |->w bp *^* sp + 4 |->w pc *^* sp + 6 |->w l))); auto. assert (_STK_SIZE_l_acquire - 4 - 2 = _STK_SIZE_sleep). auto. rewrite H0 in H. auto. split_l. split_l. unfold l_acquire7_MPre in Hmem1. sep on. sep lift 5 in Hmem1. assert (forall M, INV1 M -> (Lock_INV_H l *^* mTrue) M). intros. apply INV1_lockInv1; auto. sep weaker_subst in Hmem1 with (Lock_INV_H l *^* mTrue). sep on. sep lift 0 in Hmem1. assert (exists b, exists w0, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w0) *^* (choice (b=0) Aemp (Gamma l)) *^* (mTrue *^* (INV0 *^* mP *^* (sp |->w w *^* sp + 2 |->w bp *^* sp + 4 |->w pc *^* sp + 6 |->w l *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 4)))) ) /\ Delta w0 = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H; auto. destruct H1 as [b [w0 [Hmem' Hdelta]]]. sep lift 1 in Hmem'. sep lift 1 in Hmem2. assert (w = w0). eapply ptoW_ptoW_eq1; eauto. rewrite H1. auto. Qed. Lemma l_acquire7_enable: forall f sp l pc bp mP, enable (l_acquire7_Prd_aux sp l pc bp mP) (nextS f (comml (_call L_sleep))). Proof. intros. unfold enable. intros. unfold l_acquire7_Prd_aux in H. induction S as (((M, R), fl), isr). exists (MemUpdW M (R SP - 2) (f+1) 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_call. unfold pushW. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. split. destruct Hmem as [w [Hmem1 Hmem2]]. unfold l_acquire7_MPre in Hmem1. sep on. sep lift 4 in Hmem1. sep stksplit 2 in Hmem1. rewrite HRsp. sep lift 0 in Hmem1. sep trivial. split; auto. apply MemUpdW_MemUpd16 with 0; auto. Qed. Lemma wff_cmd_l_acquire8: NH_WFcmd (SCAP_consCT (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_acquire8_Prd l_acquire8_grt 1) l_acquire_psi) (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_acquire7_Prd l_acquire7_grt 1) (comml (_call L_sleep)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. right. split. intro. unfold prim_entry in H. inversion_clear H. absurd (L_sleep <> _SWITCH); auto. inversion_clear H0. absurd (L_sleep <> _BLOCK); auto. absurd (L_sleep <> _UNBLK); auto. unfold NH_Normal_Call. exists L_sleep_0_p. exists l_acquire8_Prd. exists L_sleep_0_g. exists l_acquire8_grt. split. unfold SCAP_lookupCT. unfold SCAP_consCT. unfold SPSpec.lookup. unfold ListT.In. right. assert (SCAP_lookupCT l_acquire_psi L_sleep (Ast L_sleep_0_p L_sleep_0_g 1)). apply L_sleep_in_psi. auto. split. auto. generalize (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1). intro f. split. unfold enable. unfold l_acquire7_Prd. assert (forall f sp l pc bp mP, enable (l_acquire7_Prd_aux sp l pc bp mP) (nextS f (comml (_call L_sleep)))). apply l_acquire7_enable. intros. InvertAll. unfold enable in H. apply H with x x0 x1 x2 x3; auto. Lemma l_acquire_step8_call1: forall f, gimp (sp_call_pred l_acquire7_Prd f L_sleep >o L_sleep_0_g) fun_frame. Proof. unfold gimp. unfold sp_call_pred. unfold conjPG. unfold linkPG. intros. destruct H as [[S0 [Hpre Htrans]] Hgrt]. unfold l_acquire7_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. assert (exists w, Ast_sleep_0 w (Gamma l) (sp - 2) (f + 1) (L_sleep_closure_acq sp l pc bp mP) S). apply l_acquire_step8_call2 with S0; auto. rename H into HFpre. destruct HFpre as [w HFpre]. unfold L_sleep_0_g in Hgrt. assert (Ast_sleep_post w (Gamma l) (sp-2) (f+1) (L_sleep_closure_acq sp l pc bp mP) S' /\ S_RF S' = S_RF S). apply Hgrt; auto. clear Hgrt. unfold fun_frame. destruct H as [HPost HRF']. split. rewrite HRF'. auto. exists (f + 1). unfold Ret_Addr. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. split. intro. apply nextPC_retw with (sp - 2). unfold Ast_sleep_0 in HFpre. UnfoldStateAll. InvertAll. auto. unfold Ast_sleep_0 in HFpre. UnfoldStateAll. InvertAll. sep on. sep lift 3 in H. sep trivial. intro. unfold Ast_sleep_post in HPost. UnfoldStateAll. InvertAll. unfold Ast_sleep_0 in HFpre. UnfoldStateAll. InvertAll. apply nextPC_retw with (sp - 2); auto. rewrite HRF'; auto. sep on. sep lift 4 in H. sep trivial. Qed. split. apply l_acquire_step8_call1. split. unfold pimp. unfold linkPG. intros. destruct H as [S0 [Hpre Htrans]]. unfold l_acquire7_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. assert (exists w, Ast_sleep_0 w (Gamma l) (sp - 2) (f + 1) (L_sleep_closure_acq sp l pc bp mP) S). apply l_acquire_step8_call2 with S0; auto. destruct H as [w HFpre]. unfold L_sleep_0_p. exists w. exists (Gamma l). exists (sp - 2). exists (f + 1). induction S as (((M, R), fl), isr). unfold Ast_sleep_0 in *. UnfoldStateAll. InvertAll. split; auto. sep on. sep matchH H with 5. Lemma l_acquire_step8_call3: forall f pc' sp l pc bp mP S S', l_acquire7_Prd_aux sp l pc bp mP S -> wrap_fun L_sleep_0_g f L_sleep pc' S S' -> l_acquire8_Prd_aux sp l pc bp mP S'. Proof. intros. rename H into Hpre. rename H0 into Htrans. unfold wrap_fun in Htrans. unfold conjG in Htrans. destruct Htrans as [S2 [[S1 [Hcall Hgrt]] Hretw]]. assert (sp >= 2). unfold l_acquire7_Prd_aux in Hpre. induction S as (((M, R), fl), isr). induction S1 as (((M', R'), fl'), isr'). InvertAll. destruct (nextS_inversion Hcall). InvertAll. rewrite H in H8; auto. rename H into Hspge2. assert (exists w, Ast_sleep_0 w (Gamma l) (sp - 2) (f + 1) (L_sleep_closure_acq sp l pc bp mP) S1). apply l_acquire_step8_call2 with S; auto. destruct H as [w HFpre]. unfold L_sleep_0_g in Hgrt. assert (Ast_sleep_post w (Gamma l) (sp-2) (f+1) (L_sleep_closure_acq sp l pc bp mP) S2 /\ S_RF S2 = S_RF S1). apply Hgrt; auto. clear Hgrt Hcall. destruct H as [Hpre' HR]. induction S2 as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Hretw). subst M'. destruct H0 as [[pc'' [HMpc HR']] [Hfl' Hisr']]. subst fl' isr' R'. clear Hretw. clear HMpc. unfold Ast_sleep_post in Hpre'. UnfoldStateAll. destruct Hpre' as [Hmem [Hfl Hisr]]. unfold l_acquire8_Prd_aux. reg simpl. assert (R SP + 2 = sp). unfold Ast_sleep_0 in HFpre. induction S1 as (((M2, R2), fl2), isr2). rewrite HR. UnfoldStateAll. InvertAll. rewrite H1. auto. split_l. split. rewrite H. clear H. unfold l_acquire8_MPre. unfold L_sleep_closure_acq in Hmem. assert (sp - 2 + 2 = sp). auto. rewrite H in Hmem. sep on. sep lift 3. sep stksplit. assert (sp + 2 - 2 = sp). auto. rewrite H0. sep stksplit. assert (_STK_SIZE_l_acquire - 2 - 2 - 2 = 18 + 2 + _BLK_Stk). auto with arith. rewrite H1. sep matchH Hmem with 10. split; auto. unfold l_acquire7_Prd_aux in Hpre. induction S as (((Mx, Rx), flx), isrx). InvertAll; auto. Qed. split. unfold linkPG. unfold pimp. intros. InvertAll. unfold l_acquire7_Prd in H. InvertAll. unfold l_acquire8_Prd. mexists5 x0 x1 x2 x3 x4. apply l_acquire_step8_call3 with f pc' x; auto. intros. unfold gimp. unfold conjPG. unfold conjG. intros. destruct H as [S'' [[Hpre Hfun] Htrans5]]. unfold l_acquire7_grt. unfold leadstoPQ2. intros. unfold l_acquire8_grt in Htrans5. unfold leadstoPQ2 in Htrans5. apply Htrans5. apply l_acquire_step8_call3 with f pc' S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire7_Prd_IF_false. apply l_acquire7_Grt_Itr_Stk. Qed. (* _addw (Opr_imm 2) SP *) Definition l_acquire9_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ sp >= 2 /\ l_acquire8_Prd_aux (sp - 2) l pc bp mP (M, RF_update R SP (sp - 2), fl, isr) end. Definition l_acquire9_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire9_Prd_aux sp l pc bp mP S. Definition l_acquire9_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire9_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +2) l pc bp) S S'. Lemma l_acquire_step9: forall f sp l pc bp mP S S', l_acquire8_Prd_aux sp l pc bp mP S -> nextS f (comml (_addw (Opr_imm 2) SP)) S S' -> l_acquire9_Prd_aux (sp + 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [HR' [Hfl' Hisr']]. unfold opr_eval in HR'. subst R' isr'. clear Htrans. unfold l_acquire8_Prd_aux in H. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. unfold l_acquire9_Prd_aux. reg simpl. rewrite HRsp. split; auto with arith. split; auto with arith. assert (sp + 2 - 2 = sp). auto. rewrite H. rewrite <- HRsp. assert (RF_update R SP (R SP) = R). apply RF_update_prev. rewrite H0. unfold l_acquire8_Prd_aux. split_l. split; auto. split_l. split_r. unfold trash_fl in Hfl'. inversion Hfl'. subst fl'. unfold Set_Flag. simpl. auto. subst fl'. unfold Clear_Flag. simpl. auto. Qed. Lemma l_acquire8_Prd_IF_false: forall S : State, l_acquire8_Prd S -> S_Flag S _IF = false. Proof. unfold l_acquire8_Prd. unfold l_acquire8_Prd_aux. intros. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. auto. Qed. Lemma l_acquire8_Grt_Itr_Stk: Grt_Itr_Stk l_acquire8_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire8_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_acquire8_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H8 in H7. inversion H7. Qed. Lemma wff_cmd_l_acquire9: NH_WFcmd (SCAP_consCT (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_acquire9_Prd l_acquire9_grt 1) l_acquire_psi) (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_acquire8_Prd l_acquire8_grt 1) (comml (_addw (Opr_imm 2) SP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_acquire9_Prd. exists l_acquire9_grt. split. auto. generalize (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1). intro f. split. apply trivial_enable_addw. split. unfold pimp. unfold linkPG. intros. destruct H as [S0 [Hpre Htrans]]. unfold l_acquire8_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold l_acquire9_Prd. mexists5 (sp + 2) l pc bp mP. apply l_acquire_step9 with f S0; auto. unfold gimp. unfold conjG. unfold conjPG. intros. destruct H as [S'' [[Hpre Htrans] Hgrt7]]. unfold l_acquire8_grt. unfold l_acquire9_grt in Hgrt7. unfold leadstoPQ2 in *. intros. assert (sp + 2 + 2 = sp + 4). auto. rewrite <- H0. apply Hgrt7. apply l_acquire_step9 with f S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire8_Prd_IF_false. apply l_acquire8_Grt_Itr_Stk. Qed. Lemma l_acquire9_Prd_IF_false: forall S : State, l_acquire9_Prd S -> S_Flag S _IF = false. Proof. unfold l_acquire9_Prd. unfold l_acquire9_Prd_aux. unfold l_acquire8_Prd_aux. intros. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. auto. Qed. Lemma l_acquire9_Grt_Itr_Stk: Grt_Itr_Stk l_acquire9_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire9_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_acquire9_Prd_aux in H4. unfold l_acquire8_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H10 in H9. inversion H9. Qed. Definition l_acquire_Post (S : State) : Prop := exists sp, exists l, exists pc, exists bp, exists mP, l_acquire_Post_aux sp l pc bp mP S. Definition l_acquire_last_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_acquire_Post_aux sp l pc bp) (l_acquire_Post_aux sp l pc bp) S S'. Lemma wff_cmd_l_acquirea: NH_WFcmd (SCAP_consCT (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_acquire_Post l_acquire_last_grt 1) l_acquire_psi) (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_acquire9_Prd l_acquire9_grt 1) (comml (_popw BP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_acquire_Post. exists l_acquire_last_grt. split. auto. generalize (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1). intro f. assert (forall sp l pc bp mP, enable (l_acquire9_Prd_aux sp l pc bp mP) (nextS f (comml (_popw BP)))). intros. apply enable_popw. intros. assert ((S_RF S SP |~>w bp) (S_Mem S)). Lemma l_acquire9_Prd_1: forall sp l pc bp mP S, l_acquire9_Prd_aux sp l pc bp mP S -> (S_RF S SP |~>w bp) (S_Mem S). Proof. intros. unfold l_acquire9_Prd_aux in H. induction S as (((M, R), fl), isr). InvertAll. UnfoldStateAll. unfold l_acquire8_Prd_aux in H2. unfold l_acquire8_MPre in H2. reg simpl. InvertAll. sep on. assert (sp - 2 + 2 = sp). auto. rewrite H5 in H2. sep lift 0 in H2. rewrite H0. sep trivial. Qed. apply l_acquire9_Prd_1 with sp l pc mP. auto. apply leadsToW_leadsToxW with bp; auto. split. unfold enable in *. intros. unfold l_acquire9_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. Lemma l_acquire_stepa: forall f sp l pc bp mP S S', l_acquire9_Prd_aux sp l pc bp mP S -> nextS f (comml (_popw BP)) S S' -> l_acquire_Post_aux (sp + 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [[x [Hmemx HR']] [Hfl' Hisr']]. assert (x = bp). assert ((S_RF (M, R, fl, isr) SP |~>w bp) (S_Mem (M, R, fl, isr))). apply l_acquire9_Prd_1 with sp l pc mP; auto. UnfoldStateAll. apply leadsToW_unique with (R SP) M; auto. subst x. subst R' fl' isr'. unfold l_acquire_Post_aux. reg simpl. clear Htrans. unfold l_acquire9_Prd_aux in H. InvertAll. split. rewrite H0. auto. split_l. unfold l_acquire8_Prd_aux in H2. reg simpl. InvertAll. split; auto. unfold l_acquire8_MPre in H2. unfold l_acquire_MPost. unfold l_acquire_MPre. sep on. sep lift 2. sep stksplit. assert (sp + 2 - 2 = sp). auto. rewrite H5. assert (sp + 2 + 2 = sp + 4). auto. rewrite H7. assert (sp - 2 + 2 = sp); auto. rewrite H8 in H2. assert (sp - 2 + 4 = sp + 2). auto. rewrite H9 in H2. assert (sp - 2 + 6 = sp + 4). auto. rewrite H10 in H2. sep matchH H2 with 8. Qed. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_acquire9_Prd in H0. InvertAll. unfold l_acquire_Post. exists (x0 + 2). exists x1. exists x2. exists x3. exists x4. apply l_acquire_stepa with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_acquire9_grt. unfold leadstoPQ2. intros. unfold l_acquire_last_grt in H2. unfold leadstoPQ2 in H2. apply H2. apply l_acquire_stepa with f S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire9_Prd_IF_false. apply l_acquire9_Grt_Itr_Stk. Qed. Lemma wff_cmd_l_acquireb: NH_WFiseq l_acquire_psi (l_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast l_acquire_Post l_acquire_last_grt 1) (sseq _retw). Proof. apply nh_isq_end. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. split; auto. intros. unfold l_acquire_last_grt. intros. unfold leadstoPQ2. auto. split. apply IF_false_Prd_Itr_Stk. Lemma l_acquire_Post_IF_false: forall S : State, l_acquire_Post S -> S_Flag S _IF = false. Proof. unfold l_acquire_Post. unfold l_acquire_Post_aux. intros. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. auto. Qed. Lemma l_acquire_last_Grt_Itr_Stk : Grt_Itr_Stk l_acquire_last_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_acquire_last_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_acquire_Post_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H9 in H8. inversion H8. Qed. apply l_acquire_Post_IF_false. apply l_acquire_last_Grt_Itr_Stk. Qed. Lemma wff_l_acquire: NH_WFiseq l_acquire_psi l_acquire (Ast l_acquire_Prd l_acquire_grt 1) I_l_acquire. Proof. unfold I_l_acquire. apply nh_isq_seq with l_acquire1_Prd l_acquire1_grt. apply wff_cmd_l_acquire1. apply nh_isq_seq with l_acquire2_Prd l_acquire2_grt. apply wff_cmd_l_acquire2. apply nh_isq_seq with l_acquire3_Prd l_acquire3_grt. apply wff_cmd_l_acquire3. apply nh_isq_seq with l_acquire4_Prd l_acquire4_grt. apply wff_cmd_l_acquire4. apply nh_isq_seq with l_acquire5_Prd l_acquire5_grt. apply wff_cmd_l_acquire5. apply nh_isq_seq with l_acquire6_Prd l_acquire6_grt. apply wff_cmd_l_acquire6. apply nh_isq_seq with l_acquire7_Prd l_acquire7_grt. apply wff_cmd_l_acquire7. apply nh_isq_seq with l_acquire8_Prd l_acquire8_grt. apply wff_cmd_l_acquire8. apply nh_isq_seq with l_acquire9_Prd l_acquire9_grt. apply wff_cmd_l_acquire9. apply nh_isq_seq with l_acquire_Post l_acquire_last_grt. apply wff_cmd_l_acquirea. apply wff_cmd_l_acquireb. Qed. Definition l_setacq1_MPre (sp l pc bp : Label) := (sp |->w bp) *^* (sp + 2 |->w pc) *^* (sp + 4 |->w l) *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 2) *^* INV1 *^* INV0 *^* Gamma l. Definition l_setacq1_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (l_setacq1_MPre sp l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition l_setacq1_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, l_setacq1_Prd_aux sp l pc bp mP S. Definition l_setacq1_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (l_setacq1_Prd_aux sp l pc bp) (l_acquire_Post_aux (sp +2) l pc bp) S S'. Definition l_setacq_psi := SCAP_emptCT. Lemma wff_cmd_l_setacq1: NH_WFcmd (SCAP_consCT (l_setacq + 1) (Ast l_setacq1_Prd l_setacq1_grt 1) l_setacq_psi) l_setacq (Ast l_setacq_Prd l_setacq_grt 1) (comml (_movwst (Opr_imm 0) (A_reg L_AVAIL BX))). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_setacq1_Prd. exists l_setacq1_grt. split. auto. generalize l_setacq. intro f. assert (forall sp l pc bp mP, enable (l_setacq_Prd_aux sp l pc bp mP) (nextS f (comml (_movwst (Opr_imm 0) (A_reg L_AVAIL BX))))). intros. apply enable_movwst. intros. Lemma l_setacq_Prd_1: forall sp l pc bp mP S, l_setacq_Prd_aux sp l pc bp mP S -> (addr_eval (S_RF S) (A_reg L_AVAIL BX) |~>w_) (S_Mem S). Proof. intros. unfold addr_eval. unfold l_setacq_Prd_aux in H. induction S as (((M, R), fl), isr). InvertAll. UnfoldStateAll. rewrite H. reg simpl. sep on. sep lift 4 in H1. assert (forall M, INV1 M -> (Lock_INV_H l *^* mTrue) M). intros. apply INV1_lockInv1; auto. sep weaker_subst in H1 with (Lock_INV_H l *^* mTrue). sep on. sep lift 0 in H1. assert (exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* (mTrue *^* (INV0 *^* mP *^* (sp |->w bp *^* sp + 2 |->w pc *^* sp + 4 |->w l *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 2)))) ) /\ Delta w = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H; auto. clear H1. InvertAll. sep lift 0 in H1. sep trivial. Qed. apply l_setacq_Prd_1 with sp l pc bp mP. auto. split. unfold enable in *. intros. unfold l_setacq_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_setacq1_Prd. unfold l_setacq_Prd in H0. InvertAll. exists x0. exists x1. exists x2. exists x3. exists x4. Lemma l_setacq_step1: forall f sp l pc bp mP S S', l_setacq_Prd_aux sp l pc bp mP S -> nextS f (comml (_movwst (Opr_imm 0) (A_reg L_AVAIL BX))) S S' -> l_setacq1_Prd_aux sp l pc bp mP S'. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion H0). clear H0. InvertAll. subst R' fl' isr'. rename H3 into Htargetx. rename H5 into Hnewmem. unfold addr_eval in *. unfold opr_eval in *. substH Hnewmem with (MemUpd16_MemUpdW Hnewmem). destruct Hnewmem as [junk HM']. unfold l_setacq1_Prd_aux. unfold l_setacq_Prd_aux in H. destruct H as [HRsp [HRbx [Hmem1 [Hmem2 [Hlock [Hfl Hisr]]]]]]. split_l. split; auto. unfold l_setacq1_MPre. sep on. assert (exists m, leqvM INV1 (Lock_INV_H l *^* m)). apply INV1_decom_l; auto. destruct H as [mP' Hleqv]. sep lift 4. sep leqv_subst with (Lock_INV_H l *^* mP'). sep lift 4 in Hmem1. sep leqv_subst in Hmem1 with (Lock_INV_H l *^* mP'). sep on. sep lift 0. apply decomp_ex_Lock_INV_H1. exists 0. sep lift 0 in Hmem1. assert (exists b, exists w, (M ||- (l + L_AVAIL |->w b) *^* (l + L_WAITING |->w w) *^* (choice (b=0) Aemp (Gamma l)) *^* (mP' *^* (INV0 *^* mP *^* (sp |->w bp *^* sp + 2 |->w pc *^* sp + 4 |->w l *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 2)))) ) /\ Delta w = SomeT (Gamma l)). apply decomp_ex_Lock_INV_H. auto. clear Hmem1. destruct H0 as [b0 [w0 [Hmem1 Hdelta]]]. exists w0. split; auto. subst M'. rewrite HRbx. sep lift 0. sep upd. destruct Hmem2 as [avail [HMavail [HRdx Havailne0]]]. assert (b0 = avail). sep lift 0 in Hmem1. apply ptoW_leadsToW_eq1 with M (l + L_AVAIL) (l + L_WAITING |->w w0 *^* (choice (b0 = 0) Aemp (Gamma l) *^* (mP' *^* (INV0 *^* mP *^* (sp |->w bp *^* sp + 2 |->w pc *^* sp + 4 |->w l *^* stkSpacePrec sp (_STK_SIZE_l_acquire - 2)))))); auto. rewrite H0 in Hmem1. clear H0. sep matchH Hmem1 with 11. unfold choice in *. inversion_clear Hmem1. inversion_clear H0. contradiction. inversion_clear H0. exists MemMod.emp. exists h. split; auto with PMap. split; auto. left. unfold Aemp. auto. Qed. apply l_setacq_step1 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_setacq_grt. unfold leadstoPQ2. intros. unfold l_setacq1_grt in H2. unfold leadstoPQ2 in H2. apply H2. apply l_setacq_step1 with f S; auto. split. apply IF_false_Prd_Itr_Stk. Lemma l_setacq_Prd_IF_false: forall S : State, l_setacq_Prd S -> S_Flag S _IF = false. Proof. unfold l_setacq_Prd. unfold l_setacq_Prd_aux. intros. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. auto. Qed. Lemma l_setacq_Grt_Itr_Stk : Grt_Itr_Stk l_setacq_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_setacq_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_setacq_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H12 in H9. inversion H9. Qed. apply l_setacq_Prd_IF_false. apply l_setacq_Grt_Itr_Stk. Qed. Lemma l_setacq1_Prd_IF_false: forall S : State, l_setacq1_Prd S -> S_Flag S _IF = false. Proof. unfold l_setacq1_Prd. unfold l_setacq1_Prd_aux. intros. induction S as (((M, R), fl), isr). UnfoldStateAll. InvertAll. auto. Qed. Lemma l_setacq1_Grt_Itr_Stk : Grt_Itr_Stk l_setacq1_grt. Proof. unfold Grt_Itr_Stk. intros. unfold l_setacq1_grt. unfold leadstoPQ2. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). UnfoldStateAll. intros. unfold l_setacq1_Prd_aux in H4. InvertAll. unfold itr_enabled in H0. UnfoldStateAll. inversion_clear H0. rewrite H8 in H7. inversion H7. Qed. Lemma wff_cmd_l_setacq2: NH_WFcmd (SCAP_consCT (l_setacq + 1 + 1) (Ast l_acquire_Post l_acquire_last_grt 1) l_setacq_psi) (l_setacq + 1) (Ast l_setacq1_Prd l_setacq1_grt 1) (comml (_popw BP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists l_acquire_Post. exists l_acquire_last_grt. split. auto. generalize (l_setacq + 1). intro f. assert (forall sp l pc bp mP, enable (l_setacq1_Prd_aux sp l pc bp mP) (nextS f (comml (_popw BP)))). intros. apply enable_popw. intros. assert ((S_RF S SP |~>w bp) (S_Mem S)). Lemma l_setacq1_Prd_1: forall sp l pc bp mP S, l_setacq1_Prd_aux sp l pc bp mP S -> (S_RF S SP |~>w bp) (S_Mem S). Proof. intros. unfold l_setacq1_Prd_aux in H. induction S as (((M, R), fl), isr). InvertAll. UnfoldStateAll. unfold l_setacq1_MPre in H. sep on. rewrite H0. sep lift 0 in H. sep trivial. Qed. apply l_setacq1_Prd_1 with sp l pc mP. auto. apply leadsToW_leadsToxW with bp; auto. split. unfold enable in *. intros. unfold l_setacq1_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. Lemma l_setacq_step2: forall f sp l pc bp mP S S', l_setacq1_Prd_aux sp l pc bp mP S -> nextS f (comml (_popw BP)) S S' -> l_acquire_Post_aux (sp + 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [[x [Hmemx HR']] [Hfl' Hisr']]. assert (x = bp). assert ((S_RF (M, R, fl, isr) SP |~>w bp) (S_Mem (M, R, fl, isr))). apply l_setacq1_Prd_1 with sp l pc mP; auto. UnfoldStateAll. apply leadsToW_unique with (R SP) M; auto. subst x. subst R' fl' isr'. unfold l_acquire_Post_aux. reg simpl. clear Htrans. unfold l_setacq1_Prd_aux in H. InvertAll. split. rewrite H0. auto. split_l. split; auto. unfold l_setacq1_MPre in H. unfold l_acquire_MPost. unfold l_acquire_MPre. sep on. sep lift 2. sep stksplit. assert (sp + 2 - 2 = sp). auto. rewrite H3. assert (sp + 2 + 2 = sp + 4). auto. rewrite H5. sep matchH H with 8. Qed. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold l_setacq1_Prd in H0. InvertAll. unfold l_acquire_Post. exists (x0 + 2). exists x1. exists x2. exists x3. exists x4. apply l_setacq_step2 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold l_setacq1_grt. unfold leadstoPQ2. intros. unfold l_acquire_last_grt in H2. unfold leadstoPQ2 in H2. apply H2. apply l_setacq_step2 with f S; auto. split. apply IF_false_Prd_Itr_Stk. apply l_setacq1_Prd_IF_false. apply l_setacq1_Grt_Itr_Stk. Qed. Lemma wff_cmd_l_setacq3: NH_WFiseq l_setacq_psi (l_setacq + 1 + 1) (Ast l_acquire_Post l_acquire_last_grt 1) (sseq _retw). Proof. apply nh_isq_end. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. split; auto. intros. unfold l_acquire_last_grt. intros. unfold leadstoPQ2. auto. split. apply IF_false_Prd_Itr_Stk. apply l_acquire_Post_IF_false. apply l_acquire_last_Grt_Itr_Stk. Qed. Lemma wff_l_block: NH_WFiseq l_setacq_psi l_setacq (Ast l_setacq_Prd l_setacq_grt 1) I_l_setacq. Proof. unfold I_l_setacq. apply nh_isq_seq with l_setacq1_Prd l_setacq1_grt. apply wff_cmd_l_setacq1. apply nh_isq_seq with l_acquire_Post l_acquire_last_grt. apply wff_cmd_l_setacq2. apply wff_cmd_l_setacq3. Qed. (* the stack space required by l_release *) Definition _STK_SIZE_lock_acquire := 6 + IH_Stk + _STK_SIZE_l_acquire. Definition lock_acquire_psi := SCAP_consCT l_acquire (Ast l_acquire_Prd l_acquire_grt 1) SCAP_emptCT. Definition lock_acquire_MPre (sp l pc: Label) : MPred := (sp |->w pc) *^* (sp + 2 |->w l) *^* stkSpacePrec sp _STK_SIZE_lock_acquire. Definition lock_acquire_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (lock_acquire_MPre sp l pc *^* mP) M /\ In l lockSet_H /\ fl _IF = true /\ isr = false end. Definition lock_acquire_Prd (S : State) : Prop := exists sp, exists l, exists pc, exists bp, exists mP, lock_acquire_Prd_aux sp l pc bp mP S. Definition lock_acquire_MPost (sp l pc : Label) : MPred := (lock_acquire_MPre sp l pc) *^* (Gamma l). Definition lock_acquire_Post_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (lock_acquire_MPost sp l pc *^* mP) M /\ In l lockSet_H /\ fl _IF = true /\ isr = false end. Definition lock_acquire_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_acquire_Prd_aux sp l pc bp) (lock_acquire_Post_aux sp l pc bp) S S'. Definition lock_acquire1_MPre (sp l pc bp : Label) := (sp |->w bp) *^* (sp + 2 |->w pc) *^* (sp + 4 |->w l) *^* stkSpacePrec sp (_STK_SIZE_lock_acquire - 2). Definition lock_acquire1_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (lock_acquire1_MPre sp l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = true /\ isr = false end. Definition lock_acquire1_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_acquire1_Prd_aux sp l pc bp mP S. Definition lock_acquire1_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_acquire1_Prd_aux sp l pc bp) (lock_acquire_Post_aux (sp +2) l pc bp) S S'. Definition lock_acquire2_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R BP = sp /\ lock_acquire1_Prd_aux sp l pc bp mP (M, RF_update R BP bp, fl, isr) end. Definition lock_acquire2_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_acquire2_Prd_aux sp l pc bp mP S. Definition lock_acquire2_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_acquire2_Prd_aux sp l pc bp) (lock_acquire_Post_aux (sp +2) l pc bp) S S'. Definition lock_acquire3_MPre (sp l pc bp : Label) := (sp |->w l) *^* (sp + 2 |->w bp) *^* (sp + 4 |->w pc) *^* (sp + 6 |->w l) *^* stkSpacePrec sp (_STK_SIZE_lock_acquire - 4). Definition lock_acquire3_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (lock_acquire3_MPre sp l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = true /\ isr = false end. Definition lock_acquire3_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_acquire3_Prd_aux sp l pc bp mP S. Definition lock_acquire3_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_acquire3_Prd_aux sp l pc bp) (lock_acquire_Post_aux (sp + 4) l pc bp) S S'. Definition lock_acquire4_MPre (sp l pc bp : Label) := ((lock_acquire3_MPre sp l pc bp) *^* (INV1 *^* INV0)). Definition lock_acquire4_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (lock_acquire4_MPre (R SP) l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition lock_acquire4_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_acquire4_Prd_aux sp l pc bp mP S. Definition lock_acquire4_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_acquire4_Prd_aux sp l pc bp) (lock_acquire_Post_aux (sp + 4) l pc bp) S S'. Definition lock_acquire6_MPre (sp l pc bp : Label) := (sp |->w_) *^* (sp + 2 |->w bp) *^* (sp + 4 |->w pc) *^* (sp + 6 |->w l) *^* stkSpacePrec sp (_STK_SIZE_lock_acquire - 4) *^* Gamma l. Definition lock_acquire5_MPre (sp l pc bp : Label) := (lock_acquire6_MPre sp l pc bp) *^* (INV1 *^* INV0). Definition lock_acquire5_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (lock_acquire5_MPre sp l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = false /\ isr = false end. Definition lock_acquire5_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_acquire5_Prd_aux sp l pc bp mP S. Definition lock_acquire5_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_acquire5_Prd_aux sp l pc bp) (lock_acquire_Post_aux (sp + 4) l pc bp) S S'. Definition lock_acquire6_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ (lock_acquire6_MPre sp l pc bp *^* mP) M /\ In l lockSet_H /\ fl _IF = true /\ isr = false end. Definition lock_acquire6_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_acquire6_Prd_aux sp l pc bp mP S. Definition lock_acquire6_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_acquire6_Prd_aux sp l pc bp) (lock_acquire_Post_aux (sp + 4) l pc bp) S S'. (* _addw (Opr_imm 2) SP *) Definition lock_acquire7_Prd_aux (sp l pc bp : Label) (mP : MPred) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ sp >= 2 /\ lock_acquire6_Prd_aux (sp - 2) l pc bp mP (M, RF_update R SP (sp - 2), fl, isr) end. Definition lock_acquire7_Prd (S : State) := exists sp, exists l, exists pc, exists bp, exists mP, lock_acquire7_Prd_aux sp l pc bp mP S. Definition lock_acquire7_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_acquire7_Prd_aux sp l pc bp) (lock_acquire_Post_aux (sp +2) l pc bp) S S'. Definition lock_acquire_Post (S : State) : Prop := exists sp, exists l, exists pc, exists bp, exists mP, lock_acquire_Post_aux sp l pc bp mP S. Definition lock_acquire_last_grt (S S' : State) : Prop := forall sp l pc bp, leadstoPQ2 (lock_acquire_Post_aux sp l pc bp) (lock_acquire_Post_aux sp l pc bp) S S'. Lemma wff_cmd_lock_acquire1: NH_WFcmd (SCAP_consCT (lock_acquire + 1) (Ast lock_acquire1_Prd lock_acquire1_grt 1) lock_acquire_psi) lock_acquire (Ast lock_acquire_Prd lock_acquire_grt 1) (comml (_pushwp (Opr_reg BP))). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists lock_acquire1_Prd. exists lock_acquire1_grt. split. auto. assert (forall sp l pc bp mP, enable (lock_acquire_Prd_aux sp l pc bp mP) (nextS lock_acquire (comml (_pushwp (Opr_reg BP))))). intros. apply enable_pushwp with _STK_SIZE_lock_acquire; auto. Lemma lock_acquire_Prd_aux_stkSpace: forall sp l pc bp mP S, lock_acquire_Prd_aux sp l pc bp mP S -> stkSpace (S_RF S SP) _STK_SIZE_lock_acquire (S_Mem S). Proof. intros. unfold lock_acquire_Prd_aux in H. induction S as (((M, R), fl), isr). unfold lock_acquire_MPre in H. InvertAll. sep on. sep lift 2 in H1. UnfoldStateAll. rewrite H0. sep trivial. Qed. apply lock_acquire_Prd_aux_stkSpace. Lemma STK_SZ_acquire: _STK_SIZE_lock_acquire >= 2. Proof. unfold _STK_SIZE_lock_acquire. auto with arith. Qed. Hint Resolve STK_SZ_acquire. auto. split. unfold enable in *. intros. unfold lock_acquire_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_acquire_Prd in H0. InvertAll. unfold lock_acquire1_Prd. mexists5 (x0 - 2) x1 x2 x3 x4. Lemma lock_acquire_step1: forall f sp l pc bp mP S S', lock_acquire_Prd_aux sp l pc bp mP S -> nextS f (comml (_pushwp (Opr_reg BP))) S S' -> lock_acquire1_Prd_aux (sp - 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). destruct H0 as [Hspgt2 [Hmemblk HM']]. destruct H1 as [HR' [Hfl' Hisr']]. subst R' fl' isr'. clear Htrans. unfold opr_eval in HM'. unfold lock_acquire_Prd_aux in H. destruct H as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_acquire_MPre in Hmem. unfold lock_acquire1_Prd_aux. reg simpl. rewrite HRsp. split_l; split_l. split; auto. unfold lock_acquire1_MPre. rewrite HRsp in Hspgt2. assert (sp - 2 + 2 = sp). auto. rewrite H. clear H. assert (sp - 2 + 4 = sp + 2). auto. rewrite H. clear H. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M'. sep on. rewrite HRsp. rewrite HRbp. sep lift 0. sep upd2. sep lift 2 in Hmem. sep stksplit in Hmem. sep matchH Hmem with 4. Qed. apply lock_acquire_step1 with lock_acquire x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold lock_acquire_grt. unfold leadstoPQ2. intros. unfold lock_acquire1_grt in H2. unfold leadstoPQ2 in H2. assert (lock_acquire_Post_aux (sp - 2 + 2) l pc bp mP S'). apply H2. apply lock_acquire_step1 with lock_acquire S; auto. induction S as (((M, R), fl), isr). induction x as (((M', R'), fl'), isr'). destruct (nextS_inversion H3). InvertAll. unfold lock_acquire_Prd_aux in H0. InvertAll. rewrite H10 in H8. assert (sp - 2 + 2 = sp). auto. rewrite H15 in H4. auto. Lemma lock_acquire_stk_geIH: _STK_SIZE_lock_acquire >= IH_Stk + 6. Proof. unfold _STK_SIZE_lock_acquire. omega. Qed. Hint Resolve lock_acquire_stk_geIH. Lemma lock_acquire_Prd_Itr_Stk: Prd_Itr_Stk lock_acquire_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_acquire_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_acquire_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. rewrite HRsp. unfold lock_acquire_MPre in Hmem. sep on. sep lift 2 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' Hmem1'. unfold lock_acquire_Prd. mexists5 sp l pc bp mP. unfold lock_acquire_Prd_aux. unfold lock_acquire_MPre. split_l. split_l. split; auto. sep on. sep lift 2. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 4. Qed. Lemma lock_acquire_Grt_Itr_Stk: Grt_Itr_Stk lock_acquire_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_acquire_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_acquire_Prd_aux in * . simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. split_l. split_l. split; auto. unfold lock_acquire_MPre in *. sep on. sep lift 2 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 2. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HRsp in HM2'. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HRsp in HM2. split_l. sep on. sep matchH HM1x with 4. Qed. split. apply lock_acquire_Prd_Itr_Stk. apply lock_acquire_Grt_Itr_Stk. Qed. Lemma wff_cmd_lock_acquire2: NH_WFcmd (SCAP_consCT (lock_acquire + 1 + 1) (Ast lock_acquire2_Prd lock_acquire2_grt 1) lock_acquire_psi) (lock_acquire + 1) (Ast lock_acquire1_Prd lock_acquire1_grt 1) (comml (_movwp (Opr_reg SP) BP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists lock_acquire2_Prd. exists lock_acquire2_grt. split. auto. split; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_acquire1_Prd in H. InvertAll. unfold lock_acquire2_Prd. mexists5 x0 x1 x2 x3 x4. Lemma lock_acquire_step2: forall f sp l pc bp mP S S', lock_acquire1_Prd_aux sp l pc bp mP S -> nextS f (comml (_movwp (Opr_reg SP) BP)) S S' -> lock_acquire2_Prd_aux sp l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [HR' [Hfl' Hisr']]. unfold opr_eval in HR'. subst R' fl' isr'. clear Htrans. unfold lock_acquire1_Prd_aux in H. destruct H as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_acquire2_Prd_aux. reg simpl. rewrite HRsp. split_l. rewrite <- HRbp. assert (RF_update R BP (R BP) = R). apply RF_update_prev. rewrite H. clear H. rewrite HRbp. unfold lock_acquire1_Prd_aux. split_l; split_l. split; auto. Qed. apply lock_acquire_step2 with (lock_acquire + 1) x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold lock_acquire1_grt. unfold leadstoPQ2. intros. unfold lock_acquire2_grt in H1. unfold leadstoPQ2 in H1. apply H1. apply lock_acquire_step2 with (lock_acquire + 1) S; auto. Lemma stk_lock_acquire_N2_geIH: _STK_SIZE_lock_acquire - 2 >= IH_Stk + 6. Proof. unfold _STK_SIZE_lock_acquire. unfold _STK_SIZE_l_acquire. omega. Qed. Hint Resolve stk_lock_acquire_N2_geIH. Lemma lock_acquire1_Prd_Itr_Stk: Prd_Itr_Stk lock_acquire1_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_acquire1_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_acquire1_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. rewrite HRsp. unfold lock_acquire1_MPre in Hmem. sep on. sep lift 3 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' Hmem1'. unfold lock_acquire1_Prd. mexists5 sp l pc bp mP. unfold lock_acquire1_Prd_aux. unfold lock_acquire1_MPre. split_l. split_l. split; auto. sep on. sep lift 3. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 5. Qed. Lemma lock_acquire1_Grt_Itr_Stk: Grt_Itr_Stk lock_acquire1_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_acquire1_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_acquire1_Prd_aux in * . simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. split_l. split_l. split; auto. unfold lock_acquire1_MPre in *. sep on. sep lift 3 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 3. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with (R SP) (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HRsp in HM2'. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HRsp in HM2. split_l. sep on. sep matchH HM1x with 5. Qed. split. apply lock_acquire1_Prd_Itr_Stk. apply lock_acquire1_Grt_Itr_Stk. Qed. Lemma wff_cmd_lock_acquire3: NH_WFcmd (SCAP_consCT (lock_acquire + 1 + 1 + 1) (Ast lock_acquire3_Prd lock_acquire3_grt 1) lock_acquire_psi) (lock_acquire + 1 + 1) (Ast lock_acquire2_Prd lock_acquire2_grt 1) (comml (_pushwm (A_reg 4 BP))). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists lock_acquire3_Prd. exists lock_acquire3_grt. split. auto. generalize (lock_acquire + 1 + 1). intro f. split. assert (forall f sp l pc bp mP, enable (lock_acquire2_Prd_aux sp l pc bp mP) (nextS f (comml (_pushwm (A_reg 4 BP))))). Lemma lock_acquire2_Prd_enable: forall f sp l pc bp mP, enable (lock_acquire2_Prd_aux sp l pc bp mP) (nextS f (comml (_pushwm (A_reg 4 BP)))). Proof. unfold enable. intros. assert (((addr_eval (S_RF S) (A_reg 4 BP)) |~>w l) (S_Mem S)). Lemma lock_acquire2_Prd_1: forall sp l pc bp mP S, lock_acquire2_Prd_aux sp l pc bp mP S -> ((addr_eval (S_RF S) (A_reg 4 BP)) |~>w l) (S_Mem S). Proof. intros. induction S as (((M, R), fl), isr). unfold lock_acquire2_Prd_aux in H. unfold S_RF. unfold S_Mem. unfold addr_eval. inversion_clear H. rewrite H0. inversion_clear H1. unfold lock_acquire1_MPre in H2. reg simpl. InvertAll. sep on. sep lift 2 in H2. sep trivial. Qed. apply lock_acquire2_Prd_1 with sp pc bp mP; auto. induction S as (((M, R), fl), isr). exists (MemUpdW M (R SP - 2) l 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_pushwm with (addr_eval R (A_reg 4 BP)) l. auto. auto. unfold pushW. unfold lock_acquire2_Prd_aux in H. destruct H as [HRbp Hpre]. unfold lock_acquire1_Prd_aux in Hpre. unfold lock_acquire1_MPre in Hpre. reg simpl. destruct Hpre as [HRsp [Hjunk [Hmem [Hlock [Hfl Hisr]]]]]. split. sep on. sep lift 3 in Hmem. sep stksplit 2 in Hmem. sep lift 0 in Hmem. rewrite HRsp. sep trivial. split; auto. apply MemUpdW_MemUpd16 with 0; auto. Qed. apply lock_acquire2_Prd_enable. unfold enable in *. intros. unfold lock_acquire2_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_acquire2_Prd in H. InvertAll. unfold lock_acquire3_Prd. mexists5 (x0 - 2) x1 x2 x3 x4. Lemma lock_acquire_step3: forall f sp l pc bp mP S S', lock_acquire2_Prd_aux sp l pc bp mP S -> nextS f (comml (_pushwm (A_reg 4 BP))) S S' -> lock_acquire3_Prd_aux (sp - 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). destruct H0 as [w [Hsrc [Hspgt2 [Hmemblk HM']]]]. destruct H1 as [HR' [Hfl' Hisr']]. subst R' fl' isr'. clear Htrans. assert ((addr_eval (S_RF (M, R, fl, isr)) (A_reg 4 BP) |~>w l) (S_Mem (M, R, fl, isr))). apply lock_acquire2_Prd_1 with sp pc bp mP; auto. UnfoldStateAll. assert (w = l). apply leadsToW_leadsToW_eq with M (addr_eval R (A_reg 4 BP)); auto. subst w. clear H0. unfold addr_eval in Hsrc. unfold lock_acquire2_Prd_aux in H. destruct H as [HRbp Hpre]. unfold lock_acquire1_Prd_aux in Hpre. unfold lock_acquire1_MPre in Hpre. reg simpl. destruct Hpre as [HRsp [Htmp [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_acquire3_Prd_aux. reg simpl. split. rewrite HRsp. auto. split; auto. unfold lock_acquire3_MPre. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M'. sep on. sep lift 0. rewrite HRsp. sep upd2. sep lift 3 in Hmem. sep stksplit in Hmem. sep lift 1 in Hmem. rewrite HRsp in Hspgt2. assert (sp - 2 + 2 = sp). auto. rewrite H. clear H. assert (sp - 2 + 4 = sp + 2). auto. rewrite H. clear H. assert (sp - 2 + 6 = sp + 4). auto. rewrite H. clear H. assert (_STK_SIZE_lock_acquire - 2 - 2 = _STK_SIZE_lock_acquire - 4). auto with arith. rewrite H in Hmem. sep matchH Hmem with 6. Qed. apply lock_acquire_step3 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold lock_acquire2_grt. unfold leadstoPQ2. intros. unfold lock_acquire3_grt in H1. unfold leadstoPQ2 in H1. assert (lock_acquire_Post_aux (sp - 2 + 4) l pc bp mP S'). apply H1. apply lock_acquire_step3 with f S; auto. induction S as (((M, R), fl), isr). induction x as (((M', R'), fl'), isr'). destruct (nextS_inversion H2). InvertAll. unfold lock_acquire2_Prd_aux in H. unfold lock_acquire1_Prd_aux in H. InvertAll. reg simpl. rewrite H in H7. assert (sp - 2 + 4 = sp + 2); auto. rewrite H16 in H3. auto. Lemma lock_acquire2_Prd_Itr_Stk: Prd_Itr_Stk lock_acquire2_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_acquire2_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_acquire2_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRbp Hpre]. unfold lock_acquire1_Prd_aux in Hpre. reg simpl. destruct Hpre as [HRsp [Hbp0 [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_acquire1_MPre in Hmem. sep on. sep lift 3 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. rewrite HRsp. split_l. intros M1' Hmem1'. unfold lock_acquire2_Prd. mexists5 sp l pc bp mP. unfold lock_acquire2_Prd_aux. split_l. unfold lock_acquire1_Prd_aux. unfold lock_acquire1_MPre. reg simpl. split_l. split_l. split; auto. sep on. sep lift 3. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 5. Qed. Lemma lock_acquire2_Grt_Itr_Stk: Grt_Itr_Stk lock_acquire2_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_acquire2_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_acquire2_Prd_aux in * . simplS in * . destruct Hpre as [HRbp Hpre]. unfold lock_acquire1_Prd_aux in *. reg simpl. destruct Hpre as [HRsp [HRbp0 [Hmem [Hlock [Hfl Hisr]]]]]. split_l. split_l. split_l. split; auto. unfold lock_acquire1_MPre in *. sep on. sep lift 3 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 3. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. rewrite HRsp in HM2. rewrite HRsp in HM2'. assert (M2x = M2' /\ M1x = M1). assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. split_l. sep on. sep matchH HM1x with 5. Qed. split. apply lock_acquire2_Prd_Itr_Stk. apply lock_acquire2_Grt_Itr_Stk. Qed. Lemma wff_cmd_lock_acquire4: NH_WFcmd (SCAP_consCT (lock_acquire + 1 + 1 + 1 + 1) (Ast lock_acquire4_Prd lock_acquire4_grt 1) lock_acquire_psi) (lock_acquire + 1 + 1 + 1) (Ast lock_acquire3_Prd lock_acquire3_grt 1) (comml _cli). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. exists lock_acquire4_Prd. exists lock_acquire4_grt. split. auto. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_acquire3_Prd in H. InvertAll. unfold lock_acquire4_Prd. mexists5 x0 x1 x2 x3 x4. Lemma lock_acquire_step4: forall sp l pc bp mP S S', lock_acquire3_Prd_aux sp l pc bp mP S -> gcli S S' -> lock_acquire4_Prd_aux sp l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). unfold gcli in Htrans. UnfoldStateAll. destruct Htrans as [Hpp [Hfl' [Hisr' HR']]]. subst R' isr'. unfold prepost in Hpp. destruct Hpp as [M1 [M2 [M1' [HM1 [HM1' [HsplitM HsplitM']]]]]]. UnfoldStateAll. unfold lock_acquire4_Prd_aux. unfold lock_acquire3_Prd_aux in H. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. split_l. split; auto. unfold lock_acquire4_MPre. assert ((INV1 *^* INV0 *^* (lock_acquire3_MPre (R SP) l pc bp *^* mP)) M'). exists M1'. exists M2. split_l. unfold Aemp in HM1. rewrite HM1 in HsplitM. assert (M2 = M); auto with PMap. subst M2. split; auto. unfold choice in HM1'. inversion_clear HM1'. inversion H; auto. inversion H. assert (itr_enabled (M, R, fl, isr)). unfold itr_enabled. UnfoldStateAll. auto. contradiction. sep on. rewrite HRsp. auto. sep on. sep matchH H with 4. Qed. apply lock_acquire_step4 with x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold lock_acquire3_grt. unfold leadstoPQ2. intros. unfold lock_acquire4_grt in H1. unfold leadstoPQ2 in H1. apply H1. apply lock_acquire_step4 with S; auto. Lemma lock_acquire3_Prd_Itr_Stk: Prd_Itr_Stk lock_acquire3_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_acquire3_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_acquire3_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. unfold lock_acquire3_MPre in Hmem. sep on. sep lift 4 in Hmem. Lemma stk_lock_acquire_N4_geIH: _STK_SIZE_lock_acquire - 4 >= IH_Stk + 6. Proof. unfold _STK_SIZE_lock_acquire. unfold _STK_SIZE_l_acquire. omega. Qed. Hint Resolve stk_lock_acquire_N4_geIH. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. rewrite HRsp. split_l. intros M1' Hmem1'. unfold lock_acquire3_Prd. mexists5 sp l pc bp mP. unfold lock_acquire3_Prd_aux. split_l. split; auto. unfold lock_acquire3_MPre. sep on. sep lift 4. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 6. Qed. Lemma lock_acquire3_Grt_Itr_Stk : Grt_Itr_Stk lock_acquire3_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_acquire3_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_acquire3_Prd_aux in * . simplS in * . destruct Hpre as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. split_l. unfold lock_acquire3_MPre in *. split; auto. sep on. sep lift 4 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 4. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. rewrite HRsp in HM2, HM2'. assert (M2x = M2' /\ M1x = M1). assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. split_l. sep on. sep matchH HM1x with 6. Qed. split. apply lock_acquire3_Prd_Itr_Stk. apply lock_acquire3_Grt_Itr_Stk. Qed. Parameter l_acquire_not_primentry: ~ prim_entry l_acquire. Lemma lock_acquire4_enable: forall f sp l pc bp mP, enable (lock_acquire4_Prd_aux sp l pc bp mP) (nextS f (comml (_call l_acquire))). Proof. intros. unfold enable. intros. unfold lock_acquire4_Prd_aux in H. induction S as (((M, R), fl), isr). exists (MemUpdW M (R SP - 2) (f+1) 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_call. unfold pushW. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. split. unfold lock_acquire4_MPre in Hmem. unfold lock_acquire3_MPre in Hmem. sep on. sep lift 4 in Hmem. sep stksplit 2 in Hmem. sep lift 0 in Hmem. sep trivial. split; auto. apply MemUpdW_MemUpd16 with 0; auto. Qed. Definition l_acquire_closure_step5 (sp l pc bp : int) (mP: MPred) : MPred := (sp + 2 |->w bp *^* sp + 4 |->w pc *^* sp + 6 |->w l) *^* stkSpacePrec (sp - 2 - _STK_SIZE_l_acquire) IH_Stk *^* mP. Lemma stk_lock_acquire_call1: _STK_SIZE_lock_acquire - 4 - 2 - _STK_SIZE_l_acquire = IH_Stk. Proof. unfold _STK_SIZE_lock_acquire. omega. Qed. Hint Resolve stk_lock_acquire_call1. Lemma stk_lock_acquire_call2: _STK_SIZE_lock_acquire - 4 - 2 >= _STK_SIZE_l_acquire. Proof. unfold _STK_SIZE_lock_acquire. omega. Qed. Hint Resolve stk_lock_acquire_call2. Lemma lock_acquire_step5_call3: forall f sp l pc bp mP S S', lock_acquire4_Prd_aux sp l pc bp mP S -> nextS f (comml (_call l_acquire)) S S' -> l_acquire_Prd_aux (sp - 2) l (f + 1) (S_RF S' BP) (l_acquire_closure_step5 sp l pc bp mP) S'. Proof. intros. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion H0). destruct H1 as [Hspgt2 [Hpcspace HM']]. destruct H2 as [HR' [Hfl' Hisr']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. clear H0. UnfoldStateAll. reg simpl. unfold lock_acquire4_Prd_aux in H. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. rewrite HRsp in Hmem. unfold lock_acquire4_MPre in Hmem. unfold lock_acquire3_MPre in Hmem. unfold l_acquire_Prd_aux. reg simpl. rewrite HRsp. split_l. split_l. split; auto. unfold l_acquire_MPre. unfold l_acquire_closure_step5. sep on. sep lift 0. sep upd2. sep lift 4 in Hmem. sep stksplit in Hmem. sep stksplit _STK_SIZE_l_acquire in Hmem. assert (_STK_SIZE_lock_acquire - 4 - 2 - _STK_SIZE_l_acquire = IH_Stk). auto. rewrite H in Hmem. rewrite HRsp in Hspgt2. assert (sp - 2 + 2 = sp). auto. rewrite H0. sep matchH Hmem with 10. Qed. Lemma lock_acquire_step5_call2: forall f, gimp (sp_call_pred lock_acquire4_Prd f l_acquire >o l_acquire_grt) fun_frame. Proof. unfold gimp. unfold sp_call_pred. unfold conjPG. unfold linkPG. intros. destruct H as [[S0 [Hpre Htrans]] Hgrt]. unfold lock_acquire4_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. assert (l_acquire_Prd_aux (sp - 2) l (f + 1) (S_RF S BP) (l_acquire_closure_step5 sp l pc bp mP) S). apply lock_acquire_step5_call3 with S0; auto. rename H into HFpre. unfold l_acquire_grt in Hgrt. unfold leadstoPQ2 in Hgrt. assert (l_acquire_Post_aux (sp - 2) l (f+1) (S_RF S BP) (l_acquire_closure_step5 sp l pc bp mP) S'). apply Hgrt; auto. clear Hgrt. unfold fun_frame. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). unfold l_acquire_Prd_aux in HFpre. unfold l_acquire_Post_aux in H. UnfoldStateAll. destruct HFpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. destruct H as [HRsp' [HRbp' [Hmem' [Hfl' Hisr']]]]. split. rewrite HRsp. rewrite HRsp'. auto. exists (f + 1). unfold Ret_Addr. UnfoldStateAll. split. intro. apply nextPC_retw with (sp - 2). auto. unfold l_acquire_MPre in Hmem. sep on. sep lift 0 in Hmem. sep trivial. intro. apply nextPC_retw with (sp - 2); auto. unfold l_acquire_MPost in Hmem'. unfold l_acquire_MPre in Hmem'. sep on. sep lift 0 in Hmem'. sep trivial. Qed. Lemma lock_acquire_step5_call4_aux: forall f f' sp l pc bp mP S S', lock_acquire4_Prd_aux sp l pc bp mP S -> wrap_fun l_acquire_grt f l_acquire f' S S' -> lock_acquire5_Prd_aux sp l pc bp mP S'. Proof. intros. rename H into Hpre. unfold wrap_fun in H0. unfold conjG in H0. destruct H0 as [S2 [[S1 [Hcall Hgrt]] Hretw]]. assert (sp >= 2). unfold lock_acquire4_Prd_aux in Hpre. induction S as (((M, R), fl), isr). induction S1 as (((M', R'), fl'), isr'). InvertAll. destruct (nextS_inversion Hcall). InvertAll. rewrite H in H7; auto. rename H into Hspge2. assert (l_acquire_Prd_aux (sp - 2) l (f + 1) (S_RF S1 BP) (l_acquire_closure_step5 sp l pc bp mP) S1). apply lock_acquire_step5_call3 with S; auto. clear Hpre. rename H into HFpre. unfold l_acquire_grt in Hgrt. unfold leadstoPQ2 in Hgrt. assert (l_acquire_Post_aux (sp - 2) l (f+1) (S_RF S1 BP) (l_acquire_closure_step5 sp l pc bp mP) S2). apply Hgrt; auto. clear HFpre Hgrt Hcall. rename H into Hpre. induction S2 as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Hretw). subst M'. destruct H0 as [[pc'' [HMpc HR']] [Hfl' Hisr']]. subst fl' isr' R'. clear Hretw. clear HMpc. unfold l_acquire_Post_aux in Hpre. destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_acquire5_Prd_aux. reg simpl. unfold l_acquire_MPost in Hmem. unfold l_acquire_MPre in Hmem. assert (R SP + 2 = sp). rewrite HRsp. auto. split_l. split; auto. unfold lock_acquire5_MPre. unfold lock_acquire6_MPre. unfold l_acquire_closure_step5 in Hmem. sep on. sep lift 4. sep stksplit. sep lift 2 in Hmem. assert (sp - 2 >= _STK_SIZE_l_acquire). eapply stkSpacePrec_sp_ge_sz1; eauto. assert (_STK_SIZE_lock_acquire - 4 - 2 >= _STK_SIZE_l_acquire). auto. sep stksplit _STK_SIZE_l_acquire. assert (_STK_SIZE_lock_acquire - 4 - 2 - _STK_SIZE_l_acquire = IH_Stk). auto. rewrite H2. assert (sp - 2 + 2 = sp). auto. rewrite H3 in Hmem. sep matchH Hmem with 10. Qed. Lemma lock_acquire_step5_call4: forall f pc' : nat, pimp (lock_acquire4_Prd |> wrap_fun l_acquire_grt f l_acquire pc') lock_acquire5_Prd. Proof. unfold pimp. unfold linkPG. intros. destruct H as [S0 [Hpre Htrans]]. unfold lock_acquire4_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_acquire5_Prd. mexists5 sp l pc bp mP. apply lock_acquire_step5_call4_aux with f pc' S0; auto. Qed. Lemma lock_acquire_step5_call5: forall f pc' : nat, gimp (lock_acquire4_Prd >o wrap_fun l_acquire_grt f l_acquire pc' oo lock_acquire5_grt) lock_acquire4_grt. Proof. intros. unfold gimp. unfold conjPG. unfold conjG. intros. destruct H as [S'' [[Hpre Hfun] Htrans5]]. unfold lock_acquire4_grt. unfold leadstoPQ2. intros. unfold lock_acquire5_grt in Htrans5. unfold leadstoPQ2 in Htrans5. apply Htrans5. apply lock_acquire_step5_call4_aux with f pc' S; auto. Qed. Lemma lock_acquire4_Prd_IF_false: forall S : State, lock_acquire4_Prd S -> S_Flag S _IF = false. Proof. intros. unfold lock_acquire4_Prd in H. unfold lock_acquire4_Prd_aux in H. induction S as (((M, R), fl), isr). InvertAll. unfold S_Flag. auto. Qed. Lemma lock_acquire4_Grt_Itr_Stk: Grt_Itr_Stk lock_acquire4_grt. Proof. unfold Grt_Itr_Stk. intros. induction S as (((M, R), fl), isr). unfold lock_acquire4_grt. unfold leadstoPQ2. intros. unfold lock_acquire4_Prd_aux in H4. UnfoldStateAll. InvertAll. unfold itr_enabled in H0. inversion_clear H0. UnfoldStateAll. rewrite H8 in H7. inversion H7. Qed. Lemma wff_cmd_lock_acquire5: NH_WFcmd (SCAP_consCT (lock_acquire + 1 + 1 + 1 + 1 + 1) (Ast lock_acquire5_Prd lock_acquire5_grt 1) lock_acquire_psi) (lock_acquire + 1 + 1 + 1 + 1) (Ast lock_acquire4_Prd lock_acquire4_grt 1) (comml (_call l_acquire)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. right. split. apply l_acquire_not_primentry. unfold NH_Normal_Call. exists l_acquire_Prd. exists lock_acquire5_Prd. exists l_acquire_grt. exists lock_acquire5_grt. split. unfold SCAP_lookupCT. unfold SCAP_consCT. unfold SPSpec.lookup. unfold ListT.In. right. assert (SCAP_lookupCT lock_acquire_psi l_acquire (Ast l_acquire_Prd l_acquire_grt 1)). unfold lock_acquire_psi. auto. auto. split; auto. generalize (lock_acquire + 1 + 1 + 1 + 1). intro f. split. assert (forall sp l pc bp mP, enable (lock_acquire4_Prd_aux sp l pc bp mP) (nextS f (comml (_call l_acquire)))). apply lock_acquire4_enable. unfold enable in *. intros. unfold lock_acquire4_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. split. apply lock_acquire_step5_call2. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_acquire4_Prd in H. InvertAll. unfold l_acquire_Prd. mexists5 (x0 - 2) x1 (f+1) (S_RF S BP) (l_acquire_closure_step5 x0 x1 x2 x3 x4). apply lock_acquire_step5_call3 with x; auto. split. intro. apply lock_acquire_step5_call4. intro. apply lock_acquire_step5_call5. split. apply IF_false_Prd_Itr_Stk. apply lock_acquire4_Prd_IF_false. apply lock_acquire4_Grt_Itr_Stk. Qed. Lemma lock_acquire_step6_enable: enable_sti lock_acquire5_Prd. Proof. unfold lock_acquire5_Prd. unfold enable_sti. unfold lock_acquire5_Prd_aux. intros. induction S as (((M, R), fl), isr). destruct H as [sp [l [pc [bp [m [HRsp [Hmem [Hlock [Hfl Hisr]]]]]]]]]. unfold lock_acquire5_MPre in Hmem. assert ((INV1 *^* INV0 *^* (lock_acquire6_MPre sp l pc bp *^* m)) M). sep on. sep matchH Hmem with 4. clear Hmem. rename H into Hmem. destruct Hmem as [M1 [M2 [HMsplit [Hinv Hrest]]]]. exists M2. exists M1. UnfoldStateAll. split; auto with PMap. split. unfold pTrue. auto. unfold choice. right. split; auto. intro. unfold itr_enabled in H. UnfoldStateAll. inversion H. rewrite H0 in Hfl. inversion Hfl. Qed. Lemma lock_acquire_step6_Prd_aux: forall sp l pc bp mP S S', lock_acquire5_Prd_aux sp l pc bp mP S -> gsti S S' -> lock_acquire6_Prd_aux sp l pc bp mP S'. Proof. unfold lock_acquire5_Prd_aux. intros. induction S as (((M, R), fl), isr). destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. rename H0 into Htrans. induction S' as (((M', R'), fl'), isr'). unfold gsti in Htrans. UnfoldStateAll. destruct Htrans as [Hpp [Hfl' [Hisr' HR']]]. subst R' isr'. unfold prepost in Hpp. destruct Hpp as [M1 [M2 [M1' [HM1 [Hm1' [HsplitM HsplitM']]]]]]. UnfoldStateAll. assert (M2 = M'). unfold Aemp in Hm1'. rewrite Hm1' in HsplitM'. auto with PMap. subst M'. clear HsplitM' Hm1' M1'. unfold choice in HM1. inversion_clear HM1. inversion H. unfold itr_enabled in H0. inversion_clear H0. unfold S_Flag in H2. rewrite H2 in Hfl. inversion Hfl. inversion_clear H. clear H0. rename H1 into Hinv. unfold lock_acquire5_MPre in Hmem. assert ((INV1 *^* INV0 *^* (lock_acquire6_MPre sp l pc bp *^* mP)) M). sep on. sep matchH Hmem with 4. clear Hmem. rename H into Hmem. destruct Hmem as [M1x [M2x [HMsplit' [Hinv' Hrest]]]]. assert (M1 = M1x). assert (precise (INV1 *^* INV0)). apply mstar_presv_prec; auto. apply Prec1. apply Prec0. unfold precise in H. apply H with M; auto. apply MemMod.disjUnion_subseteq_left with M2; auto. apply MemMod.disjUnion_subseteq_left with M2x; auto. assert (M2 = M2x). apply MemMod.disjUnion_unique with M1 M1x M; auto. subst M2. unfold lock_acquire6_Prd_aux. split_l. split; auto. Qed. Lemma lock_acquire5_Prd_IF_false: forall S : State, lock_acquire5_Prd S -> S_Flag S _IF = false. Proof. unfold lock_acquire5_Prd. intros. destruct H as [sp [l [oc [bp [mP Hpre]]]]]. unfold lock_acquire5_Prd_aux in Hpre. induction S as (((M, R), fl), isr). InvertAll. auto. Qed. Lemma lock_acquire5_Grt_Itr_Stk: Grt_Itr_Stk lock_acquire5_grt. Proof. unfold Grt_Itr_Stk. intros. induction S as (((M, R), fl), isr). unfold lock_acquire5_grt. unfold leadstoPQ2. intros. unfold lock_acquire5_Prd_aux in H4. UnfoldStateAll. InvertAll. unfold itr_enabled in H0. inversion_clear H0. UnfoldStateAll. rewrite H8 in H7. inversion H7. Qed. Lemma wff_cmd_lock_acquire6: NH_WFcmd (SCAP_consCT (lock_acquire + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_acquire6_Prd lock_acquire6_grt 1) lock_acquire_psi) (lock_acquire + 1 + 1 + 1 + 1 + 1) (Ast lock_acquire5_Prd lock_acquire5_grt 1) (comml _sti). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. exists lock_acquire6_Prd. exists lock_acquire6_grt. split; auto. split. apply lock_acquire_step6_enable. split. unfold pimp. unfold linkPG. intros. destruct H as [S0 [Hpre Htrans]]. unfold lock_acquire5_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_acquire6_Prd. mexists5 sp l pc bp mP. apply lock_acquire_step6_Prd_aux with S0; auto. unfold gimp. unfold conjG. unfold conjPG. intros. destruct H as [S'' [[Hpre Htrans] Hgrt6]]. unfold lock_acquire5_grt. unfold lock_acquire6_grt in Hgrt6. unfold leadstoPQ2 in *. intros. apply Hgrt6. apply lock_acquire_step6_Prd_aux with S; auto. split. apply IF_false_Prd_Itr_Stk. apply lock_acquire5_Prd_IF_false. apply lock_acquire5_Grt_Itr_Stk. Qed. Lemma lock_acquire_step7: forall f sp l pc bp mP S S', lock_acquire6_Prd_aux sp l pc bp mP S -> nextS f (comml (_addw (Opr_imm 2) SP)) S S' -> lock_acquire7_Prd_aux (sp + 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [HR' [Hfl' Hisr']]. unfold opr_eval in HR'. subst R' isr'. clear Htrans. unfold lock_acquire6_Prd_aux in H. destruct H as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. unfold lock_acquire7_Prd_aux. reg simpl. rewrite HRsp. split; auto with arith. split; auto with arith. assert (sp + 2 - 2 = sp). auto. rewrite H. unfold lock_acquire6_Prd_aux. reg simpl. split; auto. split; auto. split; auto. split_r. unfold trash_fl in Hfl'. inversion Hfl'. subst fl'. unfold Set_Flag. simpl. auto. subst fl'. unfold Clear_Flag. simpl. auto. Qed. Lemma lock_acquire6_Prd_Itr_Stk : Prd_Itr_Stk lock_acquire6_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_acquire6_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_acquire6_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. unfold lock_acquire6_MPre in Hmem. sep on. sep lift 4 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. rewrite HRsp. split_l. intros M1' Hmem1'. unfold lock_acquire6_Prd. mexists5 sp l pc bp mP. unfold lock_acquire6_Prd_aux. unfold lock_acquire6_MPre. split_l. split; auto. sep on. sep lift 4. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 7. Qed. Lemma lock_acquire6_Grt_Itr_Stk : Grt_Itr_Stk lock_acquire6_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_acquire6_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_acquire6_Prd_aux in * . simplS in * . destruct Hpre as [HRsp [Hmem [Hlock [Hfl Hisr]]]]. split_l. split; auto. unfold lock_acquire6_MPre in *. sep on. sep lift 4 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 4. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. rewrite HRsp in HM2, HM2'. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. split_l. sep on. sep matchH HM1x with 7. Qed. Lemma wff_cmd_lock_acquire7: NH_WFcmd (SCAP_consCT (lock_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_acquire7_Prd lock_acquire7_grt 1) lock_acquire_psi) (lock_acquire + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_acquire6_Prd lock_acquire6_grt 1) (comml (_addw (Opr_imm 2) SP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists lock_acquire7_Prd. exists lock_acquire7_grt. split. auto. generalize (lock_acquire + 1 + 1 + 1 + 1 + 1 + 1). intro f. split. apply trivial_enable_addw. split. unfold pimp. unfold linkPG. intros. destruct H as [S0 [Hpre Htrans]]. unfold lock_acquire6_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_acquire7_Prd. mexists5 (sp + 2) l pc bp mP. apply lock_acquire_step7 with f S0; auto. unfold gimp. unfold conjG. unfold conjPG. intros. destruct H as [S'' [[Hpre Htrans] Hgrt7]]. unfold lock_acquire6_grt. unfold lock_acquire7_grt in Hgrt7. unfold leadstoPQ2 in *. intros. assert (sp + 2 + 2 = sp + 4). auto. rewrite <- H0. apply Hgrt7. apply lock_acquire_step7 with f S; auto. split. apply lock_acquire6_Prd_Itr_Stk. apply lock_acquire6_Grt_Itr_Stk. Qed. Lemma lock_acquire7_Prd_Itr_Stk : Prd_Itr_Stk lock_acquire7_Prd. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_acquire7_Prd in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_acquire7_Prd_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold lock_acquire6_Prd_aux in Hpre. unfold itr_enabled in Henable. simplS in * . reg simpl. destruct Hpre as [HRsp [Hspgt2 [Htmp [Hmem [Hlock [Hfl Hisr]]]]]]. unfold lock_acquire6_MPre in Hmem. sep on. sep lift 4 in Hmem. assert (_STK_SIZE_lock_acquire - 4 >= IH_Stk + 6 - 2). unfold _STK_SIZE_lock_acquire. unfold _STK_SIZE_l_acquire. omega. sep stksplit (IH_Stk + 6 - 2) in Hmem. sep lift 0 in Hmem. assert (M ||- stkSpacePrec (sp - 2) (IH_Stk + 6 - 2) *^* sp - 2 |->w_ *^* (stkSpacePrec (sp - 2 - (IH_Stk + 6 - 2)) (_STK_SIZE_lock_acquire - 4 - (IH_Stk + 6 - 2)) *^* (Gamma l *^* mP *^* (sp - 2 + 2 |->w bp *^* sp - 2 + 4 |->w pc *^* sp - 2 + 6 |->w l)))). sep matchH Hmem with 8. clear Hmem. rename H0 into Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. split. rewrite HRsp. sep on. sep stksplit. auto. intros M1' Hmem1'. unfold lock_acquire7_Prd. mexists5 sp l pc bp mP. unfold lock_acquire7_Prd_aux. unfold lock_acquire6_Prd_aux. unfold lock_acquire6_MPre. reg simpl. split_l. split; auto. split_l. split; auto. sep on. sep lift 4. assert (sp - 2 >= IH_Stk + 6 - 2). apply stkSpacePrec_sp_ge_sz1 with M1 (sp - 2 |->w_); auto. sep stksplit (IH_Stk + 6 - 2). sep lift 1. assert (MemMod.merge M2 M1' ||- stkSpacePrec (sp - 2) (IH_Stk + 6 - 2) *^* sp - 2 |->w_ *^* (Gamma l *^* mP *^* (sp - 2 + 2 |->w bp *^* sp - 2 + 4 |->w pc *^* sp - 2 + 6 |->w l) *^* stkSpacePrec (sp - 2 - (IH_Stk + 6 - 2)) (_STK_SIZE_lock_acquire - 4 - (IH_Stk + 6 - 2)))). exists M1'; exists M2. assert (stkSpacePrec sp (IH_Stk + 6) M1). sep on. sep stksplit. auto. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. rewrite <- HRsp. auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. rewrite <- HRsp. auto. split. sep on. assert (M1' ||- stkSpacePrec (R SP) (IH_Stk + 6)). auto. rewrite HRsp in H2. sep stksplit in H2. auto. sep on. sep matchH Hmem2 with 6. sep matchH H1 with 8. Qed. Lemma lock_acquire7_Grt_Itr_Stk : Grt_Itr_Stk lock_acquire7_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_acquire7_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_acquire7_Prd_aux in * . unfold lock_acquire6_Prd_aux in * . simplS in * . reg simpl. destruct Hpre as [HRsp [Hspgt2 [Htmp [Hmem [Hlock [Hfl Hisr]]]]]]. split_l. split_l. split_l. split; auto. unfold lock_acquire6_MPre in *. sep on. sep lift 4 in Hmem. assert (_STK_SIZE_lock_acquire - 4 >= IH_Stk + 6 - 2). unfold _STK_SIZE_lock_acquire. unfold _STK_SIZE_l_acquire. omega. sep stksplit (IH_Stk + 6 - 2) in Hmem. sep lift 0 in Hmem. assert (MemMod.merge M1 M2' ||- stkSpacePrec (sp - 2) (IH_Stk + 6 - 2) *^* sp - 2 |->w_ *^* (stkSpacePrec (sp - 2 - (IH_Stk + 6 - 2)) (_STK_SIZE_lock_acquire - 4 - (IH_Stk + 6 - 2)) *^* (Gamma l *^* mP *^* (sp - 2 + 2 |->w bp *^* sp - 2 + 4 |->w pc *^* sp - 2 + 6 |->w l)))). sep matchH Hmem with 8. clear Hmem. rename H0 into Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 4. assert (sp - 2 >= IH_Stk + 6 - 2). apply stkSpacePrec_sp_ge_sz1 with M2x (sp - 2 |->w_); auto. sep stksplit (IH_Stk + 6 - 2). sep lift 1. assert (M ||- stkSpacePrec (sp - 2) (IH_Stk + 6 - 2) *^* sp - 2 |->w_ *^* (Gamma l *^* mP *^* (sp - 2 + 2 |->w bp *^* sp - 2 + 4 |->w pc *^* sp - 2 + 6 |->w l) *^* stkSpacePrec (sp - 2 - (IH_Stk + 6 - 2)) (_STK_SIZE_lock_acquire - 4 - (IH_Stk + 6 - 2)))). rewrite HRsp in HM2, HM2'. assert (M2x = M2' /\ M1x = M1). assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (M2x ||- stkSpacePrec sp (IH_Stk + 6)). sep stksplit. sep on. auto. assert (Hx := prec_disjUnion_inv H1 H2 HM2' H3 (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H1; subst M1x M2x. exists M2; exists M1. split. auto with PMap. split. assert (M2 ||- stkSpacePrec sp (IH_Stk + 6)). auto. sep on. sep stksplit in H1. auto. sep on. sep matchH HM1x with 6. sep matchH H1 with 8. Qed. Lemma wff_cmd_lock_acquire8: NH_WFcmd (SCAP_consCT (lock_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_acquire_Post lock_acquire_last_grt 1) lock_acquire_psi) (lock_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_acquire7_Prd lock_acquire7_grt 1) (comml (_popw BP)). Proof. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. unfold SCAP_WFcmd. exists lock_acquire_Post. exists lock_acquire_last_grt. split. auto. generalize (lock_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1). intro f. assert (forall sp l pc bp mP, enable (lock_acquire7_Prd_aux sp l pc bp mP) (nextS f (comml (_popw BP)))). intros. apply enable_popw. intros. assert ((S_RF S SP |~>w bp) (S_Mem S)). Lemma lock_acquire7_Prd_1: forall sp l pc bp mP S, lock_acquire7_Prd_aux sp l pc bp mP S -> (S_RF S SP |~>w bp) (S_Mem S). Proof. intros. unfold lock_acquire7_Prd_aux in H. induction S as (((M, R), fl), isr). InvertAll. UnfoldStateAll. unfold lock_acquire6_Prd_aux in H2. unfold lock_acquire6_MPre in H2. reg simpl. InvertAll. sep on. assert (sp - 2 + 2 = sp). auto. rewrite H5 in H2. sep lift 1 in H2. rewrite H0. sep trivial. Qed. apply lock_acquire7_Prd_1 with sp l pc mP. auto. apply leadsToW_leadsToxW with bp; auto. split. unfold enable in *. intros. unfold lock_acquire7_Prd in H0. InvertAll. apply H with x x0 x1 x2 x3; auto. Lemma lock_acquire_step8: forall f sp l pc bp mP S S', lock_acquire7_Prd_aux sp l pc bp mP S -> nextS f (comml (_popw BP)) S S' -> lock_acquire_Post_aux (sp + 2) l pc bp mP S'. Proof. intros. rename H0 into Htrans. induction S as (((M, R), fl), isr). induction S' as (((M', R'), fl'), isr'). destruct (nextS_inversion Htrans). subst M'. destruct H1 as [[x [Hmemx HR']] [Hfl' Hisr']]. assert (x = bp). assert ((S_RF (M, R, fl, isr) SP |~>w bp) (S_Mem (M, R, fl, isr))). apply lock_acquire7_Prd_1 with sp l pc mP; auto. UnfoldStateAll. apply leadsToW_unique with (R SP) M; auto. subst x. subst R' fl' isr'. unfold lock_acquire_Post_aux. reg simpl. clear Htrans. unfold lock_acquire7_Prd_aux in H. InvertAll. split. rewrite H0. auto. split_l. unfold lock_acquire6_Prd_aux in H2. reg simpl. InvertAll. split; auto. unfold lock_acquire6_MPre in H2. unfold lock_acquire_MPost. unfold lock_acquire_MPre. sep on. sep lift 2. sep stksplit. assert (sp + 2 - 2 = sp). auto. rewrite H5. sep stksplit. assert (sp - 2 + 2 = sp). auto. rewrite H7 in H2. assert (_STK_SIZE_lock_acquire - 2 - 2 = _STK_SIZE_lock_acquire - 4). auto. rewrite H8. assert (sp + 2 + 2 = sp + 4). auto. rewrite H9. assert (sp - 2 + 4 = sp + 2). auto. rewrite H10 in H2. assert (sp - 2 + 6 = sp + 4). auto. rewrite H11 in H2. sep matchH H2 with 7. Qed. split. unfold pimp. unfold linkPG. intros. InvertAll. unfold lock_acquire7_Prd in H0. InvertAll. unfold lock_acquire_Post. exists (x0 + 2). exists x1. exists x2. exists x3. exists x4. apply lock_acquire_step8 with f x; auto. unfold gimp. unfold conjPG. unfold conjG. intros. InvertAll. unfold lock_acquire7_grt. unfold leadstoPQ2. intros. unfold lock_acquire_last_grt in H2. unfold leadstoPQ2 in H2. apply H2. apply lock_acquire_step8 with f S; auto. split. apply lock_acquire7_Prd_Itr_Stk. apply lock_acquire7_Grt_Itr_Stk. Qed. Lemma lock_acquirePost_Prd_Itr_Stk : Prd_Itr_Stk lock_acquire_Post. Proof. unfold Prd_Itr_Stk. intros S Hpre Henable. unfold lock_acquire_Post in Hpre. destruct Hpre as [sp [l [pc [bp [mP Hpre]]]]]. unfold lock_acquire_Post_aux in Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. unfold lock_acquire_MPost in Hmem. unfold lock_acquire_MPre in Hmem. sep on. sep lift 2 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M1 [M2 [Hsplit [Hmem1 Hmem2]]]]. exists M2; exists M1. split. auto with PMap. rewrite HRsp. split_l. intros M1' Hmem1'. unfold lock_acquire_Post. mexists5 sp l pc bp mP. unfold lock_acquire_Post_aux. unfold lock_acquire_MPost. unfold lock_acquire_MPre. split_l. split_l. split; auto. sep on. sep lift 2. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M1; auto. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. split. disjoint rep_l M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. merge commut M2. trivial. disjoint rep_r M1. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. split_l. sep on. sep matchH Hmem2 with 5. Qed. Lemma lock_acquirePost_Grt_Itr_Stk : Grt_Itr_Stk lock_acquire_last_grt. Proof. unfold Grt_Itr_Stk. intros S S' Hgrt Henable. unfold lock_acquire_last_grt in * . intros M1 M2 M2' Hsplit HM2 HM2'. unfold leadstoPQ2 in *. intros sp l pc bp mP Hpre. destruct S as [[[M R] fl] isr]. unfold itr_enabled in Henable. apply Hgrt. clear Hgrt. unfold lock_acquire_Post_aux in * . simplS in * . destruct Hpre as [HRsp [HRbp [Hmem [Hlock [Hfl Hisr]]]]]. split_l. split_l. split; auto. unfold lock_acquire_MPost in *. unfold lock_acquire_MPre in *. sep on. sep lift 2 in Hmem. sep stksplit (IH_Stk + 6) in Hmem. sep lift 0 in Hmem. destruct Hmem as [M2x [M1x [Hsplit' [HM2x HM1x]]]]. sep lift 2. assert (sp >= IH_Stk + 6). apply stkSpacePrec_sp_ge_sz with M2x; auto. sep stksplit (IH_Stk + 6). sep lift 1. rewrite HRsp in HM2, HM2'. assert (M2x = M2' /\ M1x = M1). assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. apply stkSpacePrec_stkSpacePrec_eqDom with sp (IH_Stk + 6); auto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. assert (Hx := prec_disjUnion_inv H0 H1 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H0; subst M1x M2x. exists M2; exists M1. split. auto with PMap. split_l. sep on. sep matchH HM1x with 5. Qed. Lemma wff_cmd_lock_acquire9: NH_WFiseq lock_acquire_psi (lock_acquire + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast lock_acquire_Post lock_acquire_last_grt 1) (sseq _retw). Proof. apply nh_isq_end. unfold NH_WFcmd. split. unfold NH_WFcmd_aux. split; auto. intros. unfold lock_acquire_last_grt. intros. unfold leadstoPQ2. auto. split. apply lock_acquirePost_Prd_Itr_Stk. apply lock_acquirePost_Grt_Itr_Stk. Qed. Lemma wff_lock_acquire: NH_WFiseq lock_acquire_psi lock_acquire (Ast lock_acquire_Prd lock_acquire_grt 1) I_lock_acquire. Proof. unfold I_lock_acquire. apply nh_isq_seq with lock_acquire1_Prd lock_acquire1_grt. apply wff_cmd_lock_acquire1. apply nh_isq_seq with lock_acquire2_Prd lock_acquire2_grt. apply wff_cmd_lock_acquire2. apply nh_isq_seq with lock_acquire3_Prd lock_acquire3_grt. apply wff_cmd_lock_acquire3. apply nh_isq_seq with lock_acquire4_Prd lock_acquire4_grt. apply wff_cmd_lock_acquire4. apply nh_isq_seq with lock_acquire5_Prd lock_acquire5_grt. apply wff_cmd_lock_acquire5. apply nh_isq_seq with lock_acquire6_Prd lock_acquire6_grt. apply wff_cmd_lock_acquire6. apply nh_isq_seq with lock_acquire7_Prd lock_acquire7_grt. apply wff_cmd_lock_acquire7. apply nh_isq_seq with lock_acquire_Post lock_acquire_last_grt. apply wff_cmd_lock_acquire8. apply wff_cmd_lock_acquire9. Qed. coq/examples/make.sh0000644000107400000620000000040711000223244014131 0ustar shaosystems#!/bin/bash # Top rule for Makefile. # To generate top Makefile, just type: sh make.sh > Makefile # Then type: make coq_makefile -I .. -I ../CAP0 -I ../SCAP -I ../miniOS -I . \ Assembly.v cond_signal.v cond_wait.v lock_acquire.v lock_release.v SyncUtil.v coq/examples/cond_signal.v0000644000107400000620000016055711000223244015344 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Add LoadPath "../miniOS". Add LoadPath "../examples". Require Import Coqlib. Require Import List. Require Import Arith. Require Import Machine. Require Import Mem_Lemmas. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas5. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import Reg. Require Import AIM. Require Import AIM_Lemmas. Require Import QLib. Require Import SCAP. Require Import SCAP_READY. Require Import Linking. Require Import Linking_Lemmas2. Require Import Omega. Require Import Assembly. Require Import SyncUtil. Notation _STK_SIZE_cond_signal := (4 + 2 + _UNBLK_Stk + IH_Stk) (only parsing). Definition psi_cond_signal := SCAP_emptCT. Definition cond_signal_MPre (sp cv pc : Label) (M : Mem) : Prop := ((sp |->w pc) *^* (sp + 2 |->w cv) *^* stkSpacePrec sp _STK_SIZE_cond_signal) M /\ In cv cvSet_M. Definition cond_signal_Prd_aux (sp cv pc bp : Label) (S : State) : Prop := match S with (M, R, fl, isr) => R SP = sp /\ R BP = bp /\ (cond_signal_MPre sp cv pc) M /\ fl _IF = true /\ isr = false end. Definition cond_signal_Prd (S : State) : Prop := imprec (fun S => exists sp, exists cv, exists pc, exists bp, cond_signal_Prd_aux sp cv pc bp S) S. Definition cond_signal_MPost := cond_signal_MPre. Definition cond_signal_Post_aux := cond_signal_Prd_aux. Definition cond_signal_grt (S S' : State) : Prop := forall sp cv pc bp, leadstoPQ (cond_signal_Prd_aux sp cv pc bp) (cond_signal_Post_aux sp cv pc bp) S S'. (* Definition cond_signal_psi := SCAP_consCT l_acquire (Ast l_acquire_Prd l_acquire_grt 1) (SCAP_consCT l_release (Ast l_release_Prd l_release_grt 1) (SCAP_consCT L_sleep (Ast L_sleep_0_p L_sleep_0_g 1) SCAP_emptCT )). *) Definition Ast_cond_signal_pre (cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec sp _STK_SIZE_cond_signal *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp /\ sp >= _STK_SIZE_cond_signal /\ In cv cvSet_M /\ S_Flag S _IF = true /\ S_ISR S = false. Definition Ast_cond_signal_post := Ast_cond_signal_pre. Definition p_cond_signal_0 (S : State) : Prop := exists cv, exists bp, exists sp, exists pc, Ast_cond_signal_pre cv bp sp pc mTrue S. Definition g_cond_signal_0 (S S' : State) : Prop := forall mP, forall cv bp sp pc, Ast_cond_signal_pre cv bp sp pc mP S -> Ast_cond_signal_post cv bp sp pc mP S'. (* : _pushwp (Opr_reg BP); *) Definition Ast_cond_signal_1 (cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp-2) (_STK_SIZE_cond_signal - 2) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp - 2 /\ sp >= _STK_SIZE_cond_signal /\ In cv cvSet_M /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_signal_1 (S : State) : Prop := exists cv, exists bp, exists sp, exists pc, Ast_cond_signal_1 cv bp sp pc mTrue S. Definition g_cond_signal_1 (S S' : State) : Prop := forall mP, forall cv bp sp pc, Ast_cond_signal_1 cv bp sp pc mP S -> Ast_cond_signal_post cv bp sp pc mP S'. (* : _movwp (Opr_reg SP) BP; *) Definition Ast_cond_signal_2 (cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp-2) (_STK_SIZE_cond_signal - 2) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP) (S_Mem S) /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ sp >= _STK_SIZE_cond_signal /\ In cv cvSet_M /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_signal_2 (S : State) : Prop := exists cv, exists bp, exists sp, exists pc, Ast_cond_signal_2 cv bp sp pc mTrue S. Definition g_cond_signal_2 (S S' : State) : Prop := forall mP, forall cv bp sp pc, Ast_cond_signal_2 cv bp sp pc mP S -> Ast_cond_signal_post cv bp sp pc mP S'. (* : _movwld (A_reg 4 BP) BX; *) Definition Ast_cond_signal_3 (cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp-2) (_STK_SIZE_cond_signal - 2) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP) (S_Mem S) /\ S_RF S BX = cv /\ S_RF S SP = sp - 2 /\ sp >= _STK_SIZE_cond_signal /\ In cv cvSet_M /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_signal_3 (S : State) : Prop := exists cv, exists bp, exists sp, exists pc, Ast_cond_signal_3 cv bp sp pc mTrue S. Definition g_cond_signal_3 (S S' : State) : Prop := forall mP, forall cv bp sp pc, Ast_cond_signal_3 cv bp sp pc mP S -> Ast_cond_signal_post cv bp sp pc mP S'. (* : _cli; *) Definition Ast_cond_signal_4 (cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec (sp-2) (_STK_SIZE_cond_signal - 2) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP)) (S_Mem S) /\ S_RF S BX = cv /\ S_RF S SP = sp - 2 /\ sp >= _STK_SIZE_cond_signal /\ In cv cvSet_M /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_cond_signal_4 (S : State) : Prop := exists cv, exists bp, exists sp, exists pc, Ast_cond_signal_4 cv bp sp pc mTrue S. Definition g_cond_signal_4 (S S' : State) : Prop := forall mP, forall cv bp sp pc, Ast_cond_signal_4 cv bp sp pc mP S -> Ast_cond_signal_post cv bp sp pc mP S'. (* : _pushwm (A_reg C_WAITING BX); *) Definition Ast_cond_signal_5 (cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* stkSpacePrec (sp-2-2) (_STK_SIZE_cond_signal - 2 - 2 ) *^* (sp - 2 - 2 |->w_) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP) (S_Mem S) /\ (exists w, (sp - 2 - 2 |~>w w) (S_Mem S) /\ Delta w = SomeT Aemp) /\ S_RF S SP = sp - 2 - 2 /\ sp >= _STK_SIZE_cond_signal /\ In cv cvSet_M /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_cond_signal_5 (S : State) : Prop := exists cv, exists bp, exists sp, exists pc, Ast_cond_signal_5 cv bp sp pc mTrue S. Definition g_cond_signal_5 (S S' : State) : Prop := forall mP, forall cv bp sp pc, Ast_cond_signal_5 cv bp sp pc mP S -> Ast_cond_signal_post cv bp sp pc mP S'. (* : _call _UNBLK; *) Definition Ast_cond_signal_6 (cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := ((INV0 *^* INV1) *^* (stkSpacePrec (sp-2-2) (_STK_SIZE_cond_signal - 2 - 2 ) *^* (sp - 2 - 2 |->w_) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP)) (S_Mem S) /\ S_RF S SP = sp - 2 - 2 /\ sp >= _STK_SIZE_cond_signal /\ In cv cvSet_M /\ S_Flag S _IF = false /\ S_ISR S = false. Definition p_cond_signal_6 (S : State) : Prop := exists cv, exists bp, exists sp, exists pc, Ast_cond_signal_6 cv bp sp pc mTrue S. Definition g_cond_signal_6 (S S' : State) : Prop := forall mP, forall cv bp sp pc, Ast_cond_signal_6 cv bp sp pc mP S -> Ast_cond_signal_post cv bp sp pc mP S'. (* : _sti; *) Definition Ast_cond_signal_7 (cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp-2-2) (_STK_SIZE_cond_signal - 2 - 2 ) *^* (sp - 2 - 2 |->w_) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 - 2 /\ sp >= _STK_SIZE_cond_signal /\ In cv cvSet_M /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_signal_7 (S : State) : Prop := exists cv, exists bp, exists sp, exists pc, Ast_cond_signal_7 cv bp sp pc mTrue S. Definition g_cond_signal_7 (S S' : State) : Prop := forall mP, forall cv bp sp pc, Ast_cond_signal_7 cv bp sp pc mP S -> Ast_cond_signal_post cv bp sp pc mP S'. (* : _addw (Opr_imm 2) SP; *) Definition Ast_cond_signal_8 (cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec (sp-2) (_STK_SIZE_cond_signal - 2) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ sp >= _STK_SIZE_cond_signal /\ In cv cvSet_M /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_signal_8 (S : State) : Prop := exists cv, exists bp, exists sp, exists pc, Ast_cond_signal_8 cv bp sp pc mTrue S. Definition g_cond_signal_8 (S S' : State) : Prop := forall mP, forall cv bp sp pc, Ast_cond_signal_8 cv bp sp pc mP S -> Ast_cond_signal_post cv bp sp pc mP S'. (* : _popw BP; *) Definition Ast_cond_signal_9 (cv bp sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec sp (_STK_SIZE_cond_signal) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp /\ sp >= _STK_SIZE_cond_signal /\ In cv cvSet_M /\ S_Flag S _IF = true /\ S_ISR S = false. Definition p_cond_signal_9 (S : State) : Prop := exists cv, exists bp, exists sp, exists pc, Ast_cond_signal_9 cv bp sp pc mTrue S. Definition g_cond_signal_9 (S S' : State) : Prop := forall mP, forall cv bp sp pc, Ast_cond_signal_9 cv bp sp pc mP S -> Ast_cond_signal_post cv bp sp pc mP S'. Lemma p_cond_signal_0_sound : forall S, cond_signal_Prd S -> p_cond_signal_0 S. Proof. unfold cond_signal_Prd, p_cond_signal_0. intros S HS. unfold imprec, pmstar in HS. destruct HS as [M1 [M2 [HJM [HM1 HM2]]]]. destruct S as [[[M R] fl] isr]. destruct HM1 as [sp [cv [pc [bp HS]]]]. unfold cond_signal_Prd_aux in HS. unfold Ast_cond_signal_pre. simplS in * . unfold cond_signal_MPre in HS. exists cv; exists bp; exists sp; exists pc. destruct HS as [HSP [HBP [HM1 [Hif Hisr]]]]. destruct HM1 as [HM1 Hcv]. rsplit. repeat split_l; trivial. sep on. sep lift 2 in HM1. assert (HM1x : M1 ||- stkSpace sp (4 + 2 + _UNBLK_Stk + IH_Stk)). sep trivial. destruct HM1x; trivial. exists M1; exists M2; split_l. split_r. sep on. sep matchH HM1 with 2. Qed. Lemma g_cond_signal_0_sound : forall S S', g_cond_signal_0 S S' -> cond_signal_grt S S'. Proof. unfold g_cond_signal_0, cond_signal_grt. unfold cond_signal_Prd_aux, cond_signal_Post_aux. unfold leadstoPQ. intros S S' HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. intros sp cv pc bp M1 M2 HJM HS. assert (H : Ast_cond_signal_pre cv bp sp pc (mEq M2) (M, R, fl, isr)). unfold cond_signal_MPre in HS. destruct HS as [HSP [HBP [[HM1 Hcv] [Hif Hisr]]]]. unfold Ast_cond_signal_pre. rsplit. simplS in * . repeat split_l; trivial. sep on. sep lift 2 in HM1. assert (HM1x : M1 ||- stkSpace sp (4 + 2 + _UNBLK_Stk + IH_Stk)). sep trivial. destruct HM1x; trivial. exists M1; exists M2; split_l. split_r. sep on. sep matchH HM1 with 2. unfold mEq; trivial. assert (H0 := HSS' _ _ _ _ _ H). unfold Ast_cond_signal_post, Ast_cond_signal_pre in H0. simplS in * . destruct H0 as [HM' [HBP' [HSP' [Hsp [Hcv [Hif' Hisr']]]]]]. destruct HM' as [M1' [M2' [HJM' [HM1' HM2']]]]. exists M1'. unfold cond_signal_Prd_aux. unfold cond_signal_MPre. unfold mEq in HM2'. subst M2'. repeat split_l; trivial. sep on. sep matchH HM1' with 3. Qed. Lemma g_cond_signal_0_complete : forall S S', cond_signal_grt S S' -> g_cond_signal_0 S S'. Proof. unfold g_cond_signal_0, cond_signal_grt. unfold cond_signal_Prd_aux, cond_signal_Post_aux. unfold leadstoPQ. intros S S' HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold Ast_cond_signal_post, Ast_cond_signal_pre. intros mP cv bp sp pc HS. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. substH HSS' with (HSS' sp cv pc bp M1 M2 HJM). assert (R SP = sp /\ R BP = bp /\ cond_signal_MPre sp cv pc M1 /\ fl _IF = true /\ isr = false). split_l. split_l. split_r by auto. unfold cond_signal_MPre. split_r. sep on. sep matchH HM1 with 3. substH HSS' with (HSS' H); clear H. destruct HSS' as [M1' [HJM' HM1']]. unfold cond_signal_Prd_aux in HM1'. destruct HM1' as [HSP' [HBP' [HM1' [Hif' Hisr']]]]. rsplit. repeat split_l; trivial. exists M1'; exists M2; split_l. split_r. unfold cond_signal_MPre in HM1'. destruct HM1' as [HM1' _]. sep on. sep matchH HM1' with 3. Qed. Lemma wff_cmd_cond_signal1: NH_WFcmd (SCAP_consCT (cond_signal + 1) (Ast p_cond_signal_1 g_cond_signal_1 1) psi_cond_signal) cond_signal (Ast cond_signal_Prd cond_signal_grt 1) (comml (_pushwp (Opr_reg BP))). Proof. assert (Hpp' : forall cv bp sp pc mP S S', Ast_cond_signal_pre cv bp sp pc mP S -> nextS (cond_signal) (comml (_pushwp (Opr_reg BP))) S S' -> Ast_cond_signal_1 cv bp sp pc mP S'). intros cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_signal_pre, Ast_cond_signal_1 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. split. subst M' R'. sep on. rewrite HBP. rewrite HSP. sep lift 1. sep upd. sep lift 0 in HM. sep stksplit in HM. sep matchH HM with 5. subst M' R' fl' isr'. reg simpl. rewrite HSP. repeat split_l; trivial. simpl. split. exists p_cond_signal_1; exists g_cond_signal_1. split_l (* lookup *). split. (* enable *) apply enable_pushwp with (_STK_SIZE_cond_signal). intros S HS. destruct S as [[[M R] fl] isr]. substH HS with (p_cond_signal_0_sound _ HS). unfold p_cond_signal_0 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_pre in HS. destruct HS as [HM [HBP [HSP _]]]. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep trivial. omega. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_cond_signal_1, p_cond_signal_2. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. substH HS with (p_cond_signal_0_sound _ HS). destruct HS as [cv [bp [sp [pc HS]]]]. exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. apply g_cond_signal_0_sound. unfold g_cond_signal_0, g_cond_signal_1 in * . intros mP cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS HIS. unfold cond_signal_Prd in HS. destruct HS as [M1 [M2 [HJM [HM1 HM2]]]]. destruct HM1 as [sp [cv [pc [bp HM1]]]]. unfold cond_signal_Prd_aux in HM1. destruct HM1 as [HSP [HBP [HM1 [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in HIS. simplS in * . rewrite HSP. unfold cond_signal_MPre in HM1. destruct HM1 as [HM1 Hcv]. sep on. sep lift 2 in HM1. sep stksplit (IH_Stk + 6) in HM1. sep lift 0 in HM1. destruct HM1 as [M11 [M12 [HJM1 [HM11 HM12]]]]. exists (MemMod.merge M12 M2); exists M11. split. split. disjoint des. disjoint lift_r. destruct ((fun x => HJM) 0); destruct ((fun x => HJM1) 0). subst M1 M. merge commut (MemMod.merge M12 M2). merge assoc M11. trivial. disjoint des. disjoint lift_r. split_l. intros M11' HM11'. unfold cond_signal_Prd. exists (MemMod.merge M11' M12); exists M2. simplS. assert (HeqD : MemMod.eqDom M11 M11'). eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split. split. disjoint des. disjoint rep_l M11. disjoint lift_l. disjoint lift_l. merge_commut M2. merge assoc M2. merge commut M2. merge commut M12. trivial. disjoint trivial. disjoint rep_r M11. disjoint des. disjoint lift_r. disjoint rep_r M11. disjoint lift_r. split_r. exists sp; exists cv; exists pc; exists bp. unfold cond_signal_Prd_aux. split_l. split_l. unfold cond_signal_MPre. split_r. repeat split_l; trivial. sep on. sep lift 2. assert (H : stkSpace sp (IH_Stk+6) M11). sep on. sep trivial. destruct H. sep stksplit (IH_Stk+6). sep lift 1. exists M11'; exists M12. split. split_r. disjoint rep_l M11. split_l. sep on. sep matchH HM12 with 3. (* Grt_Itr_Stk *) apply (Grt_Itr_Stk_equal g_cond_signal_0_sound g_cond_signal_0_complete). unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_signal_0 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_signal_pre in * . simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_signal2: NH_WFcmd (SCAP_consCT (cond_signal + 1 + 1) (Ast p_cond_signal_2 g_cond_signal_2 1) psi_cond_signal) (cond_signal + 1) (Ast p_cond_signal_1 g_cond_signal_1 1) (comml (_movwp (Opr_reg SP) BP)). Proof. assert (Hpp' : forall cv bp sp pc mP S S', Ast_cond_signal_1 cv bp sp pc mP S -> nextS (cond_signal + 1) (comml (_movwp (Opr_reg SP) BP)) S S' -> Ast_cond_signal_2 cv bp sp pc mP S'). intros cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_signal_1, Ast_cond_signal_2 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. subst M' R' fl' isr'. reg simpl. repeat split_l; trivial. simpl. split. exists p_cond_signal_2; exists g_cond_signal_2. split_l. split. (* enable movw *) apply trivial_enable_movwp. split. (* p ==> p' *) unfold p_cond_signal_1, p_cond_signal_2. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HSS']. destruct H as [cv [bp [sp [pc HS]]]]. exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HSS'] HS'S'']]. unfold g_cond_signal_1, g_cond_signal_2 in * . intros mP cv bp sp pc HS. eapply HS'S''; eauto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_signal_1 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_1 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_signal_1. exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_signal_1. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_signal_1 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_signal_1 in * . simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_signal3: NH_WFcmd (SCAP_consCT (cond_signal + 1 + 1 + 1) (Ast p_cond_signal_3 g_cond_signal_3 1) psi_cond_signal) (cond_signal + 1 + 1) (Ast p_cond_signal_2 g_cond_signal_2 1) (comml (_movwld (A_reg 4 BP) BX)). Proof. assert (Hpp' : forall cv bp sp pc mP S S', Ast_cond_signal_2 cv bp sp pc mP S -> nextS (cond_signal + 1 + 1) (comml (_movwld (A_reg 4 BP) BX)) S S' -> Ast_cond_signal_3 cv bp sp pc mP S'). intros cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_signal_2, Ast_cond_signal_3 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [cvx [Hlds HR']]. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. assert (Heq : cvx = cv). unfold addr_eval in Hlds. rewrite HBP in Hlds. arith_rep (sp - 2 + 4) with (sp + 2) in Hlds. sep on. sep lift 3 in HM. sep inj. auto. subst cvx M' R' fl' isr'. reg simpl. repeat split_l; trivial. simpl. split. exists p_cond_signal_3; exists g_cond_signal_3. split_l. split. (* enable *) apply enable_movwld. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_cond_signal_2 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_2 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. simplS in * . unfold addr_eval. rewrite HBP. arith_rep (sp - 2 + 4) with (sp + 2). sep on. sep lift 3 in HM. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_cond_signal_2, p_cond_signal_3. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. destruct HS as [cv [bp [sp [pc HS]]]]. exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. unfold g_cond_signal_2, g_cond_signal_3 in * . intros mP cv bp sp pc HS. eapply HS'S''; eauto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_signal_2 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_2 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_signal_2. exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_signal_2. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_signal_2 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_signal_2 in * . simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_signal4: NH_WFcmd (SCAP_consCT (cond_signal + 1 + 1 + 1 + 1) (Ast p_cond_signal_4 g_cond_signal_4 1) psi_cond_signal) (cond_signal + 1 + 1 + 1) (Ast p_cond_signal_3 g_cond_signal_3 1) (comml _cli). Proof. assert (Hpp': forall cv bp sp pc mP S S', Ast_cond_signal_3 cv bp sp pc mP S -> gcli S S' -> Ast_cond_signal_4 cv bp sp pc mP S'). intros cv bp sp pc mP S S' HS HSS'. unfold linkPG, conjPG, conjG. unfold Ast_cond_signal_3, gcli, Ast_cond_signal_4 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct HS as [HM [HBX [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. assert (Hshift' : prepost Aemp (INV0 *^* INV1) (M, R, fl, isr) (M', R', fl', isr')). apply (prepost_weaken_post (mQ' := INV0 *^* INV1) Hshift). intros Mx H. apply (choice_elim_left H); unfold itr_enabled; auto. split. sep on. assert (HMx : S_Mem (M, R, fl, isr) ||- (Aemp) *^* (stkSpacePrec (sp - 2) (4 + 2 + _UNBLK_Stk + IH_Stk - 2) *^* sp - 2 |->w bp *^* sp |->w pc *^* sp + 2 |->w cv *^* mP)). sep matchH HM with 4. substH HM with (prepost_elim Hshift' precise_emp HMx). sep on. sep matchH HM with 5. simplS in * . subst R' isr'. repeat split_l; trivial. simpl. split. exists p_cond_signal_4; exists g_cond_signal_4. split_l. (* lookup *) split. (* p ==> p' *) unfold p_cond_signal_3, p_cond_signal_4. intros S' H. unfold linkPG in H. destruct H as [S [HS HSS']]. destruct HS as [cv [bp [sp [pc HS]]]]. exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) unfold g_cond_signal_3, g_cond_signal_4. unfold linkPG, conjPG, conjG. intros S S'' H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. intros mP cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_signal_3 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_3 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_signal_3. exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_signal_3. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_signal_3 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_signal_3 in * . simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_signal5: NH_WFcmd (SCAP_consCT (cond_signal + 1 + 1 + 1 + 1 + 1) (Ast p_cond_signal_5 g_cond_signal_5 1) psi_cond_signal) (cond_signal + 1 + 1 + 1 + 1) (Ast p_cond_signal_4 g_cond_signal_4 1) (comml (_pushwm (A_reg C_WAITING BX))). Proof. assert (Hpp' : forall cv bp sp pc mP S S', Ast_cond_signal_4 cv bp sp pc mP S -> nextS (cond_signal+1+1+1+1) (comml (_pushwm (A_reg C_WAITING BX))) S S' -> Ast_cond_signal_5 cv bp sp pc mP S'). intros cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_signal_4, Ast_cond_signal_5 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [wx [Hlds [Hspgt [HldsB HM']]]]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM', Hlds. simplS in * . destruct HS as [HM [HBX [HSP [Hsp [Hcv [Hif Hisr]]]]]]. assert (Hw : exists w, (cv + C_WAITING |~>w w) M /\ Delta w = SomeT Aemp). assert ((CV_INV_M cv *^* mTrue) M). apply INV1_cvInv; trivial. sep on. sep matchH HM with 5. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. unfold CV_INV_M in HM1. destruct HM1 as [w [HM1 Hw]]. exists w; split_r. unfold leadsToW. unfold imprecM. exists M1; exists M2; auto. destruct Hw as [w [Hw1 Hw2]]. assert (Heq : w = wx). rewrite HBX in Hlds. sep on. sep inj. auto. subst wx. subst M' R' fl' isr'. rewrite HSP. split. sep on. sep lift 3. sep exists_left w. sep upd. sep lift 2 in HM. sep stksplit in HM. sep matchH HM with 6. reg simpl. repeat split_l; trivial. exists w; split_r. sep on. sep upd. sep lift 2 in HM. sep stksplit in HM. sep lift 1 in HM. sep trivial. simpl. split. exists p_cond_signal_5; exists g_cond_signal_5. split_l (* lookup *). split. (* enable *) apply enable_pushwm with (_STK_SIZE_cond_signal - 2); try omega. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_cond_signal_4 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_4 in HS. simplS in * . destruct HS as [HM [HBX [HSP [Hsp [Hcv [Hif Hisr]]]]]]. rewrite HSP. unfold addr_eval. rewrite HBX. assert (Hw : exists w, (cv + C_WAITING |~>w w) M /\ Delta w = SomeT Aemp). assert ((CV_INV_M cv *^* mTrue) M). apply INV1_cvInv; trivial. sep on. sep matchH HM with 5. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. unfold CV_INV_M in HM1. destruct HM1 as [w [HM1 Hw]]. exists w; split_r. unfold leadsToW. unfold imprecM. exists M1; exists M2; auto. destruct Hw as [w [Hw1 Hw2]]. split. sep on. sep lift 2 in HM. sep trivial. sep on. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_cond_signal_4, p_cond_signal_5. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. destruct HS as [cv [bp [sp [pc HS]]]]. exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. unfold g_cond_signal_4, g_cond_signal_5 in * . intros mP cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_signal_4 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_4 in HS. destruct HS as [HM [HBX [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_signal_5 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_cond_signal_4 in HS. simplS in * . destruct HS as [HM [HBX [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma wff_cmd_cond_signal6: NH_WFcmd (SCAP_consCT (cond_signal + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_signal_6 g_cond_signal_6 1) psi_cond_signal) (cond_signal + 1 + 1 + 1 + 1 + 1) (Ast p_cond_signal_5 g_cond_signal_5 1) (comml (_call _UNBLK)). Proof. assert (Hpp''' : forall cv bp sp pc mP S S' S'' S''' pc', Ast_cond_signal_5 cv bp sp pc mP S -> nextS (cond_signal + 1 + 1 + 1 + 1 + 1) (comml (_call _UNBLK)) S S' -> (gunblk Aemp) S' S'' -> nextS pc' (comms _retw) S'' S''' -> Ast_cond_signal_6 cv bp sp pc mP S'''). intros cv bp sp pc mP. intros S S' S'' S''' pc'. intros HS HSS' HS'S'' HS''S'''. unfold Ast_cond_signal_5, Ast_cond_signal_6 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. simplS in * . destruct HS as [HM [Hw [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspg' [Hlds Hupd]]. unfold gunblk in HS'S''. destruct HS'S'' as [sp' [HM'' [Hif'' [Hisr'' HSP'']]]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pc''' [Hlds''' HR''']]. simplS in * . subst M''' R''' fl''' isr'''. subst isr'' R' fl' isr'. clear HSS' HS''S'''. reg simpl. destruct HSP'' as [Hsp' HSP'']. subst sp'. rewrite HSP in HSP''. rewrite HSP in HM''. destruct Hw as [w [Hldsw Hw]]. split. sep on. substH Hupd with (MemUpd16_MemUpdW Hupd). destruct Hupd as [junk HM']. rewrite HSP in HM'. assert (HM''x : prepost (stkSpacePrec (sp - 2 - 2 - 2) 10) (stkSpacePrec (sp - 2 - 2 - 2) 10) (M', RF_update R SP (sp - 2 - 2 - 2), fl, isr) (M'', R'', fl'', isr)). eapply prepost_weaken_pre; eauto. intros Mx HMx. destruct HMx as [Mx1 [Mx2 [HJMx [HMx1 HMx2]]]]. assert (Mx1 = MemMod.emp). destruct (eq_nat_dec (R'' AX) 0). rewrite e in HMx1. substH HMx1 with (choice_elim_left HMx1 (refl_equal _)). unfold Aemp in HMx1; trivial. substH HMx1 with (choice_elim_right HMx1 n). unfold Aemp in HMx1; trivial. assert (Mx2 = Mx). subst Mx1. auto with PMap. subst Mx1 Mx2. trivial. clear HM''; rename HM''x into HM''. sep lift 2. sep lift 2 in HM. sep stksplit in HM. clear HSP HSP'' Hspg'. sep stksplit. sep stksplit 10. sep stksplit 10 in HM. assert (HM'x : M' ||- stkSpacePrec (sp - 2 - 2 - 2) 10 *^* stkSpacePrec (sp - 2 - 2 - 2 - 10) (4 + 2 + 10 + IH_Stk - 2 - 2 - 2 - 10) *^* (sp - 2 - 2 - 2 |->w (cond_signal + 1 + 1 + 1 + 1 + 1 + 1)) *^* (sp - 2 - 2 |->w_) *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mP *^* (INV0 *^* INV1)). subst M'. sep lift 2. sep upd. sep matchH HM with 7. replace M'' with (S_Mem (M'', R'', fl'', isr)); trivial. replace M' with (S_Mem (M', RF_update R SP (sp - 2 - 2 - 2), fl, isr)) in HM'x; trivial. sep lift 0 in HM'x. sep lift 1. sep off. substH HM'' with (prepost_elim HM'' (@precise_stkSpacePrec _ _) HM'x). simplS in * . sep on. sep matchH HM'' with 10. rewrite <- HSP''. split. generalize Hsp; clearall. omega. rewrite <- Hif''. auto. simpl. split. left. split. unfold prim_entry. right; right; trivial. split. constructor 3 with p_cond_signal_5 p_cond_signal_6 g_cond_signal_5 g_cond_signal_6 1; trivial. (* enable *) unfold enable_unblk. intros S HS. unfold p_cond_signal_5 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. assert (Hw : exists w, (sp - 2 - 2 |~>w w) (S_Mem S) /\ Delta w = SomeT Aemp). destruct HS as [HM [Hw [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct Hw as [w [Hldsw Hw]]. exists w; auto. destruct Hw as [w [Hldsw Hw]]. exists w; exists Aemp. split. split_l. destruct HS as [HM [_ [HSP [Hsp [Hcv [Hif Hisr]]]]]]. unfold pTrue, pmstar. destruct S as [[[M R] fl] isr]. simplS in * . rewrite HSP. sep on. assert (HMx : M ||- ((INV0 *^* INV1) *^* stkSpacePrec (sp-2-2-12) IH_Stk *^* (sp - 2 |->w bp) *^* (sp |->w pc) *^* (sp + 2 |->w cv) *^* mTrue) *^* (sp - 2 - 2 |->w w *^* (Aemp *^* stkSpacePrec (sp - 2 - 2) (_UNBLK_Stk + 2)))). sep lift 3 in HM. sep elim_left HM. sep inj. intro Heq; subst v. sep matchH HM with 8. generalize HM; clearall_arith; intros. clear HSP. sep stksplit (10+2) in HM. arith_rep (4 + 2 + 10 + IH_Stk - 2 - 2 - (10+2)) with IH_Stk in HM. clear HM. destruct HMx as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. auto. split. (* p ==> p' *) intros pc' S'''. unfold p_cond_signal_5, p_cond_signal_6. unfold wrap_fun. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. exists cv; exists bp; exists sp; exists pc. eapply Hpp'''; eauto. (* g''' ==> g *) intros pc' S''''. unfold g_cond_signal_5, g_cond_signal_6. unfold wrap_fun. intros HSS''''. unfold conjG at 1 in HSS'''' . destruct HSS'''' as [S''' [HSS''' H]]. destruct HSS''' as [S'' [HSS'' HS''S''']]. destruct HSS'' as [S' [HSS' HS'S'']]. clear cv bp sp pc Hldsw HS. intros mP cv bp sp pc HS. apply H; trivial. eapply Hpp'''; eauto. (* p ==> if=false *) intros S HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_5 in HS. InvertAll; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_signal_5 in HS. destruct HS as [cv [ bp [sp [pc HS]]]]. unfold Ast_cond_signal_5 in HS. destruct HS as [HM [_ [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_signal_5 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_cond_signal_5 in HS. simplS in * . destruct HS as [HM [_ [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma wff_cmd_cond_signal7: NH_WFcmd (SCAP_consCT (cond_signal + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_signal_7 g_cond_signal_7 1) psi_cond_signal) (cond_signal + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_signal_6 g_cond_signal_6 1) (comml _sti). Proof. assert (Hpp': forall cv bp sp pc mP S S', Ast_cond_signal_6 cv bp sp pc mP S -> gsti S S' -> Ast_cond_signal_7 cv bp sp pc mP S'). intros cv bp sp pc mP S S' HS HSS'. unfold linkPG, conjPG, conjG. unfold Ast_cond_signal_6, gsti, Ast_cond_signal_7 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. assert (Hshift' : prepost (INV0 *^* INV1) Aemp (M, R, fl, isr) (M', R', fl', isr')). apply (prepost_weaken_pre (mP':=INV0 *^* INV1) Hshift). intros Mx HMx. assert (Hitr : ~ itr_enabled (M, R, fl, isr)). unfold itr_enabled. intros [H1 H2]. simplS in * . rewrite Hif in H1; discriminate H1. eapply choice_elim_right; eauto. clear Hshift; rename Hshift' into Hshift. split. sep on. substH HM with (prepost_elim Hshift Prec01 HM). sep on. simplS in * . sep matchH HM with 6. sep trivial. simplS in * . subst R' isr'. repeat split_l; trivial. simpl. split. exists p_cond_signal_7; exists g_cond_signal_7. split_l. split. (* enable *) unfold enable_sti. intros S HS. unfold p_cond_signal_6 in HS. unfold pTrue, pmstar, choice. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_6 in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . destruct HM as [M2 [M1 [HJM [HM2 HM1]]]]. exists M1; exists M2. split. auto with PMap. split_l. right. split_r. intros [H1 H2]. simplS in * . rewrite Hif in H1; discriminate H1. split. (* p ==> p' *) unfold p_cond_signal_6, p_cond_signal_7. intros S' H. unfold linkPG in H. destruct H as [S [HS HSS']]. destruct HS as [cv [bp [sp [pc HS]]]]. exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) unfold g_cond_signal_6, g_cond_signal_7. unfold linkPG, conjPG, conjG. intros S S'' H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. intros mP cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_signal_6 in HS. destruct HS as [cv [ bp [sp [pc HS]]]]. unfold Ast_cond_signal_6 in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_signal_6 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_cond_signal_6 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma wff_cmd_cond_signal8: NH_WFcmd (SCAP_consCT (cond_signal + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_signal_8 g_cond_signal_8 1) psi_cond_signal) (cond_signal + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_signal_7 g_cond_signal_7 1) (comml (_addw (Opr_imm 2) SP)). Proof. assert (Hpp' : forall cv bp sp pc mP S S', Ast_cond_signal_7 cv bp sp pc mP S -> nextS (cond_signal + 1 + 1 + 1 + 1 + 1 + 1 + 1) (comml (_addw (Opr_imm 2) SP)) S S' -> Ast_cond_signal_8 cv bp sp pc mP S'). intros cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_signal_7, Ast_cond_signal_8 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. subst M' R' isr'. split. sep on. sep matchH HM with 5. sep stksplit. sep matchH HM with 2. reg simpl. unfold opr_eval. rewrite HSP. split_l by omega. split_l. split_l. split_r. unfold trash_fl in Hfl'. destruct Hfl'; subst fl'; auto. split. simpl. exists p_cond_signal_8; exists g_cond_signal_8. split_l. split. (* enable addw *) apply trivial_enable_addw. split. (* p ==> p' *) unfold p_cond_signal_7, p_cond_signal_8. intros S' H. unfold linkPG in H. destruct H as [S H]. simpl in H. destruct H as [H HnextS]. destruct H as [cv [bp [sp [pc H]]]]. exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[HSx HnextS] HS'S'']]. unfold g_cond_signal_7, g_cond_signal_8 in * . intros mP cv bp sp pc HS. eapply HS'S''; eauto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_signal_7 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_7 in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_signal_7. exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_signal_7. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_signal_7 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_signal_7 in * . simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_signal9: NH_WFcmd (SCAP_consCT (cond_signal + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_signal_9 g_cond_signal_9 1) psi_cond_signal) (cond_signal + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_signal_8 g_cond_signal_8 1) (comml (_popw BP)). Proof. assert (Hpp' : forall cv bp sp pc mP S S', Ast_cond_signal_8 cv bp sp pc mP S -> nextS (cond_signal + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (comml (_popw BP)) S S' -> Ast_cond_signal_9 cv bp sp pc mP S'). intros cv bp sp pc mP S S' HS HSS'. unfold Ast_cond_signal_8, Ast_cond_signal_9 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [bpx [Hlds HR']]. simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. assert (Heq : bp = bpx). sep on. sep lift 1 in HM. rewrite HSP in Hlds. sep inj. auto. subst bpx. subst M' fl' R' isr'. split. sep on. sep matchH HM with 5. sep stksplit. sep matchH HM with 2. rewrite HSP. reg simpl. split_l. split_l by omega. auto. simpl. split. exists p_cond_signal_9; exists g_cond_signal_9. split_l. split. (* enable *) apply enable_popw. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_cond_signal_8 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_8 in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. simplS in * . rewrite HSP. sep on. sep lift 1 in HM. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_cond_signal_8, p_cond_signal_9. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [cv [bp [sp [pc HS]]]]. exists cv; exists bp; exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HxS HSS'] HS'S'']. unfold g_cond_signal_8, g_cond_signal_9 in * . intros mP cv bp sp pc HS. apply HS'S''. apply Hpp' with S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_signal_8 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_8 in HS. destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_signal_8. exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_signal_8. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_signal_8 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_signal_8 in * . simplS in * . destruct HS as [HM [HSP [Hsp [Hcv [Hif Hisr]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cmd_cond_signal10: NH_WFiseq psi_cond_signal (cond_signal + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_cond_signal_9 g_cond_signal_9 1) (sseq _retw). Proof. constructor. simpl. split. split_l. intros S HS. unfold g_cond_signal_9, p_cond_signal_9 in * . unfold Ast_cond_signal_9, Ast_cond_signal_post, Ast_cond_signal_pre. intros mP cv bp sp pc H. InvertAll. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold p_cond_signal_9 in HS. destruct HS as [cv [bp [sp [pc HS]]]]. unfold Ast_cond_signal_9 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold p_cond_signal_9. exists cv; exists bp; exists sp; exists pc. unfold Ast_cond_signal_9. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold g_cond_signal_9 in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP cv bp sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_cond_signal_9 in * . simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hcv [Hif Hisr]]]]]]. rsplit. repeat split_l; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma wff_cond_signal: NH_WFiseq psi_cond_signal cond_signal (Ast cond_signal_Prd cond_signal_grt 1) I_cond_signal. Proof. unfold I_cond_signal. apply nh_isq_seq with p_cond_signal_1 g_cond_signal_1. apply wff_cmd_cond_signal1. apply nh_isq_seq with p_cond_signal_2 g_cond_signal_2. apply wff_cmd_cond_signal2. apply nh_isq_seq with p_cond_signal_3 g_cond_signal_3. apply wff_cmd_cond_signal3. apply nh_isq_seq with p_cond_signal_4 g_cond_signal_4. apply wff_cmd_cond_signal4. apply nh_isq_seq with p_cond_signal_5 g_cond_signal_5. apply wff_cmd_cond_signal5. apply nh_isq_seq with p_cond_signal_6 g_cond_signal_6. apply wff_cmd_cond_signal6. apply nh_isq_seq with p_cond_signal_7 g_cond_signal_7. apply wff_cmd_cond_signal7. apply nh_isq_seq with p_cond_signal_8 g_cond_signal_8. apply wff_cmd_cond_signal8. apply nh_isq_seq with p_cond_signal_9 g_cond_signal_9. apply wff_cmd_cond_signal9. apply wff_cmd_cond_signal10. Qed. coq/examples/Assembly.v0000644000107400000620000001544711000223244014640 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath ".." . Add LoadPath "../CAP0" . Add LoadPath "../SCAP" . Add LoadPath "../miniOS" . Require Import Machine. Require Import Operational_Semantics. Require Import AIM. Require Import Kernel. Definition L_AVAIL := 0. Definition L_WAITING := 2. Notation Local " i ; I " := (seq i I) (at level 60, right associativity). Notation Local " i ;; " := (sseq i) (at level 60). (************************************* * Source code for lock release ************************************* # lock_release(l) # precondition: interrupt is enabled lock_release: pushw %bp movw %sp, %bp pushw 4(%bp) cli call l_release sti addw $2, %sp popw %bp retw l_release: pushw %bp movw %sp, %bp movw 4(%bp), %bx # bx: lock pointer pushw L_WAITING(%bx) call unblock addw $2, %sp cmpw $0, %ax jne l_rel_done movw %sp, %bp movw 4(%bp), %bx movw $1, L_AVAIL(%bx) l_rel_done: popw %bp retw ************************************) Parameters lock_release l_release : Label. Axiom l_release_not_prim : ~ prim_entry l_release. Definition l_rel_done : Label := l_release + 10. Definition I_l_rel_done : iseq := (* : *) _popw BP; (* : *) _retw;; . Definition I_l_release : iseq := (* : *) _pushwp (Opr_reg BP); (* : *) _movwp (Opr_reg SP) BP; (* : *) _movwld (A_reg 4 BP) BX; (* : *) _pushwm (A_reg L_WAITING BX); (* : *) _call _UNBLK; (* : *) _addw (Opr_imm 2) SP; (* : *) _cmpw (Opr_imm 0) AX; (* : *) _jne l_rel_done; (* : *) _movwp (Opr_reg SP) BP; (* : *) _movwld (A_reg 4 BP) BX; (* : *) _movwst (Opr_imm 1) (A_reg L_AVAIL BX); (* : *) I_l_rel_done . Definition I_lock_release: iseq := (* : *) _pushwp (Opr_reg BP); (* : *) _movwp (Opr_reg SP) BP; (* : *) _pushwm (A_reg 4 BP); (* : *) _cli; (* : *) _call l_release; (* : *) _sti; (* : *) _addw (Opr_imm 2) SP; (* : *) _popw BP; (* : *) _retw;; . (************************************* * Source code for lock acquire ************************************* lock_acquire: pushw %bp movw %sp, %bp pushw 4(%bp) cli call l_acquire sti addw $2, %sp popw %bp retw # precondition: interrupt is disabled l_acquire: pushw %bp movw %sp, %bp movw 4(%bp), %bx # lock pointer movw L_AVAIL(%bx), %dx cmpw $0, %dx jne l_setacq pushw L_WAITING(%bx) call sleep addw $2, %sp popw %bp retw l_setacq: movw $0, L_AVAIL(%bx) popw %bp retw *************************************) Parameters l_setacq l_acquire lock_acquire: Label. Axiom l_acquire_not_prim : ~ prim_entry l_acquire. Definition I_l_acquire:= (* : *) _pushwp (Opr_reg BP); (* : *) _movwp (Opr_reg SP) BP; (* : *) _movwld (A_reg 4 BP) BX; (* : *) _movwld (A_reg L_AVAIL BX) DX; (* : *) _cmpw (Opr_imm 0) DX; (* : *) _jne l_setacq; (* : *) _pushwm (A_reg L_WAITING BX); (* : *) _call L_sleep; (* : *) _addw (Opr_imm 2) SP; (* : *) _popw BP; (* : *) _retw;; . Definition I_l_setacq:= (* : *) _movwst (Opr_imm 0) (A_reg L_AVAIL BX); (* : *) _popw BP; (* : *) _retw;; . Definition I_lock_acquire := (* : *) _pushwp (Opr_reg BP); (* : *) _movwp (Opr_reg SP) BP; (* : *) _pushwm (A_reg 4 BP); (* : *) _cli; (* : *) _call l_acquire; (* : *) _sti; (* : *) _addw (Opr_imm 2) SP; (* : *) _popw BP; (* : *) _retw;; . (******************************************* * Source code for cond var : Mesa style ******************************************* .set C_WAITING, 0 # cond_wait(l, cv) # precondition: interrupt is enabled cond_wait: pushw %bp movw %sp, %bp pushw 6(%bp) # lock pointer cli call l_release movw 4(%bp), %bx pushw C_WAITING(%bx) call sleep sti addw $2, %sp cli call l_acquire sti addw $2, %sp popw %bp retw # mesa style implementation # cond_signal(cv) # precondition: interrupt is enabled cond_signal: pushw %bp movw %sp, %bp movw 4(%bp), %bx cli pushw C_WAITING(%bx) call unblock sti addw $2, %sp popw %bp retw ********************************************) Definition C_WAITING := 0. Parameters cond_wait cond_signal : Label. Definition I_cond_wait := (* : *) _pushwp (Opr_reg BP); (* : *) _movwp (Opr_reg SP) BP; (* : *) _pushwm (A_reg 6 BP); (* : *) _cli; (* : *) _call l_release; (* : *) _movwld (A_reg 4 BP) BX; (* : *) _pushwm (A_reg C_WAITING BX); (* : *) _call L_sleep; (* : *) _sti; (* : *) _addw (Opr_imm 2) SP; (* : *) _cli; (* : *) _call l_acquire; (* : *) _sti; (* : *) _addw (Opr_imm 2) SP; (* : *) _popw BP; (* : *) _retw;; . Definition I_cond_signal := (* : *) _pushwp (Opr_reg BP); (* : *) _movwp (Opr_reg SP) BP; (* : *) _movwld (A_reg 4 BP) BX; (* : *) _cli; (* : *) _pushwm (A_reg C_WAITING BX); (* : *) _call _UNBLK; (* : *) _sti; (* : *) _addw (Opr_imm 2) SP; (* : *) _popw BP; (* : *) _retw;; . coq/Assertion_Lemmas3.v0000644000107400000620000014054111000223177014572 0ustar shaosystemsRequire Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Mem_Lemmas. Require Import Assertion. Require Import Omega. Notation Local "[{ A || B = C }] " := (MemMod.disjUnion A B C) (left associativity, at level 68). Notation Local " A ++ B " := (MemMod.merge A B) (left associativity, at level 67). Set Implicit Arguments. Unset Strict Implicit. Lemma imprecM_weaker: forall M (A : MPred), A M -> (imprecM A) M. Proof. intros M A H. unfold imprecM. exists M; exists MemMod.emp. split. auto with PMap. unfold mTrue. auto. Qed. Lemma ptoxBlk_indom : forall size l offset M, ptoxBlk l size M -> offset < size -> MemMod.in_dom (l+offset) M. Proof. induction size; simpl; intros. inversion H0. destruct offset. unfold mstar in H. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. unfold ptox in HM1. unfold pto in HM1. replace (l+0) with l; auto. apply MemMod.disjUnion_presv_in_dom with M1 M2; trivial. destruct HM1. unfold MemMod.sgltonM in H. destruct H. unfold MemMod.maps_to in H. unfold MemMod.in_dom. exists x; trivial. assert (offset < size). auto with arith. replace (l + S offset) with ((l+1) + offset). destruct H as [M1 [M2 [HJM [Hl H]]]]. assert (MemMod.in_dom (l+1+offset) M2). apply IHsize; trivial. assert (MemMod.disjUnion M2 M1 M). auto with PMap. apply MemMod.disjUnion_presv_in_dom with M2 M1; trivial. rewrite <- plus_assoc. simpl. trivial. Qed. Lemma ptoxBlk_notindom: forall l s addr h, ptoxBlk l s h -> addr < l \/ addr >= l + s -> h addr = None. Proof. intros l s. gen_clear l. induction s; intros. simpl in H. unfold Aemp in H. subst;trivial. simpl in H. destruct H as [h1 [h2 [HJh H]]]. destruct H. assert (Hx : addr < l + 1 \/ addr >= l+1+s). omega. assert (Hx0 := IHs (l+1) addr h2 H1 Hx). assert (Hx1 : h1 addr = None). unfold ptox in H. inversion H. unfold pto in H2. unfold MemMod.sgltonM in H2. destruct H2. unfold MemMod.not_in_dom in H3. apply H3. omega. substH HJh with (disjUnion_elim HJh addr). rewrite Hx0 in HJh. rewrite Hx1 in HJh. destruct (h addr); try contradiction. trivial. Qed. Lemma ptoxBlk_split : forall s1 s2 M l, ptoxBlk l (s1 + s2) M -> mstar (ptoxBlk l s1) (ptoxBlk (l+s1) s2) M. Proof. induction s1; simpl; intros. unfold Aemp, MemMod.emp. exists MemMod.emp; exists M. split. auto with PMap. unfold MemMod.emp. split_l. replace (l+0) with l; auto with arith. destruct H as [M1 [M2 [MJM [HM1 HM2]]]]. replace (l + S s1) with (S l + s1); [idtac | omega]. assert (Hx := IHs1 s2 M2 (l+1) HM2). apply mstar_assoc_right_left. unfold mstar. exists M1; exists M2; split_l. split_l. arith_rep (S l + s1) with (l+1+s1). Qed. Lemma ptoxBlk_merge : forall s1 s2 M l, mstar (ptoxBlk l s1) (ptoxBlk (l+s1) s2) M -> ptoxBlk l (s1 + s2) M. Proof. induction s1;simpl;intros. unfold mstar, Aemp in H. InvertAll. subst. assert (x0 = M). auto with PMap. subst. arith_rep l with (l+0);assumption. assert ( (ptox l *^* (ptoxBlk (l + 1) s1 *^* ptoxBlk (l + S s1) s2)) M). apply mstar_assoc_left_right;assumption. unfold mstar at 1 in H0. InvertAll. exists x;exists x0;intuition. apply IHs1. arith_rep (l+1+s1) with (l+S s1);assumption. Qed. Lemma precise_ptoxBlk : forall l s, precise (ptoxBlk l s). Proof. unfold precise. intros. apply MemMod.extensional_eqMap. unfold MemMod.subseteq in * . intro addr. unfold MemMod.A in * . unfold MemSpec.domain in * . destruct (le_lt_dec l addr). destruct (le_lt_dec (l+s) addr). assert (M1 addr = None). apply ptoxBlk_notindom with l s. assumption. omega. assert (M2 addr = None). apply ptoxBlk_notindom with l s. assumption. omega. rewrite H3;rewrite H4;reflexivity. assert (addr = l + (addr - l)). omega. rewrite H3 in l1. assert (addr- l < s). omega. rewrite H3. assert (M1 (l+(addr-l)) = M (l+(addr-l))). apply H. apply ptoxBlk_indom with s;assumption. assert (M2 (l+(addr-l)) = M (l+(addr-l))). apply H0. apply ptoxBlk_indom with s;assumption. rewrite H5;rewrite H6;reflexivity. assert (M1 addr = None). apply ptoxBlk_notindom with l s. assumption. omega. assert (M2 addr = None). apply ptoxBlk_notindom with l s. assumption. omega. rewrite H3;rewrite H4;reflexivity. Qed. (******************) (* leadsTo *) Lemma leadsTo_intro : forall M addr x, M addr = Some x -> leadsTo addr x M. Proof. unfold leadsTo. unfold imprecM. intros. unfold mstar, pto. exists (fun l : Label => if MemMod.beq_A l addr then Some x else None). exists (fun l : Label => if MemMod.beq_A l addr then None else M l). unfold MemMod.disjUnion. split. split. unfold MemMod.disjoint. intros l. unfold MemMod.not_in_dom. destruct (MemMod.beq_A l addr). right; trivial. auto. unfold MemMod.merge. apply (extensionality MemMod.A (option MemMod.B) M (fun x0 : MemMod.A => match (if MemMod.beq_A x0 addr then Some x else None (A:=nat)) with | Some _ => if MemMod.beq_A x0 addr then Some x else None (A:=nat) | None => if MemMod.beq_A x0 addr then None (A:=nat) else M x0 end)). intros l. destruct (MemMod.beq_A l addr). subst; trivial. trivial. split. unfold MemMod.sgltonM. split. unfold MemMod.maps_to. destruct (MemMod.beq_A addr addr). reflexivity. elim n;reflexivity. intros. unfold MemMod.not_in_dom. destruct (MemMod.beq_A x0 addr). elim H0;assumption. reflexivity. unfold mTrue. trivial. Qed. Lemma leadsTo_elim : forall addr x M, leadsTo addr x M -> M addr = Some x. Proof. unfold leadsTo, imprecM, pto, mstar. intros. destruct H. destruct H. destruct H. destruct H0. unfold MemMod.sgltonM in H0. unfold MemMod.maps_to in H0. destruct H0. unfold mTrue in H1. unfold MemMod.disjUnion in H. destruct H. subst M. unfold MemMod.disjoint in H. unfold MemMod.not_in_dom in H. destruct (H addr). rewrite H0 in H3; discriminate H3. clear H. unfold MemMod.merge. rewrite H0. trivial. Qed. Implicit Arguments leadsTo_elim [addr x M]. Lemma leadsTo_Mono : forall addr x M1 M2 M, MemMod.disjUnion M1 M2 M -> leadsTo addr x M1 -> leadsTo addr x M. Proof. unfold leadsToW. intros. unfold imprecM in * . unfold mstar in * . destruct H0 as [M11 [M12 [HJM1 [HM2 _]]]]. exists M11. exists (MemMod.merge M12 M2). rsplit. split_l. unfold mTrue; trivial. split. apply MemMod.disj_merge_A. destruct HJM1. trivial. destruct HJM1. subst M1. destruct H. eapply MemMod.disj_merge_disj_left; eauto. destruct H. subst M. destruct HJM1. subst M1. rewrite MemMod.merge_assoc. trivial. Qed. Implicit Arguments leadsTo_Mono [addr x M1 M2 M]. Lemma leadsTox_intro : forall addr M x, M addr = Some x -> leadsTox addr M. Proof. intros. exists (fun l => if MemMod.beq_A l addr then Some x else None). exists (fun l => if MemMod.beq_A l addr then None else M l). split. unfold MemMod.disjUnion. unfold MemMod.disjoint. unfold MemMod.not_in_dom. split. intro x0. destruct (MemMod.beq_A x0 addr). right;reflexivity. left;reflexivity. unfold MemMod.merge. apply (extensionality MemMod.A (option MemMod.B) M (fun x0 : MemMod.A => match (if MemMod.beq_A x0 addr then Some x else None (A:=MemMod.B)) with | Some _ => if MemMod.beq_A x0 addr then Some x else None (A:=MemMod.B) | None => if MemMod.beq_A x0 addr then None (A:=MemMod.B) else M x0 end)). intro x0. destruct (MemMod.beq_A x0 addr). rewrite e;assumption. reflexivity. unfold ptox. split. exists x. unfold pto. unfold MemMod.sgltonM. unfold MemMod.maps_to. destruct (MemMod.beq_A addr addr). split. reflexivity. intros. unfold MemMod.not_in_dom. destruct (MemMod.beq_A x0 addr). elim H0;assumption. reflexivity. elim n;reflexivity. unfold mTrue;trivial. Qed. Lemma leadsTox_elim : forall addr M, leadsTox addr M -> exists x,M addr = Some x. Proof. unfold leadsTox, imprecM, ptox, pto, mstar. intros. destruct H. destruct H. destruct H. destruct H0. unfold MemMod.sgltonM in H0. unfold MemMod.maps_to in H0. destruct H0. destruct H0. unfold mTrue in H1. unfold MemMod.disjUnion in H. destruct H. subst M. unfold MemMod.disjoint in H. unfold MemMod.not_in_dom in H. destruct (H addr). rewrite H0 in H3; discriminate H3. clear H. unfold MemMod.merge. rewrite H0. exists x1. trivial. Qed. (* leadsToW *) Lemma leadsToW_intro : forall M l x0 x1, M l = Some x0 -> M (l+1) = Some x1 -> leadsToW l x0 M. Proof. intros M l x0 x1 H1 H2. exists (fun addr : Label => if MemMod.beq_A l addr then Some x0 else if MemMod.beq_A (l+1) addr then Some x1 else None). exists (fun addr : Label => if MemMod.beq_A l addr then None else if MemMod.beq_A (l+1) addr then None else M addr). split. unfold MemMod.disjUnion. split. unfold MemMod.disjoint;unfold MemMod.not_in_dom. intro x. destruct (MemMod.beq_A l x). right;reflexivity. destruct (MemMod.beq_A (l+1) x). right;reflexivity. left;reflexivity. apply (extensionality MemMod.A (option MemMod.B) M (MemMod.merge (fun addr : nat => if MemMod.beq_A l addr then Some x0 else if MemMod.beq_A (l + 1) addr then Some x1 else None (A:=MemMod.B)) (fun addr : nat => if MemMod.beq_A l addr then None (A:=MemMod.B) else if MemMod.beq_A (l + 1) addr then None (A:=MemMod.B) else M addr))). intro x. unfold MemMod.merge. destruct (MemMod.beq_A l x). rewrite <-e;assumption. destruct (MemMod.beq_A (l+1) x). rewrite <- e;assumption. reflexivity. split. exists (fun addr : Label => if MemMod.beq_A l addr then Some x0 else None). exists (fun addr : Label => if MemMod.beq_A (l+1) addr then Some x1 else None). split. unfold MemMod.disjUnion. split. unfold MemMod.disjoint. unfold MemMod.not_in_dom. intro x. destruct (MemMod.beq_A l x). destruct (MemMod.beq_A (l+1) x). rewrite <-e in e0. assert (1=l-l). apply plus_minus;rewrite e0;reflexivity. rewrite <- (minus_n_n l) in H. discriminate H. right;reflexivity. left;reflexivity. unfold MemMod.merge. apply (extensionality MemMod.A (option MemMod.B) (fun addr : nat => if MemMod.beq_A l addr then Some x0 else if MemMod.beq_A (l + 1) addr then Some x1 else None (A:=MemMod.B)) (fun x : MemMod.A => match (if MemMod.beq_A l x then Some x0 else None (A:=MemMod.B)) with | Some _ => if MemMod.beq_A l x then Some x0 else None (A:=MemMod.B) | None => if MemMod.beq_A (l + 1) x then Some x1 else None (A:=MemMod.B) end)). intro x. destruct (MemMod.beq_A l x);reflexivity. split. unfold pto;unfold MemMod.sgltonM. unfold MemMod.maps_to. destruct (MemMod.beq_A l l). split. reflexivity. intros x H3. unfold MemMod.not_in_dom. destruct (MemMod.beq_A l x). rewrite e0 in H3;elim H3;reflexivity. reflexivity. elim n;reflexivity. exists x1. unfold pto;unfold MemMod.sgltonM. unfold MemMod.maps_to. destruct (MemMod.beq_A (l+1) (l+1)). split. reflexivity. intros x H3. unfold MemMod.not_in_dom. destruct (MemMod.beq_A (l+1) x). rewrite e0 in H3;elim H3;reflexivity. reflexivity. elim n;reflexivity. unfold mTrue;trivial. Qed. Lemma leadsToW_elim : forall addr x M, leadsToW addr x M -> M addr = Some x. Proof. unfold leadsToW, imprecM, pto, mstar. intros. destruct H. destruct H. destruct H. destruct H0. unfold MemMod.sgltonM in H0. unfold MemMod.maps_to in H0. destruct H0. unfold mTrue in H1. unfold MemMod.disjUnion in H. destruct H. subst M. unfold MemMod.disjoint in H. unfold MemMod.not_in_dom in H. destruct H0. unfold MemMod.disjoint, pto, ptox in H0. unfold MemMod.disjUnion, MemMod.sgltonM, pto in H0. unfold MemMod.disjoint, MemMod.merge, MemMod.maps_to in H0. unfold MemMod.sgltonM in H0. unfold MemMod.maps_to in H0. destruct H0. destruct H0. destruct H2. destruct H2. unfold MemMod.merge. subst x0. rewrite H2. trivial. Qed. Implicit Arguments leadsToW_elim [addr x M]. Lemma leadsToW_elim1 : forall l x0 M, leadsToW l x0 M -> exists x, M (l+1) = Some x. Proof. unfold leadsToW. unfold imprecM. unfold ptoW. unfold mstar. unfold pto. unfold MemMod.sgltonM. intros. destruct H as [M1 [M2 [H3 [H4 H5]]]]. destruct H4 as [M3 [M4 [H6 [H7 H8]]]]. destruct H8 as [n [H9 H10]]. exists n. unfold MemMod.disjUnion in * . destruct H3;destruct H6. rewrite H2 in H0. rewrite H0. unfold MemMod.merge. destruct H7 as [H11 H12]. assert (M3 (l+1) = None). apply H12. intros FH. assert (1=l-l). apply plus_minus;rewrite FH;reflexivity. rewrite <- (minus_n_n l) in H3. discriminate H3. rewrite H3. unfold MemMod.maps_to in H9. rewrite H9;reflexivity. Qed. Lemma leadsToW_unique : forall addr x x' M, leadsToW addr x M -> leadsToW addr x' M -> x = x'. Proof. intros. assert (Hx := leadsToW_elim H0). rewrite (leadsToW_elim H) in Hx. injection Hx; trivial. Qed. Implicit Arguments leadsToW_unique [addr x x' M]. Lemma leadsToW_Mono : forall addr x M1 M2 M, MemMod.disjUnion M1 M2 M -> leadsToW addr x M1 -> leadsToW addr x M. Proof. unfold leadsToW. intros. unfold imprecM in * . unfold mstar in * . destruct H0 as [M11 [M12 [HJM1 [HM2 _]]]]. exists M11. exists (MemMod.merge M12 M2). rsplit. split_l. unfold mTrue; trivial. split. apply MemMod.disj_merge_A. destruct HJM1. trivial. destruct HJM1. subst M1. destruct H. eapply MemMod.disj_merge_disj_left; eauto. destruct H. subst M. destruct HJM1. subst M1. rewrite MemMod.merge_assoc. trivial. Qed. Implicit Arguments leadsToW_Mono [addr x M1 M2 M]. Lemma ptoW_leadsToW : forall M l v, (l |->w v) M -> (l |~>w v) M. Proof. intros M l v H. unfold leadsToW. unfold imprecM. exists M; exists MemMod.emp. split. auto with PMap. unfold mTrue. split_lr. Qed. Implicit Arguments ptoW_leadsToW [M l v]. (* leadsToxW *) Lemma leadsToxW_intro : forall M l x0 x1, M l = Some x0 -> M (l+1) = Some x1 -> leadsToxW l M. Proof. intros M l x0 x1 H1 H2. exists (fun addr : Label => if MemMod.beq_A l addr then Some x0 else if MemMod.beq_A (l+1) addr then Some x1 else None). exists (fun addr : Label => if MemMod.beq_A l addr then None else if MemMod.beq_A (l+1) addr then None else M addr). split. unfold MemMod.disjUnion. split. unfold MemMod.disjoint;unfold MemMod.not_in_dom. intro x. destruct (MemMod.beq_A l x). right;reflexivity. destruct (MemMod.beq_A (l+1) x). right;reflexivity. left;reflexivity. apply (extensionality MemMod.A (option MemMod.B) M (MemMod.merge (fun addr : nat => if MemMod.beq_A l addr then Some x0 else if MemMod.beq_A (l + 1) addr then Some x1 else None (A:=MemMod.B)) (fun addr : nat => if MemMod.beq_A l addr then None (A:=MemMod.B) else if MemMod.beq_A (l + 1) addr then None (A:=MemMod.B) else M addr))). intro x. unfold MemMod.merge. destruct (MemMod.beq_A l x). rewrite <-e;assumption. destruct (MemMod.beq_A (l+1) x). rewrite <- e;assumption. reflexivity. split. unfold ptoxW. exists (fun addr : Label => if MemMod.beq_A l addr then Some x0 else None). exists (fun addr : Label => if MemMod.beq_A (l+1) addr then Some x1 else None). split. unfold MemMod.disjUnion. split. unfold MemMod.disjoint. unfold MemMod.not_in_dom. intro x. destruct (MemMod.beq_A l x). destruct (MemMod.beq_A (l+1) x). rewrite <-e in e0. assert (1=l-l). apply plus_minus;rewrite e0;reflexivity. rewrite <- (minus_n_n l) in H. discriminate H. right;reflexivity. left;reflexivity. unfold MemMod.merge. apply (extensionality MemMod.A (option MemMod.B) (fun addr : nat => if MemMod.beq_A l addr then Some x0 else if MemMod.beq_A (l + 1) addr then Some x1 else None (A:=MemMod.B)) (fun x : MemMod.A => match (if MemMod.beq_A l x then Some x0 else None (A:=MemMod.B)) with | Some _ => if MemMod.beq_A l x then Some x0 else None (A:=MemMod.B) | None => if MemMod.beq_A (l + 1) x then Some x1 else None (A:=MemMod.B) end)). intro x. destruct (MemMod.beq_A l x);reflexivity. split. exists x0. unfold pto;unfold MemMod.sgltonM. unfold MemMod.maps_to. destruct (MemMod.beq_A l l). split. reflexivity. intros x H3. unfold MemMod.not_in_dom. destruct (MemMod.beq_A l x). rewrite e0 in H3;elim H3;reflexivity. reflexivity. elim n;reflexivity. exists x1. unfold pto;unfold MemMod.sgltonM. unfold MemMod.maps_to. destruct (MemMod.beq_A (l+1) (l+1)). split. reflexivity. intros x H3. unfold MemMod.not_in_dom. destruct (MemMod.beq_A (l+1) x). rewrite e0 in H3;elim H3;reflexivity. reflexivity. elim n;reflexivity. unfold mTrue;trivial. Qed. Lemma leadsToxW_elim : forall l M, leadsToxW l M -> exists x, M l = Some x. Proof. unfold leadsToxW. unfold imprecM. unfold ptoxW. unfold mstar. unfold ptox. unfold pto. unfold MemMod.sgltonM. intros. destruct H as [M1 [M2 [H3 [H4 H5]]]]. destruct H4 as [M3 [M4 [H6 [H7 H8]]]]. destruct H7 as [n H9]. exists n. unfold MemMod.disjUnion in * . destruct H3;destruct H6. rewrite H2 in H0. rewrite H0. unfold MemMod.merge. destruct H9. unfold MemMod.maps_to in H3. rewrite H3. reflexivity. Qed. Lemma leadsToxW_elim1 : forall l M, leadsToxW l M -> exists x, M (l+1) = Some x. Proof. unfold leadsToxW. unfold imprecM. unfold ptoxW. unfold mstar. unfold ptox. unfold pto. unfold MemMod.sgltonM. intros. destruct H as [M1 [M2 [H3 [H4 H5]]]]. destruct H4 as [M3 [M4 [H6 [H7 H8]]]]. destruct H8 as [n [H9 H10]]. exists n. unfold MemMod.disjUnion in * . destruct H3;destruct H6. rewrite H2 in H0. rewrite H0. unfold MemMod.merge. destruct H7 as [n1 [H11 H12]]. assert (M3 (l+1) = None). apply H12. intros FH. assert (1=l-l). apply plus_minus;rewrite FH;reflexivity. rewrite <- (minus_n_n l) in H3. discriminate H3. rewrite H3. unfold MemMod.maps_to in H9. rewrite H9;reflexivity. Qed. Lemma leadsToW_leadsToxW : forall M l x, leadsToW l x M -> leadsToxW l M. Proof. unfold leadsToW, leadsToxW. unfold ptoW, ptoxW. unfold imprecM. unfold mstar, pto, ptox, mTrue. intros. destruct H as [M1 [M2 [HJM [H _]]]]. destruct H as [M11 [M12 [HJM1 [Hpto1 Hpto2]]]]. exists M1; exists M2. split_l. split_r. exists M11; exists M12. split_l. split. exists x; trivial. trivial. Qed. Implicit Arguments leadsToW_leadsToxW [M l x]. Lemma leadsToxW_leadsToW : forall M l, leadsToxW l M -> exists x, leadsToW l x M. Proof. unfold leadsToW, leadsToxW. unfold ptoW, ptoxW. unfold imprecM. unfold mstar, pto, ptox, mTrue. intros. destruct H as [M1 [M2 [HJM [H _]]]]. destruct H as [M11 [M12 [HJM1 [Hpto1 Hpto2]]]]. destruct Hpto1 as [x Hpto1]. exists x. exists M1; exists M2. split_l. split_r. exists M11; exists M12. auto. Qed. Implicit Arguments leadsToxW_leadsToW [M l]. Lemma leadsToxW_Mono : forall l M1 M2 M, MemMod.disjUnion M1 M2 M -> leadsToxW l M1 -> leadsToxW l M. Proof. unfold leadsToxW. unfold imprecM, mstar, mTrue. intros. destruct H0 as [M11 [M12 [HJM1 [Hblk Ht]]]]. exists M11; exists (MemMod.merge M12 M2). rsplit. split_lr. destruct H. destruct HJM1. subst. split. apply MemMod.disj_merge_A. trivial. eapply MemMod.disj_merge_disj_left; eauto. rewrite MemMod.merge_assoc. trivial. Qed. Lemma leadsToxW_eqDom : forall M M' l, MemMod.eqDom M M' -> leadsToxW l M -> leadsToxW l M'. Proof. unfold MemMod.eqDom. unfold MemMod.sub_dom. unfold MemMod.in_dom. intros M M' l H H0. destruct H as [H1 H2]. destruct (H1 l (leadsToxW_elim H0)) as [x1 H3]. destruct (H1 (l+1) (leadsToxW_elim1 H0)) as [x2 H4]. apply leadsToxW_intro with x1 x2;assumption. Qed. (* leadsToBlk *) Lemma ptoxBlk_intro : forall size l M, (forall addr, (addr < l -> M addr = None) /\ (addr >= l /\ addr < (l+size) -> exists x, M addr = Some x) /\ (addr >= (l + size) -> M addr = None)) -> ptoxBlk l size M. Proof. induction size. intros. simpl. unfold Aemp. unfold MemMod.emp. apply (extensionality MemMod.A (option MemMod.B) M (fun _ : MemMod.A => None)). intros addr. substH H with (H addr). destruct H as [H1 [H2 H3]]. destruct (le_lt_dec l addr). assert (addr >= l + 0). omega. apply H3; trivial. apply H1; trivial. intros. simpl. InvertAll. assert (l>=l/\l if MemMod.beq_A addr l then Some x else None). exists (fun x => if MemMod.beq_A x l then None else M x). split. unfold MemMod.disjUnion. split. unfold MemMod.disjoint. intro x0. unfold MemMod.not_in_dom. destruct (MemMod.beq_A x0 l). right;reflexivity. left;reflexivity. unfold MemMod.merge. apply (extensionality MemMod.A (option MemMod.B) M (fun x0 : MemMod.A => match (if MemMod.beq_A x0 l then Some x else None (A:=MemMod.B)) with | Some _ => if MemMod.beq_A x0 l then Some x else None (A:=MemMod.B) | None => if MemMod.beq_A x0 l then None (A:=MemMod.B) else M x0 end)). intro x0. destruct (MemMod.beq_A x0 l). rewrite e;assumption. reflexivity. split. unfold ptox, pto. exists x. unfold MemMod.sgltonM. unfold MemMod.maps_to. split. destruct (MemMod.beq_A l l). reflexivity. elim n; reflexivity. intros. unfold MemMod.not_in_dom. destruct (MemMod.beq_A x0 l). elim H5;assumption. reflexivity. apply IHsize. intros. clear H0 H1 H2 H3. split; intros. substH H with (H addr). InvertAll. destruct (MemMod.beq_A addr l). reflexivity. apply H1. assert (addr <= l). omega. destruct (le_lt_eq_dec addr l H2). assumption. elim n;assumption. split; intros. assert (exists x , M addr = Some x). destruct (H addr) as [H1 [H2 H3]]. apply H2. destruct H0. split;omega. destruct H1. exists x0. destruct (MemMod.beq_A addr l). destruct H0. rewrite e in H0. elim (le_Sn_n l). omega. assumption. destruct (MemMod.beq_A addr l). reflexivity. destruct (H addr) as [H1 [H2 H3]]. apply H3. omega. Qed. Lemma lt_ge_dec : forall n low high, {n < low} + {n >=low /\ n < high} + {n>=high}. Proof. intros. destruct (le_lt_dec low n). destruct (le_lt_dec high n). right. omega. left;right;omega. left;left;assumption. Qed. Lemma leadsToBlk_intro : forall M l size, (forall off, off < size -> leadsTox (l+off) M) -> leadsToBlk l size M. Proof. intros. unfold leadsToBlk. unfold imprecM. unfold mstar. exists (fun addr => match (lt_ge_dec addr l (l+size)) with | inleft (left _) => None | inleft (right _) => M addr | inright _ => None end). exists (fun addr => match (lt_ge_dec addr l (l+size)) with | inleft (left _) => M addr | inleft (right _) => None | inright _ => M addr end). split. split. unfold MemMod.disjoint. intro x. unfold MemMod.not_in_dom. destruct (lt_ge_dec x l (l+size)). destruct s. left;reflexivity. right;reflexivity. left;reflexivity. unfold MemMod.merge. apply (extensionality MemMod.A (option MemMod.B) M (fun x : MemMod.A => match match lt_ge_dec x l (l + size) with | inleft s => if s then None (A:=MemMod.B) else M x | inright _ => None (A:=MemMod.B) end with | Some _ => match lt_ge_dec x l (l + size) with | inleft s => if s then None (A:=MemMod.B) else M x | inright _ => None (A:=MemMod.B) end | None => match lt_ge_dec x l (l + size) with | inleft s => if s then M x else None (A:=MemMod.B) | inright _ => M x end end)). intro x. destruct (lt_ge_dec x l (l+size)). destruct s. reflexivity. destruct (M x);reflexivity. reflexivity. split. apply ptoxBlk_intro. split;intros;destruct (lt_ge_dec addr l (l+size)). destruct s. reflexivity. destruct a. elim (le_not_lt l addr);omega. reflexivity. destruct s. split;intros. elim (le_not_lt l addr);omega. reflexivity. split;intros. assert (leadsTox (l+(addr-l)) M). apply H;omega. replace (l+(addr-l)) with addr in H1. apply leadsTox_elim;assumption. omega. elim (le_not_lt (l+size) addr);omega. split. intro. elim (le_not_lt (l+size) addr);omega. intros;reflexivity. unfold mTrue;trivial. Qed. Lemma leadsToBlk_elim : forall l offset size M, leadsToBlk l size M -> offset < size -> leadsTox (l+offset) M. Proof. intros. unfold leadsToBlk in H. destruct H as [M1 [M2 [HJM H]]]. destruct H. assert (H2 := ptoxBlk_indom H H0). unfold MemMod.in_dom in H2. destruct H2. apply leadsTox_intro with x. unfold MemMod.disjUnion in HJM. destruct HJM. subst. unfold MemMod.merge. rewrite H2. reflexivity. Qed. Lemma leadsToBlk_Mono : forall size l M1 M2 M, MemMod.disjUnion M1 M2 M -> leadsToBlk l size M1 -> leadsToBlk l size M. Proof. unfold leadsToBlk. unfold imprecM, mstar, mTrue. intros. destruct H0 as [M11 [M12 [HJM1 [Hblk Ht]]]]. exists M11; exists (MemMod.merge M12 M2). rsplit. split_lr. destruct H. destruct HJM1. subst. split. apply MemMod.disj_merge_A. trivial. eapply MemMod.disj_merge_disj_left; eauto. rewrite MemMod.merge_assoc. trivial. Qed. Lemma leadsToBlk_shrink_low : forall l size off M, leadsToBlk l size M -> off <= size -> leadsToBlk (l+off) (size - off) M. Proof. unfold leadsToBlk. intros. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. arith_rep size with (off + (size - off)) in HM1. assert (Hx := ptoxBlk_split HM1). destruct Hx as [M11 [M12 [HJM1 [HM11 HM12]]]]. unfold imprecM. exists M12; exists (MemMod.merge M11 M2). split. disjUnion shift_l. merge commut M12. merge rewrite HJM1. trivial. auto. Qed. Lemma leadsToBlk_shrink_high : forall l size off M, leadsToBlk l size M -> off <= size -> leadsToBlk l off M. Proof. unfold leadsToBlk. intros. destruct H as [M1 [M2 [HJM [HM1 HM2]]]]. arith_rep size with (off + (size - off)) in HM1. assert (Hx := ptoxBlk_split HM1). destruct Hx as [M11 [M12 [HJM1 [HM11 HM12]]]]. unfold imprecM. exists M11; exists (MemMod.merge M12 M2). split. disjUnion shift_l. merge rewrite HJM1. trivial. auto. Qed. (* MemUpd16 *) Lemma leadsToW_MemUpd16_leadsToW : forall l x' M M', MemUpd16 M l x' M' -> leadsToW l x' M'. Proof. unfold MemUpd16. intros. destruct H. subst. unfold MemMod.put. apply leadsToW_intro with x. destruct (MemMod.beq_A l (l+1)). substH e with (plus_minus l l 1 e). rewrite <- (minus_n_n l) in e. discriminate e. destruct (MemMod.beq_A l l). reflexivity. elim n0;reflexivity. destruct (MemMod.beq_A (l+1) (l+1)). reflexivity. elim n ;reflexivity. Qed. (* non-touch *) Lemma leadsToW_MemUpd16_leadsToW_nt : forall l l' x x' M M', leadsToW l x M -> l' l+1 -> MemUpd16 M l' x' M' -> leadsToW l x M'. Proof. unfold MemUpd16. intros. assert (H2:=leadsToW_elim H). assert (H3:=leadsToW_elim1 H). destruct H3. destruct H1. rewrite H1. unfold MemMod.put. apply leadsToW_intro with x0. destruct (MemMod.beq_A l (l'+1)). rewrite e in H0. destruct H0. replace (l'+1-1) with l' in H0. elim (lt_irrefl l');assumption. omega. assert (~(l'+1+1 l' + 1)). omega. elim H4;assumption. assumption. destruct (MemMod.beq_A (l+1) (l'+1)). assert (l=l'). omega. rewrite H4 in H0. assert (~( l' < l' - 1 \/ l' > l' + 1)). omega. elim H5;assumption. destruct (MemMod.beq_A (l+1) l'). rewrite <- e in H0. assert (~(l+1l+1)). omega. elim H4;assumption. assumption. Qed. (*these two is unnecessary**) Lemma leadsToxW_MemUpd16_leadsToxW : forall l x M M', leadsToxW l M -> MemUpd16 M l x M' -> leadsToxW l M'. Proof. intros. assert (leadsToW l x M'). apply leadsToW_MemUpd16_leadsToW with M;assumption. apply leadsToW_leadsToxW with x;assumption. Qed. Lemma leadsToxW_MemUpd16_leadsToW : forall l x M M', leadsToxW l M -> MemUpd16 M l x M' -> leadsToW l x M'. Proof. intros. apply leadsToW_MemUpd16_leadsToW with M;assumption. Qed. (* non-touch *) Lemma leadsToxW_MemUpd16_leadsToxW_nt : forall l l' x M M', leadsToxW l M -> l' l+1 -> MemUpd16 M l' x M' -> leadsToxW l M'. Proof. intros. destruct (leadsToxW_leadsToW H). assert (H3:=leadsToW_MemUpd16_leadsToW_nt H2 H0 H1). apply leadsToW_leadsToxW with x0;assumption. Qed. Lemma leadsToxW_MemUpd16_eqDom : forall l x M M', leadsToxW l M -> MemUpd16 M l x M' -> MemMod.eqDom M M'. Proof. intros. destruct (leadsToxW_elim H) as [x0 H2]. unfold MemUpd16 in H0. destruct H0. subst M'. split; intros. assert (MemMod.sub_dom M (MemMod.put M l x)). auto with PMap. assert (MemMod.sub_dom (MemMod.put M l x) (MemMod.put (MemMod.put M l x) (l + 1) x1)). auto with PMap. eapply MemMod.subDom_trans; eauto. assert (MemMod.in_dom l M). unfold MemMod.in_dom. exists x0; trivial. assert (MemMod.sub_dom (MemMod.put M l x) M). auto with PMap. destruct (leadsToxW_elim1 H) as [x2 H3]. assert (MemMod.in_dom (l+1) (MemMod.put M l x)). unfold MemMod.put. unfold MemMod.in_dom in H2 |- * . exists x2. destruct (MemMod.beq_A (l + 1) l); trivial. assert (forall n, ~ (n + 1 = n)). induction n; simpl. auto with arith. intro Hx. injection Hx. intro Hy. destruct (IHn Hy). destruct (H4 l e). assert (MemMod.sub_dom (MemMod.put (MemMod.put M l x) (l + 1) x1) (MemMod.put M l x)). auto with PMap. eapply MemMod.subDom_trans; eauto. Qed. Implicit Arguments leadsToxW_MemUpd16_eqDom [l x M M']. Lemma leadsToxW_MemUpd16_Mono : forall l x M1 M2 M M1', MemMod.disjUnion M1 M2 M -> leadsToxW l M1 -> MemUpd16 M1 l x M1' -> MemMod.disjUnion M1' M2 (MemMod.merge M1' M2) /\ MemUpd16 M l x (MemMod.merge M1' M2). Proof. unfold MemUpd16. intros. split. destruct H1. subst M1'. rewrite <- MemMod.put_merge_merge_put. rewrite <- MemMod.put_merge_merge_put. apply MemMod.extend_presv_disjUnion_left. apply MemMod.extend_presv_disjUnion_left. destruct H; subst; split; auto. destruct H. assert (MemMod.in_dom l M1). destruct (leadsToxW_elim H0). exists x1; trivial. unfold MemMod.disjoint in H. destruct (H l); trivial. unfold MemMod.in_dom, MemMod.not_in_dom in * . destruct H2. rewrite H2 in H3; discriminate. assert (MemMod.in_dom (l+1) M1). destruct (leadsToxW_elim1 H0). exists x1; trivial. destruct H. unfold MemMod.disjoint in H. destruct (H (l+1)); trivial. unfold MemMod.in_dom, MemMod.not_in_dom in * . destruct H1. rewrite H1 in H3; discriminate. destruct H1. subst M1'. exists x0. destruct H. subst M. rewrite <- MemMod.put_merge_merge_put. rewrite <- MemMod.put_merge_merge_put. trivial. Qed. Implicit Arguments leadsToxW_MemUpd16_Mono [l x M1 M2 M M1']. Lemma leadsToxW_MemUpd16_DMono : forall l x M1 M2 M M', MemMod.disjUnion M1 M2 M -> leadsToxW l M1 -> MemUpd16 M l x M' -> exists M1', MemMod.disjUnion M1' M2 M' /\ MemUpd16 M1 l x M1'. Proof. unfold MemUpd16. intros. destruct H1 as [x1 H1]. exists (MemMod.put (MemMod.put M1 l x) (l+1) x1). destruct (leadsToxW_elim H0). destruct (leadsToxW_elim1 H0). assert (MemMod.in_dom (l+1) (MemMod.put M1 l x)). unfold MemMod.put. unfold MemMod.in_dom in H3 |- * . exists x2. destruct (MemMod.beq_A (l + 1) l); trivial. assert (forall n, ~ (n + 1 = n)). induction n; simpl. auto with arith. intro Hx. injection Hx. intro Hy. destruct (IHn Hy). destruct (H4 l e). split. subst M'. apply MemMod.extend_presv_disjUnion_left. apply MemMod.extend_presv_disjUnion_left. trivial. destruct H. unfold MemMod.disjoint in H. destruct (H l); trivial. unfold MemMod.in_dom, MemMod.not_in_dom in * . rewrite H2 in H5; discriminate. destruct H. unfold MemMod.disjoint in H. destruct (H (l+1)); trivial. unfold MemMod.in_dom, MemMod.not_in_dom in * . rewrite H3 in H5; discriminate. exists x1. trivial. Qed. Implicit Arguments leadsToxW_MemUpd16_DMono [l x M1 M2 M M']. Lemma leadsToxW_MemUpd16_DMonoR : forall l x M1 M2 M M', MemMod.disjUnion M2 M1 M -> leadsToxW l M1 -> MemUpd16 M l x M' -> exists M1', MemMod.disjUnion M2 M1' M' /\ MemUpd16 M1 l x M1'. Proof. intros. assert (MemMod.disjUnion M1 M2 M); auto with PMap. destruct (leadsToxW_MemUpd16_DMono H2 H0 H1). destruct H3. exists x0; auto with PMap. Qed. Implicit Arguments leadsToxW_MemUpd16_DMonoR [l x M1 M2 M M']. Lemma disjoint_put_disjoint : forall l x M1 M2, MemMod.in_dom l M1 -> MemMod.disjoint M1 M2 -> MemMod.disjoint (MemMod.put M1 l x) M2. Proof. unfold MemMod.in_dom, MemMod.disjoint, MemMod.put, MemMod.not_in_dom. intros. destruct H. destruct (MemMod.beq_A x0 l). subst x0. destruct (H0 l). rewrite H in H1. discriminate H1. right; trivial. destruct (H0 x0). left; trivial. right; trivial. Qed. Lemma indom_indom_put : forall l l' x' M, MemMod.in_dom l M -> MemMod.in_dom l (MemMod.put M l' x'). Proof. unfold MemMod.in_dom, MemMod.put. intros. destruct H. destruct (MemMod.beq_A l l'). exists x'; trivial. exists x; trivial. Qed. (*****added by wangwei******) (** the leadsToBlk_MemUpd16_eqDom lemma can be omitted **) (** because of this lemma *******************************) Lemma leadsToBlk_MemUpd16_eqDom2 : forall l l1 x M M' size, leadsToBlk l size M -> size >=2 -> l1>=l -> l1<=l+size-2 -> MemUpd16 M l1 x M' -> MemMod.eqDom M M'. Proof. unfold MemUpd16. intros. unfold MemMod.eqDom. unfold MemMod.sub_dom. unfold MemMod.in_dom. destruct H3. subst. unfold MemMod.put. split. (*** --> **) intros. destruct H3. destruct (eq_nat_dec x1 (l1+1)). exists x0. rewrite e. destruct (MemMod.beq_A (l1+1) (l1+1)). reflexivity. elim n;reflexivity. destruct (eq_nat_dec x1 l1). exists x. destruct (MemMod.beq_A x1 (l1+1)). elim n;assumption. destruct (MemMod.beq_A x1 l1). reflexivity. elim n1;assumption. exists x2. destruct (MemMod.beq_A x1 (l1+1)). elim n;assumption. destruct (MemMod.beq_A x1 l1). elim n0;assumption. assumption. (*** <-- ***) intros. destruct H3. destruct (MemMod.beq_A x1 (l1+1)). rewrite e. apply leadsTox_elim. replace (l1+1) with (l+ (l1+1-l)). apply leadsToBlk_elim with size. assumption. omega. omega. destruct (MemMod.beq_A x1 l1). rewrite e. apply leadsTox_elim. replace l1 with (l+(l1-l)). apply leadsToBlk_elim with size. assumption. omega. omega. exists x2. assumption. Qed. (***added by wangwei ***) Lemma leadsToBlk_MemUpd16_leadsToBlk: forall l x M M' size, leadsToBlk l size M -> size >=2 -> MemUpd16 M l x M' -> leadsToBlk l size M'. Proof. intros. assert (MemMod.eqDom M M'). apply leadsToBlk_MemUpd16_eqDom2 with l l x size;try assumption. auto. omega. apply leadsToBlk_intro. intros. assert (leadsTox (l+off) M). apply leadsToBlk_elim with size;assumption. assert (MemMod.in_dom (l+off) M'). assert (MemMod.in_dom (l+off) M). unfold MemMod.in_dom. apply leadsTox_elim;assumption. destruct H2. apply H2;assumption. destruct H5. apply leadsTox_intro with x0. assumption. Qed. Lemma leadsToBlk_MemUpd16_Mono : forall l x size M1 M2 M M1', MemMod.disjUnion M1 M2 M -> leadsToBlk l size M1 -> MemUpd16 M1 l x M1' -> size >= 2 -> MemMod.disjUnion M1' M2 (MemMod.merge M1' M2) /\ leadsToBlk l size M1' /\ MemUpd16 M l x (MemMod.merge M1' M2). Proof. intros. destruct H. assert (MemMod.eqDom M1 M1'). apply leadsToBlk_MemUpd16_eqDom2 with l l x size;try assumption. auto. omega. split. split. apply eqDom_disjoint_left with M1;assumption. reflexivity. split. apply leadsToBlk_MemUpd16_leadsToBlk with x M1;assumption. unfold MemUpd16 in * . destruct H1. exists x0. subst. apply (extensionality MemMod.A (option MemMod.B)). intro x1. unfold MemMod.merge. unfold MemMod.put. destruct (MemMod.beq_A x1 (l+1)). reflexivity. destruct (MemMod.beq_A x1 l). reflexivity. reflexivity. Qed. Implicit Arguments leadsToBlk_MemUpd16_Mono [l x size M1 M2 M M1']. Lemma leadsToBlk_MemUpd16_DMono : forall l x M1 M2 M M', MemMod.disjUnion M1 M2 M -> leadsToBlk l 2 M1 -> MemUpd16 M l x M' -> exists M1', MemMod.disjUnion M1' M2 M' /\ MemUpd16 M1 l x M1'. Proof. intros. destruct H1. exists (MemMod.put (MemMod.put M1 l x) (l+1) x0). split. destruct H. subst. split. apply MemMod.update_presv_disj_left. apply MemMod.update_presv_disj_left. assumption. unfold MemMod.in_dom. apply leadsTox_elim. replace l with (l+0). apply leadsToBlk_elim with 2. assumption. auto. auto. assert (MemMod.in_dom (l+1) M1). unfold MemMod.in_dom. apply leadsTox_elim. apply leadsToBlk_elim with 2. assumption. auto. destruct H1. exists x1. unfold MemMod.put. destruct (MemMod.beq_A (l+1) l). assert (l+1<>l). omega. elim H2;assumption. assumption. apply (extensionality MemMod.A (option MemMod.B)). intro x1. unfold MemMod.put. unfold MemMod.merge. destruct (MemMod.beq_A x1 (l+1)). reflexivity. destruct (MemMod.beq_A x1 l). reflexivity. reflexivity. exists x0. reflexivity. Qed. Implicit Arguments leadsToBlk_MemUpd16_DMono [l x M1 M2 M M']. Lemma leadsToBlk_MemUpd16_eqDom : forall l x M M', leadsToBlk l 2 M -> MemUpd16 M l x M' -> MemMod.eqDom M M'. Proof. intros. apply leadsToBlk_MemUpd16_eqDom2 with l l x 2; try assumption. auto. auto. omega. Qed. Implicit Arguments leadsToBlk_MemUpd16_eqDom [l x M M']. (*******************************************) (* unique *) (*******************************************) Lemma leadsTo_unique : forall addr x x' M, leadsTo addr x M -> leadsTo addr x' M -> x = x'. Proof. intros. assert (Hx := leadsTo_elim H0). rewrite (leadsTo_elim H) in Hx. injection Hx; trivial. Qed. Implicit Arguments leadsTo_unique [addr x x' M]. Lemma leadsToW_unique_disjUnion_l : forall addr x x' M1 M2 M, MemMod.disjUnion M1 M2 M -> leadsToW addr x M1 -> leadsToW addr x' M -> x = x'. Proof. intros. assert (Hx := leadsToW_elim H0). assert (Hx' := leadsToW_elim H1). destruct H. subst M. unfold MemMod.merge in Hx'. rewrite Hx in Hx'. injection Hx'; trivial. Qed. Implicit Arguments leadsToW_unique_disjUnion_l [addr x x' M1 M2 M]. (************************************************) (* stkSpace *) Lemma precise_stkSpacePrec : forall sp size, precise (stkSpacePrec sp size). Proof. unfold stkSpacePrec. unfold precise. intros sp size. intros. destruct H1; destruct H2. assert (Hx := @precise_ptoxBlk (sp - size) size). unfold precise in Hx. eapply Hx; eauto. Qed. Implicit Arguments precise_stkSpacePrec [sp size]. Lemma stkSpace_stkSpacePrec : forall sp size M, stkSpace sp size M -> mstar mTrue (stkSpacePrec sp size) M. Proof. intros. unfold stkSpacePrec. unfold stkSpace in H. unfold leadsToBlk in H. unfold imprecM in H. unfold mstar in * . InvertAll. exists x0;exists x. intuition. Qed. Implicit Arguments stkSpace_stkSpacePrec [sp size M]. Lemma stkSpacePrec_stkSpace : forall sp size M, stkSpacePrec sp size M -> stkSpace sp size M. Proof. intros. unfold stkSpace. unfold stkSpacePrec in H. destruct H. intuition. unfold leadsToBlk. unfold imprecM. unfold mstar. exists M;exists MemMod.emp. intuition. unfold mTrue;trivial. Qed. Implicit Arguments stkSpacePrec_stkSpace [sp size M]. Lemma stkSpace_weaken : forall M sp s1 s2, stkSpace sp s1 M -> s2 <= s1 -> stkSpace sp s2 M. Proof. unfold stkSpace. intros. destruct H. intuition. replace s2 with (s1 - (s1-s2)). replace (sp-(s1-(s1-s2)))with ((sp-s1)+(s1-s2)). apply leadsToBlk_shrink_low. assumption. omega. omega. omega. Qed. Implicit Arguments stkSpace_weaken [M sp s1 s2]. Lemma stkSpacePrec_split : forall sp s1 s2 M, stkSpacePrec sp (s1 + s2) M -> mstar (stkSpacePrec sp s2) (stkSpacePrec (sp-s2) s1) M. Proof. unfold stkSpacePrec. intros. destruct H. assert ((ptoxBlk (sp -(s1+s2)) s1 *^* ptoxBlk (sp-(s1+s2)+s1) s2 ) M). apply ptoxBlk_split;assumption. unfold mstar in H1;InvertAll. exists x0;exists x;intuition. arith_rep (sp-s2) with (sp-(s1+s2)+s1). arith_rep (sp-s2-s1) with (sp-(s1+s2)). Qed. Implicit Arguments stkSpacePrec_split [sp s1 s2 M]. Lemma stkSpacePrec_merge : forall sp s1 s2 M1 M2, stkSpacePrec sp s2 M1 -> stkSpacePrec (sp-s2) s1 M2 -> stkSpacePrec sp (s1 + s2) (MemMod.merge M1 M2). Proof. unfold stkSpacePrec. intros. InvertAll. intuition. apply ptoxBlk_merge. assert (MemMod.disjoint M2 M1). unfold MemMod.disjoint. unfold MemMod.not_in_dom. intros. destruct (le_lt_dec (sp-s2) x). left;apply ptoxBlk_notindom with (sp-s2-s1) s1. assumption. right;omega. right;apply ptoxBlk_notindom with (sp-s2) s2. assumption. left;assumption. exists M2;exists M1;intuition. arith_rep (sp-(s1+s2)) with (sp-s2-s1). arith_rep (sp-(s1+s2)+s1) with (sp-s2). Qed. Implicit Arguments stkSpacePrec_merge [sp s1 s2 M1 M2]. Lemma stkSpacePrec_downup : forall sp size d M, stkSpacePrec sp (size + d) M -> stkSpacePrec (sp - d + d) (size + d) M. Proof. unfold stkSpacePrec. intros. intuition. arith_rep (sp-d+d-(size+d)) with (sp-(size+d)). Qed. Implicit Arguments stkSpacePrec_downup [sp size d M]. Lemma stkSpacePrec_leadsToxW : forall M sp s l, stkSpacePrec sp s M -> s >= 2 -> l >= (sp - s) -> l <= sp - 2 -> leadsToxW l M. Proof. unfold stkSpacePrec. intros. destruct H. assert (MemMod.in_dom ((sp-s)+(l-(sp-s))) M). apply ptoxBlk_indom with s. assumption. omega. assert (MemMod.in_dom ((sp-s)+(l+1-(sp-s))) M). apply ptoxBlk_indom with s. assumption. omega. replace (sp-s+(l-(sp-s))) with l in H4. replace (sp-s+(l+1-(sp-s))) with (l+1) in H5. destruct H4. destruct H5. apply leadsToxW_intro with x x0;assumption. omega. omega. Qed. Lemma stkSpacePrec_leadsToBlk : forall M sp s, stkSpacePrec sp s M -> leadsToBlk (sp - s) s M. Proof. unfold stkSpacePrec. intros. unfold leadsToBlk. unfold imprecM. destruct H. exists M;exists MemMod.emp. split. auto with PMap. split. assumption. unfold mTrue. trivial. Qed. Lemma stkSpacePrec_ptoxBlk : forall M sp s, stkSpacePrec sp s M -> ptoxBlk (sp - s) s M. Proof. unfold stkSpacePrec. intros. destruct H. assumption. Qed. Lemma stkSpacePrec_MemUpd16_eqDom : forall M sp s l x M', stkSpacePrec sp s M -> s >= 2 -> l >= (sp - s) -> l <= sp - 2 -> MemUpd16 M l x M' -> MemMod.eqDom M M'. Proof. unfold stkSpacePrec. intros. destruct H. apply leadsToBlk_MemUpd16_eqDom2 with (sp-s) l x s;try assumption. unfold leadsToBlk. apply imprecM_weaker. assumption. omega. Qed. Lemma stkSpacePrec_stkSpacePrec_eqDom : forall M M' sp s, stkSpacePrec sp s M -> stkSpacePrec sp s M' -> MemMod.eqDom M M'. Proof. intros. unfold MemMod.eqDom. unfold MemMod.sub_dom. destruct H. destruct H0. split. intro. destruct (lt_ge_dec x (sp-s) sp). destruct s0. assert (M x = None). apply ptoxBlk_notindom with (sp-s) s. assumption. left;assumption. unfold MemMod.in_dom. intro. destruct H4. rewrite H3 in H4;discriminate H4. assert (MemMod.in_dom (sp-s+(x-(sp-s))) M'). apply ptoxBlk_indom with s. assumption. omega. replace (sp-s+(x-(sp-s))) with x in H3. intro;assumption. destruct a. apply le_plus_minus. omega. assert (M x = None). apply ptoxBlk_notindom with (sp-s) s. assumption. right. omega. unfold MemMod.in_dom. intro. destruct H4. rewrite H3 in H4;discriminate H4. intro. destruct (lt_ge_dec x (sp-s) sp). destruct s0. assert (M' x = None). apply ptoxBlk_notindom with (sp-s) s. assumption. left;assumption. unfold MemMod.in_dom. intro. destruct H4. rewrite H3 in H4;discriminate H4. assert (MemMod.in_dom (sp-s+(x-(sp-s))) M). apply ptoxBlk_indom with s. assumption. omega. replace (sp-s+(x-(sp-s))) with x in H3. intro;assumption. destruct a. apply le_plus_minus. omega. assert (M' x = None). apply ptoxBlk_notindom with (sp-s) s. assumption. right. omega. unfold MemMod.in_dom. intro. destruct H4. rewrite H3 in H4;discriminate H4. Qed. Lemma stkSpacePrec_MemUpd16_stkSpacePrec : forall M sp s l x M', stkSpacePrec sp s M -> s >= 2 -> l >= (sp - s) -> l <= sp - 2 -> MemUpd16 M l x M' -> stkSpacePrec sp s M'. Proof. intros. intuition. assert (MemMod.eqDom M M'). apply stkSpacePrec_MemUpd16_eqDom with sp s l x; try assumption. unfold stkSpacePrec in * . destruct H. intuition. apply ptoxBlk_intro. intros. split. intro. assert (MemMod.not_in_dom addr M'). apply MemMod.eqDom_notin_presv with M. assumption. unfold MemMod.not_in_dom. apply ptoxBlk_notindom with (sp-s) s. assumption. left;assumption. unfold MemMod.not_in_dom in H7;assumption. split. intros. destruct H4. apply H4. replace addr with ((sp-s)+(addr - (sp-s))). apply ptoxBlk_indom with s. assumption. destruct H6. clear H6. omega. destruct H6. omega. intro. assert (MemMod.not_in_dom addr M'). apply MemMod.eqDom_notin_presv with M. assumption. unfold MemMod.not_in_dom. apply ptoxBlk_notindom with (sp-s) s. assumption. right;assumption. unfold MemMod.not_in_dom in H7;assumption. Qed. Lemma stkSpace_Mono : forall sp size M1 M2 M, MemMod.disjUnion M1 M2 M -> stkSpace sp size M1 -> stkSpace sp size M. Proof. intros. unfold stkSpace in * . destruct H0;intuition. apply leadsToBlk_Mono with M1 M2;auto with PMap. Qed. Implicit Arguments stkSpace_Mono [sp size M1 M2 M]. Lemma stkSpace_Mono_r : forall sp size M1 M2 M, MemMod.disjUnion M1 M2 M -> stkSpace sp size M2 -> stkSpace sp size M. Proof. intros. unfold stkSpace in * . destruct H0;intuition. apply leadsToBlk_Mono with M2 M1;auto with PMap. Qed. Implicit Arguments stkSpace_Mono [sp size M1 M2 M]. (********************************************************) (* The two lemmas below are used in Itr_soundness file. *) Lemma leadsToxW_leadsToW_DMono : forall l v M1 M2 M, MemMod.disjUnion M1 M2 M -> leadsToxW l M1 -> leadsToW l v M -> leadsToW l v M1. Proof. intros. assert (H2:=leadsToxW_leadsToW H0). destruct H2. assert (x=v). apply leadsToW_unique_disjUnion_l with l M1 M2 M; assumption. rewrite <- H3;assumption. Qed. Implicit Arguments leadsToxW_leadsToW_DMono [l v M1 M2 M]. Lemma leadsToBlk_leadsToxW : forall l size M, leadsToBlk l size M -> size > 1 -> leadsToxW l M. Proof. intros. assert (leadsTox l M). replace l with (l+0). apply leadsToBlk_elim with size. assumption. omega. omega. assert (leadsTox (l+1) M). apply leadsToBlk_elim with size. assumption. auto. substH H1 with (leadsTox_elim H1). substH H2 with (leadsTox_elim H2). destruct H1;destruct H2. apply leadsToxW_intro with x x0;assumption. Qed. Implicit Arguments leadsToBlk_leadsToxW [l size M]. Unset Implicit Arguments. Lemma nat_eq_neq_dec: forall n n' : nat, n = n' \/ n <> n'. Proof. intros. destruct (eq_nat_dec n n'). left;assumption. right;assumption. Qed. Lemma mstar_presv_uniqueM: forall m1 m2, uniqueM m1 -> uniqueM m2 -> uniqueM (mstar m1 m2). Proof. intros. unfold uniqueM in *. intros. unfold mstar in *. InvertAll. assert (x = x1). apply H; auto. assert (x0 = x2). apply H0; auto. inversion_clear H3. inversion_clear H4. subst M M'. subst x x0. auto. Qed. Lemma pto_uniqueM: forall l v, uniqueM (l |-> v). Proof. unfold uniqueM. unfold pto. unfold MemMod.sgltonM. unfold MemMod.not_in_dom. intros. unfold MemMod.maps_to in *. InvertAll. apply MemMod.extensional_eqMap. intro. assert (x = l \/ x <> l). apply nat_eq_neq_dec. inversion H. subst x. rewrite H0. rewrite H1. auto. assert (M x = None). apply H3; auto. rewrite H5. assert (M' x = None). apply H2; auto. rewrite H6. auto. Qed. Lemma pto_precise: forall l v, precise (l |-> v). Proof. intros. unfold precise. intros. assert (uniqueM (l |-> v)). apply pto_uniqueM. unfold uniqueM in H3. apply H3; auto. Qed. coq/Assertion_Lemmas2.v0000644000107400000620000000756511000223177014601 0ustar shaosystemsRequire Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas3. Set Implicit Arguments. Unset Strict Implicit. Lemma ptoxW_indom: forall l h, ptoxW l h -> MemMod.in_dom l h /\ MemMod.in_dom (l+1) h. Proof. intros. assert (exists x, h ||- (ptoW l x)). eapply ptoxW_ptoW. apply H. destruct H0. eapply ptoW_indom. unfold mjudge in H0. apply H0. Qed. (* Lemma leadsToxW_indom : forall M l ,leadsToxW l M -> (MemMod.in_dom l M /\ MemMod.in_dom (l + 1) M). (** added by wang **) Proof. intros. destruct H as [M1 [M2 [Mdis [MH MH1]]]]. assert (MemMod.in_dom l M1 /\ MemMod.in_dom (l + 1) M1). eapply ptoxW_indom. apply MH. elim H. intros. destruct H0. destruct H1. split. eapply indom_disjUnion_indom_l. exists x. apply H0. apply Mdis. eapply indom_disjUnion_indom_l. exists x0. apply H1. apply Mdis. Qed. *) (* Lemma sub_pto_leadsToW: forall l m h1 h, ptoW l m h1 -> MemMod.subseteq h1 h -> leadsToW l m h. Proof. intros. substH H with (ptoW_leadsToW H). assert (H1 := leadsToW_elim H). substH H with (leadsToW_elim1 H). unfold MemMod.subseteq in H0. destruct H. unfold MemMod.in_dom in H0. assert (h l = Some m). rewrite <- H1. symmetry;apply H0;exists m;assumption. assert (h (l+1) = Some x ). rewrite <- H. symmetry;apply H0;exists x;assumption. apply leadsToW_intro with x;assumption. Qed. Lemma sub_pto_leadsToxW: forall l m h1 h, ptoW l m h1 -> MemMod.subseteq h1 h -> leadsToxW l h. Proof. intros l m h1 h pW subh. assert (MemMod.disjUnion h1 (MemMod.minus h h1) h). apply MemMod.minus_disjUnion; auto. unfold ptoW in pW. destruct pW as [M1 [M2 [djh [mM1 mM2]]]]. unfold leadsToxW. unfold imprecM, ptoxW. exists h1. exists (MemMod.minus h h1). unfold mTrue. split_l. split_r. exists M1. exists M2. split_l. split_r. unfold ptox. exists m; auto. Qed. Lemma ptox_ptoW: forall l h, ptoxW l h -> exists m, ptoW l m h. Proof. intros. destruct H as [M1 [M2 [Mdis [MH MH2]]]]. destruct MH. exists x. exists M1. exists M2. auto. Qed. *) Lemma ptoxW_MemUpd16_MonoL : forall l x M1 M2 M M', MemMod.disjUnion M1 M2 M -> ptoxW l M1 -> MemUpd16 M l x M' -> exists M1', MemMod.disjUnion M1' M2 M' /\ MemUpd16 M1 l x M1'. Proof. unfold MemUpd16. intros l x M1 M2 M M' djM ldxW mup. destruct mup as [x0 mup]. rewrite mup. exists (MemMod.put (MemMod.put M1 l x) (l + 1) x0). destruct (ptoxW_indom ldxW). split. apply MemMod.update_presv_disjUnion_left. apply MemMod.update_presv_disjUnion_left; auto. assert (MemMod.sub_dom M1 (MemMod.put M1 l x)). apply MemMod.subDom_update; auto. apply H1; auto. exists x0; auto. Qed. Lemma ptoxW_MemUpd16_MonoR : forall l x M1 M2 M M', MemMod.disjUnion M1 M2 M -> ptoxW l M2 -> MemUpd16 M l x M' -> exists M2', MemMod.disjUnion M1 M2' M' /\ MemUpd16 M2 l x M2'. Proof. unfold MemUpd16. intros l x M1 M2 M M' djM ldxW mup. destruct mup as [x0 mup]. rewrite mup. exists (MemMod.put (MemMod.put M2 l x) (l + 1) x0). destruct (ptoxW_indom ldxW). split. apply MemMod.update_presv_disjUnion_right. apply MemMod.update_presv_disjUnion_right; auto. assert (MemMod.sub_dom M2 (MemMod.put M2 l x)). apply MemMod.subDom_update; auto. apply H1; auto. exists x0; auto. Qed. Implicit Arguments ptoxW_MemUpd16_MonoL [l x M1 M2 M M']. Implicit Arguments ptoxW_MemUpd16_MonoR [l x M1 M2 M M']. (* requisite *) Lemma leadsToW_leadsToBlk: forall ax x h, (ax |~>w x) h -> leadsToBlk ax 2 h. Proof. intros. destruct H as [M1 [M2 [Mdis [MH MH1]]]]. exists M1. exists M2. split. auto. split. destruct MH as [M3 [M4 [Mdis1 [MH2 MH3]]]]. exists M3. exists M4. split. apply Mdis1. split. exists x. auto. exists M4. exists MemMod.emp. split. apply MemMod.unit_emp_disjUnion. split. auto. unfold ptoxBlk. unfold Aemp. reflexivity. auto. Qed. Hint Resolve mstar_assoc_left_right mstar_assoc_right_left. coq/Arith_Lemmas.v0000644000107400000620000000403611000223177013605 0ustar shaosystemsRequire Import Arith. Require Import Omega. Lemma minus_plus_commut: forall m n q, m >= n -> m - n + q = m + q - n. Proof. intros. assert (m = n + (m - n)). apply le_plus_minus; auto. rewrite H0. assert (n + (m - n) + q = n + ((m-n) + q)). omega. rewrite H1. assert (n + (m - n + q) - n = m - n + q). apply minus_plus. rewrite H2. assert (n + (m - n) - n = m - n). apply minus_plus. rewrite H3. auto. Qed. Hint Resolve minus_plus_commut. Lemma sp_P2_N2: forall sp, sp + 2 - 2 = sp. Proof. intro. assert (sp + 2 = 2 + sp). auto with arith. rewrite H. auto with arith. Qed. Hint Resolve sp_P2_N2. Lemma sp_P4_N2: forall sp, sp + 4 - 2 = sp + 2. Proof. intro sp. omega. Qed. Hint Resolve sp_P4_N2. Lemma sp_P2_P2: forall sp, sp + 2 + 2 = sp + 4. Proof. intro sp. omega. Qed. Hint Resolve sp_P2_P2. Lemma sp_P4_N2_N2: forall sp, sp + 4 - 2 - 2 = sp. Proof. intro sp. omega. Qed. Hint Resolve sp_P4_N2_N2. Lemma ge_trans: forall a b c, a >= b -> b >= c -> a >= c. Proof. intros. assert (c <= a). apply le_trans with b; auto with arith. auto with arith. Qed. Lemma sp_P4_P2: forall sp, sp + 4 + 2 = sp + 6. Proof. intro. omega. Qed. Hint Resolve sp_P4_P2. Lemma sp_P4_N6: forall sp, sp + 4 - 6 = sp - 2. Proof. intro sp. omega. Qed. Hint Resolve sp_P4_N6. Lemma sp_P6_N2: forall sp, sp + 6 - 2 = sp + 4. Proof. intro sp. omega. Qed. Hint Resolve sp_P6_N2. Lemma sp_N2_P2: forall sp, sp >= 2 -> sp - 2 + 2 = sp. Proof. intros. assert (sp - 2 + 2 = sp + 2 - 2). auto. rewrite H0. auto. Qed. Hint Resolve sp_N2_P2. Lemma sp_N2_P4: forall sp, sp >= 2 -> sp - 2 + 4 = sp + 2. Proof. intros. assert (sp - 2 + 4 = sp + 4 - 2). auto. assert (sp + 4 - 2 = sp + 2); auto. rewrite H1 in H0. rewrite H0. auto. Qed. Hint Resolve sp_N2_P4. Lemma sp_N2_P6: forall sp, sp >= 2 -> sp - 2 + 6 = sp + 4. Proof. intros. assert (sp - 2 + 6 = sp + 6 - 2). auto. rewrite H0. omega. Qed. Hint Resolve sp_N2_P6. Lemma sp_P2_P1: forall sp, sp + 2 + 1 = sp + 3. Proof. intro sp. omega. Qed. Hint Resolve sp_P2_P1. coq/Mem_Lemmas.v0000644000107400000620000003574511000223177013267 0ustar shaosystemsRequire Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Omega. Import MemMod. Set Implicit Arguments. Unset Strict Implicit. (* merge *) Lemma merge_sym : forall M1 M2, disjoint M1 M2 -> merge M1 M2 = merge M2 M1. Proof. unfold disjoint;unfold merge;unfold not_in_dom. intros;apply extensional_eqMap. intro;assert (M1 x = None \/ M2 x = None). auto. elim H0;intro;rewrite H1. case (M2 x);[trivial | trivial]. case (M1 x);[trivial | trivial]. Qed. Lemma merge_assoc : forall M1 M2 M3, merge (merge M1 M2) M3 = merge M1 (merge M2 M3). Proof. intros;unfold merge. apply extensional_eqMap. intro;case (M1 x);trivial. Qed. Lemma disjUnion_intro : forall M1 M2 M, (forall addr, match M1 addr, M2 addr, M addr with | Some x1, None, Some x2 => x1 = x2 | None, Some x1, Some x2 => x1 = x2 | None, None, None => True | _, _, _ => False end) -> MemMod.disjUnion M1 M2 M. Proof. intros M1 M2 M H. unfold disjUnion. unfold merge, disjoint. split. intros x. substH H with (H x). unfold not_in_dom. destruct (M1 x); destruct (M2 x); destruct (M x); tauto. apply extensional_eqMap. intros x. substH H with (H x). destruct (M1 x); destruct (M2 x); destruct (M x); auto; try contradiction. Qed. Lemma disjUnion_elim : forall M1 M2 M, MemMod.disjUnion M1 M2 M -> forall addr, match M1 addr, M2 addr, M addr with | Some x1, None, Some x2 => x1 = x2 | None, Some x1, Some x2 => x1 = x2 | None, None, None => True | _, _, _ => False end. Proof. intros M1 M2 M H. unfold disjUnion in H. unfold merge, disjoint in H. destruct H. subst M. unfold not_in_dom in H. intros l. substH H with (H l). destruct H. rewrite H. destruct (M2 l); trivial. rewrite H. destruct (M1 l); trivial. Qed. Lemma disjUnion_sym : forall M1 M2 M3, disjUnion M1 M2 M3 -> disjUnion M2 M1 M3. Proof. unfold disjUnion;unfold disjoint. intros. destruct H as [H H1]. split. intro. assert (not_in_dom x M1 \/ not_in_dom x M2). apply H. tauto. assert (merge M1 M2 = merge M2 M1). apply merge_sym. unfold disjoint;apply H. rewrite H1;apply H0. Qed. Lemma disjUnion_update_left : forall l v1 v2 M1 M2 M, M1 l = Some v1 -> disjUnion M1 M2 M -> disjUnion (put M1 l v2) M2 (put M l v2). Proof. intros l v1 v2 M1 M2 M H0 H1. substH H1 with (disjUnion_elim H1). apply disjUnion_intro. intros addr. substH H1 with (H1 addr). unfold put. destruct (beq_A addr l). subst l. destruct (M1 addr); destruct (M2 addr); destruct (M addr); trivial; try discriminate. destruct (M1 addr); destruct (M2 addr); destruct (M addr); trivial; try discriminate. Qed. Lemma disjUnion_assoc_left_right : forall M1 M2 M3 M4, disjUnion (merge M1 M2) M3 M4 -> disjoint M1 M2 -> disjUnion M1 (merge M2 M3) M4. Proof. intros;apply disjUnion_assoc_left_right;trivial. Qed. Lemma disjUnion_assoc_right_left : forall M1 M2 M3 M4, disjUnion M1 (merge M2 M3) M4 -> disjoint M2 M3 -> disjUnion (merge M1 M2) M3 M4. Proof. intros. apply disjUnion_assoc_right_left;trivial. Qed. Lemma disjoint_merge_intro_left : forall M1 M2 M3, disjoint M1 M3 -> disjoint M2 M3 -> disjoint (merge M1 M2) M3. Proof. unfold disjoint;unfold merge;unfold not_in_dom. intros. assert (M1 x = None \/ M3 x = None). trivial. elim H1;intro;rewrite H2;[trivial | right;trivial]. Qed. Lemma disjoint_merge_intro_right : forall M1 M2 M3, disjoint M1 M2 -> disjoint M1 M3 -> disjoint M1 (merge M2 M3). Proof. unfold disjoint;unfold merge;unfold not_in_dom. intros. assert (M1 x = None \/ M2 x = None). trivial. elim H1. intro;left;trivial. intro H2. assert (M1 x = None \/ M3 x = None). trivial. elim H3. intro;left;trivial. intro;right;rewrite H2;trivial. Qed. Lemma disjUnion_disjoint_left : forall M1 M2 M3 Mx My, disjUnion M1 Mx M3 -> disjUnion M3 M2 My -> disjoint M1 M2. Proof. unfold disjUnion;unfold disjoint;unfold not_in_dom. intros;destruct H as [H H1];destruct H0 as [H0 H2]. rewrite H1 in H0. assert (merge M1 Mx x = None \/ M2 x = None). trivial. elim H3. intros. left;unfold merge in H4. assert ((exists b , M1 x = Some b)\/ M1 x = None). case (M1 x);[intro;left;exists b;trivial | right;trivial]. elim H5. intro. destruct H6;rewrite H6 in H4;rewrite H4 in H6. assumption. trivial. intro;right;trivial. Qed. Lemma disjUnion_left_disjoint_left : forall M1 M2 M3 Mx, disjUnion M1 Mx M3 -> disjoint M3 M2 -> disjoint M1 M2. Proof. unfold disjUnion;unfold disjoint;unfold not_in_dom. intros. destruct H. assert (M3 x = None \/ M2 x = None). trivial. elim H2. rewrite H1;unfold merge. case (M1 x). intros;left;assumption. intro;left;trivial. intro;right;assumption. Qed. Lemma disjUnion_right_disjoint_left : forall M1 M2 M3 Mx, disjUnion Mx M1 M3 -> disjoint M3 M2 -> disjoint M1 M2. Proof. unfold disjUnion;unfold disjoint;unfold not_in_dom. intros. destruct H. assert (M3 x = None \/ M2 x = None). trivial. elim H2. rewrite H1;unfold merge. assert (Mx x = None \/ M1 x = None). trivial. elim H3. intro. rewrite H4;intro;left;assumption. intros;left;assumption. intros;right;assumption. Qed. Lemma disjUnion_right_disjoint_right : forall M1 M2 M3 Mx, disjUnion Mx M2 M3 -> disjoint M1 M3 -> disjoint M1 M2. Proof. unfold disjUnion;unfold disjoint;unfold not_in_dom. intros. destruct H. assert (M1 x = None \/ M3 x = None). trivial. elim H2. intro;left;assumption. assert (Mx x = None \/ M2 x = None). trivial. rewrite H1;unfold merge. elim H3. intro H4;rewrite H4;right;assumption. intros;right;assumption. Qed. Lemma disjUnion_left_disjoint_right : forall M1 M2 M3 Mx, disjUnion M2 Mx M3 -> disjoint M1 M3 -> disjoint M1 M2. Proof. unfold disjUnion;unfold disjoint;unfold not_in_dom. intros. assert (M1 x = None \/ M3 x = None);trivial. elim H1. intro;left;assumption. destruct H. rewrite H2;unfold merge. assert (M2 x = None \/ Mx x = None);trivial. elim H3. intros;right;assumption. intro;case (M2 x);intros;right;trivial. Qed. Lemma disjUnion_disjoint : forall M1 M2 M3, disjUnion M1 M2 M3 -> disjoint M1 M2. Proof. unfold disjUnion;intros;destruct H;trivial. Qed. Lemma disjoint_sym : forall M1 M2, disjoint M1 M2 -> disjoint M2 M1. Proof. unfold disjoint. intros. assert (not_in_dom x M1 \/ not_in_dom x M2);trivial. elim H0. intro;right;assumption. intro;left;assumption. Qed. Lemma eqDom_disjoint_left : forall M1 M2 M1', disjoint M1 M2 -> eqDom M1 M1' -> disjoint M1' M2. Proof. unfold disjoint;unfold eqDom;unfold sub_dom;unfold not_in_dom. intros. assert (M1 x = None \/ M2 x = None);trivial. destruct H0. elim H1. intro. left. assert (in_dom x M1 -> in_dom x M1');auto. assert (in_dom x M1' -> in_dom x M1);auto. unfold in_dom in H4;unfold in_dom in H5. induction (M1' x). assert (exists b : B,M1 x = Some b). apply H5. exists a. auto. inversion H6. rewrite H3 in H7. inversion H7. trivial. intro;right;assumption. Qed. Lemma eqDom_disjoint_right : forall M1 M2 M2', disjoint M1 M2 -> eqDom M2 M2' -> disjoint M1 M2'. Proof. unfold disjoint;unfold eqDom;unfold sub_dom;unfold not_in_dom. intros. assert (M1 x = None \/ M2 x = None);trivial. destruct H0. elim H1. intro. left. auto. assert (in_dom x M2 -> in_dom x M2');auto. assert (in_dom x M2' -> in_dom x M2);auto. unfold in_dom in H3;unfold in_dom in H4. intro. right. induction (M2' x). assert (exists b : B,M2 x = Some b). apply H4. exists a;auto. inversion H6. rewrite H5 in H7. inversion H7. trivial. Qed. Lemma disjUnion_merge : forall M1 M2 M3, MemMod.disjUnion M1 M2 M3 -> MemMod.merge M1 M2 = M3. Proof. unfold disjUnion;intros M1 M2 M3 H;destruct H as [disjH EQ];rewrite EQ;trivial. Qed. Ltac disjoint_trivial := match goal with | H : MemMod.disjoint ?M1 ?M2 |- MemMod.disjoint ?M1 ?M2 => exact H | H : MemMod.disjoint ?M2 ?M1 |- MemMod.disjoint ?M1 ?M2 => apply disjoint_sym; trivial | H : MemMod.disjUnion ?M1 ?M2 ?M3 |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_disjoint M1 M2 M3 H); trivial | H : MemMod.disjUnion ?M2 ?M1 ?M3 |- MemMod.disjoint ?M1 ?M2 => apply disjoint_sym; apply (@disjUnion_disjoint M2 M1 M3 H); trivial | _ => trivial end. Tactic Notation "disjoint" "trivial" := disjoint_trivial. Ltac disjoint_des := match goal with | |- MemMod.disjoint (MemMod.merge ?M1 ?M2) ?M3 => apply disjoint_merge_intro_left; disjoint_des | |- MemMod.disjoint ?M1 (MemMod.merge ?M2 ?M3) => apply disjoint_merge_intro_right; disjoint_des | |- MemMod.disjoint ?M1 ?M2 => disjoint_trivial | _ => idtac end. Tactic Notation "disjoint" "des" := disjoint_des. Ltac disjoint_lift_l := match goal with | H: MemMod.disjUnion ?M1 ?Mx ?M3 |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_left_disjoint_left M1 M2 M3 Mx H); disjoint_trivial | H: MemMod.disjUnion ?Mx ?M1 ?M3 |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_right_disjoint_left M1 M2 M3 Mx H); disjoint_trivial end. Tactic Notation "disjoint" "lift_l" := disjoint_lift_l. Ltac disjoint_lift_l_1 Mx := match goal with | H: MemMod.disjUnion ?M1 Mx ?M3 |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_left_disjoint_left M1 M2 M3 Mx H); disjoint_trivial | H: MemMod.disjUnion Mx ?M1 ?M3 |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_right_disjoint_left M1 M2 M3 Mx H); disjoint_trivial | |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_right_disjoint_left M1 M2 (MemMod.merge M1 Mx) Mx); disjoint_trivial end. Tactic Notation "disjoint" "lift_l" constr (Mx) := disjoint_lift_l_1 Mx. Ltac disjoint_lift_r := match goal with | H: MemMod.disjUnion ?M2 ?Mx ?M3 |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_left_disjoint_right M1 M2 M3 Mx H); disjoint_trivial | H: MemMod.disjUnion ?Mx ?M2 ?M3 |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_right_disjoint_right M1 M2 M3 Mx H); disjoint_trivial end. Tactic Notation "disjoint" "lift_r" := disjoint_lift_r. Ltac disjoint_lift_r_1 Mx := match goal with | H: MemMod.disjUnion ?M2 Mx ?M3 |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_left_disjoint_right M1 M2 M3 Mx H); disjoint_trivial | H: MemMod.disjUnion Mx ?M2 ?M3 |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_right_disjoint_right M1 M2 M3 Mx H); disjoint_trivial | |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_left_disjoint_right M1 M2 (MemMod.merge M2 Mx) Mx); disjoint_trivial end. Tactic Notation "disjoint" "lift_r" constr (Mx) := disjoint_lift_r_1 Mx. Tactic Notation "disjoint" "lift_lr" := disjoint_lift_l; disjoint_lift_r. Tactic Notation "disjoint" "lift_llr" := disjoint_lift_l; disjoint_lift_l; disjoint_lift_r. Tactic Notation "disjoint" "lift_lrr" := disjoint_lift_l; disjoint_lift_r; disjoint_lift_r. Ltac disjoint_replace_l M1 := match goal with | |- MemMod.disjoint ?M1' ?M2 => apply (@eqDom_disjoint_left M1 M2 M1'); [disjoint_trivial | trivial] end. Ltac disjoint_replace_r M2 := match goal with | |- MemMod.disjoint ?M1 ?M2' => apply (@eqDom_disjoint_right M1 M2 M2'); [disjoint_trivial | trivial] end. Tactic Notation "disjoint" "rep_l" constr (M1) := disjoint_replace_l M1. Tactic Notation "disjoint" "rep_r" constr (M2) := disjoint_replace_r M2. Ltac disjoint_solve_left := match goal with | H: MemMod.disjUnion ?M1 ?Mx ?M3, H1: MemMod.disjUnion ?M3 ?M2 ?My |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_disjoint_left M1 M2 M3 Mx My H H1); trivial | H: MemMod.disjUnion ?M1 ?Mx ?M3, H1: MemMod.disjUnion ?M2 ?M3 ?My |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_disjoint_left M1 M2 M3 Mx My H (@disjUnion_sym M2 M3 My H1)); disjoint_trivial | H: MemMod.disjUnion ?Mx ?M1 ?M3, H1: MemMod.disjUnion ?M3 ?M2 ?My |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_disjoint_left M1 M2 M3 Mx My (@disjUnion_sym Mx M1 M3 H) H1); disjoint_trivial | H: MemMod.disjUnion ?Mx ?M1 ?M3, H1: MemMod.disjUnion ?M2 ?M3 ?My |- MemMod.disjoint ?M1 ?M2 => apply (@disjUnion_disjoint_left M1 M2 M3 Mx My (@disjUnion_sym Mx M1 M3 H) (@disjUnion_sym M2 M3 My H1)); disjoint_trivial | _ => fail end. Ltac disjoint_solve := (disjoint_trivial; disjoint_solve_left) || (apply disjoint_sym; (disjoint_solve_left)). Tactic Notation "disjoint" "solve_left" := disjoint_solve_left. Tactic Notation "disjoint" "solve" := disjoint_solve. (******* merge ********) Ltac merge_rew H := match type of H with | MemMod.disjUnion ?M1 ?M2 ?Mx => match goal with | |- context [MemMod.merge M1 M2] => rewrite (disjUnion_merge H) end end. Ltac merge_rewH H H0 := match type of H with | MemMod.disjUnion ?M1 ?M2 ?Mx => match goal with | H0 : context [MemMod.merge M1 M2] |- _ => rewrite (disjUnion_merge H) in H0 end end. Tactic Notation "merge" "rewrite" hyp (Hx) := merge_rew Hx. Tactic Notation "merge" "rewrite" hyp (Hx) "in" hyp (H) := merge_rewH Hx H. Ltac merge_commut M1 := match goal with | |- context [MemMod.merge M1 ?M2] => rewrite (@merge_sym M1 M2); [idtac | try disjoint_solve] | |- context [MemMod.merge ?M2 M1] => rewrite (@merge_sym M2 M1); [idtac | try disjoint_solve] | _ => fail end. Tactic Notation "merge" "commut" constr (M1) := merge_commut M1. Ltac merge_assoc M1 := match goal with | |- context [MemMod.merge M1 (MemMod.merge ?M2 ?M3)] => rewrite <- (@merge_assoc M1 M2 M3) | |- context [MemMod.merge (MemMod.merge ?M2 ?M3) ?M1] => rewrite (@merge_assoc M2 M3 M1) | _ => fail end. Tactic Notation "merge" "assoc" constr (M1) := merge_assoc M1. (******* disjUnion ********) Ltac disjUnion_shift_r := match goal with | |- MemMod.disjUnion (MemMod.merge ?M1 ?M2) ?M3 ?M => apply (@disjUnion_assoc_right_left M1 M2 M3 M); [idtac | try disjoint_solve] | |- _ => fail end. Ltac disjUnion_shift_l := match goal with | |- MemMod.disjUnion ?M1 (MemMod.merge ?M2 ?M3) ?M => apply (@disjUnion_assoc_left_right M1 M2 M3 M); [idtac | try disjoint_solve] | |- _ => fail end. Tactic Notation "disjUnion" "shift_r" := disjUnion_shift_r. Tactic Notation "disjUnion" "shift_l" := disjUnion_shift_l. (* Ltac disjUnion_replace_l M1 := *) (* match goal with *) (* | |- MemMod.disjUnion ?M1' ?M2 ?M3 *) (* => apply (@eqDom_disjUnion_left M1 M2 M3 M1'); [trivial | trivial] *) (* end. *) (* Ltac disjUnion_replace_r M2 := *) (* match goal with *) (* | |- MemMod.disjUnion ?M1 ?M2' ?M3 *) (* => apply (@eqDom_disjUnion_right M1 M2 M3 M2'); [trivial | trivial] *) (* end. *) (* Tactic Notation "disjUnion" "rep_l" constr (M1) := disjUnion_replace_l M1. *) (* Tactic Notation "disjUnion" "rep_r" constr (M2) := disjUnion_replace_r M2. *) Unset Implicit Arguments. coq/Map.v0000644000107400000620000011447411000223177011765 0ustar shaosystemsRequire Import Coqlib. Hint Extern 4 (~( _ = _ )) => discriminate. Hint Extern 5 ({?X1 = ?X2} + {?X1 <> ?X2}) => generalize X1 X2; decide equality. Module Type MapSpec. Parameter domain : Set. Parameter image : Set. Parameter beq_Domain : forall (x y : domain), {x = y} + {x <> y}. End MapSpec. (* Partial Map *) Module MapFun(Spec : MapSpec). Set Implicit Arguments. Definition A : Set := Spec.domain. Definition B : Set := Spec.image. Definition beq_A := Spec.beq_Domain. (* partial map *) Definition Map := A -> option B. (* empty map *) Definition emp : Map := fun a : A => None. (* map extension *) Definition put : Map -> A -> B -> Map := fun M a b => fun x => if (beq_A x a) then (Some b) else M x. Definition remove : Map -> A -> Map := fun M a => fun x => if (beq_A x a) then None else M x. Definition maps_to : Map -> A -> B -> Prop := fun M a b => M a = Some b. Definition in_dom : A -> Map -> Prop := fun a M => exists b : B, M a = Some b. Definition not_in_dom : A -> Map -> Prop := fun a M => M a = None. (* map that has only one element in the domain *) Definition sgltonM : Map -> A -> B -> Prop := fun M a b => maps_to M a b /\ (forall (x : A), x <> a -> not_in_dom x M). Definition sub_dom : Map -> Map -> Prop := fun M M' => forall (x : A), in_dom x M -> in_dom x M'. Definition eqDom : Map -> Map -> Prop := fun M M' => sub_dom M M' /\ sub_dom M' M. Definition merge : Map -> Map -> Map := fun M1 M2 => fun x => match M1 x with None => M2 x | _ => M1 x end. Definition disjoint : Map -> Map -> Prop := fun M1 M2 => forall (x : A), not_in_dom x M1 \/ not_in_dom x M2. Definition disjUnion : Map -> Map -> Map -> Prop := fun M' M'' M => disjoint M' M'' /\ (M = merge M' M''). Definition subseteq : Map -> Map -> Prop := fun M1 M2 => forall (x : A), in_dom x M1 -> M1 x = M2 x. Definition compat : Map -> Map -> Prop := fun M1 M2 => forall (x : A) (y : B), maps_to M1 x y -> not_in_dom x M2 \/ maps_to M2 x y. (* extensional equality about Maps *) Definition extensional_eqMap := extensionality A (option B). Lemma eq_get : forall (M M' : Map) (x : A), M = M' -> M x = M' x. Proof. intros; subst; trivial. Qed. (* ****************************** *) (* properties about map extension *) (* ****************************** *) Lemma put_get_eq : forall (M : Map) (x: A) (y : B), (put M x y) x = Some y. Proof. intros. unfold put. case (beq_A x x). auto. intro. assert (x=x). auto. contradiction. Qed. Lemma put_noninterfere: forall (M : Map) (x x' : A) (y : B), x <> x' -> (put M x y) x' = M x'. Proof. intros M x x' y x_neq. unfold put. case (beq_A x' x). intro. assert (x = x'). symmetry. auto. contradiction. auto. Qed. Hint Resolve put_get_eq put_noninterfere: PMap. Lemma put_unique : forall (M : Map) (x : A) (y y' : B), put M x y = put M x y' -> y = y'. Proof. intros. assert (H': put M x y x = put M x y' x). rewrite H; trivial. rewrite put_get_eq in H'. rewrite put_get_eq in H'. injection H'; trivial. Qed. (* ****************************** *) (* properties about remove *) (* ****************************** *) Lemma remove_shrinks_dom: forall (M : Map) (x : A), forall (y : A), not_in_dom y M -> not_in_dom y (remove M x). Proof. intros. unfold not_in_dom. unfold remove. induction (beq_A y x). auto. unfold not_in_dom in H. auto. Qed. Lemma nid_remove: forall (M : Map) (x : A), not_in_dom x (remove M x). Proof. intros M x. unfold remove. unfold not_in_dom. induction (beq_A x x). auto. assert (x = x); auto. contradiction. Qed. Hint Resolve remove_shrinks_dom nid_remove : PMap. Lemma remove_nothing: forall (M : Map) (x : A), not_in_dom x M -> M = (remove M x). Proof. intros. apply extensional_eqMap. intros. unfold remove. induction (beq_A x0 x). unfold not_in_dom in H. rewrite <- a in H. auto. auto. Qed. Lemma remove_cancel_put: forall (M : Map) (x : A) (y : B), remove (put M x y) x = remove M x. Proof. intros. apply extensional_eqMap. intros. unfold remove. induction (beq_A x0 x). auto. unfold put. induction (beq_A x0 x). contradiction. auto. Qed. Lemma put_cancel_remove: forall (M : Map) (x : A) (y : B), put (remove M x) x y = put M x y. Proof. intros M x y. apply extensional_eqMap. intro x0. unfold put. unfold remove. induction (beq_A x0 x); auto. Qed. Lemma remove_ext_ext_remove: forall (M : Map) (x x' : A) (y : B), x <> x' -> remove (put M x y) x' = put (remove M x') x y. Proof. intros. apply extensional_eqMap. intros. unfold put. unfold remove. induction (beq_A x0 x). induction (beq_A x0 x'). rewrite a in a0. contradiction. auto. induction (beq_A x0 x'). auto. auto. Qed. Hint Resolve remove_nothing remove_cancel_put put_cancel_remove remove_ext_ext_remove : PMap. (******************************************) (* properties about in_dom and not_in_dom *) (******************************************) Lemma in_not_notin : forall (x : A) (M : Map), in_dom x M -> ~ (not_in_dom x M). Proof. intros. intro. unfold in_dom in H. unfold not_in_dom in H0. inversion_clear H. rewrite H0 in H1. inversion_clear H1. Qed. Lemma notin_not_in: forall (x : A) (M : Map), not_in_dom x M -> ~ (in_dom x M). Proof. intros. intro. unfold in_dom in H0. unfold not_in_dom in H. inversion_clear H0. rewrite H in H1. inversion_clear H1. Qed. Lemma not_in_notin: forall (x : A) (M : Map), ~ in_dom x M -> not_in_dom x M. Proof. intros. unfold not_in_dom. unfold in_dom in H. induction (M x). assert (exists b : B, Some a = Some b). exists a; auto. contradiction. auto. Qed. Lemma not_notin_in: forall (x : A) (M : Map), ~ not_in_dom x M -> in_dom x M. Proof. intros. unfold in_dom. unfold not_in_dom in H. induction (M x). exists a. auto. elim H. auto. Qed. Lemma in_or_notin: forall x M, in_dom x M \/ not_in_dom x M. Proof. intros x M. unfold in_dom. unfold not_in_dom. elim (M x). left. exists a. auto. right. auto. Qed. Hint Resolve in_not_notin notin_not_in not_in_notin not_notin_in in_or_notin : PMap. (* properties about disjoint *) Lemma disjoint_commut: forall M1 M2, disjoint M1 M2 -> disjoint M2 M1. Proof. intros M1 M2. unfold disjoint. intros. assert (not_in_dom x M1 \/ not_in_dom x M2); auto. inversion_clear H0. right; auto. left; auto. Qed. Hint Resolve disjoint_commut : PMap. Lemma putA_presv_nidB : forall M x x' y, not_in_dom x M -> x<>x' -> not_in_dom x (put M x' y). Proof. intros. unfold not_in_dom. unfold put. induction (beq_A x x'); auto. contradiction. Qed. Lemma extend_presv_disj_left: forall (M1 M2 : Map) (x : A) (y : B), disjoint M1 M2 -> not_in_dom x M2 -> disjoint (put M1 x y) M2. Proof. intros. unfold disjoint. unfold not_in_dom in H0. unfold disjoint in H. intro. assert (not_in_dom x0 M1 \/ not_in_dom x0 M2). apply H. inversion_clear H1. unfold put. unfold not_in_dom. induction (beq_A x0 x). right. rewrite a. auto. left. unfold not_in_dom in H2. auto. right. auto. Qed. Hint Resolve extend_presv_disj_left putA_presv_nidB : PMap. Lemma extend_presv_disj_right: forall (M1 M2 : Map) (x : A) (y : B), disjoint M1 M2 -> not_in_dom x M1 -> disjoint M1 (put M2 x y). Proof. intros. apply disjoint_commut. assert (disjoint M2 M1). auto with PMap. auto with PMap. Qed. Hint Resolve extend_presv_disj_right : PMap. (* ******************************** *) (* Disjoint and in_dom / not_in_dom *) (* ******************************** *) Lemma disj_exclusive_left : forall (x : A) (M M' : Map), disjoint M M' -> in_dom x M -> not_in_dom x M'. Proof. intros. unfold disjoint in H. assert (not_in_dom x M \/ not_in_dom x M'). auto. inversion_clear H1. assert (~ in_dom x M); auto with PMap. auto. Qed. Hint Resolve disj_exclusive_left : PMap. Lemma disj_exclusive_right : forall (x : A) (M M' : Map), disjoint M M' -> in_dom x M' -> not_in_dom x M. Proof. intros. assert (disjoint M' M); auto with PMap. apply disj_exclusive_left with M'; auto. Qed. Hint Resolve disj_exclusive_right : PMap. Lemma update_presv_disj_left: forall (M1 M2 : Map) (x : A) (y : B), disjoint M1 M2 -> in_dom x M1 -> disjoint (put M1 x y) M2. Proof. intros. assert (not_in_dom x M2). apply disj_exclusive_left with M1; auto. auto with PMap. Qed. Hint Resolve update_presv_disj_left : PMap. Lemma update_presv_disj_right: forall (M1 M2 : Map) (x : A) (y : B), disjoint M1 M2 -> in_dom x M2 -> disjoint M1 (put M2 x y). Proof. intros. apply disjoint_commut. assert (disjoint M2 M1); auto with PMap. Qed. Hint Resolve update_presv_disj_right : PMap. Lemma remove_presv_disj_left: forall (M1 M2 : Map) (x : A), disjoint M1 M2 -> disjoint (remove M1 x) M2. Proof. intros. unfold disjoint. unfold disjoint in H. intro. assert (not_in_dom x0 M1 \/ not_in_dom x0 M2). apply H. inversion_clear H0. left. auto with PMap. right. auto. Qed. Hint Resolve remove_presv_disj_left : PMap. Lemma remove_presv_disj_right: forall (M1 M2 : Map) (x : A), disjoint M1 M2 -> disjoint (remove M1 x) M2. Proof. intros. apply disjoint_commut. assert (disjoint M2 M1); auto with PMap. Qed. Hint Resolve remove_presv_disj_right : PMap. (* ******************************** *) (* Merge and in_dom / not_in_dom *) (* ******************************** *) Lemma notin_merge_distr_left : forall (M1 M2 : Map) (x : A), not_in_dom x (merge M1 M2) -> not_in_dom x M1. Proof. intros M1 M2 x. unfold not_in_dom. unfold merge. elim (M1 x); auto. Qed. Hint Resolve notin_merge_distr_left: PMap. Lemma notin_merge_distr_right : forall (M1 M2 : Map) (x : A), not_in_dom x (merge M1 M2) -> not_in_dom x M2. Proof. intros M1 M2 x. unfold not_in_dom. unfold merge. elim (M1 x). intros. inversion_clear H. auto. Qed. Hint Resolve notin_merge_distr_right: PMap. Lemma merge_presv_indom_left: forall (M1 M2: Map) (x: A), in_dom x M1 -> in_dom x (merge M1 M2). Proof. intros M1 M2 x. unfold in_dom. unfold merge. intro. inversion_clear H. exists x0. rewrite H0. auto. Qed. Lemma merge_presv_indom_right: forall (M1 M2: Map) (x: A), in_dom x M2 -> in_dom x (merge M1 M2). Proof. intros. unfold in_dom. unfold in_dom in H. unfold merge. assert ((exists y, M1 x = Some y) \/ (M1 x = None)). induction (M1 x). left. exists a. auto. right. auto. inversion_clear H0. inversion_clear H1. exists x0. rewrite H0. auto. inversion_clear H. exists x0. rewrite H1. auto. Qed. Hint Resolve merge_presv_indom_left merge_presv_indom_right : PMap. Lemma in_merge_left_or_right: forall (M1 M2: Map) (x: A), in_dom x (merge M1 M2) -> in_dom x M1 \/ in_dom x M2. Proof. intros. unfold in_dom in H. unfold merge in H. unfold in_dom. induction (M1 x). left. auto. right. auto. Qed. Hint Resolve in_merge_left_or_right : PMap. Lemma in_merge_not_left_in_right: forall (M1 M2: Map) (x: A), in_dom x (merge M1 M2) -> not_in_dom x M1 -> in_dom x M2. Proof. intros. assert (in_dom x M1 \/ in_dom x M2); auto with PMap. inversion_clear H1. assert (~ in_dom x M1). auto with PMap. contradiction. auto. Qed. Hint Resolve in_merge_not_left_in_right: PMap. Lemma in_merge_not_right_in_left: forall (M1 M2: Map) (x: A), in_dom x (merge M1 M2) -> not_in_dom x M2 -> in_dom x M1. Proof. intros. assert (in_dom x M1 \/ in_dom x M2); auto with PMap. inversion_clear H1; auto. assert (~ in_dom x M2). auto with PMap. contradiction. Qed. Hint Resolve in_merge_not_right_in_left: PMap. Lemma in_merge_commut: forall (M1 M2: Map) (x: A), in_dom x (merge M1 M2) -> in_dom x (merge M2 M1). Proof. intros. assert (in_dom x M1 \/ in_dom x M2); auto with PMap. inversion_clear H0; auto with PMap. Qed. Hint Resolve in_merge_commut : PMap. Lemma not_in_merge_commut: forall (M1 M2: Map) (x: A), not_in_dom x (merge M1 M2) -> not_in_dom x (merge M2 M1). Proof. intros. assert (in_dom x (merge M2 M1) \/ not_in_dom x (merge M2 M1)); auto with PMap. inversion_clear H0; auto. assert (in_dom x (merge M1 M2)); auto with PMap. assert (~ (in_dom x (merge M1 M2))); auto with PMap. Qed. Hint Resolve not_in_merge_commut : PMap. Lemma notin_left_notin_right_notin_merge: forall (M1 M2 : Map) (x : A), not_in_dom x M1 -> not_in_dom x M2 -> not_in_dom x (merge M1 M2). Proof. intros. assert (in_dom x (merge M1 M2) \/ not_in_dom x (merge M1 M2)); auto with PMap. inversion_clear H1; auto. assert (in_dom x M1 \/ in_dom x M2); auto with PMap. inversion_clear H1. assert (~ (in_dom x M1)); auto with PMap. assert (~ (in_dom x M2)); auto with PMap. Qed. Hint Resolve notin_left_notin_right_notin_merge : PMap. (* *************************************** *) (* merge and subseteq *) (* *************************************** *) Lemma merge_extends_map: forall (M1 M2 : Map), subseteq M1 (merge M1 M2). Proof. intros. unfold subseteq. unfold merge. intros. unfold in_dom in H. inversion H. rewrite H0. auto. Qed. Hint Resolve merge_extends_map : PMap. (* ********************* *) (* Propeties about merge *) (* ********************* *) Lemma merge_assoc: forall M1 M2 M3, merge (merge M1 M2) M3 = merge M1 (merge M2 M3). Proof. intros M1 M2 M3. apply extensional_eqMap. intro. unfold merge. elim (M1 x). auto. elim (M2 x); auto. Qed. Hint Resolve merge_assoc : PMap. Lemma in_left_in_merge: forall M1 M2 x y, maps_to M1 x y -> maps_to (merge M1 M2) x y. Proof. unfold maps_to. intros. unfold merge. rewrite H. auto. Qed. Hint Resolve in_left_in_merge. Lemma in_right_in_merge : forall M1 M2 x y, not_in_dom x M1 -> maps_to M2 x y -> maps_to (merge M1 M2) x y. Proof. unfold maps_to. unfold merge. unfold not_in_dom. intros. rewrite H. auto. Qed. Hint Resolve in_right_in_merge. Lemma put_merge_merge_put: forall (M1 M2 : Map) (x : A) (y : B), put (merge M1 M2) x y = merge (put M1 x y) M2. Proof. intros M1 M2 x y. apply extensional_eqMap. intro. unfold put. unfold merge. induction (beq_A x0 x). auto. induction (M1 x0); auto. Qed. Hint Resolve put_merge_merge_put : PMap. Lemma remove_merge_merge_remove_right: forall (M1 M2 : Map) (x : A), not_in_dom x M1 -> remove (merge M1 M2) x = merge M1 (remove M2 x). Proof. intros. apply extensional_eqMap. intro. unfold remove. unfold merge. induction (beq_A x0 x). rewrite <- a in H. unfold not_in_dom in H. rewrite H. auto. induction (M1 x0); auto. Qed. Lemma disj_remove_merge_merge_remove : forall (M1 M2 : Map) (x : A), disjoint M1 M2 -> in_dom x M1 -> remove (merge M1 M2) x = merge (remove M1 x) M2. Proof. intros. assert (not_in_dom x M2). apply disj_exclusive_left with M1; auto. apply extensional_eqMap. intro. unfold remove. unfold merge. induction (beq_A x0 x). rewrite a. unfold not_in_dom in H1. auto. auto. Qed. Hint Resolve remove_merge_merge_remove_right disj_remove_merge_merge_remove : PMap. (* *************************************** *) (* Properties about disjoint and merge *) (* *************************************** *) Lemma disj_merge_disj_left: forall M1 M2 M' : Map, disjoint (merge M1 M2) M' -> disjoint M1 M'. Proof. intros M1 M2 M'. unfold disjoint. intros. assert (not_in_dom x (merge M1 M2) \/ not_in_dom x M'); auto. inversion_clear H0. left. apply notin_merge_distr_left with M2; auto. right. auto. Qed. Hint Resolve disj_merge_disj_left: PMap. Lemma disj_merge_disj_right: forall M1 M2 M' : Map, disjoint (merge M1 M2) M' -> disjoint M2 M'. Proof. intros M1 M2 M'. unfold disjoint. intros. assert (not_in_dom x (merge M1 M2) \/ not_in_dom x M'); auto. inversion_clear H0. left. apply notin_merge_distr_right with M1; auto. right. auto. Qed. Hint Resolve disj_merge_disj_right: PMap. Lemma disj_x_merge_disj_left: forall M1 M2 M' : Map, disjoint M' (merge M1 M2) -> disjoint M' M1. Proof. intros. assert (disjoint (merge M1 M2) M'). auto with PMap. assert (disjoint M1 M'); auto with PMap. apply disj_merge_disj_left with M2. auto. Qed. Lemma disj_x_merge_disj_right: forall M1 M2 M' : Map, disjoint M' (merge M1 M2) -> disjoint M' M2. Proof. intros. assert (disjoint (merge M1 M2) M'). auto with PMap. assert (disjoint M2 M'); auto with PMap. apply disj_merge_disj_right with M1. auto. Qed. Hint Resolve disj_x_merge_disj_left disj_x_merge_disj_right: PMap. Lemma disj_merge_commut : forall M1 M2 : Map, disjoint M1 M2 -> (merge M1 M2) = (merge M2 M1). Proof. intros M1 M2 disj. apply extensional_eqMap. intro. unfold merge. unfold disjoint in disj. unfold not_in_dom in disj. assert (M1 x = None \/ M2 x = None); auto. inversion H. rewrite H0. elim (M2 x); auto. rewrite H0. elim (M1 x); auto. Qed. Hint Resolve disj_merge_commut : PMap. Lemma disj_merge_disjUnion: forall M1 M2 : Map, disjoint M1 M2 -> disjUnion M1 M2 (merge M1 M2). Proof. intros M1 M2 disj. unfold disjUnion. split; auto. Qed. Hint Resolve disj_merge_disjUnion : PMap. Lemma disj_merge_A: forall M1 M2 M3, disjoint M1 M2 -> disjoint M1 M3 -> disjoint M1 (merge M2 M3). Proof. intros M1 M2 M3. unfold disjoint. intros disj1 disj2. intro. assert (not_in_dom x M1 \/ not_in_dom x M2); auto. assert (not_in_dom x M1 \/ not_in_dom x M3); auto. inversion_clear H. left; auto. inversion_clear H0. left; auto. right. unfold not_in_dom in * |- * . unfold merge. rewrite H1. auto. Qed. Hint Resolve disj_merge_A : PMap. Lemma disj_merge_B: forall M1 M2 M3, disjoint M2 M1 -> disjoint M3 M1 -> disjoint (merge M2 M3) M1. Proof. intros. assert (disjoint M1 (merge M2 M3)); auto with PMap. Qed. Hint Resolve disj_merge_B : PMap. Lemma disj_merge_assoc_left_right: forall M1 M2 M3, disjoint M1 M2 -> disjoint (merge M1 M2) M3 -> disjoint M1 (merge M2 M3). Proof. intros M1 M2 M3 disj1 disj2. assert (disjoint M1 M3). apply disj_merge_disj_left with M2. auto. apply disj_merge_A; auto. Qed. Lemma disj_merge_assoc_right_left: forall M1 M2 M3, disjoint M2 M3 -> disjoint M1 (merge M2 M3) -> disjoint (merge M1 M2) M3. Proof. intros M1 M2 M3 disj1 disj2. assert (disjoint M1 M3). apply disj_x_merge_disj_right with M2. auto. assert (disjoint M3 (merge M1 M2)); auto with PMap. Qed. Lemma disj_merge_ABC_BAC: forall M1 M2 M3, disjoint M1 M2 -> merge (merge M1 M2) M3 = merge M2 (merge M1 M3). Proof. intros M1 M2 M3 disj. assert (merge M1 M2 = merge M2 M1). apply disj_merge_commut. auto. rewrite H. apply merge_assoc. Qed. Hint Resolve disj_merge_assoc_left_right disj_merge_assoc_right_left disj_merge_ABC_BAC : PMap. Lemma disj_merge_ABC_CAB: forall (M_1 M_2 M_3 : Map), disjoint M_1 M_2 -> disjoint M_3 M_1 -> disjoint M_3 M_2 -> (merge (merge M_1 M_2) M_3) = (merge (merge M_3 M_1) M_2). Proof. intros. assert (merge M_1 M_2 = merge M_2 M_1). auto with PMap. rewrite H2. assert (merge M_3 M_1 = merge M_1 M_3). auto with PMap. rewrite H3. assert ((merge (merge M_1 M_3) M_2) = (merge M_2 (merge M_1 M_3))); auto with PMap. rewrite H4. auto with PMap. Qed. Hint Resolve disj_merge_ABC_CAB : PMap. (* Properties about disjUnion and merge *) Lemma disj_emp : forall M, disjoint M emp. Proof. unfold disjoint. intros. right. unfold not_in_dom. unfold emp. auto. Qed. Lemma disj_emp_B : forall M, disjoint emp M. Proof. intro. assert (disjoint M emp). apply disj_emp. auto with PMap. Qed. Lemma unit_emp_merge: forall M, merge M emp = M. Proof. intro M. apply extensional_eqMap. intros. unfold merge. induction (M x). auto. unfold emp. auto. Qed. Hint Resolve disj_emp disj_emp_B unit_emp_merge : PMap. Lemma unit_emp_merge_B : forall M, merge emp M = M. Proof. intros. assert (merge emp M = merge M emp). auto with PMap. rewrite H. auto with PMap. Qed. Hint Resolve unit_emp_merge_B : PMap. Lemma unit_emp_disjUnion: forall M, disjUnion M emp M. Proof. intro. unfold disjUnion. split; auto with PMap. Qed. Hint Resolve unit_emp_disjUnion : PMap. Lemma emp_disjUnion_unique: forall M M', disjUnion M emp M' -> M = M'. Proof. intros. unfold disjUnion in H. inversion_clear H. assert (merge M emp = M); auto with PMap. rewrite H in H1. auto. Qed. Hint Resolve emp_disjUnion_unique : PMap. Lemma disjUnion_commut : forall M1 M2 M, disjUnion M1 M2 M -> disjUnion M2 M1 M. Proof. unfold disjUnion. intros. inversion_clear H. split. apply disjoint_commut. auto. assert (merge M1 M2 = merge M2 M1). apply disj_merge_commut. auto. rewrite <- H; auto. Qed. Hint Resolve disjUnion_commut : PMap. Lemma disjUnion_in_left: forall (M1 M2 M : Map) (x : A) (y : B), disjUnion M1 M2 M -> in_dom x M1 -> maps_to M x y -> maps_to M1 x y. Proof. intros. unfold disjUnion in H. inversion_clear H. assert (not_in_dom x M2). apply disj_exclusive_left with M1; auto. rewrite H3 in H1. unfold not_in_dom in H. unfold maps_to. unfold maps_to in H1. unfold merge in H1. rewrite H in H1. induction (M1 x). auto. inversion_clear H1. Qed. Lemma disjUnion_in_right: forall (M1 M2 M : Map) (x : A) (y : B), disjUnion M1 M2 M -> in_dom x M2 -> maps_to M x y -> maps_to M2 x y. Proof. intros. apply disjUnion_in_left with M1 M; auto with PMap. Qed. Hint Resolve disjUnion_in_left disjUnion_in_right: PMap. Lemma disjUnion_assoc_left_right: forall M1 M2 M3 M, disjoint M1 M2 -> disjUnion (merge M1 M2) M3 M -> disjUnion M1 (merge M2 M3) M. Proof. unfold disjUnion. intros. inversion_clear H0. split. auto with PMap. rewrite H2. auto with PMap. Qed. Hint Resolve disjUnion_assoc_left_right: PMap. Lemma disjUnion_assoc_right_left: forall M1 M2 M3 M, disjoint M2 M3 -> disjUnion M1 (merge M2 M3) M -> disjUnion (merge M1 M2) M3 M. Proof. unfold disjUnion. intros. inversion_clear H0. split; auto with PMap. rewrite H2. auto with PMap. Qed. Hint Resolve disjUnion_assoc_right_left: PMap. Lemma disj_merge_unique : forall M1 M2 M3 M4, disjoint M1 M2 -> disjoint M3 M4 -> merge M1 M2 = merge M3 M4 -> M1 = M3 -> M2 = M4. Proof. intros M1 M2 M3 M4 disj1 disj2. intro eqMerge. intro eq13. rewrite eq13 in eqMerge. apply extensional_eqMap. intro. assert (merge M3 M2 x = merge M3 M4 x). rewrite <- eqMerge. auto. unfold merge in H. assert (in_dom x M3 \/ not_in_dom x M3). apply in_or_notin. inversion_clear H0. rewrite eq13 in disj1. unfold disjoint in disj1. unfold disjoint in disj2. assert (not_in_dom x M3 \/ not_in_dom x M4); auto. assert (not_in_dom x M3 \/ not_in_dom x M2); auto. inversion_clear H0. unfold not_in_dom in H3. unfold in_dom in H1. inversion_clear H1. rewrite H3 in H0. inversion_clear H0. inversion_clear H2. unfold not_in_dom in H0. unfold in_dom in H1. inversion_clear H1. rewrite H0 in H2. inversion_clear H2. unfold not_in_dom in H3. unfold not_in_dom in H0. rewrite <- H3 in H0. auto. unfold not_in_dom in H1. rewrite H1 in H. auto. Qed. Hint Resolve disj_merge_unique : PMap. Lemma disj_merge_unique_right : forall M1 M2 M3 M4, disjoint M1 M2 -> disjoint M3 M4 -> merge M1 M2 = merge M3 M4 -> M2 = M4 -> M1 = M3. Proof. intros. assert (disjoint M2 M1). auto with PMap. assert (disjoint M4 M3). auto with PMap. assert (merge M1 M2 = merge M2 M1); auto with PMap. assert (merge M3 M4 = merge M4 M3); auto with PMap. rewrite H5 in H1. rewrite H6 in H1. apply disj_merge_unique with M2 M4; auto. Qed. Lemma disjUnion_unique: forall M1 M2 M3 M4 M5, disjUnion M1 M2 M5 -> disjUnion M3 M4 M5 -> M1 = M3 -> M2 = M4. Proof. intros. unfold disjUnion in H. unfold disjUnion in H0. inversion_clear H. inversion_clear H0. rewrite H3 in H4. apply disj_merge_unique with M1 M3; auto. Qed. Lemma disjUnion_equ: forall M1 M2 M3 M4 M5, disjUnion M1 M3 M4 -> disjUnion M2 M3 M5 -> M1 = M2 -> M4 = M5. Proof. intros. unfold disjUnion in H. unfold disjUnion in H0. inversion_clear H. inversion_clear H0. rewrite H1 in H3. rewrite H3. rewrite H4. auto. Qed. Hint Resolve disj_merge_unique_right disjUnion_unique disjUnion_equ: PMap. Lemma disjUnion_reshuffle: forall M M1 M2 M1' M2' M11, disjUnion M1 M2 M -> disjUnion M1' M2' M -> disjUnion M11 M2' M1 -> disjUnion M11 M2 M1'. Proof. intros. unfold disjUnion in H. unfold disjUnion in H0. unfold disjUnion in H1. InvertAll. assert (disjoint M11 M2). rewrite H3 in H0. apply disj_merge_disj_left with M2'; auto. assert (disjoint M2' M2). rewrite H3 in H0. apply disj_merge_disj_right with M11; auto. unfold disjUnion. split; auto. rewrite H3 in H5. assert (merge (merge M11 M2') M2 = merge (merge M2 M11) M2'). auto with PMap. rewrite H7 in H5. rewrite H5 in H4. assert (merge M11 M2 = merge M2 M11). auto with PMap. rewrite H8. cut (merge M2 M11 = M1'). auto. apply disj_merge_unique_right with M2' M2'; auto. assert (disjoint M2' M2). auto with PMap. auto with PMap. Qed. (* properties about subDom and eqDom *) Lemma eqDom_refl: forall M, eqDom M M. Proof. intro. unfold eqDom. unfold sub_dom. auto. Qed. Lemma eqDom_sym: forall M1 M2, eqDom M1 M2 -> eqDom M2 M1. Proof. intros M1 M2. unfold eqDom. tauto. Qed. Lemma subDom_trans: forall M1 M2 M3, sub_dom M1 M2 -> sub_dom M2 M3 -> sub_dom M1 M3. Proof. intros M1 M2 M3. unfold sub_dom. intros. auto. Qed. Lemma eqDom_trans : forall M1 M2 M3, eqDom M1 M2 -> eqDom M2 M3 -> eqDom M1 M3. Proof. intros M1 M2 M3. unfold eqDom. intros. inversion_clear H. inversion_clear H0. split. apply subDom_trans with M2; auto. apply subDom_trans with M2; auto. Qed. Hint Resolve eqDom_refl eqDom_sym subDom_trans eqDom_trans: PMap. Lemma subDom_update: forall (M : Map) (x : A) (y : B), sub_dom M (put M x y). Proof. intros M x y. unfold sub_dom. intros x0 INDOM. unfold in_dom. unfold in_dom in INDOM. inversion_clear INDOM. unfold put. induction (beq_A x0 x). exists y. auto. rewrite H. exists x1. auto. Qed. Lemma subDom_inDom_update : forall (M : Map) (x : A) (y : B), in_dom x M -> sub_dom (put M x y) M. Proof. intros. unfold sub_dom. unfold in_dom. intros. inversion_clear H0. unfold put in H1. induction (beq_A x0 x). unfold in_dom in H. inversion_clear H. rewrite a. exists x2. auto. exists x1. auto. Qed. Lemma eqDom_indom_update_eq : forall (M : Map) (x : A) (y : B), in_dom x M -> eqDom M (put M x y). Proof. intros M x y indom. unfold eqDom. split. apply subDom_update. apply subDom_inDom_update; auto. Qed. Hint Resolve subDom_update subDom_inDom_update eqDom_indom_update_eq : PMap. (* eqDom and merge / disjUnion *) Lemma eqDom_merge: forall M1 M2 M3 M4, merge M1 M2 = merge M3 M4 -> eqDom M1 M3 -> M1 = M3. Proof. intros M1 M2 M3 M4 MG ED. apply extensional_eqMap. intro. unfold eqDom in ED. unfold sub_dom in ED. inversion_clear ED. assert (in_dom x M1 \/ not_in_dom x M1). apply in_or_notin. inversion_clear H1. assert (in_dom x M3). apply H. auto. unfold in_dom in H2. inversion_clear H2. unfold in_dom in H1. inversion_clear H1. assert (merge M1 M2 x = merge M3 M4 x). rewrite MG. auto. unfold merge in H1. rewrite H3 in H1. rewrite H2 in H1. rewrite H2. rewrite H3. auto. assert (in_dom x M3 \/ not_in_dom x M3). apply in_or_notin. inversion_clear H1. assert (in_dom x M1). apply H0. auto. unfold in_dom in H1. unfold not_in_dom in H2. rewrite H2 in H1. inversion_clear H1. inversion_clear H4. unfold not_in_dom in H2. unfold not_in_dom in H3. rewrite <- H3 in H2. auto. Qed. Lemma eqDom_disjUnion_left: forall (M1 M2 M3 M4 M : Map), disjUnion M1 M2 M -> disjUnion M3 M4 M -> eqDom M1 M3 -> M1 = M3. Proof. intros M1 M2 M3 M4 M. unfold disjUnion. intros DU1 DU2 ED. inversion_clear DU1. inversion_clear DU2. rewrite H0 in H2. apply eqDom_merge with M2 M4; auto. Qed. Lemma eqDom_disjUnion_right: forall M1 M2 M3 M4 M, disjUnion M1 M2 M -> disjUnion M3 M4 M -> eqDom M1 M3 -> M2 = M4. Proof. intros M1 M2 M3 M4 M DU1 DU2 ED. assert (M1 = M3). apply eqDom_disjUnion_left with M2 M4 M; auto. unfold disjUnion in DU1. unfold disjUnion in DU2. inversion_clear DU1. inversion_clear DU2. rewrite H1 in H3. apply disj_merge_unique with M1 M3; auto. Qed. Hint Resolve eqDom_merge eqDom_disjUnion_left eqDom_disjUnion_right: PMap. Lemma eqDom_notin_presv: forall (M1 M2 : Map) (x : A), eqDom M1 M2 -> not_in_dom x M1 -> not_in_dom x M2. Proof. intros M1 M2 x ED. unfold not_in_dom. unfold eqDom in ED. unfold sub_dom in ED. unfold in_dom in ED. inversion_clear ED. intro. assert ((exists b : B, M1 x = Some b) -> exists b : B, M2 x = Some b). auto. assert ((exists b : B, M2 x = Some b) -> exists b : B, M1 x = Some b). auto. induction (M2 x). assert (exists b : B, M1 x = Some b). apply H3. exists a. auto. inversion_clear H4. rewrite H1 in H5. inversion_clear H5. auto. Qed. Lemma eqDom_disj_presv: forall (M1 M2 M : Map), eqDom M1 M2 -> disjoint M1 M -> disjoint M2 M. Proof. intros M1 M2 M ED. unfold disjoint. intros. assert (not_in_dom x M1 \/ not_in_dom x M). auto. inversion_clear H0. left. unfold eqDom in ED. apply eqDom_notin_presv with M1; auto. right. auto. Qed. Hint Resolve eqDom_notin_presv eqDom_disj_presv: PMap. Lemma disjUnion_presv_in_dom: forall (M1 M2 M : Map) (x : A), in_dom x M1 -> disjUnion M1 M2 M -> in_dom x M. Proof. intros. unfold disjUnion in H0. inversion_clear H0. rewrite H2. auto with PMap. Qed. Lemma disjUnion_presv_eqDom: forall (M1 M2 M3 M4 M M' : Map), disjUnion M1 M2 M -> disjUnion M3 M4 M' -> eqDom M1 M3 -> eqDom M2 M4 -> eqDom M M'. Proof. unfold eqDom. unfold sub_dom. unfold disjUnion. intros. inversion_clear H1. inversion_clear H2. inversion_clear H. inversion_clear H0. unfold in_dom. split. intros. inversion_clear H0. rewrite H6 in H8. unfold merge in H8. assert ((exists b : B, M1 x = Some b) \/ (M1 x = None)). induction (M1 x). left. exists a. auto. right. auto. inversion_clear H0. assert (in_dom x M3). apply H3. unfold in_dom. auto. unfold in_dom in H0. inversion_clear H0. rewrite H7. unfold merge. exists x1. rewrite H10. auto. assert (not_in_dom x M3). apply not_in_notin. intro. assert (in_dom x M1). apply H4; auto. unfold in_dom in H10. inversion_clear H10. rewrite H9 in H11. inversion_clear H11. rewrite H9 in H8. assert (in_dom x M4). apply H1. unfold in_dom. exists x0. auto. unfold in_dom in H10. inversion_clear H10. exists x1. rewrite H7. unfold merge. unfold not_in_dom in H0. rewrite H0. auto. intros. inversion_clear H0. rewrite H7 in H8. unfold merge in H8. assert ((exists b : B, M3 x = Some b) \/ (M3 x = None)). induction (M3 x). left. exists a. auto. right. auto. inversion_clear H0. assert (in_dom x M1). apply H4. unfold in_dom. auto. unfold in_dom in H0. inversion_clear H0. rewrite H6. unfold merge. exists x1. rewrite H10. auto. assert (not_in_dom x M1). apply not_in_notin. intro. assert (in_dom x M3). apply H3; auto. unfold in_dom in H10. inversion_clear H10. rewrite H9 in H11. inversion_clear H11. rewrite H9 in H8. assert (in_dom x M2). apply H5. unfold in_dom. exists x0. auto. unfold in_dom in H10. inversion_clear H10. exists x1. rewrite H6. unfold merge. unfold not_in_dom in H0. rewrite H0. auto. Qed. Hint Resolve disjUnion_presv_in_dom disjUnion_presv_eqDom: PMap. Lemma remove_left_presv_disjUnion_left: forall (M1 M2 M : Map) (x : A), disjUnion M1 M2 M -> in_dom x M1 -> disjUnion (remove M1 x) M2 (remove M x). Proof. intros M1 M2 M x. unfold disjUnion. intros. inversion_clear H. split. auto with PMap. rewrite H2. apply disj_remove_merge_merge_remove; auto. Qed. Hint Resolve remove_left_presv_disjUnion_left : PMap. Lemma remove_left_presv_disjUnion_right: forall (M1 M2 M : Map) (x : A), disjUnion M1 M2 M -> in_dom x M2 -> disjUnion M1 (remove M2 x) (remove M x). Proof. intros. cut (disjUnion (remove M2 x) M1 (remove M x)); auto with PMap. Qed. Hint Resolve remove_left_presv_disjUnion_right : PMap. Lemma extend_presv_disjUnion_left: forall (M1 M2 M : Map) (x : A) (y : B), disjUnion M1 M2 M -> not_in_dom x M2 -> disjUnion (put M1 x y) M2 (put M x y). Proof. intros M1 M2 M x y. unfold disjUnion. intros. inversion_clear H. split. auto with PMap. rewrite H2. apply put_merge_merge_put. Qed. Hint Resolve extend_presv_disjUnion_left : PMap. Lemma extend_presv_disjUnion_right: forall (M1 M2 M : Map) (x : A) (y : B), disjUnion M1 M2 M -> not_in_dom x M1 -> disjUnion M1 (put M2 x y) (put M x y). Proof. intros. cut (disjUnion (put M2 x y) M1 (put M x y)); auto with PMap. Qed. Hint Resolve extend_presv_disjUnion_right : PMap. Lemma update_presv_disjUnion_left: forall (M1 M2 M : Map) (x : A) (y : B), disjUnion M1 M2 M -> in_dom x M1 -> disjUnion (put M1 x y) M2 (put M x y). Proof. intros. assert (not_in_dom x M2). apply disj_exclusive_left with M1; auto. unfold disjUnion in H. inversion_clear H. auto. auto with PMap. Qed. Hint Resolve update_presv_disjUnion_left : PMap. Lemma update_presv_disjUnion_right: forall (M1 M2 M : Map) (x : A) (y : B), disjUnion M1 M2 M -> in_dom x M2 -> disjUnion M1 (put M2 x y) (put M x y). Proof. intros. cut (disjUnion (put M2 x y) M1 (put M x y)); auto with PMap. Qed. Hint Resolve update_presv_disjUnion_right : PMap. (* disjunion and subseteq *) Lemma disjoint_merge_subseteq: forall M_1 M_2 M, disjoint M_1 M_2 -> subseteq M_1 M -> subseteq M_2 M -> subseteq (merge M_1 M_2) M. Proof. intros. unfold subseteq. intros. unfold merge in H2. unfold in_dom in H2. unfold merge. unfold subseteq in H0. unfold in_dom in H0. assert (M_1 x = None \/ exists y, M_1 x = Some y). induction (M_1 x). right. exists a. auto. left. auto. inversion_clear H3. rewrite H4. rewrite H4 in H2. unfold subseteq in H1. apply H1. unfold in_dom. auto. inversion_clear H4. rewrite H3. rewrite <- H3. apply H0. exists x0. auto. Qed. Hint Resolve disjoint_merge_subseteq : PMap. Lemma disjUnion_subseteq_left: forall M_1 M_2 M, disjUnion M_1 M_2 M -> subseteq M_1 M. Proof. intros. unfold disjUnion in H. inversion_clear H. rewrite H1. apply merge_extends_map. Qed. Lemma disjUnion_subseteq_right: forall M_1 M_2 M, disjUnion M_1 M_2 M -> subseteq M_2 M. Proof. intros. apply disjUnion_subseteq_left with M_1. apply disjUnion_commut; auto. Qed. Lemma split_sglton_free: forall M x y, maps_to M x y -> disjUnion (put emp x y) (remove M x) M. Proof. intros. unfold disjUnion. unfold put. unfold remove. split. unfold disjoint. intro. unfold not_in_dom. induction (beq_A x0 x). right. auto. left. unfold emp. auto. unfold merge. apply extensional_eqMap. intro. induction (beq_A x0 x). unfold maps_to in H. rewrite <- a in H. auto. unfold emp. auto. Qed. Hint Resolve disjUnion_subseteq_left disjUnion_subseteq_right split_sglton_free : PMap. Lemma ext_emp_sglton: forall x y, sgltonM (put emp x y) x y. Proof. unfold sgltonM. unfold emp. unfold put. unfold maps_to. unfold not_in_dom. intros. split. induction (beq_A x x). auto. assert (x = x). auto. contradiction. intros. induction (beq_A x0 x). contradiction. auto. Qed. Hint Resolve ext_emp_sglton. (* properties about subseteq *) Lemma subseteq_transitivity: forall M M' M'', subseteq M M' -> subseteq M' M'' -> subseteq M M''. Proof. intros. unfold subseteq. intros. assert (M x = M' x). unfold subseteq in H. apply H; auto. rewrite H2. unfold subseteq in H0. apply H0. unfold in_dom. unfold in_dom in H1. inversion H1. rewrite H3 in H2. exists x0. rewrite <- H2. auto. Qed. Hint Resolve subseteq_transitivity: PMap. Lemma subset_unique_map: forall M M' x y, subseteq M M' -> maps_to M x y -> maps_to M' x y. Proof. unfold subseteq. unfold maps_to. unfold in_dom. intros. assert (M x = M' x). apply H. exists y. auto. rewrite <- H1. auto. Qed. Hint Resolve subset_unique_map: PMap. Definition minus (M M' : Map) : Map := fun x => match M' x with None => M x | Some _ => None end. Lemma minus_disjoint: forall M M', disjoint M' (minus M M'). Proof. intros. unfold disjoint. unfold not_in_dom. intro x. assert (M' x = None \/ exists y, M' x = Some y). induction (M' x). right. exists a. auto. left. auto. inversion_clear H. left. auto. right. unfold minus. inversion_clear H0. rewrite H. auto. Qed. Hint Resolve minus_disjoint : PMap. Lemma minus_disjUnion: forall M M', subseteq M' M -> disjUnion M' (minus M M') M. Proof. intros. unfold disjUnion. split; auto with PMap. apply extensional_eqMap. intro. unfold merge. unfold minus. assert (M' x = None \/ exists y, M' x = Some y). induction (M' x). right. eauto. left. auto. inversion_clear H0. rewrite H1. auto. inversion_clear H1. rewrite H0. unfold subseteq in H. rewrite <- H0. assert (M' x = M x). apply H. unfold in_dom. exists x0. auto. auto. Qed. Hint Resolve minus_disjUnion: PMap. Lemma subseteq_split: forall M' M, subseteq M' M -> exists M'', disjUnion M' M'' M. Proof. intros. exists (minus M M'). auto with PMap. Qed. Hint Resolve subseteq_split : PMap. Lemma ext_in_dom: forall x y M, in_dom x (put M x y). Proof. intros. unfold put. unfold in_dom. induction (beq_A x x). exists y. auto. assert (x = x). auto. contradiction. Qed. Hint Resolve ext_in_dom : PMap. Lemma ext_mapsto: forall x y M, maps_to (put M x y) x y. Proof. unfold maps_to. intros. auto with PMap. Qed. Hint Resolve ext_mapsto. Lemma mapsto_indom: forall x y M, maps_to M x y -> in_dom x M. Proof. unfold in_dom. unfold maps_to. intros. exists y. auto. Qed. Lemma ext_presv_mapsto: forall M x x' y y', x <> x' -> maps_to (put M x y) x' y' -> maps_to M x' y'. Proof. intros. unfold maps_to. unfold maps_to in H0. unfold put in H0. induction (beq_A x' x). assert (x = x'). auto. contradiction. auto. Qed. Hint Resolve mapsto_indom ext_presv_mapsto: PMap. Lemma put_xy_commut: forall M x x' y y', x <> x' -> put (put M x y) x' y' = put (put M x' y') x y. Proof. intros. apply extensional_eqMap. unfold put. intro. induction (beq_A x0 x'). induction (beq_A x0 x). rewrite a0 in a. contradiction. auto. induction (beq_A x0 x). auto. auto. Qed. Lemma put_xx_update: forall M x y y', put (put M x y) x y' = put M x y'. Proof. intros. apply extensional_eqMap. unfold put. intro. induction (beq_A x0 x); auto. Qed. Hint Resolve put_xy_commut put_xx_update: PMap. Lemma removeX_presv_Y: forall M x x' y, x <> x' -> maps_to M x' y -> maps_to (remove M x) x' y. Proof. intros. unfold maps_to. unfold remove. induction (beq_A x' x). assert (x = x'). auto. contradiction. unfold maps_to in H0. auto. Qed. Hint Resolve removeX_presv_Y : PMap. End MapFun. coq/README0000644000107400000620000001132311000223177011726 0ustar shaosystems=============================================================================== | | |Certifying Low-Level Programs with Hardware Interrupts and Preemptive Threads| | | | * Xinyu Feng, Zhong Shao, Yuan Dong and Yu Guo | | | | * Published In Proc. 2008 ACM SIGPLAN Conference on Programming Language | | Design and Implementation (PLDI'08), Tucson, Arizona, pages to appear. | =============================================================================== * Coq implementation code (Coq v8.1-pl3) ** Authors : Xinyu Feng, Zhong Shao, Yuan Dong, Yu Guo Wei Wang, Haibo Wang and Xi Wang ** Download : http://flint.cs.yale.edu/publications/aim.html * Files ./ Coqlib.v Base definitions Arith_Lemmas.v Lemmas for arithmetic ListT.v List in Type universe Map.v Map structure MultiMapT.v Multiple map structure Assertion.v Assertion language definitions Reg.v Registers file definition Machine.v Machine definition Operational_Semantics.v Operational semantics Mem_Lemmas.v Lemmas for memory OpSem_Lemmas.v Lemmas for operational semantics OpSem_Lemmas2.v Lemmas for operational semantics Assertion_Lemmas.v Lemmas for assertions Assertion_Lemmas2.v Lemmas for assertions Assertion_Lemmas3.v Lemmas for assertions Assertion_Lemmas4.v Lemmas for assertions Assertion_Lemmas5.v Lemmas for assertions ./CAP0 CAP0.v CAP0 (OCAP) definition Soundness.v Soundness proof of CAP0 Link.v Link definition and lemmas ./SCAP AIM.v AIM base definitions AIM_Lemmas.v Lemmas for AIM QLib.v Double linked queue definition QLemmas.v Lemmas for queue SCAP.v SCAP logic for kernel primitives SCAP_Itr.v SCAP logic for interrupt handlers SCAP_READY.v SCAP logic for user threads SCAP_IDLE.v SCAP logic for idle thread Linking.v Linking (4 logics) together Linking_Lemmas.v Lemmas for AIM logic Linking_Lemmas2.v Lemmas for AIM logic Linking_Lemmas3.v Lemmas for AIM logic READY_SW.v Lemmas for soundness proof NH_SW.v Lemmas for soundness proof IH_SW.v Lemmas for soundness proof READY_BLK.v Lemmas for soundness proof READY_UNBLK.v Lemmas for soundness proof SCAP_Soundness.v Soundness proof of SCAP SCAP_Itr_Lemmas.v Lemmas for SCAP_Itr soundness SCAP_Itr_Soundness.v Soundness proof of SCAP_Itr SCAP_NH_Lemmas.v Lemmas for soudness proof SCAP_READY_Soundness.v Soundness proof of SCAP_READY SCAP_IDLE_Soundness.v Soundness proof of SCAP_IDLE ./miniOS Kernel.v Assembly code of kernel EnQueueSpec.v enQueue specification EnQueueProof.v enQueue proof DeQueueSpec.v deQueue specification DeQueueProof.v deQueue proof SwitchSpec.v scheduler specification SwitchProof.v scheduler proof BlockSpec.v block specification BlockProof.v block proof UnblockSpec.v unblock specification UnblockProof.v unblock proof SleepSpec.v sleep specification SleepProof.v sleep proof Timer.v timer specification TimerProof.v timer proof YieldSpec.v yield specification YieldProof.v yield proof ./examples Assembly.v Assembly code of examples SyncUtil.v Lemmas cond_signal.v signal specification % proof cond_wait.v wait specification % proof lock_acquire.v lock_acquire specification % proof lock_release.v lock_release specification % proof * Compiling ** tar -zxf aim-code.tar.gz ** cd aim-code; make all * Statistic ** Total lines of code : 76747 ** Total number of definitions : 1176 ** Total number of lemmas/theorems : 1847 coq/OpSem_Lemmas2.v0000644000107400000620000004662311000223177013653 0ustar shaosystems(****** Operational Semantics ******) Require Import Coqlib. Require Import Map. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas2. Require Import Operational_Semantics. Require Import OpSem_Lemmas. (************************************************** * Properties of operational semantics of instrs **************************************************) Lemma ptoxBlk_split : forall s1 s2 M l, ptoxBlk l (s1 + s2) M -> mstar (ptoxBlk l s1) (ptoxBlk (l+s1) s2) M. (** added by wanghaibo **) Proof. induction s1; simpl; intros. unfold Aemp, MemMod.emp. exists MemMod.emp; exists M. split. auto with PMap. unfold MemMod.emp. split_l. replace (l+0) with l; auto with arith. destruct H as [M1 [M2 [MJM [HM1 HM2]]]]. replace (l + S s1) with (S l + s1); [idtac | omega]. assert (Hx := IHs1 s2 M2 (l+1) HM2). apply mstar_assoc_right_left. unfold mstar. exists M1; exists M2; split_l. split_l. arith_rep (S l + s1) with (l+1+s1). Qed. Lemma stkSpace_rev_mono: forall sp n n' M, stkSpace sp n M -> n >= n' -> stkSpace sp n' M. Proof. unfold stkSpace. intros. destruct H as [Ineq Mp]. split. omega. unfold leadsToBlk. unfold imprecM. assert (leadsToBlk (sp - n)((n - n') + n') M). assert (n - n' + n' = n). omega. rewrite H;assumption. destruct H as [M1 [M2 [Mdis [MH MH1]]]]. assert ((ptoxBlk (sp - n) (n - n') *^* ptoxBlk (sp - n +(n - n')) n') M1). eapply ptoxBlk_split. assumption. assert (sp - n + (n - n') = sp - n'). omega. rewrite H1 in H. destruct H as [M3 [M4 [Mdis1 [MH2 MH3]]]]. exists M4. exists (MemMod.merge M3 M2). split. assert (MemMod.disjUnion M4 M3 M1). apply (MemMod.disjUnion_commut Mdis1). eapply disjUnion_assoc_lr. apply H. assumption. split. assumption. unfold mTrue;trivial. Qed. (* movwp *) Lemma trivial_enable_movwp: forall p f o r, enable p (nextS f (comml (_movwp o r))). Proof. unfold enable. intros. destruct S as [[[M R] F] b]. exists (M, RF_update R r (opr_eval R o) , F, b). eapply nextS_movwp. reflexivity. trivial. Qed. Hint Resolve trivial_enable_movwp. Lemma frame_movwp: forall f o r, frame (nextS f (comml (_movwp o r))). Proof. unfold frame. intros. exists M1. split;destruct H1 as [M H1];inversion H1;subst;inversion H;subst;simpl. apply H0. unfold S_Mem_Upd. simpl. eapply nextS_movwp. reflexivity. trivial. Qed. (* movwld *) Lemma enable_movwld: forall (p : Pred) a r f, (forall S, p S -> leadsToxW (addr_eval (S_RF S) a) (S_Mem S)) -> enable p (nextS f (comml (_movwld a r))). Proof. unfold enable. intros. destruct S as [[[M R] F] b]. assert ((addr_eval (S_RF (M, R, F, b)) a |~>w_) (S_Mem (M, R, F, b))). apply (H (M, R, F, b));trivial. simpl in H1. destruct H1 as [M1 [M2 [Mdis [MH1 MH2]]]]. destruct MH1 as [M11 [M22 [Mdis' [MH11 MH22]]]]. destruct MH11. exists (M,RF_update R r x,F,b). eapply nextS_movwld. reflexivity. exists M1. exists M2. split;[assumption | split]. exists M11. exists M22. split;[assumption | split]. apply H1. assumption. trivial. trivial. Qed. Lemma safe_mono_movwld: forall f a r, safe_mono (nextS f (comml (_movwld a r))). Proof. unfold safe_mono. unfold enable. intros. destruct H0 as [M1 [M2 [Mdis [MH MH1]]]]. destruct S as [[[M R] F] b]. simpl in Mdis. unfold S_Mem_Upd in MH. simpl in MH. assert (exists S' : State, nextS f (comml (_movwld a r)) (M1, R, F, b) S'). apply H;apply MH. destruct H0 as [S' H0]. inversion H0. subst. exists (M, RF_update R r x, F, b). assert ((addr_eval R a |~>w x) M). destruct H10 as [M3 [M4 [Mdis1 [MH2 MH3]]]]. exists M3. exists (MemMod.merge M4 M2). split. eapply disjUnion_assoc_lr. apply Mdis1. apply Mdis. split. apply MH2. trivial. eapply nextS_movwld. reflexivity. apply H1. reflexivity. Qed. Lemma disjUnion_mapto : forall M1 M2 M l x, MemMod.disjUnion M1 M2 M -> MemMod.maps_to M1 l x -> MemMod.maps_to M l x. Proof. (** added by wang **) unfold MemMod.maps_to. intros. destruct H. unfold MemMod.merge in H1. rewrite H1. rewrite H0. trivial. Qed. Lemma disjUnion_leadsToxW : forall M1 M2 M l , MemMod.disjUnion M1 M2 M ->(l |~>w_) M1 -> (l |~>w_) M. Proof. (** added by wang **) intros. destruct H0 as [M3 [M4 [Mdis [MH MH1]]]]. exists M3. exists (MemMod.merge M4 M2). split. eapply disjUnion_assoc_lr. apply Mdis. apply H. split;[apply MH | trivial]. Qed. Lemma disjUnion_leadsToW : forall M1 M2 M x l , MemMod.disjUnion M1 M2 M ->(l |~>w x) M1 -> (l |~>w x) M. Proof. (** added by wang **) intros. destruct H0 as [M3 [M4 [Mdis [MH MH1]]]]. exists M3. exists (MemMod.merge M4 M2). split. eapply disjUnion_assoc_lr. apply Mdis. apply H. split;[apply MH | trivial]. Qed. Lemma frame_movwld: forall f a r, frame (nextS f (comml (_movwld a r))). Proof. unfold frame. intros. exists M1. destruct S as [[[M R] F] b]. inversion H. subst. unfold S_Mem_Upd. simpl. simpl in H0. inversion H1. unfold S_Mem_Upd in H2. simpl in H2. inversion H2. subst. split. apply H0. destruct H13 as [M3 [M4 [Mdis [MH MH1]]]]. eapply nextS_movwld. reflexivity. exists M3. exists M4. split;[apply Mdis |split;[apply MH | trivial]]. destruct MH as [M5 [M6 [Mdis1 [MH2 MH3]]]]. destruct MH2. assert (MemMod.maps_to M3 (addr_eval R a) x1). eapply disjUnion_mapto. apply Mdis1. apply H3. assert (MemMod.maps_to M1 (addr_eval R a) x1). eapply disjUnion_mapto. apply Mdis. apply H5. assert (MemMod.maps_to M (addr_eval R a) x1). eapply disjUnion_mapto. apply H0. apply H6. destruct H11 as [M7 [M8 [Mdis2 [MH4 MH5]]]]. destruct MH4 as [M9 [M0 [Mdis3 [MH6 MH7]]]]. assert (MemMod.maps_to M7 (addr_eval R a) x). eapply disjUnion_mapto. apply Mdis3. destruct MH6. apply H8. assert (MemMod.maps_to M (addr_eval R a) x). eapply disjUnion_mapto. apply Mdis2. apply H8. unfold MemMod.maps_to in H7. unfold MemMod.maps_to in H9. rewrite H7 in H9. inversion H9. trivial. Qed. (* movwst *) Lemma enable_movwst: forall (p : Pred) o a f, (forall S, p S -> leadsToxW (addr_eval (S_RF S) a) (S_Mem S)) -> enable p (nextS f (comml (_movwst o a))). Proof. unfold enable. intros. destruct S as [[[M R] F] b]. exists (MemMod.put (MemMod.put M (addr_eval R a)(opr_eval R o)) (addr_eval R a + 1) f, R, F, b). eapply nextS_movwst. reflexivity. reflexivity. apply (H (M, R, F, b));apply H0. exists f. trivial. Qed. Lemma safe_mono_movwst: forall f o a, safe_mono (nextS f (comml (_movwst o a))). Proof. unfold safe_mono. unfold enable. intros. destruct S as [[[M R] F] b]. exists (MemMod.put (MemMod.put M (addr_eval R a)(opr_eval R o)) (addr_eval R a + 1) f, R, F, b). eapply nextS_movwst. reflexivity. reflexivity. destruct H0 as [M1 [M2 [Mdis [MH MH1]]]]. assert (exists S' : State, nextS f (comml (_movwst o a)) (M1, R, F, b) S'). apply H. unfold S_Mem_Upd in MH. simpl in MH. apply MH. destruct H0 as [S' H0]. inversion H0. subst. simpl in Mdis. eapply disjUnion_leadsToxW. apply Mdis. apply H11. exists f. trivial. Qed. Lemma disjoint_put_disjoint : forall l x M1 M2, MemMod.in_dom l M1 -> MemMod.disjoint M1 M2 -> MemMod.disjoint (MemMod.put M1 l x) M2. (** copy from Assertion_Lemma3 **) Proof. unfold MemMod.in_dom, MemMod.disjoint, MemMod.put, MemMod.not_in_dom. intros. destruct H. destruct (MemMod.beq_A x0 l). subst x0. destruct (H0 l). rewrite H in H1. discriminate H1. right; trivial. destruct (H0 x0). left; trivial. right; trivial. Qed. Lemma leadsToxW_indom : forall M l ,leadsToxW l M -> (MemMod.in_dom l M /\ MemMod.in_dom (l + 1) M). (** added by wang **) Proof. intros. destruct H as [M1 [M2 [Mdis [MH MH1]]]]. destruct MH as [M3 [M4 [Mdis1 [MH2 MH3]]]]. destruct MH2. assert (ptoW l x M1). exists M3. exists M4. auto. assert (MemMod.in_dom l M1 /\ MemMod.in_dom (l + 1) M1). eapply ptoW_indom. apply H0. elim H1. intros. split. destruct H2. exists x0. assert (MemMod.maps_to M l x0). eapply disjUnion_mapto. apply Mdis. apply H2. apply H4. destruct H3. exists x0. assert (MemMod.maps_to M (l + 1) x0). eapply disjUnion_mapto. apply Mdis. apply H3. apply H4. Qed. Lemma leadsToW_leadsToxW : forall M l x, leadsToW l x M -> leadsToxW l M. Proof. (** copy from Assertion_Lemma3 **) unfold leadsToW, leadsToxW. unfold ptoW, ptoxW. unfold imprecM. unfold mstar, pto, ptox, mTrue. intros. destruct H as [M1 [M2 [HJM [H _]]]]. destruct H as [M11 [M12 [HJM1 [Hpto1 Hpto2]]]]. exists M1; exists M2. split_l. split_r. exists M11; exists M12. split_l. split. exists x; trivial. trivial. Qed. Lemma indom_indom_put : forall l l' x' M, MemMod.in_dom l M -> MemMod.in_dom l (MemMod.put M l' x'). (** copy from Assertion_Lemma3 **) Proof. unfold MemMod.in_dom, MemMod.put. intros. destruct H. destruct (MemMod.beq_A l l'). exists x'; trivial. exists x; trivial. Qed. Lemma frame_movwst: forall f o a, frame (nextS f (comml (_movwst o a))). Proof. unfold frame. unfold S_Mem_Upd. unfold enableS. intros. destruct S as [[[M R] F] b]. simpl in H1. inversion H. subst. simpl. simpl in H0. destruct H1. inversion H1. subst. destruct H13. exists (MemMod.put (MemMod.put M1 (addr_eval R a) (opr_eval R o)) (addr_eval R a + 1) x). split. assert (MemMod.in_dom (addr_eval R a) M1 /\ MemMod.in_dom (addr_eval R a +1) M1). eapply leadsToxW_indom. apply H14. split. inversion H3. assert (MemMod.disjoint (MemMod.put M1 (addr_eval R a) (opr_eval R o)) M2). apply disjoint_put_disjoint. apply H4. destruct H0. apply H0. apply disjoint_put_disjoint. apply indom_indom_put. apply H5. apply H6. rewrite H2. destruct H0. rewrite H4. assert (MemMod.put (MemMod.merge M1 M2) (addr_eval R a) (opr_eval R o) = MemMod.merge (MemMod.put M1 (addr_eval R a) (opr_eval R o) ) M2). apply MemMod.put_merge_merge_put. rewrite H5. apply MemMod.put_merge_merge_put. eapply nextS_movwst. reflexivity. reflexivity. apply H14. exists x. trivial. Qed. (* addw *) Lemma trivial_enable_addw: forall p f o r, enable p (nextS f (comml (_addw o r))). Proof. unfold enable. intros. destruct S as [[[M R] F] b]. exists (M, RF_update R r ((opr_eval R o) + R r),Set_Flag F _ZF, b). eapply nextS_addw. reflexivity. reflexivity. reflexivity. left. auto. Qed. Lemma frame_addw: forall f o r, frame (nextS f (comml (_addw o r))). Proof. unfold frame. intros. destruct S as [[[M R] F] b]. unfold S_Mem_Upd in H1. unfold S_Mem_Upd. inversion H. subst. exists M1. split. apply H0. eapply nextS_addw. reflexivity. reflexivity. reflexivity. apply H13. Qed. (* cmpw *) Lemma trivial_enable_cmpw: forall p f o r, enable p (nextS f (comml (_cmpw o r))). Proof. unfold enable. intros. destruct S as [[[M R] F] b]. assert ({opr_eval R o = R r} + {opr_eval R o <> R r}). eapply MemMod.beq_A. elim H0. intro. exists (M, R, Set_Flag F _ZF, b). eapply nextS_cmpw. auto. intro. exists (M, R, Clear_Flag F _ZF, b). eapply nextS_cmpw. auto. Qed. Lemma frame_cmpw: forall f o r, frame (nextS f (comml (_cmpw o r))). Proof. unfold frame. intros. destruct S as [[[M R] F] b]. inversion H. subst. exists M1. unfold S_Mem_Upd. simpl in H0. simpl. split. apply H0. eapply nextS_cmpw. apply H10. Qed. (* pushwp *) Lemma leadsToBlk_indom : forall l size M off, leadsToBlk l size M -> off < size -> MemMod.in_dom (l + off) M. Proof. (** added by wanghaibo **) intros. assert (leadsToBlk (l + off)(size - off) M). assert (off <= size). omega. apply leadsToBlk_shrink_low;assumption. destruct H1 as [M1 [M2 [SH [SH1 SH2]]]]. unfold ptoxBlk in SH1. assert (size - off = S (size - off - 1)). omega. rewrite H1 in SH1. destruct SH1 as [M3 [SH3 [SH4 [[n [SH5 SH5']] SH6]]]]. assert (MemMod.in_dom (l + off) M3). apply (MemMod.mapsto_indom SH5). destruct SH;destruct SH4. assert (MemMod.in_dom (l + off) M1). subst. apply MemMod.merge_presv_indom_left;assumption. rewrite H4;apply MemMod.merge_presv_indom_left;assumption. Qed. Lemma frame_pushwp: forall f o, frame (nextS f (comml (_pushwp o))). Proof. unfold frame. unfold S_Mem_Upd. intros. destruct S as [[[M R] F] b]. inversion H. subst. simpl in H0. simpl. simpl in H1. destruct H10 as [MH [MH1 MH2]]. destruct MH1 as [x MH3]. exists (MemMod.put (MemMod.put M1 (R SP - 2) (opr_eval R o)) (R SP - 2 + 1) x). rewrite MH3. inversion H1. inversion H2. subst. destruct H11. destruct H3. split. split. assert (MemMod.in_dom (R SP - 2 + 1) M1). eapply leadsToBlk_indom. apply H5. omega. apply disjoint_put_disjoint. apply indom_indom_put. apply H6. assert (MemMod.in_dom (R SP - 2 + 0) M1). eapply leadsToBlk_indom. apply H5. omega. apply disjoint_put_disjoint. assert (R SP -2 + 0 = R SP -2). omega. rewrite <- H8. apply H7. destruct H0. apply H0. destruct H0. rewrite H6. assert (MemMod.put (MemMod.merge M1 M2) (R SP - 2) (opr_eval R o) = MemMod.merge (MemMod.put M1 (R SP -2) (opr_eval R o) ) M2). apply MemMod.put_merge_merge_put. rewrite H7. apply MemMod.put_merge_merge_put. eapply nextS_pushwp. reflexivity. unfold pushW. split. split;[apply H3 | apply H5]. split;[exists x;trivial | trivial]. Qed. Lemma leadsToBlk_Mono : forall size l M1 M2 M, MemMod.disjUnion M1 M2 M -> leadsToBlk l size M1 -> leadsToBlk l size M. (** copy from Assertion_Lemmas3 **) Proof. unfold leadsToBlk. unfold imprecM, mstar, mTrue. intros. destruct H0 as [M11 [M12 [HJM1 [Hblk Ht]]]]. exists M11; exists (MemMod.merge M12 M2). rsplit. split_lr. destruct H. destruct HJM1. subst. split. apply MemMod.disj_merge_A. trivial. eapply MemMod.disj_merge_disj_left; eauto. rewrite MemMod.merge_assoc. trivial. Qed. Lemma safe_mono_pushwp: forall f o, safe_mono (nextS f (comml (_pushwp o))). Proof. unfold safe_mono. unfold enable. intros. destruct S as [[[M R] F] b]. exists (MemMod.put (MemMod.put M (R SP - 2) (opr_eval R o)) (R SP - 2 + 1) f, RF_update R SP (R SP - 2), F, b). eapply nextS_pushwp. reflexivity. destruct H0 as [M1 [M2 [Mdis [MH MH1]]]]. unfold pushW. unfold S_Mem_Upd in MH. simpl in MH. simpl in Mdis. split. assert (exists S' : State, nextS f (comml (_pushwp o)) (M1, R, F, b) S'). apply H. apply MH. destruct H0 as [S' H0]. inversion H0. subst. inversion H9. destruct H1. split. apply H1. eapply leadsToBlk_Mono. apply Mdis. apply H3. unfold MemUpd16. split;[exists f;reflexivity | reflexivity]. Qed. Lemma enable_pushwp: forall (p : Pred) n f opr, (forall S, p S -> stkSpace (S_RF S SP) n (S_Mem S)) -> n >= 2 -> enable p (nextS f (comml (_pushwp opr))). Proof. intros. unfold enable. intros. induction S as (((M, R), fl), isr). exists (MemMod.put (MemMod.put M (R SP - 2) (opr_eval R opr)) (R SP - 2 + 1) 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_pushwp with (opr_eval R opr); auto. unfold pushW. split. apply stkSpace_rev_mono with n; auto. assert (stkSpace (S_RF (M, R, fl, isr) SP) n (S_Mem (M, R, fl, isr))). apply H; auto. UnfoldStateAll. auto. split; auto. unfold MemUpd16. exists 0. auto. Qed. (* pushwm *) Lemma safe_mono_pushwm: forall f addr, safe_mono (nextS f (comml (_pushwm addr))). Proof. unfold safe_mono. unfold enable. intros. destruct H0 as [M1 [M2 [Mdis [MH MH1]]]]. destruct S as [[[M R] F] b]. simpl in Mdis. unfold S_Mem_Upd in MH. simpl in MH. assert (exists S' : State, nextS f (comml (_pushwm addr)) (M1, R, F, b) S'). apply H;apply MH. destruct H0 as [S' H0]. inversion H0. subst. inversion H9. destruct H1 as [M3 [Mdis1 [MH2 MH3]]]. inversion MH2 as [M4 [M5 [Mdis2 [MH4 MH5]]]]. destruct MH5. exists (MemMod.put (MemMod.put M (R SP - 2) x) (R SP - 2 + 1) x1, RF_update R SP (R SP - 2), F, b). eapply nextS_pushwm. reflexivity. exists x0. exists (MemMod.merge M3 M2). split. eapply disjUnion_assoc_lr. apply Mdis1. apply Mdis. split. apply MH2. trivial. unfold pushW. split. inversion H10. inversion H2. split. apply H4. eapply leadsToBlk_Mono. apply Mdis. apply H5. split;[exists x1;reflexivity | reflexivity]. Qed. Lemma frame_pushwm: forall f addr, frame (nextS f (comml (_pushwm addr))). Proof. unfold frame. unfold S_Mem_Upd. unfold enableS. intros. destruct S as [[[M R] F] b]. simpl in H0,H1. inversion H. subst. destruct H1 as [S' MH]. inversion MH. subst. destruct H11 as [H1 [H2 H3]]. destruct H12 as [MH1 [MH2 MH3]]. assert ((addr_eval R addr |~>w x0) M). eapply disjUnion_leadsToW. apply H0. apply H9. assert (x = x0). eapply (leadsToW_unique H10 H4). inversion H2. rewrite H6. exists (MemMod.put (MemMod.put M1 (R SP - 2) x)(R SP - 2 +1) x1). simpl. split. destruct H0 as [H0 H0']. split. inversion MH1. inversion H8. apply disjoint_put_disjoint. assert (MemMod.in_dom (R SP - 2 + 1) M1). eapply leadsToBlk_indom. apply H8. omega. apply indom_indom_put. apply H12. apply disjoint_put_disjoint. assert (R SP - 2 = R SP - 2 + 0). omega. rewrite H12. eapply leadsToBlk_indom. apply H8. omega. apply H0. assert (MemMod.put (MemMod.merge M1 M2) (R SP - 2) x = MemMod.merge (MemMod.put M1 (R SP -2) x ) M2). apply MemMod.put_merge_merge_put. rewrite H0'. rewrite H7. apply MemMod.put_merge_merge_put. eapply nextS_pushwm. reflexivity. apply H9. split. apply MH1. rewrite H5. split. exists x1. reflexivity. apply H3. Qed. Lemma enable_pushwm: forall (p : Pred) n f addr, (forall S, p S -> stkSpace (S_RF S SP) n (S_Mem S) /\ leadsToxW (addr_eval (S_RF S) addr) (S_Mem S)) -> n >= 2 -> enable p (nextS f (comml (_pushwm addr))). Proof. intros. unfold enable. intros. destruct S as [[[M R] fl] isr]. substH H with (H _ H1). simplS in * . destruct H as [H2 H3]. substH H3 with (leadsToxW_leadsToW H3). destruct H3 as [x H3]. exists (MemMod.put (MemMod.put M (R SP - 2) x) (R SP - 2 + 1) 0, RF_update R SP (R SP - 2), fl, isr). apply nextS_pushwm with (addr_eval R addr) x; auto. unfold pushW. split. apply stkSpace_rev_mono with n; auto. split; auto. unfold MemUpd16. exists 0. auto. Qed. (* popw *) Lemma enable_popw: forall (p : Pred) f r, (forall S, p S -> ((S_RF S SP) |~>w_ ) (S_Mem S)) -> enable p (nextS f (comml (_popw r))). Proof. unfold enable. intros. destruct S as [[[M R] F] b]. assert ((S_RF (M, R, F, b) SP |~>w_) (S_Mem (M, R, F, b))). apply H. apply H0. simpl in H1. inversion H1 as [M1 [M2 [Mdis [MH1 MH2]]]]. destruct MH1 as [M3 [M4 [Mdis1 [MH3 MH4]]]]. destruct MH3. exists (M, RF_update (RF_update R SP (R SP + 2)) r x, F, b). eapply nextS_popw. split. assert ((R SP |~>w x) M). eapply disjUnion_leadsToW. apply Mdis. exists (MemMod.merge M3 M4). exists MemMod.emp. inversion Mdis1. rewrite <- H4. split. apply MemMod.unit_emp_disjUnion. split. exists M3. exists M4. split;[apply Mdis1 | split; [apply H2 | apply MH4]]. trivial. apply H3. reflexivity. reflexivity. Qed. Lemma safe_mono_popw: forall f r, safe_mono (nextS f (comml (_popw r))). Proof. unfold safe_mono. unfold enable. intros. destruct S as [[[M R] F] b]. destruct H0 as [M1 [M2 [Mdis [MH1 MH2]]]]. unfold S_Mem_Upd in MH1. simpl in MH1, Mdis. assert (exists S' : State, nextS f (comml (_popw r)) (M1, R, F, b) S'). apply H. apply MH1. destruct H0. inversion H0. subst. inversion H8. exists (M, RF_update (RF_update R SP (R SP + 2)) r x0, F, b). eapply nextS_popw. split. assert ((R SP |~>w x0)M). eapply disjUnion_leadsToW. apply Mdis. apply H1. apply H3. reflexivity. reflexivity. Qed. Lemma frame_popw: forall f r, frame (nextS f (comml (_popw r))). Proof. unfold frame. unfold enableS. unfold S_Mem_Upd. intros. destruct S as [[[M R] F] b]. simpl in H0,H1. inversion H. subst. exists M1. simpl. split. apply H0. destruct H1. inversion H1. subst. inversion H10. eapply nextS_popw. split. apply H2. reflexivity. inversion H9. rewrite H5. assert ((R SP |~>w x1) M). eapply disjUnion_leadsToW. apply H0. apply H2. assert (x = x1). eapply leadsToW_unique. apply H4. apply H6. rewrite H7. reflexivity. Qed. Lemma frame_call: forall f f', frame (nextS f (comml (_call f'))). Proof. unfold frame. unfold enableS. intros. destruct S as [[[M R] F] b]. destruct S' as [[[M' R'] F'] b']. UnfoldStateAll. destruct H1 as [S H1]. apply nextS_DMono with M S; auto. Qed. coq/Reg.v0000644000107400000620000001233411000223177011755 0ustar shaosystemsRequire Import Coqlib. Require Import Arith. Require Import Machine. Lemma beq_sym : forall r r', beq_reg r r' = beq_reg r' r. Proof. double induction r r'; simpl; intros; auto. Qed. Lemma beq_refl : forall r , beq_reg r r = true. Proof. induction r; simpl; intros; auto. Qed. Lemma beq_req_true : forall r r', r = r' -> beq_reg r r' = true. intros. rewrite H. induction r';auto. Qed. Lemma beq_true_req : forall r r', beq_reg r r' = true -> r = r'. Proof. double induction r r'; simpl; intros; discriminate || trivial. Qed. Lemma beq_rneq_false : forall r r', r <> r' -> beq_reg r r' = false. intros. induction r; induction r'; tauto. Qed. Lemma beq_reg_dec : forall r r', {beq_reg r r' = true} + {beq_reg r r' = false}. Proof. double induction r r'; simpl; intros; auto. Qed. Ltac simplbreg := match goal with | H : beq_reg ?r ?r = false |- _ => rewrite (beq_req_true r r (refl_equal r)) in H; discriminate H; simplbreg | H : context [ beq_reg ?r ?r] |- _ => rewrite (beq_req_true r r (refl_equal r)) in H; simplbreg | |- context [ beq_reg ?r ?r] => rewrite (beq_req_true r r (refl_equal r)); simplbreg | H : beq_reg ?rx ?ry = ?f |- context [beq_reg ?rx ?ry] => rewrite H; simplbreg | H : beq_reg ?rx ?ry = ?f |- context [beq_reg ?ry ?rx] => rewrite (beq_sym rx ry) in H; rewrite H; simplbreg | H : beq_reg ?rx ?ry = ?f, H1 : context [beq_reg ?rx ?ry] |- _ => rewrite H in H1; simplbreg | H : beq_reg ?rx ?ry = ?f, H1 : context [beq_reg ?ry ?rx] |- _ => rewrite (beq_sym rx ry) in H; rewrite H in H1; simplbreg | H : beq_reg ?rx ?ry = true |- _ => let Heq := fresh "Heq" in (generalize (beq_true_req rx ry H); intro Heq; subst rx); simplbreg | [H : ?x = ?x |- _ ] => clear H; simplbreg | [H : true = false |- _ ] => discriminate H | [H : false = true |- _ ] => discriminate H | _ => idtac end. Ltac solvebreg := intros; match goal with | |- context [ beq_reg ?r ?r] => rewrite (beq_req_true r r (refl_equal r)); reflexivity | H : beq_reg ?rx ?ry = ?f |- beq_reg ?rx ?ry = ?f => assumption | H : beq_reg ?rx ?ry = ?f |- beq_reg ?ry ?rx = ?f => rewrite (beq_sym rx ry) in H; assumption | H : beq_reg ?rx ?ry = true |- _ => let Heq := fresh "Heq" in (generalize (beq_true_req rx ry H); intro Heq; subst rx); solvebreg | H : beq_reg ?r ?r = false |- _ => rewrite (beq_req_true r r (refl_equal r)) in H; discriminate H | |- beq_reg ?rx ?ry = ?f => simpl; reflexivity | _ => fail 1 "The goal cannot be solved. " end. Ltac decbeqreg rx ry := let Hb := fresh "Hb" in (destruct (beq_reg_dec rx ry) as [Hb | Hb]; simplbreg). (********************) Lemma RF_update_RF_update : forall R r v v', RF_update (RF_update R r v') r v = RF_update R r v. Proof. intros. apply (extensionality reg nat). intro r0. unfold RF_update. generalize (beq_reg r0 r). induction b;reflexivity. Qed. Lemma RF_update_RF : forall R r v, RF_update R r v r = v. Proof. unfold RF_update. intros. replace (beq_reg r r) with true. reflexivity. apply beq_reg_refl. Qed. Lemma RF_update_prev : forall R r, RF_update R r (R r) = R. Proof. intros. apply (extensionality reg nat). intro r0;unfold RF_update. destruct (reg_eq_dec r0 r). subst. replace (beq_reg r r) with true; [reflexivity|apply beq_reg_refl]. replace (beq_reg r0 r) with false; [reflexivity|apply flag_neq_beq_false;assumption ]. Qed. Lemma RF_update_RF_neq : forall R r r' v, beq_reg r' r = false -> RF_update R r v r' = R r'. Proof. unfold RF_update. intros. rewrite H. trivial. Qed. Lemma set_get_eq : forall R r w, (RF_update R r w) r = w. Proof. intros. unfold RF_update. rewrite (beq_req_true r r (refl_equal _)). trivial. Qed. Lemma set_get_neq : forall R r r' w, beq_reg r r' = false -> (RF_update R r' w) r = R r. Proof. intros. unfold RF_update. decbeqreg r r'; trivial. Qed. Lemma set_set_eq : forall R r w w', RF_update (RF_update R r w') r w = RF_update R r w. Proof. intros. unfold RF_update. apply (extensionality reg nat). intro r'. decbeqreg r' r; trivial. Qed. Ltac reg_upd_simpl := match goal with | [ |- context [(RF_update ?R ?r ?v) ?r] ] => rewrite (set_get_eq R r v); reg_upd_simpl | [ |- context [(RF_update ?R ?r ?v) ?r] ] => rewrite set_get_eq; reg_upd_simpl | [ H : context [(RF_update ?R ?r ?v) ?r] |- _ ] => rewrite set_get_eq in H; reg_upd_simpl | [ |- context [(RF_update ?R ?r2 ?v) ?r1] ] => rewrite set_get_neq; [idtac | solvebreg]; reg_upd_simpl | [ H: context [(RF_update ?R ?r2 ?v) ?r1] |- _ ] => rewrite set_get_neq in H; [idtac | solvebreg]; reg_upd_simpl | [ |- context [(RF_update (RF_update ?s ?r2 ?v2) ?r1 ?v1)] ] => rewrite set_set_eq; reg_upd_simpl | [ H: context [(RF_update (RF_update ?s ?r2 ?v2) ?r1 ?v1)] |- _ ] => rewrite set_set_eq in H; reg_upd_simpl | _ => idtac end. Tactic Notation "reg" "simpl" := reg_upd_simpl. coq/miniOS/0000755000107400000620000000000011000242246012242 5ustar shaosystemscoq/miniOS/Makefile0000644000107400000620000001115611000223231013677 0ustar shaosystems################################################################################ The Calculus of Inductive Constructions #### #### Projet Coq #### #### INRIA ENS-CNRS #### Rocquencourt Lyon #### #### Coq V7 #### #### ################################################################################# WARNING # # This Makefile has been automagically generated by coq_makefile # Edit at your own risks ! # # END OF WARNING # # This Makefile was generated by the command line : # coq_makefile -I .. -I ../CAP0 -I ../SCAP Queue.v enQueueFirst.v enQueueMulti.v deQueueEmpty.v deQueueDeqA.v deQueueDeqB.v TCB_lemma.v Scheduler.v SchedulerProof.v SchedulerCallenQ.v SchedulerCalldeQ.v SchedulerRetw.v Unblock.v UnblockDeQueue.v UnblockEnQueue.v Yield.v YieldProof.v Timer.v TimerProof.v # ########################## # # # Variables definitions. # # # ########################## CAMLP4LIB=`camlp4 -where` COQSRC=-I $(COQTOP)/kernel -I $(COQTOP)/lib \ -I $(COQTOP)/library -I $(COQTOP)/parsing \ -I $(COQTOP)/pretyping -I $(COQTOP)/interp \ -I $(COQTOP)/proofs -I $(COQTOP)/syntax -I $(COQTOP)/tactics \ -I $(COQTOP)/toplevel -I $(COQTOP)/contrib/correctness \ -I $(COQTOP)/contrib/extraction -I $(COQTOP)/contrib/field \ -I $(COQTOP)/contrib/fourier -I $(COQTOP)/contrib/graphs \ -I $(COQTOP)/contrib/interface -I $(COQTOP)/contrib/jprover \ -I $(COQTOP)/contrib/omega -I $(COQTOP)/contrib/romega \ -I $(COQTOP)/contrib/ring -I $(COQTOP)/contrib/xml \ -I $(CAMLP4LIB) ZFLAGS=$(OCAMLLIBS) $(COQSRC) OPT= COQFLAGS=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML) COQC=$(COQBIN)coqc GALLINA=gallina COQDOC=coqdoc CAMLC=ocamlc -c CAMLOPTC=ocamlopt -c CAMLLINK=ocamlc CAMLOPTLINK=ocamlopt COQDEP=$(COQBIN)coqdep -c GRAMMARS=grammar.cma CAMLP4EXTEND=pa_extend.cmo pa_ifdef.cmo q_MLast.cmo PP=-pp "camlp4o -I . -I $(COQTOP)/parsing $(CAMLP4EXTEND) $(GRAMMARS) -impl" ######################### # # # Libraries definition. # # # ######################### OCAMLLIBS=-I .\ -I ..\ -I ../CAP0\ -I ../SCAP COQLIBS=-I .\ -I ..\ -I ../CAP0\ -I ../SCAP ################################### # # # Definition of the "all" target. # # # ################################### VFILES= \ DeQueueSpec.v\ DeQueueProof.v\ EnQueueSpec.v\ EnQueueProof.v \ \ SwitchSpec.v\ SwitchProof.v\ UnblockSpec.v\ UnblockProof.v\ BlockSpec.v\ BlockProof.v\ \ SleepSpec.v\ SleepProof.v\ YieldSpec.v\ YieldProof.v\ Timer.v\ TimerProof.v VOFILES=$(VFILES:.v=.vo) VIFILES=$(VFILES:.v=.vi) GFILES=$(VFILES:.v=.g) HTMLFILES=$(VFILES:.v=.html) GHTMLFILES=$(VFILES:.v=.g.html) all: $(VOFILES) spec: $(VIFILES) gallina: $(GFILES) html: $(HTMLFILES) gallinahtml: $(GHTMLFILES) all.ps: $(VFILES) $(COQDOC) -ps -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` all-gal.ps: $(VFILES) $(COQDOC) -ps -g -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` #################### # # # Special targets. # # # #################### .PHONY: all opt byte archclean clean install depend html .SUFFIXES: .v .vo .vi .g .html .tex .g.tex .g.html .v.vo: $(COQC) $(COQDEBUG) $(COQFLAGS) $* .v.vi: $(COQC) -i $(COQDEBUG) $(COQFLAGS) $* .v.g: $(GALLINA) $< .v.tex: $(COQDOC) -latex $< -o $@ .v.html: $(COQDOC) -html $< -o $@ .v.g.tex: $(COQDOC) -latex -g $< -o $@ .v.g.html: $(COQDOC) -html -g $< -o $@ byte: $(MAKE) all "OPT=" opt: $(MAKE) all "OPT=-opt" include .depend .depend depend: rm -f .depend $(COQDEP) -i $(COQLIBS) *.v *.ml *.mli >.depend $(COQDEP) $(COQLIBS) -suffix .html *.v >>.depend install: mkdir -p `$(COQC) -where`/user-contrib cp -f *.vo `$(COQC) -where`/user-contrib clean: rm -f *.cmo *.cmi *.cmx *.o *.vo *.vi *.g *~ rm -f all.ps all-gal.ps $(HTMLFILES) $(GHTMLFILES) archclean: rm -f *.cmx *.o html: # WARNING # # This Makefile has been automagically generated by coq_makefile # Edit at your own risks ! # # END OF WARNING coq/miniOS/Timer.v0000644000107400000620000001115511000223231013505 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) (*******************************************) (** Prove Timer (timer interrupt handler) with AIM *******) (** $Id: Timer.v,v 1.6 2008/04/04 14:36:16 ssg05 Exp $ **) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import AIM. Require Import SCAP. Require Import SCAP_Itr. Require Import Linking. Require Import OpSem_Lemmas. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas2. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas5. Require Import Reg. (** Should be moved to Assertion_Lemmas4.v **) Notation Local " i ; I " := (seq i I) (at level 60, right associativity). Notation Local " i ;; " := (sseq i) (at level 60). (** Functioon: timer, timer interrupt handler**) (********Source Code *************************** # timer(q) 1127: timer: pushw %ax pushw %bx pushw %cx 1130: pushw %dx pushw %di pushw %si pushw %bp movb $0x20, %al 1135: movw $0x20, %dx outb %al, %dx # send EOI call scheduler # instruction _SWITCH popw %bp popw %si 1140: popw %di popw %dx popw %cx popw %bx popw %ax 1145: iret ************************************************) (** Instruction Label **) Definition I_timer := _pushwp (Opr_reg AX); _pushwp (Opr_reg BX); _pushwp (Opr_reg CX); _pushwp (Opr_reg DX); _pushwp (Opr_reg DI); _pushwp (Opr_reg SI); _pushwp (Opr_reg BP); _movwp (Opr_imm 32) AX; _movwp (Opr_imm 32) DX; _outb_eoi; _call _SWITCH; _popw (BP); _popw (SI); _popw (DI); _popw (DX); _popw (CX); _popw (BX); _popw (AX); _iret;; . Definition IHpred_alt : Pred := fun (S : State) => (mstar mTrue (mstar INV0 (stkSpacePrec (S_RF S SP) IH_Stk))) (S_Mem S) /\ (S_ISR S) = true /\ (S_Flag S _IF) = false. Definition ihtag := 0. Notation s_timer := (Ast IHpred_alt IHgrt ihtag). Notation Psi_timer := SCAP_emptCT. Definition timer_post (sp : Label) (S' : State) : Prop := (INV0 *^* stkSpacePrec sp IH_Stk) (S_Mem S') /\ S_ISR S' = false. Definition ih_gy_alt : Grt := fun (S S' : State) => exists sp, (forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> (INV0 *^* (stkSpacePrec sp _SW_Stk)) M0 -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ (INV0 *^* (stkSpacePrec sp _SW_Stk)) M0') /\ S_Flag S _IF = S_Flag S' _IF /\ S_ISR S = S_ISR S' /\ S_RF S SP = sp /\ S_RF S SP = S_RF S' SP. Lemma ih_pre_imply: forall st, IHpred st -> IHpred_alt st. Proof. intros st [pre [inIsr IFtrue]]. split; auto. assert ((mTrue *^* (INV0 *^* stkSpacePrec (S_RF st SP + 6) (IH_Stk + 6))) (S_Mem st)). destruct pre as [M1 [M2 [djh [pre mM2]]]]. exists M1. exists M2. split_l. repeat split; auto. sep on. sep lift 2 in H. assert ( S_Mem st ||- stkSpacePrec (S_RF st SP + 6) 6 *^* stkSpacePrec (S_RF st SP + 6 - 6) (IH_Stk + 6 - 6) *^* (mTrue *^* INV0)). apply stkSpacePrec_splith1; auto. omega. arith_rep (S_RF st SP + 6 - 6) with (S_RF st SP) in H0. replace (IH_Stk + 6 - 6) with (IH_Stk) in H0. assert ( S_Mem st ||- (mTrue *^* stkSpacePrec (S_RF st SP + 6) 6) *^* (INV0 *^* stkSpacePrec (S_RF st SP) IH_Stk)). sep matchH H0 with 4. sep off. destruct H1 as [M1 [M2 [djh [mM1 mM2]]]]. exists M1. exists M2. split_l. repeat split; auto. simpl; trivial. Qed. Lemma ih_gy_derive: forall st st', ih_gy st st' -> ih_gy_alt st st'. Proof. unfold ih_gy, ih_gy_alt. intros st st' ih. destruct ih as [sp [pre [eqFlg [eqisr [eqsp eqsp']]]]]. exists sp. split; auto. intros M1 M2 djh mM1. unfold prepost in pre. destruct pre as [Ma [Mb [Ma' [mMa [mMa' [djha djh']]]]]]. exists Ma'. split_r. assert (Hpre: precise (INV0 *^* stkSpacePrec sp _SW_Stk)). apply mstar_presv_prec. apply Prec0. apply precise_stkSpacePrec. substH Hpre with (Hpre M1 Ma (S_Mem st)). assert (eqM: M2 = Mb). apply MemMod.disjUnion_unique with M1 Ma (S_Mem st); auto. apply Hpre; auto. apply MemMod.disjUnion_subseteq_left with M2; auto. apply MemMod.disjUnion_subseteq_left with Mb; auto. rewrite eqM; auto. Qed. coq/miniOS/YieldSpec.v0000644000107400000620000004454611000223231014320 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Require Import Kernel. Definition Ast_yield_pre (sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec sp _STK_SIZE_yield *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp /\ itr_enabled S. Definition Ast_yield_post (sp pc : Label) (mP : MPred) (S' : State) : Prop := (stkSpacePrec sp _STK_SIZE_yield *^* sp |->w pc *^* mP) (S_Mem S') /\ itr_enabled S'. Definition L_yield_0_p (S : State) : Prop := exists sp, exists pc, (Ast_yield_pre sp pc mTrue S). Definition L_yield_0_g (S S' : State) : Prop := forall mP, forall sp pc, (Ast_yield_pre sp pc mP S) -> (Ast_yield_post sp pc mP S') /\ S_RF S' = S_RF S. (* : cli *) Definition Ast_yield_1 (sp pc : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec sp _STK_SIZE_yield *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_1_p (S : State) : Prop := exists sp, exists pc, Ast_yield_1 sp pc mTrue S. Definition L_yield_1_g (S S' : State) : Prop := forall mP, forall sp pc, (Ast_yield_1 sp pc mP S) -> (Ast_yield_post sp pc mP S') /\ S_RF S' = S_RF S. (* : pushw %ax *) Definition Ast_yield_2 (sp pc ax : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-2) (_STK_SIZE_yield - 2) *^* sp-2 |->w (S_RF S AX) *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S AX = ax /\ S_RF S SP = sp-2 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_2_p (S : State) : Prop := exists sp, exists pc, exists ax, Ast_yield_2 sp pc ax mTrue S. Definition L_yield_2_g (S S' : State) : Prop := forall mP, forall sp pc ax, Ast_yield_2 sp pc ax mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = S_RF S BX /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %bx *) Definition Ast_yield_3 (sp pc ax bx : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-4) (_STK_SIZE_yield - 4) *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S BX = bx /\ S_RF S SP = sp-4 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_3_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, Ast_yield_3 sp pc ax bx mTrue S. Definition L_yield_3_g (S S' : State) : Prop := forall mP, forall sp pc ax bx, Ast_yield_3 sp pc ax bx mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %cx *) Definition Ast_yield_4 (sp pc ax bx cx : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-6) (_STK_SIZE_yield - 6) *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S CX = cx /\ S_RF S SP = sp-6 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_4_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, Ast_yield_4 sp pc ax bx cx mTrue S. Definition L_yield_4_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx, Ast_yield_4 sp pc ax bx cx mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %dx *) Definition Ast_yield_5 (sp pc ax bx cx dx : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-8) (_STK_SIZE_yield - 8) *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S DX = dx /\ S_RF S SP = sp-8 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_5_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, Ast_yield_5 sp pc ax bx cx dx mTrue S. Definition L_yield_5_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx dx, Ast_yield_5 sp pc ax bx cx dx mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %di *) Definition Ast_yield_6 (sp pc ax bx cx dx di : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-10) (_STK_SIZE_yield - 10) *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S DI = di /\ S_RF S SP = sp-10 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_6_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, Ast_yield_6 sp pc ax bx cx dx di mTrue S. Definition L_yield_6_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx dx di, Ast_yield_6 sp pc ax bx cx dx di mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %si *) Definition Ast_yield_7 (sp pc ax bx cx dx di si : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-12) (_STK_SIZE_yield - 12) *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SI = si /\ S_RF S SP = sp-12 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_7_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, Ast_yield_7 sp pc ax bx cx dx di si mTrue S. Definition L_yield_7_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx dx di si, Ast_yield_7 sp pc ax bx cx dx di si mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %bp *) Definition Ast_yield_8 (sp pc ax bx cx dx di si bp : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-14) (_STK_SIZE_yield - 14) *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp-14 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_8_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, Ast_yield_8 sp pc ax bx cx dx di si bp mTrue S. Definition L_yield_8_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx dx di si bp, Ast_yield_8 sp pc ax bx cx dx di si bp mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : pushfw *) Definition Ast_yield_9 (sp pc ax bx cx dx di si bp flnum : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-16) (_STK_SIZE_yield - 16) *^* sp-16 |->w flnum *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp-16 /\ sp >= _STK_SIZE_yield /\ (nat2FR flnum) _IF = false /\ S_Flag S = nat2FR flnum /\ S_ISR S = false. Definition L_yield_9_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, exists flnum, Ast_yield_9 sp pc ax bx cx dx di si bp flnum mTrue S. Definition L_yield_9_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx dx di si bp flnum, Ast_yield_9 sp pc ax bx cx dx di si bp flnum mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : call scheduler *) Definition Ast_yield_10 (sp pc ax bx cx dx di si bp flnum : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-16) (_STK_SIZE_yield - 16) *^* sp-16 |->w flnum *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp-16 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ (nat2FR flnum) _IF = false /\ S_ISR S = false. Definition L_yield_10_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, exists flnum, Ast_yield_10 sp pc ax bx cx dx di si bp flnum mTrue S. Definition L_yield_10_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx dx di si bp flnum, Ast_yield_10 sp pc ax bx cx dx di si bp flnum mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : popfw *) Definition Ast_yield_11 (sp pc ax bx cx dx di si bp : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-14) (_STK_SIZE_yield - 14) *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp-14 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_11_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, Ast_yield_11 sp pc ax bx cx dx di si bp mTrue S. Definition L_yield_11_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx dx di si bp, Ast_yield_11 sp pc ax bx cx dx di si bp mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : popw %bp *) Definition Ast_yield_12 (sp pc ax bx cx dx di si : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-12) (_STK_SIZE_yield - 12) *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp-12 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_12_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, Ast_yield_12 sp pc ax bx cx dx di si mTrue S. Definition L_yield_12_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx dx di si, Ast_yield_12 sp pc ax bx cx dx di si mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %si *) Definition Ast_yield_13 (sp pc ax bx cx dx di : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-10) (_STK_SIZE_yield - 10) *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp-10 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_13_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, Ast_yield_13 sp pc ax bx cx dx di mTrue S. Definition L_yield_13_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx dx di, Ast_yield_13 sp pc ax bx cx dx di mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %di *) Definition Ast_yield_14 (sp pc ax bx cx dx : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-8) (_STK_SIZE_yield - 8) *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp-8 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_14_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, Ast_yield_14 sp pc ax bx cx dx mTrue S. Definition L_yield_14_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx dx, Ast_yield_14 sp pc ax bx cx dx mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %dx *) Definition Ast_yield_15 (sp pc ax bx cx : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-6) (_STK_SIZE_yield - 6) *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp-6 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_15_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, exists cx, Ast_yield_15 sp pc ax bx cx mTrue S. Definition L_yield_15_g (S S' : State) : Prop := forall mP, forall sp pc ax bx cx, Ast_yield_15 sp pc ax bx cx mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %cx *) Definition Ast_yield_16 (sp pc ax bx : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-4) (_STK_SIZE_yield - 4) *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp-4 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_16_p (S : State) : Prop := exists sp, exists pc, exists ax, exists bx, Ast_yield_16 sp pc ax bx mTrue S. Definition L_yield_16_g (S S' : State) : Prop := forall mP, forall sp pc ax bx, Ast_yield_16 sp pc ax bx mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %bx *) Definition Ast_yield_17 (sp pc ax : nat) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-2) (_STK_SIZE_yield - 2) *^* sp-2 |->w ax *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp-2 /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_17_p (S : State) : Prop := exists sp, exists pc, exists ax, Ast_yield_17 sp pc ax mTrue S. Definition L_yield_17_g (S S' : State) : Prop := forall mP, forall sp pc ax, Ast_yield_17 sp pc ax mP S -> Ast_yield_post sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = S_RF S BX /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %ax *) Definition Ast_yield_18 (sp pc : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec sp _STK_SIZE_yield *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp /\ sp >= _STK_SIZE_yield /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_yield_18_p (S : State) : Prop := exists sp, exists pc, Ast_yield_18 sp pc mTrue S. Definition L_yield_18_g (S S' : State) : Prop := forall mP, forall sp pc, (Ast_yield_18 sp pc mP S) -> (Ast_yield_post sp pc mP S') /\ S_RF S' = S_RF S. (* : sti *) Definition Ast_yield_19 (sp pc : Label) (mP : MPred) (S : State) : Prop := (stkSpacePrec sp _STK_SIZE_yield *^* sp |->w pc *^* mP) (S_Mem S) /\ S_RF S SP = sp /\ itr_enabled S. Definition L_yield_19_p (S : State) : Prop := exists sp, exists pc, (Ast_yield_19 sp pc mTrue S). Definition L_yield_19_g (S S' : State) : Prop := forall mP, forall sp pc, (Ast_yield_19 sp pc mP S) -> (Ast_yield_post sp pc mP S') /\ S_RF S' = S_RF S. (* : retw *) Definition tag_yield := 1. Definition p_yield := L_yield_0_p. Definition g_yield := L_yield_0_g. Definition spec_yield := Ast p_yield g_yield tag_yield. Definition psi_yield := SCAP_emptCT. coq/miniOS/SleepSpec.v0000644000107400000620000006017711000223231014320 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath ".." . Add LoadPath "../CAP0" . Add LoadPath "../SCAP" . Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Require Import Kernel. Definition Ast_sleep_0 (l_ptr : Label) (wqa : WQassert) (sp pc : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec sp _STK_SIZE_sleep *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition Ast_sleep_post (l_ptr : Label) (wqa : WQassert) (sp pc : Label) (mP : MPred) (S' : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec sp _STK_SIZE_sleep *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S') /\ S_Flag S' _IF = false /\ S_ISR S' = false. Definition L_sleep_0_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, Ast_sleep_0 l_ptr wqa sp pc mTrue S. Definition L_sleep_0_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc, Ast_sleep_0 l_ptr wqa sp pc mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' = S_RF S. (* : pushw %ax *) Definition Ast_sleep_1 (l_ptr : Label) (wqa : WQassert) (sp pc ax : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-2) (_STK_SIZE_sleep-2) *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S AX = ax /\ S_RF S SP = sp - 2 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition L_sleep_1_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, Ast_sleep_1 l_ptr wqa sp pc ax mTrue S. Definition L_sleep_1_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax, Ast_sleep_1 l_ptr wqa sp pc ax mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = S_RF S BX /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %bx *) Definition Ast_sleep_2 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-4) (_STK_SIZE_sleep-4) *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S BX = bx /\ S_RF S SP = sp - 4 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition L_sleep_2_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, Ast_sleep_2 l_ptr wqa sp pc ax bx mTrue S. Definition L_sleep_2_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx, Ast_sleep_2 l_ptr wqa sp pc ax bx mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %cx *) Definition Ast_sleep_3 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-6) (_STK_SIZE_sleep-6) *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S CX = cx /\ S_RF S SP = sp - 6 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition L_sleep_3_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, Ast_sleep_3 l_ptr wqa sp pc ax bx cx mTrue S. Definition L_sleep_3_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx, Ast_sleep_3 l_ptr wqa sp pc ax bx cx mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %dx *) Definition Ast_sleep_4 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-8) (_STK_SIZE_sleep-8) *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S DX = dx /\ S_RF S SP = sp - 8 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition L_sleep_4_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, Ast_sleep_4 l_ptr wqa sp pc ax bx cx dx mTrue S. Definition L_sleep_4_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx, Ast_sleep_4 l_ptr wqa sp pc ax bx cx dx mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %di *) Definition Ast_sleep_5 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-10) (_STK_SIZE_sleep-10) *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S DI = di /\ S_RF S SP = sp - 10 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition L_sleep_5_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, Ast_sleep_5 l_ptr wqa sp pc ax bx cx dx di mTrue S. Definition L_sleep_5_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di, Ast_sleep_5 l_ptr wqa sp pc ax bx cx dx di mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %si *) Definition Ast_sleep_6 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di si : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-12) (_STK_SIZE_sleep-12) *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SI = si /\ S_RF S SP = sp - 12 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition L_sleep_6_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, Ast_sleep_6 l_ptr wqa sp pc ax bx cx dx di si mTrue S. Definition L_sleep_6_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di si, Ast_sleep_6 l_ptr wqa sp pc ax bx cx dx di si mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : pushw %bp *) Definition Ast_sleep_7 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di si bp : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-14) (_STK_SIZE_sleep-14) *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp - 14 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition L_sleep_7_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, Ast_sleep_7 l_ptr wqa sp pc ax bx cx dx di si bp mTrue S. Definition L_sleep_7_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di si bp, Ast_sleep_7 l_ptr wqa sp pc ax bx cx dx di si bp mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : pushfw *) Definition Ast_sleep_8 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di si bp flnum : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-16) (_STK_SIZE_sleep - 16) *^* sp-16 |->w flnum *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 16 /\ sp >= _STK_SIZE_sleep /\ S_Flag S = nat2FR flnum /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition L_sleep_8_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, exists flnum, Ast_sleep_8 l_ptr wqa sp pc ax bx cx dx di si bp flnum mTrue S. Definition L_sleep_8_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di si bp flnum, Ast_sleep_8 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : movw %sp, %bp *) Definition Ast_sleep_9 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di si bp flnum : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-16) (_STK_SIZE_sleep - 16) *^* sp-16 |->w flnum *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S BP = S_RF S SP /\ S_RF S SP = sp - 16 /\ sp >= _STK_SIZE_sleep /\ (nat2FR flnum) _IF = false /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition L_sleep_9_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, exists flnum, Ast_sleep_9 l_ptr wqa sp pc ax bx cx dx di si bp flnum mTrue S. Definition L_sleep_9_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di si bp flnum, Ast_sleep_9 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : pushw 18(%bp) *) Definition Ast_sleep_10 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di si bp flnum : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* stkSpacePrec (sp-18) (_STK_SIZE_sleep - 18) *^* sp-18 |->w l_ptr *^* sp-16 |->w flnum *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 18 /\ sp >= _STK_SIZE_sleep /\ (nat2FR flnum) _IF = false /\ S_Flag S _IF = false /\ S_ISR S = false /\ Delta l_ptr = SomeT wqa. Definition L_sleep_10_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, exists flnum, Ast_sleep_10 l_ptr wqa sp pc ax bx cx dx di si bp flnum mTrue S. Definition L_sleep_10_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di si bp flnum, Ast_sleep_10 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : call block *) Definition Ast_sleep_11 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di si bp flnum : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec (sp-18) (_STK_SIZE_sleep - 18) *^* sp-18 |->w l_ptr *^* sp-16 |->w flnum *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 18 /\ sp >= _STK_SIZE_sleep /\ (nat2FR flnum) _IF = false /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_sleep_11_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, exists flnum, Ast_sleep_11 l_ptr wqa sp pc ax bx cx dx di si bp flnum mTrue S. Definition L_sleep_11_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di si bp flnum, Ast_sleep_11 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : addw $2, %sp *) Definition Ast_sleep_12 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di si bp flnum : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec (sp-16) (_STK_SIZE_sleep - 16) *^* sp-16 |->w flnum *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 16 /\ sp >= _STK_SIZE_sleep /\ (nat2FR flnum) _IF = false /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_sleep_12_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, exists flnum, Ast_sleep_12 l_ptr wqa sp pc ax bx cx dx di si bp flnum mTrue S. Definition L_sleep_12_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di si bp flnum, Ast_sleep_12 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : popfw *) Definition Ast_sleep_13 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di si bp : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec (sp-14) (_STK_SIZE_sleep - 14) *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 14 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_sleep_13_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, Ast_sleep_13 l_ptr wqa sp pc ax bx cx dx di si bp mTrue S. Definition L_sleep_13_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di si bp, Ast_sleep_13 l_ptr wqa sp pc ax bx cx dx di si bp mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* : popw %bp *) Definition Ast_sleep_14 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di si : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec (sp-12) (_STK_SIZE_sleep - 12) *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 12 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_sleep_14_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, exists si, Ast_sleep_14 l_ptr wqa sp pc ax bx cx dx di si mTrue S. Definition L_sleep_14_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di si, Ast_sleep_14 l_ptr wqa sp pc ax bx cx dx di si mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %si *) Definition Ast_sleep_15 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx di : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec (sp-10) (_STK_SIZE_sleep - 10) *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 10 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_sleep_15_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, exists di, Ast_sleep_15 l_ptr wqa sp pc ax bx cx dx di mTrue S. Definition L_sleep_15_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx di, Ast_sleep_15 l_ptr wqa sp pc ax bx cx dx di mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %di *) Definition Ast_sleep_16 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx dx : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec (sp-8) (_STK_SIZE_sleep - 8) *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 8 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_sleep_16_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, exists dx, Ast_sleep_16 l_ptr wqa sp pc ax bx cx dx mTrue S. Definition L_sleep_16_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx dx, Ast_sleep_16 l_ptr wqa sp pc ax bx cx dx mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %dx *) Definition Ast_sleep_17 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx cx : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec (sp-6) (_STK_SIZE_sleep - 6) *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 6 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_sleep_17_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, exists cx, Ast_sleep_17 l_ptr wqa sp pc ax bx cx mTrue S. Definition L_sleep_17_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx cx, Ast_sleep_17 l_ptr wqa sp pc ax bx cx mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %cx *) Definition Ast_sleep_18 (l_ptr : Label) (wqa : WQassert) (sp pc ax bx : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec (sp-4) (_STK_SIZE_sleep - 4) *^* sp-4 |->w bx *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 4 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_sleep_18_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, exists bx, Ast_sleep_18 l_ptr wqa sp pc ax bx mTrue S. Definition L_sleep_18_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax bx, Ast_sleep_18 l_ptr wqa sp pc ax bx mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %bx *) Definition Ast_sleep_19 (l_ptr : Label) (wqa : WQassert) (sp pc ax : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec (sp-2) (_STK_SIZE_sleep - 2) *^* sp-2 |->w ax *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_sleep_19_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, exists ax, Ast_sleep_19 l_ptr wqa sp pc ax mTrue S. Definition L_sleep_19_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc ax, Ast_sleep_19 l_ptr wqa sp pc ax mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = ax /\ S_RF S' BX = S_RF S BX /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : popw %ax *) Definition Ast_sleep_20 (l_ptr : Label) (wqa : WQassert) (sp pc : Label) (mP : MPred) (S : State) : Prop := (INV1 *^* INV0 *^* wqa *^* stkSpacePrec sp _STK_SIZE_sleep *^* sp |->w pc *^* sp+2 |->w l_ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp /\ sp >= _STK_SIZE_sleep /\ S_Flag S _IF = false /\ S_ISR S = false. Definition L_sleep_20_p (S : State) : Prop := exists l_ptr, exists wqa, exists sp, exists pc, Ast_sleep_20 l_ptr wqa sp pc mTrue S. Definition L_sleep_20_g (S S' : State) : Prop := forall mP, forall l_ptr wqa sp pc, Ast_sleep_20 l_ptr wqa sp pc mP S -> Ast_sleep_post l_ptr wqa sp pc mP S' /\ S_RF S' AX = S_RF S AX /\ S_RF S' BX = S_RF S BX /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. (* : retw *) Definition tag_sleep := 1. Definition p_sleep := L_sleep_0_p. Definition g_sleep := L_sleep_0_g. Definition spec_sleep := Ast p_sleep g_sleep tag_sleep. Definition psi_sleep := SCAP_emptCT. coq/miniOS/TimerProof.v0000644000107400000620000025212611000223231014520 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) (*******************************************) (** Prove Timer (timer interrupt handler) with AIM *******) (** $Id: TimerProof.v,v 1.9 2008/04/04 14:36:16 ssg05 Exp $ **) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import AIM. Require Import SCAP. Require Import SCAP_Itr. Require Import Linking. Require Import OpSem_Lemmas. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas2. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas5. Require Import Reg. Require Import Timer. Definition timer_pushbx_MPre (sp ax : nat) : MPred := fun (M : Mem) => (INV0 *^* stkSpacePrec (sp-2) (IH_Stk-2) *^* sp-2 |->w ax) M. Definition timer_pushbx_pre (sp ax : nat) (S : State) : Prop := timer_pushbx_MPre sp ax (S_Mem S) /\ S_RF S AX = ax /\ S_RF S SP = sp - 2 /\ sp >= IH_Stk /\ S_ISR S = true /\ S_Flag S _IF = false. Definition p_timer_pushbx (S : State) : Prop := exists sp, exists ax, imprec (timer_pushbx_pre sp ax) S. Definition timer_pushbx_post (sp ax : nat) (S S':State) (M0':Mem) : Prop := timer_post sp (S_Mem_Upd S' M0') /\ S_RF S' AX = ax /\ S_RF S' BX = S_RF S BX /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. Definition g_timer_pushbx (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax, timer_pushbx_pre sp ax (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushbx_post sp ax S S' M0'. Lemma timer_pushax_has_stack: forall R h, (INV0 *^* stkSpacePrec (R SP) IH_Stk) h -> R SP >= IH_Stk /\ (exists ax, ((R SP-2) |~>w ax) h). Proof. intros R h pre. assert (R SP >= IH_Stk). destruct pre as [M1 [M2 [djh [mM1 [spge mM2]]]]]. auto. split_l. sep on. assert (Hx : h ||- stkSpacePrec (R SP - 2) (IH_Stk - 2) *^* R SP - 2 |->w_ *^* INV0). assocr. apply stkSpacePrec_splitW1. arith_rep (R SP - 2 + 2) with (R SP). replace (IH_Stk - 2 + 2) with (IH_Stk). sep matchH pre with 2. simpl; trivial. sep lift 1 in Hx. sep elim_left Hx. exists v. sep on. sep trivial. Qed. Lemma timer_pushax_pre2post: forall R h h', (INV0 *^* stkSpacePrec (R SP) IH_Stk) h -> MemUpd16 h (R SP - 2) (R AX) h' -> R SP >= IH_Stk -> timer_pushbx_MPre (R SP) (R AX) h'. Proof. intros R h h' pre HM' spge. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. unfold timer_pushbx_MPre. subst h'. sep on. assert (Hx : h ||- stkSpacePrec (R SP - 2) (IH_Stk - 2) *^* R SP - 2 |->w_ *^* INV0). assocr. apply stkSpacePrec_splitW1. arith_rep (R SP - 2 + 2) with (R SP). arith_rep (IH_Stk - 2 + 2) with (IH_Stk). sep matchH pre with 2. sep lift 2. sep upd. sep matchH Hx with 5. Qed. Lemma IH_WFcmd_1127_pushax: IH_WFcmd (SCAP_consCT (h_entry + 1) (Ast p_timer_pushbx g_timer_pushbx ihtag) Psi_timer) h_entry s_timer (comml (_pushwp (Opr_reg AX))). Proof. exists p_timer_pushbx. exists g_timer_pushbx. split. constructor. auto. split. intros st [pre [inIsr IFtrue]]. destruct pre as [M1 [M2 [djh [pre' mM2]]]]. induction st as (((h, R), fl), isr); UnfoldStateAll. destruct (timer_pushax_has_stack R M2 mM2) as [spge [ax ld2sp]]. exists ((MemMod.put (MemMod.put h (R SP -2) (opr_eval R (Opr_reg AX))) (R SP-2+1)(opr_eval R (Opr_reg AX))), (RF_update R SP (R SP-2)), fl, isr). apply nextS_pushwp with (opr_eval R (Opr_reg AX)); auto. unfold pushW. split. split_l. omega. apply leadsToW_leadsToBlk with ax; auto. apply leadsToW_Mono with M2 M1; auto. apply MemMod.disjUnion_commut; auto. unfold opr_eval, MemUpd16. split_r. exists (opr_eval R (Opr_reg AX)); auto. split. (** pimp **) intros st' [st [pS nS]]. destruct pS as [pre [inIsr IFtrue]]. destruct pre as [M1 [M2 [djh [pre' mM2]]]]. destruct (timer_pushax_has_stack (S_RF st) M2 mM2) as [spge [ax ld2sp]]. induction st as (((h, R), fl), isr); UnfoldStateAll. induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. exists (R SP). exists (R AX). assert (leadsToxW (R SP -2) M2). apply leadsToW_leadsToxW with ax; auto. destruct (leadsToxW_MemUpd16_DMonoR djh H memUp) as [M2' [djh' upM2]]. rewrite rfUp. rewrite eqfl. rewrite eqisr. exists M2'. exists M1. split. apply MemMod.disjUnion_commut; auto. split_r. repeat split; auto. UnfoldStateAll. apply timer_pushax_pre2post with M2; auto. (** gimp **) intros st st'' [st' [[pS nS] gS]]. destruct pS as [pre [inIsr IFtrue]]. (** 1. pS -> nS -> pS', S.H = M1 *^* M2 **) destruct pre as [M1 [M2 [djh [pre' mM2]]]]. destruct (timer_pushax_has_stack (S_RF st) M2 mM2) as [spge [ax ld2sp]]. induction st as (((h, R), fl), isr); UnfoldStateAll. induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. assert (leadsToxW (R SP -2) M2). apply leadsToW_leadsToxW with ax; auto. destruct (leadsToxW_MemUpd16_DMonoR djh H memUp) as [M2' [djh' upM2]]. assert (timer_pushbx_pre (R SP) (R AX) (M2', R', fl', isr')). rewrite rfUp. rewrite eqfl. rewrite eqisr. repeat split; auto. UnfoldStateAll. unfold RF_update; unfold beq_reg. apply timer_pushax_pre2post with M2; auto. rename H0 into mM2'. assert (MemMod.disjUnion M2' M1 h'). apply MemMod.disjUnion_commut; auto. clear djh'. rename H0 into djh'. induction st'' as (((h'', R''), fl''), isr''). unfold g_timer_pushbx in gS. (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) substH gS with (gS M2' M1 djh' (R SP) (R AX) mM2'). rewrite rfUp in gS. destruct gS as [M2'' [djh'' [[pre'' NinISr] [eqax [eqbx [eqcx [eqdx [eqdi [eqsi [eqbp eqsp]]]]]]]]]]. unfold IHgrt. unfold prepost. UnfoldStateAll. reg simpl. split. exists M2. exists M1. exists M2''. split_l. rewrite eqsp. split_l. split_r. apply MemMod.disjUnion_commut; auto. split_r. apply (extensionality reg nat R R''). induction x; auto. Qed. Definition timer_pushcx_MPre (sp ax bx : nat) : MPred := fun (M : Mem) => (INV0 *^* stkSpacePrec (sp-4) (IH_Stk-4) *^* sp-4 |->w bx *^* sp-2 |->w ax) M. Definition timer_pushcx_pre (sp ax bx : nat) (S : State) : Prop := timer_pushcx_MPre sp ax bx (S_Mem S) /\ S_RF S BX = bx /\ S_RF S SP = sp - 4 /\ sp >= IH_Stk /\ S_ISR S = true /\ S_Flag S _IF = false. Definition p_timer_pushcx (S : State) : Prop := exists sp, exists ax, exists bx, imprec (timer_pushcx_pre sp ax bx) S. Definition timer_pushcx_post (sp ax bx : nat) (S S':State) (M0':Mem) : Prop := timer_post sp (S_Mem_Upd S' M0') /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = S_RF S CX /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. Definition g_timer_pushcx (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx, timer_pushcx_pre sp ax bx (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushcx_post sp ax bx S S' M0'. Lemma timer_pushbx_has_stack: forall h sp ax, timer_pushbx_MPre sp ax h -> sp >= IH_Stk -> exists bx, ((sp-4) |~>w bx) h. Proof. unfold timer_pushbx_MPre; intros h sp ax pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-4) (IH_Stk-4) *^* sp-4 |->w_ *^* (sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 4 + 2) with (sp-2). arith_rep (IH_Stk - 4 + 2) with (IH_Stk-2). sep matchH pre with 2. sep lift 1 in Hx. sep elim_left Hx. exists v. sep on. sep trivial. Qed. Lemma timer_pushbx_pre2post: forall sp ax bx h h', timer_pushbx_MPre sp ax h -> MemUpd16 h (sp - 4) bx h' -> sp >= IH_Stk -> timer_pushcx_MPre sp ax bx h'. Proof. intros sp ax bx h h' pre HM' spge. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. unfold timer_pushcx_MPre, timer_pushbx_MPre in * . subst h'. sep on. sep lift 2. reg simpl. sep upd. assert (Hx : h ||- stkSpacePrec (sp-4) (IH_Stk-4) *^* sp-4 |->w_ *^* (sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 4 + 2) with (sp-2). arith_rep (IH_Stk - 4 + 2) with (IH_Stk-2). sep matchH pre with 2. sep matchH Hx with 4. Qed. Lemma IH_WFcmd_1128_pushbx: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1) (Ast p_timer_pushcx g_timer_pushcx ihtag) Psi_timer) (h_entry + 1) (Ast p_timer_pushbx g_timer_pushbx ihtag) (comml (_pushwp (Opr_reg BX))). Proof. exists p_timer_pushcx. exists g_timer_pushcx. split. constructor. auto. split. intros st [sp [ax pre]]. induction st as (((h, R), fl), isr). destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqax [eqsp [spge [inIsr IFtrue]]]]]. UnfoldStateAll. destruct (timer_pushbx_has_stack M1 sp ax mM1 spge) as [bx ld2sp]. exists ((MemMod.put (MemMod.put h (R SP -2) (opr_eval R (Opr_reg BX))) (R SP -2+1)(opr_eval R (Opr_reg BX))), (RF_update R SP (R SP -2)), fl, isr). apply nextS_pushwp with (opr_eval R (Opr_reg BX)); auto. unfold pushW. split. split_l. omega. apply leadsToW_leadsToBlk with bx; auto. rewrite eqsp. replace (sp-2-2) with (sp-4). apply leadsToW_Mono with M1 M2; auto. omega. unfold opr_eval, MemUpd16. split_r. exists (opr_eval R (Opr_reg BX)); auto. split. (** pimp **) intros st' [st [pS nS]]. destruct pS as [sp [ax pre]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqax [eqsp [spge [inIsr IFtrue]]]]]. destruct (timer_pushbx_has_stack M1 sp ax mM1 spge) as [bx ld2sp]. induction st as (((h, R), fl), isr); UnfoldStateAll. induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. exists sp. exists ax. exists (R BX). assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with bx. rewrite eqsp. replace (sp-2-2) with (sp-4); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. rewrite rfUp. rewrite eqfl. rewrite eqisr. exists M1'. exists M2. split_l. split_r. repeat split; auto. UnfoldStateAll. apply timer_pushbx_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-4) with (sp-2-2); auto. omega. UnfoldStateAll. reg simpl. rewrite eqsp. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). induction st'' as (((h'', R''), fl''), isr''). destruct (nextS_inversion nS). clear nS. (** nS **) unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. unfold g_timer_pushbx. (** goal: old gS **) intros M1 M2 djh sp ax [mM1 [eqax [eqsp [spge [inIsr IFtrue]]]]]. UnfoldStateAll. destruct (timer_pushbx_has_stack M1 sp ax mM1 spge) as [bx ld2sp]. assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with bx. rewrite eqsp. replace (sp-2-2) with (sp-4); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. assert (timer_pushcx_pre sp ax (R BX) (M1', R', fl', isr')). rewrite rfUp. rewrite eqfl. rewrite eqisr. repeat split; auto. UnfoldStateAll. apply timer_pushbx_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-4) with (sp-2-2); auto. omega. unfold S_RF. reg simpl. rewrite eqsp. omega. rename H0 into mM1'. unfold g_timer_pushcx in gS. (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) substH gS with (gS M1' M2 djh' sp ax (R BX) mM1'). rewrite rfUp in gS. destruct gS as [M1'' [djh'' [pre'' [eqax'' [eqbx [eqcx [eqdx [eqdi [eqsi [eqbp eqsp'']]]]]]]]]]. UnfoldStateAll. reg simpl. exists M1''. split_l. split_l. repeat split; auto. Qed. Definition timer_pushdx_MPre (sp ax bx cx: nat) : MPred := fun (M : Mem) => (INV0 *^* stkSpacePrec (sp-6) (IH_Stk-6) *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax) M. Definition timer_pushdx_pre (sp ax bx cx: nat) (S : State) : Prop := timer_pushdx_MPre sp ax bx cx (S_Mem S) /\ S_RF S CX = cx /\ S_RF S SP = sp - 6 /\ sp >= IH_Stk /\ S_ISR S = true /\ S_Flag S _IF = false. Definition p_timer_pushdx (S : State) : Prop := exists sp, exists ax, exists bx, exists cx, imprec (timer_pushdx_pre sp ax bx cx) S. Definition timer_pushdx_post (sp ax bx cx: nat) (S S':State) (M0':Mem) : Prop := timer_post sp (S_Mem_Upd S' M0') /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = S_RF S DX /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. Definition g_timer_pushdx (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx cx, timer_pushdx_pre sp ax bx cx (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushdx_post sp ax bx cx S S' M0'. Lemma timer_pushcx_has_stack: forall h sp ax bx, timer_pushcx_MPre sp ax bx h -> sp >= IH_Stk -> exists cx, (sp-6 |~>w cx) h. Proof. unfold timer_pushcx_MPre; intros h sp ax bx pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-6) (IH_Stk-6) *^* sp-6 |->w_ *^* (sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 6 + 2) with (sp-4). arith_rep (IH_Stk - 6 + 2) with (IH_Stk-4). sep matchH pre with 3. sep lift 1 in Hx. sep elim_left Hx. exists v. sep on. sep trivial. Qed. Lemma timer_pushcx_pre2post: forall sp ax bx cx h h', timer_pushcx_MPre sp ax bx h -> MemUpd16 h (sp-6) cx h' -> sp >= IH_Stk -> timer_pushdx_MPre sp ax bx cx h'. Proof. intros sp ax bx cx h h' pre HM' spge. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. unfold timer_pushcx_MPre, timer_pushdx_MPre in * . subst h'. sep on. sep lift 2. reg simpl. sep upd. assert (Hx : h ||- stkSpacePrec (sp-6) (IH_Stk-6) *^* sp-6 |->w_ *^* (sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 6 + 2) with (sp-4). arith_rep (IH_Stk - 6 + 2) with (IH_Stk-4). sep matchH pre with 3. sep matchH Hx with 5. Qed. Lemma IH_WFcmd_1129_pushcx: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1) (Ast p_timer_pushdx g_timer_pushdx ihtag) Psi_timer) (h_entry + 1 + 1) (Ast p_timer_pushcx g_timer_pushcx ihtag) (comml (_pushwp (Opr_reg CX))). Proof. exists p_timer_pushdx. exists g_timer_pushdx. split. constructor. auto. split. intros st [sp [ax [bx pre]]]. induction st as (((h, R), fl), isr). destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqbx [eqsp [spge [inIsr IFtrue]]]]]. UnfoldStateAll. destruct (timer_pushcx_has_stack M1 sp ax bx mM1 spge) as [cx ld2sp]. exists ((MemMod.put (MemMod.put h (R SP -2) (opr_eval R (Opr_reg CX))) (R SP -2+1)(opr_eval R (Opr_reg CX))), (RF_update R SP (R SP -2)), fl, isr). apply nextS_pushwp with (opr_eval R (Opr_reg CX)); auto. unfold pushW. split. split_l. omega. apply leadsToW_leadsToBlk with cx; auto. rewrite eqsp. replace (sp-4-2) with (sp-6). apply leadsToW_Mono with M1 M2; auto. omega. unfold opr_eval, MemUpd16. split_r. exists (opr_eval R (Opr_reg CX)); auto. split. (** pimp **) intros st' [st [pS nS]]. destruct pS as [sp [ax [bx pre]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqbx [eqsp [spge [inIsr IFtrue]]]]]. destruct (timer_pushcx_has_stack M1 sp ax bx mM1 spge) as [cx ld2sp]. induction st as (((h, R), fl), isr); UnfoldStateAll. induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. exists sp. exists ax. exists bx. exists (R CX). assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with cx. rewrite eqsp. replace (sp-4-2) with (sp-6); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. rewrite rfUp. rewrite eqfl. rewrite eqisr. exists M1'. exists M2. split_l. split_r. repeat split; auto. UnfoldStateAll. apply timer_pushcx_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-6) with (sp-4-2); auto. omega. UnfoldStateAll. reg simpl. rewrite eqsp. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). induction st'' as (((h'', R''), fl''), isr''). destruct (nextS_inversion nS). clear nS. (** nS **) unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. intros M1 M2 djh sp ax bx [mM1 [eqbx [eqsp [spge [inIsr IFtrue]]]]]. UnfoldStateAll. destruct (timer_pushcx_has_stack M1 sp ax bx mM1 spge) as [cx ld2sp]. assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with cx. rewrite eqsp. replace (sp-4-2) with (sp-6); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. assert (timer_pushdx_pre sp ax bx (R CX) (M1', R', fl', isr')). rewrite rfUp. rewrite eqfl. rewrite eqisr. repeat split; auto. UnfoldStateAll. apply timer_pushcx_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-6) with (sp-4-2); auto. omega. unfold S_RF. reg simpl. rewrite eqsp. omega. rename H0 into mM1'. substH gS with (gS M1' M2 djh' sp ax bx (R CX) mM1'). (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) rewrite rfUp in gS. destruct gS as [M1'' [djh'' [pre'' [eqax [eqbx'' [eqcx [eqdx [eqdi [eqsi [eqbp eqsp'']]]]]]]]]]. UnfoldStateAll. reg simpl. exists M1''. split_l. split_l. repeat split; auto. Qed. Definition timer_pushdi_MPre (sp ax bx cx dx: nat) : MPred := fun (M : Mem) => (INV0 *^* stkSpacePrec (sp-8) (IH_Stk-8) *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax) M. Definition timer_pushdi_pre (sp ax bx cx dx: nat) (S : State) : Prop := timer_pushdi_MPre sp ax bx cx dx (S_Mem S) /\ S_RF S DX = dx /\ S_RF S SP = sp - 8 /\ sp >= IH_Stk /\ S_ISR S = true /\ S_Flag S _IF = false. Definition p_timer_pushdi (S : State) : Prop := exists sp, exists ax, exists bx, exists cx, exists dx, imprec (timer_pushdi_pre sp ax bx cx dx) S. Definition timer_pushdi_post (sp ax bx cx dx: nat) (S S':State) (M0':Mem) : Prop := timer_post sp (S_Mem_Upd S' M0') /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = S_RF S DI /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. Definition g_timer_pushdi (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx cx dx, timer_pushdi_pre sp ax bx cx dx (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushdi_post sp ax bx cx dx S S' M0'. Lemma timer_pushdx_has_stack: forall h sp ax bx cx, timer_pushdx_MPre sp ax bx cx h -> sp>=IH_Stk -> exists dx, (sp-8 |~>w dx) h. Proof. unfold timer_pushdx_MPre; intros h sp ax bx cx pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-8) (IH_Stk-8) *^* sp-8 |->w_ *^* (sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 8 + 2) with (sp-6). arith_rep (IH_Stk - 8 + 2) with (IH_Stk-6). sep matchH pre with 3. sep lift 1 in Hx. sep elim_left Hx. exists v. sep on. sep trivial. Qed. Lemma timer_pushdx_pre2post: forall sp ax bx cx dx h h', timer_pushdx_MPre sp ax bx cx h -> MemUpd16 h (sp-8) dx h' -> sp >= IH_Stk -> timer_pushdi_MPre sp ax bx cx dx h'. Proof. intros sp ax bx cx dx h h' pre HM' spge. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. unfold timer_pushdi_MPre, timer_pushdx_MPre in * . subst h'. sep on. sep lift 2. reg simpl. sep upd. assert (Hx : h ||- stkSpacePrec (sp-8) (IH_Stk-8) *^* sp-8 |->w_ *^* (sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 8 + 2) with (sp-6). arith_rep (IH_Stk - 8 + 2) with (IH_Stk-6). sep matchH pre with 3. sep matchH Hx with 6. Qed. Lemma IH_WFcmd_1130_pushdx: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1) (Ast p_timer_pushdi g_timer_pushdi ihtag) Psi_timer) (h_entry + 1 + 1 + 1) (Ast p_timer_pushdx g_timer_pushdx ihtag) (comml (_pushwp (Opr_reg DX))). Proof. exists p_timer_pushdi. exists g_timer_pushdi. split. constructor. auto. split. intros st [sp [ax [bx [cx pre]]]]. induction st as (((h, R), fl), isr). destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqcx [eqsp [spge [inIsr IFtrue]]]]]. UnfoldStateAll. destruct (timer_pushdx_has_stack M1 sp ax bx cx mM1 spge) as [dx ld2sp]. exists ((MemMod.put (MemMod.put h (R SP -2) (opr_eval R (Opr_reg DX))) (R SP -2+1)(opr_eval R (Opr_reg DX))), (RF_update R SP (R SP -2)), fl, isr). apply nextS_pushwp with (opr_eval R (Opr_reg DX)); auto. unfold pushW. split. split_l. omega. apply leadsToW_leadsToBlk with dx; auto. rewrite eqsp. replace (sp-6-2) with (sp-8). apply leadsToW_Mono with M1 M2; auto. omega. unfold opr_eval, MemUpd16. split_r. exists (opr_eval R (Opr_reg DX)); auto. split. (** pimp **) intros st' [st [pS nS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. destruct pS as [sp [ax [bx [cx pre]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqcx [eqsp [spge [inIsr IFtrue]]]]]. destruct (timer_pushdx_has_stack M1 sp ax bx cx mM1 spge) as [dx ld2sp]. UnfoldStateAll. assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with dx. rewrite eqsp. replace (sp-6-2) with (sp-8); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. exists sp. exists ax. exists bx. exists cx. exists (R DX). rewrite rfUp. rewrite eqfl. rewrite eqisr. exists M1'. exists M2. split_l. split_r. repeat split; auto. unfold S_Mem, S_Mem_Upd. apply timer_pushdx_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-8) with (sp-6-2); auto. omega. unfold S_Mem_Upd, S_RF. reg simpl. rewrite eqsp. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). induction st'' as (((h'', R''), fl''), isr''). destruct (nextS_inversion nS). clear nS. (** nS **) unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. intros M1 M2 djh sp ax bx cx [mM1 [eqcx [eqsp [spge [inIsr IFtrue]]]]]. destruct (timer_pushdx_has_stack M1 sp ax bx cx mM1 spge) as [dx ld2sp]. UnfoldStateAll. assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with dx. rewrite eqsp. replace (sp-6-2) with (sp-8); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. assert (timer_pushdi_pre sp ax bx cx (R DX) (M1', R', fl', isr')). rewrite rfUp. rewrite eqfl. rewrite eqisr. repeat split; auto. unfold S_Mem, S_Mem_Upd. apply timer_pushdx_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-8) with (sp-6-2); auto. omega. unfold S_RF. reg simpl. rewrite eqsp. omega. rename H0 into mM1'. substH gS with (gS M1' M2 djh' sp ax bx cx (R DX) mM1'). (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) rewrite rfUp in gS. destruct gS as [M1'' [djh'' [pre'' [eqax [eqbx [eqcx'' [eqdx [eqdi [eqsi [eqbp eqsp'']]]]]]]]]]. UnfoldStateAll. reg simpl. exists M1''. split_l. split_l. repeat split; auto. Qed. Definition timer_pushsi_MPre (sp ax bx cx dx di: nat) : MPred := fun (M : Mem) => (INV0 *^* stkSpacePrec (sp-10) (IH_Stk-10) *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax) M. Definition timer_pushsi_pre (sp ax bx cx dx di : nat) (S : State) : Prop := timer_pushsi_MPre sp ax bx cx dx di (S_Mem S) /\ S_RF S DI = di /\ S_RF S SP = sp - 10 /\ sp >= IH_Stk /\ S_ISR S = true /\ S_Flag S _IF = false. Definition p_timer_pushsi (S : State) : Prop := exists sp, exists ax, exists bx, exists cx, exists dx, exists di, imprec (timer_pushsi_pre sp ax bx cx dx di) S. Definition timer_pushsi_post (sp ax bx cx dx di: nat) (S S':State) (M0':Mem) : Prop := timer_post sp (S_Mem_Upd S' M0') /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = S_RF S SI /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. Definition g_timer_pushsi (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx cx dx di, timer_pushsi_pre sp ax bx cx dx di (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushsi_post sp ax bx cx dx di S S' M0'. Lemma timer_pushdi_has_stack: forall h sp ax bx cx dx, timer_pushdi_MPre sp ax bx cx dx h -> sp>=IH_Stk -> exists di, (sp-10 |~>w di) h. Proof. unfold timer_pushdi_MPre; intros h sp ax bx cx dx pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-10) (IH_Stk-10) *^* sp-10 |->w_ *^* (sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 10 + 2) with (sp-8). arith_rep (IH_Stk - 10 + 2) with (IH_Stk-8). sep matchH pre with 3. sep lift 1 in Hx. sep elim_left Hx. exists v. sep on. sep trivial. Qed. Lemma timer_pushdi_pre2post: forall sp ax bx cx dx di h h', timer_pushdi_MPre sp ax bx cx dx h -> MemUpd16 h (sp-10) di h' ->sp >= IH_Stk -> timer_pushsi_MPre sp ax bx cx dx di h'. Proof. intros sp ax bx cx dx di h h' pre HM' spge. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. unfold timer_pushdi_MPre, timer_pushsi_MPre in * . subst h'. sep on. sep lift 2. reg simpl. sep upd. assert (Hx : h ||- stkSpacePrec (sp-10) (IH_Stk-10) *^* sp-10 |->w_ *^* (sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 10 + 2) with (sp-8). arith_rep (IH_Stk - 10 + 2) with (IH_Stk-8). sep matchH pre with 3. sep matchH Hx with 7. Qed. Lemma IH_WFcmd_1131_pushdi: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1) (Ast p_timer_pushsi g_timer_pushsi ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1) (Ast p_timer_pushdi g_timer_pushdi ihtag) (comml (_pushwp (Opr_reg DI))). Proof. exists p_timer_pushsi. exists g_timer_pushsi. split. constructor. auto. split. intros st [sp [ax [bx [cx [dx pre]]]]]. induction st as (((h, R), fl), isr). destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqdx [eqsp [spge [inIsr IFtrue]]]]]. UnfoldStateAll. destruct (timer_pushdi_has_stack M1 sp ax bx cx dx mM1 spge) as [di ld2sp]. exists ((MemMod.put (MemMod.put h (R SP -2) (opr_eval R (Opr_reg DI))) (R SP -2+1)(opr_eval R (Opr_reg DI))), (RF_update R SP (R SP -2)), fl, isr). apply nextS_pushwp with (opr_eval R (Opr_reg DI)); auto. unfold pushW. split. split_l. omega. apply leadsToW_leadsToBlk with di; auto. rewrite eqsp. replace (sp-8-2) with (sp-10). apply leadsToW_Mono with M1 M2; auto. omega. unfold opr_eval, MemUpd16. split_r. exists (opr_eval R (Opr_reg DI)); auto. split. (** pimp **) intros st' [st [pS nS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. destruct pS as [sp [ax [bx [cx [dx pre]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqdx [eqsp [spge [inIsr IFtrue]]]]]. destruct (timer_pushdi_has_stack M1 sp ax bx cx dx mM1 spge) as [di ld2sp]. UnfoldStateAll. assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with di. rewrite eqsp. replace (sp-8-2) with (sp-10); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. exists sp. exists ax. exists bx. exists cx. exists dx. exists (R DI). rewrite rfUp. rewrite eqfl. rewrite eqisr. exists M1'. exists M2. split_l. split_r. repeat split; auto. unfold S_Mem, S_Mem_Upd. apply timer_pushdi_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-10) with (sp-8-2); auto. omega. unfold S_Mem_Upd, S_RF. reg simpl. rewrite eqsp. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). induction st'' as (((h'', R''), fl''), isr''). destruct (nextS_inversion nS). clear nS. (** nS **) unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. intros M1 M2 djh sp ax bx cx dx [mM1 [eqdx [eqsp [spge [inIsr IFtrue]]]]]. destruct (timer_pushdi_has_stack M1 sp ax bx cx dx mM1 spge) as [di ld2sp]. UnfoldStateAll. assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with di. rewrite eqsp. replace (sp-8-2) with (sp-10); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. assert (timer_pushsi_pre sp ax bx cx dx (R DI) (M1', R', fl', isr')). rewrite rfUp. rewrite eqfl. rewrite eqisr. repeat split; auto. unfold S_Mem, S_Mem_Upd. apply timer_pushdi_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-10) with (sp-8-2); auto. omega. unfold S_RF. reg simpl. rewrite eqsp. omega. rename H0 into mM1'. substH gS with (gS M1' M2 djh' sp ax bx cx dx (R DI) mM1'). (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) rewrite rfUp in gS. destruct gS as [M1'' [djh'' [pre'' [eqax [eqbx [eqcx [eqdx'' [eqdi [eqsi [eqbp eqsp'']]]]]]]]]]. UnfoldStateAll. reg simpl. exists M1''. split_l. split_l. repeat split; auto. Qed. Definition timer_pushbp_MPre (sp ax bx cx dx di si: nat) : MPred := fun (M : Mem) => (INV0 *^* stkSpacePrec (sp-12) (IH_Stk-12) *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax) M. Definition timer_pushbp_pre (sp ax bx cx dx di si : nat) (S : State) : Prop := timer_pushbp_MPre sp ax bx cx dx di si (S_Mem S) /\ S_RF S SI = si /\ S_RF S SP = sp - 12 /\ sp >= IH_Stk /\ S_ISR S = true /\ S_Flag S _IF = false. Definition p_timer_pushbp (S : State) : Prop := exists sp, exists ax, exists bx, exists cx, exists dx, exists di, exists si, imprec (timer_pushbp_pre sp ax bx cx dx di si) S. Definition timer_pushbp_post (sp ax bx cx dx di si: nat) (S S':State) (M0':Mem) : Prop := timer_post sp (S_Mem_Upd S' M0') /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = S_RF S BP /\ S_RF S' SP = sp. Definition g_timer_pushbp (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx cx dx di si, timer_pushbp_pre sp ax bx cx dx di si (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushbp_post sp ax bx cx dx di si S S' M0'. Lemma timer_pushsi_has_stack: forall h sp ax bx cx dx di, timer_pushsi_MPre sp ax bx cx dx di h -> sp>=IH_Stk -> exists si, (sp-12 |~>w si) h. Proof. unfold timer_pushsi_MPre; intros h sp ax bx cx dx di pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-12) (IH_Stk-12) *^* sp-12 |->w_ *^* (sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 12 + 2) with (sp-10). arith_rep (IH_Stk - 12 + 2) with (IH_Stk-10). sep matchH pre with 3. sep lift 1 in Hx. sep elim_left Hx. exists v. sep on. sep trivial. Qed. Lemma timer_pushsi_pre2post: forall sp ax bx cx dx di si h h', timer_pushsi_MPre sp ax bx cx dx di h -> MemUpd16 h (sp-12) si h' ->sp >= IH_Stk -> timer_pushbp_MPre sp ax bx cx dx di si h'. Proof. intros sp ax bx cx dx di si h h' pre HM' spge. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. unfold timer_pushbp_MPre, timer_pushsi_MPre in * . subst h'. sep on. sep lift 2. reg simpl. sep upd. assert (Hx : h ||- stkSpacePrec (sp-12) (IH_Stk-12) *^* sp-12 |->w_ *^* (sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 12 + 2) with (sp-10). arith_rep (IH_Stk - 12 + 2) with (IH_Stk-10). sep matchH pre with 3. sep matchH Hx with 8. Qed. Lemma IH_WFcmd_1132_pushsi: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_pushbp g_timer_pushbp ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1) (Ast p_timer_pushsi g_timer_pushsi ihtag) (comml (_pushwp (Opr_reg SI))). Proof. exists p_timer_pushbp. exists g_timer_pushbp. split. constructor. auto. split. intros st [sp [ax [bx [cx [dx [di pre]]]]]]. induction st as (((h, R), fl), isr). destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqdi [eqsp [spge [inIsr IFtrue]]]]]. UnfoldStateAll. destruct (timer_pushsi_has_stack M1 sp ax bx cx dx di mM1 spge) as [si ld2sp]. exists ((MemMod.put (MemMod.put h (R SP -2) (opr_eval R (Opr_reg SI))) (R SP -2+1)(opr_eval R (Opr_reg SI))), (RF_update R SP (R SP -2)), fl, isr). apply nextS_pushwp with (opr_eval R (Opr_reg SI)); auto. unfold pushW. split. split_l. omega. apply leadsToW_leadsToBlk with si; auto. rewrite eqsp. replace (sp-10-2) with (sp-12). apply leadsToW_Mono with M1 M2; auto. omega. unfold opr_eval, MemUpd16. split_r. exists (opr_eval R (Opr_reg SI)); auto. split. (** pimp **) intros st' [st [pS nS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. destruct pS as [sp [ax [bx [cx [dx [di pre]]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqdi [eqsp [spge [inIsr IFtrue]]]]]. destruct (timer_pushsi_has_stack M1 sp ax bx cx dx di mM1 spge) as [si ld2sp]. UnfoldStateAll. assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with si. rewrite eqsp. replace (sp-10-2) with (sp-12); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. exists sp. exists ax. exists bx. exists cx. exists dx. exists di. exists (R SI). rewrite rfUp. rewrite eqfl. rewrite eqisr. exists M1'. exists M2. split_l. split_r. repeat split; auto. unfold S_Mem, S_Mem_Upd. apply timer_pushsi_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-12) with (sp-10-2); auto. omega. unfold S_Mem_Upd, S_RF. reg simpl. rewrite eqsp. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). induction st'' as (((h'', R''), fl''), isr''). destruct (nextS_inversion nS). clear nS. (** nS **) unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. intros M1 M2 djh sp ax bx cx dx di [mM1 [eqdi [eqsp [spge [inIsr IFtrue]]]]]. destruct (timer_pushsi_has_stack M1 sp ax bx cx dx di mM1 spge) as [si ld2sp]. UnfoldStateAll. assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with si. rewrite eqsp. replace (sp-10-2) with (sp-12); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. assert (timer_pushbp_pre sp ax bx cx dx di (R SI) (M1', R', fl', isr')). rewrite rfUp. rewrite eqfl. rewrite eqisr. repeat split; auto. unfold S_Mem, S_Mem_Upd. apply timer_pushsi_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-12) with (sp-10-2); auto. omega. unfold S_RF. reg simpl. rewrite eqsp. omega. rename H0 into mM1'. substH gS with (gS M1' M2 djh' sp ax bx cx dx di (R SI) mM1'). (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) rewrite rfUp in gS. destruct gS as [M1'' [djh'' [pre'' [eqax [eqbx [eqcx [eqdx [eqdi'' [eqsi [eqbp eqsp'']]]]]]]]]]. UnfoldStateAll. reg simpl. exists M1''. split_l. split_l. repeat split; auto. Qed. Definition timer_movax_MPre (sp ax bx cx dx di si bp: nat) : MPred := fun (M : Mem) => (INV0 *^* stkSpacePrec (sp-14) (IH_Stk-14) *^* sp-14 |->w bp *^* sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax) M. Definition timer_movax_pre (sp ax bx cx dx di si bp: nat) (S : State) : Prop := timer_movax_MPre sp ax bx cx dx di si bp (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp - 14 /\ sp >= IH_Stk /\ S_ISR S = true /\ S_Flag S _IF = false. Definition p_timer_movax (S : State) : Prop := exists sp, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, imprec (timer_movax_pre sp ax bx cx dx di si bp) S. Definition timer_movax_post (sp ax bx cx dx di si bp: nat) (S':State) (M0':Mem) : Prop := timer_post sp (S_Mem_Upd S' M0') /\ S_RF S' AX = ax /\ S_RF S' BX = bx /\ S_RF S' CX = cx /\ S_RF S' DX = dx /\ S_RF S' DI = di /\ S_RF S' SI = si /\ S_RF S' BP = bp /\ S_RF S' SP = sp. Definition g_timer_movax (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx cx dx di si bp, timer_movax_pre sp ax bx cx dx di si bp (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_movax_post sp ax bx cx dx di si bp S' M0'. Lemma timer_pushbp_has_stack: forall h sp ax bx cx dx di si, timer_pushbp_MPre sp ax bx cx dx di si h -> sp>=IH_Stk -> exists bp, (sp-14 |~>w bp) h. Proof. unfold timer_pushbp_MPre; intros h sp ax bx cx dx di si pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-14) (IH_Stk-14) *^* sp-14 |->w_ *^* (sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 14 + 2) with (sp-12). arith_rep (IH_Stk - 14 + 2) with (IH_Stk-12). sep matchH pre with 4. sep lift 1 in Hx. sep elim_left Hx. exists v. sep on. sep trivial. Qed. Lemma timer_pushbp_pre2post: forall sp ax bx cx dx di si bp h h', timer_pushbp_MPre sp ax bx cx dx di si h -> MemUpd16 h (sp-14) bp h' -> sp>=IH_Stk -> timer_movax_MPre sp ax bx cx dx di si bp h'. Proof. intros sp ax bx cx dx di si bp h h' pre HM' spge. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. unfold timer_pushbp_MPre, timer_movax_MPre in * . subst h'. sep on. sep lift 2. reg simpl. sep upd. assert (Hx : h ||- stkSpacePrec (sp-14) (IH_Stk-14) *^* sp-14 |->w_ *^* (sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). assocr. apply stkSpacePrec_splitW1. arith_rep (sp - 14 + 2) with (sp-12). arith_rep (IH_Stk - 14 + 2) with (IH_Stk-12). sep matchH pre with 4. sep matchH Hx with 9. Qed. Lemma IH_WFcmd_1133_pushbp: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_movax g_timer_movax ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_pushbp g_timer_pushbp ihtag) (comml (_pushwp (Opr_reg BP))). Proof. exists p_timer_movax. exists g_timer_movax. split. constructor. auto. split. intros st [sp [ax [bx [cx [dx [di [si pre]]]]]]]. induction st as (((h, R), fl), isr). destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqbp [eqsp [spge [inIsr IFtrue]]]]]. UnfoldStateAll. destruct (timer_pushbp_has_stack M1 sp ax bx cx dx di si mM1 spge) as [bp ld2sp]. exists ((MemMod.put (MemMod.put h (R SP -2) (opr_eval R (Opr_reg BP))) (R SP -2+1)(opr_eval R (Opr_reg BP))), (RF_update R SP (R SP -2)), fl, isr). apply nextS_pushwp with (opr_eval R (Opr_reg BP)); auto. unfold pushW. split. split_l. omega. apply leadsToW_leadsToBlk with bp; auto. rewrite eqsp. replace (sp-12-2) with (sp-14). apply leadsToW_Mono with M1 M2; auto. omega. unfold opr_eval, MemUpd16. split_r. exists (opr_eval R (Opr_reg BP)); auto. split. (** pimp **) intros st' [st [pS nS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. destruct pS as [sp [ax [bx [cx [dx [di [si pre]]]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsi [eqsp [spge [inIsr IFtrue]]]]]. destruct (timer_pushbp_has_stack M1 sp ax bx cx dx di si mM1 spge) as [bp ld2sp]. UnfoldStateAll. assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with bp. rewrite eqsp. replace (sp-12-2) with (sp-14); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. exists sp. exists ax. exists bx. exists cx. exists dx. exists di. exists si. exists (R BP). rewrite rfUp. rewrite eqfl. rewrite eqisr. exists M1'. exists M2. split_l. split_r. repeat split; auto. unfold S_Mem, S_Mem_Upd. apply timer_pushbp_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-14) with (sp-12-2); auto. omega. unfold S_Mem_Upd, S_RF. reg simpl. rewrite eqsp. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). induction st'' as (((h'', R''), fl''), isr''). destruct (nextS_inversion nS). clear nS. (** nS **) unfold opr_eval in H. destruct H as [spgt2' [ldt memUp]]. destruct H0 as [rfUp [eqfl eqisr]]. intros M1 M2 djh sp ax bx cx dx di si [mM1 [eqsi [eqsp [spge [inIsr IFtrue]]]]]. destruct (timer_pushbp_has_stack M1 sp ax bx cx dx di si mM1 spge) as [bp ld2sp]. UnfoldStateAll. assert (leadsToxW (R SP -2) M1). apply leadsToW_leadsToxW with bp. rewrite eqsp. replace (sp-12-2) with (sp-14); auto. omega. destruct (leadsToxW_MemUpd16_DMono djh H memUp) as [M1' [djh' upM1]]. assert (timer_movax_pre sp ax bx cx dx di si (R BP) (M1', R', fl', isr')). rewrite rfUp. rewrite eqfl. rewrite eqisr. repeat split; auto. unfold S_Mem, S_Mem_Upd. apply timer_pushbp_pre2post with M1; auto. rewrite eqsp in upM1. replace (sp-14) with (sp-12-2); auto. omega. unfold S_RF. reg simpl. rewrite eqsp. omega. rename H0 into mM1'. substH gS with (gS M1' M2 djh' sp ax bx cx dx di si (R BP) mM1'). (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) destruct gS as [M1'' [djh'' [pre'' [eqax [eqbx [eqcx [eqdx [eqdi [eqsi'' [eqbp eqsp'']]]]]]]]]]. exists M1''. split_l. split_l. repeat split; auto. Qed. Lemma IH_WFcmd_1134_movax: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast (conjP p_timer_movax (fun st : State => S_RF st AX = 32)) g_timer_movax ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_movax g_timer_movax ihtag) (comml (_movwp (Opr_imm 32) AX)). Proof. exists (conjP p_timer_movax (fun st : State => S_RF st AX = 32)). exists g_timer_movax. split. constructor. auto. split. intros st pS. induction st as (((h, R), fl), isr). exists (h, (RF_update R AX (opr_eval R (Opr_imm 32))), fl, isr). apply nextS_movwp with (opr_eval R (Opr_imm 32)); auto. split. intros st' [st [pS nS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. destruct H0 as [rfUp [eqfl eqisr]]. rewrite H. rewrite rfUp. rewrite eqfl. rewrite eqisr. destruct pS as [sp [ax [bx [cx [dx [di [si [bp pre]]]]]]]]. split_r. exists sp. exists ax. exists bx. exists cx. exists dx. exists di. exists si. exists bp. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqbp [eqsp [spge [inIsr IFtrue]]]]]. exists M1. exists M2. split_l. split_r. split; auto. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. destruct H0 as [rfUp [eqfl eqisr]]. rewrite H in gS. rewrite rfUp in gS. rewrite eqfl in gS. rewrite eqisr in gS. unfold g_timer_movax. intros. apply gS with M0; auto. Qed. Lemma IH_WFcmd_1135_movdx: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast (conjP p_timer_movax (fun st : State => S_RF st AX = 32 /\ S_RF st DX = 32)) g_timer_movax ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast (conjP p_timer_movax (fun st : State => S_RF st AX = 32)) g_timer_movax ihtag) (comml (_movwp (Opr_imm 32) DX)). Proof. exists (conjP p_timer_movax (fun st : State => S_RF st AX = 32 /\ S_RF st DX =32)). exists g_timer_movax. split. constructor. auto. split. intros st pS. induction st as (((h, R), fl), isr). exists (h, (RF_update R DX (opr_eval R (Opr_imm 32))), fl, isr). apply nextS_movwp with (opr_eval R (Opr_imm 32)); auto. split. intros st' [st [pS nS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. destruct H0 as [rfUp [eqfl eqisr]]. rewrite H. rewrite rfUp. rewrite eqfl. rewrite eqisr. destruct pS as [[sp [ax [bx [cx [dx [di [si [bp pre]]]]]]]] eqax]. split. exists sp. exists ax. exists bx. exists cx. exists dx. exists di. exists si. exists bp. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqbp [eqsp [spge [inIsr IFtrue]]]]]. exists M1. exists M2. split_l. split_r. split; auto. split; auto. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. destruct H0 as [rfUp [eqfl eqisr]]. rewrite H in gS. rewrite rfUp in gS. rewrite eqfl in gS. rewrite eqisr in gS. unfold g_timer_movax. intros. apply gS with M0; auto. Qed. Definition timer_scheduler_pre (sp ax bx cx dx di si bp: nat) (S : State) : Prop := timer_movax_MPre sp ax bx cx dx di si bp (S_Mem S) /\ S_RF S SP = sp - 14 /\ sp >= IH_Stk /\ S_ISR S = false /\ S_Flag S _IF = false. Definition p_timer_scheduler (S : State) : Prop := exists sp, exists ax, exists bx, exists cx, exists dx, exists di, exists si, exists bp, imprec (timer_scheduler_pre sp ax bx cx dx di si bp) S. Definition g_timer_scheduler (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx cx dx di si bp, timer_scheduler_pre sp ax bx cx dx di si bp (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_movax_post sp ax bx cx dx di si bp S' M0'. Lemma IH_WFcmd_1136_eoi: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_scheduler g_timer_scheduler ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast (conjP p_timer_movax (fun st : State => S_RF st AX = 32 /\ S_RF st DX = 32)) g_timer_movax ihtag) (comml _outb_eoi). Proof. exists p_timer_scheduler. exists g_timer_scheduler. split. constructor. auto. split. intros st [[sp [ax [bx [cx [dx [di [si [bp pre]]]]]]]] [eqax eqdx]]. induction st as (((h, R), fl), isr). exists (h,R,fl,false). apply nextS_EOI; auto. split. (** pimp **) intros st' [st [pS nS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS). clear nS. destruct H0 as [[eqR [eqax0 eqdx0]] [eqfl eqisr]]. destruct pS as [[sp [ax [bx [cx [dx [di [si [bp pre]]]]]]]] [eqax eqdx]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqbp [eqsp [spge [inIsr IFtrue]]]]]. UnfoldStateAll. exists sp. exists ax. exists bx. exists cx. exists dx. exists di. exists si. exists bp. rewrite H. rewrite eqR. rewrite eqfl. rewrite eqisr. exists M1. exists M2. split_l. split_r. repeat split; auto. (** gimp **) intros st st'' [st' [[pS nS] gS]]. clear pS. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). induction st'' as (((h'', R''), fl''), isr''). destruct (nextS_inversion nS). clear nS. (** nS **) destruct H0 as [[eqR [eqax0 eqdx0]] [eqfl eqisr]]. rewrite H in gS. rewrite eqR in gS. rewrite eqfl in gS. rewrite eqisr in gS. intros M1 M2 djh sp ax bx cx dx di si bp pre. assert (pre': timer_scheduler_pre sp ax bx cx dx di si bp (M1, R, fl, false)). destruct pre as [mM1 [eqbp [eqsp [spge [inIsr IFtrue]]]]]. split; auto. unfold g_timer_scheduler in gS. UnfoldStateAll. substH gS with (gS M1 M2 djh sp ax bx cx dx di si bp pre'). (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) destruct gS as [M1'' [djh'' [pre'' [eqax [eqbx [eqcx [eqdx [eqdi [eqsi [eqbp'' eqsp'']]]]]]]]]]. exists M1''. split_l. split_l. repeat split; auto. Qed. Definition p_timer_popbp (S : State) : Prop := p_timer_scheduler S. Definition g_timer_popbp (S S' : State) : Prop := g_timer_scheduler S S'. Lemma timer_scheduler_pre2post: forall pc' sp ax bx cx dx di si bp S S' S'' S''' M1 M2, MemMod.disjUnion M1 M2 (S_Mem S) /\ timer_scheduler_pre sp ax bx cx dx di si bp (S_Mem_Upd S M1) /\ mTrue M2 -> nextS (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (comml (_call _SWITCH)) S S' -> ih_gy S' S'' -> nextS pc' (comms _retw) S'' S''' -> exists M1', MemMod.disjUnion M1' M2 (S_Mem S''') /\ timer_scheduler_pre sp ax bx cx dx di si bp (S_Mem_Upd S''' M1'). Proof. intros pc' sp ax bx cx dx di si bp S S' S'' S''' M1 M2 [djh [pre mM2]] nSC ihg nSR. unfold timer_scheduler_pre in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. simplS in * . destruct pre as [mM1 [eqsp [spge [inIsr IFtrue]]]]. destruct (nextS_inversion nSC) as [HM' [HR' [Hfl' Hisr']]]. clear nSC. assert (ihga: ih_gy_alt (M', R', fl', isr') (M'', R'', fl'', isr'')). apply ih_gy_derive; auto. clear ihg. rename ihga into ihg. destruct ihg as [sp' [HM'' [Hif'' [Hisr'' HSP]]]]. destruct (nextS_inversion nSR) as [HM''' [HR''' [Hfl''' Hisr''']]]. clear nSR. destruct HR''' as [pc''' [Hlds''' HR''']]. destruct HM' as [Hspg' [Hlds Hupd]]. simplS in * . subst M''' R''' fl''' isr'''. subst isr'' R' fl' isr' isr. reg simpl. destruct HSP as [Hsp' HSP]. subst sp'. rewrite <- HSP. rewrite eqsp. rewrite eqsp in HM''. unfold timer_movax_MPre in * . sep on. sep lift 1 in mM1. sep stksplit in mM1. arith_rep (14+8+2-14-2) with 8 in mM1. sep off. rewrite eqsp in Hupd. assert (leadsToxW (sp-14-2) M1). sep on. sep lift 1 in mM1. sep trivial. destruct (leadsToxW_MemUpd16_DMono djh H Hupd) as [M1' [djh' upM1]]. assert (mM1a: ((INV0 *^* stkSpacePrec (sp - 14 - 2) 8) *^* (sp - 14 - 2 |->w_ *^* sp - 14 |->w bp *^* sp - 12 |->w si *^* sp - 10 |->w di *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax)) M1). sep on. simpl in mM1. sep matchH mM1 with 13. clear mM1. destruct mM1a as [M3 [M4 [djM1 [mM3 mM4]]]]. assert (leadsToxW (sp-14-2) M4). sep on. sep lift 0 in mM4. sep trivial. destruct (leadsToxW_MemUpd16_DMonoR djM1 H0 upM1) as [M4' [djM4' upM4]]. assert (djh'a: MemMod.disjUnion M3 (MemMod.merge M4' M2) M'). destruct djM4' as [dij eqM4]. apply MemMod.disjUnion_assoc_left_right; auto. rewrite <- eqM4; auto. substH HM'' with (HM'' M3 (MemMod.merge M4' M2) djh'a mM3). destruct HM'' as [M3'' [djM'' mM3'']]. exists (MemMod.merge M3'' M4'). split. apply MemMod.disjUnion_assoc_right_left; auto. apply MemMod.disj_merge_disj_right with M3; auto. destruct djM4' as [djM4' mergeM4']. rewrite <- mergeM4'. inversion djh'; auto. split. assert ((INV0 *^* stkSpacePrec (sp - 14 - 2) 8 *^* ((sp - 14 - 2 |->w_ *^* sp - 14 |->w bp *^* sp - 12 |->w si *^* sp - 10 |->w di *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax))) (MemMod.merge M3'' M4')). exists M3''. exists M4'. split. apply MemMod.disj_merge_disjUnion; auto. inversion djM''. apply MemMod.disj_x_merge_disj_left with M2; auto. (** MemMod.disjUnion M3'' M4' (MemMod.merge M3'' M4') **) split_l. assert (mM4': (sp - 14 - 2 |->w (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) *^* sp - 14 |->w bp *^* sp - 12 |->w si *^* sp - 10 |->w di *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax) M4'). substH upM4 with (MemUpd16_MemUpdW upM4). destruct upM4 as [x upM4]. rewrite upM4. sep on. sep lift 0. sep upd. sep matchH mM4 with 3. sep on. sep matchH mM4' with 3. sep on. sep lift 1. sep stksplit. simpl. sep matchH H1 with 4. repeat split; auto. omega. rewrite <- Hif''; trivial. Qed. Lemma IH_WFcmd_1137_scheduler: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popbp g_timer_popbp ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_scheduler g_timer_scheduler ihtag) (comml (_call _SWITCH)). Proof. left. unfold prim_entry. split. left. trivial. split_l. exists p_timer_popbp. exists g_timer_popbp. split. constructor; auto. split. (** enable **) intros st [sp [ax [bx [cx [dx [di [si [bp pre]]]]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [inIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. split_r. unfold timer_movax_MPre in mM1. assert (mM1r: ((sp - 14 |->w bp *^* sp - 12 |->w si *^* sp - 10 |->w di *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax) *^* (INV0 *^* stkSpacePrec (sp - 14) (IH_Stk - 14))) M1). sep on. sep matchH mM1 with 4. destruct mM1r as [M3 [M4 [djM1 [mM3 mM4]]]]. exists (MemMod.merge M2 M3). exists M4. split. destruct djM1 as [djm1 eqm1]. apply MemMod.disjUnion_assoc_right_left; auto. rewrite <- eqm1. apply MemMod.disjUnion_commut; auto. split_l. rewrite eqsp. arith_rep (8+2) with (14+8+2-14). split. (** pimp **) intros pc'. intros st' [st [pS nS]]. destruct nS as [stR [[stC [nSC gSwtch]] nSR]]. unfold p_timer_popbp. unfold p_timer_scheduler in * . destruct pS as [sp [ax [bx [cx [dx [di [si [bp pre]]]]]]]]. exists sp; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp. destruct pre as [M1 [M2 pre]]. destruct (timer_scheduler_pre2post pc' sp ax bx cx dx di si bp st stC stR st' M1 M2 pre nSC gSwtch nSR) as [M1' [dijh' pre']]. exists M1'. exists M2. split_l. split_l. unfold mTrue; auto. (** gimp **) intros pc' st st'' [st' [[pS nS] gS]]. destruct nS as [stR [[stC [nSC gSwtch]] nSR]]. unfold g_timer_popbp in gS. unfold g_timer_scheduler in * . intros M1 M2 djh sp ax bx cx dx di si bp pre. assert (IpS: MemMod.disjUnion M1 M2 (S_Mem st) /\ timer_scheduler_pre sp ax bx cx dx di si bp (S_Mem_Upd st M1) /\ mTrue M2). split_l. split. trivial. unfold mTrue; trivial. destruct (timer_scheduler_pre2post pc' sp ax bx cx dx di si bp st stC stR st' M1 M2 IpS nSC gSwtch nSR) as [M1' [dijh' pre']]. apply gS with M1'; auto. Qed. Definition timer_popsi_pre (sp ax bx cx dx di si : nat) (S : State) : Prop := timer_pushbp_MPre sp ax bx cx dx di si (S_Mem S) /\ S_RF S SP = sp - 12 /\ sp >= IH_Stk /\ S_ISR S = false /\ S_Flag S _IF = false. Definition p_timer_popsi (S : State) : Prop := exists sp, exists ax, exists bx, exists cx, exists dx, exists di, exists si, imprec (timer_popsi_pre sp ax bx cx dx di si) S. Definition g_timer_popsi (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx cx dx di si, timer_popsi_pre sp ax bx cx dx di si (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushbp_post sp ax bx cx dx di si S S' M0'. Lemma timer_popbp_has_item: forall sp ax bx cx dx di si bp h, timer_movax_MPre sp ax bx cx dx di si bp h -> sp>= IH_Stk -> (sp-14 |~>w bp) h. Proof. unfold timer_movax_MPre; intros sp ax bx cx dx di si bp h pre spge. assert (Hx : h ||- stkSpacePrec (sp-14) (IH_Stk-14) *^* sp-14 |->w bp *^* (sp-12 |->w si *^* sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). sep on. sep matchH pre with 4. sep lift 1 in Hx. sep on. sep trivial. Qed. Lemma timer_popbp_pre2post: forall sp ax bx cx dx di si bp h, timer_movax_MPre sp ax bx cx dx di si bp h -> sp >= IH_Stk -> timer_pushbp_MPre sp ax bx cx dx di si h. Proof. intros sp ax bx cx dx di si bp h pre spge. unfold timer_pushbp_MPre, timer_movax_MPre in * . sep on. sep lift 1. apply stkSpacePrec_mergeW1. arith_rep (sp - 12 - 2) with (sp-14). arith_rep (IH_Stk - 12 - 2) with (IH_Stk-14). sep matchH pre with 4. omega. omega. Qed. Lemma IH_WFcmd_1138_popbp: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popsi g_timer_popsi ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popbp g_timer_popbp ihtag) (comml (_popw BP)). Proof. exists p_timer_popsi. exists g_timer_popsi. split. constructor; auto. split. (** enable nextS **) intros st [sp [ax [bx [cx [dx [di [si [bp pre]]]]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. assert ((sp-14 |~>w bp) M1). apply timer_popbp_has_item with ax bx cx dx di si; auto. exists (h, (RF_update (RF_update R SP (sp-14+2)) BP bp), fl, isr). apply nextS_popw with (RF_update R SP (sp-14+2)) bp; auto. unfold popW; rewrite eqsp. split; auto. apply leadsToW_Mono with M1 M2; auto. split. (** pimp **) intros st' [st [pS nS]]. destruct pS as [sp [ax [bx [cx [dx [di [si [bp pre]]]]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. UnfoldStateAll. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. rewrite eqsp in H0. destruct H0 as [[bp' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl. rewrite eqisr. rewrite eqr. rewrite H. exists sp; exists ax; exists bx; exists cx; exists dx; exists di; exists si. exists M1. exists M2. split_l. split_r. repeat split; auto. unfold S_Mem_Upd, S_Mem. apply timer_popbp_pre2post with bp; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. destruct H0 as [[bp' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl in gS. rewrite eqisr in gS. rewrite eqr in gS. rewrite H in gS. induction st'' as (((h'', R''), fl''), isr''). intros M1 M2 djh sp ax bx cx dx di si bp post. destruct post as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. UnfoldStateAll. assert (eqbp: bp' = bp). rewrite eqsp in ldt. apply leadsToW_unique with (sp-14) h; auto. apply leadsToW_Mono with M1 M2; auto. apply timer_popbp_has_item with ax bx cx dx di si; auto. rewrite eqbp in gS. assert (pre: timer_popsi_pre sp ax bx cx dx di si (M1, RF_update (RF_update R SP (R SP + 2)) BP bp, fl, isr)). repeat split; auto. simplS. apply timer_popbp_pre2post with bp; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. rewrite eqsp. omega. unfold g_timer_popsi in gS; unfold timer_pushbp_post in gS. (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) UnfoldStateAll. substH gS with (gS M1 M2 djh sp ax bx cx dx di si pre). destruct gS as [M1'' [djh'' [[pre'' NinISr] [eqax'' [eqbx [eqcx [eqdx'' [eqdi [eqsi [eqbp'' eqsp'']]]]]]]]]]. exists M1''. split_l. repeat split; auto. Qed. Definition timer_popdi_pre (sp ax bx cx dx di : nat) (S : State) : Prop := timer_pushsi_MPre sp ax bx cx dx di (S_Mem S) /\ S_RF S SP = sp - 10 /\ sp >= IH_Stk /\ S_ISR S = false /\ S_Flag S _IF = false. Definition p_timer_popdi (S : State) : Prop := exists sp, exists ax, exists bx, exists cx, exists dx, exists di, imprec (timer_popdi_pre sp ax bx cx dx di) S. Definition g_timer_popdi (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx cx dx di, timer_popdi_pre sp ax bx cx dx di (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushsi_post sp ax bx cx dx di S S' M0'. Lemma timer_popsi_has_item: forall sp ax bx cx dx di si h, timer_pushbp_MPre sp ax bx cx dx di si h -> sp >= IH_Stk -> (sp-12 |~>w si) h. Proof. unfold timer_pushbp_MPre; intros sp ax bx cx dx di si h pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-12) (IH_Stk-12) *^* sp-12 |->w si *^* (sp-10 |->w di *^* sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). sep matchH pre with 4. unfold mjudge. sep lift 1 in Hx. sep on. sep trivial. Qed. Lemma timer_popsi_pre2post: forall sp ax bx cx dx di si h, timer_pushbp_MPre sp ax bx cx dx di si h -> sp >= IH_Stk -> timer_pushsi_MPre sp ax bx cx dx di h. Proof. intros sp ax bx cx dx di si h pre spge. unfold timer_pushbp_MPre, timer_pushsi_MPre in * . sep on. sep lift 1. apply stkSpacePrec_mergeW1. arith_rep (sp - 10 - 2) with (sp-12). arith_rep (IH_Stk - 10 - 2) with (IH_Stk-12). sep matchH pre with 4. omega. omega. Qed. Lemma IH_WFcmd_1139_popsi: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popdi g_timer_popdi ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popsi g_timer_popsi ihtag) (comml (_popw SI)). Proof. exists p_timer_popdi. exists g_timer_popdi. split. constructor; auto. split. (** enable nextS **) intros st [sp [ax [bx [cx [dx [di [si pre]]]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. assert ((sp-12 |~>w si) M1). apply timer_popsi_has_item with ax bx cx dx di; auto. exists (h, (RF_update (RF_update R SP (sp-12+2)) SI si), fl, isr). apply nextS_popw with (RF_update R SP (sp-12+2)) si; auto. unfold popW; rewrite eqsp. split; auto. apply leadsToW_Mono with M1 M2; auto. split. (** pimp **) intros st' [st [pS nS]]. destruct pS as [sp [ax [bx [cx [dx [di [si pre]]]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. rewrite eqsp in H0. destruct H0 as [[bp' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl. rewrite eqisr. rewrite eqr. rewrite H. exists sp; exists ax; exists bx; exists cx; exists dx; exists di. exists M1. exists M2. split_l. split_r. repeat split; auto. simplS. apply timer_popsi_pre2post with si; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. destruct H0 as [[si' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl in gS. rewrite eqisr in gS. rewrite eqr in gS. rewrite H in gS. induction st'' as (((h'', R''), fl''), isr''). intros M1 M2 djh sp ax bx cx dx di si post. destruct post as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. UnfoldStateAll. assert (eqsi: si' = si). rewrite eqsp in ldt. apply leadsToW_unique with (sp-12) h; auto. apply leadsToW_Mono with M1 M2; auto. apply timer_popsi_has_item with ax bx cx dx di; auto. rewrite eqsi in gS. assert (pre: timer_popdi_pre sp ax bx cx dx di (M1, RF_update (RF_update R SP (R SP + 2)) SI si, fl, isr)). repeat split; auto. simplS. apply timer_popsi_pre2post with si; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. rewrite eqsp. omega. unfold g_timer_popdi in gS; unfold timer_pushsi_post in gS. (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) UnfoldStateAll. substH gS with (gS M1 M2 djh sp ax bx cx dx di pre). destruct gS as [M1'' [djh'' [[pre'' NinISr] [eqax [eqbx [eqcx [eqdx [eqdi [eqsi'' [eqbp eqsp'']]]]]]]]]]. exists M1''. split_l. repeat split; auto. Qed. Definition timer_popdx_pre (sp ax bx cx dx : nat) (S : State) : Prop := timer_pushdi_MPre sp ax bx cx dx (S_Mem S) /\ S_RF S SP = sp - 8 /\ sp >= IH_Stk /\ S_ISR S = false /\ S_Flag S _IF = false. Definition p_timer_popdx (S : State) : Prop := exists sp, exists ax, exists bx, exists cx, exists dx, imprec (timer_popdx_pre sp ax bx cx dx) S. Definition g_timer_popdx (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx cx dx, timer_popdx_pre sp ax bx cx dx (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushdi_post sp ax bx cx dx S S' M0'. Lemma timer_popdi_has_item: forall sp ax bx cx dx di h, timer_pushsi_MPre sp ax bx cx dx di h -> sp >= IH_Stk -> (sp-10 |~>w di) h. Proof. unfold timer_pushsi_MPre; intros sp ax bx cx dx di h pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-10) (IH_Stk-10) *^* sp-10 |->w di *^* (sp-8 |->w dx *^* sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). sep matchH pre with 4. sep lift 1 in Hx. sep on. sep trivial. Qed. Lemma timer_popdi_pre2post: forall sp ax bx cx dx di h, timer_pushsi_MPre sp ax bx cx dx di h -> sp >= IH_Stk -> timer_pushdi_MPre sp ax bx cx dx h. Proof. intros sp ax bx cx dx di h pre spge. unfold timer_pushdi_MPre, timer_pushsi_MPre in * . sep on. sep lift 1. apply stkSpacePrec_mergeW1. arith_rep (sp - 8 - 2) with (sp-10). arith_rep (IH_Stk - 8 - 2) with (IH_Stk-10). sep matchH pre with 4. omega. omega. Qed. Lemma IH_WFcmd_1140_popdi: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popdx g_timer_popdx ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popdi g_timer_popdi ihtag) (comml (_popw DI)). Proof. exists p_timer_popdx. exists g_timer_popdx. split. constructor; auto. split. (** enable nextS **) intros st [sp [ax [bx [cx [dx [di pre]]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. assert ((sp-10 |~>w di) M1). apply timer_popdi_has_item with ax bx cx dx; auto. exists (h, (RF_update (RF_update R SP (sp-10+2)) DI di), fl, isr). apply nextS_popw with (RF_update R SP (sp-10+2)) di; auto. unfold popW; rewrite eqsp. split; auto. apply leadsToW_Mono with M1 M2; auto. split. (** pimp **) intros st' [st [pS nS]]. destruct pS as [sp [ax [bx [cx [dx [di pre]]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. rewrite eqsp in H0. destruct H0 as [[bp' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl. rewrite eqisr. rewrite eqr. rewrite H. exists sp; exists ax; exists bx; exists cx; exists dx. exists M1. exists M2. split_l. split_r. repeat split; auto. simplS. apply timer_popdi_pre2post with di; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. destruct H0 as [[di' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl in gS. rewrite eqisr in gS. rewrite eqr in gS. rewrite H in gS. induction st'' as (((h'', R''), fl''), isr''). intros M1 M2 djh sp ax bx cx dx di post. destruct post as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. UnfoldStateAll. assert (eqdi: di' = di). rewrite eqsp in ldt. apply leadsToW_unique with (sp-10) h; auto. apply leadsToW_Mono with M1 M2; auto. apply timer_popdi_has_item with ax bx cx dx; auto. rewrite eqdi in gS. assert (pre: timer_popdx_pre sp ax bx cx dx (M1, RF_update (RF_update R SP (R SP + 2)) DI di, fl, isr)). repeat split; auto. simplS. apply timer_popdi_pre2post with di; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. rewrite eqsp. omega. unfold g_timer_popdx in gS; unfold timer_pushdi_post in gS. (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) UnfoldStateAll. substH gS with (gS M1 M2 djh sp ax bx cx dx pre). destruct gS as [M1'' [djh'' [[pre'' NinISr] [eqax [eqbx [eqcx [eqdx [eqdi'' [eqsi [eqbp eqsp'']]]]]]]]]]. exists M1''. split_l. repeat split; auto. Qed. Definition timer_popcx_pre (sp ax bx cx : nat) (S : State) : Prop := timer_pushdx_MPre sp ax bx cx (S_Mem S) /\ S_RF S SP = sp - 6 /\ sp >= IH_Stk /\ S_ISR S = false /\ S_Flag S _IF = false. Definition p_timer_popcx (S : State) : Prop := exists sp, exists ax, exists bx, exists cx, imprec (timer_popcx_pre sp ax bx cx) S. Definition g_timer_popcx (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx cx, timer_popcx_pre sp ax bx cx (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushdx_post sp ax bx cx S S' M0'. Lemma timer_popdx_has_item: forall sp ax bx cx dx h, timer_pushdi_MPre sp ax bx cx dx h -> sp >= IH_Stk -> (sp-8 |~>w dx) h. Proof. unfold timer_pushdi_MPre; intros sp ax bx cx dx h pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-8) (IH_Stk-8) *^* sp-8 |->w dx *^* (sp-6 |->w cx *^* sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). sep matchH pre with 4. sep lift 1 in Hx. sep on. sep trivial. Qed. Lemma timer_popdx_pre2post: forall sp ax bx cx dx h, timer_pushdi_MPre sp ax bx cx dx h -> sp >= IH_Stk -> timer_pushdx_MPre sp ax bx cx h. Proof. intros sp ax bx cx dx h pre spge. unfold timer_pushdi_MPre, timer_pushdx_MPre in * . sep on. sep lift 1. apply stkSpacePrec_mergeW1. arith_rep (sp - 6 - 2) with (sp-8). arith_rep (IH_Stk - 6 - 2) with (IH_Stk-8). sep matchH pre with 4. omega. omega. Qed. Lemma IH_WFcmd_1141_popdx: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popcx g_timer_popcx ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popdx g_timer_popdx ihtag) (comml (_popw DX)). Proof. exists p_timer_popcx. exists g_timer_popcx. split. constructor; auto. split. (** enable nextS **) intros st [sp [ax [bx [cx [dx pre]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. assert ((sp-8 |~>w dx) M1). apply timer_popdx_has_item with ax bx cx; auto. exists (h, (RF_update (RF_update R SP (sp-8+2)) DX dx), fl, isr). apply nextS_popw with (RF_update R SP (sp-8+2)) dx; auto. unfold popW; rewrite eqsp. split; auto. apply leadsToW_Mono with M1 M2; auto. split. (** pimp **) intros st' [st [pS nS]]. destruct pS as [sp [ax [bx [cx [dx pre]]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. rewrite eqsp in H0. destruct H0 as [[dx' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl. rewrite eqisr. rewrite eqr. rewrite H. exists sp; exists ax; exists bx; exists cx. exists M1. exists M2. split_l. split_r. repeat split; auto. simplS. apply timer_popdx_pre2post with dx; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. destruct H0 as [[dx' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl in gS. rewrite eqisr in gS. rewrite eqr in gS. rewrite H in gS. induction st'' as (((h'', R''), fl''), isr''). intros M1 M2 djh sp ax bx cx dx post. destruct post as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. UnfoldStateAll. assert (eqdx: dx' = dx). rewrite eqsp in ldt. apply leadsToW_unique with (sp-8) h; auto. apply leadsToW_Mono with M1 M2; auto. apply timer_popdx_has_item with ax bx cx; auto. rewrite eqdx in gS. assert (pre: timer_popcx_pre sp ax bx cx (M1, RF_update (RF_update R SP (R SP + 2)) DX dx, fl, isr)). repeat split; auto. simplS. apply timer_popdx_pre2post with dx; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. rewrite eqsp. omega. unfold g_timer_popcx in gS; unfold timer_pushdx_post in gS. (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) UnfoldStateAll. substH gS with (gS M1 M2 djh sp ax bx cx pre). destruct gS as [M1'' [djh'' [[pre'' NinISr] [eqax [eqbx [eqcx [eqdx'' [eqdi [eqsi [eqbp eqsp'']]]]]]]]]]. exists M1''. split_l. repeat split; auto. Qed. Definition timer_popbx_pre (sp ax bx : nat) (S : State) : Prop := timer_pushcx_MPre sp ax bx (S_Mem S) /\ S_RF S SP = sp - 4 /\ sp >= IH_Stk /\ S_ISR S = false /\ S_Flag S _IF = false. Definition p_timer_popbx (S : State) : Prop := exists sp, exists ax, exists bx, imprec (timer_popbx_pre sp ax bx) S. Definition g_timer_popbx (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax bx, timer_popbx_pre sp ax bx (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushcx_post sp ax bx S S' M0'. Lemma timer_popcx_has_item: forall sp ax bx cx h, timer_pushdx_MPre sp ax bx cx h -> sp >= IH_Stk -> (sp-6 |~>w cx) h. Proof. unfold timer_pushdx_MPre; intros sp ax bx cx h pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-6) (IH_Stk-6) *^* sp-6 |->w cx *^* (sp-4 |->w bx *^* sp-2 |->w ax *^* INV0)). sep matchH pre with 3. sep lift 1 in Hx. sep on. sep trivial. Qed. Lemma timer_popcx_pre2post: forall sp ax bx cx h, timer_pushdx_MPre sp ax bx cx h -> sp >= IH_Stk -> timer_pushcx_MPre sp ax bx h. Proof. intros sp ax bx cx h pre spge. unfold timer_pushcx_MPre, timer_pushdx_MPre in * . sep on. sep lift 1. apply stkSpacePrec_mergeW1. arith_rep (sp - 4 - 2) with (sp-6). arith_rep (IH_Stk - 4 - 2) with (IH_Stk-6). sep matchH pre with 3. omega. omega. Qed. Lemma IH_WFcmd_1142_popcx: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popbx g_timer_popbx ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popcx g_timer_popcx ihtag) (comml (_popw CX)). Proof. exists p_timer_popbx. exists g_timer_popbx. split. constructor; auto. split. (** enable nextS **) intros st [sp [ax [bx [cx pre]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. assert ((sp-6 |~>w cx) M1). apply timer_popcx_has_item with ax bx; auto. exists (h, (RF_update (RF_update R SP (sp-6+2)) CX cx), fl, isr). apply nextS_popw with (RF_update R SP (sp-6+2)) cx; auto. unfold popW; rewrite eqsp. split; auto. apply leadsToW_Mono with M1 M2; auto. split. (** pimp **) intros st' [st [pS nS]]. destruct pS as [sp [ax [bx [cx pre]]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. rewrite eqsp in H0. destruct H0 as [[cx' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl. rewrite eqisr. rewrite eqr. rewrite H. exists sp; exists ax; exists bx. exists M1. exists M2. split_l. split_r. repeat split; auto. simplS. apply timer_popcx_pre2post with cx; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. destruct H0 as [[cx' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl in gS. rewrite eqisr in gS. rewrite eqr in gS. rewrite H in gS. induction st'' as (((h'', R''), fl''), isr''). intros M1 M2 djh sp ax bx cx post. destruct post as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. UnfoldStateAll. assert (eqcx: cx' = cx). rewrite eqsp in ldt. apply leadsToW_unique with (sp-6) h; auto. apply leadsToW_Mono with M1 M2; auto. apply timer_popcx_has_item with ax bx; auto. rewrite eqcx in gS. assert (pre: timer_popbx_pre sp ax bx (M1, RF_update (RF_update R SP (R SP + 2)) CX cx, fl, isr)). repeat split; auto. simplS. apply timer_popcx_pre2post with cx; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. rewrite eqsp. omega. unfold g_timer_popbx in gS; unfold timer_pushcx_post in gS. (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) UnfoldStateAll. substH gS with (gS M1 M2 djh sp ax bx pre). destruct gS as [M1'' [djh'' [[pre'' NinISr] [eqax [eqbx [eqcx'' [eqdx [eqdi [eqsi [eqbp eqsp'']]]]]]]]]]. exists M1''. split_l. repeat split; auto. Qed. Definition timer_popax_pre (sp ax : nat) (S : State) : Prop := timer_pushbx_MPre sp ax (S_Mem S) /\ S_RF S SP = sp - 2 /\ sp >= IH_Stk /\ S_ISR S = false /\ S_Flag S _IF = false. Definition p_timer_popax (S : State) : Prop := exists sp, exists ax, imprec (timer_popax_pre sp ax) S. Definition g_timer_popax (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp ax, timer_popax_pre sp ax (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_pushbx_post sp ax S S' M0'. Lemma timer_popbx_has_item: forall sp ax bx h, timer_pushcx_MPre sp ax bx h -> sp >= IH_Stk -> (sp-4 |~>w bx) h. Proof. unfold timer_pushcx_MPre; intros sp ax bx h pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-4) (IH_Stk-4) *^* sp-4 |->w bx *^* (sp-2 |->w ax *^* INV0)). sep matchH pre with 3. sep lift 1 in Hx. sep on. sep trivial. Qed. Lemma timer_popbx_pre2post: forall sp ax bx h, timer_pushcx_MPre sp ax bx h -> sp >= IH_Stk -> timer_pushbx_MPre sp ax h. Proof. intros sp ax bx h pre spge. unfold timer_pushcx_MPre, timer_pushbx_MPre in * . sep on. sep lift 1. apply stkSpacePrec_mergeW1. arith_rep (sp - 2 - 2) with (sp-4). arith_rep (IH_Stk - 2 - 2) with (IH_Stk-4). sep matchH pre with 2. omega. omega. Qed. Lemma IH_WFcmd_1143_popbx: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popax g_timer_popax ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popbx g_timer_popbx ihtag) (comml (_popw BX)). Proof. exists p_timer_popax. exists g_timer_popax. split. constructor; auto. split. (** enable nextS **) intros st [sp [ax [bx pre]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. assert ((sp-4 |~>w bx) M1). apply timer_popbx_has_item with ax; auto. exists (h, (RF_update (RF_update R SP (sp-4+2)) BX bx), fl, isr). apply nextS_popw with (RF_update R SP (sp-4+2)) bx; auto. unfold popW; rewrite eqsp. split; auto. apply leadsToW_Mono with M1 M2; auto. split. (** pimp **) intros st' [st [pS nS]]. destruct pS as [sp [ax [bx pre]]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. rewrite eqsp in H0. destruct H0 as [[bx' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl. rewrite eqisr. rewrite eqr. rewrite H. exists sp; exists ax. exists M1. exists M2. split_l. split_r. repeat split; auto. simplS. apply timer_popbx_pre2post with bx; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. destruct H0 as [[bx' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl in gS. rewrite eqisr in gS. rewrite eqr in gS. rewrite H in gS. induction st'' as (((h'', R''), fl''), isr''). intros M1 M2 djh sp ax bx post. destruct post as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. UnfoldStateAll. assert (eqbx: bx' = bx). rewrite eqsp in ldt. apply leadsToW_unique with (sp-4) h; auto. apply leadsToW_Mono with M1 M2; auto. apply timer_popbx_has_item with ax; auto. rewrite eqbx in gS. assert (pre: timer_popax_pre sp ax (M1, RF_update (RF_update R SP (R SP + 2)) BX bx, fl, isr)). repeat split; auto. simplS. apply timer_popbx_pre2post with bx; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. rewrite eqsp. omega. unfold g_timer_popax in gS; unfold timer_pushbx_post in gS. (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) UnfoldStateAll. substH gS with (gS M1 M2 djh sp ax pre). destruct gS as [M1'' [djh'' [[pre'' NinISr] [eqax [eqbx'' [eqcx [eqdx [eqdi [eqsi [eqbp eqsp'']]]]]]]]]]. exists M1''. split_l. repeat split; auto. Qed. Definition timer_iret_pre (sp : nat) (S : State) : Prop := (INV0 *^* stkSpacePrec sp IH_Stk) (S_Mem S) /\ S_RF S SP = sp /\ sp >= IH_Stk /\ S_ISR S = false /\ S_Flag S _IF = false. Definition p_timer_iret (S : State) : Prop := exists sp, imprec (timer_iret_pre sp) S. Definition g_timer_iret (S S' : State) : Prop := forall M0 M1, MemMod.disjUnion M0 M1 (S_Mem S) -> forall sp, timer_iret_pre sp (S_Mem_Upd S M0) -> exists M0', MemMod.disjUnion M0' M1 (S_Mem S') /\ timer_post sp (S_Mem_Upd S' M0') /\ S_RF S' = S_RF S. Lemma timer_popax_has_item: forall sp ax h, timer_pushbx_MPre sp ax h -> sp >= IH_Stk -> (sp-2 |~>w ax) h. Proof. unfold timer_pushbx_MPre; intros sp ax h pre spge. sep on. assert (Hx : h ||- stkSpacePrec (sp-2) (IH_Stk-2) *^* sp-2 |->w ax *^* INV0). sep matchH pre with 3. sep lift 1 in Hx. sep on. sep trivial. Qed. Lemma timer_popax_pre2post: forall sp ax h, timer_pushbx_MPre sp ax h -> sp >= IH_Stk -> (INV0 *^* stkSpacePrec sp IH_Stk) h. Proof. intros sp ax h pre spge. unfold timer_pushbx_MPre in * . sep on. sep lift 1. apply stkSpacePrec_mergeW1. sep matchH pre with 2. omega. omega. Qed. Lemma IH_WFcmd_1144_popax: IH_WFcmd (SCAP_consCT (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_iret g_timer_iret ihtag) Psi_timer) (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_popax g_timer_popax ihtag) (comml (_popw AX)). Proof. exists p_timer_iret. exists g_timer_iret. split. constructor; auto. split. (** enable nextS **) intros st [sp [ax pre]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. assert ((sp-2 |~>w ax) M1). apply timer_popax_has_item; auto. exists (h, (RF_update (RF_update R SP (sp-2+2)) AX ax), fl, isr). apply nextS_popw with (RF_update R SP (sp-2+2)) ax; auto. unfold popW; rewrite eqsp. split; auto. apply leadsToW_Mono with M1 M2; auto. split. (** pimp **) intros st' [st [pS nS]]. destruct pS as [sp [ax pre]]. destruct pre as [M1 [M2 [djh [pre mM2]]]]. destruct pre as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. induction st as (((h, R), fl), isr). UnfoldStateAll. induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. rewrite eqsp in H0. destruct H0 as [[ax' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl. rewrite eqisr. rewrite eqr. rewrite H. exists sp. exists M1. exists M2. split_l. split_r. repeat split; auto. simplS. apply timer_popax_pre2post with ax; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. omega. (** gimp **) intros st st'' [st' [[pS nS] gS]]. induction st as (((h, R), fl), isr). induction st' as (((h', R'), fl'), isr'). destruct (nextS_inversion nS); clear nS. destruct H0 as [[ax' [ldt eqr]] [eqfl eqisr]]. rewrite eqfl in gS. rewrite eqisr in gS. rewrite eqr in gS. rewrite H in gS. induction st'' as (((h'', R''), fl''), isr''). intros M1 M2 djh sp ax post. destruct post as [mM1 [eqsp [spge [NinIsr IFtrue]]]]. UnfoldStateAll. assert (eqax: ax' = ax). rewrite eqsp in ldt. apply leadsToW_unique with (sp-2) h; auto. apply leadsToW_Mono with M1 M2; auto. apply timer_popax_has_item; auto. rewrite eqax in gS. assert (pre: timer_iret_pre sp (M1, RF_update (RF_update R SP (R SP + 2)) AX ax, fl, isr)). repeat split; auto. simplS. apply timer_popax_pre2post with ax; auto. unfold S_Mem_Upd, S_RF, RF_update; unfold beq_reg. rewrite eqsp. omega. unfold g_timer_iret in gS. (** 2. pS -> gS -> pS'', S.H = M1 *^* M2 **) UnfoldStateAll. substH gS with (gS M1 M2 djh sp pre). destruct gS as [M1'' [djh'' [[pre'' NinISr] eqR]]]. exists M1''. split_l. rewrite eqsp in eqR. rewrite eqR. repeat split; auto. simplS; reg simpl. omega. Qed. Lemma IH_WFcmd_1145_iret: IH_WFcmd Psi_timer (h_entry + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1) (Ast p_timer_iret g_timer_iret ihtag) (comms _iret). Proof. simpl. split_l. (** ihtag = zero, see the defination in ./SCAP/AIM.v and ./SCAP/SCAP_Itr.v *) intros S HS M1 M2 djh sp [mM1 [eqsp [spge [NinIsr IFtrue]]]]. unfold p_timer_iret in HS. unfold timer_iret_pre in HS. exists M1. split_l. repeat split; auto. Qed. (**************************************************************) (** Well-formed Instruction Sequence *******) Lemma IH_WFiseq_timer : IH_WFiseq Psi_timer h_entry s_timer I_timer. Proof. unfold I_timer. apply ih_isq_seq with p_timer_pushbx g_timer_pushbx. apply IH_WFcmd_1127_pushax. apply ih_isq_seq with p_timer_pushcx g_timer_pushcx. apply IH_WFcmd_1128_pushbx. apply ih_isq_seq with p_timer_pushdx g_timer_pushdx. apply IH_WFcmd_1129_pushcx. apply ih_isq_seq with p_timer_pushdi g_timer_pushdi. apply IH_WFcmd_1130_pushdx. apply ih_isq_seq with p_timer_pushsi g_timer_pushsi. apply IH_WFcmd_1131_pushdi. apply ih_isq_seq with p_timer_pushbp g_timer_pushbp. apply IH_WFcmd_1132_pushsi. apply ih_isq_seq with p_timer_movax g_timer_movax. apply IH_WFcmd_1133_pushbp. apply ih_isq_seq with (conjP p_timer_movax (fun st : State => S_RF st AX = 32)) g_timer_movax. apply IH_WFcmd_1134_movax. apply ih_isq_seq with (conjP p_timer_movax (fun st : State => S_RF st AX = 32 /\ S_RF st DX =32)) g_timer_movax. apply IH_WFcmd_1135_movdx. apply ih_isq_seq with p_timer_scheduler g_timer_scheduler. apply IH_WFcmd_1136_eoi. apply ih_isq_seq with p_timer_popbp g_timer_popbp. apply IH_WFcmd_1137_scheduler. apply ih_isq_seq with p_timer_popsi g_timer_popsi. apply IH_WFcmd_1138_popbp. apply ih_isq_seq with p_timer_popdi g_timer_popdi. apply IH_WFcmd_1139_popsi. apply ih_isq_seq with p_timer_popdx g_timer_popdx. apply IH_WFcmd_1140_popdi. apply ih_isq_seq with p_timer_popcx g_timer_popcx. apply IH_WFcmd_1141_popdx. apply ih_isq_seq with p_timer_popbx g_timer_popbx. apply IH_WFcmd_1142_popcx. apply ih_isq_seq with p_timer_popax g_timer_popax. apply IH_WFcmd_1143_popbx. apply ih_isq_seq with p_timer_iret g_timer_iret. apply IH_WFcmd_1144_popax. apply ih_isq_end. apply IH_WFcmd_1145_iret. Qed. coq/miniOS/YieldProof.v0000644000107400000620000026043211000223231014505 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Set Undo 400. Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Mem_Lemmas. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import AIM. Require Import AIM_Lemmas. Require Import SCAP. Require Import SCAP_READY. Require Import QLib. Require Import Linking. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas5. Require Import Reg. Require Import Kernel. Require Import YieldSpec. (********Source Code *************************** yield: cli pushw %ax pushw %bx pushw %cx pushw %dx pushw %di pushw %si pushw %bp pushfw call scheduler popfw popw %bp popw %si popw %di popw %dx popw %cx popw %bx popw %ax sti retw ************************************************) Lemma NH_WFcmd_yield_0_cli : NH_WFcmd (SCAP_consCT (L_yield+1) (Ast L_yield_1_p L_yield_1_g tag_yield) psi_yield) (L_yield) (Ast L_yield_0_p L_yield_0_g tag_yield) (comml (_cli)). Proof. simpl. split. exists L_yield_1_p; exists L_yield_1_g. split_l. assert (Hpp': forall sp pc mP S S', Ast_yield_pre sp pc mP S -> gcli S S' -> Ast_yield_1 sp pc mP S'). intros sp pc mP S S' HS HSS'. unfold linkPG, conjPG, conjG. unfold Ast_yield_pre, gcli, Ast_yield_1 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct HS as [HM [Hsp Hitr]]. destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. assert (Hshift' : prepost Aemp (INV0 *^* INV1) (M, R, fl, isr) (M', R', fl', isr')). apply (prepost_weaken_post (mQ' := INV0 *^* INV1) Hshift). intros Mx H. apply (choice_elim_left H); trivial. split. sep on. assert (HMx : S_Mem (M, R, fl, isr) ||- (Aemp) *^* (stkSpacePrec sp _STK_SIZE_yield *^* sp |->w pc *^* mP)). sep matchH HM with 4. substH HM with (prepost_elim Hshift' precise_emp HMx). sep on. sep matchH HM with 5. split. simplS in * . subst R'; trivial. split. simplS in * . assert (stkSpace sp _STK_SIZE_yield M). sep on. sep lift 0 in HM. sep trivial. destruct H; trivial. split_l. simplS in * . subst isr'; destruct Hitr; trivial. split. (* p ==> p' *) unfold L_yield_0_p, L_yield_1_p. intros S' H. unfold linkPG in H. destruct H as [S [HS HSS']]. destruct HS as [sp [pc HpS]]. exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) unfold L_yield_0_g, L_yield_1_g. unfold linkPG, conjPG, conjG. intros S S'' H. destruct H as [S' H]. destruct H as [[HpS HSS'] HS'S'']. intros mP sp pc HS. substH Hpp' with (Hpp' sp pc mP S S' HS HSS'). substH HS'S'' with (HS'S'' mP sp pc Hpp'). destruct HS'S'' as [HS'' HR'']. split_l. unfold gcli in HSS'. destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. rewrite HR'. rewrite HR''. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_0_p in HS. destruct HS as [sp [pc HS]]. unfold Ast_yield_pre in HS. destruct HS as [HM [HSP [Hif Hisr]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. assert (Hsp : sp >= _STK_SIZE_yield). assert (stkSpace sp _STK_SIZE_yield M). sep on. sep lift 0 in HM. sep trivial. destruct H; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold L_yield_0_p. exists sp; exists pc. unfold Ast_yield_pre. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_0_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_yield_pre in * . simplS in * . destruct HS as [HM [HSP [Hif Hisr]]]. rsplit. repeat split_l; trivial. sep on. assert (Hsp : sp >= _STK_SIZE_yield). assert (stkSpace sp _STK_SIZE_yield (MemMod.merge M1 M2')). sep on. sep lift 0 in HM. sep trivial. destruct H; trivial. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma NH_WFcmd_yield_1_pushwp : NH_WFcmd (SCAP_consCT (L_yield+1+1) (Ast L_yield_2_p L_yield_2_g tag_yield) psi_yield) (L_yield+1) (Ast L_yield_1_p L_yield_1_g tag_yield) (comml (_pushwp (Opr_reg AX))). Proof. simpl. split. exists L_yield_2_p; exists L_yield_2_g. split_l. assert (Hpp' : forall sp pc mP S S', Ast_yield_1 sp pc mP S -> nextS (L_yield+1) (comml (_pushwp (Opr_reg AX))) S S' -> Ast_yield_2 sp pc (S_RF S AX) mP S'). intros sp pc mP S S' HS HSS'. unfold Ast_yield_1, Ast_yield_2 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. split. subst M' R' sp. sep on. sep lift 3. reg simpl. sep upd. assert (Hx : M ||- stkSpacePrec (R SP - 2) (_STK_SIZE_yield - 2) *^* R SP - 2 |->w_ *^* R SP |->w pc *^* INV1 *^* INV0 *^* mP). assocr. apply stkSpacePrec_splitW1. arith_rep (R SP - 2 + 2) with (R SP). arith_rep (_STK_SIZE_yield - 2 + 2) with (_STK_SIZE_yield). sep matchH HM with 4. sep matchH Hx with 5. subst R' fl' isr' sp; reg simpl. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_1_p in HpS. destruct HpS as [sp [pc HS]]. exists (MemUpdW M (sp-2) (R AX) 0, RF_update R SP (sp - 2), fl, isr). apply nextS_pushwp with (R AX); trivial. unfold pushW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . split. apply stkSpace_weaken with _STK_SIZE_yield; [idtac | omega]. sep on. sep lift 2 in HM. subst sp. sep trivial. split. subst sp; eapply MemUpdW_MemUpd16; eauto. subst sp; trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_1_p, L_yield_2_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc HS]]. exists sp; exists pc; exists (S_RF S AX). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_1_g, L_yield_2_g in * . intros mP sp pc HS. substH Hpp' with (Hpp' _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hsp _]]. simplS in * . subst sp R' fl'. reg simpl. apply (extensionality reg nat R'' R). induction x; auto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_1_p in HS. destruct HS as [sp [pc HS]]. unfold Ast_yield_1 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_1_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_1 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_2_pushwp : NH_WFcmd (SCAP_consCT (L_yield+2+1) (Ast L_yield_3_p L_yield_3_g tag_yield) psi_yield) (L_yield+2) (Ast L_yield_2_p L_yield_2_g tag_yield) (comml (_pushwp (Opr_reg BX))). Proof. simpl. split. exists L_yield_3_p; exists L_yield_3_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax mP S S', Ast_yield_2 sp pc ax mP S -> nextS (L_yield+2) (comml (_pushwp (Opr_reg BX))) S S' -> Ast_yield_3 sp pc ax (S_RF S BX) mP S'). intros sp pc ax mP S S' HS HSS'. unfold Ast_yield_2, Ast_yield_3 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hax [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. sep on. sep lift 3. rewrite Hsp. arith_rep (sp - 2 -2) with (sp-4). sep upd. assert (Hx : M ||- stkSpacePrec (sp - 4) (_STK_SIZE_yield - 4) *^* sp - 4 |->w_ *^* sp - 2 |->w ax *^* sp |->w pc *^* INV1 *^* INV0 *^* mP). arith_rep (sp - 4) with (sp - 2 -2). arith_rep (_STK_SIZE_yield - 4) with (_STK_SIZE_yield - 2 - 2). assocr. apply stkSpacePrec_splitW1. subst ax. arith_rep (sp - 2 - 2 + 2) with (sp - 2). arith_rep (_STK_SIZE_yield - 2 - 2 + 2) with (_STK_SIZE_yield - 2). sep matchH HM with 5. sep matchH Hx with 6. subst R' fl' isr'; reg simpl. rewrite Hsp. split_l. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_2_p in HpS. destruct HpS as [sp [pc [ax HS]]]. exists (MemUpdW M (sp-4) (R BX) 0, RF_update R SP (sp - 4), fl, isr). apply nextS_pushwp with (R BX); trivial. unfold pushW. destruct HS as [HM [Hax [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . rewrite Hsp. arith_rep (sp-2-2) with (sp - 4). split. apply stkSpace_weaken with (_STK_SIZE_yield - 2); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_2_p, L_yield_3_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax HS]]]. exists sp; exists pc; exists ax; exists (S_RF S BX). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_2_g, L_yield_3_g in * . intros mP sp pc ax HS. substH Hpp' with (Hpp' _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hax [Hsp _]]]. simplS in * . subst ax sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_2_p in HS. destruct HS as [sp [pc [ax HS]]]. unfold Ast_yield_2 in HS. destruct HS as [HM [HAX [HSP [Hsp [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_2_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_2 in HS. simplS in * . destruct HS as [HM [HAX [HSP [Hsp [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_3_pushwp : NH_WFcmd (SCAP_consCT (L_yield+3+1) (Ast L_yield_4_p L_yield_4_g tag_yield) psi_yield) (L_yield+3) (Ast L_yield_3_p L_yield_3_g tag_yield) (comml (_pushwp (Opr_reg CX))). Proof. simpl. split. exists L_yield_4_p; exists L_yield_4_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx mP S S', Ast_yield_3 sp pc ax bx mP S -> nextS (L_yield+3) (comml (_pushwp (Opr_reg CX))) S S' -> Ast_yield_4 sp pc ax bx (S_RF S CX) mP S'). intros sp pc ax bx mP S S' HS HSS'. unfold Ast_yield_3, Ast_yield_4 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hbx [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. sep on. sep lift 3. rewrite Hsp. arith_rep (sp - 4 -2) with (sp-6). sep upd. assert (Hx : M ||- stkSpacePrec (sp - 6) (_STK_SIZE_yield - 6) *^* sp - 6 |->w_ *^* sp - 4 |->w bx *^* sp - 2 |->w ax *^* sp |->w pc *^* INV1 *^* INV0 *^* mP). arith_rep (sp - 6) with (sp - 4 -2). arith_rep (_STK_SIZE_yield - 6) with (_STK_SIZE_yield - 4 - 2). assocr. apply stkSpacePrec_splitW1. subst bx. arith_rep (sp - 4 - 2 + 2) with (sp - 4). arith_rep (_STK_SIZE_yield - 4 - 2 + 2) with (_STK_SIZE_yield - 4). sep matchH HM with 5. sep matchH Hx with 7. subst R' fl' isr'; reg simpl. rewrite Hsp. split_l. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_3_p in HpS. destruct HpS as [sp [pc [ax [bx HS]]]]. exists (MemUpdW M (sp-6) (R CX) 0, RF_update R SP (sp - 6), fl, isr). apply nextS_pushwp with (R CX); trivial. unfold pushW. destruct HS as [HM [Hbx [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . rewrite Hsp. arith_rep (sp-4-2) with (sp - 6). split. apply stkSpace_weaken with (_STK_SIZE_yield - 4); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_3_p, L_yield_4_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx HS]]]]. exists sp; exists pc; exists ax; exists bx; exists (S_RF S CX). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_3_g, L_yield_4_g in * . intros mP sp pc ax bx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hax [Hsp _]]]. simplS in * . subst ax bx sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_3_p in HS. destruct HS as [sp [pc [ax [bx HS]]]]. unfold Ast_yield_3 in HS. destruct HS as [HM [HBX [HSP [Hsp [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_3_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_3 in HS. simplS in * . destruct HS as [HM [HBX [HSP [Hsp [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_4_pushwp : NH_WFcmd (SCAP_consCT (L_yield+4+1) (Ast L_yield_5_p L_yield_5_g tag_yield) psi_yield) (L_yield+4) (Ast L_yield_4_p L_yield_4_g tag_yield) (comml (_pushwp (Opr_reg DX))). Proof. simpl. split. exists L_yield_5_p; exists L_yield_5_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx mP S S', Ast_yield_4 sp pc ax bx cx mP S -> nextS (L_yield+4) (comml (_pushwp (Opr_reg DX))) S S' -> Ast_yield_5 sp pc ax bx cx (S_RF S DX) mP S'). intros sp pc ax bx cx mP S S' HS HSS'. unfold Ast_yield_4, Ast_yield_5 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hcx [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. sep on. sep lift 3. rewrite Hsp. arith_rep (sp - 6 -2) with (sp-8). sep upd. assert (Hx : M ||- stkSpacePrec (sp - 8) (_STK_SIZE_yield - 8) *^* sp - 8 |->w_ *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax *^* sp |->w pc *^* INV1 *^* INV0 *^* mP). arith_rep (sp - 8) with (sp - 6 -2). arith_rep (_STK_SIZE_yield - 8) with (_STK_SIZE_yield - 6 - 2). assocr. apply stkSpacePrec_splitW1. subst cx. arith_rep (sp - 6 - 2 + 2) with (sp - 6). arith_rep (_STK_SIZE_yield - 6 - 2 + 2) with (_STK_SIZE_yield - 6). sep matchH HM with 5. sep matchH Hx with 8. subst R' fl' isr'; reg simpl. rewrite Hsp. split_l. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_4_p in HpS. destruct HpS as [sp [pc [ax [bx [cx HS]]]]]. exists (MemUpdW M (sp-8) (R DX) 0, RF_update R SP (sp - 8), fl, isr). apply nextS_pushwp with (R DX); trivial. unfold pushW. destruct HS as [HM [Hcx [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . rewrite Hsp. arith_rep (sp-6-2) with (sp - 8). split. apply stkSpace_weaken with (_STK_SIZE_yield - 6); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_4_p, L_yield_5_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx [cx HS]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists (S_RF S DX). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_4_g, L_yield_5_g in * . intros mP sp pc ax bx cx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hcx [Hsp _]]]. simplS in * . subst ax bx cx sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_4_p in HS. destruct HS as [sp [pc [ax [bx [cx HS]]]]]. unfold Ast_yield_4 in HS. destruct HS as [HM [HCX [HSP [Hsp [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_4_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_4 in HS. simplS in * . destruct HS as [HM [HCX [HSP [Hsp [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_5_pushwp : NH_WFcmd (SCAP_consCT (L_yield+5+1) (Ast L_yield_6_p L_yield_6_g tag_yield) psi_yield) (L_yield+5) (Ast L_yield_5_p L_yield_5_g tag_yield) (comml (_pushwp (Opr_reg DI))). Proof. simpl. split. exists L_yield_6_p; exists L_yield_6_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx dx mP S S', Ast_yield_5 sp pc ax bx cx dx mP S -> nextS (L_yield+5) (comml (_pushwp (Opr_reg DI))) S S' -> Ast_yield_6 sp pc ax bx cx dx (S_RF S DI) mP S'). intros sp pc ax bx cx dx mP S S' HS HSS'. unfold Ast_yield_5, Ast_yield_6 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hdx [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. sep on. sep lift 3. rewrite Hsp. arith_rep (sp - 8 - 2) with (sp-10). sep upd. assert (Hx : M ||- stkSpacePrec (sp - 10) (_STK_SIZE_yield - 10) *^* sp - 10 |->w_ *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax *^* sp |->w pc *^* INV1 *^* INV0 *^* mP). arith_rep (sp - 10) with (sp - 8 -2). arith_rep (_STK_SIZE_yield - 10) with (_STK_SIZE_yield - 8 - 2). assocr. apply stkSpacePrec_splitW1. subst dx. arith_rep (sp - 8 - 2 + 2) with (sp - 8). arith_rep (_STK_SIZE_yield - 8 - 2 + 2) with (_STK_SIZE_yield - 8). sep matchH HM with 6. sep matchH Hx with 9. subst R' fl' isr'; reg simpl. rewrite Hsp. split_l. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_5_p in HpS. destruct HpS as [sp [pc [ax [bx [cx [dx HS]]]]]]. exists (MemUpdW M (sp-10) (R DI) 0, RF_update R SP (sp - 10), fl, isr). apply nextS_pushwp with (R DI); trivial. unfold pushW. destruct HS as [HM [Hdx [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . rewrite Hsp. arith_rep (sp-8-2) with (sp - 10). split. apply stkSpace_weaken with (_STK_SIZE_yield - 8); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_5_p, L_yield_6_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx [cx [dx HS]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists (S_RF S DI). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_5_g, L_yield_6_g in * . intros mP sp pc ax bx cx dx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hdx [Hsp _]]]. simplS in * . subst ax bx cx dx sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_5_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx HS]]]]]]. unfold Ast_yield_5 in HS. destruct HS as [HM [HDX [HSP [Hsp [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_5_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx dx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_5 in HS. simplS in * . destruct HS as [HM [HDX [HSP [Hsp [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_6_pushwp : NH_WFcmd (SCAP_consCT (L_yield+6+1) (Ast L_yield_7_p L_yield_7_g tag_yield) psi_yield) (L_yield+6) (Ast L_yield_6_p L_yield_6_g tag_yield) (comml (_pushwp (Opr_reg SI))). Proof. simpl. split. exists L_yield_7_p; exists L_yield_7_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx dx di mP S S', Ast_yield_6 sp pc ax bx cx dx di mP S -> nextS (L_yield+6) (comml (_pushwp (Opr_reg SI))) S S' -> Ast_yield_7 sp pc ax bx cx dx di (S_RF S SI) mP S'). intros sp pc ax bx cx dx di mP S S' HS HSS'. unfold Ast_yield_6, Ast_yield_7 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hdi [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. sep on. sep lift 3. rewrite Hsp. arith_rep (sp - 10 - 2) with (sp-12). sep upd. assert (Hx : M ||- stkSpacePrec (sp - 12) (_STK_SIZE_yield - 12) *^* sp - 12 |->w_ *^* sp - 10 |->w di *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax *^* sp |->w pc *^* INV1 *^* INV0 *^* mP). arith_rep (sp - 12) with (sp - 10 -2). arith_rep (_STK_SIZE_yield - 12) with (_STK_SIZE_yield - 10 - 2). assocr. apply stkSpacePrec_splitW1. subst di. arith_rep (sp - 10 - 2 + 2) with (sp - 10). arith_rep (_STK_SIZE_yield - 10 - 2 + 2) with (_STK_SIZE_yield - 10). sep matchH HM with 7. sep matchH Hx with 10. subst R' fl' isr' di; reg simpl. rewrite Hsp. split_l. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_6_p in HpS. destruct HpS as [sp [pc [ax [bx [cx [dx [di HS]]]]]]]. exists (MemUpdW M (sp-12) (R SI) 0, RF_update R SP (sp - 12), fl, isr). apply nextS_pushwp with (R SI); trivial. unfold pushW. destruct HS as [HM [Hdi [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . rewrite Hsp. arith_rep (sp-10-2) with (sp - 12). split. apply stkSpace_weaken with (_STK_SIZE_yield - 10); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_6_p, L_yield_7_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx [cx [dx [di HS]]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists (S_RF S SI). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_6_g, L_yield_7_g in * . intros mP sp pc ax bx cx dx di HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hdi [Hsp _]]]. simplS in * . subst ax bx cx dx di sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_6_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx [di HS]]]]]]]. unfold Ast_yield_6 in HS. destruct HS as [HM [HDI [HSP [Hsp [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_6_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx dx di HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_6 in HS. simplS in * . destruct HS as [HM [HDI [HSP [Hsp [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_7_pushwp : NH_WFcmd (SCAP_consCT (L_yield+7+1) (Ast L_yield_8_p L_yield_8_g tag_yield) psi_yield) (L_yield+7) (Ast L_yield_7_p L_yield_7_g tag_yield) (comml (_pushwp (Opr_reg BP))). Proof. simpl. split. exists L_yield_8_p; exists L_yield_8_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx dx di si mP S S', Ast_yield_7 sp pc ax bx cx dx di si mP S -> nextS (L_yield+7) (comml (_pushwp (Opr_reg BP))) S S' -> Ast_yield_8 sp pc ax bx cx dx di si (S_RF S BP) mP S'). intros sp pc ax bx cx dx di si mP S S' HS HSS'. unfold Ast_yield_7, Ast_yield_8 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hdi [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. sep on. sep lift 3. rewrite Hsp. arith_rep (sp - 12 - 2) with (sp-14). sep upd. assert (Hx : M ||- stkSpacePrec (sp - 14) (_STK_SIZE_yield - 14) *^* sp - 14 |->w_ *^* sp - 12 |->w si *^* sp - 10 |->w di *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax *^* sp |->w pc *^* INV1 *^* INV0 *^* mP). arith_rep (sp - 14) with (sp - 12 -2). arith_rep (_STK_SIZE_yield - 14) with (_STK_SIZE_yield - 12 - 2). assocr. apply stkSpacePrec_splitW1. subst si. arith_rep (sp - 12 - 2 + 2) with (sp - 12). arith_rep (_STK_SIZE_yield - 12 - 2 + 2) with (_STK_SIZE_yield - 12). sep matchH HM with 8. sep matchH Hx with 11. subst R' fl' isr' si; reg simpl. rewrite Hsp. split_l. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_7_p in HpS. destruct HpS as [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]. exists (MemUpdW M (sp-14) (R BP) 0, RF_update R SP (sp - 14), fl, isr). apply nextS_pushwp with (R BP); trivial. unfold pushW. destruct HS as [HM [Hsi [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . rewrite Hsp. arith_rep (sp-12-2) with (sp - 14). split. apply stkSpace_weaken with (_STK_SIZE_yield - 12); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_7_p, L_yield_8_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists (S_RF S BP). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_6_g, L_yield_7_g in * . intros mP sp pc ax bx cx dx di si HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hsi [Hsp _]]]. simplS in * . subst ax bx cx dx di si sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_7_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]. unfold Ast_yield_7 in HS. destruct HS as [HM [HSI [HSP [Hsp [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_7_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx dx di si HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_7 in HS. simplS in * . destruct HS as [HM [HSI [HSP [Hsp [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_8_pushfw : NH_WFcmd (SCAP_consCT (L_yield+8+1) (Ast L_yield_9_p L_yield_9_g tag_yield) psi_yield) (L_yield+8) (Ast L_yield_8_p L_yield_8_g tag_yield) (comml (_pushfw)). Proof. simpl. split. exists L_yield_9_p; exists L_yield_9_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx dx di si bp mP S S', Ast_yield_8 sp pc ax bx cx dx di si bp mP S -> nextS (L_yield+8) (comml (_pushfw)) S S' -> Ast_yield_9 sp pc ax bx cx dx di si bp (FR2nat (S_Flag S)) mP S'). intros sp pc ax bx cx dx di si bp mP S S' HS HSS'. unfold Ast_yield_8, Ast_yield_9 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hbp [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. sep on. sep lift 3. rewrite Hsp. arith_rep (sp - 14 - 2) with (sp-16). sep upd. assert (Hx : M ||- stkSpacePrec (sp - 16) (_STK_SIZE_yield - 16) *^* sp - 16 |->w_ *^* sp - 14 |->w bp *^* sp - 12 |->w si *^* sp - 10 |->w di *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax *^* sp |->w pc *^* INV1 *^* INV0 *^* mP). arith_rep (sp - 16) with (sp - 14 -2). arith_rep (_STK_SIZE_yield - 16) with (_STK_SIZE_yield - 14 - 2). assocr. apply stkSpacePrec_splitW1. subst bp. arith_rep (sp - 14 - 2 + 2) with (sp - 14). arith_rep (_STK_SIZE_yield - 14 - 2 + 2) with (_STK_SIZE_yield - 14). sep matchH HM with 9. sep matchH Hx with 12. subst R' fl' isr' bp; reg simpl. rewrite Hsp. split_l by omega. split_l. rewrite FR_nat_iso_left. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_8_p in HpS. destruct HpS as [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]. exists (MemUpdW M (sp-16) (FR2nat fl) 0, RF_update R SP (sp - 16), fl, isr). apply nextS_pushfw; trivial. unfold pushW. destruct HS as [HM [Hbp [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . rewrite Hsp. arith_rep (sp-14-2) with (sp - 16). split. apply stkSpace_weaken with (_STK_SIZE_yield - 14); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_8_p, L_yield_9_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp; exists (FR2nat (S_Flag S)). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_8_g, L_yield_9_g in * . intros mP sp pc ax bx cx dx di si bp HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hsi [Hsp _]]]. simplS in * . subst ax bx cx dx di si sp bp R' fl'. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_8_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]. unfold Ast_yield_8 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_8_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx dx di si bp HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_8 in HS. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_9_call : NH_WFcmd (SCAP_consCT (L_yield+9+1) (Ast L_yield_10_p L_yield_10_g tag_yield) psi_yield) (L_yield+9) (Ast L_yield_9_p L_yield_9_g tag_yield) (comml (_call _SWITCH)). Proof. simpl. split. assert (Hpp''' : forall sp pc ax bx cx dx di si bp flnum mP S S' S'' S''' pc', Ast_yield_9 sp pc ax bx cx dx di si bp flnum mP S -> nextS (L_yield+9) (comml (_call _SWITCH)) S S' -> gy S' S'' -> nextS pc' (comms _retw) S'' S''' -> Ast_yield_10 sp pc ax bx cx dx di si bp flnum mP S'''). intros sp pc ax bx cx dx di si bp flnum mP. intros S S' S'' S''' pc'. intros HS HSS' HS'S'' HS''S'''. unfold Ast_yield_9, Ast_yield_10 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. simplS in * . destruct HS as [HM [Hsp [Hspg [Hif [Hfl Hisr]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. unfold gy in HS'S''. destruct HS'S'' as [sp' [HM'' [Hif'' [Hisr'' HSP]]]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pc''' [Hlds''' HR''']]. destruct HM' as [Hspg' [Hlds Hupd]]. simplS in * . subst M''' R''' fl''' isr'''. subst isr'' R' fl' isr' isr. clear HSS' HS''S'''. reg simpl. destruct HSP as [Hsp' HSP]. subst sp'. rewrite <- HSP. rewrite Hsp. rewrite Hsp in HM''. split. sep on. sep lift 2. apply stkSpacePrec_mergeW1; [idtac | omega | omega ]. arith_rep (16+2+8-16-2) with 8. assert (Hx : M'' ||- (INV0 *^* INV1 *^* stkSpacePrec (sp - 16 - 2) 8) *^* (stkSpacePrec (sp - 16 - 2 - 8) IH_Stk *^* sp - 16 - 2 |->w (L_yield + 9 + 1) *^* sp - 16 |->w flnum *^* sp - 14 |->w bp *^* sp - 12 |->w si *^* sp - 10 |->w di *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax *^* sp |->w pc *^* mP)). replace M'' with (S_Mem (M'', R'', fl'', false)); trivial. sep off. assert (forall sp size, precise (INV0 *^* INV1 *^* stkSpacePrec sp size)). intros spx sizex. apply mstar_presv_prec. apply Prec01. apply precise_stkSpacePrec. apply prepost_elim with (INV0 *^* INV1 *^* stkSpacePrec (sp - 16 - 2) 8) (M', RF_update R SP (sp - 16 - 2), fl, false); auto. simplS. substH Hupd with (MemUpd16_MemUpdW Hupd). destruct Hupd as [x HM']. rewrite Hsp in HM'. subst M'. sep on. sep lift 4. sep upd. sep lift 2 in HM. sep stksplit in HM. arith_rep (_STK_SIZE_yield - 16 - 2) with (8 + IH_Stk) in HM. sep stksplit 8 in HM. arith_rep (8 + IH_Stk - 8) with IH_Stk in HM. sep matchH HM with 14. arith_rep (_STK_SIZE_yield - 16 - 2) with (8 + IH_Stk). sep stksplit 8. arith_rep (8 + IH_Stk - 8) with IH_Stk. sep matchH Hx with 13. split_l by omega. subst fl. rewrite <- Hif''. auto. left. split. unfold prim_entry. left; trivial. split. constructor 1 with L_yield_9_p L_yield_10_p L_yield_9_g L_yield_10_g tag_yield; trivial. (* enable *) unfold enable_sw. intros S HS. unfold L_yield_9_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]. unfold pTrue, pmstar. unfold Ast_yield_9 in HS. destruct S as [[[M R] fl] isr]. simplS in * . destruct HS as [HM [Hsp [Hspg HS]]]. rewrite Hsp. assert (HMx : ((stkSpacePrec (sp - 16 - (8 + 2)) IH_Stk *^* sp - 16 |->w flnum *^* sp - 14 |->w bp *^* sp - 12 |->w si *^* sp - 10 |->w di *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax *^* sp |->w pc *^* mTrue) *^* (INV0 *^* INV1 *^* stkSpacePrec (sp - 16) (8 + 2))) M). sep on. sep lift 2 in HM. sep stksplit (8+2) in HM. arith_rep (_STK_SIZE_yield - 16 - (8 + 2)) with IH_Stk in HM. sep matchH HM with 13. destruct HMx as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. auto. (* p ==> p' *) intros pc' S'''. unfold L_yield_9_p, L_yield_10_p. unfold wrap_fun. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S H]. destruct H as [HS H]. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp; exists flnum. eapply Hpp'''; eauto. (* g''' ==> g *) intros pc' S S''''. unfold L_yield_9_g, L_yield_10_g. unfold wrap_fun. intros HSS''''. unfold conjG at 1 in HSS'''' . destruct HSS'''' as [S''' [HSS''' H]]. destruct HSS''' as [HSx [S'' HSS''']]. destruct HSS''' as [HSS'' HS''S''']. destruct HSS'' as [S' [HSS' HS'S'']]. intros mP sp pc ax bx cx dx di si bp flnum HS. apply H with flnum. eapply Hpp'''; eauto. (* p ==> if=false *) intros S HS. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]. unfold Ast_yield_9 in HS. destruct HS as [HM [Hsp [Hspg [Hif [Hfl Hisr]]]]]. rewrite <- Hfl in Hif. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_9_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp [fln HS]]]]]]]]]]. unfold Ast_yield_9 in HS. destruct HS as [HM [HSP [Hsp [Hfln [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. rewrite Hfln in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_9_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx dx di si bp fln HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_9 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hfln [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. rewrite Hfln in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_10_popfw : NH_WFcmd (SCAP_consCT (L_yield+10+1) (Ast L_yield_11_p L_yield_11_g tag_yield) psi_yield) (L_yield+10) (Ast L_yield_10_p L_yield_10_g tag_yield) (comml (_popfw)). Proof. simpl. split. exists L_yield_11_p; exists L_yield_11_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx dx di si bp flnum mP S S', Ast_yield_10 sp pc ax bx cx dx di si bp flnum mP S -> stk_IF_cl S -> gpopfw_cli S S' -> Ast_yield_11 sp pc ax bx cx dx di si bp mP S'). intros sp pc ax bx cx dx di si bp flnum mP S S' HS Hcl HSS'. unfold Ast_yield_10, Ast_yield_11, stk_IF_cl in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold gpopfw_cli in HSS'. simplS in * . destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. assert (HM' : M' = M). apply (prepost_elim_emp_M M R fl isr M' R' fl' isr'). apply (prepost_weaken_post (mQ':=Aemp) Hshift). intros Mx H. apply (choice_elim_right H). intros [H1 H2]. InvertAll. simplS in * . rewrite H5 in H1; discriminate H1. subst M' R' isr'. destruct HS as [HM [Hsp [Hspg [Hif [Hfl Hisr]]]]]. split. sep on. sep matchH HM with 11. sep stksplit. arith_rep (sp - 14 - 2) with (sp - 16). arith_rep (_STK_SIZE_yield - 14 - 2) with (_STK_SIZE_yield - 16). sep matchH HM with 2. rewrite Hsp. reg simpl. split_l by omega. auto. assert (Hpp'_sti : forall sp pc ax bx cx dx di si bp flnum mP S S', Ast_yield_10 sp pc ax bx cx dx di si bp flnum mP S -> stk_IF_st S -> gpopfw_sti S S' -> Ast_yield_11 sp pc ax bx cx dx di si bp mP S'). clear Hpp'. intros sp pc ax bx cx dx di si bp flnum mP S S' HS Hst HSS'. unfold stk_IF_st in * . destruct Hst as [flnumx [Hlds Hif]]. unfold Ast_yield_10 in HS. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct HS as [HM [Hsp [Hspg [Hifx [Hfl Hisr]]]]]. simplS in * . assert (Heq : flnum = flnumx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst flnumx. rewrite Hfl in Hif; discriminate Hif. split. (* enable popfw *) clear Hpp' Hpp'_sti. unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_10_p in HpS. destruct HpS as [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]. exists (M, RF_update R SP (sp - 14),(nat2FR flnum), isr). apply nextS_popfw with flnum; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif [Hfl Hisr]]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 3 in HM. sep trivial. arith_rep (sp-16+2) with (sp - 14). split. (* enable sti *) unfold enable_popfw_sti, stk_IF_st, conjP. intros M R fl isr HS. destruct HS as [HS Hflnum]. unfold L_yield_10_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]. destruct Hflnum as [flnumx [Hlds Hif]]. unfold Ast_yield_10 in HS. destruct HS as [HM [Hsp [Hspg [Hifx [Hfl Hisr]]]]]. assert (Heq : flnum = flnumx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst flnumx. rewrite Hfl in Hif; discriminate Hif. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_10_p, L_yield_11_p. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. destruct HS as [HS Hst]. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp. eapply Hpp'_sti; eauto. split. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. destruct HpS as [HSx Hst]. unfold L_yield_10_g, L_yield_11_g in * . intros mP sp pc ax bx cx dx di si bp flnum HS. substH Hpp'_sti with (Hpp'_sti _ _ _ _ _ _ _ _ _ _ _ _ _ HS Hst HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ Hpp'_sti). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. unfold gpopfw_sti in HnextSS'. destruct HnextSS' as [HM' [Hif' [Hisr' HR']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hsi [Hsp [Hflnum [Hflnumx _]]]]]. simplS in * . subst ax bx cx dx di si sp bp R'. repeat split_l. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_10_p, L_yield_11_p. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. destruct HS as [HS Hcl]. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp. eapply Hpp'; eauto. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. destruct HpS as [HSx Hst]. unfold L_yield_10_g, L_yield_11_g in * . intros mP sp pc ax bx cx dx di si bp flnum HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ _ HS Hst HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. unfold gpopfw_cli in HnextSS'. destruct HnextSS' as [HM' [Hif' [Hisr' HR']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hsi [Hsp [Hflnum [Hflnumx _]]]]]. simplS in * . subst ax bx cx dx di si sp bp R'. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_10_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp [fln HS]]]]]]]]]]. unfold Ast_yield_10 in HS. destruct HS as [HM [HSP [Hsp [Hif [Hfln Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_10_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx dx di si bp fln HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_10 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif [Hfln Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_11_popw : NH_WFcmd (SCAP_consCT (L_yield+11+1) (Ast L_yield_12_p L_yield_12_g tag_yield) psi_yield) (L_yield+11) (Ast L_yield_11_p L_yield_11_g tag_yield) (comml (_popw BP)). Proof. simpl. split. exists L_yield_12_p; exists L_yield_12_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx dx di si bp mP S S', Ast_yield_11 sp pc ax bx cx dx di si bp mP S -> nextS (L_yield+11) (comml (_popw BP)) S S' -> Ast_yield_12 sp pc ax bx cx dx di si mP S'). intros sp pc ax bx cx dx di si bp mP S S' HS HSS'. unfold Ast_yield_11, Ast_yield_12 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [bpx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : bp = bpx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst bpx. subst M' fl' R' isr'. split. sep on. sep lift 2. sep lift 2 in HM. sep stksplit. arith_rep (sp - 12 - 2) with (sp-14). arith_rep (_STK_SIZE_yield - 12 - 2) with (_STK_SIZE_yield-14). sep matchH HM with 12. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_11_p in HpS. destruct HpS as [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]. exists (M, RF_update (RF_update R SP (sp - 12)) BP bp, fl, isr). apply nextS_popw with (RF_update R SP (sp - 12)) bp; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 3 in HM. sep trivial. arith_rep (sp - 14 + 2) with (sp - 12). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_11_p, L_yield_12_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si. apply Hpp' with bp S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_11_g, L_yield_12_g in * . intros mP sp pc ax bx cx dx di si bp HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [bpx [Hlds HR']]. assert (Heq : bp = bpx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst bpx ax bx cx dx di si sp R' fl' isr'. reg simpl. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_11_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]. unfold Ast_yield_11 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_11_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx dx di si bp HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_11 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_12_popw : NH_WFcmd (SCAP_consCT (L_yield+12+1) (Ast L_yield_13_p L_yield_13_g tag_yield) psi_yield) (L_yield+12) (Ast L_yield_12_p L_yield_12_g tag_yield) (comml (_popw SI)). Proof. simpl. split. exists L_yield_13_p; exists L_yield_13_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx dx di si mP S S', Ast_yield_12 sp pc ax bx cx dx di si mP S -> nextS (L_yield+12) (comml (_popw SI)) S S' -> Ast_yield_13 sp pc ax bx cx dx di mP S'). intros sp pc ax bx cx dx di si mP S S' HS HSS'. unfold Ast_yield_12, Ast_yield_13 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [six [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : si = six). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst six. subst M' fl' R' isr'. split. sep on. sep lift 2. sep lift 2 in HM. sep stksplit. arith_rep (sp - 10 - 2) with (sp-12). arith_rep (_STK_SIZE_yield - 10 - 2) with (_STK_SIZE_yield-12). sep matchH HM with 12. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_12_p in HpS. destruct HpS as [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]. exists (M, RF_update (RF_update R SP (sp - 10)) SI si, fl, isr). apply nextS_popw with (RF_update R SP (sp - 10)) si; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 3 in HM. sep trivial. arith_rep (sp - 12 + 2) with (sp - 10). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_12_p, L_yield_13_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di. apply Hpp' with si S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_12_g, L_yield_13_g in * . intros mP sp pc ax bx cx dx di si HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [six [Hlds HR']]. assert (Heq : si = six). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst six ax bx cx dx di sp R' fl' isr'. reg simpl. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_12_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]. unfold Ast_yield_12 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_12_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx dx di si HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_12 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_13_popw : NH_WFcmd (SCAP_consCT (L_yield+13+1) (Ast L_yield_14_p L_yield_14_g tag_yield) psi_yield) (L_yield+13) (Ast L_yield_13_p L_yield_13_g tag_yield) (comml (_popw DI)). Proof. simpl. split. exists L_yield_14_p; exists L_yield_14_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx dx di mP S S', Ast_yield_13 sp pc ax bx cx dx di mP S -> nextS (L_yield+13) (comml (_popw DI)) S S' -> Ast_yield_14 sp pc ax bx cx dx mP S'). intros sp pc ax bx cx dx di mP S S' HS HSS'. unfold Ast_yield_13, Ast_yield_14 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [dix [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : di = dix). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst dix. subst M' fl' R' isr'. split. sep on. sep lift 2. sep lift 2 in HM. sep stksplit. arith_rep (sp - 8 - 2) with (sp-10). arith_rep (_STK_SIZE_yield - 8 - 2) with (_STK_SIZE_yield-10). sep matchH HM with 9. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_13_p in HpS. destruct HpS as [sp [pc [ax [bx [cx [dx [di HS]]]]]]]. exists (M, RF_update (RF_update R SP (sp - 8)) DI di, fl, isr). apply nextS_popw with (RF_update R SP (sp - 8)) di; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 3 in HM. sep trivial. auto. arith_rep (sp - 10 + 2) with (sp - 8). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_13_p, L_yield_14_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx [cx [dx [di HS]]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx; exists dx. apply Hpp' with di S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_13_g, L_yield_14_g in * . intros mP sp pc ax bx cx dx di HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [dix [Hlds HR']]. assert (Heq : di = dix). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst dix ax bx cx dx sp R' fl' isr'. reg simpl. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_13_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx [di HS]]]]]]]. unfold Ast_yield_13 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_13_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx dx di HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_13 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_14_popw : NH_WFcmd (SCAP_consCT (L_yield+14+1) (Ast L_yield_15_p L_yield_15_g tag_yield) psi_yield) (L_yield+14) (Ast L_yield_14_p L_yield_14_g tag_yield) (comml (_popw DX)). Proof. simpl. split. exists L_yield_15_p; exists L_yield_15_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx dx mP S S', Ast_yield_14 sp pc ax bx cx dx mP S -> nextS (L_yield+14) (comml (_popw DX)) S S' -> Ast_yield_15 sp pc ax bx cx mP S'). intros sp pc ax bx cx dx mP S S' HS HSS'. unfold Ast_yield_14, Ast_yield_15 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [dxx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : dx = dxx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst dxx. subst M' fl' R' isr'. split. sep on. sep lift 2. sep lift 2 in HM. sep stksplit. arith_rep (sp - 6 - 2) with (sp-8). arith_rep (_STK_SIZE_yield - 6 - 2) with (_STK_SIZE_yield-8). sep matchH HM with 8. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_14_p in HpS. destruct HpS as [sp [pc [ax [bx [cx [dx HS]]]]]]. exists (M, RF_update (RF_update R SP (sp - 6)) DX dx, fl, isr). apply nextS_popw with (RF_update R SP (sp - 6)) dx; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 3 in HM. sep trivial. arith_rep (sp - 8 + 2) with (sp - 6). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_14_p, L_yield_15_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx [cx [dx HS]]]]]]. exists sp; exists pc; exists ax; exists bx; exists cx. apply Hpp' with dx S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_14_g, L_yield_15_g in * . intros mP sp pc ax bx cx dx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [dxx [Hlds HR']]. assert (Heq : dx = dxx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst ax bx cx dxx sp R' fl' isr'. reg simpl. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_14_p in HS. destruct HS as [sp [pc [ax [bx [cx [dx HS]]]]]]. unfold Ast_yield_14 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_14_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx dx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_14 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_15_popw : NH_WFcmd (SCAP_consCT (L_yield+15+1) (Ast L_yield_16_p L_yield_16_g tag_yield) psi_yield) (L_yield+15) (Ast L_yield_15_p L_yield_15_g tag_yield) (comml (_popw CX)). Proof. simpl. split. exists L_yield_16_p; exists L_yield_16_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx cx mP S S', Ast_yield_15 sp pc ax bx cx mP S -> nextS (L_yield+15) (comml (_popw CX)) S S' -> Ast_yield_16 sp pc ax bx mP S'). intros sp pc ax bx cx mP S S' HS HSS'. unfold Ast_yield_15, Ast_yield_16 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [cxx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : cx = cxx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst cxx. subst M' fl' R' isr'. split. sep on. sep lift 2. sep lift 2 in HM. sep stksplit. arith_rep (sp - 4 - 2) with (sp-6). arith_rep (_STK_SIZE_yield - 4 - 2) with (_STK_SIZE_yield-6). sep matchH HM with 7. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_15_p in HpS. destruct HpS as [sp [pc [ax [bx [cx HS]]]]]. exists (M, RF_update (RF_update R SP (sp - 4)) CX cx, fl, isr). apply nextS_popw with (RF_update R SP (sp - 4)) cx; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 3 in HM. sep trivial. arith_rep (sp - 6 + 2) with (sp - 4). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_15_p, L_yield_16_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx [cx HS]]]]]. exists sp; exists pc; exists ax; exists bx. apply Hpp' with cx S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_15_g, L_yield_16_g in * . intros mP sp pc ax bx cx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [cxx [Hlds HR']]. assert (Heq : cx = cxx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst ax bx cxx sp R' fl' isr'. reg simpl. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_15_p in HS. destruct HS as [sp [pc [ax [bx [cx HS]]]]]. unfold Ast_yield_15 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_15_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx cx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_15 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_16_popw : NH_WFcmd (SCAP_consCT (L_yield+16+1) (Ast L_yield_17_p L_yield_17_g tag_yield) psi_yield) (L_yield+16) (Ast L_yield_16_p L_yield_16_g tag_yield) (comml (_popw BX)). Proof. simpl. split. exists L_yield_17_p; exists L_yield_17_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax bx mP S S', Ast_yield_16 sp pc ax bx mP S -> nextS (L_yield+16) (comml (_popw BX)) S S' -> Ast_yield_17 sp pc ax mP S'). intros sp pc ax bx mP S S' HS HSS'. unfold Ast_yield_16, Ast_yield_17 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [bxx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : bx = bxx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst bxx. subst M' fl' R' isr'. split. sep on. sep lift 2. sep lift 2 in HM. sep stksplit. arith_rep (sp - 2 - 2) with (sp-4). arith_rep (_STK_SIZE_yield - 2 - 2) with (_STK_SIZE_yield-4). sep matchH HM with 6. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_16_p in HpS. destruct HpS as [sp [pc [ax [bx HS]]]]. exists (M, RF_update (RF_update R SP (sp - 2)) BX bx, fl, isr). apply nextS_popw with (RF_update R SP (sp - 2)) bx; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 3 in HM. sep trivial. arith_rep (sp - 4 + 2) with (sp - 2). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_16_p, L_yield_17_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax [bx HS]]]]. exists sp; exists pc; exists ax. apply Hpp' with bx S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_16_g, L_yield_17_g in * . intros mP sp pc ax bx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [bxx [Hlds HR']]. assert (Heq : bx = bxx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst ax bxx sp R' fl' isr'. reg simpl. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_16_p in HS. destruct HS as [sp [pc [ax [bx HS]]]]. unfold Ast_yield_16 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_16_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax bx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_16 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_17_popw : NH_WFcmd (SCAP_consCT (L_yield+17+1) (Ast L_yield_18_p L_yield_18_g tag_yield) psi_yield) (L_yield+17) (Ast L_yield_17_p L_yield_17_g tag_yield) (comml (_popw AX)). Proof. simpl. split. exists L_yield_18_p; exists L_yield_18_g. split_l (* lookup *). assert (Hpp' : forall sp pc ax mP S S', Ast_yield_17 sp pc ax mP S -> nextS (L_yield+17) (comml (_popw AX)) S S' -> Ast_yield_18 sp pc mP S'). intros sp pc ax mP S S' HS HSS'. unfold Ast_yield_17, Ast_yield_18 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [axx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : ax = axx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst axx. subst M' fl' R' isr'. split. sep on. sep lift 2. sep lift 2 in HM. sep stksplit. sep matchH HM with 6. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_yield_17_p in HpS. destruct HpS as [sp [pc [ax HS]]]. exists (M, RF_update (RF_update R SP sp) AX ax, fl, isr). apply nextS_popw with (RF_update R SP sp) ax; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 3 in HM. sep trivial. arith_rep (sp - 2 + 2) with sp. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_yield_17_p, L_yield_18_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [sp [pc [ax HS]]]. exists sp; exists pc. apply Hpp' with ax S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_yield_17_g, L_yield_18_g in * . intros mP sp pc ax HS. substH Hpp' with (Hpp' _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS as [HM [Hsp HS]]. simplS in * . destruct HR' as [axx [Hlds HR']]. assert (Heq : ax = axx). sep on. sep lift 3 in HM. rewrite Hsp in Hlds. sep inj. auto. subst axx R'' R' fl' isr'. reg simpl. repeat split_l. destruct HS as [Hspgt _]. rewrite Hsp. omega. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_17_p in HS. destruct HS as [sp [pc [ax HS]]]. unfold Ast_yield_17 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_17_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc ax HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_17 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_18_sti : NH_WFcmd (SCAP_consCT (L_yield+18+1) (Ast L_yield_19_p L_yield_19_g tag_yield) psi_yield) (L_yield+18) (Ast L_yield_18_p L_yield_18_g tag_yield) (comml (_sti)). Proof. simpl. split. exists L_yield_19_p; exists L_yield_19_g. split_l. (* lookup *) assert (Hpp': forall sp pc mP S S', Ast_yield_18 sp pc mP S -> gsti S S' -> Ast_yield_19 sp pc mP S'). intros sp pc mP S S' HS HSS'. unfold linkPG, conjPG, conjG. unfold Ast_yield_18, gsti, Ast_yield_19 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct HS as [HM [Hsp [Hspgt Hitr]]]. destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. assert (Hshift' : prepost (INV0 *^* INV1) Aemp (M, R, fl, isr) (M', R', fl', isr')). apply (prepost_weaken_pre (mP' := INV0 *^* INV1) Hshift). intros Mx HMx. apply (choice_elim_right HMx). unfold itr_enabled. intros [H1 H2]. simplS in * . destruct Hitr as [Hitr1 Hitr2]. rewrite Hitr1 in H1; discriminate H1. clear Hshift; rename Hshift' into Hshift. split. sep on. assert (HMx : S_Mem (M, R, fl, isr) ||- (INV0 *^* INV1) *^* (stkSpacePrec sp _STK_SIZE_yield *^* sp |->w pc *^* mP)). sep matchH HM with 4. substH HM with (prepost_elim Hshift Prec01 HMx). sep on. sep matchH HM with 6. simplS in * . subst R' isr'. split_l. split_l. destruct Hitr; trivial. split. (* enable *) unfold enable_sti. intros S HS. unfold L_yield_18_p in HS. unfold pTrue, pmstar, choice. destruct HS as [sp [pc HS]]. unfold Ast_yield_18 in HS. destruct HS as [HM [Hsp [Hspg [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. simplS in * . assert (HMx : ((stkSpacePrec sp _STK_SIZE_yield *^* sp |->w pc *^* mTrue) *^* (INV0 *^* INV1)) M). sep on. sep matchH HM with 4. destruct HMx as [M1 [M2 [HJM [HM1 HM2]]]]. exists M1; exists M2; split_l. split_l. right. split_r. intros [H1 H2]. simplS in * . rewrite Hif in H1; discriminate H1. split. (* p ==> p' *) unfold L_yield_18_p, L_yield_19_p. intros S' H. unfold linkPG in H. destruct H as [S [HS HSS']]. destruct HS as [sp [pc HpS]]. exists sp; exists pc. apply Hpp' with S; trivial. (* g' ==> g *) unfold L_yield_18_g, L_yield_19_g. unfold linkPG, conjPG, conjG. intros S S'' H. destruct H as [S' H]. destruct H as [[HpS HSS'] HS'S'']. intros mP sp pc HS. substH Hpp' with (Hpp' sp pc mP S S' HS HSS'). substH HS'S'' with (HS'S'' mP sp pc Hpp'). destruct HS'S'' as [HS'' HR'']. split_l. unfold gsti in HSS'. destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. rewrite HR'. rewrite HR''. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_18_p in HS. destruct HS as [sp [pc HS]]. unfold Ast_yield_18 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_18_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_yield_18 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_yield_19_retw : NH_WFcmd psi_yield (L_yield+19) (Ast L_yield_19_p L_yield_19_g tag_yield) (comms (_retw)). Proof. simpl. split. split_l. intros S HS. unfold L_yield_19_g. unfold Ast_yield_19, Ast_yield_post. intros mP sp pc H. destruct H as [H1 [H2 [H3 H4]]]. split_r. split_l. split_lr. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_yield_19_p in HS. destruct HS as [sp [pc HS]]. unfold Ast_yield_19 in HS. destruct HS as [HM [HSP [Hif Hisr]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . rewrite HSP. assert (Hsp : sp >= _STK_SIZE_yield). assert (stkSpace sp _STK_SIZE_yield M). sep on. sep lift 0 in HM. sep trivial. destruct H; trivial. sep on. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M1 [M2 [HJM [HM1 HM2]]]]. exists M2; exists M1. split. auto with PMap. split_l. intros M1' HM1'. unfold L_yield_19_p. exists sp; exists pc. unfold Ast_yield_19. simplS in * . rsplit. repeat split_l; trivial. sep on. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. exists M1'; exists M2. split. sep off. split. disjoint rep_l M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. merge commut M2. trivial. disjoint rep_r M1. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. split_l. sep on. sep matchH HM2 with 4. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_yield_19_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. apply HSS'. clear HSS'. unfold Ast_yield_19 in * . simplS in * . destruct HS as [HM [HSP [Hif Hisr]]]. rsplit. repeat split_l; trivial. sep on. assert (Hsp : sp >= _STK_SIZE_yield). assert (stkSpace sp _STK_SIZE_yield (MemMod.merge M1 M2')). sep on. sep lift 0 in HM. sep trivial. destruct H; trivial. sep lift 0 in HM. sep stksplit (IH_Stk + 6) in HM. sep lift 0 in HM. destruct HM as [M2x [M1x [HJM12 [HM2x HM1x]]]]. sep lift 0. sep stksplit (IH_Stk + 6). sep lift 1. assert (M2x = M2' /\ M1x = M1). sep off. assert (MemMod.disjUnion M1 M2' (MemMod.merge M1 M2')). split_r. disjoint rep_r M2. eapply stkSpacePrec_stkSpacePrec_eqDom; eauto. assert (MemMod.disjUnion M1x M2x (MemMod.merge M1 M2')). auto with PMap. rewrite HSP in HM2'. assert (Hx := prec_disjUnion_inv H H0 HM2' HM2x (@precise_stkSpacePrec _ _)). destruct Hx; auto. destruct H; subst M1x M2x. exists M2; exists M1. split. auto with PMap. rewrite HSP in HM2. split_l. sep on. sep matchH HM1x with 3. Qed. Lemma NH_WFiseq_yield : NH_WFiseq psi_yield L_yield spec_yield I_yield. Proof. unfold I_yield, spec_yield. apply nh_isq_seq with L_yield_1_p L_yield_1_g. apply NH_WFcmd_yield_0_cli. apply nh_isq_seq with L_yield_2_p L_yield_2_g. apply NH_WFcmd_yield_1_pushwp. assert (H : L_yield+1+1 = L_yield+2); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_3_p L_yield_3_g. apply NH_WFcmd_yield_2_pushwp. assert (H : L_yield+2+1 = L_yield+3); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_4_p L_yield_4_g. apply NH_WFcmd_yield_3_pushwp. assert (H : L_yield+3+1 = L_yield+4); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_5_p L_yield_5_g. apply NH_WFcmd_yield_4_pushwp. assert (H : L_yield+4+1 = L_yield+5); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_6_p L_yield_6_g. apply NH_WFcmd_yield_5_pushwp. assert (H : L_yield+5+1 = L_yield+6); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_7_p L_yield_7_g. apply NH_WFcmd_yield_6_pushwp. assert (H : L_yield+6+1 = L_yield+7); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_8_p L_yield_8_g. apply NH_WFcmd_yield_7_pushwp. assert (H : L_yield+7+1 = L_yield+8); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_9_p L_yield_9_g. apply NH_WFcmd_yield_8_pushfw. assert (H : L_yield+8+1 = L_yield+9); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_10_p L_yield_10_g. apply NH_WFcmd_yield_9_call. assert (H : L_yield+9+1 = L_yield+10); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_11_p L_yield_11_g. apply NH_WFcmd_yield_10_popfw. assert (H : L_yield+10+1 = L_yield+11); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_12_p L_yield_12_g. apply NH_WFcmd_yield_11_popw. assert (H : L_yield+11+1 = L_yield+12); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_13_p L_yield_13_g. apply NH_WFcmd_yield_12_popw. assert (H : L_yield+12+1 = L_yield+13); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_14_p L_yield_14_g. apply NH_WFcmd_yield_13_popw. assert (H : L_yield+13+1 = L_yield+14); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_15_p L_yield_15_g. apply NH_WFcmd_yield_14_popw. assert (H : L_yield+14+1 = L_yield+15); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_16_p L_yield_16_g. apply NH_WFcmd_yield_15_popw. assert (H : L_yield+15+1 = L_yield+16); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_17_p L_yield_17_g. apply NH_WFcmd_yield_16_popw. assert (H : L_yield+16+1 = L_yield+17); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_18_p L_yield_18_g. apply NH_WFcmd_yield_17_popw. assert (H : L_yield+17+1 = L_yield+18); [omega | rewrite H; clear H]. apply nh_isq_seq with L_yield_19_p L_yield_19_g. apply NH_WFcmd_yield_18_sti. assert (H : L_yield+18+1 = L_yield+19); [omega | rewrite H; clear H]. apply nh_isq_end. apply NH_WFcmd_yield_19_retw. Qed. coq/miniOS/SleepProof.v0000644000107400000620000026161311000223231014511 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import AIM. Require Import AIM_Lemmas. Require Import SCAP. Require Import SCAP_READY. Require Import QLib. Require Import Linking. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas5. Require Import Reg. Require Import Kernel. Require Import SleepSpec. (********Source Code *************************** # precondition: interrupt is disabled # sleep(q) sleep: pushw %ax pushw %bx pushw %cx pushw %dx pushw %di pushw %si pushw %bp pushfw movw %sp, %bp pushw 18(%bp) call block addw $2, %sp popfw popw %bp popw %si popw %di popw %dx popw %cx popw %bx popw %ax retw ************************************************) Lemma NH_WFcmd_sleep_0_pushwp : NH_WFcmd (SCAP_consCT (L_sleep+1) (Ast L_sleep_1_p L_sleep_1_g tag_sleep) psi_sleep) (L_sleep) (Ast L_sleep_0_p L_sleep_0_g tag_sleep) (comml (_pushwp (Opr_reg AX))). Proof. simpl. split. exists L_sleep_1_p; exists L_sleep_1_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc mP S S', Ast_sleep_0 l_ptr wqa sp pc mP S -> nextS (L_sleep) (comml (_pushwp (Opr_reg AX))) S S' -> Ast_sleep_1 l_ptr wqa sp pc (S_RF S AX) mP S'). intros l_ptr wqa sp pc mP S S' HS HSS'. unfold Ast_sleep_0, Ast_sleep_1 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. split. subst M' R' sp. sep on. sep lift 3. reg simpl. sep upd. sep lift 2 in HM. sep stksplit in HM. sep matchH HM with 6. subst R' fl' isr' sp; reg simpl. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_0_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc HS]]]]. exists (MemUpdW M (sp-2) (R AX) 0, RF_update R SP (sp - 2), fl, isr). apply nextS_pushwp with (R AX); trivial. unfold pushW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . split. apply stkSpace_weaken with _STK_SIZE_sleep; [idtac | omega]. sep on. sep lift 2 in HM. rewrite Hsp. sep trivial. split. subst sp; eapply MemUpdW_MemUpd16; eauto. subst sp; trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_0_p, L_sleep_1_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc HS]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists (S_RF S AX). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_0_g, L_sleep_1_g in * . intros mP l_ptr wqa sp pc HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hsp _]]. simplS in * . subst sp R' fl'. reg simpl. apply (extensionality reg nat R'' R). induction x; auto. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_0_p in HS. destruct HS as [l_ptr [wqa [sp [pc HS]]]]. unfold Ast_sleep_0 in HS. destruct HS as [HM [HSP [Hsp [HIF [Hisr Hwqa]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite HIF in IHif. discriminate. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_0_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_0 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif [Hisr Hwqa]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate. Qed. Lemma NH_WFcmd_sleep_1_pushwp : NH_WFcmd (SCAP_consCT (L_sleep+1+1) (Ast L_sleep_2_p L_sleep_2_g tag_sleep) psi_sleep) (L_sleep+1) (Ast L_sleep_1_p L_sleep_1_g tag_sleep) (comml (_pushwp (Opr_reg BX))). Proof. simpl. split. exists L_sleep_2_p; exists L_sleep_2_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax mP S S', Ast_sleep_1 l_ptr wqa sp pc ax mP S -> nextS (L_sleep+1) (comml (_pushwp (Opr_reg BX))) S S' -> Ast_sleep_2 l_ptr wqa sp pc ax (S_RF S BX) mP S'). intros l_ptr wqa sp pc ax mP S S' HS HSS'. unfold Ast_sleep_1, Ast_sleep_2 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hax [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. rewrite Hsp. sep on. sep lift 3. arith_rep (sp - 2 - 2) with (sp - 4). reg simpl. sep upd. sep lift 2 in HM. sep stksplit in HM. clear Hax Hsp Hspgt Hlds. arith_rep (sp - 2 - 2) with (sp - 4) in HM. arith_rep (18 + 2 + _BLK_Stk - 2 - 2) with (18 + 2 + _BLK_Stk - 4) in HM. sep matchH HM with 4. subst R' fl' isr'; reg simpl. rewrite Hsp. split_l. split_l by omega. auto. split. (* enable *) unfold enable. intros S HS. destruct S as [[[M R] fl] isr]. unfold L_sleep_1_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax HS]]]]]. exists (MemUpdW M (sp-4) (R BX) 0, RF_update R SP (sp - 4), fl, isr). apply nextS_pushwp with (R BX); trivial. unfold pushW. destruct HS as [HM [Hax [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . split. apply stkSpace_weaken with (_STK_SIZE_sleep - 2); [idtac | omega]. sep on. sep lift 2 in HM. rewrite Hsp. sep trivial. split. rewrite Hsp. arith_rep (sp - 2 - 2) with (sp - 4). eapply MemUpdW_MemUpd16; eauto. rewrite Hsp. arith_rep (sp - 2 - 2) with (sp - 4). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_1_p, L_sleep_2_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax HS]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists (S_RF S BX). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_1_g, L_sleep_2_g in * . intros mP l_ptr wqa sp pc ax HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hax [Hsp _]]]. simplS in * . subst ax sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_1_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax HS]]]]]. unfold Ast_sleep_1 in HS. destruct HS as [HM [HAX [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_1_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_1 in HS. simplS in * . destruct HS as [HM [HAX [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_sleep_2_pushwp : NH_WFcmd (SCAP_consCT (L_sleep+2+1) (Ast L_sleep_3_p L_sleep_3_g tag_sleep) psi_sleep) (L_sleep+2) (Ast L_sleep_2_p L_sleep_2_g tag_sleep) (comml (_pushwp (Opr_reg CX))). Proof. simpl. split. exists L_sleep_3_p; exists L_sleep_3_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx mP S S', Ast_sleep_2 l_ptr wqa sp pc ax bx mP S -> nextS (L_sleep+2) (comml (_pushwp (Opr_reg CX))) S S' -> Ast_sleep_3 l_ptr wqa sp pc ax bx (S_RF S CX) mP S'). intros l_ptr wqa sp pc ax bx mP S S' HS HSS'. unfold Ast_sleep_2, Ast_sleep_3 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hbx [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. rewrite Hsp. sep on. sep lift 3. arith_rep (sp - 4 - 2) with (sp - 6). reg simpl. sep upd. sep lift 2 in HM. sep stksplit in HM. arith_rep (sp - 4 - 2) with (sp - 6) in HM. arith_rep (_STK_SIZE_sleep - 4 - 2) with (_STK_SIZE_sleep - 6) in HM. sep matchH HM with 5. subst R' fl' isr'; reg simpl. rewrite Hsp. arith_rep (sp - 4 - 2) with (sp - 6). auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_2_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx HS]]]]]]. exists (MemUpdW M (sp-6) (R CX) 0, RF_update R SP (sp - 6), fl, isr). apply nextS_pushwp with (R CX); trivial. unfold pushW. destruct HS as [HM [Hbx [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . split. apply stkSpace_weaken with (_STK_SIZE_sleep - 4); [idtac | omega]. sep on. sep lift 2 in HM. rewrite Hsp. sep trivial. split. rewrite Hsp. arith_rep (sp - 4 - 2) with (sp - 6). eapply MemUpdW_MemUpd16; eauto. rewrite Hsp. arith_rep (sp - 4 - 2) with (sp - 6). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_2_p, L_sleep_3_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx HS]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists (S_RF S CX). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_2_g, L_sleep_3_g in * . intros mP l_ptr wqa sp pc ax bx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hbx [Hsp _]]]. simplS in * . subst bx sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_2_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx HS]]]]]]. unfold Ast_sleep_2 in HS. destruct HS as [HM [HBX [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_2_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_2 in HS. simplS in * . destruct HS as [HM [HBX [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_sleep_3_pushwp : NH_WFcmd (SCAP_consCT (L_sleep+3+1) (Ast L_sleep_4_p L_sleep_4_g tag_sleep) psi_sleep) (L_sleep+3) (Ast L_sleep_3_p L_sleep_3_g tag_sleep) (comml (_pushwp (Opr_reg DX))). Proof. simpl. split. exists L_sleep_4_p; exists L_sleep_4_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx mP S S', Ast_sleep_3 l_ptr wqa sp pc ax bx cx mP S -> nextS (L_sleep+3) (comml (_pushwp (Opr_reg DX))) S S' -> Ast_sleep_4 l_ptr wqa sp pc ax bx cx (S_RF S DX) mP S'). intros l_ptr wqa sp pc ax bx cx mP S S' HS HSS'. unfold Ast_sleep_2, Ast_sleep_3 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hcx [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. rewrite Hsp. sep on. sep lift 3. arith_rep (sp - 6 - 2) with (sp - 8). reg simpl. simplS in * . sep upd. sep lift 2 in HM. sep stksplit in HM. arith_rep (sp - 6 - 2) with (sp - 8) in HM. arith_rep (_STK_SIZE_sleep - 6 - 2) with (_STK_SIZE_sleep - 8) in HM. sep matchH HM with 5. subst R' fl' isr'; reg simpl. rewrite Hsp. arith_rep (sp - 6 - 2) with (sp - 8). auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_4_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx HS]]]]]]]. exists (MemUpdW M (sp-8) (R DX) 0, RF_update R SP (sp - 8), fl, isr). apply nextS_pushwp with (R DX); trivial. unfold pushW. destruct HS as [HM [Hcx [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . split. apply stkSpace_weaken with (_STK_SIZE_sleep - 6); [idtac | omega]. sep on. sep lift 2 in HM. rewrite Hsp. sep trivial. split. rewrite Hsp. arith_rep (sp - 6 - 2) with (sp - 8). eapply MemUpdW_MemUpd16; eauto. rewrite Hsp. arith_rep (sp - 6 - 2) with (sp - 8). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_3_p, L_sleep_4_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx HS]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists (S_RF S DX). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_3_g, L_sleep_4_g in * . intros mP l_ptr wqa sp pc ax bx cx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hcx [Hsp _]]]. simplS in * . subst cx sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_3_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx HS]]]]]]]. unfold Ast_sleep_3 in HS. destruct HS as [HM [HCX [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_3_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_3 in HS. simplS in * . destruct HS as [HM [HCX [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_sleep_4_pushwp : NH_WFcmd (SCAP_consCT (L_sleep+4+1) (Ast L_sleep_5_p L_sleep_5_g tag_sleep) psi_sleep) (L_sleep+4) (Ast L_sleep_4_p L_sleep_4_g tag_sleep) (comml (_pushwp (Opr_reg DI))). Proof. simpl. split. exists L_sleep_5_p; exists L_sleep_5_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx mP S S', Ast_sleep_4 l_ptr wqa sp pc ax bx cx dx mP S -> nextS (L_sleep+4) (comml (_pushwp (Opr_reg DI))) S S' -> Ast_sleep_5 l_ptr wqa sp pc ax bx cx dx (S_RF S DI) mP S'). intros l_ptr wqa sp pc ax bx cx dx mP S S' HS HSS'. unfold Ast_sleep_3, Ast_sleep_4 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hdx [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. rewrite Hsp. sep on. sep lift 3. arith_rep (sp - 8 - 2) with (sp - 10). reg simpl. simplS in * . sep upd. sep lift 2 in HM. sep stksplit in HM. arith_rep (sp - 8 - 2) with (sp - 10) in HM. arith_rep (_STK_SIZE_sleep - 8 - 2) with (_STK_SIZE_sleep - 10) in HM. sep matchH HM with 8. subst R' fl' isr'; reg simpl. rewrite Hsp. arith_rep (sp - 8 - 2) with (sp - 10). auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_5_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx HS]]]]]]]]. exists (MemUpdW M (sp-10) (R DI) 0, RF_update R SP (sp - 10), fl, isr). apply nextS_pushwp with (R DI); trivial. unfold pushW. destruct HS as [HM [Hdx [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . split. apply stkSpace_weaken with (_STK_SIZE_sleep - 8); [idtac | omega]. sep on. sep lift 2 in HM. rewrite Hsp. sep trivial. split. rewrite Hsp. arith_rep (sp - 8 - 2) with (sp - 10). eapply MemUpdW_MemUpd16; eauto. rewrite Hsp. arith_rep (sp - 8 - 2) with (sp - 10). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_4_p, L_sleep_5_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx HS]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists (S_RF S DI). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_4_g, L_sleep_5_g in * . intros mP l_ptr wqa sp pc ax bx cx dx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hdx [Hsp _]]]. simplS in * . subst dx sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_4_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx HS]]]]]]]]. unfold Ast_sleep_4 in HS. destruct HS as [HM [HDX [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_4_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_4 in HS. simplS in * . destruct HS as [HM [HDX [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_sleep_5_pushwp : NH_WFcmd (SCAP_consCT (L_sleep+5+1) (Ast L_sleep_6_p L_sleep_6_g tag_sleep) psi_sleep) (L_sleep+5) (Ast L_sleep_5_p L_sleep_5_g tag_sleep) (comml (_pushwp (Opr_reg SI))). Proof. simpl. split. exists L_sleep_6_p; exists L_sleep_6_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx di mP S S', Ast_sleep_5 l_ptr wqa sp pc ax bx cx dx di mP S -> nextS (L_sleep+5) (comml (_pushwp (Opr_reg SI))) S S' -> Ast_sleep_6 l_ptr wqa sp pc ax bx cx dx di (S_RF S SI) mP S'). intros l_ptr wqa sp pc ax bx cx dx di mP S S' HS HSS'. unfold Ast_sleep_4, Ast_sleep_5 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hdi [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. rewrite Hsp. sep on. sep lift 3. arith_rep (sp - 10 - 2) with (sp - 12). reg simpl. simplS in * . sep upd. sep lift 2 in HM. sep stksplit in HM. arith_rep (sp - 10 - 2) with (sp - 12) in HM. arith_rep (_STK_SIZE_sleep - 10 - 2) with (_STK_SIZE_sleep - 12) in HM. sep matchH HM with 9. subst R' fl' isr'; reg simpl. rewrite Hsp. arith_rep (sp - 10 - 2) with (sp - 12). auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_6_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di HS]]]]]]]]]. exists (MemUpdW M (sp-12) (R SI) 0, RF_update R SP (sp - 12), fl, isr). apply nextS_pushwp with (R SI); trivial. unfold pushW. destruct HS as [HM [Hdi [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . split. apply stkSpace_weaken with (_STK_SIZE_sleep - 10); [idtac | omega]. sep on. sep lift 2 in HM. rewrite Hsp. sep trivial. split. rewrite Hsp. arith_rep (sp - 10 - 2) with (sp - 12). eapply MemUpdW_MemUpd16; eauto. rewrite Hsp. arith_rep (sp - 10 - 2) with (sp - 12). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_5_p, L_sleep_6_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di HS]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists (S_RF S SI). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_5_g, L_sleep_6_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hdi [Hsp _]]]. simplS in * . subst di sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_5_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di HS]]]]]]]]]. unfold Ast_sleep_5 in HS. destruct HS as [HM [HDI [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_5_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_5 in HS. simplS in * . destruct HS as [HM [HDI [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_sleep_6_pushwp : NH_WFcmd (SCAP_consCT (L_sleep+6+1) (Ast L_sleep_7_p L_sleep_7_g tag_sleep) psi_sleep) (L_sleep+6) (Ast L_sleep_6_p L_sleep_6_g tag_sleep) (comml (_pushwp (Opr_reg BP))). Proof. simpl. split. exists L_sleep_7_p; exists L_sleep_7_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx di si mP S S', Ast_sleep_6 l_ptr wqa sp pc ax bx cx dx di si mP S -> nextS (L_sleep + 6) (comml (_pushwp (Opr_reg BP))) S S' -> Ast_sleep_7 l_ptr wqa sp pc ax bx cx dx di si (S_RF S BP) mP S'). intros l_ptr wqa sp pc ax bx cx dx di si mP S S' HS HSS'. unfold Ast_sleep_5, Ast_sleep_6 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hsi [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. rewrite Hsp. sep on. sep lift 3. arith_rep (sp - 12 - 2) with (sp - 14). reg simpl. simplS in * . sep upd. sep lift 2 in HM. sep stksplit in HM. arith_rep (sp - 12 - 2) with (sp - 14) in HM. arith_rep (_STK_SIZE_sleep - 12 - 2) with (_STK_SIZE_sleep - 14) in HM. sep matchH HM with 10. subst R' fl' isr'; reg simpl. rewrite Hsp. arith_rep (sp - 12 - 2) with (sp - 14). auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_6_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]]]. exists (MemUpdW M (sp-14) (R BP) 0, RF_update R SP (sp - 14), fl, isr). apply nextS_pushwp with (R BP); trivial. unfold pushW. destruct HS as [HM [Hbp [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . split. apply stkSpace_weaken with (_STK_SIZE_sleep - 12); [idtac | omega]. sep on. sep lift 2 in HM. rewrite Hsp. sep trivial. split. rewrite Hsp. arith_rep (sp - 12 - 2) with (sp - 14). eapply MemUpdW_MemUpd16; eauto. rewrite Hsp. arith_rep (sp - 12 - 2) with (sp - 14). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_6_p, L_sleep_7_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists (S_RF S BP). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_6_g, L_sleep_7_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di si HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hsi [Hsp _]]]. simplS in * . subst si sp R' fl'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_6_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]]]. unfold Ast_sleep_6 in HS. destruct HS as [HM [HSI [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_6_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di si HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_6 in HS. simplS in * . destruct HS as [HM [HSI [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_sleep_7_pushfw : NH_WFcmd (SCAP_consCT (L_sleep+7+1) (Ast L_sleep_8_p L_sleep_8_g tag_sleep) psi_sleep) (L_sleep+7) (Ast L_sleep_7_p L_sleep_7_g tag_sleep) (comml (_pushfw)). Proof. simpl. split. exists L_sleep_8_p; exists L_sleep_8_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx di si bp mP S S', Ast_sleep_7 l_ptr wqa sp pc ax bx cx dx di si bp mP S -> nextS (L_sleep+7) (comml (_pushfw)) S S' -> Ast_sleep_8 l_ptr wqa sp pc ax bx cx dx di si bp (FR2nat (S_Flag S)) mP S'). intros l_ptr wqa sp pc ax bx cx dx di si bp mP S S' HS HSS'. unfold Ast_sleep_7, Ast_sleep_8 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hbp [Hsp [Hspgt' [Hif Hisr]]]]]. split. subst M' R'. sep on. sep lift 3. rewrite Hsp. arith_rep (sp - 14 - 2) with (sp - 16). sep upd. sep lift 2 in HM. sep stksplit in HM. arith_rep (sp - 14 - 2) with (sp - 16) in HM. arith_rep (_STK_SIZE_sleep - 14 - 2) with (_STK_SIZE_sleep - 16) in HM. sep matchH HM with 11. subst R' fl' isr' bp; reg simpl. rewrite Hsp. split_l by omega. split_l. rewrite FR_nat_iso_left. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_7_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]]]. exists (MemUpdW M (sp-16) (FR2nat fl) 0, RF_update R SP (sp - 16), fl, isr). apply nextS_pushfw; trivial. unfold pushW. destruct HS as [HM [Hbp [Hsp [Hspgt [Hif Hisr]]]]]. simplS in * . rewrite Hsp. arith_rep (sp-14-2) with (sp - 16). split. apply stkSpace_weaken with (_STK_SIZE_sleep - 14); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_7_p, L_sleep_8_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp; exists (FR2nat (S_Flag S)). apply Hpp'; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_7_g, L_sleep_8_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di si bp HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hbp [Hsp _]]]. simplS in * . subst ax bx cx dx di si sp bp R' fl'. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_7_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]]]. unfold Ast_sleep_7 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_7_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di si bp HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_7 in HS. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hif [Hisr Hwqa]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. (* : _movwp (Opr_reg SP) BP; *) Lemma NH_WFcmd_sleep_8_movwp : NH_WFcmd (SCAP_consCT (L_sleep+8+1) (Ast L_sleep_9_p L_sleep_9_g tag_sleep) psi_sleep) (L_sleep+8) (Ast L_sleep_8_p L_sleep_8_g tag_sleep) (comml (_movwp (Opr_reg SP) BP)). Proof. simpl. split. exists L_sleep_9_p; exists L_sleep_9_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S', Ast_sleep_8 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> nextS (L_sleep+8) (comml (_movwp (Opr_reg SP) BP)) S S' -> Ast_sleep_9 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S'). intros l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S' HS HSS'. unfold Ast_sleep_8, Ast_sleep_9 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simpl in HR'. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hfl [Hif [Hisr Hwqa]]]]]]. split. subst M' R' fl' isr'. sep on. sep matchH HM with 10. subst fl R' fl' isr'; reg simpl. rewrite Hsp. repeat split_l; trivial. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_8_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. exists (M, RF_update R BP (R SP), fl, isr). apply nextS_movwp with (R SP); trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_8_p, L_sleep_9_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp; exists flnum. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_8_g, L_sleep_9_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di si bp flnum HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_8_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [fln HS]]]]]]]]]]]]. unfold Ast_sleep_8 in HS. destruct HS as [HM [HSP [Hsp [Hfln [Hif [Hisr Hwqa]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_8_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di si bp fln HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_8 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hfln [Hif [Hisr Hwqa]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. (* : _pushwm (A_reg 18 BP); *) Lemma NH_WFcmd_sleep_9_pushwm : NH_WFcmd (SCAP_consCT (L_sleep+9+1) (Ast L_sleep_10_p L_sleep_10_g tag_sleep) psi_sleep) (L_sleep+9) (Ast L_sleep_9_p L_sleep_9_g tag_sleep) (comml (_pushwm (A_reg 18 BP))). Proof. simpl. split. exists L_sleep_10_p; exists L_sleep_10_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S', Ast_sleep_9 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> nextS (L_sleep+9) (comml (_pushwm (A_reg 18 BP))) S S' -> Ast_sleep_10 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S'). intros l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S' HS HSS'. unfold Ast_sleep_9, Ast_sleep_10 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [l_ptrx [Hlds [Hspgt [HldsB HM']]]]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM', Hlds. simplS in * . destruct HS as [HM [Hbp [Hsp [Hspgt' [Hfl [Hif Hisr]]]]]]. split. subst M' R' fl' isr'. assert (Heq : l_ptr = l_ptrx). rewrite Hbp in Hlds. rewrite Hsp in Hlds. arith_rep (sp - 16 + 18) with (sp + 2) in Hlds. sep on. sep lift 12 in HM. sep inj. auto. subst l_ptrx. rewrite Hsp. arith_rep (sp - 16 - 2) with (sp - 18). sep on. sep lift 3. sep upd. sep lift 2 in HM. sep stksplit in HM. arith_rep (sp - 16 - 2) with (sp - 18) in HM. arith_rep (_STK_SIZE_sleep - 16 - 2) with (_STK_SIZE_sleep - 18) in HM. sep matchH HM with 12. subst R' fl' isr'; reg simpl. rewrite Hsp. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_9_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. destruct HS as [HM [Hbp [Hsp [Hspgt' [Hfl [Hif Hisr]]]]]]. simplS in * . exists (MemUpdW M (sp-18) l_ptr 0, RF_update R SP (sp - 18), fl, isr). apply nextS_pushwm with (sp + 2) l_ptr; trivial. simpl. rewrite Hbp. rewrite Hsp. omega. sep on. sep lift 12 in HM. sep trivial. unfold pushW. rewrite Hsp. arith_rep (sp-16-2) with (sp - 18). split. apply stkSpace_weaken with (_STK_SIZE_sleep - 16); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_9_p, L_sleep_10_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp; exists flnum. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_9_g, L_sleep_10_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di si bp flnum HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [_ [Hbp [Hsp _]]]. simplS in * . subst ax bx cx dx di si sp bp R' fl'. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_9_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [fln HS]]]]]]]]]]]]. unfold Ast_sleep_9 in HS. destruct HS as [HM [HBP [HSP [Hsp [Hfln [Hif [Hisr Hwqa]]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_9_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di si bp fln HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_9 in HS. simplS in * . destruct HS as [HM [HBP [HSP [Hsp [Hfln [Hif [Hisr Hwqa]]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. (* : _call L_block; *) Lemma NH_WFcmd_sleep_10_call : NH_WFcmd (SCAP_consCT (L_sleep+10+1) (Ast L_sleep_11_p L_sleep_11_g tag_sleep) psi_sleep) (L_sleep+10) (Ast L_sleep_10_p L_sleep_10_g tag_sleep) (comml (_call _BLOCK)). Proof. simpl. split. assert (Hpp''' : forall l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S' S'' S''' pc', Ast_sleep_10 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> nextS (L_sleep+10) (comml (_call _BLOCK)) S S' -> (gblk wqa) S' S'' -> nextS pc' (comms _retw) S'' S''' -> Ast_sleep_11 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S'''). intros l_ptr wqa sp pc ax bx cx dx di si bp flnum mP. intros S S' S'' S''' pc'. intros HS HSS' HS'S'' HS''S'''. unfold Ast_sleep_10, Ast_sleep_11 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. simplS in * . destruct HS as [HM [Hsp [Hspg [Hfl [Hif [Hisr Hwqa]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspg' [Hlds Hupd]]. unfold gblk in HS'S''. destruct HS'S'' as [sp' [HM'' [Hif'' [Hisr'' HSP]]]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pc''' [Hlds''' HR''']]. simplS in * . subst M''' R''' fl''' isr'''. subst isr'' R' fl' isr'. clear HSS' HS''S'''. reg simpl. destruct HSP as [Hsp' HSP]. subst sp'. rewrite <- HSP. rewrite Hsp. rewrite Hsp in HM''. split. sep on. sep lift 3. apply stkSpacePrec_mergeW1; [idtac | omega | omega ]. arith_rep (18 + 2 + _BLK_Stk - 18 - 2) with _BLK_Stk. assert (Hx : M'' ||- (INV0 *^* INV1 *^* wqa *^* stkSpacePrec (sp - 18 - 2) (_BLK_Stk + 2 - 2)) *^* (sp - 18 - 2 |->w (L_sleep + 10 + 1) *^* sp - 18 |->w l_ptr *^* sp - 16 |->w flnum *^* sp - 14 |->w bp *^* sp - 12 |->w si *^* sp - 10 |->w di *^* sp - 8 |->w dx *^* sp - 6 |->w cx *^* sp - 4 |->w bx *^* sp - 2 |->w ax *^* sp |->w pc *^* sp + 2 |->w l_ptr *^* mP)). replace M'' with (S_Mem (M'', R'', fl'', false)); trivial. sep off. assert (forall sp size, precise (INV0 *^* INV1 *^* stkSpacePrec sp size)). intros spx sizex. apply mstar_presv_prec. apply Prec01. apply precise_stkSpacePrec. apply prepost_elim with (INV0 *^* INV1 *^* stkSpacePrec (sp - 18 - 2) (_BLK_Stk + 2 - 2)) (M', RF_update R SP (sp - 18 - 2), fl, isr); auto. simplS. substH Hupd with (MemUpd16_MemUpdW Hupd). destruct Hupd as [x HM']. rewrite Hsp in HM'. subst M'. sep on. sep lift 3. sep upd. arith_rep (18+2+_BLK_Stk-18) with (_BLK_Stk + 2) in HM. sep matchH HM with 11. sep stksplit in HM. sep matchH HM with 2. arith_rep (_BLK_Stk + 2 - 2) with _BLK_Stk in Hx. sep matchH Hx with 13. split_l by omega. rewrite <- Hif''. auto. left. split. unfold prim_entry. right; left; trivial. split. constructor 2 with L_sleep_10_p L_sleep_11_p L_sleep_10_g L_sleep_11_g tag_sleep; trivial. (* enable *) unfold enable_blk. intros S HS. unfold L_sleep_10_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. exists l_ptr; exists wqa. split. destruct HS as [HM [Hsp [Hspg [Hfl [Hif [Hisr Hwqa]]]]]]. split_l. unfold pTrue, pmstar. destruct S as [[[M R] fl] isr]. simplS in * . rewrite Hsp. assert (HMx : (mTrue *^* (sp - 18 |->w l_ptr *^* (INV0 *^* INV1 *^* stkSpacePrec (sp - 18) (18 + 2 + _BLK_Stk - 18)))) M). sep on. sep matchH HM with 12. arith_rep (18 + 2 + _BLK_Stk - 18) with (_BLK_Stk + 2) in HMx. split. (* p ==> p' *) intros pc' S'''. unfold L_sleep_10_p, L_sleep_11_p. unfold wrap_fun. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp; exists flnum. eapply Hpp'''; eauto. (* g''' ==> g *) intros pc' S''''. unfold L_sleep_10_g, L_sleep_11_g. unfold wrap_fun. intros HSS''''. unfold conjG at 1 in HSS'''' . destruct HSS'''' as [S''' [HSS''' H]]. destruct HSS''' as [S'' [HSS'' HS''S''']]. destruct HSS'' as [S' [HSS' HS'S'']]. assert (Hwqa : Delta l_ptr = SomeT wqa). destruct HS as [HM [Hsp [Hspg [Hfl [Hif [Hisr Hwqa]]]]]]. trivial. assert (Hlds : leadsToW (S_RF S SP) l_ptr (S_Mem S)). destruct HS as [HM [Hsp [Hspg [Hfl [Hif [Hisr _]]]]]]. rewrite Hsp. sep on. sep lift 3 in HM. sep trivial. clear sp pc ax bx cx dx di si bp flnum HS. intros mP l_ptrx wqax sp pc ax bx cx dx di si bp flnum HS. assert (Heq : l_ptrx = l_ptr). destruct HS as [HM [Hsp [Hspg [Hfl [Hif [Hisr Hwqax]]]]]]. rewrite Hsp in Hlds. sep on. sep lift 3 in HM. sep inj. auto. subst l_ptrx. assert (Heq : wqax = wqa). destruct HS as [HM [Hsp [Hspg [Hfl [Hif [Hisr Hwqax]]]]]]. rewrite Hwqax in Hwqa. injection Hwqa; trivial. subst wqax. apply H with flnum. eapply Hpp'''; eauto. (* p ==> if=false *) intros S HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. unfold Ast_sleep_10 in HS. destruct HS as [HM [Hsp [Hspg [Hif [Hfl [Hisr Hwqa]]]]]]. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_10_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [fln HS]]]]]]]]]]]]. unfold Ast_sleep_10 in HS. destruct HS as [HM [HSP [Hsp [Hfln [Hif [Hisr Hwqa]]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_10_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di si bp fln HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_10 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hfln [Hif [Hisr Hwqa]]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. (* : _addw (Opr_imm 2) SP; *) Lemma NH_WFcmd_sleep_11_addw : NH_WFcmd (SCAP_consCT (L_sleep+11+1) (Ast L_sleep_12_p L_sleep_12_g tag_sleep) psi_sleep) (L_sleep+11) (Ast L_sleep_11_p L_sleep_11_g tag_sleep) (comml (_addw (Opr_imm 2) SP)). Proof. simpl. split. exists L_sleep_12_p; exists L_sleep_12_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S', Ast_sleep_11 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> nextS (L_sleep+11) (comml (_addw (Opr_imm 2) SP)) S S' -> Ast_sleep_12 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S'). intros l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S' HS HSS'. unfold Ast_sleep_11, Ast_sleep_12 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. clear HSS'. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hflnum [Hif Hisr]]]]]. subst M' R' isr'. split. sep on. sep matchH HM with 13. sep stksplit. arith_rep (sp - 16 - 2) with (sp - 18). arith_rep (_STK_SIZE_sleep - 16 - 2) with (_STK_SIZE_sleep - 18). sep matchH HM with 2. unfold opr_eval. rewrite Hsp. reg simpl. split_l by omega. unfold trash_fl in Hfl'. destruct Hfl'; subst fl'; auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_11_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. destruct HS as [HM [Hsp [Hspgt' [Hflnum [Hif Hisr]]]]]. simplS in * . exists (M, RF_update R SP (sp - 16), Clear_Flag fl _ZF, isr). apply nextS_addw with 2 (sp - 18); trivial. rewrite Hsp; trivial. arith_rep (2 + (sp - 18)) with (sp - 16). right; trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_11_p, L_sleep_12_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp; exists flnum. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_11_g, L_sleep_12_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di si bp flnum HS. apply HgS'S'' with flnum. apply Hpp' with S; trivial. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_11_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [fln HS]]]]]]]]]]]]. unfold Ast_sleep_11 in HS. destruct HS as [HM [HSP [Hsp [Hfln [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_11_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di si bp fln HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_11 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hfln [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. (* : _popfw; *) Lemma NH_WFcmd_sleep_12_popfw : NH_WFcmd (SCAP_consCT (L_sleep+12+1) (Ast L_sleep_13_p L_sleep_13_g tag_sleep) psi_sleep) (L_sleep+12) (Ast L_sleep_12_p L_sleep_12_g tag_sleep) (comml (_popfw)). Proof. simpl. split. exists L_sleep_13_p; exists L_sleep_13_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S', Ast_sleep_12 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> stk_IF_cl S -> gpopfw_cli S S' -> Ast_sleep_13 l_ptr wqa sp pc ax bx cx dx di si bp mP S'). intros l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S' HS Hcl HSS'. unfold Ast_sleep_12, Ast_sleep_13, stk_IF_cl in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold gpopfw_cli in HSS'. simplS in * . destruct HSS' as [Hshift [Hif' [Hisr' HR']]]. assert (HM' : M' = M). cut (forall M0 : Mem, choice (itr_enabled (M, R, fl, isr)) (INV0 *^* INV1) Aemp M0 -> Aemp M0). intros Hx. substH Hshift with (prepost_weaken_post (mQ':=Aemp) Hshift Hx). apply (prepost_elim_emp_M _ _ _ _ _ _ _ _ Hshift). intros. apply (choice_elim_right H). intros [H1 H2]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hflnum [Hif Hisr]]]]]. rewrite Hif in H1; discriminate H1. clear Hshift. subst M' R' isr'. destruct HS as [HM [Hsp [Hspg [Hif [Hfl Hisr]]]]]. split. sep on. sep matchH HM with 11. sep stksplit. arith_rep (sp - 14 - 2) with (sp - 16). arith_rep (_STK_SIZE_sleep - 14 - 2) with (_STK_SIZE_sleep - 16). sep matchH HM with 2. rewrite Hsp. reg simpl. split_l by omega. auto. assert (Hpp'_sti : forall l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S', Ast_sleep_12 l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S -> stk_IF_st S -> gpopfw_sti S S' -> Ast_sleep_13 l_ptr wqa sp pc ax bx cx dx di si bp mP S'). clear Hpp'. intros l_ptr wqa sp pc ax bx cx dx di si bp flnum mP S S' HS Hst HSS'. unfold stk_IF_st in * . destruct Hst as [flnumx [Hlds Hif]]. unfold Ast_sleep_12 in HS. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct HS as [HM [Hsp [Hspg [Hifx [Hfl Hisr]]]]]. simplS in * . assert (Heq : flnum = flnumx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst flnumx. rewrite Hifx in Hif; discriminate Hif. split. (* enable popfw *) clear Hpp' Hpp'_sti. unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_12_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. exists (M, RF_update R SP (sp - 14),(nat2FR flnum), isr). apply nextS_popfw with flnum; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif [Hfl Hisr]]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 4 in HM. sep trivial. arith_rep (sp-16+2) with (sp - 14). split. (* enable sti *) unfold enable_popfw_sti, stk_IF_st, conjP. intros M R fl isr HS. destruct HS as [HS Hflnum]. unfold L_sleep_10_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. destruct Hflnum as [flnumx [Hlds Hif]]. unfold Ast_sleep_12 in HS. destruct HS as [HM [Hsp [Hspg [Hifx [Hfl Hisr]]]]]. assert (Heq : flnum = flnumx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst flnumx. rewrite Hifx in Hif; discriminate Hif. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_12_p, L_sleep_13_p. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. destruct HS as [HS Hst]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp. eapply Hpp'_sti; eauto. split. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. destruct HpS as [_ Hst]. unfold L_sleep_12_g, L_sleep_13_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di si bp flnum HS. apply HgS'S''. apply Hpp'_sti with flnum S; auto. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_10_p, L_sleep_11_p. intros S' H. destruct H as [S H]. destruct H as [HS HSS']. destruct HS as [HS Hcl]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [flnum HS]]]]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si; exists bp. eapply Hpp'; eauto. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. destruct HpS as [_ Hst]. unfold L_sleep_12_g, L_sleep_13_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di si bp flnum HS. apply HgS'S''. apply Hpp' with flnum S; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_12_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp [fln HS]]]]]]]]]]]]. unfold Ast_sleep_12 in HS. destruct HS as [HM [HSP [Hsp [Hfln [Hif Hisr]]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_12_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di si bp fln HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_12 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hfln [Hif Hisr]]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_sleep_13_popw : NH_WFcmd (SCAP_consCT (L_sleep+13+1) (Ast L_sleep_14_p L_sleep_14_g tag_sleep) psi_sleep) (L_sleep+13) (Ast L_sleep_13_p L_sleep_13_g tag_sleep) (comml (_popw BP)). Proof. simpl. split. exists L_sleep_14_p; exists L_sleep_14_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx di si bp mP S S', Ast_sleep_13 l_ptr wqa sp pc ax bx cx dx di si bp mP S -> nextS (L_sleep+13) (comml (_popw BP)) S S' -> Ast_sleep_14 l_ptr wqa sp pc ax bx cx dx di si mP S'). intros l_ptr wqa sp pc ax bx cx dx di si bp mP S S' HS HSS'. unfold Ast_sleep_13, Ast_sleep_14 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [bpx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : bp = bpx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst bpx. subst M' fl' R' isr'. split. sep on. sep matchH HM with 12. sep stksplit. arith_rep (sp - 12 - 2) with (sp-14). arith_rep (_STK_SIZE_sleep - 12 - 2) with (_STK_SIZE_sleep-14). sep matchH HM with 2. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_13_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]]]. exists (M, RF_update (RF_update R SP (sp - 12)) BP bp, fl, isr). apply nextS_popw with (RF_update R SP (sp - 12)) bp; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 4 in HM. sep trivial. arith_rep (sp - 14 + 2) with (sp - 12). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_13_p, L_sleep_14_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di; exists si. apply Hpp' with bp S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_13_g, L_sleep_14_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di si bp HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [bpx [Hlds HR']]. assert (Heq : bp = bpx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst bpx ax bx cx dx di si sp R' fl' isr'. reg simpl. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_13_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si [bp HS]]]]]]]]]]]. unfold Ast_sleep_13 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_13_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di si bp HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_13 in HS. simplS in * . destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. Qed. (* : _popw (SI); *) Lemma NH_WFcmd_sleep_14_popw : NH_WFcmd (SCAP_consCT (L_sleep+14+1) (Ast L_sleep_15_p L_sleep_15_g tag_sleep) psi_sleep) (L_sleep+14) (Ast L_sleep_14_p L_sleep_14_g tag_sleep) (comml (_popw SI)). Proof. simpl. split. exists L_sleep_15_p; exists L_sleep_15_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx di si mP S S', Ast_sleep_14 l_ptr wqa sp pc ax bx cx dx di si mP S -> nextS (L_sleep+14) (comml (_popw SI)) S S' -> Ast_sleep_15 l_ptr wqa sp pc ax bx cx dx di mP S'). intros l_ptr wqa sp pc ax bx cx dx di si mP S S' HS HSS'. unfold Ast_sleep_14, Ast_sleep_15 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [six [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : si = six). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst six. subst M' fl' R' isr'. split. sep on. sep matchH HM with 10. sep stksplit. arith_rep (sp - 10 - 2) with (sp-12). arith_rep (_STK_SIZE_sleep - 10 - 2) with (_STK_SIZE_sleep-12). sep matchH HM with 2. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_14_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]]]. exists (M, RF_update (RF_update R SP (sp - 10)) SI si, fl, isr). apply nextS_popw with (RF_update R SP (sp - 10)) si; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 4 in HM. sep trivial. arith_rep (sp - 12 + 2) with (sp - 10). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_12_p, L_sleep_13_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx; exists di. apply Hpp' with si S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_14_g, L_sleep_15_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di si HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [six [Hlds HR']]. assert (Heq : si = six). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst six ax bx cx dx di sp R' fl' isr'. reg simpl. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_13_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di [si HS]]]]]]]]]]. unfold Ast_sleep_13 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_13_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di si HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_13 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. simplS in * . rewrite Hif in IHif. discriminate IHif. Qed. (* : _popw (DI) *) Lemma NH_WFcmd_sleep_15_popw : NH_WFcmd (SCAP_consCT (L_sleep+15+1) (Ast L_sleep_16_p L_sleep_16_g tag_sleep) psi_sleep) (L_sleep+15) (Ast L_sleep_15_p L_sleep_15_g tag_sleep) (comml (_popw DI)). Proof. simpl. split. exists L_sleep_16_p; exists L_sleep_16_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx di mP S S', Ast_sleep_15 l_ptr wqa sp pc ax bx cx dx di mP S -> nextS (L_sleep+15) (comml (_popw DI)) S S' -> Ast_sleep_16 l_ptr wqa sp pc ax bx cx dx mP S'). intros l_ptr wqa sp pc ax bx cx dx di mP S S' HS HSS'. unfold Ast_sleep_15, Ast_sleep_16 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [dix [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : di = dix). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst dix. subst M' fl' R' isr'. split. sep on. sep matchH HM with 9. sep stksplit. arith_rep (sp - 8 - 2) with (sp-10). arith_rep (_STK_SIZE_sleep - 8 - 2) with (_STK_SIZE_sleep-10). sep matchH HM with 2. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_15_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di HS]]]]]]]]]. exists (M, RF_update (RF_update R SP (sp - 8)) DI di, fl, isr). apply nextS_popw with (RF_update R SP (sp - 8)) di; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 4 in HM. sep trivial. arith_rep (sp - 10 + 2) with (sp - 8). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_15_p, L_sleep_16_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di HS]]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx; exists dx. apply Hpp' with di S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_15_g, L_sleep_16_g in * . intros mP l_ptr wqa sp pc ax bx cx dx di HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [dix [Hlds HR']]. assert (Heq : di = dix). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst dix ax bx cx dx sp R' fl' isr'. reg simpl. repeat split_l; trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_15_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx [di HS]]]]]]]]]. unfold Ast_sleep_15 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_15_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx di HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_15 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. simplS in * . rewrite Hif in IHif. discriminate IHif. Qed. (* : _popw (DX) *) Lemma NH_WFcmd_sleep_16_popw : NH_WFcmd (SCAP_consCT (L_sleep+16+1) (Ast L_sleep_17_p L_sleep_17_g tag_sleep) psi_sleep) (L_sleep+16) (Ast L_sleep_16_p L_sleep_16_g tag_sleep) (comml (_popw DX)). Proof. simpl. split. exists L_sleep_17_p; exists L_sleep_17_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx dx mP S S', Ast_sleep_16 l_ptr wqa sp pc ax bx cx dx mP S -> nextS (L_sleep+16) (comml (_popw DX)) S S' -> Ast_sleep_17 l_ptr wqa sp pc ax bx cx mP S'). intros l_ptr wqa sp pc ax bx cx dx mP S S' HS HSS'. unfold Ast_sleep_16, Ast_sleep_17 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [dxx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : dx = dxx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst dxx. subst M' fl' R' isr'. split. sep on. sep matchH HM with 8. sep stksplit. arith_rep (sp - 6 - 2) with (sp-8). arith_rep (_STK_SIZE_sleep - 6 - 2) with (_STK_SIZE_sleep-8). sep matchH HM with 2. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_16_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx HS]]]]]]]]. exists (M, RF_update (RF_update R SP (sp - 6)) DX dx, fl, isr). apply nextS_popw with (RF_update R SP (sp - 6)) dx; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 4 in HM. sep trivial. arith_rep (sp - 8 + 2) with (sp - 6). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_16_p, L_sleep_17_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx HS]]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx; exists cx. apply Hpp' with dx S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_16_g, L_sleep_17_g in * . intros mP l_ptr wqa sp pc ax bx cx dx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [dxx [Hlds HR']]. assert (Heq : dx = dxx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst ax bx cx dxx sp R' fl' isr'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_16_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx [dx HS]]]]]]]]. unfold Ast_sleep_16 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_16_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx dx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_16 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. simplS in * . rewrite Hif in IHif. discriminate IHif. Qed. (* : _popw (CX); *) Lemma NH_WFcmd_sleep_17_popw : NH_WFcmd (SCAP_consCT (L_sleep+17+1) (Ast L_sleep_18_p L_sleep_18_g tag_sleep) psi_sleep) (L_sleep+17) (Ast L_sleep_17_p L_sleep_17_g tag_sleep) (comml (_popw CX)). Proof. simpl. split. exists L_sleep_18_p; exists L_sleep_18_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx cx mP S S', Ast_sleep_17 l_ptr wqa sp pc ax bx cx mP S -> nextS (L_sleep+17) (comml (_popw CX)) S S' -> Ast_sleep_18 l_ptr wqa sp pc ax bx mP S'). intros l_ptr wqa sp pc ax bx cx mP S S' HS HSS'. unfold Ast_sleep_17, Ast_sleep_18 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [cxx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : cx = cxx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst cxx. subst M' fl' R' isr'. split. sep on. sep matchH HM with 8. sep stksplit. arith_rep (sp - 4 - 2) with (sp-6). arith_rep (_STK_SIZE_sleep - 4 - 2) with (_STK_SIZE_sleep-6). sep matchH HM with 2. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_17_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx [cx HS]]]]]]]. exists (M, RF_update (RF_update R SP (sp - 4)) CX cx, fl, isr). apply nextS_popw with (RF_update R SP (sp - 4)) cx; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 4 in HM. sep trivial. arith_rep (sp - 6 + 2) with (sp - 4). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_17_p, L_sleep_18_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx HS]]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax; exists bx. apply Hpp' with cx S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_17_g, L_sleep_18_g in * . intros mP l_ptr wqa sp pc ax bx cx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [cxx [Hlds HR']]. assert (Heq : cx = cxx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst ax bx cxx sp R' fl' isr'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_17_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx [cx HS]]]]]]]. unfold Ast_sleep_17 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_17_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx cx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_17 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. simplS in * . rewrite Hif in IHif. discriminate IHif. Qed. (* : _popw (BX); *) Lemma NH_WFcmd_sleep_18_popw : NH_WFcmd (SCAP_consCT (L_sleep+18+1) (Ast L_sleep_19_p L_sleep_19_g tag_sleep) psi_sleep) (L_sleep+18) (Ast L_sleep_18_p L_sleep_18_g tag_sleep) (comml (_popw BX)). Proof. simpl. split. exists L_sleep_19_p; exists L_sleep_19_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax bx mP S S', Ast_sleep_18 l_ptr wqa sp pc ax bx mP S -> nextS (L_sleep+18) (comml (_popw BX)) S S' -> Ast_sleep_19 l_ptr wqa sp pc ax mP S'). intros l_ptr wqa sp pc ax bx mP S S' HS HSS'. unfold Ast_sleep_18, Ast_sleep_19 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [bxx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : bx = bxx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst bxx. subst M' fl' R' isr'. split. sep on. sep matchH HM with 6. sep stksplit. arith_rep (sp - 2 - 2) with (sp-4). arith_rep (_STK_SIZE_sleep - 2 - 2) with (_STK_SIZE_sleep-4). sep matchH HM with 2. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_18_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax [bx HS]]]]]]. exists (M, RF_update (RF_update R SP (sp - 2)) BX bx, fl, isr). apply nextS_popw with (RF_update R SP (sp - 2)) bx; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 4 in HM. sep trivial. arith_rep (sp - 4 + 2) with (sp - 2). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_18_p, L_sleep_19_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax [bx HS]]]]]]. exists l_ptr; exists wqa; exists sp; exists pc; exists ax. apply Hpp' with bx S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_18_g, L_sleep_19_g in * . intros mP l_ptr wqa sp pc ax bx HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp _]]. simplS in * . destruct HR' as [bxx [Hlds HR']]. assert (Heq : bx = bxx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst ax bxx sp R' fl' isr'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_18_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax [bx HS]]]]]]. unfold Ast_sleep_18 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_18_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax bx HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_18 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. simplS in * . rewrite Hif in IHif. discriminate IHif. Qed. (* : _popw (AX); *) Lemma NH_WFcmd_sleep_19_popw : NH_WFcmd (SCAP_consCT (L_sleep+19+1) (Ast L_sleep_20_p L_sleep_20_g tag_sleep) psi_sleep) (L_sleep+19) (Ast L_sleep_19_p L_sleep_19_g tag_sleep) (comml (_popw AX)). Proof. simpl. split. exists L_sleep_20_p; exists L_sleep_20_g. split_l. assert (Hpp' : forall l_ptr wqa sp pc ax mP S S', Ast_sleep_19 l_ptr wqa sp pc ax mP S -> nextS (L_sleep+19) (comml (_popw AX)) S S' -> Ast_sleep_20 l_ptr wqa sp pc mP S'). intros l_ptr wqa sp pc ax mP S S' HS HSS'. unfold Ast_sleep_19, Ast_sleep_20 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [axx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspgt' [Hif Hisr]]]]. assert (Heq : ax = axx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst axx. subst M' fl' R' isr'. split. sep on. sep matchH HM with 5. sep stksplit. sep matchH HM with 2. rewrite Hsp. reg simpl. split_l by omega. auto. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_sleep_19_p in HpS. destruct HpS as [l_ptr [wqa [sp [pc [ax HS]]]]]. exists (M, RF_update (RF_update R SP sp) AX ax, fl, isr). apply nextS_popw with (RF_update R SP sp) ax; trivial. unfold popW. destruct HS as [HM [Hsp [Hspgt [Hif Hisr]]]]. simplS in * . rewrite Hsp. split. sep on. sep lift 4 in HM. sep trivial. arith_rep (sp - 2 + 2) with sp. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_sleep_19_p, L_sleep_20_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [l_ptr [wqa [sp [pc [ax HS]]]]]. exists l_ptr; exists wqa; exists sp; exists pc. apply Hpp' with ax S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_sleep_19_g, L_sleep_20_g in * . intros mP l_ptr wqa sp pc ax HS. substH Hpp' with (Hpp' _ _ _ _ _ _ _ _ HS HnextSS'). substH HgS'S'' with (HgS'S'' _ _ _ _ _ Hpp'). destruct HgS'S'' as [HS'' HS'S'']. split_l. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct (nextS_inversion HnextSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS'S'' as [HAX [HBX [HCX [HDX [HDI [HSI [HBP HSP]]]]]]]. destruct HS as [HM [Hsp HS]]. simplS in * . destruct HR' as [axx [Hlds HR']]. assert (Heq : ax = axx). sep on. sep lift 4 in HM. rewrite Hsp in Hlds. sep inj. auto. subst axx R' fl' isr'. reg simpl. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_19_p in HS. destruct HS as [l_ptr [wqa [sp [pc [ax HS]]]]]. unfold Ast_sleep_19 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_19_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc ax HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_19 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. simplS in * . rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFcmd_sleep_20_retw : NH_WFcmd psi_sleep (L_sleep+20) (Ast L_sleep_20_p L_sleep_20_g tag_sleep) (comms (_retw)). Proof. simpl. split. split_l. intros S HS. unfold L_sleep_20_g. unfold Ast_sleep_20, Ast_sleep_post. intros mP l_ptr wqa sp pc H. destruct H as [H1 [H2 [H3 H4]]]. split_l by auto. repeat split_l. trivial. split. (* Prd_Itr_Stk *) unfold Prd_Itr_Stk. intros S HS IHS. unfold L_sleep_20_p in HS. destruct HS as [l_ptr [wqa [sp [pc HS]]]]. unfold Ast_sleep_20 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. simplS in * . destruct IHS as [IHif IHisr]. rewrite Hif in IHif. discriminate IHif. (* Grt_Itr_Stk *) unfold Grt_Itr_Stk. intros S S' HSS' IHS. unfold L_sleep_20_g in * . intros M1 M2 M2' HJM HM2 HM2'. intros mP l_ptr wqa sp pc HS. destruct S as [[[M R] fl] isr]. unfold itr_enabled in IHS. unfold Ast_sleep_20 in HS. destruct HS as [HM [HSP [Hsp [Hif Hisr]]]]. destruct IHS as [IHif IHisr]. simplS in * . rewrite Hif in IHif. discriminate IHif. Qed. Lemma NH_WFiseq_sleep : NH_WFiseq psi_sleep L_sleep spec_sleep I_sleep. Proof. unfold I_sleep, spec_sleep. apply nh_isq_seq with L_sleep_1_p L_sleep_1_g. apply NH_WFcmd_sleep_0_pushwp. apply nh_isq_seq with L_sleep_2_p L_sleep_2_g. apply NH_WFcmd_sleep_1_pushwp. assert (H : L_sleep+1+1 = L_sleep+2); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_3_p L_sleep_3_g. apply NH_WFcmd_sleep_2_pushwp. assert (H : L_sleep+2+1 = L_sleep+3); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_4_p L_sleep_4_g. apply NH_WFcmd_sleep_3_pushwp. assert (H : L_sleep+3+1 = L_sleep+4); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_5_p L_sleep_5_g. apply NH_WFcmd_sleep_4_pushwp. assert (H : L_sleep+4+1 = L_sleep+5); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_6_p L_sleep_6_g. apply NH_WFcmd_sleep_5_pushwp. assert (H : L_sleep+5+1 = L_sleep+6); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_7_p L_sleep_7_g. apply NH_WFcmd_sleep_6_pushwp. assert (H : L_sleep+6+1 = L_sleep+7); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_8_p L_sleep_8_g. apply NH_WFcmd_sleep_7_pushfw. assert (H : L_sleep+7+1 = L_sleep+8); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_9_p L_sleep_9_g. apply NH_WFcmd_sleep_8_movwp. assert (H : L_sleep+8+1 = L_sleep+9); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_10_p L_sleep_10_g. apply NH_WFcmd_sleep_9_pushwm. assert (H : L_sleep+9+1 = L_sleep+10); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_11_p L_sleep_11_g. apply NH_WFcmd_sleep_10_call. assert (H : L_sleep+10+1 = L_sleep+11); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_12_p L_sleep_12_g. apply NH_WFcmd_sleep_11_addw. assert (H : L_sleep+11+1 = L_sleep+12); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_13_p L_sleep_13_g. apply NH_WFcmd_sleep_12_popfw. assert (H : L_sleep+12+1 = L_sleep+13); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_14_p L_sleep_14_g. apply NH_WFcmd_sleep_13_popw. assert (H : L_sleep+13+1 = L_sleep+14); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_15_p L_sleep_15_g. apply NH_WFcmd_sleep_14_popw. assert (H : L_sleep+14+1 = L_sleep+15); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_16_p L_sleep_16_g. apply NH_WFcmd_sleep_15_popw. assert (H : L_sleep+15+1 = L_sleep+16); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_17_p L_sleep_17_g. apply NH_WFcmd_sleep_16_popw. assert (H : L_sleep+16+1 = L_sleep+17); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_18_p L_sleep_18_g. apply NH_WFcmd_sleep_17_popw. assert (H : L_sleep+17+1 = L_sleep+18); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_19_p L_sleep_19_g. apply NH_WFcmd_sleep_18_popw. assert (H : L_sleep+18+1 = L_sleep+19); [omega | rewrite H; clear H]. apply nh_isq_seq with L_sleep_20_p L_sleep_20_g. apply NH_WFcmd_sleep_19_popw. assert (H : L_sleep+19+1 = L_sleep+20); [omega | rewrite H; clear H]. apply nh_isq_end. apply NH_WFcmd_sleep_20_retw. Qed. coq/miniOS/EnQueueSpec.v0000644000107400000620000006152311000223231014613 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) (* by wangwei *) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import Kernel. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Definition Ast_enQueue_pre (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp : nat) (mP : MPred) (S : State) : Prop := (embed_TCB tid tcb *^* ptoTQ ptr (filterTQ T Q) *^* stkSpacePrec sp 2 *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ S_RF S BP = bp /\ S_RF S SP = sp. Definition p_enQueue (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, Ast_enQueue_pre T Q ptr tid tcb bp sp mTrue S. Definition Ast_enQueue_post (T' : TQ) (Q' : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp : nat) (mP : MPred) (S' : State) : Prop := (ptoTQ ptr (filterTQ T' Q') *^* stkSpacePrec sp 2 *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S') /\ S_RF S' BP = bp /\ S_RF S' SP = sp. Definition g_enQueue (S S' : State) : Prop := forall T Q ptr tid tcb bp sp mP, Ast_enQueue_pre T Q ptr tid tcb bp sp mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : pushw %bp *) Definition Ast_enQueue_1 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp : nat) (mP : MPred) (S : State) : Prop := (embed_TCB tid tcb *^* ptoTQ ptr (filterTQ T Q) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >=2 /\ S_RF S BP = bp /\ S_RF S SP = sp - 2. Definition L_enQueue_1_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, Ast_enQueue_1 T Q ptr tid tcb bp sp mTrue S. Definition L_enQueue_1_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp mP, Ast_enQueue_1 T Q ptr tid tcb bp sp mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %sp, %bp *) Definition Ast_enQueue_2 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp : nat) (mP : MPred) (S : State) : Prop := (embed_TCB tid tcb *^* ptoTQ ptr (filterTQ T Q) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 . Definition L_enQueue_2_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, Ast_enQueue_2 T Q ptr tid tcb bp sp mTrue S. Definition L_enQueue_2_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp mP, Ast_enQueue_2 T Q ptr tid tcb bp sp mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw 4(%bp), %ax *) Definition Ast_enQueue_3 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp : nat) (mP : MPred) (S : State) : Prop := (embed_TCB tid tcb *^* ptoTQ ptr (filterTQ T Q) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid. Definition L_enQueue_3_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, Ast_enQueue_3 T Q ptr tid tcb bp sp mTrue S. Definition L_enQueue_3_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp mP, Ast_enQueue_3 T Q ptr tid tcb bp sp mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw 6(%bp), %bx *) Definition Ast_enQueue_4 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (embed_TCB tid tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S BX = ptr. Definition L_enQueue_4_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_4 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_4_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_4 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw Q_TAIL(%bx), %dx *) Definition Ast_enQueue_5 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (embed_TCB tid tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S BX = ptr /\ S_RF S DX = tail. Definition L_enQueue_5_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_5 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_5_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_5 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %bx, %cx *) Definition Ast_enQueue_6 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (embed_TCB tid tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S DX = tail /\ S_RF S CX = ptr. Definition L_enQueue_6_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_6 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_6_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_6 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %ax, %bx *) Definition Ast_enQueue_7 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev: nat) (mP : MPred) (S : State) : Prop := (tid |->w_ *^* tid+2 |->w_ *^* ptoTCB (tid+4) tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S DX = tail /\ S_RF S CX = ptr /\ S_RF S BX = tid. Definition L_enQueue_7_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_7 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_7_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_7 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %dx, ND_PREV(%bx) *) Definition Ast_enQueue_8 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev: nat) (mP : MPred) (S : State) : Prop := (tid |->w tail *^* tid + 2 |->w_ *^* ptoTCB (tid+4) tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S DX = tail /\ S_RF S CX = ptr /\ S_RF S BX = tid. Definition L_enQueue_8_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_8 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_8_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_8 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw $0, ND_NEXT(%bx) *) Definition Ast_enQueue_9 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w tail *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S DX = tail /\ S_RF S CX = ptr /\ S_RF S BX = tid. Definition L_enQueue_9_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_9 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_9_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_9 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : cmpw $0, %dx *) Definition Ast_enQueue_10_emp (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w 0 *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w 0 *^* ptr + 2 |->w 0 *^* (Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S CX = ptr /\ S_Flag S _ZF = true. Definition Ast_enQueue_10_notemp (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w tail *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ tail > 0 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S DX = tail /\ S_RF S CX = ptr /\ S_RF S BX = tid /\ S_Flag S _ZF = false. Definition L_enQueue_10_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_10_emp T Q ptr tid tcb bp sp prev mTrue S \/ Ast_enQueue_10_notemp T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_10_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_10_emp T Q ptr tid tcb bp sp prev mP S \/ Ast_enQueue_10_notemp T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : jne L_enQ_NotNull *) Definition Ast_enQueue_11 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w 0 *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w 0 *^* ptr + 2 |->w 0 *^* (Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S CX = ptr. Definition L_enQueue_11_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists prev, Ast_enQueue_11 T Q ptr tid tcb bp sp prev mTrue S. Definition L_enQueue_11_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp prev mP, Ast_enQueue_11 T Q ptr tid tcb bp sp prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %cx, %bx *) Definition Ast_enQueue_12 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w 0 *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w 0 *^* ptr + 2 |->w 0 *^* (Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S BX = ptr. Definition L_enQueue_12_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists prev, Ast_enQueue_12 T Q ptr tid tcb bp sp prev mTrue S. Definition L_enQueue_12_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp prev mP, Ast_enQueue_12 T Q ptr tid tcb bp sp prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %ax, Q_HEAD(%bx) *) Definition Ast_enQueue_13 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w 0 *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w tid *^* ptr + 2 |->w 0 *^* (Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S BX = ptr. Definition L_enQueue_13_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists prev, Ast_enQueue_13 T Q ptr tid tcb bp sp prev mTrue S. Definition L_enQueue_13_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp prev mP, Ast_enQueue_13 T Q ptr tid tcb bp sp prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %ax, Q_TAIL(%bx) *) Definition Ast_enQueue_14 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w 0 *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w tid *^* ptr + 2 |->w tid *^* (Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2. Definition L_enQueue_14_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists prev, Ast_enQueue_14 T Q ptr tid tcb bp sp prev mTrue S. Definition L_enQueue_14_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp prev mP, Ast_enQueue_14 T Q ptr tid tcb bp sp prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : popw %bp *) Definition Ast_enQueue_15 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w 0 *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w tid *^* ptr + 2 |->w tid *^* (Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q)) *^* stkSpacePrec sp 2 *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ S_RF S BP = bp /\ S_RF S SP = sp. Definition L_enQueue_15_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists prev, Ast_enQueue_15 T Q ptr tid tcb bp sp prev mTrue S. Definition L_enQueue_15_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp prev mP, Ast_enQueue_15 T Q ptr tid tcb bp sp prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : retw *) (* : enQ_NotNull *) Definition Ast_enQueue_16 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w tail *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ tail > 0 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S DX = tail /\ S_RF S CX = ptr. Definition L_enQueue_16_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_16 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_16_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_16 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %dx, %bx *) Definition Ast_enQueue_17 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w tail *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ tail > 0 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S CX = ptr /\ S_RF S BX = tail. Definition L_enQueue_17_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_17 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_17_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_17 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %ax, ND_NEXT(%bx) *) Definition Ast_enQueue_18 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w tail *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev tid (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ tail > 0 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S CX = ptr. Definition L_enQueue_18_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_18 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_18_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_18 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %cx, %bx *) Definition Ast_enQueue_19 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w tail *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev tid (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ tail > 0 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2 /\ S_RF S AX = tid /\ S_RF S BX = ptr. Definition L_enQueue_19_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_19 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_19_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_19 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : movw %ax, Q_TAIL(%bx) *) Definition Ast_enQueue_20 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w tail *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w head *^* ptr + 2 |->w tid *^* (Queue Thread ptoTCB head tail prev tid (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ tail > 0 /\ S_RF S BP = sp - 2 /\ S_RF S SP = sp - 2. Definition L_enQueue_20_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_20 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_20_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_20 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : popw %bp *) Definition Ast_enQueue_21 (T : TQ) (Q : WQ) (ptr : Label) (tid : TID) (tcb : Thread) (bp sp head tail prev : nat) (mP : MPred) (S : State) : Prop := (tid |->w tail *^* tid + 2 |->w 0 *^* ptoTCB (tid+4) tcb *^* ptr |->w head *^* ptr + 2 |->w tid *^* (Queue Thread ptoTCB head tail prev tid (filterTQ T Q)) *^* stkSpacePrec sp 2 *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP) (S_Mem S) /\ tid > 0 /\ sp >= 2 /\ tail > 0 /\ S_RF S BP = bp /\ S_RF S SP = sp. Definition L_enQueue_21_p (S : State) : Prop := exists T, exists Q, exists ptr, exists tid, exists tcb, exists bp, exists sp, exists head, exists tail, exists prev, Ast_enQueue_21 T Q ptr tid tcb bp sp head tail prev mTrue S. Definition L_enQueue_21_g (S S' : State) : Prop := forall T Q ptr tid tcb bp sp head tail prev mP, Ast_enQueue_21 T Q ptr tid tcb bp sp head tail prev mP S -> exists T', exists Q', Ast_enQueue_post T' Q' ptr tid tcb bp sp mP S' /\ T' = TQMod.put T tid tcb /\ Q' = addThrd Q tid. (* : retw *) Definition spec_enQueue := Ast p_enQueue g_enQueue sctag. Definition psi_enQueue_Block0 := (SCAP_consCT L_enQ_NotNull (Ast L_enQueue_16_p L_enQueue_16_g sctag) SCAP_emptCT). Definition psi_enQueue_Block1 := SCAP_emptCT. coq/miniOS/UnblockSpec.v0000644000107400000620000007350311000223231014642 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas. Require Import Assertion_Lemmas2. Require Import Assertion_Lemmas4. Require Import Assertion_Lemmas5. Require Import Operational_Semantics. Require Import SCAP. Require Import AIM. Require Import QLib. Require Import Linking. Require Import Kernel. Require Export EnQueueSpec. Require Export DeQueueSpec. Definition Ast_unblock_pre (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec sp _UNBLK_Stk) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S SP = sp /\ S_RF S BP = bp /\ sp >= _UNBLK_Stk /\ subsetQ_TQ RdyQ T /\ subsetQ_TQ BlkQ T /\ WQMod.disjoint RdyQ BlkQ /\ WF_TQ T. Definition Ast_unblock_post_a (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S' : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec sp _UNBLK_Stk) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S') /\ S_RF S' SP = sp /\ S_RF S' BP = bp /\ S_RF S' AX = 0 /\ (forall l, (filterTQ T BlkQ) l = None). Definition Ast_unblock_post_b (T T' : TQ) (RdyQ BlkQ RdyQ' BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S' : State) : Prop := ((embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec sp _UNBLK_Stk) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S') /\ S_RF S' SP = sp /\ S_RF S' BP = bp /\ S_RF S' AX = tid' /\ tid' <> 0 /\ TQMod.maps_to T tid' tcb' /\ T' = TQMod.put T tid' (TCB_Status_Upd tcb' READY) /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid' /\ RdyQ' = addThrd RdyQ tid'. Definition p_unblock (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, Ast_unblock_pre T RdyQ BlkQ l_ptr bp sp jk mTrue S. Definition g_unblock (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk, Ast_unblock_pre T RdyQ BlkQ l_ptr bp sp jk mP S -> Ast_unblock_post_a T RdyQ BlkQ l_ptr bp sp jk mP S' \/ exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'. Lemma p_unblock_sound : forall S, Linking.UNBLK_Prd S -> p_unblock S. Proof. unfold Linking.UNBLK_Prd. unfold p_unblock. intros S H. destruct H as [T [RdyQ [BlkQ [sp [l [[junk HM] [HRdyQ [HBlkQ [HSP [Hdisj HT]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l; exists (S_RF S BP). exists sp; exists junk. unfold Ast_unblock_pre. unfold UNBLK_MPre in HM. unfold embed_BlkQ. intuition. sep on. sep matchH HM with 10. sep on. sep lift 4 in HM. assert (S_Mem S ||- stkSpace sp 10). sep trivial. apply stkSpace_sp_ge_sz with (S_Mem S); assumption. Qed. Lemma g_unblock_sound : forall S S', g_unblock S S' -> Linking.UNBLK_grt S S'. Proof. unfold g_unblock, Linking.UNBLK_grt. intros S S' H. intros M0 M1 HdisU T RdyQ BlkQ sp l junk HP. unfold UNBLK_Prd_aux in HP. unfold Ast_unblock_pre in H. destruct HP as [HM [HRdyQ [HBlkQ [Hsp [Hdisj HT]]]]]. unfold UNBLK_MPre in HM. unfold embed_BlkQ in H. assert ((embed_RdyQ T RdyQ *^* ptoTQ l (filterTQ T BlkQ) *^* stkSpacePrec sp 10 *^* sp + 2 |-> l *^* sp + 3 |-> junk *^* (mEq M1)) (S_Mem S)). exists M0; exists M1. unfold mEq. intuition. simpl in HM. sep on. sep matchH HM with 10. assert (Ast_unblock_post_a T RdyQ BlkQ l (S_RF S BP) sp junk (mEq M1) S' \/ (exists T' : TQ, exists RdyQ' : WQ, exists BlkQ' : WQ, exists tid' : TID, exists tcb' : Thread, Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l tid' tcb' (S_RF S BP) sp junk (mEq M1) S')). apply H. intuition. sep on. sep lift 4 in HM. assert (S_Mem (S_Mem_Upd S M0) ||- stkSpace sp 10). sep trivial. apply stkSpace_sp_ge_sz with (S_Mem (S_Mem_Upd S M0)); assumption. clear H. destruct H1. unfold Ast_unblock_post_a in H. destruct H as [HM' [HSP [HBP [HAX HQ]]]]. destruct HM' as [M0' [M2 [HdisjU' [HM0' HM2]]]]. unfold mEq in HM2. subst M1. exists M0'. unfold UNBLK_Post_aux. intuition. left. unfold UNBLK_MPost. unfold UNBLK_MPre. simpl. split. apply TQMod.extensional_eqMap. intro x. substH HQ with (HQ x). rewrite HQ. unfold TQMod.emp. trivial. split. sep on. unfold embed_BlkQ in HM0'. sep matchH HM0' with 10. assumption. unfold Ast_unblock_post_b in H. destruct H as [T' [RdyQ' [BlkQ' [tid' [tcb' [HM' [HSP [HBP [HAX [Htid' [Hmaps [HT' [Hindom [HBlkQ' HRdyQ']]]]]]]]]]]]]]. destruct HM' as [M0' [M2 [HdisjU' [HM0' HM2]]]]. unfold mEq in HM2. subst M1. exists M0'. unfold UNBLK_Post_aux. intuition. right. exists tid'; exists tcb'. simpl. rewrite HAX. unfold TQMod.maps_to in Hmaps. intuition. unfold UNBLK_MPost. unfold UNBLK_MPre. subst T' BlkQ' RdyQ'. unfold embed_BlkQ in HM0'. destruct tcb' as ((tsp, tst), tpc). simpl in * . sep on. sep matchH HM0' with 10. Qed. (* : pushw %bp *) Definition Ast_unblock_1 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ S_RF S BP = bp /\ sp >= _UNBLK_Stk /\ subsetQ_TQ RdyQ T /\ subsetQ_TQ BlkQ T /\ WQMod.disjoint RdyQ BlkQ /\ WF_TQ T. Definition p_unblock_1 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, Ast_unblock_1 T RdyQ BlkQ l_ptr bp sp jk mTrue S. Definition g_unblock_1 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk, Ast_unblock_1 T RdyQ BlkQ l_ptr bp sp jk mP S -> Ast_unblock_post_a T RdyQ BlkQ l_ptr bp sp jk mP S' \/ exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'. (* : movw %sp, %bp *) Definition Ast_unblock_2 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ subsetQ_TQ RdyQ T /\ subsetQ_TQ BlkQ T /\ WQMod.disjoint RdyQ BlkQ /\ WF_TQ T. Definition p_unblock_2 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, Ast_unblock_2 T RdyQ BlkQ l_ptr bp sp jk mTrue S. Definition g_unblock_2 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk, Ast_unblock_2 T RdyQ BlkQ l_ptr bp sp jk mP S -> Ast_unblock_post_a T RdyQ BlkQ l_ptr bp sp jk mP S' \/ exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'. (* : movw 4(%bp), %bx # the pointer to the block queue *) Definition Ast_unblock_3 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S BX = l_ptr /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ subsetQ_TQ RdyQ T /\ subsetQ_TQ BlkQ T /\ WQMod.disjoint RdyQ BlkQ /\ WF_TQ T. Definition p_unblock_3 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, Ast_unblock_3 T RdyQ BlkQ l_ptr bp sp jk mTrue S. Definition g_unblock_3 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk, Ast_unblock_3 T RdyQ BlkQ l_ptr bp sp jk mP S -> Ast_unblock_post_a T RdyQ BlkQ l_ptr bp sp jk mP S' \/ exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'. (* : pushw %bx *) Definition Ast_unblock_4 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec (sp - 2 - 2) (_UNBLK_Stk - 2 - 2)) *^* (sp - 2 - 2 |->w l_ptr) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S BX = l_ptr /\ S_RF S SP = sp - 2 - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ subsetQ_TQ RdyQ T /\ subsetQ_TQ BlkQ T /\ WQMod.disjoint RdyQ BlkQ /\ WF_TQ T. Definition p_unblock_4 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, Ast_unblock_4 T RdyQ BlkQ l_ptr bp sp jk mTrue S. Definition g_unblock_4 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk, Ast_unblock_4 T RdyQ BlkQ l_ptr bp sp jk mP S -> Ast_unblock_post_a T RdyQ BlkQ l_ptr bp sp jk mP S' \/ exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'. (* : call deQueue # not change bp *) Definition Ast_unblock_5_a (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec (sp - 2 - 2) (_UNBLK_Stk - 2 - 2)) *^* (sp - 2 - 2 |->w l_ptr) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = 0 /\ S_RF S SP = sp - 2 - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ (forall l, (filterTQ T BlkQ) l = None). Definition Ast_unblock_5_b (T : TQ) (RdyQ BlkQ BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ') *^* (embed_TCB tid' tcb') *^* (stkSpacePrec (sp - 2 - 2) (_UNBLK_Stk - 2 - 2)) *^* (sp - 2 - 2 |->w l_ptr) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S SP = sp - 2 - 2 /\ S_RF S BP = sp - 2 /\ tid' <> 0 /\ sp >= _UNBLK_Stk /\ subsetQ_TQ BlkQ T /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid'. Definition p_unblock_5 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, Ast_unblock_5_a T RdyQ BlkQ l_ptr bp sp jk mTrue S \/ (exists BlkQ', exists tid', exists tcb', Ast_unblock_5_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mTrue S). Definition g_unblock_5 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk, (Ast_unblock_5_a T RdyQ BlkQ l_ptr bp sp jk mP S -> Ast_unblock_post_a T RdyQ BlkQ l_ptr bp sp jk mP S') /\ forall BlkQ' tid' tcb', (Ast_unblock_5_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> exists T', exists RdyQ', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : addw $2, %sp *) Definition Ast_unblock_6_a (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = 0 /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ (forall l, (filterTQ T BlkQ) l = None). Definition Ast_unblock_6_b (T : TQ) (RdyQ BlkQ BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ') *^* (embed_TCB tid' tcb') *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ subsetQ_TQ BlkQ T /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid'. Definition p_unblock_6 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, Ast_unblock_6_a T RdyQ BlkQ l_ptr bp sp jk mTrue S \/ (exists BlkQ', exists tid', exists tcb', Ast_unblock_6_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mTrue S). Definition g_unblock_6 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk, (Ast_unblock_6_a T RdyQ BlkQ l_ptr bp sp jk mP S -> Ast_unblock_post_a T RdyQ BlkQ l_ptr bp sp jk mP S') /\ forall BlkQ' tid' tcb', (Ast_unblock_6_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> exists T', exists RdyQ', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : cmpw $0, %ax *) Definition Ast_unblock_7_a (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_Flag S _ZF = true /\ S_RF S AX = 0 /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ (forall l, (filterTQ T BlkQ) l = None). Definition Ast_unblock_7_b (T : TQ) (RdyQ BlkQ BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ') *^* (embed_TCB tid' tcb') *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_Flag S _ZF = false /\ S_RF S AX = tid' /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ subsetQ_TQ BlkQ T /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid'. Definition p_unblock_7 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, Ast_unblock_7_a T RdyQ BlkQ l_ptr bp sp jk mTrue S \/ (exists BlkQ', exists tid', exists tcb', Ast_unblock_7_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mTrue S). Definition g_unblock_7 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk, (Ast_unblock_7_a T RdyQ BlkQ l_ptr bp sp jk mP S -> Ast_unblock_post_a T RdyQ BlkQ l_ptr bp sp jk mP S') /\ forall BlkQ' tid' tcb', (Ast_unblock_7_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> exists T', exists RdyQ', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : jne wakeup *) Definition Ast_unblock_8 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = 0 /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ (forall l, (filterTQ T BlkQ) l = None). Definition p_unblock_8 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, Ast_unblock_8 T RdyQ BlkQ l_ptr bp sp jk mTrue S. Definition g_unblock_8 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk, (Ast_unblock_8 T RdyQ BlkQ l_ptr bp sp jk mP S -> Ast_unblock_post_a T RdyQ BlkQ l_ptr bp sp jk mP S'). (* : popw %bp *) Definition Ast_unblock_9 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec sp _UNBLK_Stk) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = 0 /\ S_RF S SP = sp /\ S_RF S BP = bp /\ sp >= _UNBLK_Stk /\ (forall l, (filterTQ T BlkQ) l = None). Definition p_unblock_9 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, Ast_unblock_9 T RdyQ BlkQ l_ptr bp sp jk mTrue S. Definition g_unblock_9 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk, (Ast_unblock_9 T RdyQ BlkQ l_ptr bp sp jk mP S -> Ast_unblock_post_a T RdyQ BlkQ l_ptr bp sp jk mP S'). (* : retw # block_done *) Definition Ast_unblock_10 (T : TQ) (RdyQ BlkQ BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ') *^* (embed_TCB tid' tcb') *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ subsetQ_TQ BlkQ T /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid'. Definition p_unblock_10 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, exists BlkQ', exists tid', exists tcb', Ast_unblock_10 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mTrue S. Definition g_unblock_10 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk BlkQ' tid' tcb', (Ast_unblock_10 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> exists T', exists RdyQ', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : movw %ax, %bx *) Definition Ast_unblock_11 (T : TQ) (RdyQ BlkQ BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ') *^* (embed_TCB tid' tcb') *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S BX = tid' /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ subsetQ_TQ BlkQ T /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid'. Definition p_unblock_11 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, exists BlkQ', exists tid', exists tcb', Ast_unblock_11 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mTrue S. Definition g_unblock_11 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk BlkQ' tid' tcb', (Ast_unblock_11 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> exists T', exists RdyQ', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : movw $READY, TCB_STATUS(%bx) *) Definition Ast_unblock_12 (T : TQ) (RdyQ BlkQ BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ') *^* (embed_TCB tid' (TCB_Status_Upd tcb' READY)) *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S BX = tid' /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ subsetQ_TQ BlkQ T /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid'. Definition p_unblock_12 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, exists BlkQ', exists tid', exists tcb', Ast_unblock_12 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mTrue S. Definition g_unblock_12 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk BlkQ' tid' tcb', (Ast_unblock_12 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> exists T', exists RdyQ', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : pushw $readyQ *) Definition Ast_unblock_13 (T : TQ) (RdyQ BlkQ BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ') *^* (embed_TCB tid' (TCB_Status_Upd tcb' READY)) *^* (stkSpacePrec (sp - 2 - 2) (_UNBLK_Stk - 2 - 2)) *^* (sp - 2 - 2 |->w ready_Q) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S BX = tid' /\ S_RF S SP = sp - 2 - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ subsetQ_TQ BlkQ T /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid'. Definition p_unblock_13 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, exists BlkQ', exists tid', exists tcb', Ast_unblock_13 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mTrue S. Definition g_unblock_13 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk BlkQ' tid' tcb', (Ast_unblock_13 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> exists T', exists RdyQ', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : pushw %bx *) Definition Ast_unblock_14 (T : TQ) (RdyQ BlkQ BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ') *^* (embed_TCB tid' (TCB_Status_Upd tcb' READY)) *^* (stkSpacePrec (sp - 2 - 2 - 2) (_UNBLK_Stk - 2 - 2 - 2)) *^* (sp - 2 - 2 - 2 |->w tid') *^* (sp - 2 - 2 |->w ready_Q) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S BX = tid' /\ S_RF S SP = sp - 2 - 2 - 2 /\ S_RF S BP = sp - 2 /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ subsetQ_TQ BlkQ T /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid'. Definition p_unblock_14 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, exists BlkQ', exists tid', exists tcb', Ast_unblock_14 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mTrue S. Definition g_unblock_14 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk BlkQ' tid' tcb', (Ast_unblock_14 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> exists T', exists RdyQ', Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : call enQueue *) Definition Ast_unblock_15 (T T' : TQ) (RdyQ BlkQ RdyQ' BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec (sp - 2 - 2 - 2) (_UNBLK_Stk - 2 - 2 - 2)) *^* (sp - 2 - 2 - 2 |->w tid') *^* (sp - 2 - 2 |->w ready_Q) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 - 2 - 2 /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid' /\ T' = TQMod.put T tid' (TCB_Status_Upd tcb' READY) /\ RdyQ' = addThrd RdyQ tid'. Definition p_unblock_15 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_unblock_15 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mTrue S. Definition g_unblock_15 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk T' RdyQ' BlkQ' tid' tcb', (Ast_unblock_15 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S -> Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : popw %ax *) Definition Ast_unblock_16 (T T' : TQ) (RdyQ BlkQ RdyQ' BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec (sp - 2 - 2) (_UNBLK_Stk - 2 - 2)) *^* (sp - 2 - 2 |->w ready_Q) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S SP = sp - 2 - 2 /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid' /\ T' = TQMod.put T tid' (TCB_Status_Upd tcb' READY) /\ RdyQ' = addThrd RdyQ tid'. Definition p_unblock_16 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_unblock_16 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mTrue S. Definition g_unblock_16 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk T' RdyQ' BlkQ' tid' tcb', (Ast_unblock_16 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S -> Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : addw $2, %sp *) Definition Ast_unblock_17 (T T' : TQ) (RdyQ BlkQ RdyQ' BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec (sp - 2) (_UNBLK_Stk - 2)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S SP = sp - 2 /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid' /\ T' = TQMod.put T tid' (TCB_Status_Upd tcb' READY) /\ RdyQ' = addThrd RdyQ tid'. Definition p_unblock_17 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_unblock_17 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mTrue S. Definition g_unblock_17 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk T' RdyQ' BlkQ' tid' tcb', (Ast_unblock_17 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S -> Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : popw %bp *) Definition Ast_unblock_18 (T T' : TQ) (RdyQ BlkQ RdyQ' BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp jk : nat) (mP : MPred) (S : State) : Prop := ((embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec (sp) (_UNBLK_Stk)) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S BP = bp /\ S_RF S SP = sp /\ sp >= _UNBLK_Stk /\ tid' <> 0 /\ TQMod.maps_to T tid' tcb' /\ WQMod.in_dom tid' BlkQ /\ BlkQ' = WQMod.remove BlkQ tid' /\ T' = TQMod.put T tid' (TCB_Status_Upd tcb' READY) /\ RdyQ' = addThrd RdyQ tid'. Definition p_unblock_18 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists bp, exists sp, exists jk, exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_unblock_18 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mTrue S. Definition g_unblock_18 (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr bp sp jk T' RdyQ' BlkQ' tid' tcb', (Ast_unblock_18 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S -> Ast_unblock_post_b T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). (* : retw *) Definition spec_unblock := Ast p_unblock g_unblock sctag. Definition psi_unblock := (SCAP_consCT L_enQueue (Ast p_enQueue g_enQueue sctag) (SCAP_consCT L_deQueue (Ast p_deQueue g_deQueue sctag) (SCAP_consCT L_unblock (Ast p_unblock g_unblock sctag) (SCAP_consCT L_wakeup (Ast p_unblock_10 g_unblock_10 sctag) SCAP_emptCT)))). Lemma L_deQueue_in_psi_unblock : SCAP_lookupCT psi_unblock L_deQueue (Ast p_deQueue g_deQueue sctag). Proof. unfold SCAP_lookupCT, psi_unblock. unfold SCAP_consCT. apply SPSpec.lookup_merge_intro_r. simpl. SPSpec.lookup_solve. Qed. Lemma L_enQueue_in_psi_unblock : SCAP_lookupCT psi_unblock L_enQueue (Ast p_enQueue g_enQueue sctag). Proof. unfold SCAP_lookupCT, psi_unblock. unfold SCAP_consCT. simpl. SPSpec.lookup_solve. Qed. Lemma L_wakeup_in_psi_unblock : SCAP_lookupCT psi_unblock L_wakeup (Ast p_unblock_10 g_unblock_10 sctag). Proof. unfold SCAP_lookupCT, psi_unblock. unfold SCAP_consCT. apply SPSpec.lookup_merge_intro_r. simpl. unfold SPSpec.lookup. simpl. right. right. left; trivial. Qed. coq/miniOS/DeQueueSpec.v0000644000107400000620000006601711000223231014604 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) (* by wangwei *) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import Kernel. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Definition Ast_deQueue_pre (T : TQ) (Q : WQ) (ptr : Label) (bp sp : nat) (mP : MPred) (S : State): Prop := (ptoTQ ptr (filterTQ T Q) *^* stkSpacePrec sp 2 *^* sp + 2|->w ptr *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S SP = sp. Definition p_deQueue (S : State) : Prop := exists T, exists Q, exists ptr, exists bp, exists sp, Ast_deQueue_pre T Q ptr bp sp mTrue S. Definition Ast_deQueue_post_a (T : TQ) (Q : WQ) (ptr : Label) (bp sp : nat) (mP : MPred) (S' : State): Prop := (ptoTQ ptr (filterTQ T Q) *^* stkSpacePrec sp 2 *^* sp + 2|->w ptr *^* mP) (S_Mem S') /\ S_RF S' AX = 0 /\ S_RF S' BP = bp /\ S_RF S' SP = sp. (* exit of Block3 , get a node *) Definition Ast_deQueue_post_b (T : TQ) (Q' : WQ) (ptr : Label) (tid' : TID) (tcb' : Thread) (bp sp : nat) (mP : MPred) (S' : State): Prop := (embed_TCB tid' tcb' *^* ptoTQ ptr (filterTQ T Q') *^* stkSpacePrec sp 2 *^* sp + 2 |->w ptr *^* mP) (S_Mem S') /\ S_RF S' AX = tid' /\ S_RF S' BP = bp /\ S_RF S' SP = sp /\ TQMod.maps_to T tid' tcb'. Definition g_deQueue (S S' : State) : Prop := forall mP, forall T Q ptr bp sp, Ast_deQueue_pre T Q ptr bp sp mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : Block0 *) (* : pushw %bp *) Definition Ast_deQueue_1 (T : TQ) (Q : WQ) (ptr : Label) (bp sp : nat) (mP : MPred) (S : State) :Prop := (ptoTQ ptr (filterTQ T Q) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ sp >= 2. Definition L_deQueue_1_p (S : State) : Prop := exists T, exists Q, exists ptr, exists bp, exists sp, Ast_deQueue_1 T Q ptr bp sp mTrue S. Definition L_deQueue_1_g (S S' : State) : Prop := forall T Q ptr bp sp mP, Ast_deQueue_1 T Q ptr bp sp mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw %sp, %bp *) Definition Ast_deQueue_2 (T : TQ) (Q : WQ) (ptr : Label) (bp sp : nat) (mP : MPred) (S : State) :Prop := (ptoTQ ptr (filterTQ T Q) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= 2. Definition L_deQueue_2_p (S : State) : Prop := exists T, exists Q, exists ptr, exists bp, exists sp, Ast_deQueue_2 T Q ptr bp sp mTrue S. Definition L_deQueue_2_g (S S' : State) : Prop := forall T Q ptr bp sp mP, Ast_deQueue_2 T Q ptr bp sp mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw 4(%bp), %bx *) Definition Ast_deQueue_3 (T : TQ) (Q : WQ) (ptr : Label) (bp sp head tail prev: nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ S_RF S BX = ptr /\ sp >= 2. Definition L_deQueue_3_p (S : State) : Prop := exists T, exists Q, exists ptr, exists bp, exists sp, exists head, exists tail, exists prev, Ast_deQueue_3 T Q ptr bp sp head tail prev mTrue S. Definition L_deQueue_3_g (S S' : State) : Prop := forall T Q ptr bp sp head tail prev mP, Ast_deQueue_3 T Q ptr bp sp head tail prev mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw Q_HEAD(%bx), %dx *) Definition Ast_deQueue_4 (T : TQ) (Q : WQ) (ptr : Label) (bp sp head tail prev: nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ S_RF S BX = ptr /\ S_RF S DX = head /\ sp >= 2. Definition L_deQueue_4_p (S : State) : Prop := exists T, exists Q, exists ptr, exists bp, exists sp, exists head, exists tail, exists prev, Ast_deQueue_4 T Q ptr bp sp head tail prev mTrue S. Definition L_deQueue_4_g (S S' : State) : Prop := forall T Q ptr bp sp head tail prev mP, Ast_deQueue_4 T Q ptr bp sp head tail prev mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : cmpw $0, %dx *) Definition Ast_deQueue_5_emp (T : TQ) (Q : WQ) (ptr : Label) (bp sp prev: nat) (mP : MPred) (S : State) :Prop := (ptr |->w 0 *^* ptr + 2 |->w 0 *^* (Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ S_RF S BX = ptr /\ S_RF S DX = 0 /\ S_Flag S _ZF = true /\ sp >= 2. Definition Ast_deQueue_5_get (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head tail prev next next' tail': nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* (ptoNode Thread ptoTCB head prev next tcb) *^* (Queue Thread ptoTCB next' tail' head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ S_RF S BX = ptr /\ S_RF S DX = head /\ S_Flag S _ZF = false /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb /\ (tail' = tail /\ tail' > 0 /\ next' = next \/ tail' = 0/\ tail = head /\ next' = 0 /\ next = 0). Definition L_deQueue_5_p (S : State) : Prop := exists T, exists Q, exists ptr, exists bp, exists sp, exists head, exists tail, exists prev, Ast_deQueue_5_emp T Q ptr bp sp prev mTrue S \/ exists Q', exists tcb, exists next, exists next', exists tail', Ast_deQueue_5_get T Q Q' ptr tcb bp sp head tail prev next next' tail' mTrue S. Definition L_deQueue_5_g (S S' : State) : Prop := forall T Q ptr bp sp head tail prev mP, (Ast_deQueue_5_emp T Q ptr bp sp prev mP S \/ exists Q', exists tcb, exists next, exists next', exists tail', Ast_deQueue_5_get T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S) -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : jne deq_a *) Definition Ast_deQueue_6 (T : TQ) (Q : WQ) (ptr : Label) (bp sp prev: nat) (mP : MPred) (S : State) :Prop := (ptr |->w 0 *^* ptr + 2 |->w 0 *^* (Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ sp >= 2. Definition L_deQueue_6_p (S : State) : Prop := exists T, exists Q, exists ptr, exists bp, exists sp, exists prev, Ast_deQueue_6 T Q ptr bp sp prev mTrue S. Definition L_deQueue_6_g (S S' : State) : Prop := forall T Q ptr bp sp prev mP, Ast_deQueue_6 T Q ptr bp sp prev mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw de $0, %ax *) Definition Ast_deQueue_7 (T : TQ) (Q : WQ) (ptr : Label) (bp sp prev: nat) (mP : MPred) (S : State) :Prop := (ptr |->w 0 *^* ptr + 2 |->w 0 *^* (Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q)) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S AX = 0 /\ S_RF S SP = sp - 2 /\ sp >= 2. Definition L_deQueue_7_p (S : State) : Prop := exists T, exists Q, exists ptr, exists bp, exists sp, exists prev, Ast_deQueue_7 T Q ptr bp sp prev mTrue S. Definition L_deQueue_7_g (S S' : State) : Prop := forall T Q ptr bp sp prev mP, Ast_deQueue_7 T Q ptr bp sp prev mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : popw %bp *) Definition Ast_deQueue_8 (T : TQ) (Q : WQ) (ptr : Label) (bp sp prev: nat) (mP : MPred) (S : State) :Prop := (ptr |->w 0 *^* ptr + 2 |->w 0 *^* (Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q)) *^* stkSpacePrec sp 2 *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp /\ S_RF S BP = bp /\ S_RF S AX = 0 /\ sp >= 2. Definition L_deQueue_8_p (S : State) : Prop := exists T, exists Q, exists ptr, exists bp, exists sp, exists prev, Ast_deQueue_8 T Q ptr bp sp prev mTrue S. Definition L_deQueue_8_g (S S' : State) : Prop := forall T Q ptr bp sp prev mP, Ast_deQueue_8 T Q ptr bp sp prev mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : retw *) (* : Block1 *) Definition Ast_deQueue_9 (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head tail prev next next' tail': nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* (ptoNode Thread ptoTCB head prev next tcb) *^* (Queue Thread ptoTCB next' tail' head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ S_RF S BX = ptr /\ S_RF S DX = head /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb /\ (tail' = tail /\ tail' > 0 /\ next' = next \/ tail' = 0/\ tail = head /\ next' = 0 /\ next = 0). Definition L_deQueue_9_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists tail, exists prev, exists next, exists next', exists tail', Ast_deQueue_9 T Q Q' ptr tcb bp sp head tail prev next next' tail' mTrue S. Definition L_deQueue_9_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP, Ast_deQueue_9 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw %bx, %cx *) Definition Ast_deQueue_10 (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head tail prev next next' tail': nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* (ptoNode Thread ptoTCB head prev next tcb) *^* (Queue Thread ptoTCB next' tail' head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S CX = ptr /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ S_RF S DX = head /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb /\ (tail' = tail /\ tail' > 0 /\ next' = next \/ tail' = 0/\ tail = head /\ next' = 0 /\ next = 0). Definition L_deQueue_10_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists tail, exists prev, exists next, exists next', exists tail', Ast_deQueue_10 T Q Q' ptr tcb bp sp head tail prev next next' tail' mTrue S. Definition L_deQueue_10_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP, Ast_deQueue_10 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw %dx, %bx *) Definition Ast_deQueue_11 (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head tail prev next next' tail': nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* (ptoNode Thread ptoTCB head prev next tcb) *^* (Queue Thread ptoTCB next' tail' head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S BX = head /\ S_RF S CX = ptr /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb /\ (tail' = tail /\ tail' > 0 /\ next' = next \/ tail' = 0/\ tail = head /\ next' = 0 /\ next = 0). Definition L_deQueue_11_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists tail, exists prev, exists next, exists next', exists tail', Ast_deQueue_11 T Q Q' ptr tcb bp sp head tail prev next next' tail' mTrue S. Definition L_deQueue_11_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP, Ast_deQueue_11 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw ND_NEXT(%bx), %dx *) Definition Ast_deQueue_12 (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head tail prev next next' tail': nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* head |->w prev *^* head + 2 |->w next *^* ptoTCB (head + 4) tcb *^* (Queue Thread ptoTCB next' tail' head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S DX = next /\ S_RF S BX = head /\ S_RF S CX = ptr /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb /\ (tail' = tail /\ tail' > 0 /\ next' = next \/ tail' = 0/\ tail = head /\ next' = 0 /\ next = 0). Definition L_deQueue_12_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists tail, exists prev, exists next, exists next', exists tail', Ast_deQueue_12 T Q Q' ptr tcb bp sp head tail prev next next' tail' mTrue S. Definition L_deQueue_12_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP, Ast_deQueue_12 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw %bx, %ax *) Definition Ast_deQueue_13 (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head tail prev next next' tail': nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* head |->w prev *^* head + 2 |->w next *^* ptoTCB (head + 4) tcb *^* (Queue Thread ptoTCB next' tail' head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S AX = head /\ S_RF S DX = next /\ S_RF S CX = ptr /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb /\ (tail' = tail /\ tail' > 0 /\ next' = next \/ tail' = 0/\ tail = head /\ next' = 0 /\ next = 0). Definition L_deQueue_13_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists tail, exists prev, exists next, exists next', exists tail', Ast_deQueue_13 T Q Q' ptr tcb bp sp head tail prev next next' tail' mTrue S. Definition L_deQueue_13_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP, Ast_deQueue_13 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw %cx, %bx *) Definition Ast_deQueue_14 (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head tail prev next next' tail': nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* head |->w prev *^* head + 2 |->w next *^* ptoTCB (head + 4) tcb *^* (Queue Thread ptoTCB next' tail' head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S BX = ptr /\ S_RF S AX = head /\ S_RF S DX = next /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb /\ (tail' = tail /\ tail' > 0 /\ next' = next \/ tail' = 0/\ tail = head /\ next' = 0 /\ next = 0). Definition L_deQueue_14_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists tail, exists prev, exists next, exists next', exists tail', Ast_deQueue_14 T Q Q' ptr tcb bp sp head tail prev next next' tail' mTrue S. Definition L_deQueue_14_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP, Ast_deQueue_14 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : cmpw $0, %dx *) Definition Ast_deQueue_15_emp (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head tail prev: nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* head |->w prev *^* head + 2 |->w 0 *^* ptoTCB (head + 4) tcb *^* (Queue Thread ptoTCB 0 0 head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S BX = ptr /\ S_RF S AX = head /\ S_RF S DX = 0 /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ S_Flag S _ZF = true /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb. Definition Ast_deQueue_15_get (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head tail prev next: nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* head |->w prev *^* head + 2 |->w next *^* ptoTCB (head + 4) tcb *^* (Queue Thread ptoTCB next tail head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S BX = ptr /\ S_RF S AX = head /\ S_RF S DX = next /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ S_Flag S _ZF = false /\ sp >= 2 /\ head > 0 /\ next <> 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb. Definition L_deQueue_15_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists tail, exists prev, Ast_deQueue_15_emp T Q Q' ptr tcb bp sp head tail prev mTrue S\/ exists next, Ast_deQueue_15_get T Q Q' ptr tcb bp sp head tail prev next mTrue S. Definition L_deQueue_15_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head tail prev mP, (Ast_deQueue_15_emp T Q Q' ptr tcb bp sp head tail prev mP S \/ exists next, Ast_deQueue_15_get T Q Q' ptr tcb bp sp head tail prev next mP S) -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : jne deq_b *) Definition Ast_deQueue_16 (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head tail prev: nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail *^* head |->w prev *^* head + 2 |->w 0 *^* ptoTCB (head + 4) tcb *^* (Queue Thread ptoTCB 0 0 head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S BX = ptr /\ S_RF S AX = head /\ S_RF S DX = 0 /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb. Definition L_deQueue_16_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists tail, exists prev, Ast_deQueue_16 T Q Q' ptr tcb bp sp head tail prev mTrue S. Definition L_deQueue_16_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head tail prev mP, Ast_deQueue_16 T Q Q' ptr tcb bp sp head tail prev mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw %dx, Q_TAIL(%bx) *) (* : Block3 *) Definition Ast_deQueue_17 (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head prev head' tail': nat) (mP : MPred) (S : State) :Prop := (ptr |->w head *^* ptr + 2 |->w tail' *^* head |->w prev *^* head + 2 |->w head' *^* ptoTCB (head + 4) tcb *^* (Queue Thread ptoTCB head' tail' head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S BX = ptr /\ S_RF S AX = head /\ S_RF S DX = head' /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb. Definition L_deQueue_17_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists prev, exists head', exists tail', Ast_deQueue_17 T Q Q' ptr tcb bp sp head prev head' tail' mTrue S. Definition L_deQueue_17_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head prev head' tail' mP, Ast_deQueue_17 T Q Q' ptr tcb bp sp head prev head' tail' mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : movw %dx, Q_HEAD(%bx) *) Definition Ast_deQueue_18 (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head prev head' tail': nat) (mP : MPred) (S : State) :Prop := (ptr |->w head' *^* ptr + 2 |->w tail' *^* head |->w prev *^* head + 2 |->w head' *^* ptoTCB (head + 4) tcb *^* (Queue Thread ptoTCB head' tail' head 0 (filterTQ T Q')) *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S BX = ptr /\ S_RF S AX = head /\ S_RF S SP = sp - 2 /\ S_RF S BP = sp - 2 /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb. Definition L_deQueue_18_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists prev, exists head', exists tail', Ast_deQueue_18 T Q Q' ptr tcb bp sp head prev head' tail' mTrue S. Definition L_deQueue_18_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head prev head' tail' mP, Ast_deQueue_18 T Q Q' ptr tcb bp sp head prev head' tail' mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : popw %bp *) Definition Ast_deQueue_19 (T : TQ) (Q Q' : WQ) (ptr : Label) (tcb : Thread) (bp sp head prev head' tail': nat) (mP : MPred) (S : State) :Prop := (ptr |->w head' *^* ptr + 2 |->w tail' *^* head |->w prev *^* head + 2 |->w head' *^* ptoTCB (head + 4) tcb *^* (Queue Thread ptoTCB head' tail' head 0 (filterTQ T Q')) *^* stkSpacePrec sp 2 *^* sp + 2 |->w ptr *^* mP) (S_Mem S) /\ S_RF S BP = bp /\ S_RF S BX = ptr /\ S_RF S AX = head /\ S_RF S SP = sp /\ sp >= 2 /\ head > 0 /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q' /\ TQMod.maps_to T head tcb. Definition L_deQueue_19_p (S : State) : Prop := exists T, exists Q, exists Q', exists ptr, exists tcb, exists bp, exists sp,exists head, exists prev, exists head', exists tail', Ast_deQueue_19 T Q Q' ptr tcb bp sp head prev head' tail' mTrue S. Definition L_deQueue_19_g (S S' : State) : Prop := forall T Q Q' ptr tcb bp sp head prev head' tail' mP, Ast_deQueue_19 T Q Q' ptr tcb bp sp head prev head' tail' mP S -> (forall l, (filterTQ T Q) l = None) /\ Ast_deQueue_post_a T Q ptr bp sp mP S' \/ exists Q', exists tid', exists tcb', Ast_deQueue_post_b T Q' ptr tid' tcb' bp sp mP S' /\ Q = addThrd Q' tid' /\ WQMod.not_in_dom tid' Q'. (* : retw *) Definition spec_deQueue := Ast p_deQueue g_deQueue sctag. Definition psi_deQueue_Block0 := (SCAP_consCT L_deQ_a (Ast L_deQueue_9_p L_deQueue_9_g sctag) SCAP_emptCT). Definition psi_deQueue_Block1 := (SCAP_consCT L_deQ_b (Ast L_deQueue_17_p L_deQueue_17_g sctag) SCAP_emptCT). Definition psi_deQueue_Block2 := SCAP_emptCT. coq/miniOS/make.sh0000644000107400000620000000066611000223231013514 0ustar shaosystems#!/bin/bash # Top rule for Makefile. # To generate top Makefile, just type: sh make.sh > Makefile # Then type: make coq_makefile -I .. -I ../CAP0 -I ../SCAP \ Queue.v enQueueFirst.v enQueueMulti.v \ deQueueEmpty.v deQueueDeqA.v deQueueDeqB.v \ TCB_lemma.v Scheduler.v SchedulerProof.v SchedulerCallenQ.v SchedulerCalldeQ.v SchedulerRetw.v \ Unblock.v UnblockDeQueue.v UnblockEnQueue.v \ Yield.v YieldProof.v \ Timer.v TimerProof.v coq/miniOS/SwitchProof.v0000644000107400000620000012763011000223231014702 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Require Import Linking_Lemmas3. Require Import Reg. Require Import Assertion_Lemmas3. Require Import Assertion_Lemmas4. Require Import Kernel. Require Import SwitchSpec. (* : movw (curr_thrd), %bx *) Lemma SCAP_WFcmd_schedule_0_movwld : SCAP_WFcmd (SCAP_consCT (L_schedule+1) (Ast L_schedule_1_p L_schedule_1_g sctag) psi_schedule) (L_schedule) (Ast L_schedule_pre_p L_schedule_0_g sctag) (comml (_movwld (A_imm curr_thrd) BX)). Proof. unfold SCAP_WFcmd. exists L_schedule_1_p;exists L_schedule_1_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. unfold L_schedule_pre_p in PS. destruct PS as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 HS7]]]]]]. exists (M, RF_update R BX tid, fl, isr). apply nextS_movwld with curr_thrd tid. simpl;reflexivity. sep on. simpl in HS1. sep lift 0 in HS1. sep trivial. reflexivity. assert (Hpp': forall T RdyQ tid tcb sp pc jk mP S S', Ast_schedule_pre T RdyQ tid tcb sp pc jk mP S -> nextS (L_schedule) (comml (_movwld (A_imm curr_thrd) BX)) S S' -> Ast_schedule_1 T RdyQ tid tcb sp pc jk mP S'). unfold Ast_schedule_pre,Ast_schedule_1. intros T RdyQ tid tcb sp pc jk mP S S' Hp HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HM' [[tidx [Hc HR']] [Hfl' Hisr']]] . destruct Hp as [HM [HSP [Hsp8 [Hsub [ Hnot [Hmap HT]]]]]]. assert (Etid :tidx = tid). sep on. sep lift 0 in HM. sep inj. auto. subst tidx M' R' fl' isr'. intuition. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_schedule_pre_p,L_schedule_1_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [RdyQ [tid [tcb [sp [pc [jk H]]]]]]]. exists T; exists RdyQ; exists tid; exists tcb; exists sp; exists pc;exists jk. apply Hpp' with S;assumption. (* g' ==> g *) unfold L_schedule_0_g, L_schedule_1_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros mP T RdyQ tid tcb sp pc jk HS. apply HgS'S''. apply Hpp' with S;assumption. Qed. (* : movw %sp, TCB_STACK(%bx) *) Lemma SCAP_WFcmd_schedule_1_movwst : SCAP_WFcmd (SCAP_consCT (L_schedule+1+1) (Ast L_schedule_2_p L_schedule_2_g sctag) psi_schedule) (L_schedule+1) (Ast L_schedule_1_p L_schedule_1_g sctag) (comml (_movwst (Opr_reg SP) (A_reg TCB_STACK BX))). Proof. unfold SCAP_WFcmd. exists L_schedule_2_p;exists L_schedule_2_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. unfold L_schedule_1_p in PS. destruct PS as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 HS7]]]]]]. exists (MemUpdW M (tid + 4) sp 0, R, fl, isr). simpl in * . apply nextS_movwst with (tid+4) sp. simpl;rewrite HS2;unfold TCB_STACK;reflexivity. simpl;rewrite HS3;reflexivity. sep on. unfold embed_TCB in HS1. sep lift 3 in HS1. substH HS1 with (ptoTCB_elim1 HS1). destruct HS1 as [tst [HM HST]]. sep lift 0 in HM. sep trivial. apply MemUpdW_MemUpd16 with 0;trivial. assert (Hpp': forall T RdyQ tid tcb sp pc jk mP S S', Ast_schedule_1 T RdyQ tid tcb sp pc jk mP S -> nextS (L_schedule + 1) (comml (_movwst (Opr_reg SP) (A_reg TCB_STACK BX))) S S' -> Ast_schedule_2 T RdyQ tid tcb sp pc jk mP S'). unfold Ast_schedule_1, Ast_schedule_2. intros T RdyQ tid tcb sp pc jk mP S S' Hp HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HM [x HM']] [HR' [Hfl' Hisr']]] . unfold embed_TCB in * . destruct Hp as [HM1 [Htid [Hsp [Hsp8 [Hsub [Hnotin [Hmap HT]]]]]]]. sep on. sep lift 3 in HM1. subst M' R' fl' isr'. unfold TCB_STACK in * . intuition. sep lift 5. substH HM1 with (ptoTCB_elim1 HM1). destruct HM1 as [tst [HM1 Htst]]. apply ptoTCB_intro1 with tst. assert ((MemUpdW M (R BX + 4) (R SP) x) ||- tid + 4 |->w TCB_SP (sp, TCB_Status tcb, pc) *^* tid + 4 + 2 |->w tst *^* (embed_RdyQ T RdyQ *^* (stkSpacePrec sp 8 *^* (sp |-> pc*^*(sp+1|-> jk *^* mP))) *^* curr_thrd |->w tid *^* (tid |->w_ *^* tid + 2 |->w_))). simpl in * . rewrite Hsp; rewrite Htid. sep lift 0. sep upd. sep matchH HM1 with 10. unfold MemUpdW in H. assumption. simpl. assumption. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_schedule_1_p,L_schedule_2_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [RdyQ [tid [tcb [sp [pc [jk H]]]]]]]. exists T; exists RdyQ; exists tid; exists tcb; exists sp; exists pc;exists jk. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_schedule_2_g, L_schedule_1_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros mP T RdyQ tid tcb sp pc jk HS. apply HgS'S''. apply Hpp' with S;assumption. Qed. (* : pushw $readyQ *) Lemma SCAP_WFcmd_schedule_2_pushwp : SCAP_WFcmd (SCAP_consCT (L_schedule+2+1) (Ast L_schedule_3_p L_schedule_3_g sctag) psi_schedule) (L_schedule+2) (Ast L_schedule_2_p L_schedule_2_g sctag) (comml (_pushwp (Opr_imm ready_Q))). Proof. unfold SCAP_WFcmd. exists L_schedule_3_p;exists L_schedule_3_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. unfold L_schedule_2_p in PS. destruct PS as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 HS8]]]]]]]. exists (MemUpdW M (sp-2) ready_Q 0, RF_update R SP (sp - 2), fl, isr). simpl in * . apply nextS_pushwp with ready_Q. simpl;reflexivity. unfold pushW. rewrite HS3. split. apply stkSpace_weaken with 8; [idtac | omega]. sep on. sep lift 3 in HS1. sep trivial. intuition. apply MemUpdW_MemUpd16 with 0;trivial. (* p nextS -> p' *) assert (Hpp': forall T RdyQ tid tcb sp pc jk mP S S', Ast_schedule_2 T RdyQ tid tcb sp pc jk mP S -> nextS (L_schedule + 2) (comml (_pushwp (Opr_imm ready_Q))) S S' -> Ast_schedule_3 T RdyQ tid tcb sp pc jk mP S'). unfold Ast_schedule_2, Ast_schedule_3. intros T RdyQ tid tcb sp pc jk mP S S' HS Hnext. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. substH Hnext with (nextS_inversion Hnext). simpl in * . destruct Hnext as [[Hnext1 [Hnext2 [x Hnext3]]] [Hnext4 [Hnext5 Hnext6]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 HS8]]]]]]]. subst M' R' fl' isr'. rewrite HS3. intuition. sep on. sep lift 3 in HS1. sep lift 4. assert (MemUpdW M (sp - 2) ready_Q x ||- sp - 2 |->w ready_Q *^* (sp |-> pc*^*(sp+1|->jk *^* mP) *^* (curr_thrd |->w tid *^* embed_TCB tid (sp, TCB_Status tcb, pc) *^* embed_RdyQ T RdyQ *^* stkSpacePrec (sp - 2) 6))). sep upd. sep matchH HS1 with 14. sep stksplit in HS1. arith_rep (8-2) with 6 in HS1. assumption. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_schedule_2_p,L_schedule_3_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [RdyQ [tid [tcb [sp [pc [jk H]]]]]]]. exists T; exists RdyQ; exists tid; exists tcb; exists sp; exists pc;exists jk. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_schedule_3_g, L_schedule_2_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros mP T RdyQ tid tcb sp pc jk HS. apply HgS'S''. apply Hpp' with S;assumption. Qed. (* : pushw %bx *) Lemma SCAP_WFcmd_schedule_3_pushwp : SCAP_WFcmd (SCAP_consCT (L_schedule+3+1) (Ast L_schedule_4_p L_schedule_4_g sctag) psi_schedule) (L_schedule+3) (Ast L_schedule_3_p L_schedule_3_g sctag) (comml (_pushwp (Opr_reg BX))). Proof. unfold SCAP_WFcmd. exists L_schedule_4_p;exists L_schedule_4_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. unfold L_schedule_3_p in PS. destruct PS as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 HS8]]]]]]]. exists (MemUpdW M (sp-4) tid 0, RF_update R SP (sp - 4), fl, isr). simpl in * . apply nextS_pushwp with tid. simpl;rewrite HS2;reflexivity. unfold pushW. rewrite HS3. split. apply stkSpace_weaken with 6; [idtac | omega]. sep on. sep lift 3 in HS1. sep trivial. intuition. arith_rep (sp-2-2) with (sp-4). apply MemUpdW_MemUpd16 with 0;trivial. (* p nextS -> p' *) assert (Hpp': forall T RdyQ tid tcb sp pc jk mP S S', Ast_schedule_3 T RdyQ tid tcb sp pc jk mP S -> nextS (L_schedule + 3) (comml (_pushwp (Opr_reg BX))) S S' -> Ast_schedule_4 T RdyQ tid tcb sp pc jk mP S'). unfold Ast_schedule_4, Ast_schedule_3. intros T RdyQ tid tcb sp pc jk mP S S' HS Hnext. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. substH Hnext with (nextS_inversion Hnext). simpl in * . destruct Hnext as [[Hnext1 [Hnext2 [x Hnext3]]] [Hnext4 [Hnext5 Hnext6]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 HS8]]]]]]]. subst M' R' fl' isr'. rewrite HS3. intuition. sep on. sep lift 3 in HS1. sep lift 4. assert (MemUpdW M (sp - 4) tid x ||- sp - 4 |->w tid *^* (sp - 2 |->w ready_Q *^* (sp |-> pc *^* (sp+1|->jk *^* mP)) *^* (curr_thrd |->w tid *^* embed_TCB tid (sp, TCB_Status tcb, pc) *^* embed_RdyQ T RdyQ *^* stkSpacePrec (sp - 4) 4))). sep upd. sep matchH HS1 with 13. sep stksplit in HS1. arith_rep (sp-2-2) with (sp-4) in HS1. rewrite HS2. arith_rep (sp-2-2) with (sp-4). arith_rep (sp-2-2) with (sp-4). split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_schedule_4_p,L_schedule_3_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [RdyQ [tid [tcb [sp [pc [jk H]]]]]]]. exists T; exists RdyQ; exists tid; exists tcb; exists sp; exists pc;exists jk. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_schedule_3_g, L_schedule_4_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros mP T RdyQ tid tcb sp pc jk HS. apply HgS'S''. apply Hpp' with S;assumption. Qed. Lemma subsetQ_TQ_put_sub: forall T RdyQ tid tcb, subsetQ_TQ RdyQ T -> subsetQ_TQ (addThrd RdyQ tid) (TQMod.put T tid tcb). Proof. intros. unfold subsetQ_TQ in * . unfold addThrd. unfold WQMod.put,TQMod.put. intro tid0. unfold WQMod.in_dom in * . unfold TQMod.in_dom in * . unfold WQMod.beq_A,TQMod.beq_A. unfold WQSpec.beq_Domain,TQSpec.beq_Domain. destruct (eq_nat_dec tid0 tid). intro. exists tcb;reflexivity. apply H. Qed. (* : call enQueue (L_enQueue) *) Lemma SCAP_WFcmd_schedule_4_call : SCAP_WFcmd (SCAP_consCT (L_schedule+4+1) (Ast L_schedule_5_p L_schedule_5_g sctag) psi_schedule) (L_schedule+4) (Ast L_schedule_4_p L_schedule_4_g sctag) (comml (_call L_enQueue)). Proof. assert(Hpp' : forall T RdyQ tid tcb sp pc jk mP S S', Ast_schedule_4 T RdyQ tid tcb sp pc jk mP S -> nextS (L_schedule+4) (comml (_call L_enQueue)) S S' -> Ast_enQueue_pre T RdyQ ready_Q tid (sp, TCB_Status tcb, pc) (S_RF S' BP) (sp - 6) (curr_thrd |->w tid *^* sp - 6 |->w (L_schedule + 4 + 1) *^* sp |-> pc *^*(sp+1 |-> jk *^* mP)) S'). intros T RdyQ tid tcb sp pc jk mP S S'. intros HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold Ast_schedule_4 in HS. destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hmto HT]]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspx [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. unfold Ast_enQueue_pre. simplS in * . reg simpl. split. sep on. rewrite Hsp. arith_rep (sp - 4 - 2) with (sp - 6). sep lift 6. sep_update. sep lift 3 in HM. sep stksplit in HM. arith_rep (sp - 4 - 2) with (sp - 6) in HM. sep stksplit 2 in HM. arith_rep (sp - 6 - 2) with (sp - 8) in HM. arith_rep (8 - 4 - 2 - 2) with 0 in HM. sep lift 1 in HM. substH HM with (stkSpacePrec_unit1 HM). unfold embed_RdyQ in HM. arith_rep (sp - 6 + 2) with (sp - 4). arith_rep (sp - 6 + 4) with (sp - 2). sep matchH HM with 11. split. assert (tid <> 0). apply HT. exists tcb; trivial. clear HM Hbx Hsp Hspg Hmto Hlds HSS'. induction tid. destruct (H (refl_equal _)). clear IHtid H. omega. rewrite Hsp; omega. assert (Hpp''' : forall T RdyQ tid tcb sp pc jk pc' mP S S' S'' S''', Ast_schedule_4 T RdyQ tid tcb sp pc jk mP S -> nextS (L_schedule+4) (comml (_call L_enQueue)) S S' -> g_enQueue S' S'' -> nextS pc' (comms (_retw)) S'' S''' -> exists T', Ast_schedule_5 T T' RdyQ tid tcb sp pc jk mP S'''). intros T RdyQ tid tcb sp pc jk pc' mP. intros S S' S'' S''' HS HSS' HS'S'' HS''S'''. exists (TQMod.put T tid (sp, TCB_Status tcb, pc)). unfold g_enQueue in HS'S''. assert (HS' : Ast_enQueue_pre T RdyQ ready_Q tid (sp, TCB_Status tcb, pc) (S_RF S' BP) (sp-6) (curr_thrd |->w tid *^* sp - 6 |->w (L_schedule + 4 + 1) *^* sp |-> pc *^*(sp+1 |->jk *^* mP)) S'). apply Hpp' with S; trivial. assert (HgS'' := HS'S'' _ _ _ _ _ _ _ _ HS'). destruct HgS'' as [T' [RdyQ' [HS'' [HT' HRdyQ']]]]. clear HS'S''. unfold Ast_enQueue_post in HS''. unfold Ast_schedule_5. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. destruct HS as [HM [Hbx [Hsp [Hspg HS]]]]. destruct HS as [HRT [HtR [Hmto HT]]]. simplS in * . destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pcx [Hlds HR''']]. destruct HS'' as [HM'' HR'']. assert (Hpcx : pcx = L_schedule + 4 + 1). subst R' M''' R'''. clear Hpp' HT HRT HtR Hmto. clear Hbx Hsp Hspg HM HS' HS''S''' HM'. clear HT' HRdyQ' HSS'. subst fl' isr' fl''' isr'''. destruct HR'' as [HBP'' HSP'']. rewrite HSP'' in Hlds. sep on. sep lift 5 in HM''. sep_inj. auto. subst pcx; clear Hlds. subst M''' R''' fl''' isr'''. reg simpl. destruct HR'' as [HBP'' HSP'']. rewrite HSP''. arith_rep (sp - 6 + 2) with (sp - 4) in HM''. arith_rep (sp - 6 + 4) with (sp - 2) in HM''. arith_rep (sp - 6 + 2) with (sp - 4). split. unfold embed_RdyQ. rewrite <- HT'. rewrite <- HRdyQ'. unfold embed_RdyQ in HM'' . sep on. sep matchH HM'' with 9. sep stksplit. arith_rep (sp - 4 - 2) with (sp - 6). arith_rep (8-4-2) with 2. sep matchH HM'' with 3. repeat split_l; trivial. apply subsetQ_TQ_put_sub;assumption. simpl. exists p_enQueue; exists L_schedule_5_p. exists g_enQueue; exists L_schedule_5_g. split. unfold SCAP_lookupCT, SCAP_consCT. apply SPSpec.lookup_merge_intro_r. apply L_enQueue_in_psi_schedule. split_l. split. clear Hpp' Hpp'''. unfold enable, L_schedule_4_p. intros S HS. destruct HS as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. unfold Ast_schedule_4 in HS. destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR[Hmto HT]]]]]]]. (* enable call *) destruct S as [[[M R] fl] isr]. simplS in * . exists (MemUpdW M (sp - 4 - 2) (L_schedule+4+1) 0, RF_update R SP (sp - 4 - 2), fl, isr). apply nextS_call. unfold pushW. split. apply stkSpacePrec_stkSpace1 with mTrue. rewrite Hsp. sep on. sep lift 3 in HM. sep stksplit 2 in HM. sep matchH HM with 10. split. rewrite Hsp. apply MemUpdW_MemUpd16 with 0; trivial. rewrite Hsp; trivial. split. (* g' => fun_frame *) unfold sp_call_pred, fun_frame. unfold linkPG, conjPG. intros S' S'' HS'S''. destruct HS'S'' as [H HS'S'']. destruct H as [S [HS HSS']]. unfold g_enQueue in HS'S''. destruct HS as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. assert (HS' : Ast_enQueue_pre T RdyQ ready_Q tid (sp, TCB_Status tcb, pc) (S_RF S' BP) (sp - 6) (curr_thrd |->w tid *^* sp - 6 |->w (L_schedule + 4 + 1) *^* sp |-> pc *^* (sp+1|-> jk *^* mTrue)) S'). eapply Hpp'; eauto. clear Hpp' HS HSS' Hpp'''. substH HS'S'' with (HS'S'' _ _ _ _ _ _ _ _ HS'). destruct HS'S'' as [T' [BlkQ' HS'']]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. simplS in * . destruct HS'' as [HS'' _]. unfold Ast_enQueue_pre, Ast_enQueue_post in * . destruct HS' as [HM' [Htid Hsp']]. destruct HS'' as [HM'' [HBP'' HSP'']]. simplS in * . split. destruct Hsp' as [HBP' HSP']. rewrite HSP''; rewrite HSP'; trivial. unfold Ret_Addr. exists (L_schedule + 4 + 1). simplS. split. intros pc''. destruct Hsp'. apply nextPC_retw with (sp - 6); trivial. clear HM''. sep on. sep lift 6 in HM'. sep trivial. intros pc''. destruct Hsp'. apply nextPC_retw with (sp - 6); trivial. clear HM'. sep on. sep lift 5 in HM''. sep trivial. split. (* p => p' *) intros S' H. unfold conjPG, conjG, linkPG in H. destruct H as [S [HS HnextSS']]. unfold L_schedule_4_p in HS. unfold p_enQueue. destruct HS as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. exists T; exists RdyQ; exists ready_Q; exists tid; exists (sp, TCB_Status tcb, pc). exists (S_RF S' BP); exists (sp - 6). assert (H : Ast_enQueue_pre T RdyQ ready_Q tid (sp, TCB_Status tcb, pc) (S_RF S' BP) (sp - 6) (curr_thrd |->w tid *^* sp - 6 |->w (L_schedule + 4 + 1) *^* sp |-> pc *^*(sp+1|->jk*^* mTrue)) S'). eapply Hpp'; eauto. clear Hpp''' HS HnextSS'. unfold Ast_enQueue_pre in * . destruct H as [HM' [Htid Hsp']]. split. sep on. sep matchH HM' with 10. auto. split. (* p => p''' *) intros pc' S'''. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S H]. destruct H as [HS H]. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. unfold L_schedule_4_p, L_schedule_5_p in * . destruct HS as [T [RdyQ [tid [tcb [sp [pc[jk HS]]]]]]]. assert (H : exists T', Ast_schedule_5 T T' RdyQ tid tcb sp pc jk mTrue S'''). eapply Hpp'''; eauto. exists T; exists RdyQ. exists tid; exists tcb; exists sp; exists pc ;exists jk. apply H. (* g''' => g *) intros pc' S S'''' H. unfold conjPG, wrap_fun, conjG, linkPG in H. destruct H as [S''' [HS HS'''S'''']]. destruct HS as [HSx [S'' [Hx HnextS'']]]. destruct Hx as [S' [HSS' HS'S'']]. unfold L_schedule_4_g, L_schedule_5_g in * . intros mP T RdyQ tid tcb sp pc jk HS. assert (H : exists T', Ast_schedule_5 T T' RdyQ tid tcb sp pc jk mP S'''). eapply Hpp'''; eauto. destruct H as [T' HS']. eapply HS'''S''''; eauto. Qed. (* : addw $2, %sp *) Lemma SCAP_WFcmd_schedule_5_addw: SCAP_WFcmd (SCAP_consCT (L_schedule+5+1) (Ast L_schedule_6_p L_schedule_6_g sctag) psi_schedule) (L_schedule+5) (Ast L_schedule_5_p L_schedule_5_g sctag) (comml (_addw (Opr_imm 2 ) SP)). Proof. assert (Hpp' : forall T T' RdyQ tid tcb sp pc jk mP S S', Ast_schedule_5 T T' RdyQ tid tcb sp pc jk mP S -> nextS (L_schedule+5) (comml (_addw (Opr_imm 2 ) SP)) S S' -> Ast_schedule_6 T T' RdyQ tid tcb sp pc jk mP S'). intros T T' RdyQ tid tcb sp pc jk mP S S' HS HSS'. unfold Ast_schedule_5, Ast_schedule_6 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [Hsp [Hspg [HT' [HRdyQ [Htcb [Hmto Hnin]]]]]]]. subst M' R' isr'. split. sep on. sep matchH HM with 10. sep stksplit. arith_rep (sp - 2 - 2) with (sp - 4). arith_rep (8 - 2 - 2) with (8 - 4). sep matchH HM with 2. reg simpl. unfold opr_eval. split_l. split_l by omega. repeat split_l; trivial. simpl. exists L_schedule_6_p; exists L_schedule_6_g. split_l. split. (* enable addw *) unfold enable, L_schedule_5_p. intros S H. destruct H as [T [RdyQ [tid [tcb [sp [pc [jk H]]]]]]]. destruct H as [T' HS]. destruct HS as [HM [Hsp [Hspg [HT' [HRdyQ [Htcb [Hmto Hnin]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (R' := RF_update R SP (2 + R SP)). exists (M, R', Clear_Flag fl _ZF, isr). apply nextS_addw with 2 (R SP); auto. unfold trash_fl. right; trivial. split. (* p ==> p' *) unfold L_schedule_5_p, L_schedule_5_p. intros S' H. unfold linkPG in H. destruct H as [S H]. simpl in H. destruct H as [H HnextS]. destruct H as [T [RdyQ [tid [tcb [sp [pc [jk H]]]]]]]. destruct H as [T' HS]. exists T; exists RdyQ; exists tid; exists tcb; exists sp; exists pc;exists jk;exists T'. apply Hpp' with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[HSx HnextS] HS'S'']]. unfold L_schedule_5_g, L_schedule_6_g in * . intros. eapply HS'S''; eauto. Qed. (* : call deQueue (L_deQueue) *) Lemma SCAP_WFcmd_schedule_6_call : SCAP_WFcmd (SCAP_consCT (L_schedule+6+1) (Ast L_schedule_7_p L_schedule_7_g sctag) psi_schedule) (L_schedule+6) (Ast L_schedule_6_p L_schedule_6_g sctag) (comml (_call L_deQueue)). Proof. assert(Hpp' : forall T RdyQ tid tcb sp pc jk T' mP S S', Ast_schedule_6 T T' RdyQ tid tcb sp pc jk mP S -> nextS (L_schedule+6) (comml (_call L_deQueue)) S S' -> Ast_deQueue_pre T' (addThrd RdyQ tid) ready_Q (S_RF S BP) (sp - 4) ((curr_thrd |->w tid)*^* stkSpacePrec (sp-6) 2 *^* (sp - 4 |->w (L_schedule+6+1)) *^* (sp |-> pc)*^* (sp+1|->jk *^* mP)) S'). intros T RdyQ tid tcb sp pc jk T' mP S S'. intros HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold Ast_schedule_6 in HS. destruct HS as [HM [HT' [Hsp [Hspg [HRT [HtR [Hmto HT]]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspx [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. unfold Ast_deQueue_pre. simplS in * . reg simpl. split. sep on. rewrite Hsp. arith_rep (sp - 2 - 2) with (sp - 4). sep lift 5. sep_update. sep lift 2 in HM. sep stksplit in HM. arith_rep (sp - 2 - 2) with (sp - 4) in HM. arith_rep (8 - 2 - 2) with 4 in HM. unfold embed_RdyQ in HM. arith_rep (sp - 4 + 2) with (sp - 2). sep stksplit 2 in HM. arith_rep (sp-4-2) with (sp-6) in HM. arith_rep (4-2) with 2 in HM. sep matchH HM with 10. split_l. rewrite Hsp; omega. assert (Hpp''' : forall T RdyQ tid tcb sp pc jk T' pc' mP S S' S'' S''', Ast_schedule_6 T T' RdyQ tid tcb sp pc jk mP S -> nextS (L_schedule+6) (comml (_call L_deQueue)) S S' -> g_deQueue S' S'' -> nextS pc' (comms (_retw)) S'' S''' -> exists RdyQ', exists tid', exists tcb', Ast_schedule_7 T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S'''). intros T RdyQ tid tcb sp pc jk T' pc' mP. intros S S' S'' S''' HS HSS' HS'S'' HS''S'''. unfold g_deQueue in HS'S''. assert (HS' : Ast_deQueue_pre T' (addThrd RdyQ tid) ready_Q (S_RF S BP) (sp-4) (((curr_thrd |->w tid)*^* stkSpacePrec (sp-6) 2 *^* (sp - 4 |->w (L_schedule+6+1)) *^* (sp |-> pc)) *^*(sp+1|->jk *^* mP)) S'). eapply Hpp'; eauto. clear Hpp'. substH HS'S'' with (HS'S'' _ _ _ _ _ _ HS') into HS''. unfold Ast_schedule_6 in HS. destruct HS as [_ [HT' [Hsp [Hspg [HRT [HtR [Hmto HT]]]]]]]. destruct HS'' as [HS'' | HS'']. destruct HS'' as [Hempty [HS'' Hbp]]. substH Hempty with (Hempty tid). unfold filterTQ in Hempty. unfold addThrd,WQMod.put in Hempty. subst T'. unfold TQMod.put,WQMod.beq_A,TQMod.beq_A in Hempty. unfold WQSpec.beq_Domain,TQSpec.beq_Domain in Hempty. destruct (eq_nat_dec tid tid). inversion Hempty. elim n;reflexivity. destruct HS'' as [RdyQ' [tid' [tcb' [HS'' [HRdyQ' Hnin]]]]]. exists RdyQ'; exists tid'; exists tcb'. unfold Ast_deQueue_post_b in HS''. unfold Ast_schedule_7 . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. simplS in * . destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pcx [Hlds HR''']]. destruct HS'' as [HM'' [HAX'' [HBP'' [HSP'' Hmto']]]]. assert (Hpcx : pcx = L_schedule+6 + 1). subst R' M''' R'''. clear HT' HRT HtR Hmto. clear Hsp Hspg HS' HS''S''' HM'. clear HSS'. subst fl' isr' fl''' isr'''. rewrite HSP'' in Hlds; clear HSP''. sep on. sep lift 6 in HM''. sep_inj. auto. subst pcx; clear Hlds. subst M''' R''' fl''' isr'''. reg simpl. rewrite HAX''. rewrite HSP''. arith_rep (sp - 4 + 2) with (sp - 2) in HM''. arith_rep (sp - 4 + 2) with (sp - 2). split. unfold embed_RdyQ. sep on. sep matchH HM'' with 11. sep stksplit. arith_rep (sp - 2 - 2) with (sp - 4). arith_rep (8 - 2 - 2) with 4. sep stksplit 2. arith_rep (sp-4-2) with (sp-6). arith_rep (4-2) with 2. sep matchH HM'' with 3. repeat split_l; trivial. simpl. exists p_deQueue; exists L_schedule_7_p. exists g_deQueue; exists L_schedule_7_g. split. unfold SCAP_lookupCT, SCAP_consCT. apply SPSpec.lookup_merge_intro_r. apply L_deQueue_in_psi_schedule. split_l. split. (* enable call *) clear Hpp' Hpp'''. unfold enable, L_schedule_6_p. intros S HS. destruct HS as [T [RdyQ [tid [tcb [sp [pc [jk [T' HS]]]]]]]]. unfold Ast_schedule_6 in HS. destruct HS as [HM [HT'[Hsp [Hspg _]]]]. destruct S as [[[M R] fl] isr]. simplS in * . exists (MemUpdW M (sp - 2 - 2) (L_schedule+6+1) 0, RF_update R SP (sp - 2 - 2), fl, isr). apply nextS_call. unfold pushW. split. apply stkSpace_weaken with (8 - 2); [idtac | omega]. apply stkSpacePrec_stkSpace1 with mTrue. rewrite Hsp. sep on. sep matchH HM with 10. split. rewrite Hsp. apply MemUpdW_MemUpd16 with 0; trivial. rewrite Hsp; trivial. split. (* g' => fun_frame *) unfold sp_call_pred, fun_frame. unfold linkPG, conjPG. intros S' S'' HS'S''. destruct HS'S'' as [H HS'S'']. destruct H as [S [HS HSS']]. unfold g_deQueue in HS'S''. destruct HS as [T [RdyQ [tid [tcb [sp [pc[jk [T' HS]]]]]]]]. assert (HS' : Ast_deQueue_pre T' (addThrd RdyQ tid) ready_Q (S_RF S BP) (sp - 4) (((curr_thrd |->w tid)*^* stkSpacePrec (sp-6) 2 *^* (sp - 4 |->w (L_schedule+6+1)) *^* (sp |-> pc))*^*(sp+1|->jk *^* mTrue)) S'). eapply Hpp'; eauto. clear Hpp' HSS' Hpp'''. substH HS'S'' with (HS'S'' _ _ _ _ _ _ HS') into HS''. destruct HS as [_ [HT' [Hsp [Hspg [HRT [HtR [Hmto HT]]]]]]]. destruct HS'' as [HS'' | HS'']. destruct HS'' as [Hempty [HS'' Hbp]]. substH Hempty with (Hempty tid). unfold filterTQ in Hempty. unfold addThrd,WQMod.put in Hempty. subst T'. unfold TQMod.put,WQMod.beq_A,TQMod.beq_A in Hempty. unfold WQSpec.beq_Domain,TQSpec.beq_Domain in Hempty. destruct (eq_nat_dec tid tid). inversion Hempty. elim n;reflexivity. destruct HS'' as [RdyQ' [tid' [tcb' [HS'' [HRdyQ' Hnin']]]]]. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. simplS in * . unfold Ast_deQueue_pre, Ast_deQueue_post_b in * . destruct HS' as [HM' [HBP' HSP']]. destruct HS'' as [HM'' [HAX'' [HBP'' [HSP'' Hmto']]]]. simplS in * . split. rewrite HSP'; rewrite HSP''; trivial. unfold Ret_Addr. exists (L_schedule + 6 + 1). simplS. split. intros pc''. apply nextPC_retw with (sp - 4); trivial. clear HM''. sep on. sep lift 5 in HM'. sep trivial. intros pc''. apply nextPC_retw with (sp - 4); trivial. clear HM'. sep on. sep lift 6 in HM''. sep trivial. split. (* p => p' *) intros S' H. unfold conjPG, conjG, linkPG in H. destruct H as [S [HS HnextSS']]. unfold L_schedule_6_p in HS. unfold p_deQueue. destruct HS as [T [RdyQ [tid [tcb [sp [pc [jk [T' HS]]]]]]]]. exists T'; exists (addThrd RdyQ tid); exists ready_Q; exists (S_RF S BP); exists (sp - 4). assert (H : Ast_deQueue_pre T' (addThrd RdyQ tid) ready_Q (S_RF S BP) (sp - 4) (((curr_thrd |->w tid)*^* stkSpacePrec (sp-6) 2 *^* (sp - 4 |->w (L_schedule+6+1)) *^* (sp |-> pc))*^*(sp+1|->jk *^* mTrue)) S'). eapply Hpp'; eauto. clear Hpp''' Hpp' HS HnextSS'. unfold Ast_deQueue_pre in * . destruct H as [HM' H]. split_r. sep on. sep matchH HM' with 10. split. (* p => p''' *) intros pc' S'''. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S H]. destruct H as [HS H]. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. unfold L_schedule_6_p, L_schedule_7_p in * . destruct HS as [T [RdyQ [tid [tcb [sp [pc [jk [T' HS]]]]]]]]. assert (H : exists RdyQ', exists tid', exists tcb', Ast_schedule_7 T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mTrue S'''). eapply Hpp'''; eauto. destruct H as [RdyQ' [tid' [tcb' HS''']]]. exists T; exists RdyQ; exists tid;exists tcb; exists sp; exists pc; exists jk;exists T'; exists RdyQ'. exists tid'; exists tcb'. trivial. (* g'' => g *) intros pc' S S'''' H. unfold conjPG, wrap_fun, conjG, linkPG in H. destruct H as [S''' [HS HS'''S'''']]. destruct HS as [HSx [S'' [H HS'']]]. destruct H as [S' [HSS' HS'S'']]. unfold L_schedule_6_g, L_schedule_7_g in * . intros mP T T' RdyQ tid tcb sp pc jk HS. assert (H : exists RdyQ', exists tid', exists tcb', Ast_schedule_7 T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S'''). eapply Hpp'''; eauto. destruct H as [RdyQ' [tid' [tcb' HS''']]]. apply HS'''S'''' with T' RdyQ' tid' tcb'; trivial. Qed. (* : addw $2, %sp *) Lemma SCAP_WFcmd_schedule_7_addw: SCAP_WFcmd (SCAP_consCT (L_schedule+7+1) (Ast L_schedule_8_p L_schedule_8_g sctag) psi_schedule) (L_schedule+7) (Ast L_schedule_7_p L_schedule_7_g sctag) (comml (_addw (Opr_imm 2 ) SP)). Proof. assert (Hpp' : forall T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S S', Ast_schedule_7 T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S -> nextS (L_schedule+7) (comml (_addw (Opr_imm 2 ) SP)) S S' -> Ast_schedule_8 T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S'). intros T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S S' HS HSS'. unfold Ast_schedule_6, Ast_schedule_8 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS as [HM [Hsp [Hspg [HT' [HRdyQ [Htcb [Hmto [Hnin HT]]]]]]]]. simplS in * . subst M' R' isr'. split. sep on. sep matchH HM with 10. sep stksplit. sep matchH HM with 2. reg simpl. unfold opr_eval. split_l. split_l by omega. repeat split_l; trivial. simpl. exists L_schedule_8_p; exists L_schedule_8_g. split_l. split. (* enable addw *) unfold enable, L_schedule_7_p. intros S H. destruct H as [T [RdyQ [tid [tcb [sp [pc [jk [T' [RdyQ' [tid' [tcb' H]]]]]]]]]]]. destruct H as [HM [Hsp [Hspg [HT' [HRdyQ [Htcb [Hmto [Hnin HT]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (R' := RF_update R SP (2 + R SP)). exists (M, R', Clear_Flag fl _ZF, isr). apply nextS_addw with 2 (R SP); auto. unfold trash_fl. right; trivial. split. (* p ==> p' *) unfold L_schedule_7_p, L_schedule_7_p. intros S' H. unfold linkPG in H. destruct H as [S H]. simpl in H. destruct H as [H HnextS]. destruct H as [T [RdyQ [tid [tcb [sp [pc [jk H]]]]]]]. destruct H as [T' [RdyQ' [tid' [tcb' HS]]]]. exists T; exists RdyQ;exists tid; exists tcb; exists sp; exists pc;exists jk;exists T';exists RdyQ'; exists tid'; exists tcb'. apply Hpp' with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[HSx HnextS] HS'S'']]. unfold L_schedule_7_g, L_schedule_8_g in * . intros. eapply HS'S''; eauto. Qed. (* : movw %ax, %bx *) Lemma SCAP_WFcmd_schedule_8_movwp : SCAP_WFcmd (SCAP_consCT (L_schedule+8+1) (Ast L_schedule_9_p L_schedule_9_g sctag) psi_schedule) (L_schedule+8) (Ast L_schedule_8_p L_schedule_8_g sctag) (comml (_movwp (Opr_reg AX) BX)). Proof. assert (Hpp' : forall T RdyQ tid tcb sp pc jk T' RdyQ' tid' tcb' mP S S', Ast_schedule_8 T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S -> nextS (L_schedule + 8) (comml (_movwp (Opr_reg AX) BX)) S S' -> Ast_schedule_9 T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S'). intros T RdyQ tid tcb sp pc jk T' RdyQ' tid' tcb' mP S S' HS HSS'. unfold Ast_schedule_8, Ast_schedule_9 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [Hax [Hsp [Hspg [HT' [HBlkQ' [HRdyQ [Hmto Hnin]]]]]]]]. subst M' R' fl' isr'. split_l. reg simpl. repeat split_l; trivial. simpl. exists L_schedule_9_p; exists L_schedule_9_g. split_l. split. (* enable movw *) unfold enable, L_schedule_8_p. intros S H. destruct H as [T [RdyQ [tid [tcb [sp [pc[ jk H]]]]]]]. destruct H as [T' [RdyQ' [tid' [tcb' HS]]]]. unfold Ast_schedule_8 in HS. destruct HS as [HM [Hax [Hsp [Hspg [HT' [HBlkQ' [HRdyQ' [Hmto Hnin]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (R' := RF_update R BX tid'). exists (M, R', fl, isr). apply nextS_movwp with tid'; auto. split. (* p ==> p' *) unfold L_schedule_9_p, L_schedule_9_p. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [tid [tcb [sp [pc [jk H]]]]]]]. destruct H as [T' [RdyQ' [tid' [tcb' HS]]]]. exists T; exists RdyQ; exists tid;exists tcb. exists sp; exists pc;exists jk; exists T'; exists RdyQ'. exists tid'; exists tcb'. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HS'S'']]. unfold L_schedule_8_g, L_schedule_9_g in * . intros. eapply HS'S''; eauto. Qed. (* : movw %ax, (curr_thrd) *) Lemma SCAP_WFcmd_schedule_9_movwst : SCAP_WFcmd (SCAP_consCT (L_schedule+9+1) (Ast L_schedule_10_p L_schedule_10_g sctag) psi_schedule) (L_schedule+9) (Ast L_schedule_9_p L_schedule_9_g sctag) (comml (_movwst (Opr_reg AX) (A_imm curr_thrd))). Proof. assert (Hpp' : forall T RdyQ tid tcb sp pc jk T' RdyQ' tid' tcb' mP S S', Ast_schedule_9 T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S -> nextS (L_schedule+9) (comml (_movwst (Opr_reg AX) (A_imm curr_thrd))) S S' -> Ast_schedule_10 T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S'). intros T RdyQ tid tcb sp pc jk T' RdyQ' tid' tcb' mP S S' HS HSS'. unfold Ast_schedule_9, Ast_schedule_10 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hlds HM']. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simpl in Hlds. simplS in * . destruct HS as [HM [Hax [Hbx [Hsp [Hspg [HT' [HBlkQ' [HRdyQ' [Htid'tcb' Htid'RdyQ']]]]]]]]]. subst M' R' fl' isr'. split. sep on. sep lift 0 in HM. sep lift 0. rewrite Hax. sep upd. sep matchH HM with 6. repeat split_l; trivial. simpl. exists L_schedule_10_p; exists L_schedule_10_g. split_l. split. (* enable movw *) unfold enable, L_schedule_9_p. intros S H. destruct H as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. destruct HS as [T' [RdyQ' [tid' [tcb' HS]]]]. destruct HS as [HM [Hax [Hbx [Hsp [Hspg [HT' [HBlkQ' [HRdyQ' [Htid'tcb' Htid'RdyQ']]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (M' := MemUpdW M curr_thrd tid' 0). exists (M', R, fl, isr). apply nextS_movwst with curr_thrd tid'; auto. sep on. sep lift 0 in HM. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* pimp *) unfold L_schedule_9_p, L_schedule_10_p. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. destruct HS as [T' [RdyQ' [tid' [tcb' HS]]]]. exists T; exists RdyQ;exists tid; exists tcb; exists sp; exists pc;exists jk. exists T'; exists RdyQ'. exists tid'; exists tcb'. apply Hpp' with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HSS']]. unfold L_schedule_9_g, L_schedule_10_g in * . intros. eapply HSS'; eauto. Qed. Lemma SCAP_WFcmd_schedule_10_movwld : SCAP_WFcmd (SCAP_consCT (L_schedule+10+1) (Ast L_schedule_11_p L_schedule_11_g sctag) psi_schedule) (L_schedule+10) (Ast L_schedule_10_p L_schedule_10_g sctag) (comml (_movwld (A_reg TCB_STACK BX) SP)). Proof. simpl. exists L_schedule_11_p; exists L_schedule_11_g. split_l. assert (Hpp' : forall T RdyQ tid tcb sp pc jk T' RdyQ' tid' tcb' mP S S', Ast_schedule_10 T T' RdyQ RdyQ' tid tid' tcb tcb' sp pc jk mP S -> nextS (L_schedule+10) (comml (_movwld (A_reg TCB_STACK BX) SP)) S S' -> Ast_schedule_11 T T' RdyQ RdyQ' tid tid' tcb tcb' sp (TCB_SP tcb') pc jk mP S'). intros T RdyQ tid tcb sp pc jk T' RdyQ' tid' tcb' mP S S' HS HSS'. unfold Ast_schedule_10, Ast_schedule_11 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [sp' [Hlds HR']]. destruct HS as [HM [Hbx [Hsp [Hspg [HT' [HH [HBlkQ' [HRdyQ' [Htid'tcb' Htid'RdyQ']]]]]]]]]. simplS in * . assert (Heq : sp' = TCB_SP tcb'). unfold addr_eval in Hlds. rewrite HT' in Hlds. unfold TCB_STACK in Hlds. destruct tcb' as [[spx' stx'] pcx']. unfold embed_TCB in HM. clear Hbx Hsp Hspg HT' HBlkQ' HRdyQ' Htid'tcb' Htid'RdyQ'. clear HSS'. subst M'. sep on. sep lift 3 in HM. substH HM with (ptoTCB_elim1 HM). destruct HM as [tst [HM Htst]]. sep lift 0 in HM. sep inj. auto. subst M' R' fl' isr'. split_l. split. reg simpl. trivial. repeat split_l; trivial. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold L_schedule_10_p in HpS. destruct HpS as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. destruct HS as [T' [RdyQ' [tid' [tcb' HS]]]]. unfold Ast_schedule_10 in HS. destruct HS as [HM [HBX [HH [HSP [Hspg [HT' [HBlkQ' [HRdyQ' [Hmto Hnin]]]]]]]]]. simplS in * . exists (M, RF_update R SP (TCB_SP tcb'), fl, isr). apply nextS_movwld with (tid' + TCB_STACK) (TCB_SP tcb'); trivial. simpl. rewrite <- Hspg; trivial. unfold TCB_STACK. unfold embed_TCB in HM. sep on. sep lift 3 in HM. substH HM with (ptoTCB_elim1 HM). destruct HM as [tst [HM Htst]]. sep lift 0 in HM. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold L_schedule_10_p, L_schedule_11_p. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [tid [tcb [sp [pc [jk HS]]]]]]]. destruct HS as [T' [RdyQ' [tid' [tcb' HS]]]]. exists T; exists RdyQ;exists tid. exists tcb; exists sp; exists pc;exists jk. exists T'; exists RdyQ'. exists tid'; exists tcb'; exists (TCB_SP tcb'). apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold L_schedule_10_g, L_schedule_11_g in * . intros. eapply HgS'S''; eauto. Qed. Lemma SCAP_WFcmd_schedule_11_retw : SCAP_WFcmd psi_schedule (L_schedule+11) (Ast L_schedule_11_p L_schedule_11_g sctag) (comms _retw). Proof. unfold L_schedule_11_g. simpl. intros S H. intros. unfold Ast_schedule_11 in H0. InvertAll. exists T'; exists RdyQ''. exists tid'; exists sp'; exists tcb'. repeat split_l. trivial. Qed. Lemma SCAP_WFiseq_scheduler : SCAP_WFiseq psi_schedule L_schedule spec_schedule I_schedule. Proof. unfold I_schedule, spec_schedule. apply scap_isq_seq with L_schedule_1_p L_schedule_1_g. apply SCAP_WFcmd_schedule_0_movwld. apply scap_isq_seq with L_schedule_2_p L_schedule_2_g. apply SCAP_WFcmd_schedule_1_movwst. assert (H : L_schedule+1+1 = L_schedule+2); [omega | rewrite H; clear H]. apply scap_isq_seq with L_schedule_3_p L_schedule_3_g. apply SCAP_WFcmd_schedule_2_pushwp. assert (H : L_schedule+2+1 = L_schedule+3); [omega | rewrite H; clear H]. apply scap_isq_seq with L_schedule_4_p L_schedule_4_g. apply SCAP_WFcmd_schedule_3_pushwp. assert (H : L_schedule+3+1 = L_schedule+4); [omega | rewrite H; clear H]. apply scap_isq_seq with L_schedule_5_p L_schedule_5_g. apply SCAP_WFcmd_schedule_4_call. assert (H : L_schedule+4+1 = L_schedule+5); [omega | rewrite H; clear H]. apply scap_isq_seq with L_schedule_6_p L_schedule_6_g. apply SCAP_WFcmd_schedule_5_addw. assert (H : L_schedule+5+1 = L_schedule+6); [omega | rewrite H; clear H]. apply scap_isq_seq with L_schedule_7_p L_schedule_7_g. apply SCAP_WFcmd_schedule_6_call. assert (H : L_schedule+6+1 = L_schedule+7); [omega | rewrite H; clear H]. apply scap_isq_seq with L_schedule_8_p L_schedule_8_g. apply SCAP_WFcmd_schedule_7_addw. assert (H : L_schedule+7+1 = L_schedule+8); [omega | rewrite H; clear H]. apply scap_isq_seq with L_schedule_9_p L_schedule_9_g. apply SCAP_WFcmd_schedule_8_movwp. assert (H : L_schedule+8+1 = L_schedule+9); [omega | rewrite H; clear H]. apply scap_isq_seq with L_schedule_10_p L_schedule_10_g. apply SCAP_WFcmd_schedule_9_movwst. assert (H : L_schedule+9+1 = L_schedule+10); [omega | rewrite H; clear H]. apply scap_isq_seq with L_schedule_11_p L_schedule_11_g. apply SCAP_WFcmd_schedule_10_movwld. assert (H : L_schedule+10+1 = L_schedule+11); [omega | rewrite H; clear H]. apply scap_isq_end. apply SCAP_WFcmd_schedule_11_retw. Qed. coq/miniOS/DeQueueProof.v0000644000107400000620000014746611000223231015007 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) (* by wangwei *) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Require Import Linking_Lemmas3. Require Import QLemmas. Require Import Reg. Require Import Assertion_Lemmas3. Require Import Assertion_Lemmas4. Require Import Kernel. Require Import DeQueueSpec. (***************************************) (* : pushw %bp *) Lemma SCAP_WFcmd_deQueue_0_pushw : SCAP_WFcmd (SCAP_consCT (L_deQueue + 1) (Ast L_deQueue_1_p L_deQueue_1_g sctag) psi_deQueue_Block0) (L_deQueue) (Ast p_deQueue g_deQueue sctag) (comml (_pushwp (Opr_reg BP))). Proof. assert (Hpp': forall T Q ptr bp sp mP S S', Ast_deQueue_pre T Q ptr bp sp mP S -> nextS (L_deQueue) (comml (_pushwp (Opr_reg BP))) S S' -> Ast_deQueue_1 T Q ptr bp sp mP S'). unfold Ast_deQueue_pre,Ast_deQueue_1. intros T Q ptr bp sp mP S S' Hp HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HSS1 [HSS2 [jk HSS3]]] [HSS4 [HSS5 HSS6]]]. destruct Hp as [Hp1 [Hp2 Hp3]]. subst M' R' fl' isr'. rewrite Hp2; rewrite Hp3. intuition. sep on. sep lift 1 in Hp1. sep lift 1. assert (MemUpdW M (sp - 2) bp jk ||- sp - 2 |->w bp *^* (sp + 2 |->w ptr *^* mP *^* ptoTQ ptr (filterTQ T Q))). sep upd. sep matchH Hp1 with 10. sep trivial. unfold MemUpdW in H. assumption. unfold SCAP_WFcmd. exists L_deQueue_1_p;exists L_deQueue_1_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [bp [sp HS]]]]]. destruct HS as [HS1 [HS2 HS3]]. exists (MemUpdW M (sp-2) bp 0, RF_update R SP (sp - 2), fl, isr). simplS in * . apply nextS_pushwp with bp. unfold opr_eval. rewrite HS2;reflexivity. unfold pushW. intuition. rewrite HS3. sep on. sep lift 1 in HS1. sep trivial. exists 0. unfold MemUpdW. rewrite HS3;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold p_deQueue, L_deQueue_1_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [bp [sp H]]]]]. exists T; exists Q; exists ptr; exists bp; exists sp. apply Hpp' with S;assumption. (* g' ==> g *) unfold g_deQueue, L_deQueue_1_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S''. apply Hpp' with S;assumption. Qed. (* : movw %sp, %bp *) Lemma SCAP_WFcmd_deQueue_1_movwp : SCAP_WFcmd (SCAP_consCT (L_deQueue + 1 + 1) (Ast L_deQueue_2_p L_deQueue_2_g sctag) psi_deQueue_Block0) (L_deQueue + 1) (Ast L_deQueue_1_p L_deQueue_1_g sctag) (comml (_movwp (Opr_reg SP) BP)). Proof. assert (Hpp': forall T Q ptr bp sp mP S S', Ast_deQueue_1 T Q ptr bp sp mP S -> nextS (L_deQueue + 1) (comml (_movwp (Opr_reg SP) BP)) S S' -> Ast_deQueue_2 T Q ptr bp sp mP S'). unfold Ast_deQueue_1,Ast_deQueue_2. intros T Q ptr bp sp mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HS1 [HS2 HS3]]. subst M' R' fl' isr'. rewrite HS2. intuition. unfold SCAP_WFcmd. exists L_deQueue_2_p;exists L_deQueue_2_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [bp [sp HS]]]]]. destruct HS as [HS1 [HS2 HS3]]. exists (M, RF_update R BP (sp - 2), fl, isr). simplS in * . apply nextS_movwp with (sp - 2);trivial. unfold opr_eval. rewrite HS2;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_1_p, L_deQueue_2_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [bp [sp H]]]]]. exists T; exists Q; exists ptr; exists bp; exists sp. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_1_g, L_deQueue_2_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S''. apply Hpp' with S;assumption. Qed. (* : movw 4(%bp), %bx *) Lemma SCAP_WFcmd_deQueue_2_movwld : SCAP_WFcmd (SCAP_consCT (L_deQueue + 2 + 1) (Ast L_deQueue_3_p L_deQueue_3_g sctag) psi_deQueue_Block0) (L_deQueue + 2) (Ast L_deQueue_2_p L_deQueue_2_g sctag) (comml (_movwld (A_reg 4 BP) BX)). Proof. assert (Hpp': forall T Q ptr bp sp mP S S', Ast_deQueue_2 T Q ptr bp sp mP S -> nextS (L_deQueue + 2) (comml (_movwld (A_reg 4 BP) BX)) S S' -> exists head, exists tail, exists prev, Ast_deQueue_3 T Q ptr bp sp head tail prev mP S'). unfold Ast_deQueue_2,Ast_deQueue_3. intros T Q ptr bp sp mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [[x [HSS2 HSS3]] [HSS4 HSS5]]]. destruct HS as [HS1 [HS2 [HS3 HS4]]]. subst M' R' fl' isr'. sep on. sep lift 0 in HS1. destruct (ptoTQ_elim1 HS1) as [head [tail [prev HS]]]. clear HS1. exists head; exists tail; exists prev. assert (E: x = ptr). rewrite HS3 in HSS2. sep on. sep lift 4 in HS. arith_rep (sp-2+4) with (sp+2) in HSS2. sep inj;auto. intuition. unfold SCAP_WFcmd. exists L_deQueue_3_p;exists L_deQueue_3_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [bp [sp HS]]]]]. destruct HS as [HS1 [HS2 [HS3 HS4]]]. exists (M, RF_update R BX ptr, fl, isr). simplS in * . apply nextS_movwld with (sp+2) ptr;trivial. unfold addr_eval. rewrite HS3;omega. sep on. sep lift 2 in HS1. sep trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_2_p, L_deQueue_3_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [bp [sp H]]]]]. exists T; exists Q; exists ptr; exists bp; exists sp. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_2_g, L_deQueue_3_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. assert (exists head : nat, exists tail : nat, exists prev : nat, Ast_deQueue_3 T Q ptr bp sp head tail prev mP S'). apply Hpp' with S;assumption. destruct H0 as [head [tail [prev H0]]]. apply HgS'S'' with head tail prev;assumption. Qed. (* : movw Q_HEAD(%bx), %dx *) Lemma SCAP_WFcmd_deQueue_3_movwld : SCAP_WFcmd (SCAP_consCT (L_deQueue + 3 + 1) (Ast L_deQueue_4_p L_deQueue_4_g sctag) psi_deQueue_Block0) (L_deQueue + 3) (Ast L_deQueue_3_p L_deQueue_3_g sctag) (comml (_movwld (A_reg Q_HEAD BX) DX)). Proof. assert (Hpp': forall T Q ptr bp sp head tail prev mP S S', Ast_deQueue_3 T Q ptr bp sp head tail prev mP S -> nextS (L_deQueue + 3) (comml (_movwld (A_reg Q_HEAD BX) DX)) S S' -> Ast_deQueue_4 T Q ptr bp sp head tail prev mP S'). unfold Ast_deQueue_3, Ast_deQueue_4. intros T Q ptr bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [[x [HSS2 HSS3]] [HSS4 HSS5]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 HS5]]]]. subst M' R' fl' isr'. assert (E: x = head). rewrite HS4 in HSS2. arith_rep (ptr + 0) with ptr in HSS2. sep on. sep lift 0 in HS1. sep inj;auto. intuition. unfold SCAP_WFcmd. exists L_deQueue_4_p; exists L_deQueue_4_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [bp [sp [head [tail [prev HS]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 HS5]]]]. exists (M, RF_update R DX head, fl, isr). simplS in * . apply nextS_movwld with ptr head;trivial. unfold addr_eval. rewrite HS4;omega. sep on. sep lift 0 in HS1. sep trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_3_p, L_deQueue_4_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [bp [sp [head [tail [prev H]]]]]]]]. exists T; exists Q; exists ptr; exists bp; exists sp. exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_3_g, L_deQueue_4_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev. apply Hpp' with S;assumption. Qed. Lemma filterTQ_add_sub_equal: forall T Q head tcb TQ', filterTQ T Q = (fun l' : nat => if eq_nat_dec head l' then Some tcb else TQ' l') -> TQ' head = None -> TQMod.maps_to T head tcb /\ filterTQ T (fun l : nat => if eq_nat_dec head l then None else Q l) = TQ'/\ Q = addThrd (fun l : nat => if eq_nat_dec head l then None else Q l) head. Proof. intros. split. assert (filterTQ T Q head = (fun l' : nat => if eq_nat_dec head l' then Some tcb else TQ' l') head). rewrite H. reflexivity. unfold filterTQ in H1. destruct (Q head); destruct (eq_nat_dec head head). unfold TQMod.maps_to. assumption. elim n; reflexivity. inversion H1. elim n; reflexivity. assert (P :forall y,(filterTQ T Q) y = (fun l' : nat => if eq_nat_dec head l' then Some tcb else TQ' l') y). rewrite H. reflexivity. clear H. split. apply TQMod.extensional_eqMap. intro x. substH P with (P x). unfold filterTQ in * . destruct (eq_nat_dec head x). subst head. rewrite H0. reflexivity. rewrite <- P. reflexivity. unfold addThrd. unfold WQMod.put. apply WQMod.extensional_eqMap. intro x. substH P with (P x). simpl in P. unfold WQMod.beq_A. unfold WQSpec.beq_Domain. unfold filterTQ in P. destruct (eq_nat_dec x head);destruct (eq_nat_dec head x); destruct (Q x). induction b; reflexivity. inversion P. induction b; reflexivity. rewrite e in n;elim n;reflexivity. rewrite e in n;elim n;reflexivity. rewrite e in n;elim n;reflexivity. reflexivity. reflexivity. Qed. Lemma Queue_T_split : forall head tail prev T Q M , M ||- Queue Thread ptoTCB head tail prev 0 (filterTQ T Q) -> head > 0 -> exists Q', exists tcb, exists next, exists next', exists tail', M ||- (ptoNode Thread ptoTCB head prev next tcb *^* Queue Thread ptoTCB next' tail' head 0 (filterTQ T Q')) /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q'/\ TQMod.maps_to T head tcb /\ (tail' = tail /\ tail' > 0 /\ next' = next \/ tail' = 0/\ tail = head /\ next' = 0 /\ next = 0). Proof. intros head tail prev T Q M HQ Hhead. substH HQ with (Queue_unemp_get HQ Hhead). destruct HQ as [TQ' [tcb [next' [next'' [tail' [HM [HQTQ' [HTQ' Htail']]]]]]]]. exists (fun l : nat => if eq_nat_dec head l then None else Q l); exists tcb; exists next'; exists next''; exists tail'. destruct (filterTQ_add_sub_equal T Q head tcb TQ' HQTQ' HTQ') as [Pmap [PTQ' PQQ']]. rewrite PTQ'. unfold WQMod.not_in_dom. destruct (eq_nat_dec head head). intuition. elim n; reflexivity. Qed. Implicit Arguments Queue_T_split [head tail prev T Q M]. Lemma Queue_T_split_1 : forall head tail prev T Q M A, M ||- (Queue Thread ptoTCB head tail prev 0 (filterTQ T Q))*^* A -> head > 0 -> exists Q', exists tcb, exists next, exists next', exists tail', M ||- (ptoNode Thread ptoTCB head prev next tcb *^* Queue Thread ptoTCB next' tail' head 0 (filterTQ T Q'))*^* A /\ Q = addThrd Q' head /\ WQMod.not_in_dom head Q'/\ TQMod.maps_to T head tcb /\ (tail' = tail /\ tail' > 0 /\ next' = next \/ tail' = 0/\ tail = head /\ next' = 0 /\ next = 0). Proof. intros. destruct H as [M1 [M2 [P1 [P2 P3]]]]. substH P2 with (Queue_T_split P2). substH P2 with (P2 H0). InvertAll. exists x; exists x0; exists x1; exists x2; exists x3. split. exists M1;exists M2;intuition. intuition. Qed. Implicit Arguments Queue_T_split_1 [head tail prev T Q M A]. (* : cmpw $0, %dx *) Lemma SCAP_WFcmd_deQueue_4_cmpw : SCAP_WFcmd (SCAP_consCT (L_deQueue + 4 + 1) (Ast L_deQueue_5_p L_deQueue_5_g sctag) psi_deQueue_Block0) (L_deQueue + 4) (Ast L_deQueue_4_p L_deQueue_4_g sctag) (comml (_cmpw (Opr_imm 0) DX)). Proof. assert (Hpp': forall T Q ptr bp sp head tail prev mP S S', Ast_deQueue_4 T Q ptr bp sp head tail prev mP S -> nextS (L_deQueue + 4) (comml (_cmpw (Opr_imm 0) DX)) S S' -> (Ast_deQueue_5_emp T Q ptr bp sp prev mP S' \/ exists Q', exists tcb, exists next, exists next', exists tail', Ast_deQueue_5_get T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S')). unfold Ast_deQueue_4, Ast_deQueue_5_emp, Ast_deQueue_5_get. intros T Q ptr bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 HS6]]]]]. destruct HSS3 as [HSS3|HSS3];destruct HSS3 as [HSS31 HSS32]. subst M' R' fl' isr'. left. rewrite <- HSS31 in HS5. subst head. intuition. sep on. sep lift 2 in HS1. assert (Tail0 := Queue_head0_tail0_1 HS1). subst tail. sep matchH HS1 with 10. right. sep on. sep lift 2 in HS1. assert (headn0 : head > 0). rewrite HS5 in HSS31. omega. destruct (Queue_T_split_1 HS1 headn0) as [Q' [tcb [next [next' [tail' [P1 [P2 [P3 [P4 P5]]]]]]]]]. exists Q'; exists tcb; exists next; exists next'; exists tail'. subst M' R' fl' isr'. split. sep on. sep matchH P1 with 10. intuition. unfold SCAP_WFcmd. exists L_deQueue_5_p; exists L_deQueue_5_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [bp [sp [head [tail [prev HS]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 HS6]]]]]. destruct (eq_nat_dec 0 head). exists (M, R,Set_Flag fl _ZF, isr). simplS in * . apply nextS_cmpw;trivial. left. intuition. simpl. rewrite <- e in HS5;auto. exists (M, R,Clear_Flag fl _ZF, isr). simplS in * . apply nextS_cmpw;trivial. right. intuition. simpl in H. apply n;rewrite <- H in HS5;auto. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_4_p, L_deQueue_5_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [bp [sp [head [tail [prev H]]]]]]]]. exists T; exists Q; exists ptr; exists bp; exists sp. exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_4_g, L_deQueue_5_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev. apply Hpp' with S;assumption. Qed. (* : jne deq_a *) Lemma SCAP_WFcmd_deQueue_5_jne : SCAP_WFcmd (SCAP_consCT (L_deQueue + 5 + 1) (Ast L_deQueue_6_p L_deQueue_6_g sctag) psi_deQueue_Block0) (L_deQueue + 5) (Ast L_deQueue_5_p L_deQueue_5_g sctag) (comml (_jne L_deQ_a)). Proof. unfold SCAP_WFcmd. exists L_deQueue_9_p; exists L_deQueue_6_p. exists L_deQueue_9_g; exists L_deQueue_6_g. split. apply psi_cons_b_lookup_a. unfold psi_deQueue_Block0. apply psi_cons_a_lookup_a. split_l. assert (Hget: forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S, Ast_deQueue_5_get T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> Ast_deQueue_9 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S). unfold Ast_deQueue_5_get, Ast_deQueue_9. intros. InvertAll. intuition. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_5_p, L_deQueue_9_p. intros S' H. unfold conjP in H. destruct H as [H1 H2]. destruct H1 as [T [Q [ptr [bp [sp [head [tail [prev H]]]]]]]]. destruct H as [P|P]. destruct P as [P1 [P2 [P3 [P4 [P5 [P6 P7]]]]]]. rewrite H2 in P6. inversion P6. destruct P as [Q' [tcb [next [next' [tail' P]]]]]. exists T; exists Q; exists Q'; exists ptr;exists tcb; exists bp. exists sp;exists head; exists tail; exists prev; exists next. exists next'; exists tail'. apply Hget;assumption. split. (* g' ==> g *) unfold L_deQueue_5_g, L_deQueue_9_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [P1 [P2 P3]]. intros T Q ptr bp sp head tail prev mP H. destruct H as [P|P]. destruct P as [P01 [P02 [P03 [P04 [P05 [P06 P07]]]]]]. rewrite P2 in P06. inversion P06. destruct P as [Q' [tcb [next [next' [tail' P]]]]]. apply P3 with Q' tcb head tail prev next next' tail'. apply Hget;assumption. assert (Hemp: forall T Q ptr bp sp prev mP S, Ast_deQueue_5_emp T Q ptr bp sp prev mP S -> Ast_deQueue_6 T Q ptr bp sp prev mP S). unfold Ast_deQueue_5_emp, Ast_deQueue_6. intros. InvertAll. intuition. split. (* p ==> p'' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_5_p, L_deQueue_6_p. intros S' H. unfold conjP in H. destruct H as [H1 H2]. destruct H1 as [T [Q [ptr [bp [sp [head [tail [prev H]]]]]]]]. destruct H as [P|P]. exists T; exists Q; exists ptr; exists bp; exists sp;exists prev. apply Hemp;assumption. destruct P as [Q' [tcb [next [next' [tail' [P1 [P2 [P3 [P4 [P5 [P6 P7]]]]]]]]]]]. rewrite H2 in P6. inversion P6. (* g'' ==> g *) unfold L_deQueue_5_g, L_deQueue_6_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [P1 [P2 P3]]. intros T Q ptr bp sp head tail prev mP H. destruct H as [P|P]. apply P3 with prev. apply Hemp;assumption. destruct P as [Q' [tcb [next [next' [tail' [P01 [P02 [P03 [P04 [P05 [P06 P07]]]]]]]]]]]. rewrite P2 in P06. inversion P06. Qed. (* : movw $0, %ax *) Lemma SCAP_WFcmd_deQueue_6_movwp : SCAP_WFcmd (SCAP_consCT (L_deQueue + 6 + 1) (Ast L_deQueue_7_p L_deQueue_7_g sctag) psi_deQueue_Block0) (L_deQueue + 6) (Ast L_deQueue_6_p L_deQueue_6_g sctag) (comml (_movwp (Opr_imm 0) AX)). Proof. assert (Hpp': forall T Q ptr bp sp prev mP S S', Ast_deQueue_6 T Q ptr bp sp prev mP S -> nextS (L_deQueue + 6) (comml (_movwp (Opr_imm 0) AX)) S S' -> Ast_deQueue_7 T Q ptr bp sp prev mP S'). unfold Ast_deQueue_6, Ast_deQueue_7. intros T Q ptr bp sp prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HS1 [HS2 HS3]]. subst M' R' fl' isr'. intuition. unfold SCAP_WFcmd. exists L_deQueue_7_p; exists L_deQueue_7_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [bp [sp [prev HS]]]]]]. destruct HS as [HS1 [HS2 HS3]]. exists (M, RF_update R AX 0, fl, isr). simplS in * . apply nextS_movwp with 0;trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_6_p, L_deQueue_7_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [bp [sp [prev H]]]]]]. exists T; exists Q; exists ptr; exists bp; exists sp; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_6_g, L_deQueue_7_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with prev. apply Hpp' with S;assumption. Qed. (* : popw %bp *) Lemma SCAP_WFcmd_deQueue_7_popw : SCAP_WFcmd (SCAP_consCT (L_deQueue + 7 + 1) (Ast L_deQueue_8_p L_deQueue_8_g sctag) psi_deQueue_Block0) (L_deQueue + 7) (Ast L_deQueue_7_p L_deQueue_7_g sctag) (comml (_popw BP)). Proof. assert (Hpp': forall T Q ptr bp sp prev mP S S', Ast_deQueue_7 T Q ptr bp sp prev mP S -> nextS (L_deQueue + 7) (comml (_popw BP)) S S' -> Ast_deQueue_8 T Q ptr bp sp prev mP S'). unfold Ast_deQueue_7, Ast_deQueue_8. intros T Q ptr bp sp prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [[x [HSS2 HSS3]] [HSS4 HSS5]]]. destruct HS as [HS1 [HS2 [HS3 HS4]]]. subst M' R' fl' isr'. assert (E : x = bp ). rewrite HS3 in HSS2. sep on. sep lift 3 in HS1. sep inj;auto. subst x. rewrite HS3. arith_rep (sp-2+2) with sp. intuition. sep on. sep matchH HS1 with 10. arith_rep sp with ((sp-2)+2). assert (h ||- ptoxW (sp-2)). sep trivial. sep trivial. unfold SCAP_WFcmd. exists L_deQueue_8_p; exists L_deQueue_8_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [bp [sp [prev HS]]]]]]. destruct HS as [HS1 [HS2 [HS3 HS4]]]. exists (M, RF_update (RF_update R SP sp) BP bp, fl, isr). simplS in * . apply nextS_popw with (RF_update R SP sp) bp;trivial. unfold popW. rewrite HS3;intuition. sep on. sep lift 3 in HS1;sep trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_7_p, L_deQueue_8_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [bp [sp [prev H]]]]]]. exists T; exists Q; exists ptr; exists bp; exists sp; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_7_g, L_deQueue_8_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with prev. apply Hpp' with S;assumption. Qed. (* : retw *) Lemma SCAP_WFcmd_deQueue_8_retw : SCAP_WFcmd psi_deQueue_Block0 (L_deQueue+8) (Ast L_deQueue_8_p L_deQueue_8_g sctag) (comms _retw). Proof. unfold L_deQueue_8_g. simpl. intros S H. intros. unfold Ast_deQueue_8 in H0. InvertAll. left. sep on. split. sep lift 2 in H1. destruct (Queue_ptr0_emp_1 H1). rewrite H6. trivial. unfold Ast_deQueue_post_a. intuition. sep on. sep lift 0. apply ptoTQ_intro1 with 0 0 prev. sep matchH H1 with 10. Qed. (* : movw %bx, %cx *) Lemma SCAP_WFcmd_deQueue_9_movwp : SCAP_WFcmd (SCAP_consCT (L_deQueue + 9 + 1) (Ast L_deQueue_10_p L_deQueue_10_g sctag) psi_deQueue_Block1) (L_deQueue + 9) (Ast L_deQueue_9_p L_deQueue_9_g sctag) (comml (_movwp (Opr_reg BX) CX)). Proof. assert (Hpp': forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S', Ast_deQueue_9 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> nextS (L_deQueue + 9) (comml (_movwp (Opr_reg BX) CX)) S S' -> Ast_deQueue_10 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S'). unfold Ast_deQueue_9, Ast_deQueue_10. intros T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 [HS9 [HS10 HS11]]]]]]]]]]. subst M' R' fl' isr'. intuition. unfold SCAP_WFcmd. exists L_deQueue_10_p; exists L_deQueue_10_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' HS]]]]]]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [ HS5 [HS6 [HS7 [HS8 [HS9 [HS10 HS11]]]]]]]]]]. exists (M, RF_update R CX ptr, fl, isr). simplS in * . apply nextS_movwp with ptr;trivial. unfold opr_eval. rewrite HS4;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_9_p, L_deQueue_10_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' H]]]]]]]]]]]]]. exists T; exists Q; exists Q'; exists ptr; exists tcb; exists bp. exists sp; exists head; exists tail; exists prev; exists next. exists next'; exists tail'. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_9_g, L_deQueue_10_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with Q' tcb head tail prev next next' tail'. apply Hpp' with S;assumption. Qed. (* : movw %dx, %bx *) Lemma SCAP_WFcmd_deQueue_10_movwp : SCAP_WFcmd (SCAP_consCT (L_deQueue + 10 + 1) (Ast L_deQueue_11_p L_deQueue_11_g sctag) psi_deQueue_Block1) (L_deQueue + 10) (Ast L_deQueue_10_p L_deQueue_10_g sctag) (comml (_movwp (Opr_reg DX) BX)). Proof. assert (Hpp': forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S', Ast_deQueue_10 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> nextS (L_deQueue + 10) (comml (_movwp (Opr_reg DX) BX)) S S' -> Ast_deQueue_11 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S'). unfold Ast_deQueue_10, Ast_deQueue_11. intros T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 [HS9 [HS10 HS11]]]]]]]]]]. subst M' R' fl' isr'. intuition. unfold SCAP_WFcmd. exists L_deQueue_11_p; exists L_deQueue_11_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' HS]]]]]]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [ HS5 [HS6 [HS7 [HS8 [HS9 [HS10 HS11]]]]]]]]]]. exists (M, RF_update R BX head, fl, isr). simplS in * . apply nextS_movwp with head;trivial. unfold opr_eval. rewrite HS5;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_10_p, L_deQueue_11_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' H]]]]]]]]]]]]]. exists T; exists Q; exists Q'; exists ptr; exists tcb; exists bp. exists sp; exists head; exists tail; exists prev; exists next. exists next'; exists tail'. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_10_g, L_deQueue_11_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with Q' tcb head tail prev next next' tail'. apply Hpp' with S;assumption. Qed. (* : movw ND_NEXT(%bx), %dx *) Lemma SCAP_WFcmd_deQueue_11_movwld : SCAP_WFcmd (SCAP_consCT (L_deQueue + 11 + 1) (Ast L_deQueue_12_p L_deQueue_12_g sctag) psi_deQueue_Block1) (L_deQueue + 11) (Ast L_deQueue_11_p L_deQueue_11_g sctag) (comml (_movwld (A_reg ND_NEXT BX) DX)). Proof. assert (Hpp': forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S', Ast_deQueue_11 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> nextS (L_deQueue + 11) (comml (_movwld (A_reg ND_NEXT BX) DX)) S S' -> Ast_deQueue_12 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S'). unfold Ast_deQueue_11, Ast_deQueue_12. intros T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [[x [HSS2 HSS3]] [HSS4 HSS5]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 [HS9 [HS10 HS11]]]]]]]]]]. subst M' R' fl' isr'. unfold ptoNode in HS1. assert (E : x = next). sep on. sep lift 3 in HS1. rewrite HS2 in HSS2. sep inj;auto. subst x. split. sep on. sep matchH HS1 with 10. intuition. unfold SCAP_WFcmd. exists L_deQueue_12_p; exists L_deQueue_12_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' HS]]]]]]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [ HS5 [HS6 [HS7 [HS8 [HS9 [HS10 HS11]]]]]]]]]]. exists (M, RF_update R DX next, fl, isr). simplS in * . apply nextS_movwld with (head+2) next;trivial. unfold addr_eval. rewrite HS2;reflexivity. sep on. unfold ptoNode in HS1. sep lift 3 in HS1. sep trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_11_p, L_deQueue_12_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' H]]]]]]]]]]]]]. exists T; exists Q; exists Q'; exists ptr; exists tcb; exists bp. exists sp; exists head; exists tail; exists prev; exists next. exists next'; exists tail'. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_11_g, L_deQueue_12_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with Q' tcb head tail prev next next' tail'. apply Hpp' with S;assumption. Qed. (* : movw %bx, %ax *) Lemma SCAP_WFcmd_deQueue_12_movwp : SCAP_WFcmd (SCAP_consCT (L_deQueue + 12 + 1) (Ast L_deQueue_13_p L_deQueue_13_g sctag) psi_deQueue_Block1) (L_deQueue + 12) (Ast L_deQueue_12_p L_deQueue_12_g sctag) (comml (_movwp (Opr_reg BX) AX)). Proof. assert (Hpp': forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S', Ast_deQueue_12 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> nextS (L_deQueue + 12) (comml (_movwp (Opr_reg BX) AX)) S S' -> Ast_deQueue_13 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S'). unfold Ast_deQueue_12, Ast_deQueue_13. intros T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 [HS9 [HS10 HS11]]]]]]]]]]. subst M' R' fl' isr'. intuition. unfold SCAP_WFcmd. exists L_deQueue_13_p; exists L_deQueue_13_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' HS]]]]]]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [ HS5 [HS6 [HS7 [HS8 [HS9 [HS10 HS11]]]]]]]]]]. exists (M, RF_update R AX head, fl, isr). simplS in * . apply nextS_movwp with head;trivial. unfold opr_eval. rewrite HS3;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_12_p, L_deQueue_13_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' H]]]]]]]]]]]]]. exists T; exists Q; exists Q'; exists ptr; exists tcb; exists bp. exists sp; exists head; exists tail; exists prev; exists next. exists next'; exists tail'. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_12_g, L_deQueue_13_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with Q' tcb head tail prev next next' tail'. apply Hpp' with S;assumption. Qed. (* : movw %cx, %bx *) Lemma SCAP_WFcmd_deQueue_13_movwp : SCAP_WFcmd (SCAP_consCT (L_deQueue + 13 + 1) (Ast L_deQueue_14_p L_deQueue_14_g sctag) psi_deQueue_Block1) (L_deQueue + 13) (Ast L_deQueue_13_p L_deQueue_13_g sctag) (comml (_movwp (Opr_reg CX) BX)). Proof. assert (Hpp': forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S', Ast_deQueue_13 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> nextS (L_deQueue + 13) (comml (_movwp (Opr_reg CX) BX)) S S' -> Ast_deQueue_14 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S'). unfold Ast_deQueue_13, Ast_deQueue_14. intros T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 [HS9 [HS10 [HS11 HS12]]]]]]]]]]]. subst M' R' fl' isr'. intuition. unfold SCAP_WFcmd. exists L_deQueue_14_p; exists L_deQueue_14_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' HS]]]]]]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [ HS5 [HS6 [HS7 [HS8 [HS9 [HS10 [HS11 HS12]]]]]]]]]]]. exists (M, RF_update R BX ptr, fl, isr). simplS in * . apply nextS_movwp with ptr;trivial. unfold opr_eval. rewrite HS4;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_13_p, L_deQueue_14_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' H]]]]]]]]]]]]]. exists T; exists Q; exists Q'; exists ptr; exists tcb; exists bp. exists sp; exists head; exists tail; exists prev; exists next. exists next'; exists tail'. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_13_g, L_deQueue_14_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with Q' tcb head tail prev next next' tail'. apply Hpp' with S;assumption. Qed. (* : cmpw $0, %dx *) Lemma SCAP_WFcmd_deQueue_14_cmpw : SCAP_WFcmd (SCAP_consCT (L_deQueue + 14 + 1) (Ast L_deQueue_15_p L_deQueue_15_g sctag) psi_deQueue_Block1) (L_deQueue + 14) (Ast L_deQueue_14_p L_deQueue_14_g sctag) (comml (_cmpw (Opr_imm 0) DX)). Proof. assert (Hpp': forall T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S', Ast_deQueue_14 T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S -> nextS (L_deQueue + 14) (comml (_cmpw (Opr_imm 0) DX)) S S' -> (Ast_deQueue_15_emp T Q Q' ptr tcb bp sp head tail prev mP S' \/ exists next'', Ast_deQueue_15_get T Q Q' ptr tcb bp sp head tail prev next'' mP S')). unfold Ast_deQueue_14, Ast_deQueue_15_emp, Ast_deQueue_15_get. intros T Q Q' ptr tcb bp sp head tail prev next next' tail' mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 [HS9 [HS10 [HS11 HS12]]]]]]]]]]]. destruct HSS3 as [HSS3|HSS3];destruct HSS3 as [HSS31 HSS32]. subst M' R' fl' isr'. left. rewrite <- HSS31 in HS4. subst next. destruct HS12 as [[P1 [P2 P3]] |[P1 [P2 [P3 P4]]]]. subst tail' next'. sep on. sep lift 5 in HS1. assert (P := Queue_head0_tail0_1 HS1). rewrite P in P2;inversion P2. subst tail' tail next'. intuition. right. destruct HS12 as [[P1 [P2 P3]] |[P1 [P2 [P3 P4]]]]. exists next. subst M' R' fl' isr' next' tail'. intuition. rewrite HS4 in HSS31;rewrite P4 in HSS31; elim HSS31;reflexivity. unfold SCAP_WFcmd. exists L_deQueue_15_p; exists L_deQueue_15_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' HS]]]]]]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 [HS9 [HS10 [HS11 HS12]]]]]]]]]]]. destruct (eq_nat_dec 0 next). exists (M, R,Set_Flag fl _ZF, isr). simplS in * . apply nextS_cmpw;trivial. left. split. simpl. rewrite <- e in HS4;auto. auto. exists (M, R,Clear_Flag fl _ZF, isr). simplS in * . apply nextS_cmpw;trivial. right. intuition. simpl in H. apply n;rewrite <- H1 in HS4;auto. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_14_p, L_deQueue_15_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev [next [next' [tail' H]]]]]]]]]]]]]. exists T; exists Q; exists Q'; exists ptr; exists tcb; exists bp; exists sp. exists head; exists tail; exists prev. apply Hpp' with next next' tail' S; assumption. (* g' ==> g *) unfold L_deQueue_14_g, L_deQueue_15_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with Q' tcb head tail prev. apply Hpp' with next next' tail' S;assumption. Qed. (* : jne deq_b *) Lemma SCAP_WFcmd_deQueue_15_jne : SCAP_WFcmd (SCAP_consCT (L_deQueue + 15 + 1) (Ast L_deQueue_16_p L_deQueue_16_g sctag) psi_deQueue_Block1) (L_deQueue + 15) (Ast L_deQueue_15_p L_deQueue_15_g sctag) (comml (_jne L_deQ_b)). Proof. unfold SCAP_WFcmd. exists L_deQueue_17_p; exists L_deQueue_16_p. exists L_deQueue_17_g; exists L_deQueue_16_g. split. apply psi_cons_b_lookup_a. unfold psi_deQueue_Block1. apply psi_cons_a_lookup_a. split_l. assert (Hget: forall T Q Q' ptr tcb bp sp head tail prev next mP S, Ast_deQueue_15_get T Q Q' ptr tcb bp sp head tail prev next mP S -> Ast_deQueue_17 T Q Q' ptr tcb bp sp head prev next tail mP S). unfold Ast_deQueue_15_get, Ast_deQueue_17. intros. InvertAll. intuition. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_15_p, L_deQueue_17_p. intros S' H. unfold conjP in H. destruct H as [H1 H2]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. destruct H as [P|P]. destruct P as [P1 [P2 [P3 [P4 [P5 [P6 [P7 P8]]]]]]]. rewrite H2 in P7. inversion P7. destruct P as [next P]. exists T; exists Q; exists Q'; exists ptr;exists tcb; exists bp. exists sp;exists head; exists prev; exists next; exists tail. apply Hget;assumption. split. (* g' ==> g *) unfold L_deQueue_15_g, L_deQueue_17_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [P1 [P2 P3]]. intros T Q Q' ptr tcb bp sp head tail prev mP H. destruct H as [P|P]. destruct P as [P01 [P02 [P03 [P04 [P05 [P06 [P07 P08]]]]]]]. rewrite P2 in P07. inversion P07. destruct P as [next P]. apply P3 with Q' tcb head prev next tail. apply Hget;assumption. assert (Hemp: forall T Q Q' ptr tcb bp sp head tail prev mP S, Ast_deQueue_15_emp T Q Q' ptr tcb bp sp head tail prev mP S -> Ast_deQueue_16 T Q Q' ptr tcb bp sp head tail prev mP S). unfold Ast_deQueue_15_emp, Ast_deQueue_16. intros. InvertAll. intuition. split. (* p ==> p'' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_15_p, L_deQueue_16_p. intros S' H. unfold conjP in H. destruct H as [H1 H2]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. destruct H as [P|P]. exists T; exists Q; exists Q'; exists ptr; exists tcb; exists bp; exists sp. exists head; exists tail; exists prev. apply Hemp;assumption. destruct P as [next [P1 [P2 [P3 [P4 [P5 [P6 [P7 P8]]]]]]]]. rewrite H2 in P7. inversion P7. (* g'' ==> g *) unfold L_deQueue_15_g, L_deQueue_16_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [P1 [P2 P3]]. intros T Q Q' ptr tcb bp sp head tail prev mP H. destruct H as [P|P]. apply P3 with Q' tcb head tail prev. apply Hemp;assumption. destruct P as [next [P01 [P02 [P03 [P04 [P05 [P06 [P07 P08]]]]]]]]. rewrite P2 in P07. inversion P07. Qed. (* : movw %dx, Q_TAIL(%bx) *) Lemma SCAP_WFcmd_deQueue_16_movwst : SCAP_WFcmd (SCAP_consCT (L_deQueue + 16 + 1) (Ast L_deQueue_17_p L_deQueue_17_g sctag) psi_deQueue_Block1) (L_deQueue + 16) (Ast L_deQueue_16_p L_deQueue_16_g sctag) (comml (_movwst (Opr_reg DX) (A_reg Q_TAIL BX))). Proof. assert (Hpp': forall T Q Q' ptr tcb bp sp head tail prev mP S S', Ast_deQueue_16 T Q Q' ptr tcb bp sp head tail prev mP S -> nextS (L_deQueue + 16) (comml (_movwst (Opr_reg DX)(A_reg Q_TAIL BX))) S S' -> Ast_deQueue_17 T Q Q' ptr tcb bp sp head prev 0 0 mP S'). unfold Ast_deQueue_16, Ast_deQueue_17. intros T Q Q' ptr tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HSS1 [jk HSS2]] [HSS3 [HSS4 HSS5]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 [HS9 HS10]]]]]]]]]. subst M' R' fl' isr'. intuition. sep on. assert (MemUpdW M (ptr + 2) 0 jk ||- ptr |->w head *^* ptr + 2 |->w 0 *^* head |->w prev *^* head + 2 |->w 0 *^* ptoTCB (head + 4) tcb *^* Queue Thread ptoTCB 0 0 head 0 (filterTQ T Q') *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP). sep lift 1. sep upd. sep matchH HS1 with 10. unfold MemUpdW in H. rewrite HS2; rewrite HS4. assumption. unfold SCAP_WFcmd. exists L_deQueue_17_p; exists L_deQueue_17_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [ HS5 [HS6 [HS7 [HS8 [HS9 HS10]]]]]]]]]. exists (MemUpdW M (ptr+2) 0 0, R, fl, isr). simplS in * . apply nextS_movwst with (ptr+2) 0;trivial. unfold addr_eval. rewrite HS2;reflexivity. simpl;auto. sep on. sep lift 1 in HS1. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_16_p, L_deQueue_17_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists Q'; exists ptr; exists tcb; exists bp. exists sp; exists head; exists prev; exists 0;exists 0. apply Hpp' with tail S; assumption. (* g' ==> g *) unfold L_deQueue_16_g, L_deQueue_17_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with Q' tcb head prev 0 0. apply Hpp' with tail S;assumption. Qed. (* : movw %dx, Q_HEAD(%bx) *) Lemma SCAP_WFcmd_deQueue_17_movwst : SCAP_WFcmd (SCAP_consCT (L_deQueue + 17 + 1) (Ast L_deQueue_18_p L_deQueue_18_g sctag) psi_deQueue_Block1) (L_deQueue + 17) (Ast L_deQueue_17_p L_deQueue_17_g sctag) (comml (_movwst (Opr_reg DX) (A_reg Q_HEAD BX))). Proof. assert (Hpp': forall T Q Q' ptr tcb bp sp head prev head' tail' mP S S', Ast_deQueue_17 T Q Q' ptr tcb bp sp head prev head' tail' mP S -> nextS (L_deQueue + 17) (comml (_movwst (Opr_reg DX)(A_reg Q_HEAD BX))) S S' -> Ast_deQueue_18 T Q Q' ptr tcb bp sp head prev head' tail' mP S'). unfold Ast_deQueue_17, Ast_deQueue_18. intros T Q Q' ptr tcb bp sp head prev head' tail' mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HSS1 [jk HSS2]] [HSS3 [HSS4 HSS5]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 [HS9 HS10]]]]]]]]]. subst M' R' fl' isr'. intuition. sep on. assert (MemUpdW M ptr head' jk ||- ptr |->w head' *^* ptr + 2 |->w tail' *^* head |->w prev *^* head + 2 |->w head' *^* ptoTCB (head + 4) tcb *^* Queue Thread ptoTCB head' tail' head 0 (filterTQ T Q') *^* sp - 2 |->w bp *^* sp + 2 |->w ptr *^* mP). sep lift 0. sep upd. sep matchH HS1 with 10. unfold MemUpdW in H. rewrite HS2; rewrite HS4. arith_rep (ptr+0) with ptr. unfold SCAP_WFcmd. exists L_deQueue_18_p; exists L_deQueue_18_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [Q' [ptr [tcb [bp [sp [head [prev [head' [tail' HS]]]]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [ HS5 [HS6 [HS7 [HS8 [HS9 HS10]]]]]]]]]. exists (MemUpdW M ptr head' 0, R, fl, isr). simplS in * . apply nextS_movwst with ptr head';trivial. unfold addr_eval. rewrite HS2;auto. simpl;auto. sep on. sep lift 0 in HS1. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_17_p, L_deQueue_18_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [prev [head' [tail' H]]]]]]]]]]]. exists T; exists Q; exists Q'; exists ptr; exists tcb; exists bp. exists sp; exists head; exists prev; exists head';exists tail'. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_17_g, L_deQueue_18_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with Q' tcb head prev head' tail'. apply Hpp' with S;assumption. Qed. (* : popw %bp *) Lemma SCAP_WFcmd_deQueue_18_popw : SCAP_WFcmd (SCAP_consCT (L_deQueue + 18 + 1) (Ast L_deQueue_19_p L_deQueue_19_g sctag) psi_deQueue_Block1) (L_deQueue + 18) (Ast L_deQueue_18_p L_deQueue_18_g sctag) (comml (_popw BP)). Proof. assert (Hpp': forall T Q Q' ptr tcb bp sp head prev head' tail' mP S S', Ast_deQueue_18 T Q Q' ptr tcb bp sp head prev head' tail' mP S -> nextS (L_deQueue + 18) (comml (_popw BP)) S S' -> Ast_deQueue_19 T Q Q' ptr tcb bp sp head prev head' tail' mP S'). unfold Ast_deQueue_18, Ast_deQueue_19. intros T Q Q' ptr tcb bp sp head prev head' tail' mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [[x [HSS2 HSS3]] [HSS4 HSS5]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 HS9]]]]]]]]. subst M' R' fl' isr'. assert (E : x = bp ). rewrite HS4 in HSS2. sep on. sep lift 6 in HS1. sep inj;auto. subst x. rewrite HS4. arith_rep (sp-2+2) with sp. intuition. sep on. sep matchH HS1 with 10. arith_rep sp with ((sp-2)+2). assert (h ||- ptoxW (sp-2)). sep trivial. sep trivial. unfold SCAP_WFcmd. exists L_deQueue_19_p; exists L_deQueue_19_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [Q' [ptr [tcb [bp [sp [head [prev [head' [tail' HS]]]]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 [HS7 [HS8 HS9]]]]]]]]. exists (M, RF_update (RF_update R SP sp) BP bp, fl, isr). simplS in * . apply nextS_popw with (RF_update R SP sp) bp;trivial. unfold popW. rewrite HS4;intuition. sep on. sep lift 6 in HS1;sep trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_deQueue_18_p, L_deQueue_19_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [Q' [ptr [tcb [bp [sp [head [prev [head' [tail' HS]]]]]]]]]]]. exists T; exists Q; exists Q'; exists ptr; exists tcb; exists bp. exists sp; exists head; exists prev; exists head'; exists tail'. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_deQueue_18_g, L_deQueue_19_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with Q' tcb head prev head' tail'. apply Hpp' with S;assumption. Qed. (* : retw *) Lemma SCAP_WFcmd_deQueue_19_retw : SCAP_WFcmd psi_deQueue_Block1 (L_deQueue+19) (Ast L_deQueue_19_p L_deQueue_19_g sctag) (comms _retw). Proof. unfold L_deQueue_19_g. simpl. intros S H. intros. unfold Ast_deQueue_19 in H0. InvertAll. right. exists Q'; exists head; exists tcb. repeat split_l. unfold embed_TCB. sep on. sep lift 3. apply ptoTQ_intro1 with head' tail' head. sep matchH H1 with 10. assumption. trivial. Qed. Lemma SCAP_WFiseq_deQueue_Block0 : SCAP_WFiseq psi_deQueue_Block0 L_deQueue spec_deQueue I_deQueue. Proof. unfold I_deQueue, spec_deQueue. apply scap_isq_seq with L_deQueue_1_p L_deQueue_1_g. apply SCAP_WFcmd_deQueue_0_pushw. apply scap_isq_seq with L_deQueue_2_p L_deQueue_2_g. apply SCAP_WFcmd_deQueue_1_movwp. assert (H : L_deQueue+1+1 = L_deQueue+2); [omega | rewrite H; clear H]. apply scap_isq_seq with L_deQueue_3_p L_deQueue_3_g. apply SCAP_WFcmd_deQueue_2_movwld. assert (H : L_deQueue+2+1 = L_deQueue+3); [omega | rewrite H; clear H]. apply scap_isq_seq with L_deQueue_4_p L_deQueue_4_g. apply SCAP_WFcmd_deQueue_3_movwld. assert (H : L_deQueue+3+1 = L_deQueue+4); [omega | rewrite H; clear H]. apply scap_isq_seq with L_deQueue_5_p L_deQueue_5_g. apply SCAP_WFcmd_deQueue_4_cmpw. assert (H : L_deQueue+4+1 = L_deQueue+5); [omega | rewrite H; clear H]. apply scap_isq_seq with L_deQueue_6_p L_deQueue_6_g. apply SCAP_WFcmd_deQueue_5_jne. assert (H : L_deQueue+5+1 = L_deQueue+6); [omega | rewrite H; clear H]. apply scap_isq_seq with L_deQueue_7_p L_deQueue_7_g. apply SCAP_WFcmd_deQueue_6_movwp. assert (H : L_deQueue+6+1 = L_deQueue+7); [omega | rewrite H; clear H]. apply scap_isq_seq with L_deQueue_8_p L_deQueue_8_g. apply SCAP_WFcmd_deQueue_7_popw. assert (H : L_deQueue+7+1 = L_deQueue+8); [omega | rewrite H; clear H]. apply scap_isq_end. apply SCAP_WFcmd_deQueue_8_retw. Qed. Lemma SCAP_WFiseq_deQueue_Block1 : SCAP_WFiseq psi_deQueue_Block1 L_deQ_a (Ast L_deQueue_9_p L_deQueue_9_g sctag) I_deQ_a. Proof. unfold I_deQ_a, L_deQ_a. apply scap_isq_seq with L_deQueue_10_p L_deQueue_10_g. apply SCAP_WFcmd_deQueue_9_movwp. apply scap_isq_seq with L_deQueue_11_p L_deQueue_11_g. arith_rep (L_deQueue + 9 + 1) with (L_deQueue + 10). apply SCAP_WFcmd_deQueue_10_movwp. apply scap_isq_seq with L_deQueue_12_p L_deQueue_12_g. arith_rep (L_deQueue + 9 + 1 + 1) with (L_deQueue + 11). apply SCAP_WFcmd_deQueue_11_movwld. apply scap_isq_seq with L_deQueue_13_p L_deQueue_13_g. arith_rep (L_deQueue + 9 + 1 + 1 + 1) with (L_deQueue + 12). apply SCAP_WFcmd_deQueue_12_movwp. apply scap_isq_seq with L_deQueue_14_p L_deQueue_14_g. arith_rep (L_deQueue + 9 + 1 + 1+ 1 + 1) with (L_deQueue + 13). apply SCAP_WFcmd_deQueue_13_movwp. apply scap_isq_seq with L_deQueue_15_p L_deQueue_15_g. arith_rep (L_deQueue + 9 + 1 + 1+ 1 + 1 +1) with (L_deQueue + 14). apply SCAP_WFcmd_deQueue_14_cmpw. apply scap_isq_seq with L_deQueue_16_p L_deQueue_16_g. arith_rep (L_deQueue + 9 + 1 + 1+ 1 + 1 +1+1) with (L_deQueue + 15). apply SCAP_WFcmd_deQueue_15_jne. apply scap_isq_seq with L_deQueue_17_p L_deQueue_17_g. arith_rep (L_deQueue + 9 + 1 + 1+ 1 + 1 +1+1+1) with (L_deQueue + 16). apply SCAP_WFcmd_deQueue_16_movwst. apply scap_isq_seq with L_deQueue_18_p L_deQueue_18_g. arith_rep (L_deQueue + 9 + 1 + 1+ 1 + 1 +1+1+1+1) with (L_deQueue + 17). apply SCAP_WFcmd_deQueue_17_movwst. apply scap_isq_seq with L_deQueue_19_p L_deQueue_19_g. arith_rep (L_deQueue + 9 + 1 + 1+ 1 + 1 +1+1+1+1+1) with (L_deQueue + 18). apply SCAP_WFcmd_deQueue_18_popw. arith_rep (L_deQueue + 9 + 1 + 1+ 1 + 1 +1+1+1+1+1+1) with (L_deQueue + 19). apply scap_isq_end. apply SCAP_WFcmd_deQueue_19_retw. Qed. coq/miniOS/Kernel.v0000644000107400000620000002564511000223231013656 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath ".." . Add LoadPath "../CAP0" . Add LoadPath "../SCAP" . Require Import Machine. Require Import Operational_Semantics. Require Import AIM. Notation Local " i ; I " := (seq i I) (at level 60, right associativity). Notation Local " i ;; " := (sseq i) (at level 60). (** Thread Control Block constructure **) Definition TCB_STATUS : nat := 6. Definition TCB_STACK : nat := 4. Notation TCB_PREV := 0. Notation TCB_NEXT := 2. (** Queue and node fields **) Notation Q_HEAD := 0. Notation Q_TAIL := 2. Notation ND_PREV := 0. Notation ND_NEXT := 2. (* Notation _STK_SIZE_unblock := 10 (only parsing). *) (* Notation _STK_SIZE_swith := 8 (only parsing). *) (* Notation _STK_SIZE_block := 10 (only parsing). *) (** Functioon: scheduler, system thread scheduler**) (********Source Code *************************** # precondition requires that interrupt be disabled 1146 : movw (curr_thrd), %bx movw %sp, TCB_STACK(%bx) pushw $readyQ pushw %bx 1150: call enQueue (L_enQueue) 1151: addw $2, %sp 1152: call deQueue (L_deQueue) 1153: addw $2, %sp movw %ax, %bx movw %ax, (curr_thrd) movw TCB_STACK(%bx), %sp 1157: retw # precondition requires that interrupt be disabled # block(q) 1158 : movw (curr_thrd), %bx #curr_thrd = 2254 movw $BLOCKED, TCB_STATUS(%bx) 1160 movw %sp, TCB_STACK(%bx) movw %sp, %bp movw 2(%bp), %ax pushw %ax #BlockQ pushw %bx 1165 call enQueue (1190) pushw $readyQ #readyQ = 2250 call deQueue (1212) # note that we can always find a thread in the readyQ # because our program logic guarantees the idle thread # will never be blocked. So the idle thread must always # be in the ready queue at this moment addw $6, %sp movw %ax, %bx 1170 movw %ax, (curr_thrd) movw TCB_STACK(%bx), %sp 1172 retw # unblock(q) 1173: pushw %bp movw %sp, %bp 1175: movw 4(%bp), %bx # the pointer to the block queue pushw %bx call deQueue # not change bp addw $2, %sp cmpw $0, %ax 1180: jne wakeup popw %bp retw # block_done 1183:wakeup: movw %ax, %bx movw $READY, TCB_STATUS(%bx) 1185: pushw $readyQ pushw %bx call enQueue popw %ax addw $2, %sp 1190: popw %bp retw 1190 : pushw %bp movw %sp, %bp movw 4(%bp), %ax # ax: pointer to node movw 6(%bp), %bx # bx: pointer to Q movw Q_TAIL(%bx), %dx 1195: movw %bx, %cx # save bx movw %ax, %bx movw %dx, ND_PREV(%bx) movw $0, ND_NEXT(%bx) cmpw $0, %dx 1200: jne not_null movw %cx, %bx # bx: pointers to Q movw %ax, Q_HEAD(%bx) # head = newtcb movw %ax, Q_TAIL(%bx) popw %bp retw 1206: : movw %dx, %bx movw %ax, ND_NEXT(%bx) movw %cx, %bx # bx: pointers to Q movw %ax, Q_TAIL(%bx) 1210: popw %bp retw 1212 : # Block0 pushw %bp movw %sp, %bp movw 4(%bp), %bx # bx: pointer to Q 1215: movw Q_HEAD(%bx), %dx # dx: head cmpw $0, %dx jne deq_a movw $0, %ax # return value popw %bp 1220: retw 1221: : # Block1 movw %bx, %cx # save bx movw %dx, %bx movw ND_NEXT(%bx), %dx movw %bx, %ax # return value 1225: movw %cx, %bx # bx: pointer to Q cmpw $0, %dx jne deq_b movw %dx, Q_TAIL(%bx) 1229: : # Block2: movw %dx, Q_HEAD(%bx) popw %bp retw ************************************************) (** Instruction Label **) Parameter L_enQueue: Label. Definition L_enQ_NotNull := L_enQueue + 16. Parameter L_deQueue: Label. Definition L_deQ_a := L_deQueue + 9. Definition L_deQ_b := L_deQueue + 17. Definition L_schedule: Label := _SWITCH. Definition L_block : Label := _BLOCK. Definition L_unblock : Label := _UNBLK. Definition L_wakeup := L_unblock +1+1+1+1 +1+1+1+1 +1+1. (** Instruction sequence **) Definition I_enQueue := (seq (_pushwp (Opr_reg BP)) (seq (_movwp (Opr_reg SP) BP) (seq (_movwld (A_reg 4 BP) AX) (seq (_movwld (A_reg 6 BP) BX) (seq (_movwld (A_reg Q_TAIL BX) DX) (seq (_movwp (Opr_reg BX) CX) (seq (_movwp (Opr_reg AX) BX) (seq (_movwst (Opr_reg DX) (A_reg ND_PREV BX)) (seq (_movwst (Opr_imm 0 ) (A_reg ND_NEXT BX)) (seq (_cmpw (Opr_imm 0 ) DX) (seq (_jne L_enQ_NotNull) (seq (_movwp (Opr_reg CX) BX) (seq (_movwst (Opr_reg AX) (A_reg Q_HEAD BX)) (seq (_movwst (Opr_reg AX) (A_reg Q_TAIL BX)) (seq (_popw BP) (sseq (_retw))))))))))))))))). Definition I_enQ_NotNull := (seq (_movwp (Opr_reg DX) BX) (seq (_movwst (Opr_reg AX) (A_reg ND_NEXT BX)) (seq (_movwp (Opr_reg CX) BX) (seq (_movwst (Opr_reg AX) (A_reg Q_TAIL BX)) (seq (_popw BP) (sseq (_retw))))))). (*********************************************) Definition I_deQueue := (seq (_pushwp (Opr_reg BP)) (seq (_movwp (Opr_reg SP) BP) (seq (_movwld (A_reg 4 BP) BX) (seq (_movwld (A_reg Q_HEAD BX) DX) (seq (_cmpw (Opr_imm 0 ) DX) (seq (_jne L_deQ_a) (seq (_movwp (Opr_imm 0 ) AX) (seq (_popw BP) (sseq (_retw)))))))))). Definition I_deQ_a := (seq (_movwp (Opr_reg BX) CX) (seq (_movwp (Opr_reg DX) BX) (seq (_movwld (A_reg ND_NEXT BX) DX) (seq (_movwp (Opr_reg BX) AX) (seq (_movwp (Opr_reg CX) BX) (seq (_cmpw (Opr_imm 0 ) DX) (seq (_jne L_deQ_b) (seq (_movwst (Opr_reg DX) (A_reg Q_TAIL BX)) (seq (_movwst (Opr_reg DX) (A_reg Q_HEAD BX)) (seq (_popw BP) (sseq (_retw)))))))))))). Definition I_deQ_b := (seq (_movwst (Opr_reg DX) (A_reg Q_HEAD BX)) (seq (_popw BP) (sseq (_retw)))). (*********************************************) Definition I_schedule:= (seq (_movwld (A_imm curr_thrd) BX) (seq (_movwst (Opr_reg SP) (A_reg TCB_STACK BX)) (seq (_pushwp (Opr_imm ready_Q)) (seq (_pushwp (Opr_reg BX)) (seq (_call L_enQueue) (seq (_addw (Opr_imm 2 ) SP) (seq (_call L_deQueue) (seq (_addw (Opr_imm 2 ) SP) (seq (_movwp (Opr_reg AX) BX) (seq (_movwst (Opr_reg AX) (A_imm curr_thrd)) (seq (_movwld (A_reg TCB_STACK BX) SP) (sseq (_retw))))))))))))). (**********************************************) Definition I_block:= (* 00 *) (seq (_movwld (A_imm curr_thrd) BX) (* 01 *) (seq (_movwst (Opr_imm 2) (A_reg TCB_STATUS BX)) (* 02 *) (seq (_movwst (Opr_reg SP) (A_reg TCB_STACK BX)) (* 03 *) (seq (_movwp (Opr_reg SP) BP) (* 04 *) (seq (_movwld (A_reg 2 BP) AX) (* 05 *) (seq (_pushwp (Opr_reg AX)) (* 06 *) (seq (_pushwp (Opr_reg BX)) (* 07 *) (seq (_call L_enQueue) (* 08 *) (seq (_pushwp (Opr_imm ready_Q)) (* 09 *) (seq (_call L_deQueue) (* 10 *) (seq (_addw (Opr_imm 6 ) SP) (* 11 *) (seq (_movwp (Opr_reg AX) BX) (* 12 *) (seq (_movwst (Opr_reg AX) (A_imm curr_thrd)) (* 13 *) (seq (_movwld (A_reg TCB_STACK BX) SP) (* 14 *) (sseq (_retw)))))))))))))))). (**********************************************) Definition I_unblock := (seq (_pushwp (Opr_reg BP)) (seq (_movwp (Opr_reg SP) BP) (seq (_movwld (A_reg 4 BP) BX) (seq (_pushwp (Opr_reg BX)) (seq (_call L_deQueue) (seq (_addw (Opr_imm 2 ) SP) (seq (_cmpw (Opr_imm 0 ) AX) (seq (_jne L_wakeup) (seq (_popw BP) (sseq (_retw))))))))))). Definition I_wakeup := (seq (_movwp (Opr_reg AX) BX) (seq (_movwst (Opr_imm 1) (A_reg TCB_STATUS BX)) (seq (_pushwp (Opr_imm ready_Q)) (seq (_pushwp (Opr_reg BX)) (seq (_call L_enQueue) (seq (_popw AX) (seq (_addw (Opr_imm 2 ) SP) (seq (_popw BP) (sseq (_retw)))))))))). (**********************************************) (********Source Code *************************** # precondition: interrupt is disabled # sleep(q) sleep: pushw %ax pushw %bx pushw %cx pushw %dx pushw %di pushw %si pushw %bp pushfw movw %sp, %bp pushw 18(%bp) call block addw $2, %sp popfw popw %bp popw %si popw %di popw %dx popw %cx popw %bx popw %ax retw yield: cli pushw %ax pushw %bx pushw %cx pushw %dx pushw %di pushw %si pushw %bp pushfw call scheduler popfw popw %bp popw %si popw %di popw %dx popw %cx popw %bx popw %ax sti retw *********************************************) (** Instruction Label **) Parameter L_sleep : Label. Parameter L_yield : Label. Parameter sleep_not_prim : ~ prim_entry L_sleep. Notation _STK_SIZE_yield:= (16 + 2 + 8 + IH_Stk) (only parsing). Notation _STK_SIZE_sleep := (18 + 2 + _BLK_Stk) (only parsing). Definition I_yield := _cli; _pushwp (Opr_reg AX); _pushwp (Opr_reg BX); _pushwp (Opr_reg CX); _pushwp (Opr_reg DX); _pushwp (Opr_reg DI); _pushwp (Opr_reg SI); _pushwp (Opr_reg BP); _pushfw; _call _SWITCH; _popfw; _popw (BP); _popw (SI); _popw (DI); _popw (DX); _popw (CX); _popw (BX); _popw (AX); _sti; _retw;; . Definition I_sleep := (* : *) _pushwp (Opr_reg AX); (* : *) _pushwp (Opr_reg BX); (* : *) _pushwp (Opr_reg CX); (* : *) _pushwp (Opr_reg DX); (* : *) _pushwp (Opr_reg DI); (* : *) _pushwp (Opr_reg SI); (* : *) _pushwp (Opr_reg BP); (* : *) _pushfw; (* : *) _movwp (Opr_reg SP) BP; (* : *) _pushwm (A_reg 18 BP); (* : *) _call _BLOCK; (* : *) _addw (Opr_imm 2) SP; (* : *) _popfw; (* : *) _popw (BP); (* : *) _popw (SI); (* : *) _popw (DI); (* : *) _popw (DX); (* : *) _popw (CX); (* : *) _popw (BX); (* : *) _popw (AX); (* : *) _retw;; . coq/miniOS/SwitchSpec.v0000644000107400000620000004612611000223231014507 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Assertion_Lemmas4. Require Import Operational_Semantics. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Require Import Linking_Lemmas3. Require Import Kernel. Require Export EnQueueSpec. Require Export DeQueueSpec. Definition Ast_schedule_pre (T : TQ) (RdyQ : WQ)(tid : TID) (tcb : Thread) (sp pc jk : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid tcb) *^* (embed_RdyQ T RdyQ) *^* (stkSpacePrec sp _SW_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ S_RF S SP = sp /\ sp >= _SW_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition L_schedule_pre_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc,exists jk, Ast_schedule_pre T RdyQ tid tcb sp pc jk mTrue S. Definition Ast_schedule_post (T' : TQ) (RdyQ' : WQ) (tid' : TID) (tcb' : Thread) (sp' sp pc jk : nat) (mP : MPred) (S' : State) : Prop := ((curr_thrd |->w tid') *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (stkSpacePrec sp _SW_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S') /\ S_RF S' SP = sp' /\ TQMod.maps_to T' tid' tcb' /\ TCB_SP tcb' = sp' /\ WQMod.not_in_dom tid' RdyQ'. Definition L_schedule_0_g (S S' : State) : Prop := forall mP, forall T RdyQ tid tcb sp pc jk, Ast_schedule_pre T RdyQ tid tcb sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb, pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : movw (curr_thrd), %bx *) Definition Ast_schedule_1 (T : TQ) (RdyQ : WQ)(tid : TID) (tcb : Thread) (sp pc jk: nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid tcb) *^* (embed_RdyQ T RdyQ) *^* (stkSpacePrec sp _SW_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ S_RF S BX = tid /\ S_RF S SP = sp /\ sp >= _SW_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition L_schedule_1_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc,exists jk, Ast_schedule_1 T RdyQ tid tcb sp pc jk mTrue S. Definition L_schedule_1_g (S S' : State) := forall mP, forall T RdyQ tid tcb sp pc jk, Ast_schedule_1 T RdyQ tid tcb sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : movw %sp, TCB_STACK(%bx)*) Definition Ast_schedule_2 (T : TQ) (RdyQ : WQ)(tid : TID) (tcb : Thread) (sp pc jk: nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid (sp,TCB_Status tcb, pc)) *^* (embed_RdyQ T RdyQ) *^* (stkSpacePrec sp _SW_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ S_RF S BX = tid /\ S_RF S SP = sp /\ sp >= _SW_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition L_schedule_2_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc,exists jk, Ast_schedule_2 T RdyQ tid tcb sp pc jk mTrue S. Definition L_schedule_2_g (S S' : State) := forall mP, forall T RdyQ tid tcb sp pc jk, Ast_schedule_2 T RdyQ tid tcb sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : pushw $readyQ *) Definition Ast_schedule_3 (T : TQ) (RdyQ : WQ)(tid : TID) (tcb : Thread) (sp pc jk: nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid (sp,TCB_Status tcb, pc)) *^* (embed_RdyQ T RdyQ) *^* (stkSpacePrec (sp - 2) (_SW_Stk - 2)) *^* (sp - 2 |->w ready_Q) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ S_RF S BX = tid /\ S_RF S SP = sp - 2 /\ sp >= _SW_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition L_schedule_3_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc, exists jk, Ast_schedule_3 T RdyQ tid tcb sp pc jk mTrue S. Definition L_schedule_3_g (S S' : State) := forall mP, forall T RdyQ tid tcb sp pc jk, Ast_schedule_3 T RdyQ tid tcb sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : pushw %bx *) Definition Ast_schedule_4 (T : TQ) (RdyQ : WQ)(tid : TID) (tcb : Thread) (sp pc jk : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid (sp,TCB_Status tcb, pc)) *^* (embed_RdyQ T RdyQ) *^* (stkSpacePrec (sp - 4) (_SW_Stk - 4)) *^* (sp - 4 |->w tid) *^* (sp - 2 |->w ready_Q) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ S_RF S BX = tid /\ S_RF S SP = sp - 4 /\ sp >= _SW_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition L_schedule_4_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc, exists jk, Ast_schedule_4 T RdyQ tid tcb sp pc jk mTrue S. Definition L_schedule_4_g (S S' : State) := forall mP, forall T RdyQ tid tcb sp pc jk, Ast_schedule_4 T RdyQ tid tcb sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : call L_enQueue *) Definition Ast_schedule_5 (T T' : TQ) (RdyQ : WQ)(tid : TID) (tcb : Thread) (sp pc jk : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_RdyQ T' (addThrd RdyQ tid)) *^* (stkSpacePrec (sp - 4) (_SW_Stk - 4)) *^* (sp - 4 |->w tid) *^* (sp - 2 |->w ready_Q) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 4 /\ sp >= _SW_Stk /\ subsetQ_TQ (addThrd RdyQ tid) T' /\ WQMod.not_in_dom tid RdyQ /\ TQMod.maps_to T tid tcb /\ T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ WF_TQ T. Definition L_schedule_5_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc,exists jk, exists T', Ast_schedule_5 T T' RdyQ tid tcb sp pc jk mTrue S. Definition L_schedule_5_g (S S' : State) := forall mP, forall T T' RdyQ tid tcb sp pc jk, Ast_schedule_5 T T' RdyQ tid tcb sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : addw $2, %sp *) Definition Ast_schedule_6 (T T' : TQ) (RdyQ : WQ)(tid : TID) (tcb : Thread) (sp pc jk : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_RdyQ T' (addThrd RdyQ tid)) *^* (stkSpacePrec (sp - 2) (_SW_Stk - 2)) *^* (sp - 2 |->w ready_Q) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ S_RF S SP = sp - 2 /\ sp >= _SW_Stk /\ subsetQ_TQ (addThrd RdyQ tid) T' /\ WQMod.not_in_dom tid RdyQ /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition L_schedule_6_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc,exists jk, exists T', Ast_schedule_6 T T' RdyQ tid tcb sp pc jk mTrue S. Definition L_schedule_6_g (S S' : State) := forall mP, forall T T' RdyQ tid tcb sp pc jk, Ast_schedule_6 T T' RdyQ tid tcb sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : call L_deQueue *) Definition Ast_schedule_7 (T T' : TQ) (RdyQ RdyQ' : WQ)(tid tid': TID) (tcb tcb': Thread) (sp pc jk : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (stkSpacePrec (sp - 2) (_SW_Stk - 2)) *^* (sp - 2 |->w ready_Q) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ S_RF S AX = tid' /\ S_RF S SP = sp - 2 /\ TQMod.maps_to T' tid' tcb' /\ TQMod.maps_to T tid tcb /\ sp >= _SW_Stk /\ WQMod.not_in_dom tid' RdyQ'. Definition L_schedule_7_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc,exists jk, exists T', exists RdyQ'', exists tid', exists tcb', Ast_schedule_7 T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk mTrue S. Definition L_schedule_7_g (S S' : State) := forall mP, forall T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk, Ast_schedule_7 T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : addw $2, %sp*) Definition Ast_schedule_8 (T T' : TQ) (RdyQ RdyQ' : WQ)(tid tid': TID) (tcb tcb': Thread) (sp pc jk : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (stkSpacePrec sp _SW_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S SP = sp /\ sp >= _SW_Stk /\ T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ TQMod.maps_to T' tid' tcb' /\ TQMod.maps_to T tid tcb /\ WQMod.not_in_dom tid' RdyQ'. Definition L_schedule_8_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc, exists jk, exists T', exists RdyQ'', exists tid', exists tcb', Ast_schedule_8 T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk mTrue S. Definition L_schedule_8_g (S S' : State) := forall mP, forall T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk, Ast_schedule_8 T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : movw %ax, %bx *) Definition Ast_schedule_9 (T T' : TQ) (RdyQ RdyQ' : WQ)(tid tid': TID) (tcb tcb': Thread) (sp pc jk : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (stkSpacePrec sp _SW_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S BX = tid' /\ S_RF S SP = sp /\ T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ TQMod.maps_to T' tid' tcb' /\ TQMod.maps_to T tid tcb /\ sp >= _SW_Stk /\ WQMod.not_in_dom tid' RdyQ'. Definition L_schedule_9_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc ,exists jk, exists T', exists RdyQ'', exists tid', exists tcb', Ast_schedule_9 T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk mTrue S. Definition L_schedule_9_g (S S' : State) := forall mP, forall T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk, Ast_schedule_9 T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : movw %ax, (curr_thrd) *) Definition Ast_schedule_10 (T T' : TQ) (RdyQ RdyQ' : WQ)(tid tid': TID) (tcb tcb': Thread) (sp pc jk: nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid') *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (stkSpacePrec sp _SW_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ S_RF S AX = tid' /\ S_RF S BX = tid' /\ S_RF S SP = sp /\ TQMod.maps_to T' tid' tcb' /\ sp >= _SW_Stk /\ TQMod.maps_to T tid tcb /\ WQMod.not_in_dom tid' RdyQ' (* /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ WF_TQ T*). Definition L_schedule_10_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc,exists jk, exists T', exists RdyQ'', exists tid', exists tcb', Ast_schedule_10 T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk mTrue S. Definition L_schedule_10_g (S S' : State) := forall mP, forall T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk, Ast_schedule_10 T T' RdyQ RdyQ'' tid tid' tcb tcb' sp pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : movw TCB_STACK(%bx), %sp*) Definition Ast_schedule_11 (T T' : TQ) (RdyQ RdyQ' : WQ)(tid tid': TID) (tcb tcb': Thread) (sp sp' pc jk: nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid') *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (stkSpacePrec sp _SW_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk) *^* mP) (S_Mem S) /\ T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ S_RF S AX = tid' /\ S_RF S BX = tid' /\ TCB_SP tcb' = sp' /\ S_RF S SP = sp' /\ TQMod.maps_to T' tid' tcb' /\ TQMod.maps_to T tid tcb /\ sp >= _SW_Stk /\ WQMod.not_in_dom tid' RdyQ' (* /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ TQMod.maps_to T tid tcb /\ WF_TQ T*). Definition L_schedule_11_p (S : State) : Prop := exists T, exists RdyQ, exists tid, exists tcb, exists sp, exists pc,exists jk, exists T', exists RdyQ'', exists tid', exists tcb', exists sp', Ast_schedule_11 T T' RdyQ RdyQ'' tid tid' tcb tcb' sp sp' pc jk mTrue S. Definition L_schedule_11_g (S S' : State) := forall mP, forall T T' RdyQ RdyQ'' tid tid' tcb tcb' sp sp' pc jk, Ast_schedule_11 T T' RdyQ RdyQ'' tid tid' tcb tcb' sp sp' pc jk mP S -> exists T', exists RdyQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, TCB_Status tcb , pc) /\ addThrd RdyQ tid = addThrd RdyQ' tid' /\ Ast_schedule_post T' RdyQ' tid' tcb' sp' sp pc jk mP S'. (* : retw *) Lemma L_schedule_pre_p_sound : forall S, Linking.SW_Prd S -> L_schedule_pre_p S. Proof. intros S HS. unfold L_schedule_pre_p. unfold SW_Prd in HS. destruct HS as [T [RdyQ [tid [sp [tcb [pc [[jk P1] [P2 [P3 [P4 [P5 P6]]]]]]]]]]]. unfold Ast_schedule_pre. exists T; exists RdyQ; exists tid; exists tcb; exists sp; exists pc;exists jk. unfold SW_MPre in P1. intuition. sep on. sep lift 0 in P1. substH P1 with (embed_curr_TCB_elim1 (S_Mem S) T tid (embed_RdyQ T RdyQ *^* (sp |-> pc *^* (sp + 1 |-> jk *^* (stkSpacePrec sp 8 *^* mTrue)))) P1). destruct P1 as [tcbx [E P1]]. assert (tcbx = tcb). unfold TQMod.maps_to in * . rewrite E in P2. inversion P2. reflexivity. subst tcbx. unfold embed_TCB. sep matchH P1 with 8. sep on. sep lift 4 in P1. assert (P : (S_Mem S) ||- stkSpace sp 8). sep trivial. destruct P. assumption. Qed. Lemma L_schedule_0_g_sound : forall S S', L_schedule_0_g S S' -> Linking.SW_grt S S'. Proof. unfold L_schedule_0_g,SW_grt. intros S S' HSS'. intros M0 M1 HJM T T' RdyQ tid sp tcb pc jk. unfold SW_Prd_aux. intros H. destruct H as [HMPre [Hmto [HRT [HSP [HtR HT]]]]]. intros HT'. substH HSS' with (HSS' (mEq M1) T RdyQ tid tcb sp pc jk). assert (Ast_schedule_pre T RdyQ tid tcb sp pc jk (mEq M1) S). destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold SW_MPre in HMPre. simplS in * . split. simplS. exists M0; exists M1; split_l. rsplit. unfold mEq; trivial. sep on. sep lift 0 in HMPre. substH HMPre with (embed_curr_TCB_elim1 _ _ _ _ HMPre). destruct HMPre as [tcbx [Hmtox HM]]. assert (tcbx = tcb). unfold TQMod.maps_to in * . rewrite Hmto in Hmtox. injection Hmtox; auto. subst tcbx. unfold embed_TCB. sep matchH HM with 10. simplS. split_l. split. sep on. sep lift 4 in HMPre. assert (HMx : M0 ||- stkSpace sp 8). sep trivial. destruct HMx; trivial. repeat split_l; trivial. substH HSS' with (HSS' H). destruct HSS' as [Tx' [RdyQx' [tid' [sp' [tcb' Hx]]]]]. destruct Hx as [HTx' [HRdyQ HS']]. unfold Ast_schedule_post in HS'. destruct HS' as [HM' [Hsp' [Hmto' [Htcb' Hnin']]]]. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . destruct HM' as [M2' [M1' [HJM' [HM2' HM1']]]]. unfold mEq in HM1'; subst M1'. exists M2'; exists RdyQx'; exists tid'; exists sp'; exists tcb'. split_l. split_l. unfold SW_Post_aux. unfold SW_MPost. simplS. assert (Tx' = T'). subst T' Tx'; trivial. clear HTx'. subst Tx'. intuition. sep on. sep lift 0. apply embed_curr_TCB_intro1 with tcb'; trivial. unfold embed_TCB in HM2'. sep matchH HM2' with 8. Qed. Definition spec_schedule := Ast L_schedule_pre_p L_schedule_0_g sctag. Definition psi_schedule := (SCAP_consCT L_enQueue (Ast p_enQueue g_enQueue sctag) (SCAP_consCT L_deQueue (Ast p_deQueue g_deQueue sctag) SCAP_emptCT)). Lemma L_deQueue_in_psi_schedule : SCAP_lookupCT psi_schedule L_deQueue (Ast p_deQueue g_deQueue sctag). Proof. unfold SCAP_lookupCT, psi_schedule. unfold SCAP_consCT. apply SPSpec.lookup_merge_intro_r. simpl. SPSpec.lookup_solve. Qed. Lemma L_enQueue_in_psi_schedule : SCAP_lookupCT psi_schedule L_enQueue (Ast p_enQueue g_enQueue sctag). Proof. unfold SCAP_lookupCT, psi_schedule. unfold SCAP_consCT. simpl. SPSpec.lookup_solve. Qed. coq/miniOS/BlockSpec.v0000644000107400000620000006570611000223231014305 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Operational_Semantics. Require Import Assertion. Require Import Assertion_Lemmas4. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Require Import Linking_Lemmas3. Require Import Kernel. Require Export EnQueueSpec. Require Export DeQueueSpec. Definition Ast_block_pre (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (tcb : Thread) (sp pc jk1 jk2 : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid tcb) *^* (embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S SP = sp /\ sp >= _BLK_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ exists_Idle T RdyQ tid /\ TCB_Status tcb = READY /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition Ast_block_post (T' : TQ) (RdyQ' BlkQ' : WQ) (l_ptr : Label) (tid' : TID) (tcb' : Thread) (sp' sp pc jk1 jk2 : nat) (mP : MPred) (S' : State) : Prop := ((curr_thrd |->w tid') *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S') /\ S_RF S' SP = sp' /\ TQMod.maps_to T' tid' tcb' /\ TCB_SP tcb' = sp' /\ WQMod.not_in_dom tid' RdyQ'. Definition p_block (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists tcb, exists sp, exists pc, exists jk1, exists jk2, Ast_block_pre T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mTrue S. Definition g_block (S S' : State) : Prop := forall mP, forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2, Ast_block_pre T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1158 : movw (curr_thrd), %bx # curr_thrd = 2254 *) Definition Ast_block_1 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (tcb : Thread) (sp pc jk1 jk2 : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid tcb) *^* (embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S BX = tid /\ S_RF S SP = sp /\ sp >= _BLK_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ exists_Idle T RdyQ tid /\ TCB_Status tcb = READY /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition p_block_1 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists tcb, exists sp, exists pc, exists jk1, exists jk2, Ast_block_1 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mTrue S. Definition g_block_1 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2, Ast_block_1 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1159 : movw $BLOCKED, TCB_STATUS(%bx) *) Definition Ast_block_2 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (tcb : Thread) (sp pc jk1 jk2 : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid (TCB_Status_Upd tcb BLOCKED)) *^* (embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S BX = tid /\ S_RF S SP = sp /\ sp >= _BLK_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ exists_Idle T RdyQ tid /\ TCB_Status tcb = READY /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition p_block_2 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists tcb, exists sp, exists pc, exists jk1, exists jk2, Ast_block_2 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mTrue S. Definition g_block_2 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2, Ast_block_2 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1160 : movw %sp, TCB_STACK(%bx) *) Definition Ast_block_3 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (tcb : Thread) (sp pc jk1 jk2 : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid (sp, BLOCKED, pc)) *^* (embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S BX = tid /\ S_RF S SP = sp /\ sp >= _BLK_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ exists_Idle T RdyQ tid /\ TCB_Status tcb = READY /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition p_block_3 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists tcb, exists sp, exists pc, exists jk1, exists jk2, Ast_block_3 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mTrue S. Definition g_block_3 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2, Ast_block_3 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1161 : movw %sp, %bp *) Definition Ast_block_4 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (tcb : Thread) (sp pc jk1 jk2 : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid (sp, BLOCKED, pc)) *^* (embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S BX = tid /\ S_RF S SP = sp /\ S_RF S BP = sp /\ sp >= _BLK_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ exists_Idle T RdyQ tid /\ TCB_Status tcb = READY /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition p_block_4 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists tcb, exists sp, exists pc, exists jk1, exists jk2, Ast_block_4 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mTrue S. Definition g_block_4 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2, Ast_block_4 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1162 : movw 2(%bp), %ax *) Definition Ast_block_5 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (tcb : Thread) (sp pc jk1 jk2 : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid (sp, BLOCKED, pc)) *^* (embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S AX = l_ptr /\ S_RF S BX = tid /\ S_RF S SP = sp /\ sp >= _BLK_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ exists_Idle T RdyQ tid /\ TCB_Status tcb = READY /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition p_block_5 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists tcb, exists sp, exists pc, exists jk1, exists jk2, Ast_block_5 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mTrue S. Definition g_block_5 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 , Ast_block_5 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1163 : pushw %ax #BlockQ *) Definition Ast_block_6 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (tcb : Thread) (sp pc jk1 jk2 : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid (sp, BLOCKED, pc)) *^* (embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec (sp - 2) (_BLK_Stk - 2)) *^* (sp - 2 |->w l_ptr) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S BX = tid /\ S_RF S SP = sp - 2 /\ sp >= _BLK_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ exists_Idle T RdyQ tid /\ TCB_Status tcb = READY /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition p_block_6 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists tcb, exists sp, exists pc, exists jk1, exists jk2, Ast_block_6 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mTrue S. Definition g_block_6 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2, Ast_block_6 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1164 : pushw %bx *) Definition Ast_block_7 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (tcb : Thread) (sp pc jk1 jk2 : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid (sp, BLOCKED, pc)) *^* (embed_RdyQ T RdyQ) *^* (embed_BlkQ l_ptr T BlkQ) *^* (stkSpacePrec (sp - 4) (_BLK_Stk - 4)) *^* (sp - 4 |->w tid) *^* (sp - 2 |->w l_ptr) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S BX = tid /\ S_RF S SP = sp - 4 /\ sp >= _BLK_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ exists_Idle T RdyQ tid /\ TCB_Status tcb = READY /\ TQMod.maps_to T tid tcb /\ WF_TQ T. Definition p_block_7 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists tcb, exists sp, exists pc, exists jk1, exists jk2, Ast_block_7 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mTrue S. Definition g_block_7 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2, Ast_block_7 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1165 : call L_enQueue *) Definition Ast_block_8 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (tcb : Thread) (sp pc jk1 jk2 : nat) (T' : TQ) (BlkQ' : WQ) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_RdyQ T' RdyQ) *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec (sp - 4) (_BLK_Stk - 4)) *^* (sp - 4 |->w tid) *^* (sp - 2 |->w l_ptr) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 4 /\ sp >= _BLK_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ exists_Idle T RdyQ tid /\ TCB_Status tcb = READY /\ TQMod.maps_to T tid tcb /\ T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid. Definition p_block_8 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists tcb, exists sp, exists pc, exists jk1, exists jk2, exists T', exists BlkQ', Ast_block_8 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mTrue S. Definition g_block_8 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ', Ast_block_8 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1166 : pushw $readyQ #readyQ = 2250 *) Definition Ast_block_9 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (tcb : Thread) (sp pc jk1 jk2 : nat) (T' : TQ) (BlkQ' : WQ) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_RdyQ T' RdyQ) *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec (sp - 6) (_BLK_Stk - 6)) *^* (sp - 6 |->w ready_Q) *^* (sp - 4 |->w tid) *^* (sp - 2 |->w l_ptr) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S SP = sp - 6 /\ sp >= _BLK_Stk /\ subsetQ_TQ RdyQ T /\ WQMod.not_in_dom tid RdyQ /\ exists_Idle T RdyQ tid /\ TCB_Status tcb = READY /\ TQMod.maps_to T tid tcb /\ T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid. Definition p_block_9 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists tcb, exists sp, exists pc, exists jk1, exists jk2, exists T', exists BlkQ', Ast_block_9 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mTrue S. Definition g_block_9 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ', Ast_block_9 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1167 : call L_deQueue *) Definition Ast_block_10 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (sp pc jk1 jk2 : nat) (T' : TQ) (RdyQ' BlkQ' : WQ) (tid' : TID) (tcb' : Thread) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec (sp - 6) (_BLK_Stk - 6)) *^* (sp - 6 |->w ready_Q) *^* (sp - 4 |->w tid) *^* (sp - 2 |->w l_ptr) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S SP = sp - 6 /\ sp >= _BLK_Stk /\ T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ TQMod.maps_to T' tid' tcb' /\ WQMod.not_in_dom tid' RdyQ'. Definition p_block_10 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists sp, exists pc, exists jk1, exists jk2, exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_block_10 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mTrue S. Definition g_block_10 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb', Ast_block_10 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1168 : addw $6, %sp *) Definition Ast_block_11 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (sp pc jk1 jk2 : nat) (T' : TQ) (RdyQ' BlkQ' : WQ) (tid' : TID) (tcb' : Thread) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S SP = sp /\ sp >= _BLK_Stk /\ T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ TQMod.maps_to T' tid' tcb' /\ WQMod.not_in_dom tid' RdyQ'. Definition p_block_11 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists sp, exists pc, exists jk1, exists jk2, exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_block_11 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mTrue S. Definition g_block_11 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb', Ast_block_11 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1169 : movw %ax, %bx *) Definition Ast_block_12 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (sp pc jk1 jk2 : nat) (T' : TQ) (RdyQ' BlkQ' : WQ) (tid' : TID) (tcb' : Thread) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid) *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S AX = tid' /\ S_RF S BX = tid' /\ S_RF S SP = sp /\ sp >= _BLK_Stk /\ T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ TQMod.maps_to T' tid' tcb' /\ WQMod.not_in_dom tid' RdyQ'. Definition p_block_12 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists sp, exists pc, exists jk1, exists jk2, exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_block_12 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mTrue S. Definition g_block_12 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb', Ast_block_12 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1170 : movw %ax, (curr_thrd) *) Definition Ast_block_13 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (sp pc jk1 jk2 : nat) (T' : TQ) (RdyQ' BlkQ' : WQ) (tid' : TID) (tcb' : Thread) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid') *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S BX = tid' /\ S_RF S SP = sp /\ sp >= _BLK_Stk /\ T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ TQMod.maps_to T' tid' tcb' /\ WQMod.not_in_dom tid' RdyQ'. Definition p_block_13 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists sp, exists pc, exists jk1, exists jk2, exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', Ast_block_13 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mTrue S. Definition g_block_13 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb', Ast_block_13 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1171 : movw TCB_STACK(%bx), %sp *) Definition Ast_block_14 (T : TQ) (RdyQ BlkQ : WQ) (l_ptr : Label) (tid : TID) (sp pc jk1 jk2 : nat) (T' : TQ) (RdyQ' BlkQ' : WQ) (tid' : TID) (tcb' : Thread) (sp' : nat) (mP : MPred) (S : State) : Prop := ((curr_thrd |->w tid') *^* (embed_TCB tid' tcb') *^* (embed_RdyQ T' RdyQ') *^* (embed_BlkQ l_ptr T' BlkQ') *^* (stkSpacePrec sp _BLK_Stk) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2) *^* mP) (S_Mem S) /\ S_RF S SP = sp' /\ sp >= _BLK_Stk /\ T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ TCB_SP tcb' = sp' /\ TQMod.maps_to T' tid' tcb' /\ WQMod.not_in_dom tid' RdyQ'. Definition p_block_14 (S : State) : Prop := exists T, exists RdyQ, exists BlkQ, exists l_ptr, exists tid, exists sp, exists pc, exists jk1, exists jk2, exists T', exists RdyQ', exists BlkQ', exists tid', exists tcb', exists sp', Ast_block_14 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' sp' mTrue S. Definition g_block_14 (S S' : State) := forall mP, forall T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' sp', Ast_block_14 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' sp' mP S -> exists T', exists RdyQ', exists BlkQ', exists tid', exists sp', exists tcb', T' = TQMod.put T tid (sp, BLOCKED, pc) /\ BlkQ' = addThrd BlkQ tid /\ RdyQ = addThrd RdyQ' tid' /\ Ast_block_post T' RdyQ' BlkQ' l_ptr tid' tcb' sp' sp pc jk1 jk2 mP S'. (* 1172 : retw *) Lemma p_block_sound : forall S, Linking.BLK_Prd S -> p_block S. Proof. intros S HS. unfold p_block, BLK_Prd in * . destruct HS as [T [RdyQ [BlkQ [tid [sp [l_ptr [tcb [pc HS]]]]]]]]. destruct HS as [HM [Hex [Hmto [HRT [HBT [Htcb [HSP [HtR [HtB [HRB HT]]]]]]]]]]. destruct HM as [jk1 [jk2 HM]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists tid; exists tcb; exists sp; exists pc; exists jk1; exists jk2. destruct S as [[[M R] fl] isr]. unfold Ast_block_pre, BLK_MPre in * . simplS in * . split. sep on. sep lift 0 in HM. substH HM with (embed_curr_TCB_elim1 _ _ _ _ HM). destruct HM as [tcbx [Hmtox HM]]. assert (tcbx = tcb). unfold TQMod.maps_to in * . rewrite Hmto in Hmtox. injection Hmtox; auto. subst tcbx. unfold embed_TCB. unfold embed_BlkQ. sep matchH HM with 12. split_l. split. sep on. sep lift 7 in HM. assert (HMx : M ||- stkSpace sp 10). sep trivial. destruct HMx; trivial. repeat split_l; trivial. Qed. Lemma g_block_sound : forall S S', g_block S S' -> Linking.BLK_grt S S'. Proof. unfold g_block, BLK_grt. intros S S' HSS'. intros M0 M1 HJM T T' RdyQ BlkQ BlkQ' tid sp BlkQ_ptr tcb pc jk1 jk2. unfold BLK_Prd_aux. intros H. destruct H as [HMPre [Hex [Hmto [HRT [HBT [Htcb [HSP [HtR [HtB [HRB HT]]]]]]]]]]. intros HT' HBlkQ'. substH HSS' with (HSS' (mEq M1) T RdyQ BlkQ BlkQ_ptr tid tcb sp pc). assert (Ast_block_pre T RdyQ BlkQ BlkQ_ptr tid tcb sp pc jk1 jk2 (mEq M1) S). destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold BLK_MPre in HMPre. simplS in * . split. simplS. exists M0; exists M1; split_l. rsplit. unfold mEq; trivial. sep on. sep lift 0 in HMPre. substH HMPre with (embed_curr_TCB_elim1 _ _ _ _ HMPre). destruct HMPre as [tcbx [Hmtox HM]]. assert (tcbx = tcb). unfold TQMod.maps_to in * . rewrite Hmto in Hmtox. injection Hmtox; auto. subst tcbx. unfold embed_TCB. unfold embed_BlkQ. sep matchH HM with 12. simplS. split_l. split. sep on. sep lift 7 in HMPre. assert (HMx : M0 ||- stkSpace sp 10). sep trivial. destruct HMx; trivial. repeat split_l; trivial. substH HSS' with (HSS' jk1 jk2 H). destruct HSS' as [Tx' [RdyQx' [BlkQx' [tid' [sp' [tcb' Hx]]]]]]. destruct Hx as [HTx' [HBlkQx' [HRdyQ HS']]]. unfold Ast_block_post in HS'. destruct HS' as [HM' [Hsp' [Hmto' [Htcb' Hnin']]]]. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . destruct HM' as [M2' [M1' [HJM' [HM2' HM1']]]]. unfold mEq in HM1'; subst M1'. exists M2'; exists RdyQx'; exists tid'; exists sp'; exists tcb'. split_l. split_l. unfold BLK_Post_aux. unfold BLK_MPost. simplS. assert (Tx' = T'). subst T' Tx'; trivial. clear HTx'. subst Tx'. split_l. split_l. split_l. split_l. sep on. sep lift 0. apply embed_curr_TCB_intro1 with tcb'; trivial. unfold embed_BlkQ in HM2'. unfold embed_TCB in HM2'. sep matchH HM2' with 8. rewrite <- HBlkQ' in HBlkQx'. subst BlkQx'. trivial. Qed. Definition spec_block := Ast p_block g_block sctag. Definition psi_block := (SCAP_consCT L_enQueue (Ast p_enQueue g_enQueue sctag) (SCAP_consCT L_deQueue (Ast p_deQueue g_deQueue sctag) SCAP_emptCT)). Lemma L_deQueue_in_psi_block : SCAP_lookupCT psi_block L_deQueue (Ast p_deQueue g_deQueue sctag). Proof. unfold SCAP_lookupCT, psi_block. unfold SCAP_consCT. apply SPSpec.lookup_merge_intro_r. simpl. SPSpec.lookup_solve. Qed. Lemma L_enQueue_in_psi_block : SCAP_lookupCT psi_block L_enQueue (Ast p_enQueue g_enQueue sctag). Proof. unfold SCAP_lookupCT, psi_block. unfold SCAP_consCT. simpl. SPSpec.lookup_solve. Qed. coq/miniOS/EnQueueProof.v0000644000107400000620000015614511000223231015013 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) (* by wangwei *) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Reg. Require Import Assertion. Require Import Assertion_Lemmas3. Require Import Assertion_Lemmas4. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Require Import Linking_Lemmas3. Require Import QLemmas. Require Import Kernel. Require Import EnQueueSpec. (** Functioon: EnQueue, add a node into Queue **) (** Two blocks: EnQueue, EnQ_NotNull **) (***********************************************) (********Source Code *************************** 1190 : 1190: pushw %bp movw %sp, %bp movw 4(%bp), %ax # ax: pointer to node movw 6(%bp), %bx # bx: pointer to Q movw Q_TAIL(%bx), %dx 1195: movw %bx, %cx # save bx movw %ax, %bx movw %dx, ND_PREV(%bx) movw $0, ND_NEXT(%bx) cmpw $0, %dx 1200: jne EnQ_NotNull movw %cx, %bx # bx: pointers to Q movw %ax, Q_HEAD(%bx) # head = newtcb movw %ax, Q_TAIL(%bx) popw %bp retw EnQ_NotNull : 1206: movw %dx, %bx movw %ax, ND_NEXT(%bx) movw %cx, %bx # bx: pointers to Q movw %ax, Q_TAIL(%bx) 1210: popw %bp retw ************************************************) (***************************************) (* : pushw %bp *) Lemma SCAP_WFcmd_enQueue_0_pushw : SCAP_WFcmd (SCAP_consCT (L_enQueue + 1) (Ast L_enQueue_1_p L_enQueue_1_g sctag) psi_enQueue_Block0) (L_enQueue) (Ast p_enQueue g_enQueue sctag) (comml (_pushwp (Opr_reg BP))). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp mP S S', Ast_enQueue_pre T Q ptr tid tcb bp sp mP S -> nextS (L_enQueue) (comml (_pushwp (Opr_reg BP))) S S' -> Ast_enQueue_1 T Q ptr tid tcb bp sp mP S'). unfold Ast_enQueue_pre,Ast_enQueue_1. intros T Q ptr tid tcb bp sp mP S S' Hp HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HSS1 [HSS2 [jk HSS3]]] [HSS4 [HSS5 HSS6]]]. destruct Hp as [Hp1 [Hp2 [Hp3 Hp4]]]. subst M' R' fl' isr'. rewrite Hp3; rewrite Hp4. intuition. sep on. sep lift 2 in Hp1. sep lift 2. assert (MemUpdW M (sp - 2) bp jk ||- sp - 2 |->w bp *^* (sp + 2 |->w tid *^* (sp + 4 |->w ptr *^* mP) *^* (embed_TCB tid tcb *^* ptoTQ ptr (filterTQ T Q)))). sep upd. sep matchH Hp1 with 10. sep trivial. unfold MemUpdW in H. assumption. unfold SCAP_WFcmd. exists L_enQueue_1_p;exists L_enQueue_1_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp HS]]]]]]]. destruct HS as [HS1 [HS2 [HS3 HS4]]]. exists (MemUpdW M (sp-2) bp 0, RF_update R SP (sp - 2), fl, isr). simplS in * . apply nextS_pushwp with bp. unfold opr_eval. rewrite HS3;reflexivity. unfold pushW. intuition. rewrite HS4. sep on. sep lift 2 in HS1. sep trivial. exists 0. unfold MemUpdW. rewrite HS4;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold p_enQueue, L_enQueue_1_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp H]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb . exists bp; exists sp. apply Hpp' with S;assumption. (* g' ==> g *) unfold g_enQueue, L_enQueue_1_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S''. apply Hpp' with S;assumption. Qed. (* : movw %sp, %bp *) Lemma SCAP_WFcmd_enQueue_1_movwp : SCAP_WFcmd (SCAP_consCT (L_enQueue + 1 + 1) (Ast L_enQueue_2_p L_enQueue_2_g sctag) psi_enQueue_Block0) (L_enQueue + 1) (Ast L_enQueue_1_p L_enQueue_1_g sctag) (comml (_movwp (Opr_reg SP) BP)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp mP S S', Ast_enQueue_1 T Q ptr tid tcb bp sp mP S -> nextS (L_enQueue + 1) (comml (_movwp (Opr_reg SP) BP)) S S' -> Ast_enQueue_2 T Q ptr tid tcb bp sp mP S'). unfold Ast_enQueue_1,Ast_enQueue_2. intros T Q ptr tid tcb bp sp mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 HS5]]]]. subst M' R' fl' isr'. rewrite HS5. intuition. unfold SCAP_WFcmd. exists L_enQueue_2_p;exists L_enQueue_2_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp HS]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 HS5]]]]. exists (M, RF_update R BP (sp - 2), fl, isr). simplS in * . apply nextS_movwp with (sp - 2);trivial. unfold opr_eval. rewrite HS5;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_1_p, L_enQueue_2_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp H]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp; exists sp. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_1_g, L_enQueue_2_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S''. apply Hpp' with S;assumption. Qed. (* : movw 4(%bp), %ax *) Lemma SCAP_WFcmd_enQueue_2_movwld : SCAP_WFcmd (SCAP_consCT (L_enQueue + 2 + 1) (Ast L_enQueue_3_p L_enQueue_3_g sctag) psi_enQueue_Block0) (L_enQueue + 2) (Ast L_enQueue_2_p L_enQueue_2_g sctag) (comml (_movwld (A_reg 4 BP) AX)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp mP S S', Ast_enQueue_2 T Q ptr tid tcb bp sp mP S -> nextS (L_enQueue + 2) (comml (_movwld (A_reg 4 BP) AX)) S S' -> Ast_enQueue_3 T Q ptr tid tcb bp sp mP S'). unfold Ast_enQueue_2,Ast_enQueue_3. intros T Q ptr tid tcb bp sp mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [[x [HSS2 HSS3]] [HSS4 HSS5]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 HS5]]]]. subst M' R' fl' isr'. assert (E: x = tid). rewrite HS4 in HSS2. sep on. sep lift 3 in HS1. arith_rep (sp-2+4) with (sp+2) in HSS2. sep inj; auto. intuition. unfold SCAP_WFcmd. exists L_enQueue_3_p;exists L_enQueue_3_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp HS]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 HS5]]]]. exists (M, RF_update R AX tid, fl, isr). simplS in * . apply nextS_movwld with (sp+2) tid;trivial. unfold addr_eval. rewrite HS4;omega. sep on. sep lift 3 in HS1. sep trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_2_p, L_enQueue_3_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp H]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb. exists bp; exists sp. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_2_g, L_enQueue_3_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S''. apply Hpp' with S; assumption. Qed. (* Lemma ptoTQ_elim : *) (* forall Q ptr M, *) (* M ||- (ptoTQ ptr Q) *) (* -> exists head, exists tail, exists prev, *) (* M ||- (ptr |->w head *^* ptr + 2 |->w tail *^* *) (* Queue Thread ptoTCB head tail prev 0 Q). *) (* Proof. *) (* intros. *) (* sep off. *) (* unfold ptoTQ , ptoQ2 in H. *) (* destruct H as [head [tail [prev H]]]. *) (* exists head; exists tail; exists prev. *) (* assumption. *) (* Qed. *) (* Implicit Arguments ptoTQ_elim [Q ptr M]. *) (* Lemma ptoTQ_elim1 : *) (* forall Q ptr M A, *) (* M ||- (ptoTQ ptr Q *^* A) *) (* -> exists head, exists tail, exists prev, *) (* M ||- (ptr |->w head *^* ptr + 2 |->w tail *^* *) (* Queue Thread ptoTCB head tail prev 0 Q *^* A). *) (* Proof. *) (* intros. *) (* destruct H as [M1 [M2 [Hdis [HQ HA]]]]. *) (* destruct (ptoTQ_elim HQ) as [head [tail [prev H]]]. *) (* exists head; exists tail; exists prev. *) (* exists M1;exists M2. *) (* intuition. *) (* Qed. *) (* Implicit Arguments ptoTQ_elim1 [Q ptr M A]. *) (* : movw 6(%bp), %bx *) Lemma SCAP_WFcmd_enQueue_3_movwld : SCAP_WFcmd (SCAP_consCT (L_enQueue + 3 + 1) (Ast L_enQueue_4_p L_enQueue_4_g sctag) psi_enQueue_Block0) (L_enQueue + 3) (Ast L_enQueue_3_p L_enQueue_3_g sctag) (comml (_movwld (A_reg 6 BP) BX)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp mP S S', Ast_enQueue_3 T Q ptr tid tcb bp sp mP S -> nextS (L_enQueue + 3) (comml (_movwld (A_reg 6 BP) BX)) S S' -> exists head, exists tail, exists prev, Ast_enQueue_4 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_4, Ast_enQueue_4. intros T Q ptr tid tcb bp sp mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [[x [HSS2 HSS3]] [HSS4 HSS5]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 HS6]]]]]. simplS in * . subst M' R' fl' isr'. sep on. sep lift 1 in HS1. destruct (ptoTQ_elim1 HS1) as [head [tail [prev HS]]]. clear HS1. exists head; exists tail; exists prev. assert (E: x = ptr). rewrite HS4 in HSS2. sep lift 5 in HS. arith_rep (sp-2+6) with (sp+4) in HSS2. sep inj;auto. intuition. sep on. sep matchH HS with 10. unfold SCAP_WFcmd. exists L_enQueue_4_p;exists L_enQueue_4_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp HS]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 HS6]]]]]. exists (M, RF_update R BX ptr, fl, isr). simplS in * . apply nextS_movwld with (sp+4) ptr;trivial. unfold addr_eval. rewrite HS4;omega. sep on. sep lift 4 in HS1. sep trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_3_p, L_enQueue_4_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp H]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb. exists bp; exists sp. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_3_g, L_enQueue_4_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. assert (exists head : nat, exists tail : nat, exists prev : nat, Ast_enQueue_4 T Q ptr tid tcb bp sp head tail prev mP S'). apply Hpp' with S;assumption. destruct H0 as [head [tail [prev H0]]]. apply HgS'S'' with head tail prev;assumption. Qed. (* : movw Q_TAIL(%bx), %dx *) Lemma SCAP_WFcmd_enQueue_4_movwld : SCAP_WFcmd (SCAP_consCT (L_enQueue + 4 + 1) (Ast L_enQueue_5_p L_enQueue_5_g sctag) psi_enQueue_Block0) (L_enQueue + 4) (Ast L_enQueue_4_p L_enQueue_4_g sctag) (comml (_movwld (A_reg Q_TAIL BX) DX)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_4 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 4) (comml (_movwld (A_reg Q_TAIL BX) DX)) S S' -> Ast_enQueue_5 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_4, Ast_enQueue_5. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [[x [HSS2 HSS3]] [HSS4 HSS5]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 HS7]]]]]]. subst M' R' fl' isr'. assert (E: x = tail). rewrite HS7 in HSS2. sep on. sep lift 2 in HS1. sep inj;auto. intuition. unfold SCAP_WFcmd. exists L_enQueue_5_p; exists L_enQueue_5_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HS1 [HS2 [HS3 [HS4 [HS5 [HS6 HS7]]]]]]. exists (M, RF_update R DX tail, fl, isr). simplS in * . apply nextS_movwld with (ptr + 2) tail;trivial. unfold addr_eval. rewrite HS7;reflexivity. sep on. sep lift 2 in HS1. sep trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_4_p, L_enQueue_5_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb. exists bp; exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_4_g, L_enQueue_5_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev. apply Hpp' with S;assumption. Qed. (* : movw %bx, %cx *) Lemma SCAP_WFcmd_enQueue_5_movwp : SCAP_WFcmd (SCAP_consCT (L_enQueue + 5 + 1) (Ast L_enQueue_6_p L_enQueue_6_g sctag) psi_enQueue_Block0) (L_enQueue + 5) (Ast L_enQueue_5_p L_enQueue_5_g sctag) (comml (_movwp (Opr_reg BX) CX)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_5 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 5) (comml (_movwp (Opr_reg BX) CX)) S S' -> Ast_enQueue_6 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_5,Ast_enQueue_6. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX [HBX HDX]]]]]]]. subst M' R' fl' isr'. rewrite HBX. intuition. unfold SCAP_WFcmd. exists L_enQueue_6_p;exists L_enQueue_6_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX [HBX HDX]]]]]]]. exists (M, RF_update R CX ptr, fl, isr). simplS in * . apply nextS_movwp with ptr; trivial. unfold opr_eval. rewrite HBX;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_5_p, L_enQueue_6_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp; exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_5_g, L_enQueue_6_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev. apply Hpp' with S;assumption. Qed. (* : movw %ax, %bx *) Lemma SCAP_WFcmd_enQueue_6_movwp : SCAP_WFcmd (SCAP_consCT (L_enQueue + 6 + 1) (Ast L_enQueue_7_p L_enQueue_7_g sctag) psi_enQueue_Block0) (L_enQueue + 6) (Ast L_enQueue_6_p L_enQueue_6_g sctag) (comml (_movwp (Opr_reg AX) BX)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_6 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 6) (comml (_movwp (Opr_reg AX) BX)) S S' -> Ast_enQueue_7 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_6,Ast_enQueue_7. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX [HDX HCX]]]]]]]. subst M' R' fl' isr'. rewrite HAX. unfold embed_TCB in HM. intuition. unfold SCAP_WFcmd. exists L_enQueue_7_p;exists L_enQueue_7_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX [HDX HCX]]]]]]]. exists (M, RF_update R BX tid, fl, isr). simplS in * . apply nextS_movwp with tid; trivial. unfold opr_eval. rewrite HAX;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_6_p, L_enQueue_7_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp; exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_6_g, L_enQueue_7_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev. apply Hpp' with S;assumption. Qed. (* : movw %dx, ND_PREV(%bx) *) Lemma SCAP_WFcmd_enQueue_7_movwst : SCAP_WFcmd (SCAP_consCT (L_enQueue + 7 + 1) (Ast L_enQueue_8_p L_enQueue_8_g sctag) psi_enQueue_Block0) (L_enQueue + 7) (Ast L_enQueue_7_p L_enQueue_7_g sctag) (comml (_movwst (Opr_reg DX) (A_reg ND_PREV BX))). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_7 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 7) (comml (_movwst (Opr_reg DX)(A_reg ND_PREV BX))) S S' -> Ast_enQueue_8 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_7, Ast_enQueue_8. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HSS1 [jk HSS2]] [HSS3 [HSS4 HSS5]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX [HDX [HCX HBX]]]]]]]]. subst M' R' fl' isr'. intuition. sep on. assert (MemUpdW M tid tail jk ||- tid |->w tail *^* tid + 2 |->w_ *^* ptoTCB (tid + 4) tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* Queue Thread ptoTCB head tail prev 0 (filterTQ T Q) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP). sep lift 0. sep upd. sep matchH HM with 10. unfold MemUpdW in H. rewrite HBX; rewrite HDX. replace (tid+0) with tid. assumption. auto. unfold SCAP_WFcmd. exists L_enQueue_8_p; exists L_enQueue_8_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX [HDX [HCX HBX]]]]]]]]. exists (MemUpdW M tid tail 0, R, fl, isr). simplS in * . apply nextS_movwst with tid tail;trivial. unfold addr_eval. rewrite HBX;auto. simpl;auto. sep on. sep lift 0 in HM. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_7_p, L_enQueue_8_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp. exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_7_g, L_enQueue_8_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev . apply Hpp' with S;assumption. Qed. (* : movw $0, ND_NEXT(%bx) *) Lemma SCAP_WFcmd_enQueue_8_movwst : SCAP_WFcmd (SCAP_consCT (L_enQueue + 8 + 1) (Ast L_enQueue_9_p L_enQueue_9_g sctag) psi_enQueue_Block0) (L_enQueue + 8) (Ast L_enQueue_8_p L_enQueue_8_g sctag) (comml (_movwst (Opr_imm 0) (A_reg ND_NEXT BX))). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_8 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 8) (comml (_movwst (Opr_imm 0)(A_reg ND_NEXT BX))) S S' -> Ast_enQueue_9 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_8, Ast_enQueue_9. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HSS1 [jk HSS2]] [HSS3 [HSS4 HSS5]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX [HDX [HCX HBX]]]]]]]]. subst M' R' fl' isr'. intuition. sep on. assert (MemUpdW M (tid + 2) 0 jk ||- tid |->w tail *^* tid + 2 |->w 0 *^* ptoTCB (tid + 4) tcb *^* ptr |->w head *^* ptr + 2 |->w tail *^* Queue Thread ptoTCB head tail prev 0 (filterTQ T Q) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP). sep lift 1. sep upd. sep matchH HM with 10. unfold MemUpdW in H. rewrite HBX; assumption. unfold SCAP_WFcmd. exists L_enQueue_9_p; exists L_enQueue_9_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX [HDX [HCX HBX]]]]]]]]. exists (MemUpdW M (tid + 2) 0 0, R, fl, isr). simplS in * . apply nextS_movwst with (tid + 2) 0;trivial. unfold addr_eval. rewrite HBX;auto. sep on. sep lift 1 in HM. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp. exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_8_g, L_enQueue_9_g in *. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev . apply Hpp' with S;assumption. Qed. (* : cmpw $0, %dx *) Lemma SCAP_WFcmd_enQueue_9_cmpw : SCAP_WFcmd (SCAP_consCT (L_enQueue + 9 + 1) (Ast L_enQueue_10_p L_enQueue_10_g sctag) psi_enQueue_Block0) (L_enQueue + 9) (Ast L_enQueue_9_p L_enQueue_9_g sctag) (comml (_cmpw (Opr_imm 0) DX)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_9 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 9) (comml (_cmpw (Opr_imm 0) DX)) S S' -> (Ast_enQueue_10_emp T Q ptr tid tcb bp sp prev mP S' \/ Ast_enQueue_10_notemp T Q ptr tid tcb bp sp head tail prev mP S')). unfold Ast_enQueue_9, Ast_enQueue_10_emp, Ast_enQueue_10_notemp. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX [HDX [HCX HBX]]]]]]]]. destruct HSS3 as [HSS3|HSS3];destruct HSS3 as [HSS31 HSS32]. subst M' R' fl' isr'. left. rewrite <- HSS31 in HDX. subst tail. intuition. sep on. sep lift 5 in HM. assert (Head0 := Queue_tail0_head0_1 HM). subst head. sep matchH HM with 10. right. assert (tailn0 : tail > 0). rewrite HDX in HSS31. omega. subst M' R' fl' isr'. intuition. unfold SCAP_WFcmd. exists L_enQueue_10_p; exists L_enQueue_10_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX [HDX [HCX HBX]]]]]]]]. destruct (eq_nat_dec 0 tail). exists (M, R,Set_Flag fl _ZF, isr). simplS in * . apply nextS_cmpw;trivial. left. intuition. simpl. rewrite <- e in HDX;auto. exists (M, R,Clear_Flag fl _ZF, isr). simplS in * . apply nextS_cmpw;trivial. right. intuition. simpl in H. apply n;rewrite <- H in HDX;auto. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_9_p, L_enQueue_10_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb. exists bp; exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_9_g, L_enQueue_10_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev. apply Hpp' with S;assumption. Qed. (* : jne EnQ_NotNull *) Lemma SCAP_WFcmd_enQueue_10_jne : SCAP_WFcmd (SCAP_consCT (L_enQueue + 10 + 1) (Ast L_enQueue_11_p L_enQueue_11_g sctag) psi_enQueue_Block0) (L_enQueue + 10) (Ast L_enQueue_10_p L_enQueue_10_g sctag) (comml (_jne L_enQ_NotNull)). Proof. unfold SCAP_WFcmd. exists L_enQueue_16_p; exists L_enQueue_11_p. exists L_enQueue_16_g; exists L_enQueue_11_g. split. apply psi_cons_b_lookup_a. unfold psi_enQueue_Block0. apply psi_cons_a_lookup_a. split_l. assert (Hget: forall T Q ptr tid tcb bp sp head tail prev mP S, Ast_enQueue_10_notemp T Q ptr tid tcb bp sp head tail prev mP S -> Ast_enQueue_16 T Q ptr tid tcb bp sp head tail prev mP S). unfold Ast_enQueue_10_notemp, Ast_enQueue_16. intros. InvertAll. intuition. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_10_p, L_enQueue_16_p. intros S' H. unfold conjP in H. destruct H as [H1 H2]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. destruct H as [P|P]. destruct P as [HM [Htid [Hsp [HBP [HSP [HAX [HCX HZF]]]]]]]. rewrite H2 in HZF. inversion HZF. exists T; exists Q; exists ptr;exists tid; exists tcb; exists bp. exists sp;exists head; exists tail; exists prev. apply Hget;assumption. split. (* g' ==> g *) unfold L_enQueue_10_g, L_enQueue_16_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [P1 [P2 P3]]. intros T Q ptr tid tcb bp sp head tail prev mP H. destruct H as [P|P]. destruct P as [HM [Htid [Hsp [HBP [HSP [HAX [HCX HZF]]]]]]]. rewrite P2 in HZF. inversion HZF. apply P3 with head tail prev. apply Hget;assumption. assert (Hemp: forall T Q ptr tid tcb bp sp prev mP S, Ast_enQueue_10_emp T Q ptr tid tcb bp sp prev mP S -> Ast_enQueue_11 T Q ptr tid tcb bp sp prev mP S). unfold Ast_enQueue_10_emp, Ast_enQueue_11. intros. InvertAll. intuition. split. (* p ==> p'' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_10_p, L_enQueue_11_p. intros S' H. unfold conjP in H. destruct H as [H1 H2]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. destruct H as [P|P]. exists T; exists Q; exists ptr; exists tid; exists tcb . exists bp; exists sp;exists prev. apply Hemp;assumption. destruct P as [HM [Htid [Hsp [Htail [HBP [HSP [HAX [HDX [HCX [HBX HZF]]]]]]]]]]. rewrite H2 in HZF. inversion HZF. (* g'' ==> g *) unfold L_enQueue_10_g, L_enQueue_11_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [P1 [P2 P3]]. intros T Q ptr tid tcb bp sp head tail prev mP H. destruct H as [P|P]. apply P3 with prev. apply Hemp;assumption. destruct P as [HM [Htid [Hsp [Htail [HBP [HSP [HAX [HDX [HCX [HBX HZF]]]]]]]]]]. rewrite P2 in HZF. inversion HZF. Qed. (* : movw %cx, %bx *) Lemma SCAP_WFcmd_enQueue_11_movwp : SCAP_WFcmd (SCAP_consCT (L_enQueue + 11 + 1) (Ast L_enQueue_12_p L_enQueue_12_g sctag) psi_enQueue_Block0) (L_enQueue + 11) (Ast L_enQueue_11_p L_enQueue_11_g sctag) (comml (_movwp (Opr_reg CX) BX)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp prev mP S S', Ast_enQueue_11 T Q ptr tid tcb bp sp prev mP S -> nextS (L_enQueue + 11) (comml (_movwp (Opr_reg CX) BX)) S S' -> Ast_enQueue_12 T Q ptr tid tcb bp sp prev mP S'). unfold Ast_enQueue_11, Ast_enQueue_12. intros T Q ptr tid tcb bp sp prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX HCX]]]]]]. subst M' R' fl' isr'. rewrite HCX. intuition. unfold SCAP_WFcmd. exists L_enQueue_12_p;exists L_enQueue_12_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [prev HS]]]]]]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX HCX]]]]]]. exists (M, RF_update R BX ptr, fl, isr). simplS in * . apply nextS_movwp with ptr; trivial. unfold opr_eval. rewrite HCX;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_11_p, L_enQueue_12_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [prev H]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp; exists sp; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_11_g, L_enQueue_12_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with prev. apply Hpp' with S;assumption. Qed. (* : movw %ax, Q_HEAD(%bx) *) Lemma SCAP_WFcmd_enQueue_12_movwst : SCAP_WFcmd (SCAP_consCT (L_enQueue + 12 + 1) (Ast L_enQueue_13_p L_enQueue_13_g sctag) psi_enQueue_Block0) (L_enQueue + 12) (Ast L_enQueue_12_p L_enQueue_12_g sctag) (comml (_movwst (Opr_reg AX) (A_reg Q_HEAD BX))). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp prev mP S S', Ast_enQueue_12 T Q ptr tid tcb bp sp prev mP S -> nextS (L_enQueue + 12) (comml (_movwst (Opr_reg AX)(A_reg Q_HEAD BX))) S S' -> Ast_enQueue_13 T Q ptr tid tcb bp sp prev mP S'). unfold Ast_enQueue_12, Ast_enQueue_13. intros T Q ptr tid tcb bp sp prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HSS1 [jk HSS2]] [HSS3 [HSS4 HSS5]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX HBX]]]]]]. subst M' R' fl' isr'. intuition. sep on. assert (MemUpdW M ptr tid jk ||- tid |->w 0 *^* tid + 2 |->w 0 *^* ptoTCB (tid + 4) tcb *^* ptr |->w tid *^* ptr + 2 |->w 0 *^* Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP). sep lift 3. sep upd. sep matchH HM with 10. unfold MemUpdW in H. rewrite HBX; rewrite HAX. arith_rep (ptr+0) with ptr. unfold SCAP_WFcmd. exists L_enQueue_13_p; exists L_enQueue_13_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [prev HS]]]]]]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX HBX]]]]]]. exists (MemUpdW M ptr tid 0, R, fl, isr). simplS in * . apply nextS_movwst with ptr tid;trivial. unfold addr_eval. rewrite HBX;auto. unfold opr_eval. rewrite HAX;auto. sep on. sep lift 3 in HM. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [prev H]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp. exists sp; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_12_g, L_enQueue_13_g in *. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with prev . apply Hpp' with S;assumption. Qed. (* : movw %ax, Q_TAIL(%bx) *) Lemma SCAP_WFcmd_enQueue_13_movwst : SCAP_WFcmd (SCAP_consCT (L_enQueue + 13 + 1) (Ast L_enQueue_14_p L_enQueue_14_g sctag) psi_enQueue_Block0) (L_enQueue + 13) (Ast L_enQueue_13_p L_enQueue_13_g sctag) (comml (_movwst (Opr_reg AX) (A_reg Q_TAIL BX))). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp prev mP S S', Ast_enQueue_13 T Q ptr tid tcb bp sp prev mP S -> nextS (L_enQueue + 13) (comml (_movwst (Opr_reg AX)(A_reg Q_TAIL BX))) S S' -> Ast_enQueue_14 T Q ptr tid tcb bp sp prev mP S'). unfold Ast_enQueue_13, Ast_enQueue_14. intros T Q ptr tid tcb bp sp prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HSS1 [jk HSS2]] [HSS3 [HSS4 HSS5]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX HBX]]]]]]. subst M' R' fl' isr'. intuition. sep on. assert (MemUpdW M (ptr + 2) tid jk ||- tid |->w 0 *^* tid + 2 |->w 0 *^* ptoTCB (tid + 4) tcb *^* ptr |->w tid *^* ptr + 2 |->w tid *^* Queue Thread ptoTCB 0 0 prev 0 (filterTQ T Q) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP). sep lift 4. sep upd. sep matchH HM with 10. unfold MemUpdW in H. rewrite HBX; rewrite HAX. assumption. unfold SCAP_WFcmd. exists L_enQueue_14_p; exists L_enQueue_14_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [prev HS]]]]]]]]. destruct HS as [HM [Htid [Hsp [HBP [HSP [HAX HBX]]]]]]. exists (MemUpdW M (ptr + 2) tid 0, R, fl, isr). simplS in * . apply nextS_movwst with (ptr + 2) tid;trivial. unfold addr_eval. rewrite HBX;auto. unfold opr_eval. rewrite HAX;auto. sep on. sep lift 4 in HM. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [prev H]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp. exists sp; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_13_g, L_enQueue_14_g in *. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with prev . apply Hpp' with S;assumption. Qed. (* : popw %bp *) Lemma SCAP_WFcmd_enQueue_14_popw : SCAP_WFcmd (SCAP_consCT (L_enQueue + 14 + 1) (Ast L_enQueue_15_p L_enQueue_15_g sctag) psi_enQueue_Block0) (L_enQueue + 14) (Ast L_enQueue_14_p L_enQueue_14_g sctag) (comml (_popw BP)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp prev mP S S', Ast_enQueue_14 T Q ptr tid tcb bp sp prev mP S -> nextS (L_enQueue + 14) (comml (_popw BP)) S S' -> Ast_enQueue_15 T Q ptr tid tcb bp sp prev mP S'). unfold Ast_enQueue_14, Ast_enQueue_15. intros T Q ptr tid tcb bp sp prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [[x [HSS2 HSS3]] [HSS4 HSS5]]]. destruct HS as [HM [Htid [Hsp [HBP HSP]]]]. subst M' R' fl' isr'. assert (E : x = bp ). rewrite HSP in HSS2. sep on. sep lift 6 in HM. sep inj;auto. subst x. rewrite HSP. arith_rep (sp-2+2) with sp. intuition. sep on. sep matchH HM with 10. assert (h ||- ptoxW (sp-2)). sep trivial. arith_rep sp with ((sp -2) + 2). sep trivial. unfold SCAP_WFcmd. exists L_enQueue_15_p; exists L_enQueue_15_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [prev HS]]]]]]]]. destruct HS as [HM [Htid [Hsp [HBP HSP]]]]. exists (M, RF_update (RF_update R SP sp) BP bp, fl, isr). simplS in * . apply nextS_popw with (RF_update R SP sp) bp;trivial. unfold popW. rewrite HSP;intuition. sep on. sep lift 6 in HM;sep trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_14_p, L_enQueue_15_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [prev H]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb. exists bp; exists sp; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_14_g, L_enQueue_15_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with prev. apply Hpp' with S;assumption. Qed. (* : retw *) Lemma SCAP_WFcmd_enQueue_15_retw : SCAP_WFcmd psi_enQueue_Block0 (L_enQueue+15) (Ast L_enQueue_15_p L_enQueue_15_g sctag) (comms _retw). Proof. unfold L_enQueue_15_g. simpl. intros S H. intros. unfold Ast_enQueue_15 in H0. InvertAll. exists (TQMod.put T tid tcb); exists (addThrd Q tid). unfold Ast_enQueue_post. intuition. sep on. sep lift 0. apply ptoTQ_intro1 with tid tid 0. sep lift 5 in H1. destruct (Queue_ptr0_emp_1 H1). sep lift 2. assert ((filterTQ (TQMod.put T tid tcb) (addThrd Q tid)) = (fun l' => if eq_nat_dec tid l' then Some tcb else None)). apply TQMod.extensional_eqMap . intro x. assert (filterTQ T Q x = None). rewrite H6;reflexivity;clear H6. unfold filterTQ in * . unfold addThrd. unfold WQMod.put, TQMod.put, WQMod.beq_A, TQMod.beq_A, WQSpec.beq_Domain, TQSpec.beq_Domain. destruct (eq_nat_dec x tid); destruct (eq_nat_dec tid x); auto;(subst tid;elim n;auto). rewrite H7. apply (Queue_cons_fst_intro_1 Thread ptoTCB tid 0 0 tcb (S_Mem S)). unfold ptoNode. sep matchH H4 with 10. assumption. Qed. (* : movw %dx, %bx *) Lemma SCAP_WFcmd_enQueue_16_movwp : SCAP_WFcmd (SCAP_consCT (L_enQueue + 16 + 1) (Ast L_enQueue_17_p L_enQueue_17_g sctag) psi_enQueue_Block1) (L_enQueue + 16) (Ast L_enQueue_16_p L_enQueue_16_g sctag) (comml (_movwp (Opr_reg DX) BX)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_16 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 16) (comml (_movwp (Opr_reg DX) BX)) S S' -> Ast_enQueue_17 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_16,Ast_enQueue_17. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HM [Htid [Hsp [Htail [HBP [HSP [HAX [HDX HCX]]]]]]]]. subst M' R' fl' isr'. rewrite HDX. intuition. unfold SCAP_WFcmd. exists L_enQueue_17_p;exists L_enQueue_17_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HM [Htid [Hsp [Htail [HBP [HSP [HAX [HDX HCX]]]]]]]]. exists (M, RF_update R BX tail, fl, isr). simplS in * . apply nextS_movwp with tail; trivial. unfold opr_eval. rewrite HDX;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_16_p, L_enQueue_17_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp; exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_16_g, L_enQueue_17_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev. apply Hpp' with S;assumption. Qed. (* : movw %ax, ND_NEXT(%bx) *) Lemma SCAP_WFcmd_enQueue_17_movwst : SCAP_WFcmd (SCAP_consCT (L_enQueue + 17 + 1) (Ast L_enQueue_18_p L_enQueue_18_g sctag) psi_enQueue_Block1) (L_enQueue + 17) (Ast L_enQueue_17_p L_enQueue_17_g sctag) (comml (_movwst (Opr_reg AX) (A_reg ND_NEXT BX))). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_17 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 17) (comml (_movwst (Opr_reg AX)(A_reg ND_NEXT BX))) S S' -> Ast_enQueue_18 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_17, Ast_enQueue_18. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HSS1 [jk HSS2]] [HSS3 [HSS4 HSS5]]]. destruct HS as [HM [Htid [Hsp [Htail [HBP [HSP [HAX [HCX HBX]]]]]]]]. subst M' R' fl' isr'. intuition. sep on. sep lift 5 in HM. rewrite HAX; rewrite HBX. substH HM with (Queue_upd_next_1 tid jk HM Htail ). sep matchH HM with 10. unfold SCAP_WFcmd. exists L_enQueue_18_p; exists L_enQueue_18_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HM [Htid [Hsp [Htail [HBP [HSP [HAX [HCX HBX]]]]]]]]. exists (MemUpdW M (tail + 2) tid 0, R, fl, isr). simplS in * . apply nextS_movwst with (tail+2) tid;trivial. unfold addr_eval. rewrite HBX;auto. simpl;auto. sep on. sep lift 5 in HM. substH HM with (Queue_unemp_split_1 HM Htail). destruct HM as [Q' [tcb' [prev' [head' [tail' [HM P]]]]]]. unfold ptoNode in HM. sep lift 1 in HM. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_17_p, L_enQueue_18_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp. exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_17_g, L_enQueue_18_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev . apply Hpp' with S;assumption. Qed. (* : movw %cx, %bx *) Lemma SCAP_WFcmd_enQueue_18_movwp : SCAP_WFcmd (SCAP_consCT (L_enQueue + 18 + 1) (Ast L_enQueue_19_p L_enQueue_19_g sctag) psi_enQueue_Block1) (L_enQueue + 18) (Ast L_enQueue_18_p L_enQueue_18_g sctag) (comml (_movwp (Opr_reg CX) BX)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_18 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 18) (comml (_movwp (Opr_reg CX) BX)) S S' -> Ast_enQueue_19 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_18,Ast_enQueue_19. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [HSS2 [HSS3 HSS4]]]. destruct HS as [HM [Htid [Hsp [Htail [HBP [HSP [HAX HCX]]]]]]]. subst M' R' fl' isr'. rewrite HCX. intuition. unfold SCAP_WFcmd. exists L_enQueue_19_p;exists L_enQueue_19_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HM [Htid [Hsp [Htail [HBP [HSP [HAX HCX]]]]]]]. exists (M, RF_update R BX ptr, fl, isr). simplS in * . apply nextS_movwp with ptr; trivial. unfold opr_eval. rewrite HCX;reflexivity. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_18_p, L_enQueue_19_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp; exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_18_g, L_enQueue_19_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev. apply Hpp' with S;assumption. Qed. (* : movw %ax, Q_TAIL(%bx) *) Lemma SCAP_WFcmd_enQueue_19_movwst : SCAP_WFcmd (SCAP_consCT (L_enQueue + 19 + 1) (Ast L_enQueue_20_p L_enQueue_20_g sctag) psi_enQueue_Block1) (L_enQueue + 19) (Ast L_enQueue_19_p L_enQueue_19_g sctag) (comml (_movwst (Opr_reg AX) (A_reg Q_TAIL BX))). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_19 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 19) (comml (_movwst (Opr_reg AX)(A_reg Q_TAIL BX))) S S' -> Ast_enQueue_20 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_19, Ast_enQueue_20. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [[HSS1 [jk HSS2]] [HSS3 [HSS4 HSS5]]]. destruct HS as [HM [Htid [Hsp [Htail [HBP [HSP [HAX HBX]]]]]]]. subst M' R' fl' isr'. intuition. sep on. assert (MemUpdW M (ptr + 2) tid jk ||- tid |->w tail *^* tid + 2 |->w 0 *^* ptoTCB (tid + 4) tcb *^* ptr |->w head *^* ptr + 2 |->w tid *^* Queue Thread ptoTCB head tail prev tid (filterTQ T Q) *^* sp - 2 |->w bp *^* sp + 2 |->w tid *^* sp + 4 |->w ptr *^* mP). sep lift 4. sep upd. sep matchH HM with 10. rewrite HAX; rewrite HBX. unfold MemUpdW in H. assumption. unfold SCAP_WFcmd. exists L_enQueue_20_p; exists L_enQueue_20_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HM [Htid [Hsp [Htail [HBP [HSP [HAX HBX]]]]]]]. exists (MemUpdW M (ptr + 2) tid 0, R, fl, isr). simplS in * . apply nextS_movwst with (ptr+2) tid;trivial. unfold addr_eval. rewrite HBX;auto. simpl;auto. sep on. sep lift 4 in HM. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_19_p, L_enQueue_20_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb; exists bp. exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_19_g, L_enQueue_20_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev . apply Hpp' with S;assumption. Qed. (* : popw %bp *) Lemma SCAP_WFcmd_enQueue_20_popw : SCAP_WFcmd (SCAP_consCT (L_enQueue + 20 + 1) (Ast L_enQueue_21_p L_enQueue_21_g sctag) psi_enQueue_Block1) (L_enQueue + 20) (Ast L_enQueue_20_p L_enQueue_20_g sctag) (comml (_popw BP)). Proof. assert (Hpp': forall T Q ptr tid tcb bp sp head tail prev mP S S', Ast_enQueue_20 T Q ptr tid tcb bp sp head tail prev mP S -> nextS (L_enQueue + 20) (comml (_popw BP)) S S' -> Ast_enQueue_21 T Q ptr tid tcb bp sp head tail prev mP S'). unfold Ast_enQueue_20, Ast_enQueue_21. intros T Q ptr tid tcb bp sp head tail prev mP S S' HS HSS'. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. simplS in * . substH HSS' with (nextS_inversion HSS'). simpl in HSS'. destruct HSS' as [HSS1 [[x [HSS2 HSS3]] [HSS4 HSS5]]]. destruct HS as [HM [Htid [Hsp [Htail [HBP HSP]]]]]. subst M' R' fl' isr'. assert (E : x = bp ). rewrite HSP in HSS2. sep on. sep lift 6 in HM. sep inj;auto. subst x. rewrite HSP. arith_rep (sp-2+2) with sp. intuition. sep on. sep matchH HM with 10. assert (h ||- ptoxW (sp-2)). sep trivial. arith_rep sp with ((sp -2) + 2). sep trivial. unfold SCAP_WFcmd. exists L_enQueue_21_p; exists L_enQueue_21_g. split_l. split. (* enable *) unfold enable. intros S PS. destruct S as [[[M R] fl] isr]. destruct PS as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev HS]]]]]]]]]]. destruct HS as [HM [Htid [Hsp [Htail [HBP HSP]]]]]. exists (M, RF_update (RF_update R SP sp) BP bp, fl, isr). simplS in * . apply nextS_popw with (RF_update R SP sp) bp;trivial. unfold popW. rewrite HSP;intuition. sep on. sep lift 6 in HM;sep trivial. split. (* p ==> p' *) unfold pimp. unfold linkPG, conjPG, conjG. unfold L_enQueue_20_p, L_enQueue_21_p. intros S' H. destruct H as [S [H1 H2]]. destruct H1 as [T [Q [ptr [tid [tcb [bp [sp [head [tail [prev H]]]]]]]]]]. exists T; exists Q; exists ptr; exists tid; exists tcb. exists bp; exists sp; exists head; exists tail; exists prev. apply Hpp' with S; assumption. (* g' ==> g *) unfold L_enQueue_20_g, L_enQueue_21_g. intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[Hps HnextSS'] HgS'S'']. intros. apply HgS'S'' with head tail prev. apply Hpp' with S;assumption. Qed. (* : retw *) Lemma SCAP_WFcmd_enQueue_21_retw : SCAP_WFcmd psi_enQueue_Block1 (L_enQueue+21) (Ast L_enQueue_21_p L_enQueue_21_g sctag) (comms _retw). Proof. unfold L_enQueue_21_g. simpl. intros S H. intros. unfold Ast_enQueue_21 in H0. InvertAll. exists (TQMod.put T tid tcb); exists (addThrd Q tid). unfold Ast_enQueue_post. intuition. sep on. sep lift 0. apply ptoTQ_intro1 with head tid prev. sep lift 2. assert ((filterTQ (TQMod.put T tid tcb) (addThrd Q tid)) = (fun l' => if eq_nat_dec tid l' then Some tcb else (filterTQ T Q) l')). apply TQMod.extensional_eqMap. intro x. unfold filterTQ, addThrd. unfold WQMod.put, TQMod.put. unfold WQMod.beq_A, TQMod.beq_A, WQSpec.beq_Domain, TQSpec.beq_Domain. destruct (eq_nat_dec x tid); destruct (eq_nat_dec tid x); try reflexivity; rewrite e in n; elim n; reflexivity. rewrite H5. apply (Queue_cons_more_intro_1 Thread ptoTCB head tail prev (filterTQ T Q) (S_Mem S) tid 0 tcb). unfold ptoNode. sep matchH H1 with 10. assumption. assumption. Qed. Lemma SCAP_WFiseq_enQueue_Block0 : SCAP_WFiseq psi_enQueue_Block0 L_enQueue spec_enQueue I_enQueue. Proof. unfold I_enQueue, spec_enQueue. apply scap_isq_seq with L_enQueue_1_p L_enQueue_1_g. apply SCAP_WFcmd_enQueue_0_pushw. apply scap_isq_seq with L_enQueue_2_p L_enQueue_2_g. apply SCAP_WFcmd_enQueue_1_movwp. assert (H : L_enQueue+1+1 = L_enQueue+2); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_3_p L_enQueue_3_g. apply SCAP_WFcmd_enQueue_2_movwld. assert (H : L_enQueue+2+1 = L_enQueue+3); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_4_p L_enQueue_4_g. apply SCAP_WFcmd_enQueue_3_movwld. assert (H : L_enQueue+3+1 = L_enQueue+4); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_5_p L_enQueue_5_g. apply SCAP_WFcmd_enQueue_4_movwld. assert (H : L_enQueue+4+1 = L_enQueue+5); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_6_p L_enQueue_6_g. apply SCAP_WFcmd_enQueue_5_movwp. assert (H : L_enQueue+5+1 = L_enQueue+6); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_7_p L_enQueue_7_g. apply SCAP_WFcmd_enQueue_6_movwp. assert (H : L_enQueue+6+1 = L_enQueue+7); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_8_p L_enQueue_8_g. apply SCAP_WFcmd_enQueue_7_movwst. assert (H : L_enQueue+7+1 = L_enQueue+8); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_9_p L_enQueue_9_g. apply SCAP_WFcmd_enQueue_8_movwst. assert (H : L_enQueue+8+1 = L_enQueue+9); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_10_p L_enQueue_10_g. apply SCAP_WFcmd_enQueue_9_cmpw. assert (H : L_enQueue+9+1 = L_enQueue+10); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_11_p L_enQueue_11_g. apply SCAP_WFcmd_enQueue_10_jne. assert (H : L_enQueue+10+1 = L_enQueue+11); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_12_p L_enQueue_12_g. apply SCAP_WFcmd_enQueue_11_movwp. assert (H : L_enQueue+11+1 = L_enQueue+12); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_13_p L_enQueue_13_g. apply SCAP_WFcmd_enQueue_12_movwst. assert (H : L_enQueue+12+1 = L_enQueue+13); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_14_p L_enQueue_14_g. apply SCAP_WFcmd_enQueue_13_movwst. assert (H : L_enQueue+13+1 = L_enQueue+14); [omega | rewrite H; clear H]. apply scap_isq_seq with L_enQueue_15_p L_enQueue_15_g. apply SCAP_WFcmd_enQueue_14_popw. assert (H : L_enQueue+14+1 = L_enQueue+15); [omega | rewrite H; clear H]. apply scap_isq_end. apply SCAP_WFcmd_enQueue_15_retw. Qed. Lemma SCAP_WFiseq_enQueue_Block1 : SCAP_WFiseq psi_enQueue_Block1 L_enQ_NotNull (Ast L_enQueue_16_p L_enQueue_16_g sctag) I_enQ_NotNull. Proof. unfold I_enQ_NotNull, L_enQ_NotNull. apply scap_isq_seq with L_enQueue_17_p L_enQueue_17_g. apply SCAP_WFcmd_enQueue_16_movwp. apply scap_isq_seq with L_enQueue_18_p L_enQueue_18_g. arith_rep (L_enQueue + 16 + 1) with (L_enQueue + 17). apply SCAP_WFcmd_enQueue_17_movwst. apply scap_isq_seq with L_enQueue_19_p L_enQueue_19_g. arith_rep (L_enQueue + 16 + 1 + 1) with (L_enQueue + 18). apply SCAP_WFcmd_enQueue_18_movwp. apply scap_isq_seq with L_enQueue_20_p L_enQueue_20_g. arith_rep (L_enQueue + 16 + 1 + 1 + 1) with (L_enQueue + 19). apply SCAP_WFcmd_enQueue_19_movwst. apply scap_isq_seq with L_enQueue_21_p L_enQueue_21_g. arith_rep (L_enQueue + 16 + 1 + 1+ 1 + 1) with (L_enQueue + 20). apply SCAP_WFcmd_enQueue_20_popw. arith_rep (L_enQueue + 16 + 1 + 1+ 1 + 1) with (L_enQueue + 20). apply scap_isq_end. apply SCAP_WFcmd_enQueue_21_retw. Qed. coq/miniOS/BlockProof.v0000644000107400000620000015631711000223231014477 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import Reg. Require Import Assertion_Lemmas3. Require Import Assertion_Lemmas4. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Require Import Linking_Lemmas3. Require Import Kernel. Require Import BlockSpec. (******** Block *************************** # precondition requires that interrupt be disabled # block(q) 1158 : movw (curr_thrd), %bx #curr_thrd = 2254 movw $BLOCKED, TCB_STATUS(%bx) 1160 movw %sp, TCB_STACK(%bx) movw %sp, %bp movw 2(%bp), %ax pushw %ax #BlockQ pushw %bx 1165 call enQueue (1190) pushw $readyQ #readyQ = 2250 call deQueue (1212) # note that we can always find a thread in the readyQ # because our program logic guarantees the idle thread # will never be blocked. So the idle thread must always # be in the ready queue at this moment addw $6, %sp movw %ax, %bx 1170 movw %ax, (curr_thrd) movw TCB_STACK(%bx), %sp 1172 retw ************************************************) (* : movw (curr_thrd), %bx #curr_thrd = 2254 *) Lemma SCAP_WFcmd_block_0_movwld : SCAP_WFcmd (SCAP_consCT (L_block+1) (Ast p_block_1 g_block_1 sctag) psi_block) (L_block) (Ast p_block g_block sctag) (comml (_movwld (A_imm curr_thrd) BX)). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S S', Ast_block_pre T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> nextS (L_block) (comml (_movwld (A_imm curr_thrd) BX)) S S' -> Ast_block_1 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S'). intros T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S S' HS HSS'. unfold Ast_block_pre, Ast_block_1 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [tidx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]. assert (Heq : tidx = tid). unfold addr_eval in Hlds. sep on. sep lift 0 in HM. sep inj. auto. subst tidx M' R' fl' isr'. reg simpl. repeat split_l. trivial. simpl. exists p_block_1; exists g_block_1. split_l. split. (* enable *) unfold enable. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_block in HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. unfold Ast_block_pre in HS. destruct HS as [HM [Hsp [Hspg [HRT [HtR [Hex [Htcb Hmto]]]]]]]. simplS in * . exists (M, RF_update R BX tid, fl, isr). apply nextS_movwld with curr_thrd tid; trivial. sep on. sep lift 0 in HM. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_block, p_block_1. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists tid; exists tcb; exists sp; exists pc; exists jk1; exists jk2. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold g_block, g_block_1 in * . intros mP T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 HS. eapply HgS'S''; eauto. Qed. (* : movw $BLOCKED, TCB_STATUS(%bx) *) Lemma SCAP_WFcmd_block_1_movwst : SCAP_WFcmd (SCAP_consCT (L_block+1+1) (Ast p_block_2 g_block_2 sctag) psi_block) (L_block+1) (Ast p_block_1 g_block_1 sctag) (comml (_movwst (Opr_imm 2) (A_reg TCB_STATUS BX))). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S S', Ast_block_1 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> nextS (L_block+1) (comml (_movwst (Opr_imm 2) (A_reg TCB_STATUS BX))) S S' -> Ast_block_2 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S'). intros T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S S' HS HSS'. unfold Ast_block_1, Ast_block_2 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hlds HM']. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simpl in Hlds. simplS in * . destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]. subst M' R' fl' isr'. split. sep on. unfold TCB_STATUS. unfold embed_TCB in * . sep lift 3 in HM. sep lift 3. apply ptoTCB_intro1 with 2. substH HM with (ptoTCB_elim1 HM). destruct HM as [tst [HM Htst]]. sep lift 1 in HM. sep lift 1. arith_rep (tid + 4 + 2) with (tid + 6). arith_rep (tid + 4 + 2) with (tid + 6) in HM. rewrite Hbx. sep upd. destruct tcb as [[spx statusx] pcx]. unfold TCB_SP, TCB_Status_Upd in * . sep matchH HM with 8. destruct tcb as [[spx statusx] pcx]. unfold TCB_SP, TCB_Status, TCB_Status_Upd in * . simpl; trivial. repeat split_l; trivial. simpl. exists p_block_2; exists g_block_2. split_l. split. (* enable movw *) unfold enable, p_block_1. intros S H. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. unfold Ast_block_1 in HS. destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (M' := MemUpdW M (tid + 6) 2 0). exists (M', R, fl, isr). apply nextS_movwst with (tid + 6) 2; auto. unfold addr_eval, TCB_STATUS. rewrite Hbx; trivial. unfold embed_TCB in HM. sep on. sep lift 3 in HM. substH HM with (ptoTCB_elim1 HM). destruct HM as [tst [HM Htst]]. sep lift 1 in HM. arith_rep (tid + 4 + 2) with (tid + 6) in HM. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* p ==> p' *) unfold p_block_1, p_block_2. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists tid; exists tcb; exists sp; exists pc; exists jk1; exists jk2. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HSS']]. unfold g_block_1, g_block_2 in * . intros mP T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 HS. eapply HSS'; eauto. Qed. (* : movw %sp, TCB_STACK(%bx) *) Lemma SCAP_WFcmd_block_2_movwst : SCAP_WFcmd (SCAP_consCT (L_block+2+1) (Ast p_block_3 g_block_3 sctag) psi_block) (L_block+2) (Ast p_block_2 g_block_2 sctag) (comml (_movwst (Opr_reg SP) (A_reg TCB_STACK BX))). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S S', Ast_block_2 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> nextS (L_block+2) (comml (_movwst (Opr_reg SP) (A_reg TCB_STACK BX))) S S' -> Ast_block_3 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S'). intros T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S S' HS HSS'. unfold Ast_block_2, Ast_block_3 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hlds HM']. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simpl in Hlds. simplS in * . destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]. subst M' R' fl' isr'. destruct tcb as [[spx statusx] pcx]. unfold TCB_Status, TCB_Status_Upd in * . split. unfold embed_TCB in * . sep on. unfold TCB_STACK. sep lift 3 in HM. sep lift 3. apply ptoTCB_intro1 with 2. substH HM with (ptoTCB_elim1 HM). destruct HM as [tst [HM Htst]]. sep lift 0 in HM. sep lift 0. unfold TCB_SP in * . rewrite Hbx. rewrite Hsp. sep upd. assert (Htst' : tst = 2). destruct tst; simpl in Htst. discriminate Htst. destruct tst; simpl in Htst. discriminate Htst. destruct tst; simpl in Htst. trivial. discriminate Htst. subst tst. sep matchH HM with 8. simpl; trivial. repeat split_l; trivial. simpl. exists p_block_3; exists g_block_3. split_l. split. (* enable movw *) unfold enable, p_block_2. intros S H. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. unfold Ast_block_2 in HS. destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (M' := MemUpdW M (tid + 4) sp 0). exists (M', R, fl, isr). apply nextS_movwst with (tid + 4) sp; auto. unfold addr_eval, TCB_STACK. rewrite Hbx; trivial. unfold embed_TCB in * . sep on. sep lift 3 in HM. substH HM with (ptoTCB_elim1 HM). destruct HM as [tst [HM Htst]]. sep lift 0 in HM. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* p ==> p' *) unfold p_block_2, p_block_3. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists tid; exists tcb; exists sp; exists pc; exists jk1; exists jk2. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HSS']]. unfold g_block_2, g_block_3 in * . intros mP T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 HS. eapply HSS'; eauto. Qed. (* : movw %sp, %bp *) Lemma SCAP_WFcmd_block_3_movwp : SCAP_WFcmd (SCAP_consCT (L_block+3+1) (Ast p_block_4 g_block_4 sctag) psi_block) (L_block+3) (Ast p_block_3 g_block_3 sctag) (comml (_movwp (Opr_reg SP) BP)). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S S', Ast_block_3 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> nextS (L_block+3) (comml (_movwp (Opr_reg SP) BP)) S S' -> Ast_block_4 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S'). intros T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S S' HS HSS'. unfold Ast_block_3, Ast_block_4 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]. subst M' R' fl' isr'. reg simpl. repeat split_l; trivial. simpl. exists p_block_4; exists g_block_4. split_l. split. (* enable movw *) unfold enable, p_block_3. intros S H. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. unfold Ast_block_3 in HS. destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (R' := RF_update R BP sp). exists (M, R', fl, isr). apply nextS_movwp with sp; auto. split. (* p ==> p' *) unfold p_block_3, p_block_4. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists tid. exists tcb; exists sp; exists pc; exists jk1; exists jk2. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HS'S'']]. unfold g_block_3, g_block_4 in * . intros mP T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 HS. eapply HS'S''; eauto. Qed. (* : movw 2(%bp), %ax *) Lemma SCAP_WFcmd_block_4_movwld : SCAP_WFcmd (SCAP_consCT (L_block+4+1) (Ast p_block_5 g_block_5 sctag) psi_block) (L_block+4) (Ast p_block_4 g_block_4 sctag) (comml (_movwld (A_reg 2 BP) AX)). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S S', Ast_block_4 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> nextS (L_block+4) (comml (_movwld (A_reg 2 BP) AX)) S S' -> Ast_block_5 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S'). intros T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S S' HS HSS'. unfold Ast_block_4, Ast_block_5 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [l_ptrx [Hlds HR']]. simplS in * . destruct HS as [HM [Hbx [Hsp [Hbp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]]. assert (Heq : l_ptrx = l_ptr). unfold addr_eval in Hlds. rewrite Hbp in Hlds. sep on. sep lift 7 in HM. sep inj. auto. subst l_ptrx M' R' fl' isr'. reg simpl. repeat split_l; trivial. simpl. exists p_block_5; exists g_block_5. split_l. split. (* enable *) unfold enable. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_block_4 in HS. destruct HS as [T [RdyQ [BlkQ [ltr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. unfold Ast_block_4 in HS. destruct HS as [HM [Hbx [Hsp [Hbp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]]. simplS in * . exists (M, RF_update R AX ltr, fl, isr). apply nextS_movwld with (sp+2) ltr; auto. unfold addr_eval; rewrite Hbp; trivial. sep on. sep lift 7 in HM. apply ptoW_leadsToW1 with mTrue. sep subst_left with (sp + 2 |-> ltr *^* sp + 2 + 1 |->_). arith_rep (sp + 2 + 1) with (sp + 3). sep lift 0. sep match_left HM. sep lift 0 in HM. sep match_left HM. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_block_4, p_block_5. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [ltr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists ltr. exists tid; exists tcb; exists sp; exists pc; exists jk1; exists jk2. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold p_block_4, g_block_5 in * . intros mP T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 HS. eapply HgS'S''; eauto. Qed. (* : pushw %ax #BlockQ *) Lemma SCAP_WFcmd_block_5_pushwp : SCAP_WFcmd (SCAP_consCT (L_block+5+1) (Ast p_block_6 g_block_6 sctag) psi_block) (L_block+5) (Ast p_block_5 g_block_5 sctag) (comml (_pushwp (Opr_reg AX))). Proof. assert (Hpp' : forall T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 mP S S', Ast_block_5 T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 mP S -> nextS (L_block+5) (comml (_pushwp (Opr_reg AX))) S S' -> Ast_block_6 T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 mP S'). intros T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 mP S S' HS HSS'. unfold Ast_block_5, Ast_block_6 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hax [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]]. split. subst M' R' fl' isr'. sep on. sep lift 5. rewrite Hsp. rewrite Hax. sep upd. sep matchH HM with 7. sep stksplit in HM. sep trivial. subst R' fl' isr'; reg simpl. rewrite Hsp; rewrite Hbx. repeat split_l; trivial. simpl. exists p_block_6; exists g_block_6. split_l. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold p_block_5 in HpS. destruct HpS as [T [RdyQ [BlkQ [ltr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. exists (MemUpdW M (sp-2) (R AX) 0, RF_update R SP (sp - 2), fl, isr). apply nextS_pushwp with (R AX); trivial. unfold pushW. destruct HS as [HM [Hax [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]]. simplS in * . rewrite Hsp; rewrite Hax. split. apply stkSpace_weaken with (_BLK_Stk); [idtac | omega]. sep on. sep lift 4 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_block_5, g_block_6. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [ltr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists ltr; exists tid; exists tcb; exists sp; exists pc; exists jk1; exists jk2. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold p_block_5, g_block_6 in * . intros mP T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 HS. eapply HgS'S''; eauto. Qed. (* : pushw %bx *) Lemma SCAP_WFcmd_block_6_pushwp : SCAP_WFcmd (SCAP_consCT (L_block+6+1) (Ast p_block_7 g_block_7 sctag) psi_block) (L_block+6) (Ast p_block_6 g_block_6 sctag) (comml (_pushwp (Opr_reg BX))). Proof. assert (Hpp' : forall T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 mP S S', Ast_block_6 T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 mP S -> nextS (L_block+6) (comml (_pushwp (Opr_reg BX))) S S' -> Ast_block_7 T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 mP S'). intros T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 mP S S' HS HSS'. unfold Ast_block_6, Ast_block_7 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]. split. subst M' R' fl' isr'. sep on. sep lift 5. rewrite Hsp. rewrite Hbx. arith_rep (sp - 2 - 2) with (sp - 4). sep upd. sep matchH HM with 10. sep stksplit in HM. arith_rep (sp - 2 - 2) with (sp - 4) in HM. subst R' fl' isr'; reg simpl. rewrite Hsp; rewrite Hbx. split_l. split_l by omega. repeat split_l; trivial. simpl. exists p_block_7; exists g_block_7. split_l. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold p_block_6 in HpS. destruct HpS as [T [RdyQ [BlkQ [ltr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. exists (MemUpdW M (sp-4) (R BX) 0, RF_update R SP (sp - 4), fl, isr). apply nextS_pushwp with (R BX); trivial. unfold pushW. destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]. simplS in * . rewrite Hsp; rewrite Hbx. split. apply stkSpace_weaken with (_BLK_Stk - 2); [idtac | omega]. sep on. sep lift 4 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. arith_rep (sp - 2 - 2) with (sp - 4). arith_rep (sp - 2 - 2) with (sp - 4). split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_block_6, p_block_7. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [ltr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists ltr; exists tid; exists tcb; exists sp; exists pc; exists jk1; exists jk2. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold g_block_6, g_block_7 in * . intros mP T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 HS. eapply HgS'S''; eauto. Qed. (* : call enQueue (1190) *) Lemma SCAP_WFcmd_block_7_call : SCAP_WFcmd (SCAP_consCT (L_block+7+1) (Ast p_block_8 g_block_8 sctag) psi_block) (L_block+7) (Ast p_block_7 g_block_7 sctag) (comml (_call L_enQueue)). Proof. assert(Hpp' : forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mQ mP S S', Ast_block_7 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> nextS (L_block+7) (comml (_call L_enQueue)) S S' -> mQ = (stkSpacePrec (sp - 8) 2 *^* (curr_thrd |->w tid) *^* (embed_RdyQ T RdyQ) *^* (sp - 6 |->w (L_block+7+1)) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2)) -> Ast_enQueue_pre T BlkQ l_ptr tid (sp, BLOCKED, pc) (S_RF S' BP) (sp - 6) (mQ *^* mP) S'). intros T RdyQ BlkQ ltr tid tcb sp pc jk1 jk2 mQ mP S S'. intros HS HSS' HmQ. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold Ast_block_7 in HS. destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspx [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. unfold Ast_enQueue_pre. simplS in * . reg simpl. split. sep on. rewrite Hsp. arith_rep (sp - 4 - 2) with (sp - 6). subst mQ. sep lift 8. sep upd. sep lift 4 in HM. sep stksplit in HM. arith_rep (sp - 4 - 2) with (sp - 6) in HM. sep stksplit 2 in HM. arith_rep (sp - 6 - 2) with (sp - 8) in HM. arith_rep (10 - 4 - 2 - 2) with 2 in HM. unfold embed_BlkQ in HM. arith_rep (sp - 6 + 2) with (sp - 4). arith_rep (sp - 6 + 4) with (sp - 2). sep matchH HM with 11. split. assert (tid <> 0). apply HT. exists tcb; trivial. clear HM Hbx Hsp Hspg Hex Htcb Hmto Hlds HSS'. induction tid. destruct (H (refl_equal _)). clear IHtid H. omega. rewrite Hsp; omega. assert (Hpp''' : forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 pc' mP S S' S'' S''', Ast_block_7 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 mP S -> nextS (L_block+7) (comml (_call L_enQueue)) S S' -> g_enQueue S' S'' -> nextS pc' (comms (_retw)) S'' S''' -> exists T', exists BlkQ', Ast_block_8 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mP S'''). intros T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 pc' mP. intros S S' S'' S''' HS HSS' HS'S'' HS''S'''. exists (TQMod.put T tid (sp, BLOCKED, pc)). exists (addThrd BlkQ tid). unfold g_enQueue in HS'S''. set (mQ := (stkSpacePrec (sp - 8) 2 *^* (curr_thrd |->w tid) *^* (embed_RdyQ T RdyQ) *^* (sp - 6 |->w (L_block+7+1)) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2))). assert (HS' : Ast_enQueue_pre T BlkQ l_ptr tid (sp, BLOCKED, pc) (S_RF S' BP) (sp-6) (mQ *^* mP) S'). apply Hpp' with RdyQ tcb jk1 jk2 S; trivial. assert (HgS'' := HS'S'' _ _ _ _ _ _ _ _ HS'). destruct HgS'' as [T' [BlkQ' [HS'' [HT' HBlkQ']]]]. subst mQ. clear HS'S''. unfold Ast_enQueue_post in HS''. unfold Ast_block_8. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. destruct HS as [HM [Hbx [Hsp [Hspg HS]]]]. destruct HS as [HRT [HtR [Hex [Htcb [Hmto HT]]]]]. simplS in * . destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pcx [Hlds HR''']]. destruct HS'' as [HM'' [HBP'' HSP'']]. assert (Hpcx : pcx = L_block + 7 + 1). subst R' M''' R'''. clear Hpp' HT HRT HtR Hex Htcb Hmto. clear Hbx Hsp Hspg HM HS' HS''S''' HM'. clear HT' HBlkQ' HSS'. subst fl' isr' fl''' isr'''. rewrite HSP'' in Hlds; clear HSP''. sep on. sep lift 7 in HM''. sep_inj. auto. subst pcx; clear Hlds. subst M''' R''' fl''' isr'''. reg simpl. rewrite HSP''. arith_rep (sp - 6 + 2) with (sp - 4) in HM''. arith_rep (sp - 6 + 4) with (sp - 2) in HM''. arith_rep (sp - 6 + 2) with (sp - 4). split. unfold embed_BlkQ. rewrite <- HT'. rewrite <- HBlkQ'. unfold embed_RdyQ in * . rewrite (filterTQ_prev _ _ _ _ _ HRT HtR HT'). sep on. sep matchH HM'' with 9. sep stksplit. arith_rep (sp - 4 - 2) with (sp - 6). sep stksplit 2. arith_rep (10-4-2-2) with 2. arith_rep (sp-6-2) with (sp-8). sep matchH HM'' with 3. repeat split_l; trivial. simpl. exists p_enQueue; exists p_block_8. exists g_enQueue; exists g_block_8. split. unfold SCAP_lookupCT, SCAP_consCT. apply SPSpec.lookup_merge_intro_r. apply L_enQueue_in_psi_block. split_l. split. clear Hpp' Hpp'''. unfold enable, p_block_7. intros S HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. unfold Ast_block_7 in HS. destruct HS as [HM [Hbx [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto HT]]]]]]]]]. (* enable call *) destruct S as [[[M R] fl] isr]. simplS in * . exists (MemUpdW M (sp - 4 - 2) (L_block+7+1) 0, RF_update R SP (sp - 4 - 2), fl, isr). apply nextS_call. unfold pushW. split. apply stkSpacePrec_stkSpace1 with mTrue. rewrite Hsp. sep on. sep lift 4 in HM. sep stksplit 2 in HM. sep matchH HM with 10. split. rewrite Hsp. apply MemUpdW_MemUpd16 with 0; trivial. rewrite Hsp; trivial. split. (* g' => fun_frame *) unfold sp_call_pred, fun_frame. unfold linkPG, conjPG. intros S' S'' HS'S''. destruct HS'S'' as [H HS'S'']. destruct H as [S [HS HSS']]. unfold p_enQueue in HS'S''. destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. set (mQ := (stkSpacePrec (sp - 8) 2 *^* (curr_thrd |->w tid) *^* (embed_RdyQ T RdyQ) *^* (sp - 6 |->w (L_block+7+1)) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2))). assert (HS' : Ast_enQueue_pre T BlkQ l_ptr tid (sp, BLOCKED, pc) (S_RF S' BP) (sp - 6) (mQ *^* mTrue) S'). eapply Hpp'; eauto. clear Hpp' HS HSS' Hpp'''. substH HS'S'' with (HS'S'' _ _ _ _ _ _ _ _ HS'). destruct HS'S'' as [T' [BlkQ' HS'']]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. simplS in * . destruct HS'' as [HS'' _]. unfold Ast_enQueue_pre, Ast_enQueue_post in * . destruct HS' as [HM' [Htid [HBP' HSP']]]. destruct HS'' as [HM'' [HBP'' HSP'']]. simplS in * . split. rewrite HSP'; rewrite HSP''; trivial. unfold Ret_Addr. exists (L_block + 7 + 1). simplS. split. intros pc''. apply nextPC_retw with (sp - 6); trivial. clear HM''. sep on. subst mQ. sep lift 8 in HM'. sep trivial. intros pc''. apply nextPC_retw with (sp - 6); trivial. clear HM'. sep on. subst mQ. sep lift 7 in HM''. sep trivial. split. (* p => p' *) intros S' H. unfold conjPG, conjG, linkPG in H. destruct H as [S [HS HnextSS']]. unfold p_block_7 in HS. unfold p_enQueue. destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. exists T; exists BlkQ; exists l_ptr; exists tid; exists (sp, BLOCKED, pc). exists (S_RF S' BP); exists (sp - 6). set (mQ := (stkSpacePrec (sp - 8) 2 *^* (curr_thrd |->w tid) *^* (embed_RdyQ T RdyQ) *^* (sp - 6 |->w (L_block+7+1)) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2))). assert (H : Ast_enQueue_pre T BlkQ l_ptr tid (sp, BLOCKED, pc) (S_RF S' BP) (sp - 6) (mQ *^* mTrue) S'). eapply Hpp'; eauto. clear Hpp''' HS HnextSS'. unfold Ast_enQueue_pre in * . destruct H as [HM' [Htid [HBP' HSP']]]. split. sep on. sep matchH HM' with 10. auto. split. (* p => p''' *) intros pc' S'''. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S H]. destruct H as [HS H]. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. unfold p_block_7, g_block_8 in * . destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. assert (H : exists T', exists BlkQ', Ast_block_8 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mTrue S'''). eapply Hpp'''; eauto. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists tid; exists tcb; exists sp; exists pc; exists jk1; exists jk2. apply H. (* g''' => g *) intros pc' S S'''' H. unfold conjPG, wrap_fun, conjG, linkPG in H. destruct H as [S''' [HS HS'''S'''']]. destruct HS as [HSx [S'' [Hx HnextS'']]]. destruct Hx as [S' [HSS' HS'S'']]. unfold p_block_7, g_block_8 in * . intros mP T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 HS. assert (H : exists T', exists BlkQ', Ast_block_8 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mP S'''). eapply Hpp'''; eauto. destruct H as [T' [BlkQ' HS']]. eapply HS'''S''''; eauto. Qed. Lemma SCAP_WFcmd_block_8_pushwp : SCAP_WFcmd (SCAP_consCT (L_block+8+1) (Ast p_block_9 g_block_9 sctag) psi_block) (L_block+8) (Ast p_block_8 g_block_8 sctag) (comml (_pushwp (Opr_imm ready_Q))). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mP S S', Ast_block_8 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mP S -> nextS (L_block+8) (comml (_pushwp (Opr_imm ready_Q))) S S' -> Ast_block_9 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mP S'). intros T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mP S S' HS HSS'. unfold Ast_block_8, Ast_block_9 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto [HT' HBlkQ']]]]]]]]]. split. subst M' R' fl' isr'. sep on. sep lift 4. rewrite Hsp. arith_rep (sp - 4 - 2) with (sp - 6). sep upd. sep matchH HM with 13. sep stksplit in HM. arith_rep (sp - 4 - 2) with (sp - 6) in HM. subst R' fl' isr'; reg simpl. rewrite Hsp. split_l by omega. repeat split_l. trivial. simpl. exists p_block_9; exists g_block_9. split_l. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold p_block_8 in HpS. destruct HpS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 [T' [BlkQ' HS]]]]]]]]]]]]. exists (MemUpdW M (sp-6) ready_Q 0, RF_update R SP (sp - 6), fl, isr). apply nextS_pushwp with ready_Q; trivial. unfold pushW. destruct HS as [HM [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto [HT' HBlkQ']]]]]]]]]. simplS in * . rewrite Hsp. split. apply stkSpace_weaken with (_BLK_Stk - 4); [idtac | omega]. sep on. sep lift 3 in HM. sep trivial. arith_rep (sp - 4 - 2) with (sp - 6). split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_block_8, p_block_9. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 [T' [BlkQ' HS]]]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists tid; exists tcb; exists sp; exists pc; exists jk1; exists jk2; exists T'; exists BlkQ'. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold p_block_8, g_block_9 in * . intros mP T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' HS. eapply HgS'S''; eauto. Qed. Lemma SCAP_WFcmd_block_9_call : SCAP_WFcmd (SCAP_consCT (L_block+9+1) (Ast p_block_10 g_block_10 sctag) psi_block) (L_block+9) (Ast p_block_9 g_block_9 sctag) (comml (_call L_deQueue)). Proof. assert(Hpp' : forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mQ mP S S', Ast_block_9 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mP S -> nextS (L_block+9) (comml (_call L_deQueue)) S S' -> mQ = ((curr_thrd |->w tid) *^* (embed_BlkQ l_ptr T' BlkQ') *^* (sp - 8 |->w (L_block+9+1)) *^* (sp - 4 |->w tid) *^* (sp - 2 |->w l_ptr) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2)) -> Ast_deQueue_pre T' RdyQ ready_Q (S_RF S' BP) (sp - 8) (mQ *^* mP) S'). intros T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mQ mP S S'. intros HS HSS' HmQ. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold Ast_block_9 in HS. destruct HS as [HM [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto [HT HBlkQ']]]]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspx [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. unfold Ast_deQueue_pre. simplS in * . reg simpl. split. sep on. rewrite Hsp. arith_rep (sp - 6 - 2) with (sp - 8). subst mQ. sep lift 5. sep_update. sep lift 3 in HM. sep stksplit in HM. arith_rep (sp - 6 - 2) with (sp - 8) in HM. arith_rep (10 - 6 - 2) with 2 in HM. unfold embed_RdyQ in HM. arith_rep (sp - 8 + 2) with (sp - 6). sep matchH HM with 13. split_l. rewrite Hsp; omega. assert (Hpp''' : forall T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' pc' mP S S' S'' S''', Ast_block_9 T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' mP S -> nextS (L_block+9) (comml (_call L_deQueue)) S S' -> g_deQueue S' S'' -> nextS pc' (comms (_retw)) S'' S''' -> exists RdyQ', exists tid', exists tcb', Ast_block_10 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S'''). intros T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' pc' mP. intros S S' S'' S''' HS HSS' HS'S'' HS''S'''. unfold p_deQueue in HS'S''. set (mQ := (curr_thrd |->w tid) *^* (embed_BlkQ l_ptr T' BlkQ') *^* (sp - 8 |->w (L_block+9+1)) *^* (sp - 4 |->w tid) *^* (sp - 2 |->w l_ptr) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2)). assert (HS' : Ast_deQueue_pre T' RdyQ ready_Q (S_RF S' BP) (sp-8) (mQ *^* mP) S'). eapply Hpp'; eauto. clear Hpp'. substH HS'S'' with (HS'S'' _ _ _ _ _ _ HS') into HS''. unfold Ast_block_9 in HS. destruct HS as [_ [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto [HT' HBlkQ']]]]]]]]]. destruct HS'' as [HS'' | HS'']. destruct HS'' as [Hempty [HS'' Hbp]]. rewrite (filterTQ_prev _ _ _ _ _ HRT HtR HT') in Hempty. destruct (filterTQ_not_empty _ _ _ _ Hex Htcb Hmto Hempty). destruct HS'' as [RdyQ' [tid' [tcb' [HS'' [HRdyQ' Hnin]]]]]. exists RdyQ'; exists tid'; exists tcb'. subst mQ. unfold Ast_deQueue_post_b in HS''. unfold Ast_block_10. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. simplS in * . destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pcx [Hlds HR''']]. destruct HS'' as [HM'' [HAX'' [HBP'' [HSP'' Hmto']]]]. assert (Hpcx : pcx = L_block + 9 + 1). subst R' M''' R'''. clear HT' HRT HtR Hex Htcb Hmto. clear Hsp Hspg HS' HS''S''' HM'. clear HBlkQ' HSS'. subst fl' isr' fl''' isr'''. rewrite HSP'' in Hlds; clear HSP''. sep on. sep lift 6 in HM''. sep_inj. auto. subst pcx; clear Hlds. subst M''' R''' fl''' isr'''. reg simpl. rewrite HAX''. rewrite HSP''. arith_rep (sp - 8 + 2) with (sp - 6) in HM''. arith_rep (sp - 8 + 2) with (sp - 6). split. unfold embed_BlkQ in * . unfold embed_RdyQ. sep on. sep matchH HM'' with 11. sep stksplit. arith_rep (sp - 6 - 2) with (sp - 8). arith_rep (10 - 6 - 2) with 2. sep matchH HM'' with 2. repeat split_l; trivial. simpl. exists p_deQueue; exists p_block_10. exists g_deQueue; exists g_block_10. split. unfold SCAP_lookupCT, SCAP_consCT. apply SPSpec.lookup_merge_intro_r. apply L_deQueue_in_psi_block. split_l. split. (* enable call *) clear Hpp' Hpp'''. unfold enable, p_block_9. intros S HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. destruct HS as [T' [BlkQ' HS]]. unfold Ast_block_9 in HS. destruct HS as [HM [Hsp [Hspg _]]]. destruct S as [[[M R] fl] isr]. simplS in * . exists (MemUpdW M (sp - 6 - 2) (L_block+9+1) 0, RF_update R SP (sp - 6 - 2), fl, isr). apply nextS_call. unfold pushW. split. apply stkSpace_weaken with (10 - 6); [idtac | omega]. apply stkSpacePrec_stkSpace1 with mTrue. rewrite Hsp. sep on. sep matchH HM with 10. split. rewrite Hsp. apply MemUpdW_MemUpd16 with 0; trivial. rewrite Hsp; trivial. split. (* g' => fun_frame *) unfold sp_call_pred, fun_frame. unfold linkPG, conjPG. intros S' S'' HS'S''. destruct HS'S'' as [H HS'S'']. destruct H as [S [HS HSS']]. unfold p_deQueue in HS'S''. destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. destruct HS as [T' [BlkQ' HS]]. set (mQ := (curr_thrd |->w tid) *^* (embed_BlkQ l_ptr T' BlkQ') *^* (sp - 8 |->w (L_block+9+1)) *^* (sp - 4 |->w tid) *^* (sp - 2 |->w l_ptr) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2)). assert (HS' : Ast_deQueue_pre T' RdyQ ready_Q (S_RF S' BP) (sp - 8) (mQ *^* mTrue) S'). eapply Hpp'; eauto. clear Hpp' HSS' Hpp'''. substH HS'S'' with (HS'S'' _ _ _ _ _ _ HS') into HS''. destruct HS as [_ [Hsp [Hspg [HRT [HtR [Hex [Htcb [Hmto [HT' HBlkQ']]]]]]]]]. destruct HS'' as [HS'' | HS'']. destruct HS'' as [Hempty [HS'' Hbp]]. rewrite (filterTQ_prev _ _ _ _ _ HRT HtR HT') in Hempty. destruct (filterTQ_not_empty _ _ _ _ Hex Htcb Hmto Hempty). destruct HS'' as [RdyQ' [tid' [tcb' [HS'' [HRdyQ' Hnin']]]]]. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. simplS in * . unfold Ast_deQueue_pre, Ast_deQueue_post_b in * . destruct HS' as [HM' [HBP' HSP']]. destruct HS'' as [HM'' [HAX'' [HBP'' [HSP'' Hmto']]]]. simplS in * . split. rewrite HSP'; rewrite HSP''; trivial. unfold Ret_Addr. exists (L_block + 9 + 1). simplS. split. intros pc''. apply nextPC_retw with (sp - 8); trivial. clear HM''. sep on. subst mQ. sep lift 5 in HM'. sep trivial. intros pc''. apply nextPC_retw with (sp - 8); trivial. clear HM'. sep on. subst mQ. sep lift 6 in HM''. sep trivial. split. (* p => p' *) intros S' H. unfold conjPG, conjG, linkPG in H. destruct H as [S [HS HnextSS']]. unfold p_block_9 in HS. unfold p_deQueue. destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. destruct HS as [T' [BlkQ' HS]]. exists T'; exists RdyQ; exists ready_Q; exists (S_RF S' BP); exists (sp - 8). set (mQ := (curr_thrd |->w tid) *^* (embed_BlkQ l_ptr T' BlkQ') *^* (sp - 8 |->w (L_block+9+1)) *^* (sp - 4 |->w tid) *^* (sp - 2 |->w l_ptr) *^* (sp |-> pc) *^* (sp + 1 |-> jk1) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk2)). assert (H : Ast_deQueue_pre T' RdyQ ready_Q (S_RF S' BP) (sp - 8) (mQ *^* mTrue) S'). eapply Hpp'; eauto. clear Hpp''' Hpp' HS HnextSS'. unfold Ast_deQueue_pre in * . destruct H as [HM' H]. split_r. sep on. sep matchH HM' with 10. split. (* p => p''' *) intros pc' S'''. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S H]. destruct H as [HS H]. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. unfold p_block_9, p_block_10 in * . destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [tcb [sp [pc [jk1 [jk2 HS]]]]]]]]]]. destruct HS as [T' [BlkQ' HS]]. assert (H : exists RdyQ', exists tid', exists tcb', Ast_block_10 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mTrue S'''). eapply Hpp'''; eauto. destruct H as [RdyQ' [tid' [tcb' HS''']]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists tid; exists sp; exists pc; exists jk1; exists jk2; exists T'; exists RdyQ'. exists BlkQ'; exists tid'; exists tcb'. trivial. (* g'' => g *) intros pc' S S'''' H. unfold conjPG, wrap_fun, conjG, linkPG in H. destruct H as [S''' [HS HS'''S'''']]. destruct HS as [HSx [S'' [H HS'']]]. destruct H as [S' [HSS' HS'S'']]. unfold p_block_9, p_block_10 in * . intros mP T RdyQ BlkQ l_ptr tid tcb sp pc jk1 jk2 T' BlkQ' HS. assert (H : exists RdyQ', exists tid', exists tcb', Ast_block_10 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S'''). eapply Hpp'''; eauto. destruct H as [RdyQ' [tid' [tcb' HS''']]]. apply HS'''S'''' with T' RdyQ' BlkQ' tid' tcb'; trivial. Qed. (* : addw $6, %sp *) Lemma SCAP_WFcmd_block_10_addw : SCAP_WFcmd (SCAP_consCT (L_block+10+1) (Ast p_block_11 g_block_11 sctag) psi_block) (L_block+10) (Ast p_block_10 g_block_10 sctag) (comml (_addw (Opr_imm 6 ) SP)). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S S', Ast_block_10 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S -> nextS (L_block+10) (comml (_addw (Opr_imm 6 ) SP)) S S' -> Ast_block_11 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S'). intros T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S S' HS HSS'. unfold Ast_block_10, Ast_block_11 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [Hax [Hsp [Hspg [HT' [HBlkQ' [HRdyQ [Hmto Hnin]]]]]]]]. subst M' R' isr'. split. sep on. sep matchH HM with 10. sep stksplit. sep stksplit. sep stksplit. arith_rep (sp - 2 - 2) with (sp - 4). arith_rep (sp - 4 - 2) with (sp - 6). arith_rep (10 - 2 - 2 - 2) with (10 - 6). sep matchH HM with 4. reg simpl. unfold opr_eval. split_l. split_l by omega. repeat split_l; trivial. simpl. exists p_block_11; exists g_block_11. split_l. split. (* enable addw *) unfold enable, p_block_10. intros S H. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [sp [pc [jk1 [jk2 H]]]]]]]]]. destruct H as [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]. destruct HS as [HM [Hax [Hsp [Hspg [HT' [HBlkQ' [HRdyQ [Hmto Hnin]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (R' := RF_update R SP (6 + R SP)). exists (M, R', Clear_Flag fl _ZF, isr). apply nextS_addw with 6 (R SP); auto. unfold trash_fl. right; trivial. split. (* p ==> p' *) unfold p_block_10, g_block_11. intros S' H. unfold linkPG in H. destruct H as [S H]. simpl in H. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [sp [pc [jk1 [jk2 H]]]]]]]]]. destruct H as [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists tid; exists sp; exists pc; exists jk1; exists jk2. exists T'; exists RdyQ'; exists BlkQ'; exists tid'; exists tcb'. apply Hpp' with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[HSx HnextS] HS'S'']]. unfold p_block_10, p_block_11 in * . intros mP T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' HS. eapply HS'S''; eauto. Qed. Lemma SCAP_WFcmd_block_11_movw : SCAP_WFcmd (SCAP_consCT (L_block+11+1) (Ast p_block_12 g_block_12 sctag) psi_block) (L_block+11) (Ast p_block_11 g_block_11 sctag) (comml (_movwp (Opr_reg AX) BX)). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S S', Ast_block_11 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S -> nextS (L_block+11) (comml (_movwp (Opr_reg AX) BX)) S S' -> Ast_block_12 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S'). intros T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S S' HS HSS'. unfold Ast_block_11, Ast_block_12 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [Hax [Hsp [Hspg [HT' [HBlkQ' [HRdyQ [Hmto Hnin]]]]]]]]. subst M' R' fl' isr'. split_l. reg simpl. repeat split_l; trivial. simpl. exists p_block_12; exists g_block_12. split_l. split. (* enable movw *) unfold enable, p_block_11. intros S H. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [sp [pc [jk1 [jk2 H]]]]]]]]]. destruct H as [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]. unfold Ast_block_11 in HS. destruct HS as [HM [Hax [Hsp [Hspg [HT' [HBlkQ' [HRdyQ' [Hmto Hnin]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (R' := RF_update R BX tid'). exists (M, R', fl, isr). apply nextS_movwp with tid'; auto. split. (* p ==> p' *) unfold p_block_11, p_block_12. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [sp [pc [jk1 [jk2 H]]]]]]]]]. destruct H as [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists tid. exists sp; exists pc; exists jk1; exists jk2; exists T'; exists RdyQ'. exists BlkQ'; exists tid'; exists tcb'. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HS'S'']]. unfold p_block_11, p_block_12 in * . intros mP T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' HS. eapply HS'S''; eauto. Qed. Lemma SCAP_WFcmd_block_12_movwst : SCAP_WFcmd (SCAP_consCT (L_block+12+1) (Ast p_block_13 g_block_13 sctag) psi_block) (L_block+12) (Ast p_block_12 g_block_12 sctag) (comml (_movwst (Opr_reg AX) (A_imm curr_thrd))). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S S', Ast_block_12 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S -> nextS (L_block+12) (comml (_movwst (Opr_reg AX) (A_imm curr_thrd))) S S' -> Ast_block_13 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S'). intros T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S S' HS HSS'. unfold Ast_block_12, Ast_block_13 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hlds HM']. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simpl in Hlds. simplS in * . destruct HS as [HM [Hax [Hbx [Hsp [Hspg [HT' [HBlkQ' [HRdyQ' [Htid'tcb' Htid'RdyQ']]]]]]]]]. subst M' R' fl' isr'. split. sep on. sep lift 0 in HM. sep lift 0. rewrite Hax. sep upd. sep matchH HM with 6. repeat split_l; trivial. simpl. exists p_block_13; exists g_block_13. split_l. split. (* enable movw *) unfold enable, p_block_12. intros S H. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [sp [pc [jk1 [jk2 HS]]]]]]]]]. destruct HS as [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]. destruct HS as [HM [Hax [Hbx [Hsp [Hspg [HT' [HBlkQ' [HRdyQ' [Htid'tcb' Htid'RdyQ']]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (M' := MemUpdW M curr_thrd tid' 0). exists (M', R, fl, isr). apply nextS_movwst with curr_thrd tid'; auto. sep on. sep lift 0 in HM. sep trivial. apply MemUpdW_MemUpd16 with 0; trivial. split. (* pimp *) unfold p_block_12, p_block_13. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [tid [sp [pc [jk1 [jk2 HS]]]]]]]]]. destruct HS as [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists tid; exists sp; exists pc; exists jk1; exists jk2. exists T'; exists RdyQ'; exists BlkQ'. exists tid'; exists tcb'. apply Hpp' with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HSS']]. unfold p_block_12, p_block_13 in * . intros mP T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' HS. eapply HSS'; eauto. Qed. Lemma SCAP_WFcmd_block_13_movwld : SCAP_WFcmd (SCAP_consCT (L_block+13+1) (Ast p_block_14 g_block_14 sctag) psi_block) (L_block+13) (Ast p_block_13 g_block_13 sctag) (comml (_movwld (A_reg TCB_STACK BX) SP)). Proof. simpl. exists p_block_14; exists g_block_14. split_l. assert (Hpp' : forall T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S S', Ast_block_13 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S -> nextS (L_block+13) (comml (_movwld (A_reg TCB_STACK BX) SP)) S S' -> Ast_block_14 T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' (TCB_SP tcb') mP S'). intros T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' mP S S' HS HSS'. unfold Ast_block_13, Ast_block_14 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [sp' [Hlds HR']]. simplS in * . destruct HS as [HM [Hbx [Hsp [Hspg [HT' [HBlkQ' [HRdyQ' [Htid'tcb' Htid'RdyQ']]]]]]]]. assert (Heq : sp' = TCB_SP tcb'). unfold addr_eval in Hlds. rewrite Hbx in Hlds. unfold TCB_STACK in Hlds. destruct tcb' as [[spx' stx'] pcx']. unfold embed_TCB in HM. clear Hbx Hsp Hspg HT' HBlkQ' HRdyQ' Htid'tcb' Htid'RdyQ'. clear HSS'. subst M'. sep on. sep lift 3 in HM. substH HM with (ptoTCB_elim1 HM). destruct HM as [tst [HM Htst]]. sep lift 0 in HM. sep inj. auto. subst M' R' fl' isr'. split_l. split. reg simpl. trivial. repeat split_l; trivial. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold p_block_13 in HpS. destruct HpS as [T [RdyQ [BlkQ [l_ptr [tid [sp [pc [jk1 [jk2 HS]]]]]]]]]. destruct HS as [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]. unfold Ast_block_13 in HS. destruct HS as [HM [HBX [HSP [Hspg [HT' [HBlkQ' [HRdyQ' [Hmto Hnin]]]]]]]]. simplS in * . exists (M, RF_update R SP (TCB_SP tcb'), fl, isr). apply nextS_movwld with (tid' + TCB_STACK) (TCB_SP tcb'); trivial. simpl. subst; trivial. unfold TCB_STACK. unfold embed_TCB in HM. sep on. sep lift 3 in HM. substH HM with (ptoTCB_elim1 HM). destruct HM as [tst [HM Htst]]. sep lift 0 in HM. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_block_13, p_block_14. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [l_ptr [tid [sp [pc [jk1 [jk2 HS]]]]]]]]]. destruct HS as [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists tid; exists sp; exists pc; exists jk1; exists jk2. exists T'; exists RdyQ'; exists BlkQ'. exists tid'; exists tcb'; exists (TCB_SP tcb'). apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold p_block_13, p_block_14 in * . intros mP T RdyQ BlkQ l_ptr tid sp pc jk1 jk2 T' RdyQ' BlkQ' tid' tcb' HS. eapply HgS'S''; eauto. Qed. Lemma SCAP_WFcmd_block_14_retw : SCAP_WFcmd psi_block (L_block+14) (Ast p_block_14 g_block_14 sctag) (comms _retw). Proof. unfold p_block_14, g_block_14. simpl. intros S H. intros. unfold Ast_block_14 in H0. InvertAll. exists T'; exists RdyQ'; exists BlkQ'. exists tid'; exists sp'; exists tcb'. repeat split_l. trivial. Qed. Lemma SCAP_WFiseq_block : SCAP_WFiseq psi_block L_block spec_block I_block. Proof. unfold I_block, spec_block. apply scap_isq_seq with p_block_1 g_block_1. apply SCAP_WFcmd_block_0_movwld. apply scap_isq_seq with p_block_2 g_block_2. apply SCAP_WFcmd_block_1_movwst. assert (H : L_block+1+1 = L_block+2); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_3 g_block_3. apply SCAP_WFcmd_block_2_movwst. assert (H : L_block+2+1 = L_block+3); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_4 g_block_4. apply SCAP_WFcmd_block_3_movwp. assert (H : L_block+3+1 = L_block+4); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_5 g_block_5. apply SCAP_WFcmd_block_4_movwld. assert (H : L_block+4+1 = L_block+5); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_6 g_block_6. apply SCAP_WFcmd_block_5_pushwp. assert (H : L_block+5+1 = L_block+6); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_7 g_block_7. apply SCAP_WFcmd_block_6_pushwp. assert (H : L_block+6+1 = L_block+7); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_8 g_block_8. apply SCAP_WFcmd_block_7_call. assert (H : L_block+7+1 = L_block+8); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_9 g_block_9. apply SCAP_WFcmd_block_8_pushwp. assert (H : L_block+8+1 = L_block+9); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_10 g_block_10. apply SCAP_WFcmd_block_9_call. assert (H : L_block+9+1 = L_block+10); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_11 g_block_11. apply SCAP_WFcmd_block_10_addw. assert (H : L_block+10+1 = L_block+11); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_12 g_block_12. apply SCAP_WFcmd_block_11_movw. assert (H : L_block+11+1 = L_block+12); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_13 g_block_13. apply SCAP_WFcmd_block_12_movwst. assert (H : L_block+12+1 = L_block+13); [omega | rewrite H; clear H]. apply scap_isq_seq with p_block_14 g_block_14. apply SCAP_WFcmd_block_13_movwld. assert (H : L_block+13+1 = L_block+14); [omega | rewrite H; clear H]. apply scap_isq_end. apply SCAP_WFcmd_block_14_retw. Qed. coq/miniOS/UnblockProof.v0000644000107400000620000020136211000223231015031 0ustar shaosystems(***************************************************************) (* Coq code for AIM *) (* *) (* *) (***************************************************************) Add LoadPath "..". Add LoadPath "../CAP0". Add LoadPath "../SCAP". Require Import Coqlib. Require Import Arith. Require Import Machine. Require Import Assertion. Require Import Operational_Semantics. Require Import OpSem_Lemmas. Require Import OpSem_Lemmas2. Require Import Reg. Require Import Assertion_Lemmas3. Require Import Assertion_Lemmas4. Require Import AIM. Require Import SCAP. Require Import QLib. Require Import Linking. Require Import Linking_Lemmas3. Require Import Kernel. Require Import UnblockSpec. (* : pushw %bp *) Lemma SCAP_WFcmd_0_pushbp: SCAP_WFcmd (SCAP_consCT (L_unblock + 1) (Ast p_unblock_1 g_unblock_1 sctag) psi_unblock) L_unblock spec_unblock (comml (_pushwp (Opr_reg BP))). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr bp sp jk mP S S', Ast_unblock_pre T RdyQ BlkQ l_ptr bp sp jk mP S -> nextS (L_unblock) (comml (_pushwp (Opr_reg BP))) S S' -> Ast_unblock_1 T RdyQ BlkQ l_ptr bp sp jk mP S'). intros T RdyQ BlkQ l_ptr bp sp jk mP S S' HS HSS'. unfold Ast_unblock_pre, Ast_unblock_1 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hsp [Hbp [Hspg [HRT [HBT [HRB HT]]]]]]]. split. subst M' R' fl' isr'. sep on. sep lift 3. rewrite Hsp. rewrite Hbp. sep upd. sep matchH HM with 7. sep stksplit in HM. sep trivial. subst R' fl' isr'; reg simpl. rewrite Hsp; rewrite Hbp. repeat split_l; trivial. simpl. exists p_unblock_1; exists g_unblock_1. split_l. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold p_unblock in HpS. destruct HpS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. exists (MemUpdW M (sp-2) (R BP) 0, RF_update R SP (sp - 2), fl, isr). apply nextS_pushwp with (R BP); trivial. unfold pushW. destruct HS as [HM [Hbp [Hsp [Hspg [HRT [HBT [HRB HT]]]]]]]. simplS in * . rewrite Hsp; rewrite Hbp. split. apply stkSpace_weaken with (_UNBLK_Stk); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_unblock, p_unblock_1. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists bp; exists sp; exists jk. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold g_unblock, g_unblock_1 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk HS. eapply HgS'S''; eauto. Qed. (* : movw %sp, %bp *) Lemma SCAP_WFcmd_1_movwp: SCAP_WFcmd (SCAP_consCT (L_unblock +1+1) (Ast p_unblock_2 g_unblock_2 sctag) psi_unblock) (L_unblock +1) (Ast p_unblock_1 g_unblock_1 sctag) (comml (_movwp (Opr_reg SP) BP)). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr bp sp jk mP S S', Ast_unblock_1 T RdyQ BlkQ l_ptr bp sp jk mP S -> nextS (L_unblock+1) (comml (_movwp (Opr_reg SP) BP)) S S' -> Ast_unblock_2 T RdyQ BlkQ l_ptr bp sp jk mP S'). intros T RdyQ BlkQ l_ptr bp sp jk mP S S' HS HSS'. unfold Ast_unblock_1, Ast_unblock_2 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [Hsp [Hbp [Hspg [HRT [HBT [HRB HT]]]]]]]. subst M' R' fl' isr'. reg simpl. repeat split_l; trivial. simpl. exists p_unblock_2; exists g_unblock_2. split_l. split. (* enable movw *) unfold enable, p_unblock. intros S H. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. unfold Ast_unblock_pre in HS. destruct HS as [HM [Hsp [Hbp [Hspg [HRT [HBT [HRB HT]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (R' := RF_update R BP (sp - 2)). exists (M, R', fl, isr). apply nextS_movwp with (sp - 2); auto. split. (* p ==> p' *) unfold p_unblock_1, p_unblock_2. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists bp; exists sp; exists jk. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HS'S'']]. unfold g_unblock_1, g_unblock_2 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk HS. eapply HS'S''; eauto. Qed. (* : movw 4(%bp), %bx # the pointer to the block queue *) Lemma SCAP_WFcmd_2_movwld: SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1) (Ast p_unblock_3 g_unblock_3 sctag) psi_unblock) (L_unblock +1+1) (Ast p_unblock_2 g_unblock_2 sctag) (comml (_movwld (A_reg 4 BP) BX)). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr bp sp jk mP S S', Ast_unblock_2 T RdyQ BlkQ l_ptr bp sp jk mP S -> nextS (L_unblock +1+1) (comml (_movwld (A_reg 4 BP) BX)) S S' -> Ast_unblock_3 T RdyQ BlkQ l_ptr bp sp jk mP S'). intros T RdyQ BlkQ l_ptr bp sp jk mP S S' HS HSS'. unfold Ast_unblock_2, Ast_unblock_3 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [l_ptrx [Hlds HR']]. simplS in * . destruct HS as [HM [Hsp [Hbp [Hspg [HRT [HBT [HRB HT]]]]]]]. assert (Heq : l_ptrx = l_ptr). unfold addr_eval in Hlds. rewrite Hbp in Hlds. sep on. sep lift 4 in HM. arith_rep (sp - 2 + 4) with (sp + 2) in Hlds. sep inj. auto. subst l_ptrx M' R' fl' isr'. reg simpl. repeat split_l; trivial. simpl. exists p_unblock_3; exists g_unblock_3. split_l. split. (* enable *) unfold enable. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_unblock_2 in HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. unfold Ast_unblock_2 in HS. destruct HS as [HM [Hsp [Hbp [Hspg [HRT [HBT [HRB HT]]]]]]]. simplS in * . exists (M, RF_update R BX l_ptr, fl, isr). apply nextS_movwld with (sp+2) l_ptr; auto. unfold addr_eval; rewrite Hbp; trivial. omega. sep on. sep lift 4 in HM. sep trivial. apply ptoW_leadsToW1 with mTrue. sep subst_left with (sp + 2 |-> l_ptr *^* sp + 2 + 1 |->_). arith_rep (sp + 2 + 1) with (sp + 3). sep lift 0. sep match_left HM. sep lift 0 in HM. sep match_left HM. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_unblock_2, p_unblock_3. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists bp; exists sp; exists jk. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold g_unblock_2, g_unblock_3 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk HS. eapply HgS'S''; eauto. Qed. (* : pushw %bx *) Lemma SCAP_WFcmd_3_pushwp: SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1) (Ast p_unblock_4 g_unblock_4 sctag) psi_unblock) (L_unblock +1+1+1) (Ast p_unblock_3 g_unblock_3 sctag) (comml (_pushwp (Opr_reg BX))). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr bp sp jk mP S S', Ast_unblock_3 T RdyQ BlkQ l_ptr bp sp jk mP S -> nextS (L_unblock +1+1+1) (comml (_pushwp (Opr_reg BX))) S S' -> Ast_unblock_4 T RdyQ BlkQ l_ptr bp sp jk mP S'). intros T RdyQ BlkQ l_ptr bp sp jk mP S S' HS HSS'. unfold Ast_unblock_3, Ast_unblock_4 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [Hbx [Hsp [Hbp [Hspg [HRT [HBT [HRB HT]]]]]]]]. split. subst M' R' fl' isr'. sep on. sep lift 3. rewrite Hsp. rewrite Hbx. sep upd. sep matchH HM with 7. sep stksplit in HM. sep trivial. subst R' fl' isr'; reg simpl. rewrite Hsp; rewrite Hbx. repeat split_l; trivial. simpl. exists p_unblock_4; exists g_unblock_4. split_l. split. (* enable *) unfold enable. intros S HpS. destruct S as [[[M R] fl] isr]. unfold p_unblock_4 in HpS. destruct HpS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. exists (MemUpdW M (sp-2-2) (R BX) 0, RF_update R SP (sp - 2-2), fl, isr). apply nextS_pushwp with (R BX); trivial. unfold pushW. unfold Ast_unblock_3 in HS. destruct HS as [HM [Hbx [Hsp [Hbp [Hspg [HRT [HBT [HRB HT]]]]]]]]. simplS in * . rewrite Hsp; rewrite Hbx. split. apply stkSpace_weaken with (_UNBLK_Stk - 2); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split. apply MemUpdW_MemUpd16 with 0; trivial. trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_unblock_3, g_unblock_4. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists bp; exists sp; exists jk. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HgS'S'']. unfold g_unblock_3, g_unblock_4 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk HS. eapply HgS'S''; eauto. Qed. (* : call deQueue # not change bp *) Lemma SCAP_WFcmd_4_call: SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1+1) (Ast p_unblock_5 g_unblock_5 sctag) psi_unblock) (L_unblock +1+1+1+1) (Ast p_unblock_4 g_unblock_4 sctag) (comml (_call L_deQueue)). Proof. assert(Hpp' : forall T RdyQ BlkQ l_ptr bp sp jk mQ mP S S', Ast_unblock_4 T RdyQ BlkQ l_ptr bp sp jk mP S -> nextS (L_unblock +1+1+1+1) (comml (_call L_deQueue)) S S' -> mQ = ((embed_RdyQ T RdyQ) *^* (stkSpacePrec (sp -2-2-2-2) (_UNBLK_Stk -2-2-2-2)) *^* (sp -2-2-2 |->w (L_unblock +1+1+1+1+1)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk)) -> Ast_deQueue_pre T BlkQ l_ptr (S_RF S' BP) (sp -2-2-2) (mQ *^* mP) S'). intros T RdyQ BlkQ l_ptr bp sp jk mQ mP S S'. intros HS HSS' HmQ. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold Ast_unblock_4 in HS. destruct HS as [HM [Hbx [Hsp [Hbp [Hspg [HRT [HBT [HRB HT]]]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspx [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. unfold Ast_deQueue_pre. simplS in * . reg simpl. split. sep on. rewrite Hsp. subst mQ. sep lift 5. sep upd. sep lift 2 in HM. sep stksplit in HM. unfold embed_BlkQ in HM. sep stksplit 2 in HM. assert (Ha1 : sp - 2 - 2 - 2 + 2 = sp - 2 - 2). generalize Hspg; clearall. omega. rewrite Ha1. sep matchH HM with 13. split_l. rewrite Hsp; trivial. assert (Hpp''' : forall T RdyQ BlkQ l_ptr bp sp jk pc' mP S S' S'' S''', Ast_unblock_4 T RdyQ BlkQ l_ptr bp sp jk mP S -> nextS (L_unblock +1+1+1+1) (comml (_call L_deQueue)) S S' -> g_deQueue S' S'' -> nextS pc' (comms (_retw)) S'' S''' -> Ast_unblock_5_a T RdyQ BlkQ l_ptr bp sp jk mP S''' \/ exists BlkQ', exists tid', exists tcb', Ast_unblock_5_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S'''). intros T RdyQ BlkQ l_ptr bp sp jk pc' mP. intros S S' S'' S''' HS HSS' HS'S'' HS''S'''. unfold g_deQueue in HS'S''. set (mQ := (embed_RdyQ T RdyQ) *^* (stkSpacePrec (sp -2-2-2-2) (_UNBLK_Stk -2-2-2-2)) *^* (sp -2-2-2 |->w (L_unblock +1+1+1+1+1)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk)). assert (HS' : Ast_deQueue_pre T BlkQ l_ptr (S_RF S' BP) (sp-2-2-2) (mQ *^* mP) S'). eapply Hpp'; eauto. clear Hpp'. substH HS'S'' with (HS'S'' _ _ _ _ _ _ HS') into HS''. unfold Ast_unblock_4 in HS. destruct HS as [_ [Hbx [Hsp [Hbp [Hspg [HRT [HBT [HRB HT]]]]]]]]. destruct HS'' as [HS'' | HS'']. destruct HS'' as [Hempty HS'']. left. unfold Ast_deQueue_post_a in HS''. unfold Ast_unblock_5_a. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. simplS in * . destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pcx [Hlds HR''']]. destruct HS'' as [HM'' [HAX'' [HBP'' HSP'']]]. assert (Hpcx : pcx = L_unblock +1+1+1+1+1). subst R' M''' R'''. subst fl' isr' fl''' isr'''. rewrite HSP'' in Hlds; clear HSP''. sep on. subst mQ. sep lift 5 in HM''. sep_inj. auto. subst pcx; clear Hlds. subst M''' R''' fl''' isr'''. reg simpl. rewrite HAX''. rewrite HSP''. rewrite HBP''. subst R'. reg simpl. assert (Ha1 : sp - 2 - 2 - 2 + 2 = sp - 2 - 2). generalize Hspg; clearall. omega. split. subst mQ. unfold embed_BlkQ in * . clear HRT HRB HBT HT Hbx Hsp Hbp HSS' HS' Hempty. clear HAX'' HBP'' HSP'' HM' HS''S'''. sep on. rewrite Ha1 in HM''. sep matchH HM'' with 11. clear Ha1. sep stksplit. sep stksplit 2. sep matchH HM'' with 2. repeat split_l; trivial. destruct HS'' as [BlkQ' [tid' [tcb' [HS'' [HBlkQ' Hnin]]]]]. right. exists BlkQ'; exists tid'; exists tcb'. subst mQ. unfold Ast_deQueue_post_b in HS''. unfold Ast_unblock_5_b. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. simplS in * . destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pcx [Hlds HR''']]. destruct HS'' as [HM'' [HAX'' [HBP'' [HSP'' Hmto']]]]. assert (Hpcx : pcx = L_unblock +1+1+1+1+1). subst R' M''' R'''. subst fl' isr' fl''' isr'''. rewrite HSP'' in Hlds; clear HSP''. sep on. sep lift 6 in HM''. sep_inj. auto. subst pcx; clear Hlds. subst M''' R''' fl''' isr'''. reg simpl. rewrite HAX''. rewrite HSP''. rewrite HBP''. subst R'. reg simpl. clear HAX'' HSP'' HBP''. assert (Ha1 : sp - 2 - 2 - 2 + 2 = sp - 2 - 2). generalize Hspg; clearall. omega. rewrite Ha1. rewrite Ha1 in HM''. clear Ha1. split. unfold embed_BlkQ in * . sep on. sep matchH HM'' with 11. generalize Hspg HM''; clearall; intros. sep stksplit. sep stksplit 2. sep matchH HM'' with 2. repeat split_l; trivial. apply HT; exists tcb'; trivial. subst BlkQ. unfold addThrd. auto with PMap. subst BlkQ. unfold addThrd. rewrite WQMod.remove_cancel_put. rewrite <- WQMod.remove_nothing. trivial. trivial. simpl. exists p_deQueue; exists p_unblock_5. exists g_deQueue; exists g_unblock_5. split. unfold SCAP_lookupCT, SCAP_consCT. apply SPSpec.lookup_merge_intro_r. apply L_deQueue_in_psi_unblock. split_l. split. (* enable call *) clear Hpp' Hpp'''. unfold enable, p_unblock_4. intros S HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. unfold Ast_unblock_4 in HS. destruct HS as [HM [HBX [HSP [HBP [Hsp _]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . exists (MemUpdW M (sp - 2 - 2 - 2) (L_unblock+1+1+1+1+1) 0, RF_update R SP (sp - 2 - 2 - 2), fl, isr). apply nextS_call. unfold pushW. rewrite HSP. split. apply stkSpace_weaken with (10 - 2 - 2 ); [idtac | omega]. sep on. sep lift 2 in HM. sep trivial. split_r. apply MemUpdW_MemUpd16 with 0; trivial. split. (* g' => fun_frame *) unfold sp_call_pred, fun_frame. unfold linkPG, conjPG. intros S' S'' HS'S''. destruct HS'S'' as [H HS'S'']. destruct H as [S [HS HSS']]. unfold p_deQueue in HS'S''. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. set (mQ := (embed_RdyQ T RdyQ) *^* (stkSpacePrec (sp -2-2-2-2) (_UNBLK_Stk -2-2-2-2)) *^* (sp -2-2-2 |->w (L_unblock +1+1+1+1+1)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk)). assert (HS' : Ast_deQueue_pre T BlkQ l_ptr (S_RF S' BP) (sp-2-2-2) (mQ *^* mTrue) S'). eapply Hpp'; eauto. clear Hpp' HSS' Hpp'''. substH HS'S'' with (HS'S'' _ _ _ _ _ _ HS') into HS''. unfold Ast_unblock_4 in HS. destruct HS as [_ [HBX [HSP [HBP [Hsp [HRT [HBT [HRB HT]]]]]]]]. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. simplS in * . unfold Ast_deQueue_pre, Ast_deQueue_post_b, Ast_deQueue_post_a in * . destruct HS' as [HM' [HBP' HSP']]. simplS in * . split. rewrite HSP'. destruct HS'' as [HS'' | HS'']. destruct HS'' as [_ HS'']. destruct HS'' as [_ [_ [HBP'' HSP'']]]. rewrite HSP''; trivial. destruct HS'' as [Q' [tid' [tcb' [HS'' _]]]]. destruct HS'' as [_ [_ [HBP'' [HSP'' _]]]]. rewrite HSP''; trivial. unfold Ret_Addr. exists (L_unblock +1+1+1+1+1). simplS. split. intros pc''. apply nextPC_retw with (sp -2-2-2); trivial. destruct HS'' as [HS'' | HS'']. destruct HS'' as [_ HS'']. destruct HS'' as [HM'' _]. sep on. subst mQ. sep lift 5 in HM'. sep trivial. destruct HS'' as [Q' [tid' [tcb' [HS'' _]]]]. destruct HS'' as [HM'' _]. sep on. subst mQ. sep lift 5 in HM'. sep trivial. intros pc''. clear HM'. destruct HS'' as [HS'' | HS'']. destruct HS'' as [_ HS'']. destruct HS'' as [HM'' [HAX'' [HBP'' HSP'']]]. apply nextPC_retw with (sp -2-2-2); trivial. sep on. subst mQ. sep lift 5 in HM''. sep trivial. destruct HS'' as [Q' [tid' [tcb' [HS'' _]]]]. destruct HS'' as [HM'' [HAX'' [HBP'' [HSP'' _]]]]. apply nextPC_retw with (sp -2-2-2); trivial. sep on. subst mQ. sep lift 6 in HM''. sep trivial. split. (* p => p' *) intros S' H. unfold conjPG, conjG, linkPG in H. destruct H as [S [HS HnextSS']]. unfold p_unblock_4 in HS. unfold p_deQueue. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. exists T; exists BlkQ; exists l_ptr; exists (S_RF S' BP); exists (sp -2-2-2). set (mQ := (embed_RdyQ T RdyQ) *^* (stkSpacePrec (sp -2-2-2-2) (_UNBLK_Stk -2-2-2-2)) *^* (sp -2-2-2 |->w (L_unblock +1+1+1+1+1)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk)). assert (HS' : Ast_deQueue_pre T BlkQ l_ptr (S_RF S' BP) (sp-2-2-2) (mQ *^* mTrue) S'). eapply Hpp'; eauto. clear Hpp''' Hpp' HS HnextSS'. unfold Ast_deQueue_pre in * . destruct HS' as [HM' H]. split_r. sep on. sep matchH HM' with 10. split. (* p => p''' *) intros pc' S'''. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S H]. destruct H as [HS H]. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. unfold p_unblock_4, p_unblock_5 in * . destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists bp; exists sp; exists jk. eapply Hpp'''; eauto. (* g'' => g *) intros pc' S S'''' H. unfold conjPG, wrap_fun, conjG, linkPG in H. destruct H as [S''' [HS HS'''S'''']]. destruct HS as [HSx [S'' [H HS'']]]. destruct H as [S' [HSS' HS'S'']]. unfold g_unblock_4, g_unblock_5 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk HS. substH HS'''S'''' with (HS'''S'''' mP T RdyQ BlkQ l_ptr bp sp jk). assert (H : Ast_unblock_5_a T RdyQ BlkQ l_ptr bp sp jk mP S''' \/ (exists BlkQ' : WQ, exists tid' : TID, exists tcb' : Thread, Ast_unblock_5_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S''')). eapply Hpp'''; eauto. clear Hpp' Hpp'''. destruct HS'''S'''' as [H1 H2]. destruct H as [HS''' | [BlkQ' [tid' [tcb' HS''']]]]. left; auto. right. substH H2 with (H2 BlkQ' tid' tcb' HS'''). destruct H2 as [T' [RdyQ' H2]]. exists T'; exists RdyQ'; exists BlkQ'; exists tid'; exists tcb'. trivial. Qed. (* : addw $2, %sp *) Lemma SCAP_WFcmd_5_addw : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1+1+1) (Ast p_unblock_6 g_unblock_6 sctag) psi_unblock) (L_unblock +1+1+1+1+1) (Ast p_unblock_5 g_unblock_5 sctag) (comml (_addw (Opr_imm 2 ) SP)). Proof. assert (Hpp'a : forall T RdyQ BlkQ l_ptr bp sp jk mP S S', Ast_unblock_5_a T RdyQ BlkQ l_ptr bp sp jk mP S -> nextS (L_unblock+1+1+1+1+1) (comml (_addw (Opr_imm 2 ) SP)) S S' -> Ast_unblock_6_a T RdyQ BlkQ l_ptr bp sp jk mP S'). intros T RdyQ BlkQ l_ptr bp sp jk mP S S' HS HSS'. unfold Ast_unblock_5_a, Ast_unblock_6_a in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HAX [HSP [HBP [Hsp HQ]]]]]. subst M' R' isr'. split. sep on. sep matchH HM with 10. sep stksplit. sep matchH HM with 2. reg simpl. unfold opr_eval. rewrite HSP. split_l. split. generalize Hsp; clearall; omega. repeat split_l; trivial. assert (Hpp'b : forall T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S', Ast_unblock_5_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock+1+1+1+1+1) (comml (_addw (Opr_imm 2 ) SP)) S S' -> Ast_unblock_6_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S'). intros T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S' HS HSS'. unfold Ast_unblock_5_b, Ast_unblock_6_b in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HA [HSP [HBP [Htid' [Hsp [HBT [Hmto' [Hin HBlkQ]]]]]]]]]. subst M' R' isr'. split. sep on. sep matchH HM with 10. generalize Hsp HM; clearall; intros. sep stksplit. sep matchH HM with 4. reg simpl. unfold opr_eval. split_l. split. rewrite HSP. generalize Hsp; clearall; intros. omega. repeat split_l; trivial. simpl. exists p_unblock_6; exists g_unblock_6. split_l. split. (* enable addw *) apply trivial_enable_addw. split. (* p ==> p' *) unfold p_unblock_5, p_unblock_6. intros S' H. unfold linkPG in H. destruct H as [S H]. simpl in H. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk H]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists bp; exists sp; exists jk. destruct H. left; apply Hpp'a with S; trivial. right. destruct H as [BlkQ' [tid' [tcb' HS]]]. exists BlkQ'; exists tid'; exists tcb'. apply Hpp'b with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[HSx HnextS] HS'S'']]. unfold g_unblock_5, g_unblock_6 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk. substH HS'S'' with (HS'S'' mP T RdyQ BlkQ l_ptr bp sp jk). destruct HS'S'' as [HS'S''a HS'S''b]. split. intros HS. eapply HS'S''a; eauto. intros BlkQ' tid' tcb' HS. eapply HS'S''b; eauto. Qed. (* : cmpw $0, %ax *) Lemma SCAP_WFcmd_6_cmpw : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1+1+1+1) (Ast p_unblock_7 g_unblock_7 sctag) psi_unblock) (L_unblock +1+1+1+1+1+1) (Ast p_unblock_6 g_unblock_6 sctag) (comml (_cmpw (Opr_imm 0 ) AX)). Proof. assert (Hpp'a : forall T RdyQ BlkQ l_ptr bp sp jk mP S S', Ast_unblock_6_a T RdyQ BlkQ l_ptr bp sp jk mP S -> nextS (L_unblock+1+1+1+1+1+1) (comml (_cmpw (Opr_imm 0 ) AX)) S S' -> Ast_unblock_7_a T RdyQ BlkQ l_ptr bp sp jk mP S'). intros T RdyQ BlkQ l_ptr bp sp jk mP S S' HS HSS'. unfold Ast_unblock_6_a, Ast_unblock_7_a in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HAX [HSP [HBP [Hsp HQ]]]]]. subst M' R' isr'. split. sep on. sep matchH HM with 10. destruct Hfl' as [Hfl' | Hfl']; simpl in Hfl'. destruct Hfl' as [_ Hfl']. subst fl'. unfold Set_Flag. simpl. repeat split_l; trivial. destruct Hfl' as [Hfl' _]. rewrite HAX in Hfl'. destruct (Hfl' (refl_equal _)). assert (Hpp'b : forall T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S', Ast_unblock_6_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock+1+1+1+1+1+1) (comml (_cmpw (Opr_imm 0 ) AX)) S S' -> Ast_unblock_7_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S'). intros T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S' HS HSS'. unfold Ast_unblock_6_b, Ast_unblock_7_b in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HAX [HSP [HBP [Hsp [Htid' [HBT [Hmto' [Hin HBlkQ]]]]]]]]]. subst M' R' isr'. assert (Hzf' : fl' _ZF = false). simpl in Hfl'. destruct Hfl'. destruct H. rewrite HAX in H. rewrite <- H in Htid'. destruct (Htid' (refl_equal _)). destruct H; subst fl'. simpl; trivial. split. sep on. sep matchH HM with 10. repeat split_l; trivial. simpl. exists p_unblock_7; exists g_unblock_7. split_l. split. (* enable addw *) apply trivial_enable_cmpw. split. (* p ==> p' *) unfold p_unblock_6, p_unblock_7. intros S' H. unfold linkPG in H. destruct H as [S H]. simpl in H. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk H]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists bp; exists sp; exists jk. destruct H. left; apply Hpp'a with S; trivial. right. destruct H as [BlkQ' [tid' [tcb' HS]]]. exists BlkQ'; exists tid'; exists tcb'. apply Hpp'b with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[HSx HnextS] HS'S'']]. unfold g_unblock_6, g_unblock_7 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk. substH HS'S'' with (HS'S'' mP T RdyQ BlkQ l_ptr bp sp jk). destruct HS'S'' as [HS'S''a HS'S''b]. split. intros HS. eapply HS'S''a; eauto. intros BlkQ' tid' tcb' HS. eapply HS'S''b; eauto. Qed. (* : jne wakeup *) Lemma SCAP_WFcmd_7_jne : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1+1+1+1+1) (Ast p_unblock_8 g_unblock_8 sctag) psi_unblock) (L_unblock +1+1+1+1+1+1+1) (Ast p_unblock_7 g_unblock_7 sctag) (comml (_jne L_wakeup)). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr bp sp jk mP S S', Ast_unblock_7_a T RdyQ BlkQ l_ptr bp sp jk mP S -> nextS (L_unblock+1+1+1+1+1+1+1) (comml (_jne L_wakeup)) S S' -> Ast_unblock_8 T RdyQ BlkQ l_ptr bp sp jk mP S'). intros T RdyQ BlkQ l_ptr bp sp jk mP S S' HS HSS'. unfold Ast_unblock_7_a, Ast_unblock_8 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HZF [HAX [HSP [HBP [Hsp HQ]]]]]]. subst M' R' isr'. repeat split_l; trivial. assert (Hpp'' : forall T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S', Ast_unblock_7_b T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock+1+1+1+1+1+1) (comml (_jne L_wakeup)) S S' -> Ast_unblock_10 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S'). intros T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S' HS HSS'. unfold Ast_unblock_7_b, Ast_unblock_10 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HZF [HAX [HSP [HBP [Hsp [Htid' [HBT [Hmto' [Hni HBlkQ']]]]]]]]]]. subst M' R' isr'. repeat split_l; trivial. simpl. exists p_unblock_10; exists p_unblock_8. exists g_unblock_10; exists g_unblock_8. split_l. unfold SCAP_lookupCT, SCAP_consCT. apply SPSpec.lookup_merge_intro_r. apply L_wakeup_in_psi_unblock. split_l. split. (* p ==> p'' *) unfold p_unblock_7, p_unblock_8. intros S' H. unfold conjP, linkPG in H. destruct H as [H HZF]. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk H]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists bp; exists sp; exists jk. unfold ZF_cl in HZF. destruct H. unfold Ast_unblock_7_a in H. destruct H as [_ [HZF' _]]. rewrite HZF' in HZF. discriminate. destruct H as [BlkQ' [tid' [tcb' HS']]]. exists BlkQ'; exists tid'; exists tcb'. apply Hpp'' with S'; trivial. destruct S' as [[[M' R'] fl'] isr']. apply nextS_jne. split. (* g'' ==> g *) unfold g_unblock_10, g_unblock_7. intros S S'' H. unfold conjPG, conjG in H. destruct H as [HSx [HZF H]]. intros mP T RdyQ BlkQ l_ptr bp sp jk. split. intros HS. unfold Ast_unblock_7_a in HS. unfold ZF_cl in HZF. destruct HS as [HM [HZF' [HAX [HSP [HBP [Hsp HQ]]]]]]. rewrite HZF in HZF'. discriminate. intros BlkQ' tid' tcb' HS. eapply H; eauto. eapply Hpp''; eauto. destruct S as [[[M R] fl] isr]. apply nextS_jne. split. (* p ==> p' *) unfold p_unblock_7, p_unblock_8. intros S' H. unfold conjP, linkPG in H. destruct H as [H HZF]. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk H]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists bp; exists sp; exists jk. unfold ZF_cl in HZF. destruct H. apply Hpp' with S'; trivial. destruct S' as [[[M' R'] fl'] isr']. apply nextS_jne. destruct H as [BlkQ' [tid' [tcb' HS']]]. unfold Ast_unblock_7_b in HS'. destruct HS' as [_ [HZF' _]]. unfold ZF_st in HZF. rewrite HZF' in HZF. discriminate. (* g' ==> g *) unfold g_unblock_8, g_unblock_7. intros S S'' H. unfold conjPG, conjG in H. destruct H as [HSx [HZF H]]. intros mP T RdyQ BlkQ l_ptr bp sp jk. split. intros HS. apply H. eapply Hpp'; eauto. destruct S as [[[M R] fl] isr]. apply nextS_jne. intros BlkQ' tid' tcb' HS. unfold Ast_unblock_7_b in HS. destruct HS as [_ [HZF' _]]. unfold ZF_st in HZF. rewrite HZF' in HZF. discriminate. Qed. (* : popw %bp *) Lemma SCAP_WFcmd_8_popw : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1+1+1+1+1+1) (Ast p_unblock_9 g_unblock_9 sctag) psi_unblock) (L_unblock +1+1+1+1+1+1+1+1) (Ast p_unblock_8 g_unblock_8 sctag) (comml (_popw BP)). Proof. assert (Hpp' : forall T RdyQ BlkQ l_ptr bp sp jk mP S S', Ast_unblock_8 T RdyQ BlkQ l_ptr bp sp jk mP S -> nextS (L_unblock+1+1+1+1+1+1+1+1) (comml (_popw BP)) S S' -> Ast_unblock_9 T RdyQ BlkQ l_ptr bp sp jk mP S'). intros T RdyQ BlkQ l_ptr bp sp jk mP S S' HS HSS'. unfold Ast_unblock_8, Ast_unblock_9 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [bpx [Hlds HR']]. simplS in * . destruct HS as [HM [HAX [HSP [HBP [Hsp HQ]]]]]. assert (Heq : bp = bpx). sep on. sep lift 3 in HM. rewrite HSP in Hlds. sep inj. auto. subst bpx. subst M' fl' R' isr'. split. sep on. sep matchH HM with 12. generalize Hsp HM; clearall; intros. sep stksplit. sep matchH HM with 2. rewrite HSP. reg simpl. split_l. split. generalize Hsp; clearall; omega. auto. simpl. exists p_unblock_9; exists g_unblock_9. split_l. split. (* enable *) apply enable_popw. intros S HS. destruct S as [[[M R] fl] isr]. unfold p_unblock_8 in HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. unfold Ast_unblock_8 in HS. destruct HS as [HM [HAX [HSP [HBP [Hsp HQ]]]]]. simplS in * . rewrite HSP. sep on. sep lift 3 in HM. sep trivial. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_unblock_8, p_unblock_9. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk HS]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists bp; exists sp; exists jk. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HSx HnextSS'] HS'S'']. unfold g_unblock_8, g_unblock_9 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk HS. eapply HS'S''; eauto. Qed. (* : retw # block_done *) Lemma SCAP_WFcmd_9_retw : SCAP_WFcmd psi_unblock (L_unblock +1+1+1+1+1+1+1+1+1) (Ast p_unblock_9 g_unblock_9 sctag) (comms (_retw)). Proof. unfold p_unblock_9, g_unblock_9. simpl. intros S H. intros. unfold Ast_unblock_9, Ast_unblock_post_a in * . InvertAll. repeat split_l. trivial. Qed. (* : movw %ax, %bx *) Lemma SCAP_WFcmd_10_movw : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1+1+1+1+1+1+1+1) (Ast p_unblock_11 g_unblock_11 sctag) psi_unblock) (L_unblock +1+1+1+1+1+1+1+1+1+1) (Ast p_unblock_10 g_unblock_10 sctag) (comml (_movwp (Opr_reg AX) BX)). Proof. assert (Hpp' : forall T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S', Ast_unblock_10 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock +1+1+1+1 +1+1+1+1 +1+1) (comml (_movwp (Opr_reg AX) BX)) S S' -> Ast_unblock_11 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S'). intros T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S' HS HSS'. unfold Ast_unblock_10, Ast_unblock_11 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. simplS in * . destruct HS as [HM [HAX [HSP [HBP [Hsp [Htid' [HBT [Hmto [Hin HBlkQ']]]]]]]]]. subst M' R' fl' isr'. simpl. reg simpl. rewrite HAX; rewrite HSP; rewrite HBP. split. simpl in HM. sep on. sep matchH HM with 8. repeat split_l; trivial. simpl. exists p_unblock_11; exists g_unblock_11. split_l. split. (* enable movw *) unfold enable, p_unblock_10. intros S H. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. unfold Ast_unblock_10 in HS. destruct HS as [HM [HAX [HSP [HBP [Hsp [Htid' [Hmto [Hin HBlkQ']]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (R' := RF_update R BX tid'). exists (M, R', fl, isr). apply nextS_movwp with tid'; auto. split. (* p ==> p' *) unfold p_unblock_10, p_unblock_11. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists bp; exists sp; exists jk; exists BlkQ'. exists tid'; exists tcb'. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HS'S'']]. unfold g_unblock_10, g_unblock_11 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk BlkQ' tid' tcb' HS. eapply HS'S''; eauto. Qed. (* : movw $READY, TCB_STATUS(%bx) *) Lemma SCAP_WFcmd_11_movwst : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1) (Ast p_unblock_12 g_unblock_12 sctag) psi_unblock) (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1) (Ast p_unblock_11 g_unblock_11 sctag) (comml (_movwst (Opr_imm 1) (A_reg TCB_STATUS BX))). Proof. assert (Hpp' : forall T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S', Ast_unblock_11 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1) (comml (_movwst (Opr_imm 1) (A_reg TCB_STATUS BX))) S S' -> Ast_unblock_12 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S'). intros T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S' HS HSS'. unfold Ast_unblock_11, Ast_unblock_12 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hlds HM']. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simpl in Hlds. simplS in * . destruct HS as [HM [HAX [HBX [HSP [HBP [Hsp [Htid' [HBT [Hmto [Hin HBlkQ']]]]]]]]]]. subst M' R' fl' isr'. split. sep on. unfold TCB_STATUS. unfold embed_TCB in * . rewrite HBX. sep lift 4 in HM. sep lift 4. apply ptoTCB_intro1 with 1. substH HM with (ptoTCB_elim1 HM). destruct HM as [tst [HM Htst]]. sep lift 1 in HM. sep lift 1. arith_rep (tid' + 4 + 2) with (tid' + 6). arith_rep (tid' + 4 + 2) with (tid' + 6) in HM. sep upd. destruct tcb' as [[spx statusx] pcx]. unfold TCB_SP, TCB_Status_Upd in * . sep matchH HM with 8. destruct tcb' as [[spx statusx] pcx]. unfold TCB_SP, TCB_Status, TCB_Status_Upd in * . simpl; trivial. repeat split_l; trivial. simpl. exists p_unblock_12; exists g_unblock_12. split_l. split. (* enable movw *) apply enable_movwst. intros S HS. unfold p_unblock_11 in HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. unfold Ast_unblock_11 in HS. simpl. destruct HS as [HM [HAX [HBX [HSP [HBP [Hsp [Htid' [Hmto [Hin HBlkQ']]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . set (M' := MemUpdW M (tid' + 4 + 2) 1 0). unfold TCB_STATUS. rewrite HBX. unfold embed_TCB in HM. sep on. sep lift 4 in HM. substH HM with (ptoTCB_elim1 HM). destruct HM as [tst [HM Htst]]. sep lift 1 in HM. arith_rep (tid' + 4 + 2) with (tid' + 6) in HM. sep trivial. split. (* p ==> p' *) unfold p_unblock_11, p_unblock_12. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists bp; exists sp; exists jk; exists BlkQ'; exists tid'; exists tcb'. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HSS']]. unfold g_unblock_11, g_unblock_12 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk BlkQ' tid' tcb' HS. eapply HSS'; eauto. Qed. (* : pushw $readyQ *) Lemma SCAP_WFcmd_12_pushwp : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1) (Ast p_unblock_13 g_unblock_13 sctag) psi_unblock) (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1) (Ast p_unblock_12 g_unblock_12 sctag) (comml (_pushwp (Opr_imm ready_Q))). Proof. assert (Hpp' : forall T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S', Ast_unblock_12 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1) (comml (_pushwp (Opr_imm ready_Q))) S S' -> Ast_unblock_13 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S'). intros T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S' HS HSS'. unfold Ast_unblock_12, Ast_unblock_13 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [HBX [HSP [HBP [Hsp [Htid' [HBT [Hmto [Hin HBlkQ']]]]]]]]]. subst M' R' fl' isr'. reg simpl. rewrite HSP. rewrite HBP. rewrite HBX. split. sep on. sep lift 4. sep upd. sep matchH HM with 13. sep stksplit in HM. trivial. repeat split_l; trivial. simpl. exists p_unblock_13; exists g_unblock_13. split_l. split. (* enable *) apply enable_pushwp with 8; simpl. intros S HS. unfold p_unblock_12 in HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. unfold Ast_unblock_12 in HS. destruct S as [[[M R] fl] isr]. destruct HS as [HM [HBX [HSP [HBP [Hsp [Htid' [HBT [Hmto [Hin HBlkQ']]]]]]]]]. simplS in * . rewrite HSP. sep on. sep lift 3 in HM. simpl in HM. sep trivial. clearall; omega. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_unblock_12, p_unblock_13. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists bp; exists sp; exists jk; exists BlkQ'; exists tid'; exists tcb'. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HS'S'']. unfold g_unblock_12, g_unblock_13 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk BlkQ' tid' tcb' HS. eapply HS'S''; eauto. Qed. (* : pushw %bx *) Lemma SCAP_WFcmd_13_pushwp : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1) (Ast p_unblock_14 g_unblock_14 sctag) psi_unblock) (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1) (Ast p_unblock_13 g_unblock_13 sctag) (comml (_pushwp (Opr_reg BX))). Proof. assert (Hpp' : forall T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S', Ast_unblock_13 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1) (comml (_pushwp (Opr_reg BX))) S S' -> Ast_unblock_14 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S'). intros T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S S' HS HSS'. unfold Ast_unblock_13, Ast_unblock_14 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspgt [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. simpl in HM'. simplS in * . destruct HS as [HM [HBX [HSP [HBP [Hsp [Htid' [HBT [Hmto [Hin HBlkQ']]]]]]]]]. subst M' R' fl' isr'. reg simpl. rewrite HSP. rewrite HBP. rewrite HBX. split. sep on. sep lift 4. sep upd. sep matchH HM with 13. sep stksplit in HM. trivial. repeat split_l; trivial. simpl. exists p_unblock_14; exists g_unblock_14. split_l. split. (* enable *) apply enable_pushwp with 6; simpl. intros S HS. unfold p_unblock_13 in HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. unfold Ast_unblock_13 in HS. destruct S as [[[M R] fl] isr]. destruct HS as [HM [HBX [HSP [HBP [Hsp [Htid' [HBT [Hmto [Hin HBlkQ']]]]]]]]]. simplS in * . rewrite HSP. sep on. sep lift 3 in HM. simpl in HM. sep trivial. clearall; omega. split. (* p ==> p' *) unfold linkPG, conjPG, conjG. unfold p_unblock_13, p_unblock_14. intros S' H. destruct H as [S H]. destruct H as [HS HnextS]. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists bp; exists sp; exists jk; exists BlkQ'; exists tid'; exists tcb'. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold linkPG, conjPG, conjG in H. destruct H as [S' H]. destruct H as [[HpS HnextSS'] HS'S'']. unfold g_unblock_13, g_unblock_14 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk BlkQ' tid' tcb' HS. eapply HS'S''; eauto. Qed. (* : call enQueue *) Lemma SCAP_WFcmd_14_call : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1) (Ast p_unblock_15 g_unblock_15 sctag) psi_unblock) (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1) (Ast p_unblock_14 g_unblock_14 sctag) (comml (_call L_enQueue)). Proof. assert(Hpp' : forall T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mQ mP S S', Ast_unblock_14 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1) (comml (_call L_enQueue)) S S' -> mQ = ((embed_BlkQ l_ptr T BlkQ') *^* (sp - 2 - 2 - 2 - 2 |->w (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk)) -> Ast_enQueue_pre T RdyQ ready_Q tid' (TCB_Status_Upd tcb' READY) (sp - 2) (sp -2-2-2-2) (mQ *^* mP) S'). intros T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mQ mP S S'. intros HS HSS' HmQ. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. unfold Ast_unblock_14 in HS. destruct HS as [HM [HBX [HSP [HBP [Hsp [Htid' [HBT [Hmto [Hin HBlkQ']]]]]]]]]. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HM' as [Hspx [Hlds HM']]. substH HM' with (MemUpd16_MemUpdW HM'). destruct HM' as [junk HM']. subst M' R' fl' isr'. unfold Ast_enQueue_pre. simplS in * . reg simpl. rewrite HSP. split. sep on. assert (H1 : sp - 2 - 2 - 2 - 2 + 2 = sp - 2 - 2 - 2). assert (H2 : sp - 2 - 2 - 2 = sp - 6). generalize Hsp; clearall; omega. rewrite H2. generalize Hsp; clearall; omega. rewrite H1. clear H1. assert (H1 : sp - 2 - 2 - 2 - 2 + 4 = sp - 2 - 2). assert (H2 : sp - 2 - 2 = sp - 4). generalize Hsp; clearall; omega. rewrite H2; clear H2. assert (H2 : sp - 4 - 2 = sp - 6). generalize Hsp; clearall; omega. rewrite H2; clear H2. assert (H2 : sp - 6 - 2 = sp - 8). generalize Hsp; clearall; omega. rewrite H2; clear H2. generalize Hsp; clearall; omega. rewrite H1; clear H1. subst mQ. sep lift 6. sep upd. unfold embed_RdyQ in HM. sep matchH HM with 10. sep stksplit in HM. simpl in HM. trivial. split. generalize Htid'; clearall. unfold TID in * ; omega. split_lr. assert (Hpp''' : forall T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk pc' mP S S' S'' S''', Ast_unblock_14 T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1) (comml (_call L_enQueue)) S S' -> g_enQueue S' S'' -> nextS pc' (comms (_retw)) S'' S''' -> exists T', exists RdyQ', Ast_unblock_15 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'''). intros T RdyQ BlkQ BlkQ' l_ptr tid' tcb' bp sp jk pc' mP. intros S S' S'' S''' HS HSS' HS'S'' HS''S'''. exists (TQMod.put T tid' (TCB_Status_Upd tcb' READY)). exists (addThrd RdyQ tid'). unfold g_enQueue in HS'S''. set (mQ := (embed_BlkQ l_ptr T BlkQ') *^* (sp - 2 - 2 - 2 - 2 |->w (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk)). assert (HS' : Ast_enQueue_pre T RdyQ ready_Q tid' (TCB_Status_Upd tcb' READY) (sp - 2) (sp -2-2-2-2) (mQ *^* mP) S'). eapply Hpp'; eauto. clear Hpp'. substH HS'S'' with (HS'S'' _ _ _ _ _ _ _ _ HS') into HS''. destruct HS'' as [T' [RdyQ' [HS'' [HT' HRdyQ']]]]. subst mQ. unfold Ast_enQueue_post in HS''. unfold Ast_unblock_15. destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. destruct S''' as [[[M''' R'''] fl'''] isr''']. unfold Ast_unblock_14 in HS. destruct HS as [HM [HBX [HSP [HBP [Hsp [Htid' [HBT [Hmto [Hin HBlkQ']]]]]]]]]. simplS in * . destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct (nextS_inversion HS''S''') as [HM''' [HR''' [Hfl''' Hisr''']]]. destruct HR''' as [pcx [Hlds HR''']]. destruct HS'' as [HM'' [HBP'' HSP'']]. assert (Hpcx : pcx = L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1). subst R' M''' R'''. clear HBP HSP Hsp HM HS' HS''S''' HM'. clear HT' HRdyQ' HSS'. subst fl' isr' fl''' isr'''. rewrite HSP'' in Hlds; clear HSP''. sep on. sep lift 5 in HM''. sep_inj; auto. subst pcx; clear Hlds. subst M''' R''' fl''' isr'''. reg simpl. rewrite HSP''. assert (H1 : sp - 2 - 2 - 2 - 2 + 2 = sp - 2 - 2 - 2). assert (H2 : sp - 2 - 2 - 2 = sp - 6). generalize Hsp; clearall; omega. rewrite H2; clear H2. generalize Hsp; clearall; omega. rewrite H1; rewrite H1 in HM''; clear H1. assert (H1 : sp - 2 - 2 - 2 - 2 + 4 = sp - 2 - 2). assert (H2 : sp - 2 - 2 = sp - 4). generalize Hsp; clearall; omega. rewrite H2; clear H2. assert (H2 : sp - 4 - 2 = sp - 6). generalize Hsp; clearall; omega. rewrite H2; clear H2. assert (H2 : sp - 6 - 2 = sp - 8). generalize Hsp; clearall; omega. rewrite H2; clear H2. generalize Hsp; clearall; omega. rewrite H1 in HM''; clear H1. split. unfold embed_RdyQ in * . unfold embed_BlkQ in *. rewrite <- HRdyQ'. rewrite <- HT'. rewrite (filterTQ_prev2 _ _ _ _ _ _ HBT HBlkQ' HT'). sep on. sep matchH HM'' with 9. generalize Hsp HM''; clearall. sep stksplit. simpl. sep matchH HM'' with 2. repeat split_l; trivial. simpl. exists p_enQueue; exists p_unblock_15. exists g_enQueue; exists g_unblock_15. split. unfold SCAP_lookupCT, SCAP_consCT. apply SPSpec.lookup_merge_intro_r. apply L_enQueue_in_psi_unblock. split_l. split. clear Hpp' Hpp'''. unfold enable, p_unblock_14. intros S HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. unfold Ast_unblock_14 in HS. destruct HS as [HM [HBX [HSP [HBP [Hsp _]]]]]. (* enable call *) destruct S as [[[M R] fl] isr]. simplS in * . exists (MemUpdW M (sp-2-2-2-2) (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1) 0, RF_update R SP (sp-2-2-2-2), fl, isr). apply nextS_call. unfold pushW. rewrite HSP. split. apply stkSpace_weaken with 4; [idtac | generalize Hsp; clearall; omega]. sep on. sep lift 3 in HM. simpl in HM. sep trivial. split_r. apply MemUpdW_MemUpd16 with 0; trivial. split. (* g' => fun_frame *) clear Hpp'''. unfold sp_call_pred, fun_frame. unfold linkPG, conjPG. intros S' S'' HS'S''. destruct HS'S'' as [H HS'S'']. destruct H as [S [HS HSS']]. unfold g_enQueue in HS'S''. unfold p_unblock_14 in HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. set (mQ := (embed_BlkQ l_ptr T BlkQ') *^* (sp - 2 - 2 - 2 - 2 |->w (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk)). assert (HS' : Ast_enQueue_pre T RdyQ ready_Q tid' (TCB_Status_Upd tcb' READY) (sp - 2) (sp -2-2-2-2) (mQ *^* mTrue) S'). eapply Hpp'; eauto. clear Hpp' HS HSS'. substH HS'S'' with (HS'S'' _ _ _ _ _ _ _ _ HS'). destruct HS'S'' as [T' [RdyQ' HS'']]. destruct S' as [[[M' R'] fl'] isr']. destruct S'' as [[[M'' R''] fl''] isr'']. simplS in * . destruct HS'' as [HS'' _]. unfold Ast_enQueue_pre, Ast_enQueue_post in * . destruct HS' as [HM' [Htid [HBP' HSP']]]. destruct HS'' as [HM'' [HBP'' HSP'']]. simplS in * . split. rewrite HSP'; rewrite HSP''; trivial. unfold Ret_Addr. exists (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1). simplS. split. intros pc''. apply nextPC_retw with (sp-2-2-2-2); trivial. clear HM''. sep on. subst mQ. sep lift 6 in HM'. sep trivial. intros pc''. apply nextPC_retw with (sp-2-2-2-2); trivial. clear HM'. sep on. subst mQ. sep lift 5 in HM''. sep trivial. split. (* p => p' *) intros S' H. unfold conjPG, conjG, linkPG in H. destruct H as [S [HS HnextSS']]. unfold p_unblock_14 in HS. unfold p_enQueue. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. exists T; exists RdyQ; exists ready_Q; exists tid'. exists (TCB_Status_Upd tcb' READY); exists (sp - 2); exists (sp -2-2-2-2). set (mQ := (embed_BlkQ l_ptr T BlkQ') *^* (sp - 2 - 2 - 2 - 2 |->w (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1)) *^* (sp - 2 |->w bp) *^* (sp + 2 |-> l_ptr) *^* (sp + 3 |-> jk)). assert (HS' : Ast_enQueue_pre T RdyQ ready_Q tid' (TCB_Status_Upd tcb' READY) (sp - 2) (sp -2-2-2-2) (mQ *^* mTrue) S'). eapply Hpp'; eauto. unfold Ast_enQueue_pre in * . destruct HS' as [HM' [Htid' [HBP' HSP']]]. rewrite HBP'; rewrite HSP'. split. sep on. sep matchH HM' with 10. auto. split. (* p => p''' *) intros pc' S'''. unfold linkPG, wrap_fun, conjG. intros H. destruct H as [S H]. destruct H as [HS H]. destruct H as [S'' [H HS''S''']]. destruct H as [S' [HSS' HS'S'']]. unfold p_unblock_14, p_unblock_15 in * . destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [BlkQ' [tid' [tcb' HS]]]]]]]]]]. assert (H : exists T' : TQ, exists RdyQ' : WQ, Ast_unblock_15 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mTrue S'''). eapply Hpp'''; eauto. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists bp; exists sp; exists jk. destruct H as [T' [RdyQ' HS''']]. exists T'; exists RdyQ'; exists BlkQ'; exists tid'; exists tcb'. trivial. (* g''' => g *) intros pc' S S'''' H. unfold conjPG, wrap_fun, conjG, linkPG in H. destruct H as [S''' [HS HS'''S'''']]. destruct HS as [HSx [S'' [Hx HnextS'']]]. destruct Hx as [S' [HSS' HS'S'']]. unfold g_unblock_14, g_unblock_15 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk BlkQ' tid' tcb' HS. assert (H : exists T' : TQ, exists RdyQ' : WQ, Ast_unblock_15 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'''). eapply Hpp'''; eauto. destruct H as [T' [RdyQ' HS']]. exists T'; exists RdyQ'; trivial. eapply HS'''S''''; eauto. Qed. (* : popw %ax *) Lemma SCAP_WFcmd_15_popw : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1+1) (Ast p_unblock_16 g_unblock_16 sctag) psi_unblock) (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1) (Ast p_unblock_15 g_unblock_15 sctag) (comml (_popw AX)). Proof. assert (Hpp' : forall T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S S', Ast_unblock_15 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1) (comml (_popw AX)) S S' -> Ast_unblock_16 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). intros T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S S' HS HSS'. unfold Ast_unblock_15, Ast_unblock_16 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [x [HMx HR']]. assert (x = tid'). simpl in HS. destruct HS as [HSM [HSP HS]]. sep on. sep lift 3 in HSM. rewrite HSP in HMx. sep inj; auto. destruct HS as [HM [HSP [Hsp [Htid' [Hmto [Hin [HBlkQ' [HT' HRdyQ']]]]]]]]. subst M' R' fl' isr' x. simpl in * . split. sep on. sep matchH HM with 10. sep stksplit. arith_rep (6 - 2) with 4. sep matchH HM with 2. repeat split_l; trivial. rewrite HSP. assert (Ha1 : sp - 2 - 2 - 2 + 2 = sp - 2 - 2). generalize Hsp; clearall. omega. rewrite Ha1;clear Ha1. trivial. exists p_unblock_16; exists g_unblock_16. split_l. split. (* enable popw *) apply enable_popw. intros S HS. unfold p_unblock_15 in HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]]]]]]]]. unfold Ast_unblock_15 in HS. simpl. destruct HS as [HM [HSP [Hsp [Htid' [Hmto [Hin [HBlkQ' [HT' HRdyQ']]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . rewrite HSP. sep on. sep lift 3 in HM. sep trivial. split. (* p ==> p' *) unfold p_unblock_15, p_unblock_16. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists bp; exists sp; exists jk. exists T'; exists RdyQ'; exists BlkQ'; exists tid'; exists tcb'. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HSS']]. unfold g_unblock_15, g_unblock_16 in * . intros. eapply HSS'; eauto. Qed. (* : addw $2, %sp *) Lemma SCAP_WFcmd_16_addw : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1+1 +1) (Ast p_unblock_17 g_unblock_17 sctag) psi_unblock) (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1+1) (Ast p_unblock_16 g_unblock_16 sctag) (comml (_addw (Opr_imm 2) SP)). Proof. assert (Hpp' : forall T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S S', Ast_unblock_16 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1+1) (comml (_addw (Opr_imm 2) SP)) S S' -> Ast_unblock_17 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). intros T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S S' HS HSS'. unfold Ast_unblock_16, Ast_unblock_17 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HS as [HM [HAX [HSP [Hsp [Htid' [Hmto [Hin [HBlkQ' [HT' HRdyQ']]]]]]]]]. subst M' R' isr'. simpl in * . split. sep on. sep matchH HM with 10. sep stksplit. arith_rep (8 - 2) with 6. sep matchH HM with 2. repeat split_l; trivial. rewrite HSP. arith_rep (S (S (sp -2 -2))) with (sp-2). exists p_unblock_17; exists g_unblock_17. split_l. split. (* enable addw *) apply trivial_enable_addw. split. (* p ==> p' *) unfold p_unblock_16, p_unblock_17. intros S' H. unfold linkPG in H. destruct H as [S H]. simpl in H. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [T' [RdyQ' [BlkQ' [tid' [tcb' H]]]]]]]]]]]] . exists T; exists RdyQ; exists BlkQ; exists l_ptr; exists bp; exists sp; exists jk. exists T'; exists RdyQ'; exists BlkQ'; exists tid'; exists tcb'. apply Hpp' with S; trivial. (* gimp *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[HSx HnextS] HS'S'']]. unfold g_unblock_16, g_unblock_17 in * . intros mP T RdyQ BlkQ l_ptr bp sp jk T' RdyQ' BlkQ' tid' tcb' HS. substH HS'S'' with (HS'S'' mP T RdyQ BlkQ l_ptr bp sp jk T' RdyQ' BlkQ' tid' tcb'). eapply HS'S''; eauto. Qed. (* : popw %bp *) Lemma SCAP_WFcmd_17_popw : SCAP_WFcmd (SCAP_consCT (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1) (Ast p_unblock_18 g_unblock_18 sctag) psi_unblock) (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1+1 +1) (Ast p_unblock_17 g_unblock_17 sctag) (comml (_popw BP)). Proof. assert (Hpp' : forall T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S S', Ast_unblock_17 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S -> nextS (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1+1 +1) (comml (_popw BP)) S S' -> Ast_unblock_18 T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S'). intros T T' RdyQ BlkQ RdyQ' BlkQ' l_ptr tid' tcb' bp sp jk mP S S' HS HSS'. unfold Ast_unblock_17, Ast_unblock_18 in * . destruct S as [[[M R] fl] isr]. destruct S' as [[[M' R'] fl'] isr']. destruct (nextS_inversion HSS') as [HM' [HR' [Hfl' Hisr']]]. destruct HR' as [x [HMx HR']]. assert (x = bp). simpl in HS. destruct HS as [HSM [HAX [HSP HS]]]. sep on. sep lift 3 in HSM. rewrite HSP in HMx. sep inj; auto. destruct HS as [HM [HAX [HSP [Hsp [Htid' [Hmto [Hin [HBlkQ' [HT' HRdyQ']]]]]]]]]. subst M' R' fl' isr' x. simpl in * . split. sep on. sep matchH HM with 10. sep stksplit. arith_rep (10 - 2) with 8. sep matchH HM with 2. repeat split_l; trivial. rewrite HSP. arith_rep (sp -2 +2) with sp. exists p_unblock_18; exists g_unblock_18. split_l. split. (* enable popw *) apply enable_popw. intros S HS. unfold p_unblock_17 in HS. destruct HS as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]]]]]]]]. unfold Ast_unblock_17 in HS. simpl. destruct HS as [HM [HAX [HSP [Hsp [Htid' [Hmto [Hin [HBlkQ' [HT' HRdyQ']]]]]]]]]. destruct S as [[[M R] fl] isr]. simplS in * . rewrite HSP. sep on. sep lift 3 in HM. sep trivial. split. (* p ==> p' *) unfold p_unblock_17, p_unblock_18. intros S' H. unfold linkPG in H. destruct H as [S H]. destruct H as [H HnextS]. destruct H as [T [RdyQ [BlkQ [l_ptr [bp [sp [jk [T' [RdyQ' [BlkQ' [tid' [tcb' HS]]]]]]]]]]]]. exists T; exists RdyQ; exists BlkQ; exists l_ptr. exists bp; exists sp; exists jk. exists T'; exists RdyQ'; exists BlkQ'; exists tid'; exists tcb'. apply Hpp' with S; trivial. (* g' ==> g *) intros S S'' H. unfold conjPG, conjG in H. destruct H as [S' [[_ HnextS] HSS']]. unfold g_unblock_17, g_unblock_18 in * . intros. eapply HSS'; eauto. Qed. (* : retw *) Lemma SCAP_WFcmd_18_retw : SCAP_WFcmd psi_unblock (L_unblock +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1+1+1 +1+1) (Ast p_unblock_18 g_unblock_18 sctag) (comms (_retw)). Proof. unfold p_unblock_18, g_unblock_18. simpl. intros S H. intros. unfold Ast_unblock_18, Ast_unblock_post_b in * . InvertAll. repeat split_l. trivial. Qed. Lemma SCAP_WFiseq_wakeup : SCAP_WFiseq psi_unblock L_wakeup (Ast p_unblock_10 g_unblock_10 sctag) I_wakeup. Proof. unfold I_wakeup, L_wakeup. apply scap_isq_seq with p_unblock_11 g_unblock_11. apply SCAP_WFcmd_10_movw. apply scap_isq_seq with p_unblock_12 g_unblock_12. apply SCAP_WFcmd_11_movwst. apply scap_isq_seq with p_unblock_13 g_unblock_13. apply SCAP_WFcmd_12_pushwp. apply scap_isq_seq with p_unblock_14 g_unblock_14. apply SCAP_WFcmd_13_pushwp. apply scap_isq_seq with p_unblock_15 g_unblock_15. apply SCAP_WFcmd_14_call. apply scap_isq_seq with p_unblock_16 g_unblock_16. apply SCAP_WFcmd_15_popw. apply scap_isq_seq with p_unblock_17 g_unblock_17. apply SCAP_WFcmd_16_addw. apply scap_isq_seq with p_unblock_18 g_unblock_18. apply SCAP_WFcmd_17_popw. apply scap_isq_end. apply SCAP_WFcmd_18_retw. Qed. Lemma WFiseq_unblock : SCAP_WFiseq psi_unblock L_unblock spec_unblock I_unblock. Proof. unfold L_unblock, spec_unblock, I_unblock. apply scap_isq_seq with p_unblock_1 g_unblock_1. apply SCAP_WFcmd_0_pushbp. apply scap_isq_seq with p_unblock_2 g_unblock_2. apply SCAP_WFcmd_1_movwp. apply scap_isq_seq with p_unblock_3 g_unblock_3. apply SCAP_WFcmd_2_movwld. apply scap_isq_seq with p_unblock_4 g_unblock_4. apply SCAP_WFcmd_3_pushwp. apply scap_isq_seq with p_unblock_5 g_unblock_5. apply SCAP_WFcmd_4_call. apply scap_isq_seq with p_unblock_6 g_unblock_6. apply SCAP_WFcmd_5_addw. apply scap_isq_seq with p_unblock_7 g_unblock_7. apply SCAP_WFcmd_6_cmpw. apply scap_isq_seq with p_unblock_8 g_unblock_8. apply SCAP_WFcmd_7_jne. apply scap_isq_seq with p_unblock_9 g_unblock_9. apply SCAP_WFcmd_8_popw. apply scap_isq_end. apply SCAP_WFcmd_9_retw. Qed.