Add Raspberry Pi 4 target

lib/mirage/impl/mirage_impl_block.ml

@@ -63,6 +63,8 @@ let block_conf file =
         (* XXX For now, on Solo5, just pass the "file" name through directly as
          * the Solo5 block device name *)
         file
+    | #Mirage_key.mode_rpi4 ->
+        Fmt.failwith "Block device is not implemented for RPi4"
   in
   let packages_v =
     Key.match_ Key.(value target) @@ function
@@ -71,6 +73,7 @@ let block_conf file =
         [ package ~min:"0.6.1" ~max:"0.7.0" "mirage-block-solo5" ]
     | #Mirage_key.mode_unix ->
         [ package ~min:"2.12.0" ~max:"3.0.0" "mirage-block-unix" ]
+    | #Mirage_key.mode_rpi4 -> []
   in
   let configure _ =
     let (_ : block_t) = make_block_t file in

lib/mirage/impl/mirage_impl_console.ml

@@ -18,6 +18,11 @@ let console_solo5 str =
   let packages = [ package ~min:"0.6.1" ~max:"0.7.0" "mirage-console-solo5" ] in
   impl ~packages ~connect:(connect str) "Console_solo5" console
 
+let console_rpi4 =
+  let packages = [ package "mirage-console-gilbraltar" ] in
+  let connect _ modname _ = Fmt.str "%s.connect ()" modname in
+  impl ~packages ~connect "Console_gilbraltar" console
+
 let custom_console str =
   match_impl
     Key.(value target)
@@ -29,6 +34,7 @@ let custom_console str =
       (`Spt, console_solo5 str);
       (`Muen, console_solo5 str);
       (`Genode, console_solo5 str);
+      (`RPi4, console_rpi4);
     ]
     ~default:(console_unix str)
 

lib/mirage/impl/mirage_impl_mclock.ml

@@ -1,13 +1,31 @@
 open Functoria
+module Key = Mirage_key
 
 type mclock = MCLOCK
 
 let mclock = Type.v MCLOCK
 
-let default_monotonic_clock =
-  let packages_v =
-    Mirage_key.(if_ is_unix)
-      [ package ~min:"3.0.0" ~max:"4.0.0" "mirage-clock-unix" ]
-      [ package ~min:"3.1.0" ~max:"4.0.0" "mirage-clock-freestanding" ]
+let unix_monotonic_clock =
+  let packages = [ package ~min:"3.0.0" ~max:"4.0.0" "mirage-clock-unix" ] in
+  impl ~packages "Mclock" mclock
+
+let freestanding_monotonic_clock =
+  let packages =
+    [ package ~min:"3.1.0" ~max:"4.0.0" "mirage-clock-freestanding" ]
   in
