ocaml build error

ocaml build error

[Ian Jackson]

On Debian lenny I run "make -j4 xen tools" and I get the message
below.

I'm going to disable my ocaml build for now, but this needs to be
fixed if for no other reason than that I'm working on a huge patch
which makes a non-compatible interface change to libxc, and which will
break the ocaml build completely if I can't include the adjustements
to it in my patch submission.

Ian.

make[3]: Entering directory `/u/iwj/work/2/xen-unstable.git/tools/ocaml'
 === building libs/uuid
 === building libs/mmap
 === building libs/log
 === building libs/xc
 MLDEP    
 MLDEP    
 MLDEP    
 MLI      mmap.cmi
 MLDEP    
 CC       mmap_stubs.o
 MLOPT    mmap.cmx
 MLC      mmap.cmo
 MKLIB    libmmap_stubs.a
 MLA      mmap.cma
 MLI      log.cmi
 MLI      xc.cmi
 MLI      uuid.cmi
File "xc.mli", line 79, characters 66-75:
Unbound type constructor Uuid.t
make[4]: *** [xc.cmi] Error 2
make[3]: *** [libs/xc] Error 2
make[3]: *** Waiting for unfinished jobs....
 MLA      mmap.cmxa
 MLC      uuid.cmo
 MLI      syslog.cmi
 CC       syslog_stubs.o
 MLOPT    uuid.cmx
 MLA      uuid.cma
syslog_stubs.c:28: warning: '__syslog_options_table' defined but not used
 MLI      logs.cmi
 MLC      syslog.cmo
 MLC      log.cmo
 MLC      logs.cmo
 MKLIB     libsyslog_stubs.a
 MLA      uuid.cmxa
 MLOPT    syslog.cmx
 MLA       log.cma
 MLOPT    log.cmx
 MLOPT    logs.cmx
 MLA       log.cmxa
make[3]: Leaving directory `/u/iwj/work/2/xen-unstable.git/tools/ocaml'
make[2]: *** [subdir-install-ocaml] Error 2
make[2]: Leaving directory `/u/iwj/work/2/xen-unstable.git/tools'
make[1]: *** [subdirs-install] Error 2
make[1]: Leaving directory `/u/iwj/work/2/xen-unstable.git/tools'
make: *** [install-tools] Error 2

Re: ocaml build error

[Ian Jackson]

I wrote:
> On Debian lenny I run "make -j4 xen tools" and I get the message
> below.
> 
> I'm going to disable my ocaml build for now, but this needs to be
> fixed if for no other reason than that I'm working on a huge patch
> which makes a non-compatible interface change to libxc, and which will
> break the ocaml build completely if I can't include the adjustements
> to it in my patch submission.

In fact on a closer inspection this turns out to be a parallel make
error.  The author of the Makefile hadn't realised that if you mention
multiple things as a dependency, make may process them in any order.

The patch below fixes this.  However, the ocam build is still broken:

In file included from xc_lib.c:30:
xc.h:19:21: error: xen/xen.h: No such file or directory
xc.h:20:24: error: xen/memory.h: No such file or directory
xc.h:21:24: error: xen/sysctl.h: No such file or directory
xc.h:22:24: error: xen/domctl.h: No such file or directory
xc.h:23:23: error: xen/sched.h: No such file or directory
xc.h:26:31: error: xen/linux/privcmd.h: No such file or directory
xc.h:30:25: error: xen/version.h: No such file or directory
xc.h:31:32: error: xen/foreign/x86_32.h: No such file or directory
xc.h:32:32: error: xen/foreign/x86_64.h: No such file or directory
xc.h:33:28: error: xen/hvm/params.h: No such file or directory
In file included from xc.h:34,
                 from xc_lib.c:30:
xc_e820.h:4:26: error: xen/hvm/e820.h: No such file or directory

etc.

Signed-off-by: Ian Jackson <ian.jackson@eu.citrix.com>

diff --git a/tools/ocaml/Makefile b/tools/ocaml/Makefile
index 73c2988..ecd54b7 100644
--- a/tools/ocaml/Makefile
+++ b/tools/ocaml/Makefile
@@ -13,21 +13,23 @@ SUBDIRS = $(SUBDIRS_LIBS) $(SUBDIRS_PROGRAMS)
 .PHONY: all
 all: build
 
