Morello (#84)

This PR upstreams support for the Arm Morello architecture (for aarch64)

The target specification is the first Morello release (version A.f):
https://developer.arm.com/documentation/ddi0606/A-f

A new variant has been created: "-variant morello", both for diy7 and
for herd7. For diy7, new annotations have been added in order to deal
with Morello capabilities:

Ct for morello tags
Cs for morello seal (object type)
P, A, Q and L annotations can be suffixed with "c" to handle
capabilities
More information can be found in the individual commit messages.

The patchset passed "pre-commit run --all-files" as well as the
regression tests currently in PR #81 with "make test".

* [morello] Add infrastructure

Add morello variant. Enabling morello variant also enables mixed
variant. Because the implementation of the morello tag uses a separate
memory location, the execution of herd is faster that way. Using morello
without mixed hasn't been fully implemented and would output incorrect
results.

Add 128-bit size (S128 in MachSize and V128 for AArch64)

Add Capability registers for AArch64

Parse morello initializations

* [morello] Add capability constants

They hold a boolean for the tag and a 128-bit value for the rest of the
capability.

Arithmetic operations modifying the capability reset the tag to false.

* [lib] Add morello

Add a number of morello instructions. Some of which are not particularly
useful at the moment given that addresses are represented as strings and
not numerical values.

This patch includes the implementation of the tag, permissions and
object type of capabilities. It doesn't include their bounds and flags.
When using morello, the only implemented instruction set is C64.

Add the necessary operations on Value to implement those instructions.

Add the possibility to use unary and binary operations on Symbolic.
Those operation will only make use of the new "capability" field of
Symbolic values, and won't have an effect on non-morello variants.

* [herd] Expose used value in lift_memop

This allows to perform checks on both the address and the value used for
memory accesses.

* [herd] Add a morello specific CAS semantic

This is a temporary implementation that should be unified with the
baseline CAS in the future. It uses choiceT instead of altT in order to
get a correct behavior with the morello tag memory location.

* [herd] Allow delay of non-singleton events

Not used for now, but might be useful at some point.

* [herd] Add morello

Add morello instructions

Adapt data processing to fit 128-bit registers

Add read/write of capabilities from/to registers and memory

Add checks on memory accesses and add permissions to memory operations

Enable initialization of capability tag memory location

* [gen] Fix memtag generation

Warn instead of failing an assert when a Tag annotation is used on xload
or xstore. That allows the use of "T" in a relaxlist without failure.

* [AArch64 gen] Add an optional annotation modifier

This patch adds the means to modify the implementation of some
annotations without interfering with their nature. The modification is
done by chosing and adding a letter to the annotation. For example, for
AArch64, using the morello variation of LDAR is done by using "Ac"
instead of "A".

* [gen] Add is_addr

* [gen] Add morello

Add capability annotations for tag "Ct" and seal "Cs". Those annotations
correspond to their own Banks, behaving similarly to Ord.

A situation of potential Fault is created when using those annotations
together with DpAddr. The result of the preceding read is used to modify
the address so that it will fault if different from the expected value.

Implement the addition of the optional annotation modifier for morello
capabilities.

gen/AArch64Arch_gen.ml

@@ -31,6 +31,7 @@ module Make
 
 let do_self = C.variant Variant_gen.Self
 let do_tag = C.variant Variant_gen.MemTag
+let do_morello = C.variant Variant_gen.Morello
 open Code
 open Printf
 
@@ -52,16 +53,19 @@ module Mixed =
 (* AArch64 has more atoms that others *)
 let bellatom = false
 type atom_rw =  PP | PL | AP | AL
-type atom_acc = Plain | Acq | AcqPc | Rel | Atomic of atom_rw | Tag
+type atom_acc_opt = Capability
+type atom_acc = Plain of atom_acc_opt option | Acq of atom_acc_opt option
+  | AcqPc of atom_acc_opt option | Rel of atom_acc_opt option
+  | Atomic of atom_rw | Tag | CapaTag | CapaSeal
 type atom = atom_acc * MachMixed.t option
 
 let default_atom = Atomic PP,None
 
 let applies_atom (a,_) d = match a,d with
-| Acq,R
-| AcqPc,R
-| Rel,W
-| (Plain|Atomic _|Tag),(R|W)
+| Acq _,R
+| AcqPc _,R
+| Rel _,W
+| (Plain _|Atomic _|Tag|CapaTag|CapaSeal),(R|W)
   -> true
 | _ -> false
 
@@ -75,20 +79,31 @@ let applies_atom (a,_) d = match a,d with
      | AP -> "A"
      | AL -> "AL"
 
+   let pp_opt = function
+     | None -> ""
+     | Some Capability -> "c"
+
    let pp_atom_acc = function
      | Atomic rw -> sprintf "X%s" (pp_atom_rw rw)
-     | Rel -> "L"
-     | Acq -> "A"
-     | AcqPc -> "Q"
-     | Plain -> "P"
+     | Rel o -> sprintf "L%s" (pp_opt o)
+     | Acq o -> sprintf "A%s" (pp_opt o)
+     | AcqPc o -> sprintf "Q%s" (pp_opt o)
+     | Plain o -> sprintf "P%s" (pp_opt o)
      | Tag -> "T"
+     | CapaTag -> "Ct"
+     | CapaSeal -> "Cs"
 
    let pp_atom (a,m) = match a with
-   | Plain ->
+   | Plain o ->
+      let prefix = match o with
+      | None -> ""
+      | Some Capability -> "Pc" in
        begin
          match m with
-         | None -> ""
-         | Some m -> Mixed.pp_mixed m
+         | None -> prefix
+         | Some m -> if String.length prefix > 0
+           then sprintf "%s.%s" prefix (Mixed.pp_mixed m)
+           else Mixed.pp_mixed m
        end
    | _ ->
      let pp_acc = pp_atom_acc a in
@@ -101,7 +116,7 @@ let applies_atom (a,_) d = match a,d with
 
    let fold_mixed f r =
      Mixed.fold_mixed
-       (fun m r -> f (Plain,Some m) r)
+       (fun m r -> f (Plain None,Some m) r)
        r
 
    let fold_atom_rw f r = f PP (f PL (f AP (f AL r)))
@@ -110,8 +125,22 @@ let applies_atom (a,_) d = match a,d with
      if do_tag then fun f r -> f Tag r
      else fun _f r -> r
 
+   let fold_morello =
+     if do_morello then fun f r -> f CapaSeal (f CapaTag r)
+     else fun _f r -> r
+
    let fold_acc f r =
-     fold_tag f (f Acq (f AcqPc (f Rel (fold_atom_rw (fun rw -> f (Atomic rw)) r))))
+     fold_morello f (
+     fold_tag f (
+     f (Plain (Some Capability)) (
+     f (Acq (Some Capability)) (
+     f (Acq None) (
+     f (AcqPc (Some Capability)) (
+     f (AcqPc None) (
+     f (Rel (Some Capability)) (
+     f (Rel None) (
+     fold_atom_rw (fun rw -> f (Atomic rw)) r)
+     ))))))))
 
    let fold_non_mixed f r = fold_acc (fun acc r -> f (acc,None) r) r
 
@@ -125,25 +154,29 @@ let applies_atom (a,_) d = match a,d with
 
    let worth_final (a,_) = match a with
      | Atomic _ -> true
-     | Acq|AcqPc|Rel|Plain|Tag -> false
+     | Acq _|AcqPc _|Rel _|Plain _|Tag|CapaTag|CapaSeal -> false
 
 
    let varatom_dir _d f r = f None r
 
    let merge_atoms a1 a2 = match a1,a2 with
-   | ((Plain,sz),(a,None))
-   | ((a,None),(Plain,sz)) -> Some (a,sz)
+   | ((Plain None,sz),(a,None))
+   | ((a,None),(Plain None,sz)) -> Some (a,sz)
    | ((a1,None),(a2,sz))
    | ((a1,sz),(a2,None)) when a1=a2 -> Some (a1,sz)
-   | ((Plain,sz1),(a,sz2))
-   | ((a,sz1),(Plain,sz2)) when sz1=sz2 -> Some (a,sz1)
+   | ((Plain None,sz1),(a,sz2))
+   | ((a,sz1),(Plain None,sz2)) when sz1=sz2 -> Some (a,sz1)
    | _,_ ->
        if equal_atom a1 a2 then Some a1 else None
 
    let atom_to_bank = function
    | Tag,None -> Code.Tag
    | Tag,Some _ -> assert false
-   | (Plain|Acq|AcqPc|Rel|Atomic (PP|PL|AP|AL)),_
+   | CapaTag,None -> Code.CapaTag
+   | CapaTag,Some _ -> assert false
+   | CapaSeal,None -> Code.CapaSeal
+   | CapaSeal,Some _ -> assert false
+   | (Plain _|Acq _|AcqPc _|Rel _|Atomic (PP|PL|AP|AL)),_
       -> Code.Ord
 
 (**************)
@@ -161,14 +194,14 @@ let applies_atom (a,_) d = match a,d with
        end)
 
 let overwrite_value v ao w = match ao with
