From nobody Sun Feb 8 20:35:13 2026 Delivered-To: importer@patchew.org Received-SPF: pass (zohomail.com: domain of lists.xenproject.org designates 192.237.175.120 as permitted sender) client-ip=192.237.175.120; envelope-from=xen-devel-bounces@lists.xenproject.org; helo=lists.xenproject.org; Authentication-Results: mx.zohomail.com; dkim=pass; spf=pass (zohomail.com: domain of lists.xenproject.org designates 192.237.175.120 as permitted sender) smtp.mailfrom=xen-devel-bounces@lists.xenproject.org; dmarc=pass(p=reject dis=none) header.from=citrix.com ARC-Seal: i=1; a=rsa-sha256; t=1610751562; cv=none; d=zohomail.com; s=zohoarc; b=YtrbpGqnG2/sBuh10oR0TWWd43VIKMNrRl1zXtcLeyCrCZHhDRFyTsKs2xN8tRrTD2prk6QDXOqo9eLY2rCFbKMci9xQw8PfDb3HshAu4YjyIlUEcryAE/WmT5Cqi8ASlAkSWUjhxHa0YtAf0PgUb+Y8dVb6FWrAUhj6Ld1O7fA= ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=zohomail.com; s=zohoarc; t=1610751562; h=Content-Type:Content-Transfer-Encoding:Cc:Date:From:In-Reply-To:List-Subscribe:List-Post:List-Id:List-Help:List-Unsubscribe:MIME-Version:Message-ID:References:Sender:Subject:To; bh=Va2gppK8iDNZLhTkypcxxu8EbgkfPK2+EVGBGhHeV3s=; b=WQhqsqScujsJ9bwSZz6q1rtwC0EcJdm6dZ741PmqNasfPwDAokMdT1YXMlGnP9VOy0jQ0FA6jVwa0hnjLG7oUrxqT7BOpAouWvCzFiPZHL/nT3bWTD/AvkKVepu6RuCdIiHxtGaVtpeJJ0YqI3sq5jYpW3Mu990kQXMlibVHOoI= ARC-Authentication-Results: i=1; mx.zohomail.com; dkim=pass; spf=pass (zohomail.com: domain of lists.xenproject.org designates 192.237.175.120 as permitted sender) smtp.mailfrom=xen-devel-bounces@lists.xenproject.org; dmarc=pass header.from= (p=reject dis=none) header.from= Return-Path: Received: from lists.xenproject.org (lists.xenproject.org [192.237.175.120]) by mx.zohomail.com with SMTPS id 1610751562808906.8893694678876; Fri, 15 Jan 2021 14:59:22 -0800 (PST) Received: from list by lists.xenproject.org with outflank-mailman.68790.123300 (Exim 4.92) (envelope-from ) id 1l0Y3c-0003Ue-Sg; Fri, 15 Jan 2021 22:59:04 +0000 Received: by outflank-mailman (output) from mailman id 68790.123300; Fri, 15 Jan 2021 22:59:04 +0000 Received: from localhost ([127.0.0.1] helo=lists.xenproject.org) by lists.xenproject.org with esmtp (Exim 4.92) (envelope-from ) id 1l0Y3c-0003U4-6s; Fri, 15 Jan 2021 22:59:04 +0000 Received: by outflank-mailman (input) for mailman id 68790; Fri, 15 Jan 2021 22:59:02 +0000 Received: from us1-rack-iad1.inumbo.com ([172.99.69.81]) by lists.xenproject.org with esmtp (Exim 4.92) (envelope-from ) id 1l0XyH-0001Wj-15 for xen-devel@lists.xenproject.org; Fri, 15 Jan 2021 22:53:33 +0000 Received: from esa3.hc3370-68.iphmx.com (unknown [216.71.145.155]) by us1-rack-iad1.inumbo.com (Halon) with ESMTPS id 26887bda-f300-44c6-b71d-4f5718b9a07b; Fri, 15 Jan 2021 22:52:37 +0000 (UTC) X-Outflank-Mailman: Message body and most headers restored to incoming version X-BeenThere: xen-devel@lists.xenproject.org List-Id: Xen developer discussion List-Unsubscribe: , List-Post: List-Help: List-Subscribe: , Errors-To: xen-devel-bounces@lists.xenproject.org Precedence: list Sender: "Xen-devel" X-Inumbo-ID: 26887bda-f300-44c6-b71d-4f5718b9a07b DKIM-Signature: v=1; a=rsa-sha256; c=simple/simple; d=citrix.com; s=securemail; t=1610751157; h=from:to:cc:subject:date:message-id:in-reply-to: references:mime-version:content-transfer-encoding; bh=Mh4+eKEr9LhDfKwKuYHJiWolDcWugUyUrf0m4DtFF4M=; b=dUdVDx1Jvg1MGm8O96LNDjYjkOeAhPtlqisB+ygg91emNkoLRhFtLEg0 JB/a8/Lx6BB9XI5DYgkY2/zm1bT/7o7UQJbRPdTm20gdymwck4iThNWP1 kfCYXsroyeMIfMdgtHKeeeyfD23kljq8dv7f5CbI3PSr5q+LbE3OmPUuv I=; Authentication-Results: esa3.hc3370-68.iphmx.com; dkim=none (message not signed) header.i=none IronPort-SDR: OQrlBuPf51cLcdff5hNyHoPZHagzmyyWFcZmbAOfqoa1NLXnXB76PV9XrB271TBirbhWHLsiGx E9W9Mx4CLtVXJpUxeoyUyQy0aA0NwTNjSdrrShM7AHsYpYJaypv1tXyfprLi6zyAnZ5ueT345Y mNpdPBpeRKmI8ivPcE4366fj1uYr9jcQNSSBJtJRM9OV1z3HNE/c77vjr2oEchC+ZpOEZzSA9I cdZOTyyEh6vsCb69XaQsot/RfhgdST1L6JMboQ6Z8DsU1tMuFZJeAvPu5fm+kKk+BH0tYI8XKJ IIk= X-SBRS: 5.1 X-MesageID: 35217499 X-Ironport-Server: esa3.hc3370-68.iphmx.com X-Remote-IP: 162.221.158.21 X-Policy: $RELAYED X-IronPort-AV: E=Sophos;i="5.79,350,1602561600"; d="scan'208";a="35217499" From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= To: CC: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= , "Christian Lindig" , David Scott , "Ian Jackson" , Wei Liu Subject: [PATCH v4 4/4] tools/ocaml/xenstored: use more efficient tries Date: Fri, 15 Jan 2021 22:28:58 +0000 Message-ID: X-Mailer: git-send-email 2.27.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: quoted-printable X-ZohoMail-DKIM: pass (identity @citrix.com) No functional change, just an optimization. Signed-off-by: Edwin T=C3=B6r=C3=B6k Acked-by: Christian Lindig --- Changed since V3: * repost after XSA to avoid conflicts --- tools/ocaml/xenstored/connections.ml | 2 +- tools/ocaml/xenstored/symbol.ml | 6 +-- tools/ocaml/xenstored/trie.ml | 59 ++++++++++++---------------- tools/ocaml/xenstored/trie.mli | 26 ++++++------ 4 files changed, 43 insertions(+), 50 deletions(-) diff --git a/tools/ocaml/xenstored/connections.ml b/tools/ocaml/xenstored/c= onnections.ml index 82988f7e8d..8a66eeec3a 100644 --- a/tools/ocaml/xenstored/connections.ml +++ b/tools/ocaml/xenstored/connections.ml @@ -21,7 +21,7 @@ type t =3D { anonymous: (Unix.file_descr, Connection.t) Hashtbl.t; domains: (int, Connection.t) Hashtbl.t; ports: (Xeneventchn.t, Connection.t) Hashtbl.t; - mutable watches: (string, Connection.watch list) Trie.t; + mutable watches: Connection.watch list Trie.t; } =20 let create () =3D { diff --git a/tools/ocaml/xenstored/symbol.ml b/tools/ocaml/xenstored/symbol= .ml index 301639f16f..72a84ebf80 100644 --- a/tools/ocaml/xenstored/symbol.ml +++ b/tools/ocaml/xenstored/symbol.ml @@ -31,9 +31,9 @@ let equal a b =3D (* compare using physical equality, both members have to be part of the = above weak table *) a =3D=3D b =20 -let compare a b =3D - if equal a b then 0 - else -(String.compare a b) +(* the sort order is reversed here, so that Map.fold constructs a list + in ascending order *) +let compare a b =3D String.compare b a =20 let stats () =3D let len, entries, _, _, _, _ =3D WeakTable.stats tbl in diff --git a/tools/ocaml/xenstored/trie.ml b/tools/ocaml/xenstored/trie.ml index f513f4e608..ad2aed5123 100644 --- a/tools/ocaml/xenstored/trie.ml +++ b/tools/ocaml/xenstored/trie.ml @@ -15,24 +15,26 @@ =20 open Stdext =20 +module StringMap =3D Map.Make(String) + module Node =3D struct - type ('a,'b) t =3D { - key: 'a; - value: 'b option; - children: ('a,'b) t list; + type 'a t =3D { + key: string; + value: 'a option; + children: 'a t StringMap.t; } =20 let _create key value =3D { key =3D key; value =3D Some value; - children =3D []; + children =3D StringMap.empty; } =20 let empty key =3D { key =3D key; value =3D None; - children =3D [] + children =3D StringMap.empty; } =20 let _get_key node =3D node.key @@ -49,41 +51,31 @@ struct { node with children =3D children } =20 let _add_child node child =3D - { node with children =3D child :: node.children } + { node with children =3D StringMap.add child.key child node.children } end =20 -type ('a,'b) t =3D ('a,'b) Node.t list +type 'a t =3D 'a Node.t StringMap.t =20 let mem_node nodes key =3D - List.exists (fun n -> n.Node.key =3D key) nodes + StringMap.mem key nodes =20 let find_node nodes key =3D - List.find (fun n -> n.Node.key =3D key) nodes + StringMap.find key nodes =20 let replace_node nodes key node =3D - let rec aux =3D function - | [] -> [] - | h :: tl when h.Node.key =3D key -> node :: tl - | h :: tl -> h :: aux tl - in - aux nodes + StringMap.update key (function None -> None | Some _ -> Some node) nodes =20 let remove_node nodes key =3D - let rec aux =3D function - | [] -> raise Not_found - | h :: tl when h.Node.key =3D key -> tl - | h :: tl -> h :: aux tl - in - aux nodes + StringMap.update key (function None -> raise Not_found | Some _ -> None) = nodes =20 -let create () =3D [] +let create () =3D StringMap.empty =20 let rec iter f tree =3D - let aux node =3D - f node.Node.key node.Node.value; + let aux key node =3D + f key node.Node.value; iter f node.Node.children in - List.iter aux tree + StringMap.iter aux tree =20 let rec map f tree =3D let aux node =3D @@ -94,13 +86,14 @@ let rec map f tree =3D in { node with Node.value =3D value; Node.children =3D map f node.Node.chil= dren } in - List.filter (fun n -> n.Node.value <> None || n.Node.children <> []) (Lis= t.map aux tree) + tree |> StringMap.map aux + |> StringMap.filter (fun _ n -> n.Node.value <> None || not (StringMap.is= _empty n.Node.children) ) =20 let rec fold f tree acc =3D - let aux accu node =3D - fold f node.Node.children (f node.Node.key node.Node.value accu) + let aux key node accu =3D + fold f node.Node.children (f key node.Node.value accu) in - List.fold_left aux acc tree + StringMap.fold aux tree acc =20 (* return a sub-trie *) let rec sub_node tree =3D function @@ -117,7 +110,7 @@ let rec sub_node tree =3D function =20 let sub tree path =3D try (sub_node tree path).Node.children - with Not_found -> [] + with Not_found -> StringMap.empty =20 let find tree path =3D Node.get_value (sub_node tree path) @@ -161,7 +154,7 @@ and set tree path value =3D replace_node tree h (set_node node t value) end else begin let node =3D Node.empty h in - set_node node t value :: tree + StringMap.add node.Node.key (set_node node t value) tree end =20 let rec unset tree =3D function @@ -176,7 +169,7 @@ let rec unset tree =3D function then Node.set_children (Node.empty h) children else Node.set_children node children in - if children =3D [] && new_node.Node.value =3D None + if StringMap.is_empty children && new_node.Node.value =3D None then remove_node tree h else replace_node tree h new_node end else diff --git a/tools/ocaml/xenstored/trie.mli b/tools/ocaml/xenstored/trie.mli index 5dc53c1cb1..27785154f5 100644 --- a/tools/ocaml/xenstored/trie.mli +++ b/tools/ocaml/xenstored/trie.mli @@ -15,46 +15,46 @@ =20 (** Basic Implementation of polymorphic tries (ie. prefix trees) *) =20 -type ('a, 'b) t -(** The type of tries. ['a list] is the type of keys, ['b] the type of val= ues. +type 'a t +(** The type of tries. ['a] the type of values. Internally, a trie is represented as a labeled tree, where node contains = values - of type ['a * 'b option]. *) + of type [string * 'a option]. *) =20 -val create : unit -> ('a,'b) t +val create : unit -> 'a t (** Creates an empty trie. *) =20 -val mem : ('a,'b) t -> 'a list -> bool +val mem : 'a t -> string list -> bool (** [mem t k] returns true if a value is associated with the key [k] in th= e trie [t]. Otherwise, it returns false. *) =20 -val find : ('a, 'b) t -> 'a list -> 'b +val find : 'a t -> string list -> 'a (** [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]. *) =20 -val set : ('a, 'b) t -> 'a list -> 'b -> ('a, 'b) t +val set : 'a t -> string list -> 'a -> 'a t (** [set t k v] associates the value [v] with the key [k] in the trie [t].= *) =20 -val unset : ('a, 'b) t -> 'a list -> ('a, 'b) t +val unset : 'a t -> string list -> 'a t (** [unset k v] removes the association of value [v] with the key [k] in t= he trie [t]. Moreover, it automatically clean the trie, ie. it removes recursively every nodes of [t] containing no values and having no chil. *) =20 -val iter : ('a -> 'b option -> unit) -> ('a, 'b) t -> unit +val iter : (string -> 'a option -> unit) -> 'a 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 ar= gument of [f] is an option type. *) =20 -val iter_path : ('a -> 'b option -> unit) -> ('a, 'b) t -> 'a list -> unit +val iter_path : (string -> 'a option -> unit) -> 'a t -> string list -> un= it (** [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 prefi= x of [p]. *) =20 -val fold : ('a -> 'b option -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c +val fold : (string -> 'a option -> 'c -> 'c) -> 'a t -> 'c -> 'c (** [fold f t x] fold [f] over every nodes of [t], with [x] as initial val= ue. *) =20 -val map : ('b -> 'c option) -> ('a,'b) t -> ('a,'c) t +val map : ('a -> 'b option) -> 'a t -> 'b t (** [map f t] maps [f] over every values stored in [t]. The return value o= f [f] is of type 'c option as one may wants to remove value associated to a key. This function is no= t tail-recursive. *) =20 -val sub : ('a, 'b) t -> 'a list -> ('a,'b) t +val sub : 'a t -> string list -> 'a t (** [sub t p] returns the sub-trie associated with the path [p] in the tri= e [t]. If [p] is not a valid path of [t], it returns an empty trie. *) --=20 2.29.2