Library ArchSemArm.VMSA22Arm


From ASCommon Require Import Options.
From ASCommon Require Import Common GRel FMon.

Require Import ArmInst.
Require Import GenAxiomaticArm.


This file define the VMSA model from the ESOP 22 paper by Ben Simner et al. The reference implementation is at: TODO

Section VMSAArm.
  Import Candidate.
  Context (regs_whitelist : gset reg).
  Context {nmth : nat}.
  Context (cd : Candidate.t NMS nmth).

Arm standard notations

  Import AxArmNames.

Thread relations

  Notation pe := (pre_exec cd).
  Notation int := (same_thread pe).
  Notation si := (same_instruction_instance cd).
  Notation sca := (same_access cd).
  Notation instruction_order := (instruction_order pe).
  Notation full_instruction_order := (full_instruction_order pe).
  Notation iio := (iio pe).

Dependencies

  Notation addr := (addr cd).
  Notation data := (data cd).
  Notation ctrl := (ctrl cd).

Registers

  Notation RR := (reg_reads pe).
  Notation RW := (reg_writes pe).
  Notation RE := (RE cd).
  Notation rrf := (reg_reads_from cd).
  Notation rfr := (reg_from_reads cd).
  Notation MSR := (MSR cd).
  Notation MRS := (MRS cd).

Barriers

  Notation F := (barriers cd).
  Notation ISB := (isb cd).

Memory

  Notation W := (explicit_writes pe).
  Notation R := (explicit_reads pe).
  Notation M := (mem_explicit pe).
  Notation Wx := (exclusive_writes pe).
  Notation Rx := (exclusive_writes pe).
  Notation L := (rel_acq_rcsc_writes pe).
  Notation A := (rel_acq_rcsc_reads pe).
  Notation Q := (rel_acq_rcpc_reads pe).
  Notation T := (ttw_reads pe).
  Notation IF := (ifetch_reads pe).
  Notation IR := (init_mem_reads cd).

  Notation lxsx := (lxsx cd).
  Notation amo := (atomic_update cd).
  Notation rmw := (rmw cd).

  Notation co := (co cd).
  Notation coi := (coi cd).
  Notation coe := (coe cd).

  Notation rf := (rf cd).
  Notation rfi := (rfi cd).
  Notation rfe := (rfe cd).
  Notation fr := (fr cd).
  Notation fri := (fri cd).
  Notation fre := (fre cd).

  Notation frf := (frf cd).
  Notation frfi := (frfi cd).

  Notation trf := (trf cd).
  Notation trfi := (trfi cd).
  Notation trfe := (trfe cd).
  Notation tfr := (tfr cd).
  Notation tfri := (tfri cd).
  Notation tfre := (tfre cd).

  Notation irf := (irf cd).
  Notation irfi := (irfi cd).
  Notation irfe := (irfe cd).
  Notation ifr := (ifr cd).
  Notation ifri := (ifri cd).
  Notation ifre := (ifre cd).

Caches

  Notation ICDC := (ICDC cd).
  Notation TLBI := (TLBI cd).
  Notation C := (C cd).

Exceptions

  Notation TE := (TE cd).
  Notation ERET := (ERET cd).

Explicit events

  Notation Exp := (Exp cd).
  Notation po := (po cd).

Registers

Although this model supports updating the page tables, it does not yet support updating page table registers like the TTBRs. Therefore it only support untagged register writes

  Definition is_illegal_reg_write (regs : gset reg) :=
    is_reg_writeP (λ reg acc _, reg regs acc None).
  #[export] Instance is_illegal_reg_write_dec regs ev :
    Decision (is_illegal_reg_write regs ev).
  Proof. unfold_decide. Defined.

  Definition Illegal_RW := collect_all (λ _, is_illegal_reg_write regs_whitelist) cd.

  Notation "'id'" := valid_eids cd.

  Definition valid_eids_rc r := r id.
  Definition valid_eids_compl a := (valid_eids cd) a.

  Notation "a ?" := (valid_eids_rc a) (at level 1, format "a ?") : stdpp_scope.
  Notation "'~~' a" := (valid_eids_compl a)
                          (at level 1, format "~~ a") : stdpp_scope.