-| None| Some ((Atomic _|Acq|AcqPc|Rel|Plain|Tag),None)
+| None| Some ((Atomic _|Acq _|AcqPc _|Rel _|Plain _|Tag|CapaTag|CapaSeal),None)
   -> w (* total overwrite *)
-| Some ((Atomic _|Acq|AcqPc|Rel|Plain|Tag),Some (sz,o)) ->
+| Some ((Atomic _|Acq _|AcqPc _|Rel _|Plain _|Tag|CapaTag|CapaSeal),Some (sz,o)) ->
     ValsMixed.overwrite_value v sz o w
 
  let extract_value v ao = match ao with
-  | None| Some ((Atomic _|Acq|AcqPc|Rel|Plain|Tag),None) -> v
-  | Some ((Atomic _|Acq|AcqPc|Rel|Plain|Tag),Some (sz,o)) ->
+  | None| Some ((Atomic _|Acq _|AcqPc _|Rel _|Plain _|Tag|CapaTag|CapaSeal),None) -> v
+  | Some ((Atomic _|Acq _|AcqPc _|Rel _|Plain _|Tag|CapaTag|CapaSeal),Some (sz,o)) ->
       ValsMixed.extract_value v sz o
 
 (* End of atoms *)
@@ -277,8 +310,8 @@ let fold_rmw f r =
   r
 
 let applies_atom_rmw rmw ar aw = match rmw,ar,aw with
-| (LrSc|Swp|Cas|LdOp _),(Some (Acq,_)|None),(Some (Rel,_)|None)
-| (StOp _),None,(Some (Rel,_)|None)
+| (LrSc|Swp|Cas|LdOp _),(Some (Acq _,_)|None),(Some (Rel _,_)|None)
+| (StOp _),None,(Some (Rel _,_)|None)
   -> true
 | _ -> false