-.PHONY: build $(SUBDIRS)
-build: $(SUBDIRS)
+.PHONY: build SUBDIRS
+build: SUBDIRS
 
-$(SUBDIRS):
-	@echo " === building $@"
-	@$(MAKE) --no-print-directory -C $@
+SUBDIRS SUBDIRS_PROGRAMS SUBDIRS_LIBS:
+	@set -e; for d in $($@); do			\
+		echo " === building $$d";		\
+		$(MAKE) --no-print-directory -C $$d;	\
+	done
 
 .PHONY: install install-libs install-program
 install: install-libs install-program
 
-install-program: $(SUBDIRS_PROGRAMS)
+install-program: SUBDIRS_PROGRAMS
 	$(INSTALL_DIR) $(DESTDIR)$(SBINDIR)
 	$(INSTALL_PROG) xenstored/oxenstored $(DESTDIR)$(SBINDIR)
 
-install-libs: $(SUBDIRS_LIBS)
+install-libs: SUBDIRS_LIBS
 
 .PHONY: clean
 clean:

Re: ocaml build error

[Keir Fraser]

On 06/05/2010 16:38, "Ian Jackson" <Ian.Jackson@eu.citrix.com> wrote:

> On Debian lenny I run "make -j4 xen tools" and I get the message
> below.
> 
> I'm going to disable my ocaml build for now, but this needs to be
> fixed if for no other reason than that I'm working on a huge patch
> which makes a non-compatible interface change to libxc, and which will
> break the ocaml build completely if I can't include the adjustements
> to it in my patch submission.

Wow, you have ocaml toolchain installed? :-)

 K.

> Ian.
> 
> make[3]: Entering directory `/u/iwj/work/2/xen-unstable.git/tools/ocaml'
>  === building libs/uuid
>  === building libs/mmap
>  === building libs/log
>  === building libs/xc
>  MLDEP    
>  MLDEP    
>  MLDEP    
>  MLI      mmap.cmi
>  MLDEP    
>  CC       mmap_stubs.o
>  MLOPT    mmap.cmx
>  MLC      mmap.cmo
>  MKLIB    libmmap_stubs.a
>  MLA      mmap.cma
>  MLI      log.cmi
>  MLI      xc.cmi
>  MLI      uuid.cmi
> File "xc.mli", line 79, characters 66-75:
> Unbound type constructor Uuid.t
> make[4]: *** [xc.cmi] Error 2
> make[3]: *** [libs/xc] Error 2
> make[3]: *** Waiting for unfinished jobs....
>  MLA      mmap.cmxa
>  MLC      uuid.cmo
>  MLI      syslog.cmi
>  CC       syslog_stubs.o
>  MLOPT    uuid.cmx
>  MLA      uuid.cma
> syslog_stubs.c:28: warning: '__syslog_options_table' defined but not used
>  MLI      logs.cmi
>  MLC      syslog.cmo
>  MLC      log.cmo
>  MLC      logs.cmo
>  MKLIB     libsyslog_stubs.a
>  MLA      uuid.cmxa
>  MLOPT    syslog.cmx
>  MLA       log.cma
>  MLOPT    log.cmx
>  MLOPT    logs.cmx
>  MLA       log.cmxa
> make[3]: Leaving directory `/u/iwj/work/2/xen-unstable.git/tools/ocaml'
> make[2]: *** [subdir-install-ocaml] Error 2
> make[2]: Leaving directory `/u/iwj/work/2/xen-unstable.git/tools'
> make[1]: *** [subdirs-install] Error 2
> make[1]: Leaving directory `/u/iwj/work/2/xen-unstable.git/tools'
> make: *** [install-tools] Error 2
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xensource.com
> http://lists.xensource.com/xen-devel

Re: ocaml build error

[Ian Jackson]