-  impl ~packages_v "Mclock" mclock
+  impl ~packages "Mclock" mclock
+
+let default_monotonic_clock =
+  match_impl
+    Key.(value target)
+    [
+      (`Unix, unix_monotonic_clock);
+      (`Qubes, freestanding_monotonic_clock);
+      (`Virtio, freestanding_monotonic_clock);
+      (`Hvt, freestanding_monotonic_clock);
+      (`Spt, freestanding_monotonic_clock);
+      (`Muen, freestanding_monotonic_clock);
+      (`Genode, freestanding_monotonic_clock);
+      (* TODO(dinosaure): RPi4 *)
+    ]
+    ~default:unix_monotonic_clock

lib/mirage/impl/mirage_impl_network.ml

@@ -21,6 +21,7 @@ let network_conf (intf : string Key.key) =
         ]
     | #Mirage_key.mode_solo5 ->
         [ package ~min:"0.6.1" ~max:"0.7.0" "mirage-net-solo5" ]
+    | #Mirage_key.mode_rpi4 -> []
   in
   let connect _ modname _ =
     (* @samoht: why not just use the args paramater? *)

lib/mirage/impl/mirage_impl_tracing.ml

@@ -23,11 +23,14 @@ let mprof_trace ~size () =
           package ~max:"1.0.0" "mirage-profile";
           package ~max:"1.0.0" "mirage-profile-unix";
         ]
+    | #Mirage_key.mode_rpi4 -> []
   in
   let connect i _ _ =
     match get_target i with
     | #Mirage_key.mode_solo5 ->
         failwith "tracing is not currently implemented for solo5 targets"
+    | #Mirage_key.mode_rpi4 ->
+        failwith "tracing is not currently implemented for rpi4 targets"
     | #Mirage_key.mode_unix ->
         Fmt.str
           "Lwt.return ())@.let () = (@ @[<v 2> let buffer = \

lib/mirage/mirage_key.ml

@@ -65,7 +65,8 @@ let pp_group = Fmt.(option ~none:(any "the unikernel") @@ fmt "the %s group")
 type mode_unix = [ `Unix | `MacOSX ]
 type mode_xen = [ `Xen | `Qubes ]
 type mode_solo5 = [ `Hvt | `Spt | `Virtio | `Muen | `Genode ]
-type mode = [ mode_unix | mode_xen | mode_solo5 ]
+type mode_rpi4 = [ `RPi4 ]
+type mode = [ mode_unix | mode_xen | mode_solo5 | mode_rpi4 ]
 
 let first_ukvm_mention = ref true
 
@@ -87,6 +88,7 @@ let target_conv : mode Cmdliner.Arg.converter =
         ("qubes", `Qubes);
         ("genode", `Genode);
         ("spt", `Spt);
+        ("rpi4", `RPi4);
       ]
   in
   let filter_ukvm s =
@@ -112,6 +114,7 @@ let target_serialize ppf = function
   | `Qubes -> Fmt.pf ppf "`Qubes"
   | `Genode -> Fmt.pf ppf "`Genode"
   | `Spt -> Fmt.pf ppf "`Spt"
+  | `RPi4 -> Fmt.pf ppf "`RPi4"
 
 let pp_target fmt m = snd target_conv fmt m
 
@@ -144,17 +147,17 @@ let target =
 let is_unix =
   Key.match_ Key.(value target) @@ function
   | #mode_unix -> true
-  | #mode_xen | #mode_solo5 -> false
+  | #mode_xen | #mode_solo5 | #mode_rpi4 -> false
 
 let is_solo5 =
   Key.match_ Key.(value target) @@ function
   | #mode_solo5 -> true
-  | #mode_xen | #mode_unix -> false
+  | #mode_xen | #mode_unix | #mode_rpi4 -> false
 
 let is_xen =
   Key.match_ Key.(value target) @@ function
   | #mode_xen -> true
-  | #mode_solo5 | #mode_unix -> false
+  | #mode_solo5 | #mode_unix | #mode_rpi4 -> false
 
 let warn_error =
   let doc = "Enable -warn-error when compiling OCaml sources." in

lib/mirage/mirage_key.mli

@@ -37,7 +37,8 @@ val abstract : 'a key -> t [@@ocaml.deprecated "Use Mirage.Key.v."]
 type mode_unix = [ `Unix | `MacOSX ]
 type mode_xen = [ `Xen | `Qubes ]
 type mode_solo5 = [ `Hvt | `Spt | `Virtio | `Muen | `Genode ]
-type mode = [ mode_unix | mode_xen | mode_solo5 ]
+type mode_rpi4 = [ `RPi4 ]
+type mode = [ mode_unix | mode_xen | mode_solo5 | mode_rpi4 ]
 
 (** {2 Mirage keys} *)
 

lib/mirage/target/mirage_target.ml

@@ -4,6 +4,7 @@ module Key = Mirage_key
 let choose : Key.mode -> (module S.TARGET) = function
   | #Solo5.t -> (module Solo5)
   | #Unix.t -> (module Unix)
+  | #RPi4.t -> (module RPi4)
 
 let dune i =
   let target = Info.get i Key.target in

lib/mirage/target/rPi4.ml

@@ -0,0 +1,100 @@
+open Functoria
+module Key = Mirage_key
+
+type t = [ `RPi4 ]
+
+let cast = function #t as t -> t | _ -> invalid_arg "not a rpi4 target."
+
+let build_packages =
+  [ Functoria.package ~scope:`Switch ~build:true "gilbraltar"
+  ; Functoria.package ~scope:`Switch ~build:true "gilbraltar-toolchain" ]
+
+let runtime_packages target =
+  match target with
+  | `RPi4 -> [ Functoria.package "mirage-gilbraltar" ]
+  | _ -> invalid_arg "It's not a RPi 4 target."
+
+let packages target = build_packages @ runtime_packages target
+
+let context_name i =
+  let target = Info.get i Key.target in
+  Fmt.str "mirage-%a" Key.pp_target target
+
+let build_context ?build_dir:_ i =
+  let profile_release = Dune.stanza "(profile release)" in
+  let build_context =
+    Dune.stanzaf
+      {dune|
+(context
+ (default
+  (name %s)
+  (host default)
+  (toolchain rpi4)
+  (disable_dynamically_linked_foreign_archives true)))
+|dune}
+      (context_name i)
+  in
+  [ profile_release; build_context ]
+
+let configure i =
+  let target = Info.get i Key.target in
+  match target with `RPi4 -> Action.ok () | _ -> assert false
+
+let out i =
+  let public_name =
+    match Info.output i with None -> Info.name i | Some o -> o
+  in
+  public_name ^ ".elf"
+
+let main info = Fpath.(base (rem_ext (Info.main info)))
+
+let rename info =
+  let out = out info in
+  let main = Fpath.to_string (main info) in
+  Dune.stanzaf
+    {dune|
+(rule
+ (target %s)
+ (enabled_if (= %%{context_name} "%s"))
+ (deps %s.exe)
+ (action
+  (copy %s.exe %%{target})))
+|dune}
+    out (context_name info) main main
+
+let alias_override info =
+  Dune.stanzaf
+    {dune|
+(alias
+ (name default)
+ (enabled_if (= %%{context_name} "%s"))
+ (deps (alias_rec all)))
+|dune}
+    (context_name info)
+
+let main i =
+  let libraries = Info.libraries i in
+  let flags = Mirage_dune.flags i in
+  let main = Fpath.(to_string (base (rem_ext (Info.main i)))) in
+  Dune.stanzaf
+    {dune|
+(executable
+ (enabled_if (= %%{context_name} "%s"))
+ (name %s)
+ (modes (native exe))
+ (libraries %a)
+ (link_flags %a -cclib "-z rpi4-abi=rpi4")
+ (modules (:standard \ config)))
+|dune}
+    (context_name i) main
+    (Dune.compact_list "libraries")
+    libraries
+    (Dune.compact_list "link_flags")
+    flags
+
+let dune info = [ main info; rename info; alias_override info ]
+
+let install info =
+  let out = out info in
+  let open Fpath in
+  Install.v ~bin:[ (v out, v out) ] ()