Permalink
Browse files

Implement Io_page and add a skeleton for Netif (as a consumer) togeth…

…er with a simple test (basic/netif).
  • Loading branch information...
1 parent 6388ddb commit 3f1245f1feb0298789839b642c0fee9ff61cabbe @pgj committed Aug 7, 2012
View
3 packages/mirage-platform/Makefile
@@ -3,7 +3,8 @@ LIBNAME= mirage-platform
SRCS!= ls lib/*.ml
MLLIB= lib/oS.cmxa lib/oS.a lib/oS.cmx lib/oS.cmi
-COBJS= runtime/kernel/clock_stubs.o runtime/kernel/kmod.o runtime/ocaml/libocaml.a
+COBJS= runtime/kernel/page_stubs.o runtime/kernel/clock_stubs.o \
+ runtime/kernel/kmod.o runtime/ocaml/libocaml.a
PWD!= pwd
View
2 packages/mirage-platform/_tags
@@ -1,3 +1,3 @@
-<lib/*>: for-pack(OS), use_syntax, use_custom_stdlib, use_lwt_syntax
+<lib/*>: for-pack(OS), use_syntax, use_custom_stdlib, use_lwt_syntax, use_cstruct
<syntax/*>: build_syntax
true: camlp4of
View
84 packages/mirage-platform/lib/io_page.ml
@@ -0,0 +1,84 @@
+(*
+ * Copyright (c) 2011 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+
+type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+external alloc_pages: int -> t array = "caml_alloc_pages"
+
+(* pages_per_block -> queue of free blocks *)
+let free_lists = Hashtbl.create 10
+
+let get_free_list pages_per_block : t Queue.t =
+ if not(Hashtbl.mem free_lists pages_per_block)
+ then Hashtbl.add free_lists pages_per_block (Queue.create ());
+ Hashtbl.find free_lists pages_per_block
+
+let alloc ~pages_per_block ~n_blocks =
+ let q = get_free_list pages_per_block in
+ Printf.printf "alloc pages_per_block=%d n_blocks=%d" pages_per_block n_blocks;
+ for i = 0 to n_blocks - 1 do
+ Array.iter (fun x -> Queue.add x q) (alloc_pages pages_per_block);
+ done
+
+let get ?(pages_per_block=1) () =
+ let q = get_free_list pages_per_block in
+ let rec inner () =
+ try
+ let block = Queue.pop q in
+ let fin p =
+(* Printf.printf "block finalise\n%!"; *)
+ Queue.add p q
+ in
+ Gc.finalise fin block;
+ block
+ with Queue.Empty -> begin
+ alloc ~pages_per_block ~n_blocks:128;
+ inner ()
+ end in
+ inner ()
+
+let rec get_n ?(pages_per_block=1) n = match n with
+ | 0 -> []
+ | n -> get () :: (get_n ~pages_per_block (n - 1))
+
+let sub t off len = Bigarray.Array1.sub t off len
+
+let length t = Bigarray.Array1.dim t
+
+let page_size = 4096
+
+let to_pages t =
+ assert(length t mod page_size = 0);
+ let rec loop off acc =
+ if off < (length t)
+ then loop (off + page_size) (sub t off page_size :: acc)
+ else acc in
+ List.rev (loop 0 [])
+
+let string_blit src t =
+ for i = 0 to String.length src - 1 do
+ t.{i} <- src.[i]
+ done
+
+let to_string t =
+ let result = String.create (length t) in
+ for i = 0 to length t - 1 do
+ result.[i] <- t.{i}
+ done;
+ result
+
+let blit src dest = Bigarray.Array1.blit src dest
View
31 packages/mirage-platform/lib/io_page.mli
@@ -0,0 +1,31 @@
+(*
+ * Copyright (c) 2011-2012 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+val get : ?pages_per_block:int -> unit -> t
+val get_n : ?pages_per_block:int -> int -> t list
+
+val sub : t -> int -> int -> t
+val length : t -> int
+
+val to_pages : t -> t list
+
+val string_blit : string -> t -> unit
+
+val to_string : t -> string
+
+val blit : t -> t -> unit
View
79 packages/mirage-platform/lib/netif.ml
@@ -0,0 +1,79 @@
+(*-
+ * Copyright (c) 2012 Gabor Pali
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ *)
+
+open Lwt
+open Printf
+
+
+type t = {
+ backend_id : int;
+ backend : string;
+}
+
+type id = string
+
+let plug id =
+ Console.log (sprintf "Netif.plug %s: not implemented yet" id);
+ lwt backend_id = return 0 in
+ lwt backend = return id in
+ let t = { backend_id; backend } in
+ return t
+
+let unplug id =
+ Console.log (sprintf "Netif.unplug %s: not implemented yet" id);
+ ()
+
+let create fn =
+ Console.log (sprintf "Netif.create: not implemented yet");
+ return ()
+
+let write nf page =
+ Console.log (sprintf "Netif.write %s: not implemented yet" nf.backend);
+ return ()
+
+let writev nf pages =
+ Console.log (sprintf "Netif.writev %s: not implemented yet" nf.backend);
+ return ()
+
+let listen nf fn =
+ Console.log (sprintf "Netif.listen %s: not implemented yet" nf.backend);
+ return ()
+
+let enumerate () =
+ Console.log (sprintf "Netif.enumerate: not implemented yet");
+ return []
+
+let mac nf =
+ Console.log (sprintf "Netif.mac %s: not implemented yet" nf.backend);
+ ""
+
+let ethid nf =
+ string_of_int nf.backend_id
+
+let get_writebuf nf =
+ let page = Io_page.get() in
+ return page
View
60 packages/mirage-platform/lib/netif.mli
@@ -0,0 +1,60 @@
+(*
+ * Copyright (c) 2011 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** kFreeBSD Netfront interface for Ethernet I/O *)
+
+(** Type of a single netfront interface *)
+type t
+
+(** Textual id which is unique per netfront interface *)
+type id = string
+
+(** Create a hotplug interface that will spawn a new thread
+ per network interface.
+
+ @param fn Callback function that is invoked for every new netfront
+ interface.
+ @return Blocking thread that will unplug all the attached interfaces
+ if cancelled.
+ *)
+val create : (id -> t -> unit Lwt.t) -> unit Lwt.t
+
+(** Manually plug in a new network interface. Normally automatically invoked by
+ the create function *)
+val plug: id -> t Lwt.t
+
+(** Manually unplug a network interface. This makes an effort not to block, so
+ the unplugging is not guaranteed *)
+val unplug: id -> unit
+
+(** Output an Io_page to an interface *)
+val write : t -> Io_page.t -> unit Lwt.t
+
+(** Output a list of Io_pages to an interface as a single packet *)
+val writev : t -> Io_page.t list -> unit Lwt.t
+
+(** Listen endlesses on a Netfront, and invoke the callback function as frames are
+ received. *)
+val listen : t -> (Io_page.t -> unit Lwt.t) -> unit Lwt.t
+
+(** Enumerate all the currently available Netfronts (which may or may not be attached) *)
+val enumerate : unit -> id list Lwt.t
+
+(** Return the MAC address of the Netfront *)
+val ethid : t -> string
+val mac : t -> string
+
+val get_writebuf : t -> Io_page.t Lwt.t
View
6 packages/mirage-platform/lib/oS.mlpack
@@ -1,4 +1,6 @@
-Main
-Console
Clock
+Console
+Io_page
+Main
+Netif
Time
View
62 packages/mirage-platform/runtime/kernel/page_stubs.c
@@ -0,0 +1,62 @@
+/*-
+ * Copyright (c) 2012 Gabor Pali
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ */
+
+#include <sys/types.h>
+#include <sys/malloc.h>
+
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/bigarray.h"
+
+CAMLprim value caml_alloc_pages(value n_pages);
+
+CAMLprim value
+caml_alloc_pages(value n_pages)
+{
+ CAMLparam1(n_pages);
+ CAMLlocal2(page, result);
+ int i;
+ size_t len;
+ unsigned long block;
+
+ len = Int_val(n_pages);
+ block = (unsigned long) contigmalloc(PAGE_SIZE * len, M_MIRAGE,
+ M_NOWAIT, 0, 0xffffffff, PAGE_SIZE, 0ul);
+ if (block == 0)
+ caml_failwith("contigmalloc");
+ result = caml_alloc(len, 0);
+ for (i = 0; i < len; i++) {
+ page = caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT
+ | CAML_BA_MANAGED, 1, (void *) block, (long) PAGE_SIZE);
+ Store_field(result, i, page);
+ block += (PAGE_SIZE / sizeof(unsigned long));
+ };
+ CAMLreturn(result);
+}
View
12 packages/mirage-platform/runtime/ocaml/bigarray_stubs.c
@@ -568,10 +568,18 @@ static void caml_ba_finalize(value v)
break;
case CAML_BA_MANAGED:
if (b->proxy == NULL) {
- __free(b->data);
+#ifdef _KERNEL
+ contigfree(b->data, PAGE_SIZE, M_MIRAGE);
+#else
+ free(b->data);
+#endif
} else {
if (-- b->proxy->refcount == 0) {
- __free(b->proxy->data);
+#ifdef _KERNEL
+ contigfree(b->proxy->data, PAGE_SIZE, M_MIRAGE);
+#else
+ free(b->proxy->data);
+#endif
caml_stat_free(b->proxy);
}
}
View
5 packages/mirage-test/regress/Makefile
@@ -18,6 +18,11 @@ basic/exception:
echo "let _ = OS.Main.run (Exception.main ())" > main.ml
${MAKE} -f Makefile.kmod SRCS=exception.ml KMOD=mirage-basic-exception
+basic/netif:
+ ln -sf basic/netif.ml .
+ echo "let _ = OS.Main.run (Netif.main ())" > main.ml
+ ${MAKE} -f Makefile.kmod SRCS=netif.ml KMOD=mirage-basic-netif
+
basic/sleep:
ln -sf basic/sleep.ml .
echo "let _ = OS.Main.run (Sleep.main ())" > main.ml
View
17 packages/mirage-test/regress/basic/netif.ml
@@ -0,0 +1,17 @@
+open Lwt
+open Printf
+
+let main () =
+ lwt t = OS.Netif.create
+ (fun id netif ->
+ eprintf "netif open %s\n%!" id;
+ lwt () = OS.Time.sleep 1000000 in
+ OS.Netif.listen netif
+ (fun page ->
+ eprintf "incoming %d\n%!" (Cstruct.len page);
+ return ()
+ )
+ )
+ in
+ eprintf "netif thread done\n%!";
+ return ()
View
2 packages/myocamlbuild.ml
@@ -28,6 +28,8 @@ dispatch begin function
(S[A "-I"; A "+camlp4"]);
flag ["compile"; "use_custom_stdlib"]
(S[A "-nostdlib"; A "-I"; A (query "mirage-stdlib")]);
+ flag ["compile"; "use_cstruct"]
+ (S[A "-I"; A (query "cstruct")]);
flag ["ocaml"; "pp"; "use_lwt_syntax"]
(S[A "-I"; A (query "lwt"); A "lwt-syntax-options.cma"; A "lwt-syntax.cma"]);
| _ -> ()

0 comments on commit 3f1245f

Please sign in to comment.