ocaml: add mmap bindings implementation.

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

@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "Mmap interface extension"
+archive(byte) = "mmap.cma"
+archive(native) = "mmap.cmxa"

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
+

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"

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"

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);
+}

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