WARNING - OLD ARCHIVES

This is an archived copy of the Xen.org mailing list, which we have preserved to ensure that existing links to archives are not broken. The live archive, which contains the latest emails, can be found at http://lists.xen.org/
   
 
 
Xen 
 
Home Products Support Community News
 
   
 

xen-changelog

[Xen-changelog] [xen-unstable] ocaml: add mmap bindings implementation.

To: xen-changelog@xxxxxxxxxxxxxxxxxxx
Subject: [Xen-changelog] [xen-unstable] ocaml: add mmap bindings implementation.
From: Xen patchbot-unstable <patchbot-unstable@xxxxxxxxxxxxxxxxxxx>
Date: Thu, 06 May 2010 04:10:25 -0700
Delivery-date: Thu, 06 May 2010 04:17:05 -0700
Envelope-to: www-data@xxxxxxxxxxxxxxxxxxx
List-help: <mailto:xen-changelog-request@lists.xensource.com?subject=help>
List-id: BK change log <xen-changelog.lists.xensource.com>
List-post: <mailto:xen-changelog@lists.xensource.com>
List-subscribe: <http://lists.xensource.com/mailman/listinfo/xen-changelog>, <mailto:xen-changelog-request@lists.xensource.com?subject=subscribe>
List-unsubscribe: <http://lists.xensource.com/mailman/listinfo/xen-changelog>, <mailto:xen-changelog-request@lists.xensource.com?subject=unsubscribe>
Reply-to: xen-devel@xxxxxxxxxxxxxxxxxxx
Sender: xen-changelog-bounces@xxxxxxxxxxxxxxxxxxx
# HG changeset patch
# User Keir Fraser <keir.fraser@xxxxxxxxxx>
# Date 1273140091 -3600
# Node ID f8a3979d05522b47a5cc733ae0bf6f62397ea89e
# Parent  65ad65a113bc95e36badbf8b78f9c292b95644d2
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@xxxxxxxxxxxxx>
---
 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(+)

diff -r 65ad65a113bc -r f8a3979d0552 tools/ocaml/libs/mmap/META.in
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/mmap/META.in     Thu May 06 11:01:31 2010 +0100
@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "Mmap interface extension"
+archive(byte) = "mmap.cma"
+archive(native) = "mmap.cmxa"
diff -r 65ad65a113bc -r f8a3979d0552 tools/ocaml/libs/mmap/Makefile
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/mmap/Makefile    Thu May 06 11:01:31 2010 +0100
@@ -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 -r 65ad65a113bc -r f8a3979d0552 tools/ocaml/libs/mmap/mmap.ml
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/mmap/mmap.ml     Thu May 06 11:01:31 2010 +0100
@@ -0,0 +1,31 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * 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 -r 65ad65a113bc -r f8a3979d0552 tools/ocaml/libs/mmap/mmap.mli
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/mmap/mmap.mli    Thu May 06 11:01:31 2010 +0100
@@ -0,0 +1,28 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * 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 -r 65ad65a113bc -r f8a3979d0552 tools/ocaml/libs/mmap/mmap_stubs.c
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/mmap/mmap_stubs.c        Thu May 06 11:01:31 2010 +0100
@@ -0,0 +1,136 @@
+/*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * 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 -r 65ad65a113bc -r f8a3979d0552 tools/ocaml/libs/mmap/mmap_stubs.h
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/mmap/mmap_stubs.h        Thu May 06 11:01:31 2010 +0100
@@ -0,0 +1,33 @@
+/*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * 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

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

<Prev in Thread] Current Thread [Next in Thread>
  • [Xen-changelog] [xen-unstable] ocaml: add mmap bindings implementation., Xen patchbot-unstable <=