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 + * + * 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 + * + * 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 + * + * 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 +#include +#include +#include +#include +#include "mmap_stubs.h" + +#include +#include +#include +#include +#include +#include + +#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 + * + * 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 +#include +#include +#include +#include +#include + +struct mmap_interface +{ + void *addr; + int len; +}; + +#endif