Explicit memory

The only kind of read allowed in this model are:
  • Explicit
  • TTW
  • IFetch
In addition, only explicit write are allowed.
coherence however can also contain cache operations.



  Definition wco := (coherence cd).





  #[local] Hint Extern 10 (Decision (?x _)) ⇒ unfold x : typeclass_instances.
  #[local] Hint Extern 10 (Decision (?x _ _)) ⇒ unfold x : typeclass_instances.
  #[local] Hint Extern 10 (Decision (?x _ _ _)) ⇒ unfold x : typeclass_instances.



  Definition is_tlbi_op (tlbiop : TLBIOp) (tlbop : TLBIInfo) :=
    tlbop.(TLBIInfo_rec).(TLBIRecord_op) = tlbiop.

  Definition has_tlbi_op (event : iEvent) (tlbiop : TLBIOp) :=
    is_tlbopP (is_tlbi_op tlbiop) event.

  Definition TLBI_ASID :=
    collect_all (λ _ event, has_tlbi_op event TLBIOp_ASID
                             has_tlbi_op event TLBIOp_VA
                             has_tlbi_op event TLBIOp_VAA) cd.
  Definition TLBI_S1 :=
    collect_all (λ _ event, has_tlbi_op event TLBIOp_VA
                             has_tlbi_op event TLBIOp_VMALLS12
                             has_tlbi_op event TLBIOp_VMALL
                             has_tlbi_op event TLBIOp_ALL
                             has_tlbi_op event TLBIOp_ASID) cd.
  Definition TLBI_S2 :=
    collect_all (λ _ event, has_tlbi_op event TLBIOp_IPAS2
                             has_tlbi_op event TLBIOp_VMALLS12
                             has_tlbi_op event TLBIOp_VMALL
                             has_tlbi_op event TLBIOp_ALL
                             has_tlbi_op event TLBIOp_ASID) cd.
  Definition TLBI_VMID :=
    collect_all (λ _ event, has_tlbi_op event TLBIOp_VA
                             has_tlbi_op event TLBIOp_VAA
                             has_tlbi_op event TLBIOp_IPAS2
                             has_tlbi_op event TLBIOp_VMALLS12
                             has_tlbi_op event TLBIOp_VMALL
                             has_tlbi_op event TLBIOp_ASID) cd.
  Definition TLBI_VA :=
    collect_all (λ _ event, has_tlbi_op event TLBIOp_VA) cd.
  Definition TLBI_IPA :=
    collect_all (λ _ event, has_tlbi_op event TLBIOp_IPAS2) cd.

regime
  Definition is_tlbi_regime (reg : Regime) (tlbop : TLBIInfo) :=
    tlbop.(TLBIInfo_rec).(TLBIRecord_regime) = reg.

  Definition has_tlbi_regime (event : iEvent) (reg : Regime) :=
    is_tlbopP (is_tlbi_regime reg) event.

  Definition TLBI_EL1 :=
    collect_all (λ _ event, has_tlbi_regime event Regime_EL10) cd.
  Definition TLBI_EL2 :=
    collect_all (λ _ event, has_tlbi_regime event Regime_EL2) cd.