Keir Fraser writes ("Re: [Xen-devel] ocaml build error"):
> On 06/05/2010 16:38, "Ian Jackson" <Ian.Jackson@eu.citrix.com> wrote:
> > I'm going to disable my ocaml build for now, but this needs to be
> > fixed if for no other reason than that I'm working on a huge patch
> > which makes a non-compatible interface change to libxc, and which will
> > break the ocaml build completely if I can't include the adjustements
> > to it in my patch submission.
> 
> Wow, you have ocaml toolchain installed? :-)

Apparently so :-).  Tempting to remove it, but I'll wait to see if
the ocaml tool build can be fixed, first ...

Ian.

Re: ocaml build error

[Keir Fraser]

On 06/05/2010 17:05, "Ian Jackson" <Ian.Jackson@eu.citrix.com> wrote:

> Keir Fraser writes ("Re: [Xen-devel] ocaml build error"):
>> On 06/05/2010 16:38, "Ian Jackson" <Ian.Jackson@eu.citrix.com> wrote:
>>> I'm going to disable my ocaml build for now, but this needs to be
>>> fixed if for no other reason than that I'm working on a huge patch
>>> which makes a non-compatible interface change to libxc, and which will
>>> break the ocaml build completely if I can't include the adjustements
>>> to it in my patch submission.
>> 
>> Wow, you have ocaml toolchain installed? :-)
> 
> Apparently so :-).  Tempting to remove it, but I'll wait to see if
> the ocaml tool build can be fixed, first ...

If the build doesn't get fixed then the corrcet thing to do will be to
disable build of the ocaml components by default.

 -- Keir

Re: ocaml build error

[Vincent Hanquez]

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

On 06/05/10 17:13, Keir Fraser wrote:
> If the build doesn't get fixed then the corrcet thing to do will be to
> disable build of the ocaml components by default.

It's stale build instructions that happens to still work for me since 
i've got some env set for all my old repos. the following patch fix it.

Signed-off-by: Vincent Hanquez <vincent.hanquez@eu.citrix.com>

-- 
Vincent

