Require Import ucos_include.
Require Import OSMutex_common.
Require Import os_ucos_h.
Require Import mutex_absop_rules.
Require Import sep_lemmas_ext.
Require Import symbolic_lemmas.
Require Import OSTimeDlyPure.
Require Import OSQPostPure.
Require Import tcblist_setnode_lemmas.
Require Import OSMutexPostPure.

Local Open Scope code_scope.
Local Open Scope nat_scope.
Local Open Scope Z_scope.
Local Open Scope int_scope.
Local Open Scope list_scope.

Lemma tcbjoin_get_exists :
  forall (tcbls:TcbMod.map) a x,
    get tcbls a = Some x ->
    exists tcbls',
      TcbJoin a x tcbls' tcbls.
Proof.
  intros.
  unfold TcbJoin.
  exists (minus tcbls (sig a x)).
  unfold join, minus, sig; simpl.
  unfold get in H; simpl in H.
  unfold TcbMod.join; intro.
  destruct (tidspec.beq a a0) eqn : eq1.
  lets Hx: tidspec.beq_true_eq eq1; substs.
  rewrite TcbMod.get_sig_some.
  rewrite TcbMod.minus_sem.
  rewrite TcbMod.get_sig_some.
  rewrite H; auto.
  lets Hx: tidspec.beq_false_neq eq1.
  rewrite TcbMod.minus_sem.
  rewrite TcbMod.get_sig_none; auto.
  destruct (TcbMod.get tcbls a0); auto.
Qed.

Lemma OSMapVallist_bound :
  forall n (i:int32),
    (n < 8)%nat -> exists i, nth_val' n OSMapVallist = Vint32 i /\ (Int.unsigned i) <= 128.
Proof.
  intros.
  destruct n.
  simpl; exists ($1); split; mauto.
  destruct n.
  simpl; exists ($2); split; mauto.
  destruct n.
  simpl; exists ($4); split; mauto.
  destruct n.
  simpl; exists ($8); split; mauto.
  destruct n.
  simpl; exists ($16); split; mauto.
  destruct n.
  simpl; exists ($32); split; mauto.
  destruct n.
  simpl; exists ($64); split; mauto.
  destruct n.
  simpl; exists ($128); split; mauto.
  omega.
Qed.

Lemma mutex_post_no_pi_part1 :
  forall
   ( v'  v'0  v'1  v'2 : val)