shareability
  Definition is_tlbi_shareability (share : Shareability)
    (tlbop : TLBIInfo) :=
    tlbop.(TLBIInfo_shareability) = share.

  Definition has_tlbi_shareability (event : iEvent) (share : Shareability) :=
    is_tlbopP (is_tlbi_shareability share) event.

  Definition TLBI_IS :=
    collect_all (λ _ event, has_tlbi_shareability event Shareability_ISH
                             has_tlbi_shareability event Shareability_OSH) cd.

  Definition same_translation : grel EID.t := same_instruction_instance cd.

  Definition get_translation_start (eid : EID.t) : option trans_start :=
    '(instr_trace, _) lookup_instruction cd eid.(EID.tid) eid.(EID.iid);
    let trace_before := take eid.(EID.ieid) instr_trace in
    last $ omap get_trans_start trace_before.

  Definition get_vmid (eid : EID.t) (event : iEvent) :=
    if event is TlbOp tlbop &→ _
    then Some tlbop.(TLBIInfo_rec).(TLBIRecord_asid)
    else
      ts get_translation_start eid;
      Some ts.(TranslationStartInfo_asid).

  Definition same_vmid := same_key get_vmid cd.

  Definition get_asid (eid : EID.t) (event : iEvent) :=
    if event is TlbOp tlbop &→ _
    then Some tlbop.(TLBIInfo_rec).(TLBIRecord_asid)
    else
      ts get_translation_start eid;
      Some ts.(TranslationStartInfo_asid).

  Definition same_asid := same_key get_asid cd.

  Definition tlbi_translate_same_asid : grel EID.t :=
    (TLBI_ASID × T) same_asid.

  Definition tlbi_translate_same_vmid : grel EID.t :=
    (TLBI_VMID × T) same_vmid.

  Definition page_of_addr (ad: bits 64): bits 36 := bv_extract 12 36 ad.


  Inductive TLBI_addr_kind :=
    | TLBI_ak_unsupported
    | TLBI_ak_no
    | TLBI_ak_va
    | TLBI_ak_ipa.

Classifies the use of the TLBI address field (TLBIRecord_address). The results can be:
  • This TLBI is unsupported (because Aarch32, VMSA128, or GPT/RME)
  • doesn't use an address, thus this field is unused
  • use the address as a virtual address (VA)
  • use the address as a intermediate physical address (IPA)