[-- Attachment #2: patch-fix-relative-path --]
[-- Type: text/plain, Size: 601 bytes --]

diff --git a/tools/ocaml/common.make b/tools/ocaml/common.make
index 3b14dfb..5f3579a 100644
--- a/tools/ocaml/common.make
+++ b/tools/ocaml/common.make
@@ -8,9 +8,7 @@ OCAMLYACC ?= ocamlyacc
 
 CFLAGS ?= -Wall -fPIC -O2
 
-XEN_ROOT ?= $(TOPLEVEL)/../xen-unstable.hg
-XEN_DIST_ROOT ?= $(XEN_ROOT)/dist/install
-CFLAGS += -I$(XEN_DIST_ROOT)/usr/include
+CFLAGS += -I$(TOPLEVEL)/../include -I$(TOPLEVEL)/../libxc
 
 OCAMLOPTFLAG_G := $(shell $(OCAMLOPT) -h 2>&1 | sed -n 's/^  *\(-g\) .*/\1/p')
 OCAMLOPTFLAGS = $(OCAMLOPTFLAG_G) -ccopt "$(LDFLAGS)" -dtypes $(OCAMLINCLUDE) -cc $(CC) -w F -warn-error F

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

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

Re: ocaml build error

[Jeremy Fitzhardinge]

On 05/06/2010 02:36 PM, Vincent Hanquez wrote:
> On 06/05/10 17:13, Keir Fraser wrote:
>> If the build doesn't get fixed then the corrcet thing to do will be to
>> disable build of the ocaml components by default.
>
> It's stale build instructions that happens to still work for me since
> i've got some env set for all my old repos. the following patch fix it.
>
> Signed-off-by: Vincent Hanquez <vincent.hanquez@eu.citrix.com>

It looks like Fedora 12 packages ocaml oddly, and its headers are under
/usr/lib64/ocaml/, so I had to add:

diff -r faf9bd66bf45 tools/ocaml/common.make
--- a/tools/ocaml/common.make	Thu May 06 17:44:03 2010 -0700
+++ b/tools/ocaml/common.make	Thu May 06 17:54:35 2010 -0700
@@ -8,7 +8,7 @@
 
 CFLAGS ?= -Wall -fPIC -O2
 
-CFLAGS += -I$(TOPLEVEL)/../include -I$(TOPLEVEL)/../libxc
+CFLAGS += -I$(TOPLEVEL)/../include -I$(TOPLEVEL)/../libxc -I/usr/lib64/ocaml -I/usr/lib/ocaml
 
 OCAMLOPTFLAG_G := $(shell $(OCAMLOPT) -h 2>&1 | sed -n 's/^  *\(-g\) .*/\1/p')
 OCAMLOPTFLAGS = $(OCAMLOPTFLAG_G) -ccopt "$(LDFLAGS)" -dtypes $(OCAMLINCLUDE) -cc $(CC) -w F -warn-error F


But even then it fails later on with:

 === building xenstored
 MLI      symbol.cmi
make[4]: *** No rule to make target `trie.cmi', needed by `all'.  Stop.
make[3]: *** [xenstored] Error 2
make[3]: Leaving directory `/home/jeremy/hg/xen/unstable/tools/ocaml'
make[2]: *** [subdir-install-ocaml] Error 2
make[2]: Leaving directory `/home/jeremy/hg/xen/unstable/tools'
make[1]: *** [subdirs-install] Error 2
make[1]: Leaving directory `/home/jeremy/hg/xen/unstable/tools'
make: *** [install-tools] Error 2


Forgot to add file?

    J

Re: ocaml build error

[Vincent Hanquez]

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

On 07/05/10 01:56, Jeremy Fitzhardinge wrote:
> It looks like Fedora 12 packages ocaml oddly, and its headers are under
> /usr/lib64/ocaml/, so I had to add:

The patch is correct; it's again my specific build environment 
(debian+tweaks) that happens to play tricks.

> diff -r faf9bd66bf45 tools/ocaml/common.make
> --- a/tools/ocaml/common.make	Thu May 06 17:44:03 2010 -0700
> +++ b/tools/ocaml/common.make	Thu May 06 17:54:35 2010 -0700
> @@ -8,7 +8,7 @@
>
>   CFLAGS ?= -Wall -fPIC -O2
>
> -CFLAGS += -I$(TOPLEVEL)/../include -I$(TOPLEVEL)/../libxc
> +CFLAGS += -I$(TOPLEVEL)/../include -I$(TOPLEVEL)/../libxc -I/usr/lib64/ocaml -I/usr/lib/ocaml
>
>   OCAMLOPTFLAG_G := $(shell $(OCAMLOPT) -h 2>&1 | sed -n 's/^  *\(-g\) .*/\1/p')
>   OCAMLOPTFLAGS = $(OCAMLOPTFLAG_G) -ccopt "$(LDFLAGS)" -dtypes $(OCAMLINCLUDE) -cc $(CC) -w F -warn-error F
>
>
> But even then it fails later on with:
>
>   === building xenstored
>   MLI      symbol.cmi
> make[4]: *** No rule to make target `trie.cmi', needed by `all'.  Stop.
> make[3]: *** [xenstored] Error 2
> make[3]: Leaving directory `/home/jeremy/hg/xen/unstable/tools/ocaml'
> make[2]: *** [subdir-install-ocaml] Error 2
> make[2]: Leaving directory `/home/jeremy/hg/xen/unstable/tools'
> make[1]: *** [subdirs-install] Error 2
> make[1]: Leaving directory `/home/jeremy/hg/xen/unstable/tools'
> make: *** [install-tools] Error 2
>
>
> Forgot to add file?

gah yes; 3 files were missing. they got lost when i remove the stdext 
dependencies and move only the necessary files in to reduce the patchset 
size.

adding another patch for Keir.

-- 
Vincent

[-- Attachment #2: patch-missing-files --]
[-- Type: text/plain, Size: 12175 bytes --]

commit b5015f5111b9c1b9beabf176b810a19cc62240ce
Author: Vincent Hanquez <vincent.hanquez@eu.citrix.com>
Date:   Fri May 7 07:36:39 2010 +0100

    add missing files that got lost in the v2 shuffle

diff --git a/tools/ocaml/xenstored/stdext.ml b/tools/ocaml/xenstored/stdext.ml
new file mode 100644
index 0000000..b8a8fd0
--- /dev/null
+++ b/tools/ocaml/xenstored/stdext.ml
@@ -0,0 +1,130 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008-2010 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
+ * Author Dave Scott <dave.scott@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 ('a, 'b) either = Right of 'a | Left of 'b
+
+(** apply the clean_f function after fct function has been called.
+ * Even if fct raises an exception, clean_f is applied
+ *)
+let exnhook = ref None 
+
+let finally fct clean_f =
+	let result = try
+		fct ();
+	with
+		exn ->
+		  (match !exnhook with None -> () | Some f -> f exn);
+		  clean_f (); raise exn in
+	clean_f ();
+	result
+
+(** if v is not none, apply f on it and return some value else return none. *)
+let may f v =
+	match v with Some x -> Some (f x) | None -> None
+
+(** default value to d if v is none. *) 
+let default d v =
+	match v with Some x -> x | None -> d
+
+(** apply f on v if not none *)
+let maybe f v =
+	match v with None -> () | Some x -> f x
+
+module String = struct include String
+
+let of_char c = String.make 1 c
+
+let rec split ?limit:(limit=(-1)) c s =
+	let i = try String.index s c with Not_found -> -1 in
+	let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in
+	if i = -1 || nlimit = 0 then
+		[ s ]
+	else
+		let a = String.sub s 0 i
+		and b = String.sub s (i + 1) (String.length s - i - 1) in
+		a :: (split ~limit: nlimit c b)
+
+let fold_left f accu string =
+	let accu = ref accu in
+	for i = 0 to length string - 1 do
+		accu := f !accu string.[i]
+	done;
+	!accu
+
+(** True if string 'x' starts with prefix 'prefix' *)
+let startswith prefix x =
+	let x_l = String.length x and prefix_l = String.length prefix in
+	prefix_l <= x_l && String.sub x 0 prefix_l  = prefix
+end
+
+module Unixext = struct
+
+(** remove a file, but doesn't raise an exception if the file is already removed *)
+let unlink_safe file =
+	try Unix.unlink file with (* Unix.Unix_error (Unix.ENOENT, _ , _)*) _ -> ()
+
+(** create a directory but doesn't raise an exception if the directory already exist *)
+let mkdir_safe dir perm =
+	try Unix.mkdir dir perm with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
+
+(** create a directory, and create parent if doesn't exist *)
+let mkdir_rec dir perm =
+	let rec p_mkdir dir =
+		let p_name = Filename.dirname dir in
+		if p_name <> "/" && p_name <> "." 
+		then p_mkdir p_name;
+		mkdir_safe dir perm in
+	p_mkdir dir
+
+(** daemonize a process *)
+(* !! Must call this before spawning any threads !! *)
+let daemonize () =
+	match Unix.fork () with
+	| 0 ->
+		if Unix.setsid () == -1 then
+			failwith "Unix.setsid failed";
+
+		begin match Unix.fork () with
+		| 0 ->
+			let nullfd = Unix.openfile "/dev/null" [ Unix.O_WRONLY ] 0 in
+			begin try
+				Unix.close Unix.stdin;
+				Unix.dup2 nullfd Unix.stdout;
+				Unix.dup2 nullfd Unix.stderr;
+			with exn -> Unix.close nullfd; raise exn
+			end;
+			Unix.close nullfd
+		| _ -> exit 0
+		end
+	| _ -> exit 0
+
+(** write a pidfile file *)
+let pidfile_write filename =
+	let fd = Unix.openfile filename
+	                       [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC; ]
+			       0o640 in
+	finally
+	(fun () ->
+		let pid = Unix.getpid () in
+		let buf = string_of_int pid ^ "\n" in
+		let len = String.length buf in
+		if Unix.write fd buf 0 len <> len 
+		then failwith "pidfile_write failed";
+	)
+	(fun () -> Unix.close fd)
+
+end
diff --git a/tools/ocaml/xenstored/trie.ml b/tools/ocaml/xenstored/trie.ml
new file mode 100644
index 0000000..bc9a903
--- /dev/null
+++ b/tools/ocaml/xenstored/trie.ml
@@ -0,0 +1,182 @@
+(*
+ * Copyright (C) 2008-2009 Citrix Ltd.
+ * Author Thomas Gazagnaire <thomas.gazagnaire@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.
+ *)
+
+module Node =
+struct
+	type ('a,'b) t =  {
+		key: 'a;
+		value: 'b option;
+		children: ('a,'b) t list;
+	}
+
+	let create key value = {
+		key = key;
+		value = Some value;
+		children = [];
+	}
+
+	let empty key = {
+		key = key;
+		value = None;
+		children = []
+	}
+
+	let get_key node = node.key
+	let get_value node = 
+		match node.value with
+		| None       -> raise Not_found
+		| Some value -> value
+
+	let get_children node = node.children
+
+	let set_value node value =
+		{ node with value = Some value }
+	let set_children node children =
+		{ node with children = children }
+
+	let add_child node child = 
+		{ node with children = child :: node.children }
+end
+
+type ('a,'b) t = ('a,'b) Node.t list
+
+let mem_node nodes key =
+	List.exists (fun n -> n.Node.key = key) nodes
+
+let find_node nodes key =
+	List.find (fun n -> n.Node.key = key) nodes
+
+let replace_node nodes key node =
+	let rec aux = function
+		| []                            -> []
+		| h :: tl when h.Node.key = key -> node :: tl
+		| h :: tl                       -> h :: aux tl
+	in
+	aux nodes
+			
+let remove_node nodes key =
+	let rec aux = function
+		| []                            -> raise Not_found
+		| h :: tl when h.Node.key = key -> tl
+		| h :: tl                       -> h :: aux tl
+	in
+	aux nodes
+
+let create () = []
+
+let rec iter f tree = 
+	let rec aux node =
+		f node.Node.key node.Node.value; 
+		iter f node.Node.children
+	in
+	List.iter aux tree
+
+let rec map f tree =
+	let rec aux node =
+		let value = 
+			match node.Node.value with
+			| None       -> None
+			| Some value -> f value
+		in
+		{ node with Node.value = value; Node.children = map f node.Node.children }
+	in
+	List.filter (fun n -> n.Node.value <> None || n.Node.children <> []) (List.map aux tree)
+
+let rec fold f tree acc =
+	let rec aux accu node =
+		fold f node.Node.children (f node.Node.key node.Node.value accu)
+	in
+	List.fold_left aux acc tree 
+
+(* return a sub-trie *)
+let rec sub_node tree = function
+	| []   -> raise Not_found
+	| h::t -> 
+		  if mem_node tree h
+		  then begin
+			  let node = find_node tree h in
+			  if t = []
+			  then node
+			  else sub_node node.Node.children t
+		  end else
+			  raise Not_found
+
+let sub tree path = 
+	try (sub_node tree path).Node.children
+	with Not_found -> []
+
+let find tree path = 
+	Node.get_value (sub_node tree path)
+
+(* return false if the node doesn't exists or if it is not associated to any value *)
+let rec mem tree = function
+	| []   -> false
+	| h::t -> 
+		  mem_node tree h
+		  && (let node = find_node tree h in 
+			  if t = []
+			  then node.Node.value <> None
+			  else mem node.Node.children t)
+
+(* Iterate over the longest valid prefix *)
+let rec iter_path f tree = function
+	| []   -> ()
+	| h::l -> 
+		  if mem_node tree h
+		  then begin
+			  let node = find_node tree h in
+			  f node.Node.key node.Node.value;
+			  iter_path f node.Node.children l
+		  end
+
+let rec set_node node path value =
+	if path = [] 
+	then Node.set_value node value
+	else begin
+		let children = set node.Node.children path value in
+		Node.set_children node children
+	end
+
+and set tree path value =
+	match path with
+		| []   -> raise Not_found
+		| h::t -> 
+			  if mem_node tree h
+			  then begin
+				  let node = find_node tree h in
+				  replace_node tree h (set_node node t value)
+			  end else begin
+				  let node = Node.empty h in
+				  set_node node t value :: tree
+			  end
+
+let rec unset tree = function
+	| []   -> tree
+	| h::t -> 
+		  if mem_node tree h
+		  then begin
+			  let node = find_node tree h in
+			  let children = unset node.Node.children t in
+			  let new_node =
+				  if t = []
+				  then Node.set_children (Node.empty h) children
+				  else Node.set_children node children
+			  in
+			  if children = [] && new_node.Node.value = None
+			  then remove_node tree h
+			  else replace_node tree h new_node
+		  end else
+			  raise Not_found
+
diff --git a/tools/ocaml/xenstored/trie.mli b/tools/ocaml/xenstored/trie.mli
new file mode 100644
index 0000000..25db9d0
--- /dev/null
+++ b/tools/ocaml/xenstored/trie.mli
@@ -0,0 +1,60 @@
+(*
+ * Copyright (C) 2008-2009 Citrix Ltd.
+ * Author Thomas Gazagnaire <thomas.gazagnaire@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.
+ *)
+
+(** Basic Implementation of polymorphic tries (ie. prefix trees) *)
+
+type ('a, 'b) t
+(** The type of tries. ['a list] is the type of keys, ['b] the type of values.
+	Internally, a trie is represented as a labeled tree, where node contains values
+	of type ['a * 'b option]. *)
+
+val create : unit -> ('a,'b) t
+(** Creates an empty trie. *)
+
+val mem : ('a,'b) t -> 'a list -> bool
+(** [mem t k] returns true if a value is associated with the key [k] in the trie [t]. 
+	Otherwise, it returns false. *)
+
+val find : ('a, 'b) t -> 'a list -> 'b
+(** [find t k] returns the value associated with the key [k] in the trie [t].
+	Returns [Not_found] if no values are associated with [k] in [t]. *)
+
+val set : ('a, 'b) t -> 'a list -> 'b -> ('a, 'b) t
+(** [set t k v] associates the value [v] with the key [k] in the trie [t]. *)
+
+val unset : ('a, 'b) t -> 'a list -> ('a, 'b) t
+(** [unset k v] removes the association of value [v] with the key [k] in the trie [t]. 
+	Moreover, it automatically clean the trie, ie. it removes recursively 
+	every nodes of [t] containing no values and having no chil. *)
+
+val iter : ('a -> 'b option -> unit) -> ('a, 'b) t -> unit
+(** [iter f t] applies the function [f] to every node of the trie [t]. 
+	As nodes of the trie [t] do not necessary contains a value, the second argument of
+	[f] is an option type. *)
+
+val iter_path : ('a -> 'b option -> unit) -> ('a, 'b) t -> 'a list -> unit
+(** [iter_path f t p] iterates [f] over nodes associated with the path [p] in the trie [t]. 
+	If [p] is not a valid path of [t], it iterates on the longest valid prefix of [p]. *)
+
+val fold : ('a -> 'b option -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c 
+(** [fold f t x] fold [f] over every nodes of [t], with [x] as initial value. *)
+
+val map : ('b -> 'c option) -> ('a,'b) t -> ('a,'c) t
+(** [map f t] maps [f] over every values stored in [t]. The return value of [f] is of type 'c option
+	as one may wants to remove value associated to a key. This function is not tail-recursive. *)
+
+val sub : ('a, 'b) t -> 'a list -> ('a,'b) t
+(** [sub t p] returns the sub-trie associated with the path [p] in the trie [t].
+	If [p] is not a valid path of [t], it returns an empty trie. *)

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

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

Re: ocaml build error

[Ian Jackson]

Vincent Hanquez writes ("Re: [Xen-devel] ocaml build error"):
> adding another patch for Keir.

Even with that, I get this.

Ian.

cc1: warnings being treated as errors
xc_lib.c: In function 'xc_domain_set_memmap_limit':
xc_lib.c:659: error: dereferencing type-punned pointer will break strict-aliasing rules
xc_lib.c: In function 'xc_domain_memory_increase_reservation':
xc_lib.c:709: error: dereferencing type-punned pointer will break strict-aliasing rules
xc_lib.c: In function 'xc_domain_memory_decrease_reservation':
xc_lib.c:735: error: dereferencing type-punned pointer will break strict-aliasing rules
xc_lib.c: In function 'xc_domain_memory_populate_physmap':
xc_lib.c:765: error: dereferencing type-punned pointer will break strict-aliasing rules
xc_lib.c: In function 'xc_domain_get_pfn_list':
xc_lib.c:1217: error: assignment from incompatible pointer type
make[4]: *** [xc_lib.o] Error 1
make[4]: *** Waiting for unfinished jobs....
make[3]: *** [SUBDIRS_LIBS] Error 2
make[3]: Leaving directory `/u/iwj/work/1/xen-unstable.hg/tools/ocaml'
make[2]: *** [subdir-install-ocaml] Error 2
make[2]: Leaving directory `/u/iwj/work/1/xen-unstable.hg/tools'
make[1]: *** [subdirs-install] Error 2
make[1]: Leaving directory `/u/iwj/work/1/xen-unstable.hg/tools'
make: *** [install-tools] Error 2

Re: ocaml build error

[Keir Fraser]

On 07/05/2010 18:11, "Ian Jackson" <Ian.Jackson@eu.citrix.com> wrote:

> Vincent Hanquez writes ("Re: [Xen-devel] ocaml build error"):
>> adding another patch for Keir.
> 
> Even with that, I get this.
> 
> Ian.
> 
> cc1: warnings being treated as errors
> xc_lib.c: In function 'xc_domain_set_memmap_limit':
> xc_lib.c:659: error: dereferencing type-punned pointer will break
> strict-aliasing rules

No reason for tools/ocaml to override the provided base CFLAGS. This should
be fixed by xen-unstable:21329, which implicitly adds -fno-strict-aliasing
to CFLAGS.

 -- Keir

ocaml build error

[Christoph Egger]

Hi!

With c/s 21446, I get this build error:

 === building libs/mmap
 MLOPT    trie.cmx
 MLDEP
 MLI      mmap.cmi
 MLC      mmap.cmo
 MLOPT    config.cmx
 MLA      mmap.cma
 CC       mmap_stubs.o
 MKLIB    libmmap_stubs.a
 MLOPT    mmap.cmx
 MLOPT    logging.cmx
 MLA      mmap.cmxa
File "logging.ml", line 20, characters 16-26:
Error: Unbound value Logs.error
gmake[4]: *** [logging.cmx] Error 2
gmake[3]: *** [SUBDIRS_PROGRAMS] Error 2
gmake[3]: *** Waiting for unfinished jobs....

Christoph


-- 
---to satisfy European Law for business letters:
Advanced Micro Devices GmbH
Einsteinring 24, 85609 Dornach b. Muenchen
Geschaeftsfuehrer: Andrew Bowd, Thomas M. McCoy, Giuliano Meroni
Sitz: Dornach, Gemeinde Aschheim, Landkreis Muenchen
Registergericht Muenchen, HRB Nr. 43632

Re: ocaml build error

[Keir Fraser]

Looks like maybe you're still getting a parallel build despite recent ocaml
Makefile fixes, including .NOTPARALLEL target added to Makefile.rules? There
are no logging.* files under ocaml/libs/mmap after all. Anyway I expect you
do not want the OCAML tools and you can disable it easily enough from your
build with OCAML_TOOLS=n in your environment.

 K.

On 25/05/2010 10:25, "Christoph Egger" <Christoph.Egger@amd.com> wrote:

> 
> Hi!
> 
> With c/s 21446, I get this build error:
> 
>  === building libs/mmap
>  MLOPT    trie.cmx
>  MLDEP
>  MLI      mmap.cmi
>  MLC      mmap.cmo
>  MLOPT    config.cmx
>  MLA      mmap.cma
>  CC       mmap_stubs.o
>  MKLIB    libmmap_stubs.a
>  MLOPT    mmap.cmx
>  MLOPT    logging.cmx
>  MLA      mmap.cmxa
> File "logging.ml", line 20, characters 16-26:
> Error: Unbound value Logs.error
> gmake[4]: *** [logging.cmx] Error 2
> gmake[3]: *** [SUBDIRS_PROGRAMS] Error 2
> gmake[3]: *** Waiting for unfinished jobs....
> 
> Christoph
>