Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Return to Anil's original Io_page implemention but with some changes …

…in order to be able to allocate contiguous multi-page buffers.
  • Loading branch information...
commit 158c9e669a86984cd18d807f334b12976573006c 1 parent 15b3d0a
@pgj authored
View
69 packages/mirage-platform/lib/io_page.ml
@@ -1,43 +1,60 @@
-(*-
+(*
+ * Copyright (c) 2011-2012 Anil Madhavapeddy <anil@recoil.org>
* 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.
+ * 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.
*)
open Bigarray
type t = (char, int8_unsigned_elt, c_layout) Array1.t
-external alloc_pages: int -> t array = "caml_alloc_pages"
+external alloc_pages: int -> t = "caml_alloc_pages"
let page_size = 4096
-let get () = Array.get (alloc_pages 1) 0
+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
+ for i = 0 to (n_blocks - 1) do
+ Queue.add (alloc_pages pages_per_block) q;
+ 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 = Queue.add p q in
+ Gc.finalise fin block;
+ block
+ with
+ Queue.Empty -> begin
+ alloc ~pages_per_block ~n_blocks:8;
+ inner ()
+ end
+ in
+ inner ()
-let rec get_n = function
+let rec get_n ?(pages_per_block = 1) n = match n with
| 0 -> []
- | n -> get () :: (get_n (n - 1))
+ | n -> get () :: (get_n ~pages_per_block (n - 1))
let sub t off len = Array1.sub t off len
View
4 packages/mirage-platform/lib/io_page.mli
@@ -16,8 +16,8 @@
type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
-val get : unit -> t
-val get_n : int -> t list
+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
View
12 packages/mirage-platform/runtime/kernel/page_stubs.c
@@ -44,8 +44,7 @@ CAMLprim value
caml_alloc_pages(value n_pages)
{
CAMLparam1(n_pages);
- CAMLlocal2(page, result);
- int i;
+ CAMLlocal1(result);
size_t len;
unsigned long block;
@@ -54,12 +53,7 @@ caml_alloc_pages(value n_pages)
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));
- };
+ result = caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT
+ | CAML_BA_MANAGED, 1, (void *) block, (long) PAGE_SIZE * len);
CAMLreturn(result);
}
View
10 packages/mirage-platform/runtime/ocaml/bigarray_stubs.c
@@ -573,6 +573,9 @@ CAMLprim value caml_ba_layout(value vb)
static void caml_ba_finalize(value v)
{
struct caml_ba_array * b = Caml_ba_array_val(v);
+#ifdef _KERNEL
+ int data_size, i;
+#endif
switch (b->flags & CAML_BA_MANAGED_MASK) {
case CAML_BA_EXTERNAL:
@@ -580,7 +583,10 @@ static void caml_ba_finalize(value v)
case CAML_BA_MANAGED:
if (b->proxy == NULL) {
#ifdef _KERNEL
- contigfree(b->data, PAGE_SIZE, M_MIRAGE);
+ data_size = 0;
+ for (i = 0; i < b->num_dims; i++)
+ data_size += b->dim[i];
+ contigfree(b->data, data_size, M_MIRAGE);
#else
free(b->data);
#endif
@@ -589,7 +595,7 @@ static void caml_ba_finalize(value v)
(int) b->proxy->refcount, 0, 0, 0);
if (-- b->proxy->refcount == 0) {
#ifdef _KERNEL
- contigfree(b->proxy->data, PAGE_SIZE, M_MIRAGE);
+ contigfree(b->proxy->data, b->proxy->size, M_MIRAGE);
#else
free(b->proxy->data);
#endif
View
12 packages/mirage-test/regress/perf/io_page.ml
@@ -10,17 +10,17 @@ let with_time i label fn =
let main () =
Random.self_init ();
- let page_size = 4096 in
- let sizes = [ 1; 2; 4; 8; 16; 32; 64; 128; 256; 512 ] in
+ let sizes = [ 1; 2; 4; 8; 16; 32; 64; 128 ] in
List.iter (fun sz ->
with_time sz sz (fun () ->
- for i = 0 to 1000 do
- let ts = OS.Io_page.get_n sz in
- for j = 0 to (sz * 100) do
+ for i = 0 to 10000 do
+ let p = OS.Io_page.get ~pages_per_block:sz () in
+ let page_size = OS.Io_page.length p in
+ for j = 0 to (sz * 10) do
let off = Random.int page_size in
let len = Random.int (page_size - off) in
let k = Random.int sz in
- let _ = OS.Io_page.sub (List.nth ts k) off len in
+ let _ = OS.Io_page.sub p off len in
()
done;
done;
Please sign in to comment.
Something went wrong with that request. Please try again.