[PATCH 01/10] add ocaml mmap bindings implementation.

[Vincent Hanquez <vincent.hanquez@eu.citrix.com>]

[-- Attachment #1: Type: text/plain, Size: 883 bytes --]


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      |    4 +
 tools/ocaml/libs/mmap/Makefile     |   27 +++++++
 tools/ocaml/libs/mmap/mmap.ml      |   31 ++++++++
 tools/ocaml/libs/mmap/mmap.mli     |   28 ++++++++
 tools/ocaml/libs/mmap/mmap_stubs.c |  136 ++++++++++++++++++++++++++++++++++++
 tools/ocaml/libs/mmap/mmap_stubs.h |   33 +++++++++
 6 files changed, 259 insertions(+), 0 deletions(-)
 create mode 100644 tools/ocaml/libs/mmap/META.in
 create mode 100644 tools/ocaml/libs/mmap/Makefile
 create mode 100644 tools/ocaml/libs/mmap/mmap.ml
 create mode 100644 tools/ocaml/libs/mmap/mmap.mli
 create mode 100644 tools/ocaml/libs/mmap/mmap_stubs.c
 create mode 100644 tools/ocaml/libs/mmap/mmap_stubs.h


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-add-ocaml-mmap-bindings-implementation.patch --]
[-- Type: text/x-patch; name="0001-add-ocaml-mmap-bindings-implementation.patch", Size: 9470 bytes --]

diff --git a/tools/ocaml/libs/mmap/META.in b/tools/ocaml/libs/mmap/META.in
new file mode 100644
index 0000000..1d71548
--- /dev/null
+++ b/tools/ocaml/libs/mmap/META.in
@@ -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
index 0000000..bd8ab43
--- /dev/null
+++ b/tools/ocaml/libs/mmap/Makefile
@@ -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
index 0000000..44b67c8
--- /dev/null
+++ b/tools/ocaml/libs/mmap/mmap.ml
@@ -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
index 0000000..8f92ed6
--- /dev/null
+++ b/tools/ocaml/libs/mmap/mmap.mli
@@ -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
index 0000000..e32cef6
--- /dev/null
+++ b/tools/ocaml/libs/mmap/mmap_stubs.c
@@ -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
index 0000000..65e4239
--- /dev/null
+++ b/tools/ocaml/libs/mmap/mmap_stubs.h
@@ -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

[-- Attachment #3: Type: text/plain, Size: 138 bytes --]

_______________________________________________
Xen-devel mailing list
Xen-devel@lists.xensource.com
http://lists.xensource.com/xen-devel