search for: hashtbl

I have done some printf profiling and found that supermin's calls to dpkg for individual packages are quite expensive. Here are some patches that gather all information on demand where possible. On my Debian/unstable-based workstation at home, preparing a minimal appliance using $ ./supermin --use-installed --prepare bash -o supermin.d now takes ~3.5s (previously ~15s). Turning that

...> resize/resize.ml | 2 ++ > 1 file changed, 2 insertions(+) > > diff --git a/resize/resize.ml b/resize/resize.ml > index d7a8ce1..92f7304 100644 > --- a/resize/resize.ml > +++ b/resize/resize.ml > @@ -616,6 +616,8 @@ read the man page virt-resize(1). > let hash = Hashtbl.create 13 in > List.iter (fun ({ p_name = name } as p) -> Hashtbl.add hash name p) > partitions; > + List.iter (fun ({ p_name = name } as p) -> Hashtbl.add hash name p) > + logical_partitions; > fun ~option name -> > let name = >...

...t compare files in + let paths = + List.sort compare + (List.map (fun file -> file.ft_path) files) in let rec stat_is_dir dir = try (stat dir).st_kind = S_DIR with Unix_error _ -> false @@ -336,7 +338,7 @@ and munge files = in let insert_dir, dir_seen = - let h = Hashtbl.create (List.length files) in + let h = Hashtbl.create (List.length paths) in let insert_dir dir = Hashtbl.replace h dir true in let dir_seen dir = Hashtbl.mem h dir in insert_dir, dir_seen @@ -385,10 +387,17 @@ and munge files = (* Have we seen this parent directory before...

This is v2 of the 4/4 patch from the original series. Changes: - memoize the function this time - check packages are installed using rpm_package_of_string However I didn't combine the two case together, because the code is a bit simpler with them separate. Rich.

...letions(-) diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index 81d8202..78618f5 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -297,6 +297,15 @@ let sort_uniq ?(cmp = Pervasives.compare) xs = let xs = uniq ~cmp xs in xs +let remove_duplicates xs = + let h = Hashtbl.create (List.length xs) in + let rec loop = function + | [] -> [] + | x :: xs when Hashtbl.mem h x -> xs + | x :: xs -> Hashtbl.add h x true; x :: loop xs + in + loop xs + let push_back xsp x = xsp := !xsp @ [x] let push_front x xsp = xsp := x :: !xsp let pop_back xsp = diff...

...iff --git a/src/rpm.ml b/src/rpm.ml index 4d31472..d3ab7da 100644 --- a/src/rpm.ml +++ b/src/rpm.ml @@ -210,8 +210,42 @@ let rpm_package_name pkg = let rpm_get_package_database_mtime () = (lstat "/var/lib/rpm/Packages").st_mtime -(* Memo of resolved provides. *) -let rpm_providers = Hashtbl.create 13 +(* Return the best provider of a particular RPM requirement. + * + * There may be multiple, or no providers. In case there are multiple, + * choose the one with the shortest name (as yum used to). + * + * We could do better here: http://yum.baseurl.org/wiki/CompareProviders + *) +let pr...

While trying to run libguestfs tests after building with "--enable-appliance --with-supermin-extra-options=--use-installed", I ran into a peculiar error message in the c-api test: ,---- | libguestfs: error: strings: /abssymlink: strings: error while loading | shared libraries: libbfd-2.24-multiarch.so: cannot open shared object | file: No such file or directory `---- The problem here

...tbuf -let run_parts_host ~debug hooks_dir hook_name scripts run_script = +let run_parts_host ~debug (g : Guestfs.guestfs) hooks_dir hook_name base_mount_dir scripts run_script = let hook_dir = hooks_dir // hook_name in let scripts = List.sort digit_prefix_compare scripts in - let timings = Hashtbl.create 13 in - List.iter ( - fun x -> - message (f_"Running: %s/%s") hook_name x; - let cmd = [ run_script; hook_dir; x ] in - let run () = - run_command cmd in - let delta_t = timed_run run in - if debug >= 1 then ( - printf "\n"...

...or run. --- generator/utils.ml | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/generator/utils.ml b/generator/utils.ml index 3a62084..1b00ce5 100644 --- a/generator/utils.ml +++ b/generator/utils.ml @@ -291,10 +291,22 @@ let pod2text_memo : (memo_key, memo_value) Hashtbl.t = v with _ -> Hashtbl.create 13 -let pod2text_memo_updated () = +let pod2text_memo_unsaved_count = ref 0 +let pod2text_memo_atexit = ref false +let pod2text_memo_save () = let chan = open_out pod2text_memo_filename in output_value chan pod2text_memo; close_out chan +let p...

Fix for https://bugzilla.redhat.com/show_bug.cgi?id=1266918

...10-1301 USA. > + *) > + > +(** Parsing and handling of elements. *) > + > +type element = { > + directory : string; (** directory of the element *) > + hooks : hooks_map; (** available hooks, and scripts for each hook *) > +} > +and hooks_map = (string, string list) Hashtbl.t (** hook name, scripts *) > + > +val builtin_elements_blacklist : string list > +val builtin_scripts_blacklist : string list The above have documentation comments in the .ml, I guess the comments can be moved here. > +val load_elements : debug:int -> string list -> (string, el...

- refactor memoization code - pass pod as stdin rather than files Pino Toscano (3): generator: isolate memoized cache in own module generator: adjust variable names generator: improve pod2text invocation generator/Makefile.am | 3 ++ generator/memoized_cache.ml | 62 +++++++++++++++++++++ generator/memoized_cache.mli | 29 ++++++++++ generator/utils.ml | 101

...ption * string (* key + subkey + value *) (* Calls yyparse in the C code. *) external parse_index : string -> sections = "virt_builder_parse_index" @@ -149,12 +149,17 @@ let get_index ~prog ~debug ~downloader ~sigchecker source = fun (n, fields) -> let fseen = Hashtbl.create 13 in List.iter ( - fun (field, _) -> - if Hashtbl.mem fseen field then ( - eprintf (f_"virt-builder: index is corrupt: %s: field '%s' appears two or more times\n") n field; + fun (field, subkey, _) -> + le...

Move the OCaml binding to C _exit to an own module. Just code motion, adapting v2v in the process. --- docs/C_SOURCE_FILES | 2 +- mllib/Makefile.am | 5 ++++- mllib/exit-c.c | 33 +++++++++++++++++++++++++++++++++ mllib/exit.ml | 19 +++++++++++++++++++ mllib/exit.mli | 20 ++++++++++++++++++++ v2v/Makefile.am | 1 - v2v/changeuid-c.c | 33

...anxiao <chenhanxiao@cn.fujitsu.com> --- resize/resize.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/resize/resize.ml b/resize/resize.ml index d7a8ce1..92f7304 100644 --- a/resize/resize.ml +++ b/resize/resize.ml @@ -616,6 +616,8 @@ read the man page virt-resize(1). let hash = Hashtbl.create 13 in List.iter (fun ({ p_name = name } as p) -> Hashtbl.add hash name p) partitions; + List.iter (fun ({ p_name = name } as p) -> Hashtbl.add hash name p) + logical_partitions; fun ~option name -> let name = if String.length name < 5 || S...

...et default = diff --git a/v2v/utils.ml b/v2v/utils.ml index ec69abb..6e68583 100644 --- a/v2v/utils.ml +++ b/v2v/utils.ml @@ -79,15 +79,6 @@ let compare_app2_versions app1 app2 = compare_version app1.Guestfs.app2_release app2.Guestfs.app2_release ) -let remove_duplicates xs = - let h = Hashtbl.create (List.length xs) in - let rec loop = function - | [] -> [] - | x :: xs when Hashtbl.mem h x -> xs - | x :: xs -> Hashtbl.add h x true; x :: loop xs - in - loop xs - let du filename = (* There's no OCaml binding for st_blocks, so run coreutils 'du'. *)...

On Tuesday 21 January 2014 16:37:20 Richard W.M. Jones wrote: > On Tue, Jan 21, 2014 at 05:18:27PM +0100, Pino Toscano wrote: > > + sv = caml_copy_string (fields->subkey ? fields->subkey : ""); > > > > Store_field (v, 1, sv); > > Heh, sure would be nice if this was an option type :-) > > I believe the following should work: > >

...tring * string (* key + subkey + value *) (* Calls yyparse in the C code. *) external parse_index : string -> sections = "virt_builder_parse_index" @@ -149,12 +149,13 @@ let get_index ~prog ~debug ~downloader ~sigchecker source = fun (n, fields) -> let fseen = Hashtbl.create 13 in List.iter ( - fun (field, _) -> - if Hashtbl.mem fseen field then ( + fun (field, subkey, _) -> + let hashkey = (field, subkey) in + if Hashtbl.mem fseen hashkey then ( eprintf (f_"virt-builder: index...

...| PMSuspendDisk of ([`R] Domain.t -> PM_suspend_disk.t -> unit) + + type callback_id = int64 + + let fresh_callback_id = + let next = ref 0L in + fun () -> + let result = !next in + next := Int64.succ !next; + result + + let make_table value_name = + let table = Hashtbl.create 16 in + let callback callback_id generic x = + if Hashtbl.mem table callback_id + then Hashtbl.find table callback_id generic x in + let _ = Callback.register value_name callback in + table + + let u_table = make_table "Libvirt.u_callback" + let i_table = make_...

...> compare s1 s2 + in (* Fill an hash with the higher revision of the available * (name, arch) tuples, so it possible to ignore duplicates, * and versions with a lower revision. @@ -44,7 +51,7 @@ let remove_duplicates index = let id = name, arch in try let rev = Hashtbl.find nseen id in - if revision > rev then + if compare_revisions rev revision > 0 then Hashtbl.replace nseen id revision with Not_found -> Hashtbl.add nseen id revision diff --git a/builder/cache.ml b/builder/cache.ml index e73bcfd..8b63a86 100644 -...