(v'3  v'4  v'5 : list vallist )
(  v'6 : list EventData)
(  v'7 : list os_inv.EventCtr)
(  v'8 : vallist)
(  v'9  v'10 : val)
(  v'11 : list vallist)
(  v'12 : vallist)
(  v'13 : list vallist)
(  v'14 : vallist)
(  v'15 : val)
(  v'16 : EcbMod.map)
(  v'17 : TcbMod.map)
(  v'18 : int32)
(  v'19 : addrval)
(  v'21 : val)
(  v'22 : list vallist)
(  v'25  v'26 : list os_inv.EventCtr)
(  v'27  v'28 : list EventData)
(  v'33  v'35 : list vallist)
(  v'38 : EcbMod.map)
(  v'42  v'46 : val)
(  v'47  v'48  v'49 : EcbMod.map)
(  w : waitset)
(  H17 : EcbMod.join v'47 v'49 v'38)
(  H12 : length v'25 = length v'27)
(  H16 : isptr v'46)
(  v'23 : addrval)
(  x3 : val)
(  H24 : isptr v'46)
(  H20 : Int.unsigned ($ OS_EVENT_TYPE_MUTEX) <= 255)
(  x : int32)
(  H10 : Int.unsigned x <= 65535)
(  H15 : Int.unsigned (x >>ᵢ $ 8) < 64)
(  H22 : Int.unsigned x <= 65535)
(  v'24 : val)
(  v'43  v'45 : TcbMod.map)
(  v'52 : block)
(  H30 : Vptr (v'52, Int.zero) <> Vnull)
(  H36 : isptr v'24)
(  x7 : val)
(  x10 : TcbMod.map)
(  m : msg)
(  H : RH_TCBList_ECBList_P v'16 v'17 (v'52, Int.zero))
(  H0 : RH_CurTCB (v'52, Int.zero) v'17)
(  H23 : isptr (Vptr (v'52, $ 0)))
(  H29 : x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 = $ OS_MUTEX_AVAILABLE \/
        x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 <> $ OS_MUTEX_AVAILABLE )
(  H35 : x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 <> $ OS_MUTEX_AVAILABLE)
(  H47 : Int.ltu (x >>ᵢ $ 8) (x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) = true)
(  H48 : Int.unsigned (x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) < 64)
(  H4 : Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) = None -> w = nil)
(  H9 : forall (tid0 : tid) (opr : int32),
       Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) = Some (tid0, opr) ->
       Int.ltu (x >>ᵢ $ 8) opr = true /\ Int.unsigned opr < 64 )
(  H13 : w <> nil -> Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) <> None )
(  H25 : x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 = $ OS_MUTEX_AVAILABLE ->
        Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) = None /\
        Vptr (v'52, $ 0) = Vnull )
(  H26 : x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 <> $ OS_MUTEX_AVAILABLE ->
        exists tid,
        Vptr (v'52, $ 0) = Vptr tid /\
        Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) =
        Some (tid, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) )
(  backup : RLH_ECBData_P (DMutex (Vint32 x) (Vptr (v'52, $ 0)))
             (absmutexsem (x >>ᵢ $ 8)
                (Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)), w) )
(  v'32  x1  x0 : val )
(  i7 : int32)
(  H55 : Int.unsigned i7 <= 255)
(  x2 : int32)
(  H59 : length OSUnMapVallist = 256%nat)
(  H62 : true = rule_type_val_match Int8u (Vint32 x2))
(  fffbb : Int.unsigned x2 < 8)
(  x4 : int32)
(  H64 : Int.unsigned x4 <= 255)
(  H65 : (Z.to_nat (Int.unsigned x4) < length OSUnMapVallist)%nat)
(  x5 : int32)
(  H66 : nth_val' (Z.to_nat (Int.unsigned x4)) OSUnMapVallist = Vint32 x5)
(  H67 : Int.unsigned x5 <= 255)
(  ttfasd : Int.unsigned x5 < 8)
(  H27 : isptr x7)
(  H38 : isptr m)
(  x6 : int32)
(  H77 : 0 <= Int.unsigned x6)
(  H85 : Int.unsigned x6 < 64)
(  x15 : val)
(  H43 : Int.unsigned (x6 >>ᵢ $ 3) <= 255)
(  H45 : Int.unsigned ($ 1<<ᵢ(x6 >>ᵢ $ 3)) <= 255)
(  H44 : Int.unsigned ($ 1<<ᵢ(x6&ᵢ$ 7)) <= 255)
(  H42 : Int.unsigned (x6&ᵢ$ 7) <= 255)
(  H41 : Int.unsigned x6 <= 255)
(  H28 : Int.ltu x6 (x >>ᵢ $ 8) = false)
(  H37 : isptr x15)
(  r1 : Int.unsigned ((x >>ᵢ $ 8) >>ᵢ $ 3) < 8)
(  r2 : Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)&ᵢ$ 7) < 8)
(  r3 : Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) >>ᵢ $ 3) < 8)
(  r4 : Int.unsigned ((x >>ᵢ $ 8)&ᵢ$ 7) < 8)
(  H34 : array_type_vallist_match Int8u OSMapVallist)
(  H69 : length OSMapVallist = 8%nat)
(  H71 : (Z.to_nat (Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) >>ᵢ $ 3)) <
         8)%nat )
(  x8 : int32 )
(  H74 : nth_val'
          (Z.to_nat
             (Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) >>ᵢ $ 3)))
          OSMapVallist = Vint32 x8 )
(  H75 : true = rule_type_val_match Int8u (Vint32 x8))
(  H76 : (Z.to_nat (Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)&ᵢ$ 7)) < 8)%nat)
(  x9 : int32)
(  H78 : nth_val'
          (Z.to_nat (Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)&ᵢ$ 7)))
          OSMapVallist = Vint32 x9 )
(  H79 : true = rule_type_val_match Int8u (Vint32 x9))
(  H80 : (Z.to_nat (Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)&ᵢ$ 7)) < 8)%nat)
(  x11 : int32)
(  H81 : nth_val'
          (Z.to_nat (Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)&ᵢ$ 7)))
          OSMapVallist = Vint32 x11)
(  H83 : true = rule_type_val_match Int8u (Vint32 x11))
(  r5 : Int.unsigned (x6 >>ᵢ $ 3) < 8)
(  r6 : Int.unsigned (x6&ᵢ$ 7) < 8)
(  x16 : int32)
(  H91 : Int.unsigned x16 <= 255)
(  x13 : int32)
(  H90 : Int.unsigned x13 <= 255)
(  x12 : int32)
(  H89 : Int.unsigned x12 <= 255)
(  H92 : Int.unsigned (x >>ᵢ $ 8) < Int.unsigned ($ Byte.modulus))
(  H70 : TcbJoin (v'52, Int.zero) (x6, rdy, m) x10 v'45)
(  H82 : $ OS_STAT_RDY = $ OS_STAT_RDY \/
        $ OS_STAT_RDY = $ OS_STAT_SEM \/
        $ OS_STAT_RDY = $ OS_STAT_Q \/
        $ OS_STAT_RDY = $ OS_STAT_MBOX \/
        $ OS_STAT_RDY = $ OS_STAT_MUTEX )
(  H84 : $ OS_STAT_RDY = $ OS_STAT_RDY -> x15 = Vnull)
(  H40 : Int.unsigned ($ OS_STAT_RDY) <= 255)
(  H39 : Int.unsigned ($ 0) <= 65535)
(  H93 : val_inj
          (if Int.eq x6 (x >>ᵢ $ 8)
           then Some (Vint32 Int.one)
           else Some (Vint32 Int.zero)) = Vint32 Int.zero \/
        val_inj
          (if Int.eq x6 (x >>ᵢ $ 8)
           then Some (Vint32 Int.one)
           else Some (Vint32 Int.zero)) = Vnull )
(  v'34 : addrval)
(  v'37 : TcbMod.map)
(  v'53 : list val)
(  v'54 : vallist)
(  v'57 : val)
(  v'58  v'59 : int32)
(  v'60 : vallist)
(  v'67  v'69 : val)
(  v'73  v'74  v'75  v'76  v'77 : int32)
(  v'80  v'81  v'82  v'83  v'84 : val)
(  v'85 : int32)
(  v'86  v'87  v'88  v'89  v'90 : val)
(  v'91 : block)
(  v'92 : int32)
(  H95 : nth_val' (Z.to_nat (Int.unsigned v'74)) v'54 = Vint32 v'92)
(  H97 : nth_val' (Z.to_nat (Int.unsigned ((v'74<<ᵢ$ 3) +ᵢ  v'73))) v'53 =
        Vptr (v'91, Int.zero) /\ (v'91, Int.zero) <> v'34 )
(  H103 : nth_val' (Z.to_nat (Int.unsigned v'58)) OSUnMapVallist =
         Vint32 v'74 )
(  H104 : nth_val' (Z.to_nat (Int.unsigned v'74)) v'60 = Vint32 v'75 )
(  H105 : nth_val' (Z.to_nat (Int.unsigned v'75)) OSUnMapVallist =
         Vint32 v'73 )
(  H106 : nth_val' (Z.to_nat (Int.unsigned v'74)) OSMapVallist =
         Vint32 v'77 )
(  H107 : nth_val' (Z.to_nat (Int.unsigned v'73)) OSMapVallist =
         Vint32 v'76 )
(  H112 : array_type_vallist_match Int8u v'54 /\
         length v'54 = ∘ OS_RDY_TBL_SIZE )
(  H114 : RL_Tbl_Grp_P v'60 (Vint32 v'58))
(  H115 : array_type_vallist_match Int8u v'60)
(  H120 : array_type_vallist_match OS_TCB ∗ v'53 /\ length v'53 = 64%nat)
(  H122 : R_PrioTbl_P v'53 v'37 v'34)
(  H31 : v'67 <> Vnull)
(  H46 : array_type_vallist_match OS_TCB ∗ v'53)
(  H51 : length v'53 = 64%nat)
(  H52 : nth_val (Z.to_nat (Int.unsigned (x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)))
          v'53 = Some x1 )
(  H53 : nth_val (Z.to_nat (Int.unsigned (x >>ᵢ $ 8))) v'53 = Some x0)
(  H72 : TCBList_P x7 v'35 v'54 x10)
(  H54 : array_type_vallist_match Int8u v'54)
(  H58 : length v'54 = ∘ OS_RDY_TBL_SIZE)
(  H57 : prio_in_tbl ($ OS_IDLE_PRIO) v'54)
(  H56 : RL_Tbl_Grp_P v'54 (Vint32 i7))
(  rr1 : (Z.to_nat (Int.unsigned ((x >>ᵢ $ 8) >>ᵢ $ 3)) < length v'54)%nat)
(  rr2 : (Z.to_nat (Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)&ᵢ$ 7)) <
         length v'54)%nat )
(  rr3 : (Z.to_nat (Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) >>ᵢ $ 3)) <
         length v'54)%nat )
(  rr4 : (Z.to_nat (Int.unsigned ((x >>ᵢ $ 8)&ᵢ$ 7)) < length v'54)%nat)
(  rr5 : (Z.to_nat (Int.unsigned (x6 >>ᵢ $ 3)) < length v'54)%nat)
(  rr6 : (Z.to_nat (Int.unsigned (x6&ᵢ$ 7)) < length v'54)%nat)
(  rrr1 : Int.unsigned ((x >>ᵢ $ 8) >>ᵢ $ 3) < Z.of_nat (length v'54))
(  rrr2 : Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)&ᵢ$ 7) <
         Z.of_nat (length v'54) )
(  rrr3 : Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) >>ᵢ $ 3) <
         Z.of_nat (length v'54) )
(  rrr4 : Int.unsigned ((x >>ᵢ $ 8)&ᵢ$ 7) < Z.of_nat (length v'54))
(  rrr5 : Int.unsigned (x6 >>ᵢ $ 3) < Z.of_nat (length v'54))
(  rrr6 : Int.unsigned (x6&ᵢ$ 7) < Z.of_nat (length v'54))
(  HH58 : length v'54 = Z.to_nat 8)
(  aa : rule_type_val_match Int8u
         (nth_val' (Z.to_nat (Int.unsigned ((x >>ᵢ $ 8) >>ᵢ $ 3))) v'54) =
       true )
(  aa2 : rule_type_val_match Int8u
          (nth_val'
             (Z.to_nat
                (Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) >>ᵢ $ 3)))
             v'54) = true )
(  aa3 : rule_type_val_match Int8u
          (nth_val' (Z.to_nat (Int.unsigned (x6 >>ᵢ $ 3))) v'54) = true )
(  H88 : nth_val' (Z.to_nat (Int.unsigned ((x >>ᵢ $ 8) >>ᵢ $ 3))) v'54 =
        Vint32 x16 )
(  H87 : nth_val'
          (Z.to_nat
             (Int.unsigned ((x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) >>ᵢ $ 3))) v'54 =
        Vint32 x13 )
(  H86 : nth_val' (Z.to_nat (Int.unsigned (x6 >>ᵢ $ 3))) v'54 =
        Vint32 x12 )
(  backup2 : TCBList_P (Vptr (v'52, Int.zero))
              ((x7
                :: v'24
                   :: x15
                      :: m
                         :: V$ 0
                            :: V$ OS_STAT_RDY
                               :: Vint32 x6
                                  :: Vint32 (x6&ᵢ$ 7)
                                     :: Vint32 (x6 >>ᵢ $ 3)
                                        :: Vint32 ($ 1<<ᵢ(x6&ᵢ$ 7))
                                           :: Vint32
                                              ($ 1<<ᵢ(x6 >>ᵢ $ 3))
                                              :: nil) :: v'35) v'54 v'45 )
(  H73 : R_TCB_Status_P
          (x7
           :: v'24
              :: x15
                 :: m
                    :: V$ 0
                       :: V$ OS_STAT_RDY
                          :: Vint32 x6
                             :: Vint32 (x6&ᵢ$ 7)
                                :: Vint32 (x6 >>ᵢ $ 3)
                                   :: Vint32 ($ 1<<ᵢ(x6&ᵢ$ 7))
                                      :: Vint32 ($ 1<<ᵢ(x6 >>ᵢ $ 3))
                                         :: nil) v'54
          (x6, rdy, m) )
(  H33 : TCBList_P v'67 v'33 v'54 v'43)
(  H49 : RL_RTbl_PrioTbl_P v'54 v'53 v'34)
(  H111 : RL_Tbl_Grp_P v'54 (Vint32 i7) /\
         prio_in_tbl ($ OS_IDLE_PRIO) v'54 )
(  H113 : rule_type_val_match Int8u (Vint32 i7) = true)
(  H11 : array_type_vallist_match Int8u v'60)
(  H19 : length v'60 = ∘ OS_EVENT_TBL_SIZE)
(  fffbb2 : (Z.to_nat (Int.unsigned x2) < length v'60)%nat)
(  H19'' : length v'60 = Z.to_nat 8)
(  H63 : nth_val' (Z.to_nat (Int.unsigned x2)) v'60 = Vint32 x4)
(  H102 : rel_edata_tcbstat (DMutex (Vint32 x) (Vptr (v'52, $ 0))) v'85)
(  H3 : ECBList_P v'46 Vnull v'26 v'28 v'48 v'37)
(  H32 : join v'43 v'45 v'37)
(  H7 : RH_TCBList_ECBList_P v'38 v'37 (v'52, Int.zero))
(  H8 : RH_CurTCB (v'52, Int.zero) v'37)
(  H50 : R_PrioTbl_P v'53 v'37 v'34)
(  H124 : TCBList_P v'67
           (v'33 ++
            (x7
             :: v'24
                :: x15
                   :: m
                      :: V$ 0
                         :: V$ OS_STAT_RDY
                            :: Vint32 x6
                               :: Vint32 (x6&ᵢ$ 7)
                                  :: Vint32 (x6 >>ᵢ $ 3)
                                     :: Vint32 ($ 1<<ᵢ(x6&ᵢ$ 7))
                                        :: Vint32 ($ 1<<ᵢ(x6 >>ᵢ $ 3))
                                           :: nil) :: v'35) v'54 v'37 )
(  H21 : Int.unsigned v'58 <= 255 )
(  fffa : length OSUnMapVallist = 256%nat ->
         (Z.to_nat (Int.unsigned v'58) < 256)%nat ->
         exists x,
         Vint32 x2 = Vint32 x /\
         true = rule_type_val_match Int8u (Vint32 x) )
(  H60 : (Z.to_nat (Int.unsigned v'58) < 256)%nat )
(  H61 : nth_val' (Z.to_nat (Int.unsigned v'58)) OSUnMapVallist =
        Vint32 x2 )
(  H68 : val_inj
          (bool_and
             (val_inj
                (notint
                   (val_inj
                      (if Int.eq v'58 ($ 0)
                       then Some (Vint32 Int.one)
                       else Some (Vint32 Int.zero)))))
             (val_inj
                (bool_or
                   (val_inj
                      (if Int.ltu ((x2<<ᵢ$ 3) +ᵢ  x5) (x >>ᵢ $ 8)
                       then Some (Vint32 Int.one)
                       else Some (Vint32 Int.zero)))
                   (val_inj
                      (if Int.eq ((x2<<ᵢ$ 3) +ᵢ  x5) (x >>ᵢ $ 8)
                       then Some (Vint32 Int.one)
                       else Some (Vint32 Int.zero)))))) =
        Vint32 Int.zero \/
        val_inj
          (bool_and
             (val_inj
                (notint
                   (val_inj
                      (if Int.eq v'58 ($ 0)
                       then Some (Vint32 Int.one)
                       else Some (Vint32 Int.zero)))))
             (val_inj
                (bool_or
                   (val_inj
                      (if Int.ltu ((x2<<ᵢ$ 3) +ᵢ  x5) (x >>ᵢ $ 8)
                       then Some (Vint32 Int.one)
                       else Some (Vint32 Int.zero)))
                   (val_inj
                      (if Int.eq ((x2<<ᵢ$ 3) +ᵢ  x5) (x >>ᵢ $ 8)
                       then Some (Vint32 Int.one)
                       else Some (Vint32 Int.zero)))))) = Vnull )
(  H94 : val_inj
          (notint
             (val_inj
                (if Int.eq v'58 ($ 0)
                 then Some (Vint32 Int.one)
                 else Some (Vint32 Int.zero)))) <>
        Vint32 Int.zero /\
        val_inj
          (notint
             (val_inj
                (if Int.eq v'58 ($ 0)
                 then Some (Vint32 Int.one)
                 else Some (Vint32 Int.zero)))) <> Vnull /\
        val_inj
          (notint
             (val_inj
                (if Int.eq v'58 ($ 0)
                 then Some (Vint32 Int.one)
                 else Some (Vint32 Int.zero)))) <> Vundef )
(  i_neq_zero : v'58 <> Int.zero )
(  H18 : RL_Tbl_Grp_P v'60 (Vint32 v'58) )
(  H1 : ECBList_P v'42 Vnull
         (v'25 ++
          ((V$ OS_EVENT_TYPE_MUTEX
            :: Vint32 v'58
               :: Vint32 x :: Vptr (v'52, $ 0) :: x3 :: v'46 :: nil,
           v'60) :: nil) ++ v'26)
         (v'27 ++ (DMutex (Vint32 x) (Vptr (v'52, $ 0)) :: nil) ++ v'28)
         v'38 v'37 )
(  H98 : tcblist_get (Vptr (v'91, Int.zero)) v'67
          (v'33 ++
           (x7
            :: v'24
               :: x15
                  :: m
                     :: V$ 0
                        :: V$ OS_STAT_RDY
                           :: Vint32 x6
                              :: Vint32 (x6&ᵢ$ 7)
                                 :: Vint32 (x6 >>ᵢ $ 3)
                                    :: Vint32 ($ 1<<ᵢ(x6&ᵢ$ 7))
                                       :: Vint32 ($ 1<<ᵢ(x6 >>ᵢ $ 3))
                                          :: nil) :: v'35) =
        Some
          (v'80
           :: v'81
              :: v'82
                 :: v'83
                    :: v'84
                       :: Vint32 v'85
                          :: v'86 :: v'87 :: v'88 :: v'89 :: v'90 :: nil) /\
        struct_type_vallist_match OS_TCB_flag
          (v'80
           :: v'81
              :: v'82
                 :: v'83
                    :: v'84
                       :: Vint32 v'85
                          :: v'86 :: v'87 :: v'88 :: v'89 :: v'90 :: nil) )
(  H121 : RL_RTbl_PrioTbl_P
           (update_nth_val (Z.to_nat (Int.unsigned v'74)) v'54
              (Vint32 (Int.or v'92 v'76))) v'53 v'34 )
(  v'30 : addrval)
(  v'31 : val)
(  v'36 : block)
(  H118 : struct_type_vallist_match OS_EVENT
           (V$ OS_EVENT_TYPE_MUTEX
            :: Vint32 v'59
               :: Vint32 x :: Vptr (v'52, $ 0) :: x3 :: v'46 :: nil) )
(  H99 : array_type_vallist_match Int8u
          (update_nth_val (Z.to_nat (Int.unsigned v'74)) v'60
             (Vint32 (v'75&ᵢInt.not v'76))) )
(  H101 : Some (Vint32 v'59) = Some v'31 )
(  H108 : RL_Tbl_Grp_P
           (update_nth_val (Z.to_nat (Int.unsigned v'74)) v'60
              (Vint32 (v'75&ᵢInt.not v'76))) v'31)
(  H109 : Some (V$ OS_EVENT_TYPE_MUTEX) = Some (V$ OS_EVENT_TYPE_MUTEX))
(  H116 : Some (Vint32 x) = Some (Vint32 x))
(  H117 : Some (Vptr (v'52, $ 0)) = Some (Vptr (v'52, $ 0)))
(  H14 : id_addrval' (Vptr (v'36, Int.zero)) OSEventTbl OS_EVENT =
        Some v'23 )
(  H6 : EcbMod.joinsig (v'36, Int.zero)
         (absmutexsem (x >>ᵢ $ 8)
            (Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)), w) v'48 v'49 )
(  H2 : ECBList_P v'42 (Vptr (v'36, Int.zero)) v'25 v'27 v'47 v'37 )
(  H5 : R_ECB_ETbl_P (v'36, Int.zero)
         (V$ OS_EVENT_TYPE_MUTEX
          :: Vint32 v'58
             :: Vint32 x :: Vptr (v'52, $ 0) :: x3 :: v'46 :: nil, v'60)
         v'37 )
(  H123 : R_ECB_ETbl_P (v'36, Int.zero)
           (V$ OS_EVENT_TYPE_MUTEX
            :: Vint32 v'58
               :: Vint32 x :: Vptr (v'52, $ 0) :: x3 :: v'46 :: nil,
           v'60) v'37 )
(  H119 : ptr_in_tcblist (Vptr (v'52, Int.zero)) v'67
           (set_node (Vptr (v'91, Int.zero))
              (v'80
               :: v'81
                  :: Vnull
                     :: Vptr (v'36, Int.zero)
                        :: Vint32 Int.zero
                           :: Vint32 (v'85&ᵢInt.not ($ OS_STAT_MUTEX))
                              :: v'86
                                 :: v'87 :: v'88 :: v'89 :: v'90 :: nil)
              v'67
              (v'33 ++
               (x7
                :: v'24
                   :: x15
                      :: m
                         :: V$ 0
                            :: V$ OS_STAT_RDY
                               :: Vint32 x6
                                  :: Vint32 (x6&ᵢ$ 7)
                                     :: Vint32 (x6 >>ᵢ $ 3)
                                        :: Vint32 ($ 1<<ᵢ(x6&ᵢ$ 7))
                                           :: Vint32
                                              ($ 1<<ᵢ(x6 >>ᵢ $ 3))
                                              :: nil) :: v'35)) )
(  H100 : id_addrval' (Vptr (v'36, Int.zero)) OSEventTbl OS_EVENT =
         Some v'30 )
(  H_rgrp_le7 : Int.unsigned v'74 <= 7)
( H_row_le7 : Int.unsigned v'73 <= 7 ),
 {|OS_spec, GetHPrio, OSLInv, I,
   fun v : option val =>
   ( <|| END v ||>  **
    p_local OSLInv (v'52, Int.zero) init_lg **
    ((EX v0 : val, LV pevent @ OS_EVENT ∗ |-> v0) **
     (EX v0 : val, LV os_code_defs.x @ Int8u |-> v0) **
     (EX v0 : val, LV pip @ Int8u |-> v0) **
     (EX v0 : val, LV prio @ Int8u |-> v0) **
     (EX v0 : val, LV legal @ Int8u |-> v0) ** Aemp) **
    Aie true ** Ais nil ** Acs nil ** Aisr empisr) **
   A_dom_lenv
     ((pevent, OS_EVENT ∗)
      :: (os_code_defs.x, Int8u)
         :: (pip, Int8u) :: (prio, Int8u) :: (legal, Int8u) :: nil),
   Afalse|}|- (v'52, Int.zero)
   {{ <|| mutexpost (Vptr (v'36, Int.zero) :: nil) ||>  **
     LV pevent @ OS_EVENT ∗ |-> Vptr (v'36, Int.zero) **
     Astruct (v'36, Int.zero) OS_EVENT
       (V$ OS_EVENT_TYPE_MUTEX
        :: Vint32 v'59
           :: Vint32
                (Int.or (x&ᵢ$ OS_MUTEX_KEEP_UPPER_8) ((v'74<<ᵢ$ 3) +ᵢ  v'73))
              :: nth_val' (Z.to_nat (Int.unsigned ((v'74<<ᵢ$ 3) +ᵢ  v'73)))
                   v'53 :: x3 :: v'46 :: nil) **
     Aarray v'30 (Tarray Int8u ∘ OS_EVENT_TBL_SIZE)
       (update_nth_val (Z.to_nat (Int.unsigned v'74)) v'60
          (Vint32 (v'75&ᵢInt.not v'76))) **
     p_local OSLInv (v'52, Int.zero) init_lg **
     Aie false **
     Ais nil **
     Acs (true :: nil) **
     Aisr empisr **
     A_isr_is_prop **
     AOSUnMapTbl **
     AOSMapTbl **
     AOSRdyTblGrp
       (update_nth_val (Z.to_nat (Int.unsigned v'74)) v'54
          (Vint32 (Int.or v'92 v'76))) v'57 **
     GAarray OSTCBPrioTbl (Tarray OS_TCB ∗ 64) v'53 **
     tcbdllseg v'67 Vnull v'69 Vnull
       (set_node (Vptr (v'91, Int.zero))
          (v'80
           :: v'81
              :: Vnull
                 :: Vptr (v'36, Int.zero)
                    :: Vint32 Int.zero
                       :: Vint32 (v'85&ᵢInt.not ($ OS_STAT_MUTEX))
                          :: v'86 :: v'87 :: v'88 :: v'89 :: v'90 :: nil)
          v'67
          (v'33 ++
           (x7
            :: v'24
               :: x15
                  :: m
                     :: V$ 0
                        :: V$ OS_STAT_RDY
                           :: Vint32 x6
                              :: Vint32 (x6&ᵢ$ 7)
                                 :: Vint32 (x6 >>ᵢ $ 3)
                                    :: Vint32 ($ 1<<ᵢ(x6&ᵢ$ 7))
                                       :: Vint32 ($ 1<<ᵢ(x6 >>ᵢ $ 3)) :: nil)
           :: v'35)) **
     LV prio @ Int8u |-> Vint32 ((v'74<<ᵢ$ 3) +ᵢ  v'73) **
     LV os_code_defs.x @ Int8u |-> (V$ OS_STAT_MUTEX) **
     LV legal @ Int8u |-> Vint32 x2 **
     PV v'34 @ Int8u |-> v'32 **
     GV OSTCBList @ OS_TCB ∗ |-> v'67 **
     GV OSTCBCur @ OS_TCB ∗ |-r-> Vptr (v'52, Int.zero) **
     LV pip @ Int8u |-> Vint32 (x >>ᵢ $ 8) **
     GV OSEventList @ OS_EVENT ∗ |-> v'42 **
     evsllseg v'42 (Vptr (v'36, Int.zero)) v'25 v'27 **
     evsllseg v'46 Vnull v'26 v'28 **
     tcbdllflag v'67
       (v'33 ++
        (x7
         :: v'24
            :: x15
               :: m
                  :: V$ 0
                     :: V$ OS_STAT_RDY
                        :: Vint32 x6
                           :: Vint32 (x6&ᵢ$ 7)
                              :: Vint32 (x6 >>ᵢ $ 3)
                                 :: Vint32 ($ 1<<ᵢ(x6&ᵢ$ 7))
                                    :: Vint32 ($ 1<<ᵢ(x6 >>ᵢ $ 3)) :: nil)
        :: v'35) **
     G& OSPlaceHolder @ Int8u == v'34 **
     HECBList v'38 **
     HTCBList v'37 **
     HCurTCB (v'52, Int.zero) **
     AOSEventFreeList v'3 **
     AOSQFreeList v'4 **
     AOSQFreeBlk v'5 **
     AOSIntNesting **
     AOSTCBFreeList v'21 v'22 **
     AOSTime (Vint32 v'18) **
     HTime v'18 **
     AGVars **
     atoy_inv' **
     A_dom_lenv
       ((pevent, OS_EVENT ∗)
        :: (os_code_defs.x, Int8u)
           :: (pip, Int8u) :: (prio, Int8u) :: (legal, Int8u) :: nil)}}
   EXIT_CRITICAL;ₛ
   OS_Sched ();ₛ
  RETURN ′ OS_NO_ERR {{Afalse}}.
Proof.
  Set Printing Depth 999.
  intros.

  (*high level step*)
  destruct H97.
  unfolds in H50.
  destruct H50.
  assert (0 <= Int.unsigned ((v'74<<ᵢ$ 3) +ᵢ  v'73) < 64) as H_prio_range.
  clear - H_rgrp_le7 H_row_le7.
  mauto.

  assert (nth_val ∘ (Int.unsigned ((v'74<<ᵢ$ 3) +ᵢ  v'73)) v'53 = Some (Vptr (v'91, Int.zero))).
  eapply oscore_common.nth_val'2nth_val'; auto.

  lets Hx: H50 H_prio_range H125 H97.
  destruct Hx.
  destruct H126.

  lets Hx: tcbjoin_get_exists H126; destruct Hx.
  lets Hx: post_exwt_succ_pre_mutex'' i_neq_zero H103 H104 H105 H96; eauto.
  clear - H104 H115 H_rgrp_le7 H19.
  assert (Z.to_nat (Int.unsigned v'74) < length v'60)%nat.
  rewrite H19.
  unfold OS_EVENT_TBL_SIZE.
  mauto.
  lets Hx: array_int8u_nth_lt_len H115 H; simpljoin1.
  rewrite H104 in H0; inverts H0; auto.
  lets Hx1: Hx H127; clear Hx.
  simpljoin1.

  assert (Int.eq x6 (x >>ᵢ $ 8) = false).
  clear - H93.
  destruct H93.
  destruct (Int.eq x6 (x >>ᵢ $ 8)) eqn : eq1; tryfalse; auto.
  destruct (Int.eq x6 (x >>ᵢ $ 8)) eqn : eq1; tryfalse; auto.

  hoare abscsq.
  apply noabs_oslinv.
  eapply absinfer_mutexpost_noreturn_exwt_succ; eauto.
  go.
  eapply EcbMod.join_get_r; eauto.
  eapply EcbMod.join_get_l; eauto.
  eapply EcbMod.get_sig_some.

  eapply join_get_r.
  auto.
  eapply H32.
  unfold TcbJoin in H70.
  eapply join_get_l; eauto.
  eapply get_sig_some.

(*change the tcbdllseg in the post cond of OS_EventTaskRdy *)
  assert ((((v'74<<ᵢ$ 3) +ᵢ  v'73) >>ᵢ $ 3) = v'74) as H_prio_shr3.
  clear - H_rgrp_le7 H_row_le7.
  mauto.
  assert ((((v'74<<ᵢ$ 3) +ᵢ  v'73) &ᵢ$ 7) = v'73) as H_prio_and7.
  clear - H_rgrp_le7 H_row_le7.
  mauto.
  assert (v'76 = ($ 1<<ᵢv'73)) as H_bitx_prop.
  clear - H107 H_row_le7.
  eapply math_mapval_core_prop; auto.
  mauto.

  hoare lift 19%nat pre.
  eapply set_node_elim_hoare; eauto.
  eapply TCBNode_P_set_rdy with (row := v'92); eauto.
  rewrite H_prio_shr3.
  eapply nth_val'2nth_val; eauto.
  3: eapply TCBList_P_tcblist_get_TCBNode_P; eauto.
  clear - H95 H112 H_rgrp_le7 H141.
  assert (Z.to_nat (Int.unsigned v'74) < length v'54)%nat.
  rewrite H141.
  unfold OS_RDY_TBL_SIZE.
  mauto.
  lets Hx: array_int8u_nth_lt_len H112 H; simpljoin1.
  rewrite H95 in H0; inverts H0; auto.

  clear - H102.
  simpl in H102; substs.
  unfold OS_STAT_MUTEX, OS_STAT_MUTEX.
  apply Int.and_not_self.
  unfolds.
  rewrite H_prio_shr3; rewrite H_prio_and7.
  do 2 eexists.
  splits; eauto.
  rewrite H_bitx_prop; auto.
  unfolds; simpl; auto.
  (**)

  (*EXIT_CRITICAL;ₛ*)
  hoare forward prim.
  remember (A_dom_lenv
              ((pevent, OS_EVENT ∗)
               :: (os_code_defs.x, Int8u) :: (pip, Int8u) :: (prio, Int8u) :: (legal, Int8u) :: nil)) in H116.
  sep split in H116.
  unfold AOSTCBList.
  sep normal.
  do 23 eexists.
  sep cancel 1%nat 2%nat.
  sep cancel 1%nat 3%nat.
  do 2 sep cancel 18%nat 1%nat.
  sep split.
  6: eapply H128.
  sep cancel AOSEventFreeList.
  do 2 sep cancel 24%nat 1%nat.
  sep cancel AOSMapTbl; sep cancel AOSUnMapTbl; sep cancel AOSIntNesting.
  sep cancel AOSTCBFreeList; sep cancel AOSRdyTblGrp.
  sep cancel AOSTime.
  do 2 sep cancel 3%nat 5%nat.
  sep cancel AGVars.
  sep cancel p_local.
  sep cancel A_isr_is_prop.
  sep cancel atoy_inv'.
  do 2 sep cancel 1%nat 3%nat.
  unfold AOSTCBPrioTbl.
  sep split; eauto.
  sep cancel OSTCBPrioTbl.
  sep cancel OSPlaceHolder.
  sep normal.
  eexists.
  sep cancel 7%nat 1%nat.
  sep lift 11%nat in H116.
  sep lift 2%nat.
  eapply tcbdllflag_set_node; eauto.
  sep cancel 1%nat 1%nat.
  unfold AECBList.
  sep normal.
  eexists.
  sep cancel OSEventList.
  sep split; eauto.
  eapply evsllseg_compose; eauto.
  instantiate (2 :=
                 (V$ OS_EVENT_TYPE_MUTEX
                   :: Vint32 v'59
                   :: Vint32 (Int.or (x&ᵢ$ OS_MUTEX_KEEP_UPPER_8) ((v'74<<ᵢ$ 3) +ᵢ  v'73))
                   :: nth_val' (Z.to_nat (Int.unsigned ((v'74<<ᵢ$ 3) +ᵢ  v'73))) v'53
                   :: x3 :: v'46 :: nil)).
  unfold V_OSEventListPtr; simpl; eauto.
  sep cancel 8%nat 2%nat.
  sep cancel 8%nat 2%nat.
  instantiate (2 := DMutex (Vint32 (Int.or (x&ᵢ$ OS_MUTEX_KEEP_UPPER_8) ((v'74<<ᵢ$ 3) +ᵢ  v'73))) (Vptr (v'91, Int.zero)) ).
  unfold AEventNode; unfold AOSEvent; unfold AEventData; unfold AOSEventTbl.
  unfold node.
  sep normal.
  do 3 eexists.
  sep split; eauto.
  sep cancel 2%nat 1%nat.
  sep cancel 2%nat 1%nat.
  rewrite Heqa in H116.
  exact H116.
  unfolds; simpl.
  rewrite H96; auto.
  split; auto.
  rewrite H96.
  clear - H118 H_rgrp_le7 H_row_le7 H133 H134 H10.
  simpl in H118.
  simpl.
  simpljoin1; splits; auto.
  remember ((v'74<<ᵢ$ 3) +ᵢ  v'73).
  clear Heqi.
  clear - H134 H10.
  lets Hx: mund_int_c1 H134 H10.
  rewrite Zle_imp_le_bool; auto.

  rewrite H96.
  eapply ecblist_p_post_exwt_hold_mutex_new; eauto.
  rewrite H61 in H103.
  inverts H103.
  rewrite H63 in H104.
  inverts H104.
  rewrite H66 in H105.
  inverts H105.
  eapply zh_asdf.
  clear - H68 i_neq_zero.
  assert (Int.eq v'58 ($ 0) = false).
  eapply Int.eq_false; auto.
  rewrite H in H68.
  auto.
  clear - H104 H115 H_rgrp_le7 H19.
  assert (Z.to_nat (Int.unsigned v'74) < length v'60)%nat.
  rewrite H19.
  unfold OS_EVENT_TBL_SIZE.
  mauto.
  lets Hx: array_int8u_nth_lt_len H115 H; simpljoin1.
  rewrite H104 in H0; inverts H0; auto.

  clear - H107 H_row_le7.
  assert (Z.to_nat (Int.unsigned v'73) < 8)%nat.
  mauto.
  lets Hx: OSMapVallist_bound H; auto.
  simpljoin1.
  rewrite H107 in H0; inverts H0; auto.
  unfolds; simpl; auto.
  clear - H50 H96 H97 H122 H133 H134.
  assert (nth_val (Z.to_nat (Int.unsigned ((v'74<<ᵢ$ 3) +ᵢ  v'73))) v'53 = Some (Vptr (v'91, Int.zero))).
  eapply oscore_common.nth_val'2nth_val'; auto.
  apply H50 in H; auto.
  do 2 destruct H.
  eapply r_priotbl_p_set_hold; eauto.
  lets Hx: Pos.eq_dec v'52 v'91.
  destruct Hx.
  substs.
  eapply OSMutex_common.return_rh_ctcb.
  eapply rh_curtcb_set_nct; auto.
  intro; apply n; inverts H144; auto.
  unfolds in H131; simpljoin1.
  lets Hx: rh_tcblist_ecblist_p_post_exwt_aux_mbox H7 H17 H6 H131 H126.
  auto.
  destruct Hx; substs.
  eapply rh_tcblist_ecblist_p_post_exwt_mutex; eauto.
  rewrite H_prio_shr3 in H143.
  rewrite H_prio_and7 in H143.
  rewrite H_bitx_prop.
  auto.
  rewrite H_prio_shr3 in H142.
  rewrite H_prio_and7 in H142.
  rewrite H_bitx_prop.
  auto.
  auto.
  go.

  (*OS_Sched ();ₛ*)
  hoare forward.
  sep normal.
  do 2 eexists.
  remember (A_dom_lenv
              ((pevent, OS_EVENT ∗)
               :: (os_code_defs.x, Int8u) :: (pip, Int8u) :: (prio, Int8u) :: (legal, Int8u) :: nil)) in H116.
  sep split in H116.
  sep split; eauto.
  sep cancel p_local.
  rewrite Heqa in H116.
  exact H116.
  unfolds; auto.
  go.
  intros.
  do 2 destruct H116.
  exists init_lg.
  sep cancel p_local.
  sep auto.
  intros.
  do 2 destruct H116.
  exists (logic_val x20 :: nil).
  sep cancel p_local.
  sep auto.

  (*RETURN ′ OS_NO_ERR*)
  unfold OS_SchedPost.
  simpl getasrt.
  unfold OS_SchedPost'.
  hoare forward.
  sep normal.
  do 5 eexists.
  sep split in H116.
  sep split; eauto.
  sep cancel pevent.
  sep cancel p_local.
  sep cancel legal.
  sep cancel prio.
  sep cancel pip.
  eapply H116.
  inverts H117.
  auto.
Qed.


Require Import Bool List String PeanoNat.
Require Import Common FMap ListSupport Syntax Semantics StepM SemFacts.
Require Import Invariant Serial SerialFacts.

Require Import Lia.

Set Implicit Arguments.

Section TrsInv.
  Context `{dv: DecValue} `{oifc: OStateIfc}.

  Variables (impl: System)
            (ginv: State -> Prop).

  Definition Invariant := @Invariant (State).
  Definition InvInit := @InvInit (System) (State) _ impl ginv.

  Definition InvTrs :=
    forall ist1,
      Reachable (steps step_m) impl ist1 ->
      ginv ist1 ->
      forall hst ist2,
        trsSteps impl ist1 hst ist2 ->
        ginv ist2.

  Definition InvSeq :=
    forall ist1,
      Reachable (steps step_m) impl ist1 ->
      ginv ist1 ->
      forall hst ist2,
        seqSteps impl ist1 hst ist2 ->
        ginv ist2.

  Hypotheses (Hinvi: InvInit)
             (Hinvt: InvTrs).

  Lemma inv_trs_seqSteps':
    forall ist1,
      Reachable (steps step_m) impl ist1 ->
      ginv ist1 ->
      forall ihst ist2,
        seqSteps impl ist1 ihst ist2 ->
        ginv ist2.
  Proof.
    intros.
    destruct H1; destruct H2 as [trss ?].
    destruct H2; subst.

    generalize dependent ist2; generalize dependent ist1.
    induction trss; simpl; intros.
    - inv H1; assumption.
    - eapply steps_split in H1; [|reflexivity].
      destruct H1 as [sti [? ?]].
      inv H2.
      eapply Hinvt with (ist1:= sti); eauto.
      + eapply reachable_steps; eauto.
      + split; eauto.
  Qed.

  Lemma inv_trs_seqSteps: InvSeq.
  Proof.
    unfold InvSeq; intros.
    eapply inv_trs_seqSteps'; eauto.
  Qed.

End TrsInv.

Section AtomicInv.
  Context `{dv: DecValue} `{oifc: OStateIfc}.

  Variables (impl: System)
            (ginv: State -> Prop)
            (ainv: list (Id Msg) (* inits *) ->
                   State (* starting state *) ->
                   History (* atomic history *) ->
                   list (Id Msg) (* eouts *) ->
                   State (* ending state *) -> Prop).

  Definition InvTrsIns :=
    forall ist1,
      Reachable (steps step_m) impl ist1 ->
      ginv ist1 ->
      forall eins ist2,
        step_m impl ist1 (RlblIns eins) ist2 ->
        ginv ist2.

  Definition InvTrsOuts :=
    forall ist1,
      Reachable (steps step_m) impl ist1 ->
      ginv ist1 ->
      forall eouts ist2,
        step_m impl ist1 (RlblOuts eouts) ist2 ->
        ginv ist2.

  Definition InvTrsAtomic :=
    forall ist1,
      Reachable (steps step_m) impl ist1 ->
      ginv ist1 ->
      forall inits hst eouts ist2,
        ExtAtomic impl inits hst eouts ->
        steps step_m impl ist1 hst ist2 ->
        ainv inits ist1 hst eouts ist2 /\ ginv ist2.

  Hypotheses (Hinvi: InvInit impl ginv)
             (Hinvti: InvTrsIns)
             (Hinvto: InvTrsOuts)
             (Hinvta: InvTrsAtomic).

  Lemma inv_atomic_InvTrs:
    InvTrs impl ginv.
  Proof.
    red; intros.
    destruct H1.
    inv H2.
    - inv_steps; inv_step; assumption.
    - inv_steps; eapply Hinvti; eauto.
    - inv_steps; eapply Hinvto; eauto.
    - eapply Hinvta; eauto.
  Qed.

End AtomicInv.

Theorem invSeq_serializable_invStep:
  forall `{dv: DecValue} `{oifc: OStateIfc} (impl: System) ginv,
    InvInit impl ginv ->
    InvSeq impl ginv ->
    SerializableSys impl ->
    InvStep impl step_m ginv.
Proof.
  unfold InvInit, InvSeq, SerializableSys, InvStep, Invariant.InvStep.
  intros.
  assert (Reachable (steps step_m) impl ist2).
  { eapply reachable_steps; [eassumption|].
    apply steps_singleton; eassumption.
  }
  specialize (H1 _ H5).
  red in H1; destruct H1 as [sll ?].
  eapply H0; [| |eassumption]; auto.
  apply reachable_init.
Qed.


From isla Require Import opsem.

Definition instr_ldr : isla_trace :=
  AssumeReg "HCR_EL2" [] (RegVal_Base (Val_Bits (BV 64%N 0x80000000%Z))) Mk_annot :t:
  AssumeReg "CFG_ID_AA64PFR0_EL1_EL3" [] (RegVal_Base (Val_Bits (BV 4%N 0x1%Z))) Mk_annot :t:
  AssumeReg "CFG_ID_AA64PFR0_EL1_EL2" [] (RegVal_Base (Val_Bits (BV 4%N 0x1%Z))) Mk_annot :t:
  AssumeReg "CFG_ID_AA64PFR0_EL1_EL1" [] (RegVal_Base (Val_Bits (BV 4%N 0x1%Z))) Mk_annot :t:
  AssumeReg "CFG_ID_AA64PFR0_EL1_EL0" [] (RegVal_Base (Val_Bits (BV 4%N 0x1%Z))) Mk_annot :t:
  AssumeReg "TCR_EL2" [] (RegVal_Base (Val_Bits (BV 64%N 0x0%Z))) Mk_annot :t:
  AssumeReg "EDSCR" [] (RegVal_Base (Val_Bits (BV 32%N 0x0%Z))) Mk_annot :t:
  AssumeReg "OSDLR_EL1" [] (RegVal_Base (Val_Bits (BV 32%N 0x0%Z))) Mk_annot :t:
  AssumeReg "OSLSR_EL1" [] (RegVal_Base (Val_Bits (BV 32%N 0x0%Z))) Mk_annot :t:
  Smt (DeclareConst 6%Z (Ty_BitVec 1%N)) Mk_annot :t:
  AssumeReg "PSTATE" [Field "EL"] (RegVal_Base (Val_Bits (BV 2%N 0x2%Z))) Mk_annot :t:
  AssumeReg "PSTATE" [Field "nRW"] (RegVal_Base (Val_Bits (BV 1%N 0x0%Z))) Mk_annot :t:
  AssumeReg "SCR_EL3" [] (RegVal_Base (Val_Bits (BV 32%N 0x501%Z))) Mk_annot :t:
  AssumeReg "SCTLR_EL2" [] (RegVal_Base (Val_Bits (BV 64%N 0x4000002%Z))) Mk_annot :t:
  Smt (DeclareConst 29%Z (Ty_BitVec 64%N)) Mk_annot :t:
  Assume (AExp_Binop (Eq) (AExp_Manyop (Bvmanyarith Bvand) [AExp_Val (AVal_Var "R1" []) Mk_annot; AExp_Val (AVal_Bits (BV 64%N 0xfff0000000000007%Z)) Mk_annot] Mk_annot) (AExp_Val (AVal_Bits (BV 64%N 0x0%Z)) Mk_annot) Mk_annot) Mk_annot :t:
  ReadReg "R1" [] (RegVal_Base (Val_Symbolic 29%Z)) Mk_annot :t:
  Smt (DefineConst 118%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 29%Z) Mk_annot; Val (Val_Bits (BV 64%N 0x0%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  Smt (DefineConst 122%Z (Binop (Eq) (Val (Val_Symbolic 118%Z) Mk_annot) (Manyop (Bvmanyarith Bvand) [Val (Val_Symbolic 118%Z) Mk_annot; Val (Val_Bits (BV 64%N 0xfffffffffffffff8%Z)) Mk_annot] Mk_annot) Mk_annot)) Mk_annot :t:
  ReadReg "PSTATE" [Field "D"] (RegVal_Struct [("D", RegVal_Base (Val_Symbolic 6%Z))]) Mk_annot :t:
  Smt (DeclareConst 2317%Z (Ty_BitVec 56%N)) Mk_annot :t:
  Smt (DefineConst 2326%Z (Unop (ZeroExtend 8%N) (Manyop Concat [Val (Val_Bits (BV 4%N 0x0%Z)) Mk_annot; Unop (Extract 51%N 0%N) (Val (Val_Symbolic 118%Z) Mk_annot) Mk_annot] Mk_annot) Mk_annot)) Mk_annot :t:
  Smt (DeclareConst 2327%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadMem (RegVal_Base (Val_Symbolic 2327%Z)) (RegVal_Base (Val_Enum ((Mk_enum_id 6%nat), Mk_enum_ctor 0%nat))) (RegVal_Base (Val_Symbolic 2326%Z)) 8%N None Mk_annot :t:
  Smt (DefineConst 2331%Z (Val (Val_Symbolic 2327%Z) Mk_annot)) Mk_annot :t:
  WriteReg "R0" [] (RegVal_Base (Val_Symbolic 2331%Z)) Mk_annot :t:
  Smt (DeclareConst 2332%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadReg "_PC" [] (RegVal_Base (Val_Symbolic 2332%Z)) Mk_annot :t:
  Smt (DefineConst 2333%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 2332%Z) Mk_annot; Val (Val_Bits (BV 64%N 0x4%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  WriteReg "_PC" [] (RegVal_Base (Val_Symbolic 2333%Z)) Mk_annot :t:
  tnil
.


From RecordUpdate Require Import RecordSet.
From aneris.aneris_lang Require Import network resources.
From aneris.aneris_lang.lib.serialization Require Import serialization_proof.

Definition Key := string.

(** Arguments that user supplies to the interface *)

Class DB_params := {
  DB_addresses : list socket_address; (* can we remove it ? *)
  DB_addresses_NoDup : NoDup DB_addresses;
  DB_keys : gset Key;
  DB_InvName : namespace; (* Global Invariant *)
  DB_serialization : serialization;
}.

Notation DB_Serializable v := (Serializable DB_serialization v).

Record SerializableVal `{!DB_params} :=
  SerVal {SV_val : val;
          SV_ser : DB_Serializable SV_val }.

Coercion SV_val : SerializableVal >-> val.

Existing Instance SV_ser.

Arguments SerVal {_} _ {_}.


Set Implicit Arguments.
Require Import HJ.Tid.
Require Import HJ.Vars.
Require Import HJ.Phasers.Regmode.
Require Import HJ.Phasers.Phaser.
Require Import Coq.Lists.SetoidList.

(** This chapter defines a deadlock-free phaser language. A [phasermap] represents
all phasers available for a set of tasks. A phasermap is a map from phaser handles [phid]
into phasers. *)

Definition phasermap := Map_PHID.t phaser.

(** Function [make] creates an empty phasermap. *)

Definition make : phasermap := Map_PHID.empty phaser.

(**
  We now define phasermap operations, first with a pre-condition and
  then a function that executes the operation.
  *)

Record Op := mk_op {
  can_run: tid -> phasermap -> Prop;
  run: tid -> phasermap -> phasermap
}.

(**
  Function [new_phaser] places a new empty phaser in the phasermap.
  The pre-condition is that [p] is not in phasermap [m]. *)

Inductive PhNewPre p (t:tid) (m:phasermap) : Prop :=
  ph_new_pre:
    ~ Map_PHID.In p m ->
    PhNewPre p t m.

Definition ph_new (p:phid) (t:tid) : phasermap -> phasermap := Map_PHID.add p (Phaser.make t).

Definition ph_new_op p := mk_op (PhNewPre p) (ph_new p).

(**
  Function [update] mutates the phaser associated to [p] by applying
  parameter [f] to the phaser.
 *)

Definition update p (f:phaser -> phaser) m : phasermap :=
match Map_PHID.find p m with
| Some ph => Map_PHID.add p (f ph) m
| None => m
end.

(**
  Signal applies the phaser-signal to the phaser associated with [p].
  The pre-condition is that [p] must be in the phasermap and
  we must meet the pre-conditions of the phaser-signal.
  *)

Inductive PhSignalPre p t m : Prop :=
  ph_signal_pre:
    forall ph,
    Map_PHID.MapsTo p ph m ->
    SignalPre t ph ->
    PhSignalPre p t m.

Definition ph_signal p t := update p (Phaser.signal t).

Definition ph_signal_op p := mk_op (PhSignalPre p) (ph_signal p).

(** Droping a phaser has a similar implementation and pre-conditions. *)

Inductive PhDropPre p t m : Prop :=
  ph_drop_pre:
    forall ph,
    Map_PHID.MapsTo p ph m ->
    DropPre t ph ->
    PhDropPre p t m.

Definition ph_drop p t := update p (Phaser.drop t).

Definition ph_drop_op p := mk_op (PhDropPre p) (ph_drop p).

(**
  We now introduce functions that act on all phasers the task is regitered  with.
  Function [foreach] updates all phasers in the phasermap by applying function [f].
  *)

Definition foreach (f:phaser -> phaser) : phasermap -> phasermap :=
Map_PHID.mapi (fun _ ph => f ph).

(** Function [signal_all] lets task [t] perform a [Phaser.signal] on all phasers
    it is registered with. There are no pre-conditions to this operation. *)

Definition signal_all (t:tid) := foreach (Phaser.try_signal t).

Definition signal_all_op := mk_op (fun _ _ => True) signal_all.

(**
  Wait-all invokes a wait on every phaser the task is registered with.
  The pre-condition of wait-all is the pre-condition of each phaser the
  task is registered with. *)

Inductive WaitAllPre t m : Prop :=
  wait_all_pre:
    (forall p ph, Map_PHID.MapsTo p ph m -> Map_TID.In t ph -> TryWaitPre t ph) ->
    WaitAllPre t m.

Definition wait_all (t:tid) := foreach (Phaser.wait t).

Definition wait_all_op := mk_op WaitAllPre wait_all.

(**
  Function [drop_all] deregisters task [t] from all phasers in the phasermap; it
  has no pre-conditions.
  *)

Definition drop_all (t:tid) := foreach (Phaser.drop t).

Definition drop_all_op := mk_op (fun _ _ => True) drop_all.

(**
  Finally, we define async. To be able to spawn a task we must ensure
  that the spawned task name is unknown in all phasers, so we need to
  define a task membership for phasermaps.
  Predicate [In t m] holds when task [t] is registered in a phaser of [m]. *)

Inductive In (t:tid) (pm:phasermap) : Prop :=
  in_def:
    forall p ph,
    Map_PHID.MapsTo p ph pm ->
    Map_TID.In t ph ->
    In t pm.

Inductive Nonempty (pm:phasermap) : Prop :=
| nonempty_def:
  forall x,
  In x pm ->
  Nonempty pm.

Definition Empty (pm:phasermap) : Prop := forall x, ~ In x pm.

(** The parameter of a phased async is list of pairs, each of which
  consists of a phaser name and a registration  mode. *)

Record phased := mk_phased {
  get_args : Map_PHID.t regmode;
  get_new_task : tid
}.

(**
  Async phased register a new task in a list of [phased].
  Function [async_1] registers task [t] with phaser named by [p] according
  to mode [r].
  *)

Definition async_1 (ps:phased) t p ph : phaser :=
match Map_PHID.find p (get_args ps) with
| Some r => register (mk_registry (get_new_task ps) r) t ph
| _ => ph
end.

Definition async ps t : phasermap -> phasermap := Map_PHID.mapi (async_1 ps t).

(**
  Predicate [PhasedPre] ensures that task [t] can register task [t']
  using the phased object [ps].
   *)

Inductive PhasedPre (ps:phased) (t:tid) pm : Prop :=
  phased_pre_def:
    (forall p m,
      Map_PHID.MapsTo p m (get_args ps) ->
      exists ph, Map_PHID.MapsTo p ph pm /\ RegisterPre (mk_registry (get_new_task ps) m) t ph) ->
    PhasedPre ps t pm.

(**
  The pre-condition of executing an async are three:
  (i) all phased pairs in [ps] must meet the preconditions of [PhasedPre],
  (ii) the spawned task [t'] cannot be known in the phasermap.
  *)

Inductive AsyncPre (ps:phased) t m : Prop :=
  async_pre:
    PhasedPre ps t m ->
    ~ In (get_new_task ps) m ->
    AsyncPre ps t m.

Definition async_op (ps:phased) := mk_op (AsyncPre ps) (async ps).

(**
  We are now ready to define the closed set of operations on phasermaps.
 *)

Inductive op : Type :=
| PH_NEW : phid -> op
| PH_SIGNAL : phid -> op
| PH_DROP : phid -> op
| SIGNAL_ALL
| WAIT_ALL
| DROP_ALL
| ASYNC : phased -> op.

(** Function [get_impl] yields the [Op] object. *)

Definition get_impl o :=
match o with
| PH_NEW p => ph_new_op p
| PH_SIGNAL p => ph_signal_op p
| PH_DROP p => ph_drop_op p
| SIGNAL_ALL => signal_all_op
| WAIT_ALL => wait_all_op
| DROP_ALL => drop_all_op
| ASYNC ps => async_op ps
end.

(** In closing, we define the [Reduces] relation. *)

Inductive Reduces m t o : phasermap -> Prop :=
  reduces:
    can_run (get_impl o) t m ->
    Reduces m t o (run (get_impl o) t m).

Module Trace.
  Definition t := (list (tid * op)) % type.

  Inductive ReducesN: phasermap -> t -> Prop :=
  | reduces_n_nil:
    ReducesN make nil
  | reduces_n_cons:
    forall t l o pm pm',
    ReducesN pm l ->
    Reduces pm t o pm' ->
    ReducesN pm' ((t,o)::l).
End Trace.

Section Facts.

  Let update_rw:
    forall p f ph m,
    Map_PHID.MapsTo p ph m ->
    update p f m = Map_PHID.add p (f ph) m.
  Proof.
    intros.
    unfold update.
    remember (Map_PHID.find _ _) as o.
    symmetry in Heqo.
    destruct o.
    - rewrite <- Map_PHID_Facts.find_mapsto_iff in Heqo.
      assert (p0 = ph) by eauto using Map_PHID_Facts.MapsTo_fun.
      subst.
      trivial.
    - rewrite <- Map_PHID_Facts.not_find_in_iff in Heqo.
      contradiction Heqo.
      eauto using Map_PHID_Extra.mapsto_to_in.
  Qed.

  Lemma ph_signal_rw:
    forall p t ph m,
    Map_PHID.MapsTo p ph m ->
    ph_signal p t m = Map_PHID.add p (Phaser.signal t ph) m.
  Proof.
    intros.
    unfold ph_signal.
    rewrite update_rw with (ph:=ph); auto.
  Qed.

  Lemma ph_drop_rw:
    forall p t ph m,
    Map_PHID.MapsTo p ph m ->
    ph_drop p t m = Map_PHID.add p (Phaser.drop t ph) m.
  Proof.
    intros.
    unfold ph_drop.
    rewrite update_rw with (ph:=ph); auto.
  Qed.

  Lemma foreach_mapsto_rw:
    forall p ph f m,
    Map_PHID.MapsTo p ph (foreach f m) <->
    exists ph', ph = f ph' /\ Map_PHID.MapsTo p ph' m.
  Proof.
    intros.
    unfold foreach in *.
    rewrite Map_PHID_Facts.mapi_mapsto_iff; auto.
    split; eauto.
  Qed.

  Lemma async_simpl_notin:
    forall p (ps:phased) ph t,
    ~ Map_PHID.In p (get_args ps) ->
    async_1 ps t p ph = ph.
  Proof.
    intros.
    unfold async_1.
    destruct (Map_PHID_Extra.find_rw p (get_args ps)) as [(R,?)|(r,(R,?))].
    - rewrite R; clear R.
      trivial.
    - contradiction H.
      eauto using Map_PHID_Extra.mapsto_to_in.
  Qed.

  Lemma async_1_rw:
    forall ps t p ph,
      { exists r, Map_PHID.MapsTo p r (get_args ps) /\ async_1 ps t p ph = register (mk_registry (get_new_task ps) r) t ph }
      +
      { async_1 ps t p ph = ph /\ ~ Map_PHID.In p (get_args ps)}.
  Proof.
    intros.
    unfold async_1.
    destruct (Map_PHID_Extra.find_rw p (get_args ps)).
    - right.
      destruct a as (R,?).
      rewrite R.
      intuition.
    - left.
      destruct e as (r,(R,?)).
      rewrite R.
      eauto.
  Qed.

  Lemma async_1_mapsto_neq:
    forall t' v ps t p ph,
    t' <> (get_new_task ps) ->
    Map_TID.MapsTo t' v (async_1 ps t p ph) ->
    Map_TID.MapsTo t' v ph.
  Proof.
    intros.
    unfold async_1 in *.
    destruct (Map_PHID_Extra.find_rw p (get_args ps)) as [(R,?)|(r,(R,?))]. {
      rewrite R in *; clear R.
      assumption.
    }
    rewrite R in *; clear R.
    eauto using register_mapsto_neq.
  Qed.

  Lemma async_1_mapsto_eq:
    forall v ps t p ph r,
    Map_TID.In t ph ->
    Map_PHID.MapsTo p r (get_args ps) ->
    Map_TID.MapsTo (get_new_task ps) v (async_1 ps t p ph) ->
    exists v', Map_TID.MapsTo t v' ph /\ v = Taskview.set_mode v' r.
  Proof.
    intros.
    unfold async_1 in *.
    destruct (Map_PHID_Extra.find_rw p (get_args ps)) as [(R,?)|(r',(R,?))]. {
      (* absurd *)
      rewrite R in *; clear R.
      contradiction H2.
      eauto using Map_PHID_Extra.mapsto_to_in.
    }
    rewrite R in *; clear R.
    assert (r' = r) by eauto using Map_PHID_Facts.MapsTo_fun; subst; clear H2.
    eauto using register_mapsto_eq.
  Qed.

  Lemma async_1_mapsto:
    forall p ph ps t' t v,
    Map_TID.MapsTo t' v (async_1 ps t p ph) ->
    Map_TID.MapsTo t' v ph \/
    (exists v' r, Map_TID.MapsTo t v' ph /\ Map_PHID.MapsTo p r (get_args ps) /\
    v = Taskview.set_mode v' r).
  Proof.
    intros.
    destruct (async_1_rw ps t p ph) as [(r,(i,R))|(R1,R2)]. {
      rewrite R in *; clear R.
      apply register_inv_mapsto in H.
      destruct H; auto.
      destruct H as (?, (v', (mt2, ?))).
      subst.
      right.
      eauto.
    }
    left.
    rewrite R1 in *; clear R1.
    auto.
  Qed.

  Lemma async_mapsto_rw:
    forall p ph ps t m,
    Map_PHID.MapsTo p ph (async ps t m) <->
    exists ph', ph = async_1 ps t p ph' /\ Map_PHID.MapsTo p ph' m.
  Proof.
    intros.
    unfold async in *.
    rewrite Map_PHID_Facts.mapi_mapsto_iff; auto.
    split; eauto.
    intros.
    subst.
    trivial.
  Qed.

  Lemma async_notina_mapsto:
    forall p ps m t ph,
    ~ Map_PHID.In p (get_args ps) ->
    Map_PHID.MapsTo p ph m ->
    Map_PHID.MapsTo p ph (async ps t m).
  Proof.
    intros.
    apply async_mapsto_rw.
    exists ph.
    intuition.
    symmetry.
    eauto using async_simpl_notin.
  Qed.

  Lemma async_notina_mapsto_rtl:
    forall p ps m t ph,
    ~ Map_PHID.In p (get_args ps) ->
    Map_PHID.MapsTo p ph (async ps t m) ->
    Map_PHID.MapsTo p ph m.
  Proof.
    intros.
    apply async_mapsto_rw in H0.
    destruct H0 as (ph', (R, mt)).
    rewrite R in *.
    apply async_simpl_notin with (ph:=ph') (t:=t) in H.
    rewrite H.
    assumption.
  Qed.

  Lemma ph_new_impl_mapsto:
    forall p t pm,
    Map_PHID.MapsTo p (Phaser.make t) (ph_new p t pm).
  Proof.
    intros.
    unfold ph_new.
    auto using Map_PHID.add_1.
  Qed.

  Lemma async_pre_to_in_ph:
    forall ps t pm r ph p,
    AsyncPre ps t pm ->
    Map_PHID.MapsTo p r (get_args ps) ->
    Map_PHID.MapsTo p ph pm ->
    Map_TID.In t ph.
  Proof.
    intros.
    inversion H as [Hx].
    inversion Hx.
    specialize (H3 _ _ H0).
    destruct H3 as (ph', (?, Hr)).
    assert (ph' = ph) by eauto using Map_PHID_Facts.MapsTo_fun; subst.
    eauto using Phaser.register_pre_to_in.
  Qed.
End Facts.

Section Decidability.
  Ltac handle_not := right; unfold not; intros N; inversion N; contradiction; fail.
  Lemma ph_new_pre_dec p t pm:
    { PhNewPre p t pm } + { ~ PhNewPre p t pm }.
  Proof.
    destruct (Map_PHID_Facts.In_dec pm p); try handle_not.
    auto using ph_new_pre.
  Defined.

  Lemma ph_signal_pre_dec p t pm:
    { PhSignalPre p t pm } + { ~ PhSignalPre p t pm }.
  Proof.
    destruct (Map_PHID_Extra.lookup_dec phid_eq_rw p pm) as [(ph,mt)|(_,?)]. {
      destruct (signal_pre t ph). {
        eauto using ph_signal_pre.
      }
      right.
      unfold not; intros N.
      inversion N.
      assert (ph0 = ph) by eauto using Map_PHID_Facts.MapsTo_fun; subst.
      contradiction.
    }
    right.
    unfold not; intros N.
    inversion N.
    apply Map_PHID_Extra.mapsto_to_in in H.
    contradiction.
  Defined.

  Lemma ph_drop_pre_dec p t pm:
    { PhDropPre p t pm } + { ~ PhDropPre p t pm }.
  Proof.
    destruct (Map_PHID_Extra.lookup_dec phid_eq_rw p pm) as [(ph,mt)|(_,?)]. {
      destruct (drop_pre t ph). {
        eauto using ph_drop_pre.
      }
      right.
      unfold not; intros N.
      inversion N.
      assert (ph0 = ph) by eauto using Map_PHID_Facts.MapsTo_fun; subst.
      contradiction.
    }
    right.
    unfold not; intros N.
    inversion N.
    apply Map_PHID_Extra.mapsto_to_in in H.
    contradiction.
  Defined.

  Definition phased_pre_dec ps t (pm:phasermap):
    { PhasedPre ps t pm } + { ~ PhasedPre ps t pm }.
  Proof.
    remember (forallb (fun kv =>
      match Map_PHID.find (fst kv) pm with
      | Some ph =>
        if register_pre {| get_task := get_new_task ps; get_mode := (snd kv) |} t ph
        then true else false
      | _ => false
      end
    ) (Map_PHID.elements (get_args ps))).
    symmetry in Heqb.
    destruct b. {
      left.
      apply phased_pre_def.
      intros.
      rewrite forallb_forall in *.
      specialize Heqb with (p, m).
      rewrite <- Map_PHID_Extra.maps_to_iff_in_elements in Heqb; auto using phid_eq_rw.
      specialize (Heqb H).
      simpl in *.
      destruct (Map_PHID_Extra.find_rw p pm) as [(R,N)|(ph,(R,?))]; rewrite R in *; clear R. {
        inversion Heqb.
      }
      destruct (register_pre {| get_task := get_new_task ps; get_mode := m |} t ph). {
        eauto.
      }
      inversion Heqb.
    }
    right.
    rewrite List.forallb_existsb in Heqb.
    rewrite Bool.negb_false_iff in *.
    apply existsb_exists in Heqb.
    unfold not; intros N.
    destruct Heqb as ((p,m),(Hi,Hx)).
    apply Map_PHID_Extra.maps_to_iff_in_elements in Hi; auto using phid_eq_rw.
    rewrite Bool.negb_true_iff in *.
    simpl in *.
    inversion N.
    specialize (H _ _ Hi).
    destruct H as (ph, (mt, Hr)).
    destruct (Map_PHID_Extra.find_rw p pm) as [(R,N1)|(ph',(R,?))]; rewrite R in *; clear R. {
      contradiction N1.
      eauto using Map_PHID_Extra.mapsto_to_in.
    }
    destruct (register_pre {| get_task := get_new_task ps; get_mode := m |} t ph'). {
      inversion Hx.
    }
    assert (ph' = ph) by eauto using Map_PHID_Facts.MapsTo_fun; subst.
    contradiction.
  Defined.

  Definition in_dec t pm:
    { In t pm } + { ~ In t pm }.
  Proof.
    destruct (Map_PHID_Extra.pred_choice pm (fun p ph =>
      if Map_TID_Extra.in_dec tid_eq_rw t ph then true else false
    )); auto with *. {
      left.
      destruct e as (p,(ph, (?,Hx))).
      destruct (Map_TID_Extra.in_dec tid_eq_rw t ph). {
        eauto using in_def.
      }
      inversion Hx.
    }
    right.
    unfold not; intros N.
    inversion N; subst; clear N.
    specialize (e _ _ H).
    destruct (Map_TID_Extra.in_dec tid_eq_rw t ph). {
      inversion e.
    }
    contradiction.
  Defined.

  Lemma async_pre_dec ps t pm:
    { AsyncPre ps t pm } + { ~ AsyncPre ps t pm }.
  Proof.
    destruct (in_dec (get_new_task ps) pm). {
      right.
      unfold not; intros N.
      inversion N.
      contradiction.
    }
    destruct (phased_pre_dec ps t pm). {
      auto using async_pre.
    }
    right.
    unfold not; intros N.
    inversion N.
    contradiction.
  Defined.
End Decidability.

Section InInv.
  Let in_add_inv:
    forall x p ph s,
    In x (Map_PHID.add p ph s) ->
    Map_TID.In x ph \/ In x s.
  Proof.
    intros.
    inversion H; subst; clear H.
    apply Map_PHID_Facts.add_mapsto_iff in H0.
    destruct H0 as [(?,?)|(?,?)]. {
      subst.
      auto.
    }
    eauto using in_def.
  Qed.

  Let in_make_inv:
    forall x y,
    Map_TID.In y (Phaser.make x) ->
    y = x.
  Proof.
    intros.
    apply Map_TID_Extra.in_to_mapsto in H.
    destruct H as (?, mt).
    apply make_mapsto in mt.
    destruct mt; auto.
  Qed.

  Let ph_in_signal_inv:
    forall x y ph,
    Map_TID.In x (signal y ph) ->
    Map_TID.In x ph.
  Proof.
    unfold signal, Phaser.update; intros.
    destruct (Map_TID_Extra.find_rw y ph) as [(R,?)|(?,(R,?))];
    rewrite R in *; clear R. {
      assumption.
    }
    apply Map_TID_Extra.F.add_in_iff in H.
    destruct H. {
      subst.
      eauto using Map_TID_Extra.mapsto_to_in.
    }
    assumption.
  Qed.

  Let ph_in_try_signal_inv:
    forall x y ph,
    Map_TID.In x (try_signal y ph) ->
    Map_TID.In x ph.
  Proof.
    unfold try_signal, Phaser.update; intros.
    destruct (Map_TID_Extra.find_rw y ph) as [(R,?)|(?,(R,?))];
    rewrite R in *; clear R. {
      assumption.
    }
    apply Map_TID_Extra.F.add_in_iff in H.
    destruct H. {
      subst.
      eauto using Map_TID_Extra.mapsto_to_in.
    }
    assumption.
  Qed.

  Let ph_in_wait_inv:
    forall x y ph,
    Map_TID.In x (wait y ph) ->
    Map_TID.In x ph.
  Proof.
    unfold wait, Phaser.update; intros.
    destruct (Map_TID_Extra.find_rw y ph) as [(R,?)|(?,(R,?))];
    rewrite R in *; clear R. {
      assumption.
    }
    apply Map_TID_Facts.add_in_iff in H.
    destruct H. {
      subst.
      eauto using Map_TID_Extra.mapsto_to_in.
    }
    assumption.
  Qed.

  Let ph_in_drop_inv:
    forall x y ph,
    Map_TID.In x (drop y ph) ->
    y <> x /\ Map_TID.In x ph.
  Proof.
    unfold drop, Phaser.update; intros.
    apply Map_TID_Facts.remove_in_iff in H.
    assumption.
  Qed.

  Let ph_in_async_1_inv:
    forall x y p ph h,
    Map_TID.In y (async_1 p x h ph) ->
    get_new_task p = y \/ Map_TID.In y ph.
  Proof.
    unfold async_1; intros.
    destruct (Map_PHID_Extra.find_rw h (get_args p)) as [(R,?)|(?,(R,?))];
    rewrite R in *; clear R. {
      auto.
    }
    unfold register in *.
    destruct (Map_TID_Extra.find_rw x ph) as [(R,?)|(?,(R,?))];
    rewrite R in *; clear R. {
      auto.
    }
    simpl in *.
    apply Map_TID_Facts.add_in_iff in H.
    auto.
  Qed.

  Let in_signal_inv:
    forall x y p s,
    In x (ph_signal p y s) ->
    In x s.
  Proof.
    unfold ph_signal, update.
    intros.
    destruct (Map_PHID_Extra.find_rw p s) as [(R,?)|(?,(R,?))];
    rewrite R in *; clear R. {
      assumption.
    }
    apply in_add_inv in H.
    destruct H; eauto using in_def, ph_in_signal_inv.
  Qed.

  Let in_drop_inv:
    forall x y p s,
    In x (ph_drop p y s) ->
    In x s.
  Proof.
    unfold ph_drop, update.
    intros.
    destruct (Map_PHID_Extra.find_rw p s) as [(R,?)|(?,(R,?))];
    rewrite R in *; clear R. {
      assumption.
    }
    apply in_add_inv in H.
    destruct H; auto.
    apply ph_in_drop_inv in H.
    destruct H; eauto using in_def.
  Qed.

  Let in_signal_all_inv:
    forall x y s,
    In x (signal_all y s) ->
    In x s.
  Proof.
    unfold signal_all, foreach.
    intros.
    inversion H; subst; clear H.
    rewrite Map_PHID_Facts.mapi_mapsto_iff in *; auto.
    destruct H0 as (ph', (?,mt)).
    subst.
    eauto using in_def, ph_in_try_signal_inv.
  Qed.

  Let in_wait_all_inv:
    forall x y s,
    In x (wait_all y s) ->
    In x s.
  Proof.
    unfold wait_all, foreach.
    intros.
    inversion H; subst; clear H.
    rewrite Map_PHID_Facts.mapi_mapsto_iff in *; auto.
    destruct H0 as (ph', (?,mt)).
    subst.
    eauto using in_def, ph_in_wait_inv.
  Qed.

  Let in_drop_all_inv:
    forall x y s,
    In x (drop_all y s) ->
    y <> x /\ In x s.
  Proof.
    unfold drop_all, foreach.
    intros.
    inversion H; subst; clear H.
    rewrite Map_PHID_Facts.mapi_mapsto_iff in *; auto.
    destruct H0 as (ph', (?,mt)).
    subst.
    apply ph_in_drop_inv in H1.
    destruct H1.
    eauto using in_def.
  Qed.

  Let in_async_inv:
    forall x y s p,
    In x (async p y s) ->
    get_new_task p = x \/ In x s.
  Proof.
    unfold async, foreach.
    intros.
    inversion H; subst; clear H.
    rewrite Map_PHID_Facts.mapi_mapsto_iff in *. {
      destruct H0 as (ph', (?,mt)).
      subst.
      apply ph_in_async_1_inv in H1.
      destruct H1;
      eauto using in_def.
    }
    intros.
    subst.
    auto.
  Qed.

  Lemma reduces_in_inv:
    forall x y o s s',
    In y s' ->
    Reduces s x o s' ->
    (y = x /\ exists p, o = PH_NEW p) \/
    (exists p, get_new_task p = y /\ o = ASYNC p) \/
    In y s.
  Proof.
    intros.
    destruct o; inversion H0; subst; clear H0; simpl in *;
    inversion H1; subst; clear H1.
    - unfold ph_new in *.
      apply in_add_inv in H.
      destruct H; auto.
      apply in_make_inv in H.
      eauto 4.
    - eauto using in_signal_inv.
    - eauto using in_drop_inv.
    - eauto using in_signal_all_inv.
    - eauto using in_wait_all_inv.
    - apply in_drop_all_inv in H.
      destruct H; auto.
    - apply in_async_inv in H.
      destruct H; eauto.
  Qed.

  Lemma reduces_drop_all_not_in:
    forall pm x pm',
    Reduces pm x DROP_ALL pm' ->
    ~ In x pm'.
  Proof.
    intros.
    unfold not; intros N.
    inversion H; subst; clear H.
    simpl in *.
    apply in_drop_all_inv in N.
    destruct N.
    contradiction.
  Qed.

  Lemma not_in_make:
    forall x,
    ~ In x make.
  Proof.
    intros.
    unfold not, make in *; intros N.
    inversion N; subst; clear N.
    rewrite Map_PHID_Facts.empty_mapsto_iff in *.
    assumption.
  Qed.
End InInv.


Require Import Coqlib.
Require Import Maps.
Require Import LibTactics.

Require Import Integers.
Open Scope Z_scope.
Import ListNotations.

Set Asymmetric Patterns.

Require Import state.
Require Import language.

Set Implicit Arguments.
Unset Strict Implicit.

Require Import logic.

Require Import lemmas.
Require Import lemmas_ins.

Require Import Coq.Logic.FunctionalExtensionality.

Require Import integer_lemma.

Require Import sep_lemma.
Require Import reg_lemma.
Require Import derived_rule.

Require Import tm_dly_lemma.

Require Import code.
Require Import ctxswitch_spec.

Require Import lemma1.

Open Scope nat.
Open Scope code_scope.
Open Scope mem_scope.

Theorem RegRestoreProof :
  forall vl,
    spec |- {{ reg_restore_pre vl }}
             regstore
           {{ reg_restore_post vl }}.
Proof.
  intros.
  unfold reg_restore_pre.
  unfold reg_restore_post.
  hoare_ex_intro_pre.
  renames x' to fmg, x'0 to fmo, x'1 to fml, x'2 to fmi.
  renames x'3 to nctx, x'5 to vy, x'7 to id, x'8 to vi, x'9 to F.
  renames x'4 to l, x'6 to retl.
  eapply Pure_intro_rule.
  introv Hlgvl.
  destruct nctx as [nl nctx].
  destruct nctx as [ [ [rl ri] rg] ry].
  hoare_lift_pre 5.
  eapply Pure_intro_rule.
  introv Hpure.
  destruct Hpure as [Hsp [Hctx_addr Hretf] ].
  simpl in Hctx_addr.
  inversion Hctx_addr; subst.
  unfold regstore.
  hoare_lift_pre 2.
  unfold context at 1.
  unfold context'.
  eapply backward_rule.
  introv Hs.
  asrt_to_line_in Hs 3.
  eauto.

  save_reg_unfold.
  hoare_lift_pre 2.
  save_reg_unfold.
  hoare_lift_pre 3.
  save_reg_unfold.
  eapply backward_rule.
  introv Hs.
  unfold save_reg at 1 in Hs.
  asrt_to_line_in Hs 8.
  simpl_sep_liftn_in Hs 9.
  simpl_sep_liftn_in Hs 9.
  unfold save_reg at 1 in Hs.
  asrt_to_line_in Hs 8.
  simpl_sep_liftn_in Hs 9.
  simpl_sep_liftn_in Hs 17.
  unfold save_reg at 1 in Hs.
  asrt_to_line_in Hs 4.
  simpl_sep_liftn_in Hs 5.
  simpl_sep_liftn_in Hs 22.
  eauto.

  Ltac solve_ld_ctx :=
    eapply seq_rule;
    [TimReduce_simpl; eapply ld_rule_reg; eauto;
    try solve [simpl; repeat (rewrite Int.add_assoc); eauto] | simpl upd_genreg].

  destruct fmg, fmo, fml, fmi.
  simpl in Hsp.
  inversion Hsp; subst.

  (** ld (l5 + OS_L0_OFFSET) l0 *)
  solve_ld_ctx.
  simpl.
  unfold OS_L0_OFFSET.
  rewrite in_range0; eauto.
  rewrite Int.add_zero; eauto.

  (** ld (l5 + OS_L1_OFFSET) l1 *)
  hoare_lift_pre 3.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_L2_OFFSET) l2 *)
  hoare_lift_pre 4.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_L3_OFFSET) l3 *)
  hoare_lift_pre 5.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_I0_OFFSET) i0 *)
  hoare_lift_pre 6.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_I1_OFFSET) i1 *)
  hoare_lift_pre 7.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_I2_OFFSET) i2 *)
  hoare_lift_pre 8.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_I3_OFFSET) i3 *)
  hoare_lift_pre 9.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_I4_OFFSET) i4 *)
  hoare_lift_pre 10.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_I5_OFFSET) i5 *)
  hoare_lift_pre 11.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_I6_OFFSET) i6 *)
  hoare_lift_pre 12.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_I7_OFFSET) i7 *)
  hoare_lift_pre 13.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_Y_OFFSET) l6 *)
  hoare_lift_pre 22.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** wr l6 0 Ry *)
  hoare_lift_pre 23.
  hoare_lift_pre 2.
  eapply seq_rule.
  TimReduce_simpl.
  eapply wr_rule_reg; eauto.
  simpl; eauto.
  rewrite in_range0; eauto.
  simpl set_spec_reg.
  rewrite Int.xor_zero.

  (** ld (l5 + OS_G1_OFFSET) g1 *)
  hoare_lift_pre 17.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_G2_OFFSET) g2 *)
  hoare_lift_pre 18.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_G3_OFFSET) g3 *)
  hoare_lift_pre 19.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_G4_OFFSET) g4 *)
  hoare_lift_pre 20.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_G5_OFFSET) g5 *)
  hoare_lift_pre 21.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_G6_OFFSET) g6 *)
  hoare_lift_pre 22.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** ld (l5 + OS_G7_OFFSET) g7 *)
  hoare_lift_pre 23.
  hoare_lift_pre 2.
  solve_ld_ctx.

  (** retl; nop *)
  eapply retl_rule; eauto.
  TimReduce_simpl.
  eapply nop_rule; eauto.
  introv Hs.
  sep_ex_intro.
  eapply sep_pure_l_intro; eauto.
  sep_cancel1 1 1.
  sep_cancel1 8 2.
  unfold context, context'.
  asrt_to_line 4.
  unfold save_reg.
  asrt_to_line 4.
  simpl_sep_liftn 5.
  simpl_sep_liftn 5.
  asrt_to_line 8.
  simpl_sep_liftn 9.
  simpl_sep_liftn 13.
  asrt_to_line 8.
  simpl_sep_liftn 9.

  sep_cancel1 1 8.
  sep_cancel1 1 7.
  sep_cancel1 1 6.
  sep_cancel1 1 5.
  sep_cancel1 1 4.
  sep_cancel1 1 3.
  sep_cancel1 1 2.
  sep_cancel1 1 14.
  sep_cancel1 13 1.
  sep_cancel1 1 8.
  sep_cancel1 1 7.
  sep_cancel1 1 6.
  sep_cancel1 1 5.
  sep_cancel1 1 4.
  sep_cancel1 1 3.
  sep_cancel1 1 2.
  sep_cancel1 1 1.
  sep_cancel1 1 4.
  sep_cancel1 1 3.
  sep_cancel1 1 2.
  sep_cancel1 1 1.
  sep_cancel1 1 1.
  instantiate (1 := Aemp).
  eapply astar_emp_intro_r; eauto.
  eapply astar_emp_elim_r.
  eapply sep_pure_l_intro; eauto.
  simpls.
  repeat (split; eauto).

  unfold fretSta.
  TimReduce_simpl.
  introv Hs Hs'.
  simpl in Hretf.
  inversion Hretf; subst.
  sep_ex_elim_in Hs'.
  eapply sep_pure_l_elim in Hs'.
  destruct Hs' as [Hlgvl1 Hs'].
  inversion Hlgvl1; subst.
  destruct x, x0, x1, x2.
  simpl_sep_liftn_in Hs' 5.
  eapply sep_pure_l_elim in Hs'.
  destruct Hs' as [Hctx_win_restore Hs'].
  destruct_state s.
  destruct_state s'.
  eapply getR_eq_get_genreg_val1 with (rr := r15) in Hs; eauto.
  eapply getR_eq_get_genreg_val1 with (rr := r15) in Hs'; eauto.
  clear - Hs Hctx_win_restore Hs'.
  simpls.
  simpljoin1.
  unfolds get_R.
  destruct (r r15); tryfalse.
  destruct (r0 r15); tryfalse.
  inversion H0; subst.
  eauto.
Qed.


Require Export MicroBFTprops2.

Section MicroBFTass_new.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { dtc                 : DTimeContext          }.
  Context { microbft_context    : MicroBFT_context      }.
  Context { m_initial_keys      : MicroBFT_initial_keys }.
  Context { u_initial_keys      : USIG_initial_keys     }.
  Context { usig_hash           : USIG_hash             }.
  Context { microbft_auth       : MicroBFT_auth         }.

  Opaque KE_TOWNS.
  Opaque KE_ID_BEFORE.

  Lemma ASSUMPTION_generates_new_true :
    forall (eo : EventOrdering), assume_eo eo ASSUMPTION_generates_new_ex.
  Proof.
    introv h; simpl in *.
    allrw interp_KE_ID_BEFORE.
    exrepnd; GC; subst.

    unfold id_before, id_after in *; simpl; exrepnd; subst.
    rename mem0 into mem1.
    rename mem into mem2.
    simpl in *.
    unfold trusted_state_before, trusted_state_after in *; simpl in *.
    exrepnd.
    rewrite h2 in *; unfold MicroBFTheader.node2name in *; ginv; subst.
    unfold disseminate_data in *; exrepnd.
    unfold M_byz_output_sys_on_event in *.
    unfold M_byz_output_ls_on_event in *; simpl in *.
    unfold M_byz_state_sys_on_event in *; simpl in *.
    unfold M_byz_state_sys_before_event in *; simpl in *.

    applydup preserves_usig_id in h5 as eqid; auto;[].

    apply map_option_Some in h5; exrepnd; rev_Some; simpl in *; microbft_simp.
    apply map_option_Some in h6; exrepnd; rev_Some; simpl in *; microbft_simp.
    rewrite M_byz_run_ls_on_event_unroll2 in h3; simpl in *.

    remember (M_byz_run_ls_before_event (MicroBFTsys (loc e)) e) as ls; symmetry in Heqls.
    simpl in *.
    rewrite Heqls in *.
    unfold MicroBFTsys in *; simpl in *.

    apply M_byz_run_ls_before_event_ls_is_microbft in Heqls.
    repndors; exrepnd; subst; simpl in *; microbft_simp.

    { unfold M_byz_run_ls_on_this_one_event in *; simpl in *.
      unfold M_byz_run_ls_on_one_event in *; simpl in *.
      revert dependent o.
      unfold data_is_in_out, event2out in *.
      remember (trigger e) as trig; symmetry in Heqtrig.
      destruct trig; simpl in *; ginv; tcsp; introv run j.

      { allrw in_flat_map; exrepnd.
        unfold M_run_ls_on_input in *.
        autorewrite with microbft in *.
        Time microbft_dest_msg Case;
          repeat (simpl in *; autorewrite with microbft in *; smash_microbft2);
          try (complete (repndors; ginv; simpl in *;
                           unfold ui_has_counter, ui2counter, state_of_trusted in *; simpl in *;
                             eexists; dands; try reflexivity; try omega; tcsp)). }

      { unfold M_run_ls_on_trusted, M_run_ls_on_input in *; simpl in *.
        autorewrite with microbft in *.
        rewrite @on_comp_sing_eq in run.
        rewrite @on_comp_sing_eq in h3.
        dest_cases w; simpl in *;[].
        destruct i, o; simpl in *; repndors; ginv; tcsp;[].
        inversion w; subst; simpl in *.
        rewrite (UIP_refl_CompName _ w) in *; auto; simpl in *.
        destruct it_input; simpl in *; repnd; simpl in *; tcsp; microbft_simp; ginv;
          unfold ui_has_counter, ui2counter, state_of_trusted in *; simpl in *;
            eexists; dands; try reflexivity; try omega; tcsp. } }

    { unfold M_byz_run_ls_on_this_one_event in *; simpl in *.
      unfold M_byz_run_ls_on_one_event in *; simpl in *.
      revert dependent o.
      unfold data_is_in_out, event2out in *.
      remember (trigger e) as trig; symmetry in Heqtrig.
      destruct trig; simpl in *; ginv; tcsp; introv run j.

      unfold M_run_ls_on_trusted, M_run_ls_on_input in *; simpl in *.
      autorewrite with microbft in *.
      rewrite @on_comp_sing_eq in run.
      rewrite @on_comp_sing_eq in h3.
      dest_cases w; simpl in *;[].
      destruct i, o; simpl in *; repndors; ginv; tcsp;[].
      inversion w; subst; simpl in *.
      rewrite (UIP_refl_CompName _ w) in *; auto; simpl in *.
      destruct it_input; simpl in *; repnd; simpl in *; tcsp; microbft_simp; ginv;
        unfold ui_has_counter, ui2counter, state_of_trusted in *; simpl in *;
          eexists; dands; try reflexivity; try omega; tcsp. }
  Qed.
  Hint Resolve ASSUMPTION_generates_new_true : microbft.

End MicroBFTass_new.

Hint Resolve ASSUMPTION_generates_new_true : microbft.


Require Import Lia IndefiniteDescription Arith.
From hahn Require Import Hahn.
Require Import AuxRel.
Require Import Labels.
Require Import Events.
Require Import Execution.
Require Import View.

Set Implicit Arguments.

Record Message :=
  Msg {
      mloc : Loc ;
      mval : Val ;
      mts  : Timestamp ;
      mview : View }.

Definition Memory := (Message -> Prop).
Definition State := (Memory * (Tid -> View))%type.

Definition Minit : Memory :=
  fun m => mval m = 0 /\ mts m = 0 /\
           mview m = fun _ => 0.

Definition Vinit : View := fun x => 0.
Definition Sinit : State := (Minit, fun tid => Vinit).

Inductive RA_label :=
  | RA_event (e : Event) (tstamp : Timestamp) (view : View)
  | RA_internal (t : Tid) (x : Loc) (tstamp : Timestamp).

Definition deflabel : RA_label := RA_internal 0 0 0.

Definition read_ts x :=
  match x with
  | RA_event _ ts _ => ts
  | RA_internal _ _ _ => 0
  end.

Definition write_ts x :=
  match x with
  | RA_event _ ts _ => S ts
  | RA_internal _ _ _ => 0
  end.

Definition tid_of x :=
  match x with
  | RA_event e _ _ => tid e
  | RA_internal tid x _ => tid
  end.

Definition is_external x :=
  match x with
  | RA_event (ThreadEvent _ _ _) _ _ => True
  | _ => False
  end.

Definition proj_ev x :=
  match x with
  | RA_event e _ _ => e
  | RA_internal _ _ _ => InitEvent 0
  end.

Definition trproj t :=
  trace_map proj_ev (trace_filter is_external t).

Definition fresh_tstamp (m : Memory) x ts :=
  ~ exists v view, m (Msg x v ts view).

(*
  Note that we use 'S tstamp` value in write transitions.
  This allows to compute both read and write timestamps
  from single 'tstamp' field of RA_label.
  This is useful for working with RMW labels
  for which both kinds of timestamps make sense.
  By accessing these timestamps with write_ts and read_ts helpers defined above,
  we obtain actual timestamps being written to memory.
*)
Inductive RA_step (MV : State) (e: RA_label) (MV' : State) : Prop :=
| RAstep_read t i x v tstamp view view'
              (EQ: e = RA_event (ThreadEvent t i (Aload x v)) tstamp view')
	      (MSG: fst MV (Msg x v tstamp view))
              (LEV: snd MV t x <= tstamp)
              (MEM: fst MV' = fst MV)
              (EQ': view' = view_join (upd (snd MV t) x tstamp) view)
	      (VIEW: snd MV' = upd (snd MV) t view')
| RAstep_write t i x v tstamp view'
               (EQ: e = RA_event (ThreadEvent t i (Astore x v)) tstamp view')
               (EQ': view' = upd (snd MV t) x (S tstamp))
               (LTV: snd MV t x < S tstamp)
               (MEM: fst MV' = fst MV ∪₁ eq (Msg x v (S tstamp) view'))
               (FRESH: fresh_tstamp (fst MV) x (S tstamp))
	       (VIEW: snd MV' = upd (snd MV) t view')
| RAstep_rmw t i x vr vw tstamp view view'
             (EQ: e = RA_event (ThreadEvent t i (Armw x vr vw)) tstamp view')
	     (MSG: fst MV (Msg x vr tstamp view))
             (LEV: snd MV t x <= tstamp)
             (EQ' : view' = view_join (upd (snd MV t) x (S tstamp)) view)
             (MEM: fst MV' = fst MV ∪₁ eq (Msg x vw (S tstamp) view'))
             (FRESH: fresh_tstamp (fst MV) x (S tstamp))
             (VIEW: snd MV' = upd (snd MV) t view')
| RAstep_internal t x v tstamp view view'
                  (EQ: e = RA_internal t x tstamp)
		  (MSG: fst MV (Msg x v tstamp view))
                  (LEV: snd MV t x < tstamp)
                  (MEM: fst MV' = fst MV)
                  (EQ': view' = upd (snd MV t) x tstamp)
		  (VIEW: snd MV' = upd (snd MV) t view').

Definition ra_lts :=
  {| LTS_init := eq Sinit ;
     LTS_step := RA_step ;
     LTS_final := ∅ |}.

Definition run_fair (states : nat -> State) t : Prop :=
  match t with
  | trace_fin _ => True
  | trace_inf fl =>
    exists (threads : Tid -> Prop),
    set_finite threads /\
    trace_elems t ⊆₁ tid_of ↓₁ threads /\
    forall i (tid : Tid) (TID: threads tid) x tstamp,
    exists j,
      i <= j /\
      (fl j = RA_internal tid x tstamp \/
       forall st'
              (STEP: RA_step (states j) (RA_internal tid x tstamp) st'),
         False)
  end.

Definition RA_is_w lab :=
  match lab with
  | RA_event (ThreadEvent _ _ (Astore _ _)) ts view => True
  | RA_event (ThreadEvent _ _ (Armw _ _ _)) ts view => True
  | _ => False
  end.

Definition RA_wmsg lab :=
  match lab with
  | RA_event (ThreadEvent t i (Astore x v)) ts view => Msg x v (S ts) view
  | RA_event (ThreadEvent t i (Armw x vr vw)) ts view => Msg x vw (S ts) view
  | _ => Msg 0 0 0 (fun _ => 0)
  end.

Definition view_of x :=
  match x with
  | RA_event _ _ view => view
  | RA_internal _ _ _ => fun _ => 0
  end.

Inductive match_ev (e : Event) (l : RA_label) : Prop :=
| ME_case t i lab tstamp view (EQe : e = ThreadEvent t i lab)
          (EQl : l = RA_event e tstamp view).

Definition view_of' t x :=
  match excluded_middle_informative
          (exists xl, match_ev x xl /\ trace_elems t xl) with
  | left IN =>
    view_of (proj1_sig
               (IndefiniteDescription.constructive_indefinite_description
                  _ IN))
  | right _ => fun _ => 0
  end.

Lemma view_of_init t x :
  view_of' t (InitEvent x) = fun _ => 0.
Proof using.
  unfold view_of'; desf.
  exfalso; desf; destruct e; desf.
Qed.

Lemma RA_step_view_mono mem lab mem'
      (STEP : RA_step mem lab mem') t :
  view_le (snd mem t) (snd mem' t).
Proof using.
  destruct STEP; ins; desf; ins.
  all: rewrite VIEW; clear VIEW; unfold upd; desf.
  all: try apply view_le_join_l.
  all: red; unfold upd; ins; desf; lia.
Qed.

Lemma RA_step_view_ext mem lab mem'
      (STEP : RA_step mem lab mem')
      (EXT : is_external lab) :
  view_le (snd mem (tid_of lab))
          (view_of lab) /\
  view_of lab = snd mem' (tid_of lab).
Proof using.
  destruct STEP; ins; desf; ins.
  all: rewrite VIEW, upds; split; ins.
  all: try apply view_le_join_l.
  all: red; unfold upd; ins; desf; lia.
Qed.

Lemma RA_view_mono mem lab
      (STEP : forall i, RA_step (mem i) (lab i) (mem (S i)))
      i j (LE : i <= j) mytid x :
  snd (mem i) mytid x <= snd (mem j) mytid x.
Proof using.
  induction j; rewrite Nat.le_lteq in LE; desf; try lia.
  rewrite Nat.lt_succ_r in *; intuition.
  eapply Nat.le_trans, RA_step_view_mono; eauto.
Qed.

Section RADeclarative.

Variable G: execution.

Definition ra_consistent :=
  irreflexive (hb G ⨾ (co G ∪ fr G)^?) /\
  irreflexive ((rf G)⁻¹ ⨾ (co G ⨾ (co G))).

Lemma hb_irr (CONS : ra_consistent) : irreflexive (hb G).
Proof using.
  cdes CONS. eapply irreflexive_mori; [|by apply CONS0]. red. basic_solver.
Qed.

Lemma ra_rmw_atomicity (WF: Wf G) (CONS : ra_consistent) :
  rmw_atomicity G.
Proof using.
  unfold ra_consistent, rmw_atomicity in *; desc.
  rewrite wf_rfE, wf_rfD; ins; unfolder in *; ins; desf.
  destruct (classic (x = y)) as [|NEQ]; desf.
    by edestruct (CONS y); exists y; split; vauto.
  eapply (wf_co_total WF) in NEQ; ins; desf; ins.
    splits; ins; intro; desf; eauto 10.
  edestruct (CONS x); exists y; split; vauto.
  apply wf_rfl in H0; ins.
Qed.

Lemma ra_rf_irr (CONS : ra_consistent) : irreflexive (rf G).
Proof using. rewrite rf_in_hb. by apply hb_irr. Qed.

Lemma rf_w_in_co (WF: Wf G) (CONS : ra_consistent) :
  (rf G) ⨾ ⦗is_w⦘ ⊆ (co G).
Proof using.
  unfolder. intros x y [RF WY].
  destruct (classic (x = y)) as [|NEQ]; subst.
  { exfalso. eapply ra_rf_irr; eauto. }
  apply (wf_rfE WF) in RF. unfolder in RF. desf.
  apply (wf_rfD WF) in RF0. unfolder in RF0. desf.
  edestruct (wf_co_total WF) with (a:=x) (b:=y) as [|HH]; eauto.
  1,2: unfolder; splits; eauto.
  { symmetry. by apply (wf_rfl WF). }
  exfalso.
  cdes CONS.
  eapply CONS0. eexists. split.
  2: { generalize HH. basic_solver. }
    by apply rf_in_hb.
Qed.

Lemma co_init_r (WF: Wf G) (CONS : ra_consistent) x y : (co G) x y -> is_init y -> False.
Proof.
  ins.
  eapply (proj1 CONS y); eexists x; split; vauto.
  apply (wf_coE WF) in H.
  apply t_step; left; unfold sb, ext_sb; unfolder in *; desf.
  assert (SL := wf_col WF _ _ H1); unfold same_loc, loc in *; ins; desf.
  edestruct (co_irr WF); eauto.
Qed.

End RADeclarative.


(**************************************************************************)
(*  This file is part of CertrBPF,                                        *)
(*  a formally verified rBPF verifier + interpreter + JIT in Coq.         *)
(*                                                                        *)
(*  Copyright (C) 2022 Inria                                              *)
(*                                                                        *)
(*  This program is free software; you can redistribute it and/or modify  *)
(*  it under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation; either version 2 of the License, or     *)
(*  (at your option) any later version.                                   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful,       *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU General Public License for more details.                          *)
(*                                                                        *)
(**************************************************************************)

From bpf.comm Require Import rBPFAST ListAsArray MemRegion Regs Flag State.

From bpf.monadicmodel Require Import Opcode.

From Coq Require Import List Lia ZArith.
From compcert Require Import Integers Values Clight Memory AST.
Import ListNotations.

From bpf.clightlogic Require Import Clightlogic CommonLib.
From bpf.simulation Require Import MatchState.

Definition val_ptr_correct {S:special_blocks} (x:val) (v: val) (st: State.state) (m:Memory.Mem.mem) :=
  x = v /\
  match_state st m.

Open Scope nat_scope.
Definition is_state_handle {S: special_blocks} (v: val) := v = Vptr st_blk Ptrofs.zero.

Definition is_illegal_alu64_ins (i:nat): Prop :=
  ((Nat.land i 240) <> 0x00) /\
  ((Nat.land i 240) <> 0x10) /\
  ((Nat.land i 240) <> 0x20) /\
  ((Nat.land i 240) <> 0x30) /\
  ((Nat.land i 240) <> 0x40) /\
  ((Nat.land i 240) <> 0x50) /\
  ((Nat.land i 240) <> 0x60) /\
  ((Nat.land i 240) <> 0x70) /\
  ((Nat.land i 240) <> 0x80) /\
  ((Nat.land i 240) <> 0x90) /\
  ((Nat.land i 240) <> 0xa0) /\
  ((Nat.land i 240) <> 0xb0) /\
  ((Nat.land i 240) <> 0xc0).

Definition opcode_alu64_correct (opcode: opcode_alu64) (v: val) :=
  match opcode with
  | op_BPF_ADD64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x07 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x0f 240)))
  | op_BPF_SUB64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x17 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x1f 240)))
  | op_BPF_MUL64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x27 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x2f 240)))
  | op_BPF_DIV64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x37 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x3f 240)))
  | op_BPF_OR64  => v = Vint (Int.repr (Z.of_nat (Nat.land 0x47 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x4f 240)))
  | op_BPF_AND64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x57 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x5f 240)))
  | op_BPF_LSH64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x67 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x6f 240)))
  | op_BPF_RSH64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x77 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x7f 240)))
  | op_BPF_NEG64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x87 240)))
  | op_BPF_MOD64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x97 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x9f 240)))
  | op_BPF_XOR64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0xa7 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0xaf 240)))
  | op_BPF_MOV64 => v = Vint (Int.repr (Z.of_nat (Nat.land 0xb7 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0xbf 240)))
  | op_BPF_ARSH64=> v = Vint (Int.repr (Z.of_nat (Nat.land 0xc7 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0xcf 240)))
  | op_BPF_ALU64_ILLEGAL_INS => exists i, v = Vint (Int.repr (Z.of_nat (Nat.land i 240))) /\ is_illegal_alu64_ins i
  end.

Definition is_illegal_alu32_ins (i:nat): Prop :=
  ((Nat.land i 240) <> 0x00) /\
  ((Nat.land i 240) <> 0x10) /\
  ((Nat.land i 240) <> 0x20) /\
  ((Nat.land i 240) <> 0x30) /\
  ((Nat.land i 240) <> 0x40) /\
  ((Nat.land i 240) <> 0x50) /\
  ((Nat.land i 240) <> 0x60) /\
  ((Nat.land i 240) <> 0x70) /\
  ((Nat.land i 240) <> 0x80) /\
  ((Nat.land i 240) <> 0x90) /\
  ((Nat.land i 240) <> 0xa0) /\
  ((Nat.land i 240) <> 0xb0) /\
  ((Nat.land i 240) <> 0xc0).

Definition opcode_alu32_correct (opcode: opcode_alu32) (v: val) :=
  match opcode with
  | op_BPF_ADD32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x04 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x0c 240)))
  | op_BPF_SUB32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x14 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x1c 240)))
  | op_BPF_MUL32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x24 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x2c 240)))
  | op_BPF_DIV32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x34 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x3c 240)))
  | op_BPF_OR32  => v = Vint (Int.repr (Z.of_nat (Nat.land 0x44 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x4c 240)))
  | op_BPF_AND32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x54 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x5c 240)))
  | op_BPF_LSH32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x64 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x6c 240)))
  | op_BPF_RSH32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x74 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x7c 240)))
  | op_BPF_NEG32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x84 240)))
  | op_BPF_MOD32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0x94 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x9c 240)))
  | op_BPF_XOR32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0xa4 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0xac 240)))
  | op_BPF_MOV32 => v = Vint (Int.repr (Z.of_nat (Nat.land 0xb4 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0xbc 240)))
  | op_BPF_ARSH32=> v = Vint (Int.repr (Z.of_nat (Nat.land 0xc4 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0xcc 240)))
  | op_BPF_ALU32_ILLEGAL_INS => exists i, v = Vint (Int.repr (Z.of_nat (Nat.land i 240))) /\ is_illegal_alu32_ins i
  end.

Definition is_illegal_jmp_ins (i:nat): Prop :=
  ((Nat.land i 240) <> 0x00) /\
  ((Nat.land i 240) <> 0x10) /\
  ((Nat.land i 240) <> 0x20) /\
  ((Nat.land i 240) <> 0x30) /\
  ((Nat.land i 240) <> 0x40) /\
  ((Nat.land i 240) <> 0x50) /\
  ((Nat.land i 240) <> 0x60) /\
  ((Nat.land i 240) <> 0x70) /\
  ((Nat.land i 240) <> 0x80) /\
  ((Nat.land i 240) <> 0x90) /\
  ((Nat.land i 240) <> 0xa0) /\
  ((Nat.land i 240) <> 0xb0) /\
  ((Nat.land i 240) <> 0xc0) /\
  ((Nat.land i 240) <> 0xd0).

Definition opcode_branch_correct (opcode: opcode_branch) (v: val) :=
  match opcode with
  | op_BPF_JA    => v = Vint (Int.repr (Z.of_nat (Nat.land 0x05 240)))
  | op_BPF_JEQ   => v = Vint (Int.repr (Z.of_nat (Nat.land 0x15 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x1d 240)))
  | op_BPF_JGT   => v = Vint (Int.repr (Z.of_nat (Nat.land 0x25 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x2d 240)))
  | op_BPF_JGE   => v = Vint (Int.repr (Z.of_nat (Nat.land 0x35 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x3d 240)))
  | op_BPF_JLT   => v = Vint (Int.repr (Z.of_nat (Nat.land 0xa5 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0xad 240)))
  | op_BPF_JLE   => v = Vint (Int.repr (Z.of_nat (Nat.land 0xb5 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0xbd 240)))
  | op_BPF_JSET  => v = Vint (Int.repr (Z.of_nat (Nat.land 0x45 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x4d 240)))
  | op_BPF_JNE   => v = Vint (Int.repr (Z.of_nat (Nat.land 0x55 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x5d 240)))
  | op_BPF_JSGT  => v = Vint (Int.repr (Z.of_nat (Nat.land 0x65 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x6d 240)))
  | op_BPF_JSGE  => v = Vint (Int.repr (Z.of_nat (Nat.land 0x75 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0x7d 240)))
  | op_BPF_JSLT  => v = Vint (Int.repr (Z.of_nat (Nat.land 0xc5 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0xcd 240)))
  | op_BPF_JSLE  => v = Vint (Int.repr (Z.of_nat (Nat.land 0xd5 240))) \/ v = Vint (Int.repr (Z.of_nat (Nat.land 0xdd 240)))
  | op_BPF_CALL  => v = Vint (Int.repr (Z.of_nat (Nat.land 0x85 240)))
  | op_BPF_RET   => v = Vint (Int.repr (Z.of_nat (Nat.land 0x95 240)))
  | op_BPF_JMP_ILLEGAL_INS => exists i, v = Vint (Int.repr (Z.of_nat (Nat.land i 240))) /\ is_illegal_jmp_ins i
  end.

Definition opcode_mem_ld_imm_correct (opcode: opcode_mem_ld_imm) (v: val) :=
  match opcode with
  | op_BPF_LDDW_low  => v = Vint (Int.repr (Z.of_nat 0x18))
  | op_BPF_LDDW_high => v = Vint (Int.repr (Z.of_nat 0x10))
  | op_BPF_LDX_IMM_ILLEGAL_INS =>
    exists i,
      v = Vint (Int.repr (Z.of_nat i)) /\
      (i <> 0x18 /\ i <> 0x10) /\
      i <= 255
  end.

Definition opcode_mem_ld_reg_correct (opcode: opcode_mem_ld_reg) (v: val) :=
  match opcode with
  | op_BPF_LDXW  => v = Vint (Int.repr (Z.of_nat 0x61))
  | op_BPF_LDXH  => v = Vint (Int.repr (Z.of_nat 0x69))
  | op_BPF_LDXB  => v = Vint (Int.repr (Z.of_nat 0x71))
  | op_BPF_LDXDW => v = Vint (Int.repr (Z.of_nat 0x79))
  | op_BPF_LDX_REG_ILLEGAL_INS =>
    exists i,
      v = Vint (Int.repr (Z.of_nat i)) /\
      (i <> 0x61 /\ i <> 0x69 /\ i <> 0x71 /\ i <> 0x79) /\
      i <= 255
  end.

Definition opcode_mem_st_imm_correct (opcode: opcode_mem_st_imm) (v: val) :=
  match opcode with
  | op_BPF_STW  => v = Vint (Int.repr (Z.of_nat 0x62))
  | op_BPF_STH  => v = Vint (Int.repr (Z.of_nat 0x6a))
  | op_BPF_STB  => v = Vint (Int.repr (Z.of_nat 0x72))
  | op_BPF_STDW => v = Vint (Int.repr (Z.of_nat 0x7a))
  | op_BPF_ST_ILLEGAL_INS =>
    exists i,
      v = Vint (Int.repr (Z.of_nat i)) /\
      (i <> 0x62 /\ i <> 0x6a /\ i <> 0x72 /\ i <> 0x7a) /\
      i <= 255
  end.

Definition opcode_mem_st_reg_correct (opcode: opcode_mem_st_reg) (v: val) :=
  match opcode with
  | op_BPF_STXW  => v = Vint (Int.repr (Z.of_nat 0x63))
  | op_BPF_STXH  => v = Vint (Int.repr (Z.of_nat 0x6b))
  | op_BPF_STXB  => v = Vint (Int.repr (Z.of_nat 0x73))
  | op_BPF_STXDW => v = Vint (Int.repr (Z.of_nat 0x7b))
  | op_BPF_STX_ILLEGAL_INS =>
    exists i,
      v = Vint (Int.repr (Z.of_nat i)) /\
      (i <> 0x63 /\ i <> 0x6b /\ i <> 0x73 /\ i <> 0x7b) /\
      i <= 255
  end.

Definition opcode_step_correct (op: opcode) (v: val) :=
  match op with
  | op_BPF_ALU64   (**r 0xX7 / 0xXf *) => v = Vint (Int.repr (Z.of_nat 0x07))
  | op_BPF_ALU32   (**r 0xX4 / 0xXc *) => v = Vint (Int.repr (Z.of_nat 0x04))
  | op_BPF_Branch  (**r 0xX5 / 0xXd *) => v = Vint (Int.repr (Z.of_nat 0x05))
  | op_BPF_Mem_ld_imm  (**r 0xX8 *)    => v = Vint (Int.repr (Z.of_nat 0x00))
  | op_BPF_Mem_ld_reg  (**r 0xX1/0xX9 *) => v = Vint (Int.repr (Z.of_nat 0x01))
  | op_BPF_Mem_st_imm  (**r 0xX2/0xXa *) => v = Vint (Int.repr (Z.of_nat 0x02))
  | op_BPF_Mem_st_reg  (**r 0xX3/0xXb *) => v = Vint (Int.repr (Z.of_nat 0x03))

  | op_BPF_ILLEGAL_INS =>
    exists i,
      v = Vint (Int.repr (Z.of_nat i)) /\
      (i <> 0x00 /\ i <> 0x01 /\ i <> 0x02 /\ i <> 0x03 /\ i <> 0x04 /\ i <> 0x05 /\ i <> 0x07) /\
      i <= 255
  end.

Close Scope nat_scope.

Definition mr_correct {S:special_blocks} (mr: memory_region) (v: val) (st: State.state) (m:Memory.Mem.mem) :=
  List.In mr (bpf_mrs st) /\
  match_region st_blk mrs_blk ins_blk mr v st m /\
  match_state  st m.

Definition mrs_correct (S: special_blocks) (mrs: list memory_region) (v: val) (st: State.state) (m:Memory.Mem.mem) :=
  v = Vptr mrs_blk Ptrofs.zero /\
  mrs = (bpf_mrs st) /\
  match_regions st_blk mrs_blk ins_blk st m /\
  match_state  st m.