TODO write this function in Sail so other sail backends can use it?
  Definition get_TLBI_addr_kind (top : TLBIOp) : TLBI_addr_kind :=
    match top with
    | TLBIOp_ALLTLBI_ak_no
    | TLBIOp_ASIDTLBI_ak_no
    | TLBIOp_IPAS2TLBI_ak_ipa
    | TLBIOp_VAATLBI_ak_va
    | TLBIOp_VATLBI_ak_va
    | TLBIOp_VMALLTLBI_ak_no
    | TLBIOp_VMALLS12TLBI_ak_no
    | TLBIOp_RIPAS2TLBI_ak_ipa
    | TLBIOp_RVAATLBI_ak_va
    | TLBIOp_RVATLBI_ak_va
    | _TLBI_ak_unsupported
    end.

  Definition get_va_page (eid : EID.t) (event : iEvent) :=
    if event is TlbOp tlbop &→ _
    then
      guard (get_TLBI_addr_kind tlbop.(TLBIInfo_rec).(TLBIRecord_op) = TLBI_ak_va);;
      Some $ page_of_addr tlbop.(TLBIInfo_rec).(TLBIRecord_address)
    else
      ts get_translation_start eid;
      Some $ page_of_addr ts.(TranslationStartInfo_va).

  Definition va_page_overlap :=
    same_key get_va_page cd.

  Definition get_ipa_page (eid : EID.t) (event : iEvent) :=
    if event is TlbOp tlbop &→ _
    then
      guard (get_TLBI_addr_kind tlbop.(TLBIInfo_rec).(TLBIRecord_op) = TLBI_ak_ipa);;
      Some $ page_of_addr tlbop.(TLBIInfo_rec).(TLBIRecord_address)
    else
      ts get_translation_start eid;
      guard (ts.(TranslationStartInfo_regime) = Regime_EL10);;
      Some $ page_of_addr ts.(TranslationStartInfo_va).

  Definition ipa_page_overlap :=
    same_key get_ipa_page cd.

  Definition tlbi_translate_same_va_page : grel EID.t :=
    (TLBI_VA × T) va_page_overlap.

  Definition tlbi_translate_same_ipa_page : grel EID.t :=
    (TLBI_IPA × T) ipa_page_overlap.


  Section isFault.
    Context (P : FaultRecord Prop).
    Implicit Type ev : iEvent.

    Definition is_faultP :=
      is_take_exceptionP (λ e, if e is Some f then P f else False).
    Typeclasses Opaque is_faultP.

    Definition is_faultP_spec ev:
      is_faultP ev
         flt, ev = TakeException (Some flt) &→ () P flt.
    Proof.
      clear - P ev.
      destruct ev as [[] fret];
        split; cdestruct |- ? #CDestrMatch; destruct fret; sauto lq:on dep:on.
    Qed.

    Context `{Pdec: c, Decision (P c)}.
    #[global] Instance is_faultP_dec ev: Decision (is_faultP ev).
    Proof using Pdec. unfold is_faultP. solve_decision. Defined.
  End isFault.
  Notation is_fault := (is_faultP (λ _, True)).

  Definition Fault := collect_all (λ _ event, is_fault event) cd.
  Definition Fault_T :=
    collect_all
      (λ _ event,
          is_faultP
            (λ fault, fault.(FaultRecord_statuscode) = Fault_Translation) event) cd.
  Definition Fault_P :=
    collect_all
      (λ _ event,
          is_faultP
            (λ fault, fault.(FaultRecord_statuscode) = Fault_Permission) event) cd.
  Definition FaultFromR :=
    collect_all
      (λ _ event,
          is_faultP (λ fault, fault.(FaultRecord_write) = false) event) cd.
  Definition FaultFromW :=
    collect_all
      (λ _ event,
          is_faultP (λ fault, fault.(FaultRecord_write) = true) event) cd.
  Definition FaultFromAquireR :=
    collect_all
      (λ _ event,
          is_faultP
            (λ fault, fault.(FaultRecord_write) = false
                                                    
                       fault.(FaultRecord_access).(AccessDescriptor_acqsc)) event) cd.
  Definition FaultFromReleaseW :=
    collect_all
      (λ _ event,
          is_faultP
            (λ fault, fault.(FaultRecord_write) = true
                       fault.(FaultRecord_access).(AccessDescriptor_relsc)) event) cd.


  Notation T_f := (T_f cd).

Stage 2 is temporarily disabled because the current Arm instantiation in translation start/end doesn't support it


  Definition Stage1 := T.   Definition Stage2 : gset EID.t:= .
  Definition speculative := ctrl (addrpo).
  Definition ContextChange := MSR TE ERET.
  Definition CSE := ISB TE ERET.

  Definition tlb_might_affect :=
    (TLBI_S1 ~~TLBI_S2 TLBI_VA TLBI_ASID
        (tlbi_translate_same_va_page tlbi_translate_same_asid
           tlbi_translate_same_vmid)⨾T Stage1)
       (TLBI_S1 ~~TLBI_S2 TLBI_VA TLBI_ASID ~~TLBI_VMID
            ⨾(tlbi_translate_same_va_page tlbi_translate_same_asid)⨾T Stage1)
       (TLBI_S1 ~~TLBI_S2 ~~TLBI_VA TLBI_ASID TLBI_VMID
            ⨾(tlbi_translate_same_asid tlbi_translate_same_vmid)⨾T Stage1)
       (TLBI_S1 ~~TLBI_S2 ~~TLBI_VA ~~TLBI_ASID TLBI_VMID
            tlbi_translate_same_vmidT Stage1)
       (~~TLBI_S1 TLBI_S2 TLBI_IPA ~~TLBI_ASID TLBI_VMID
            ⨾(tlbi_translate_same_ipa_page tlbi_translate_same_vmid)⨾T Stage2)
       (~~TLBI_S1 TLBI_S2 ~~TLBI_IPA ~~TLBI_ASID TLBI_VMID
            tlbi_translate_same_vmidT Stage2)
       (TLBI_S1 TLBI_S2 ~~TLBI_IPA ~~TLBI_ASID TLBI_VMID
            tlbi_translate_same_vmidT)
       (TLBI_S1 ~~TLBI_IPA ~~TLBI_ASID ~~TLBI_VMID) × (T Stage1)
       (TLBI_S2 ~~TLBI_IPA ~~TLBI_ASID ~~TLBI_VMID) × (T Stage2).

  Definition tlb_affects :=
    (TLBI_IStlb_might_affect)
       (~~TLBI_IStlb_might_affect) int.

  Definition maybe_TLB_cached :=
    ((Ttrf⁻¹wcoTLBI_S1)
    
        ((T grel_rng trf) × (TLBI_S1 (grel_dom wco grel_rng wco)))
    ) tlb_affects⁻¹.

  Definition tob :=
    (T_ftfr) (speculativetrfi).

  Definition tlb_barriered :=
    (TtfrwcoTLBI) tlb_affects⁻¹.

  Definition obtlbi_translate :=
    
    (T Stage1tlb_barrieredTLBI_S1)
      
      
       ((T Stage2tlb_barrieredTLBI_S2)
             (same_translationT Stage1trf⁻¹wco⁻¹))
      
       (((T Stage2tlb_barrieredTLBI_S2)⨾(wco ?)⨾TLBI_S1)
             (same_translationT Stage1maybe_TLB_cached)).

  Definition obtlbi :=
    obtlbi_translate
      
       (R W Faultiio⁻¹⨾(obtlbi_translate int)⨾TLBI).

  Definition ctxob :=
    
    (speculativeMSR)
      
       (CSEinstruction_order)
      
       (ContextChangepoCSE)
      
       (speculativeCSE).

  Definition obfault :=
    dataFault_T FaultFromW
       speculativeFault_T FaultFromW
       dmb_store cdpoFault_T FaultFromW
       dmb_load cdpoFault_T (FaultFromW FaultFromR)
       A QpoFault_T (FaultFromW FaultFromR)
       R WpoFault_T FaultFromW FaultFromReleaseW.

  Definition obETS :=
    ((obfaultFault_T)⨾iio⁻¹T_f)
       ((TLBIpodsbsy cdinstruction_orderT) tlb_affects).

  Definition obETS2 :=
    MpoT_f
       dsbsy cdinstruction_orderIFiioT.

  Definition obs := rfe fr wco trfe.

  Definition dob :=
    addr data
       (speculativeW)
       ((addr data)⨾rfi)
       ((addr data)⨾trfi).

  Definition aob :=
    rmw
       (grel_rng rmwrfi⨾(AQ)).

  Definition bob :=
    (Rpodmb_load cd)
     (Wpodmb_store cd)
     (dmb cdpoW)
     (dmb_load cdpoR)
    
     (grel_rng (AamoL)poM)
     (LpoA)
     (A QpoM)
     (MpoL)
     (dsb cdpoMSR M F C TE ERET)
     (ISB instruction_order).

  Definition ob1 := obs dob aob bob iio tob obtlbi ctxob
                       obfault obETS.
  Definition ob := ob1⁺.

  Record consistent := {
      internal :> exp_internal cd;
      reg_internal' :> reg_internal cd;
      translation_internal : trfi not_after cd;
      external : grel_irreflexive ob;
      atomic : (rmw (fre coe)) = ;
      co_contains_TBLI_writes:
       weid mem_writes cd, teid TLBI,
        (weid, teid) coherence cd (teid, weid) coherence cd
    }.
  #[export] Instance consistent_dec : Decision consistent := ltac:(decide_record).

  Record not_UB := {
      initial_reads : IF IR;
      initial_reads_not_delayed : IF ## grel_rng (coherence cd);
      register_write_permitted : Illegal_RW = ;
      memory_events_permitted : (mem_events cd) M T IF;
      is_nms' : is_nms cd;
      no_cacheop : ICDC = ;
    }.
  #[export] Instance not_UB_dec : Decision not_UB := ltac:(decide_record).

  Definition consistent_ok := consistent not_UB.
  Instance consistent_ok_dec : Decision consistent_ok := ltac:(unfold_decide).

End VMSAArm.

The VMSA22 Arm axiomatic model
Definition axmodel regs_whitelist : Ax.t Candidate.NMS :=
  λ _ cd, if decide (consistent cd) then
            if decide (not_UB regs_whitelist cd) then Ok Ax.Allowed
            else Error ""
          else Ok Ax.Rejected.

The VMSA22 Arm architecture model