]> xenbits.xensource.com Git - xen.git/commitdiff
ocaml: add mmap bindings implementation.
authorKeir Fraser <keir.fraser@citrix.com>
Thu, 6 May 2010 10:01:31 +0000 (11:01 +0100)
committerKeir Fraser <keir.fraser@citrix.com>
Thu, 6 May 2010 10:01:31 +0000 (11:01 +0100)
This is quite similar to the mmap functionality available in bigarray
but it's less complicated.

Signed-off-by: Vincent Hanquez <vincent.hanquez@eu.citrix.com>
tools/ocaml/libs/mmap/META.in [new file with mode: 0644]
tools/ocaml/libs/mmap/Makefile [new file with mode: 0644]
tools/ocaml/libs/mmap/mmap.ml [new file with mode: 0644]
tools/ocaml/libs/mmap/mmap.mli [new file with mode: 0644]
tools/ocaml/libs/mmap/mmap_stubs.c [new file with mode: 0644]
tools/ocaml/libs/mmap/mmap_stubs.h [new file with mode: 0644]

diff --git a/tools/ocaml/libs/mmap/META.in b/tools/ocaml/libs/mmap/META.in
new file mode 100644 (file)
index 0000000..1d71548
--- /dev/null
@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "Mmap interface extension"
+archive(byte) = "mmap.cma"
+archive(native) = "mmap.cmxa"
diff --git a/tools/ocaml/libs/mmap/Makefile b/tools/ocaml/libs/mmap/Makefile
new file mode 100644 (file)
index 0000000..bd8ab43
--- /dev/null
@@ -0,0 +1,27 @@
+TOPLEVEL=../..
+include $(TOPLEVEL)/common.make
+
+OBJS = mmap
+INTF = $(foreach obj, $(OBJS),$(obj).cmi)
+LIBS = mmap.cma mmap.cmxa
+
+all: $(INTF) $(LIBS) $(PROGRAMS)
+
+bins: $(PROGRAMS)
+
+libs: $(LIBS)
+
+mmap_OBJS = $(OBJS)
+mmap_C_OBJS = mmap_stubs
+OCAML_LIBRARY = mmap
+
+.PHONY: install
+install: $(LIBS) META
+       ocamlfind install -destdir $(DESTDIR)$(shell ocamlfind printconf destdir) -ldconf ignore mmap META $(INTF) $(LIBS) *.a *.so *.cmx
+
+.PHONY: uninstall
+uninstall:
+       ocamlfind remove mmap
+
+include $(TOPLEVEL)/Makefile.rules
+
diff --git a/tools/ocaml/libs/mmap/mmap.ml b/tools/ocaml/libs/mmap/mmap.ml
new file mode 100644 (file)
index 0000000..44b67c8
--- /dev/null
@@ -0,0 +1,31 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type mmap_interface
+
+type mmap_prot_flag = RDONLY | WRONLY | RDWR
+type mmap_map_flag = SHARED | PRIVATE
+
+(* mmap: fd -> prot_flag -> map_flag -> length -> offset -> interface *)
+external mmap: Unix.file_descr -> mmap_prot_flag -> mmap_map_flag
+               -> int -> int -> mmap_interface = "stub_mmap_init"
+external unmap: mmap_interface -> unit = "stub_mmap_final"
+(* read: interface -> start -> length -> data *)
+external read: mmap_interface -> int -> int -> string = "stub_mmap_read"
+(* write: interface -> data -> start -> length -> unit *)
+external write: mmap_interface -> string -> int -> int -> unit = "stub_mmap_write"
+(* getpagesize: unit -> size of page *)
+external getpagesize: unit -> int = "stub_mmap_getpagesize"
diff --git a/tools/ocaml/libs/mmap/mmap.mli b/tools/ocaml/libs/mmap/mmap.mli
new file mode 100644 (file)
index 0000000..8f92ed6
--- /dev/null
@@ -0,0 +1,28 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type mmap_interface
+type mmap_prot_flag = RDONLY | WRONLY | RDWR
+type mmap_map_flag = SHARED | PRIVATE
+
+external mmap : Unix.file_descr -> mmap_prot_flag -> mmap_map_flag -> int -> int
+             -> mmap_interface = "stub_mmap_init"
+external unmap : mmap_interface -> unit = "stub_mmap_final"
+external read : mmap_interface -> int -> int -> string = "stub_mmap_read"
+external write : mmap_interface -> string -> int -> int -> unit
+               = "stub_mmap_write"
+
+external getpagesize : unit -> int = "stub_mmap_getpagesize"
diff --git a/tools/ocaml/libs/mmap/mmap_stubs.c b/tools/ocaml/libs/mmap/mmap_stubs.c
new file mode 100644 (file)
index 0000000..e32cef6
--- /dev/null
@@ -0,0 +1,136 @@
+/*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#include <unistd.h>
+#include <stdlib.h>
+#include <sys/mman.h>
+#include <string.h>
+#include <errno.h>
+#include "mmap_stubs.h"
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+
+#define GET_C_STRUCT(a) ((struct mmap_interface *) a)
+
+static int mmap_interface_init(struct mmap_interface *intf,
+                               int fd, int pflag, int mflag,
+                               int len, int offset)
+{
+       intf->len = len;
+       intf->addr = mmap(NULL, len, pflag, mflag, fd, offset);
+       return (intf->addr == MAP_FAILED) ? errno : 0;
+}
+
+CAMLprim value stub_mmap_init(value fd, value pflag, value mflag,
+                              value len, value offset)
+{
+       CAMLparam5(fd, pflag, mflag, len, offset);
+       CAMLlocal1(result);
+       int c_pflag, c_mflag;
+
+       switch (Int_val(pflag)) {
+       case 0: c_pflag = PROT_READ; break;
+       case 1: c_pflag = PROT_WRITE; break;
+       case 2: c_pflag = PROT_READ|PROT_WRITE; break;
+       default: caml_invalid_argument("protectiontype");
+       }
+
+       switch (Int_val(mflag)) {
+       case 0: c_mflag = MAP_SHARED; break;
+       case 1: c_mflag = MAP_PRIVATE; break;
+       default: caml_invalid_argument("maptype");
+       }
+
+       result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);
+
+       if (mmap_interface_init(GET_C_STRUCT(result), Int_val(fd),
+                               c_pflag, c_mflag,
+                               Int_val(len), Int_val(offset)))
+               caml_failwith("mmap");
+       CAMLreturn(result);
+}
+
+CAMLprim value stub_mmap_final(value interface)
+{
+       CAMLparam1(interface);
+       struct mmap_interface *intf;
+
+       intf = GET_C_STRUCT(interface);
+       if (intf->addr != MAP_FAILED)
+               munmap(intf->addr, intf->len);
+       intf->addr = MAP_FAILED;
+
+       CAMLreturn(Val_unit);
+}
+
+CAMLprim value stub_mmap_read(value interface, value start, value len)
+{
+       CAMLparam3(interface, start, len);
+       CAMLlocal1(data);
+       struct mmap_interface *intf;
+       int c_start;
+       int c_len;
+
+       c_start = Int_val(start);
+       c_len = Int_val(len);
+       intf = GET_C_STRUCT(interface);
+
+       if (c_start > intf->len)
+               caml_invalid_argument("start invalid");
+       if (c_start + c_len > intf->len)
+               caml_invalid_argument("len invalid");
+
+       data = caml_alloc_string(c_len);
+       memcpy((char *) data, intf->addr + c_start, c_len);
+
+       CAMLreturn(data);
+}
+
+CAMLprim value stub_mmap_write(value interface, value data,
+                               value start, value len)
+{
+       CAMLparam4(interface, data, start, len);
+       struct mmap_interface *intf;
+       int c_start;
+       int c_len;
+
+       c_start = Int_val(start);
+       c_len = Int_val(len);
+       intf = GET_C_STRUCT(interface);
+
+       if (c_start > intf->len)
+               caml_invalid_argument("start invalid");
+       if (c_start + c_len > intf->len)
+               caml_invalid_argument("len invalid");
+
+       memcpy(intf->addr + c_start, (char *) data, c_len);
+
+       CAMLreturn(Val_unit);
+}
+
+CAMLprim value stub_mmap_getpagesize(value unit)
+{
+       CAMLparam1(unit);
+       CAMLlocal1(data);
+
+       data = Val_int(getpagesize());
+       CAMLreturn(data);
+}
diff --git a/tools/ocaml/libs/mmap/mmap_stubs.h b/tools/ocaml/libs/mmap/mmap_stubs.h
new file mode 100644 (file)
index 0000000..65e4239
--- /dev/null
@@ -0,0 +1,33 @@
+/*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#ifndef C_MMAP_H
+#define C_MMAP_H
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+
+struct mmap_interface
+{
+       void *addr;
+       int len;
+};
+
+#endif