Permalink
Browse files

[feature] database: Made improvements in db-light wrt. large transact…

…ions.
  • Loading branch information...
1 parent 5448d6f commit 973aed671a199277e0b2bf6784f065ac141a775c @nrs135 nrs135 committed with Louis Gesbert Jul 29, 2011
View
@@ -7,6 +7,7 @@
<gml_parser.{ml,mli,byte,native}>: use_libtrx
<light/*.{ml,mli,byte,native}>: use_dbm
+#<light/*.{ml,mli,byte,native}>: profile
<badop_{protocol,server,client}.ml>: rectypes
View
@@ -25,6 +25,7 @@ type 'a answer = [ `Answer of 'a | `Absent | `Linkto of Badop.path ]
type database = { session: Session_light.t; file: string; mutable node_config : Node_property.config }
type transaction = { db: database; tr: Transaction_light.t }
+let (@>) f x = f x
let (|>) x f = f x
let open_database options k =
@@ -55,16 +56,19 @@ let close_database db k =
let status db k = Badop.Light db.file |> k
+let start_time = ref 0.0
+
module Tr = struct
let start db _errk k =
- (*Logger.debug "Badop_light.Tr.start";*)
+ Logger.debug "Badop_light.Tr.start";
+ #<If:BADOP_DEBUG$minlevel 10>start_time := Unix.gettimeofday ()#<End>;
{ db = db; tr = Session_light.new_trans db.session } |> k
let start_at_revision db _rev _errk k =
{ db = db; tr = Session_light.new_trans (*~read_only:(true, Some rev)*) db.session } |> k
let prepare trans k =
- (*Logger.debug "Badop_light.Tr.prepare";*)
+ Logger.debug "Badop_light.Tr.prepare";
(* Executes [k] as soon as prepare finished, asynchronously, nonblocking.
When prepare is postponed and stored on the FIFO,
the continuation is stored as well. The exceptions from [k]
@@ -77,13 +81,17 @@ module Tr = struct
({db = trans.db; tr = trans.tr}, true) |> k
let commit trans k =
- (*Logger.debug "Badop_light.Tr.commit";*)
+ Logger.debug "Badop_light.Tr.commit";
if Transaction_light.modified trans.tr then
(* Assumption: [trans] is prepared by [execute_trans_prepare].
Here some continuations of [prepare] may be executed, but only in case
when some transactions are on the FIFO and are being prepared
after the actual commit is completed. *)
- Session_light.really_commit trans.db.session trans.tr |> k
+ Session_light.really_commit trans.db.session trans.tr
+ |> (fun tf ->
+ #<If:BADOP_DEBUG$minlevel 10>Logger.debug "DB-LIGHT : Badop_light.commit: time=%f\n%!"
+ ((Unix.gettimeofday()) -. !start_time)#<End>;
+ tf |> k)
else
true |> k
@@ -98,23 +106,23 @@ type 'which read_op = ('which,revision) Badop.generic_read_op
let read trans path op k =
match op with
| Badop.Stat (D.Query () as q) ->
- (*Logger.debug "Badop_light.read Stat";*)
+ Logger.debug "Badop_light.read Stat";
(try `Answer (Badop.Stat (D.Dialog_aux.respond q (Session_light.stat trans.tr path)))
with Db_light.UnqualifiedPath -> `Absent) |> k
| Badop.Contents (D.Query () as q) ->
- (*Logger.debug "Badop_light.read Contents";*)
+ Logger.debug "Badop_light.read Contents";
(try `Answer (Badop.Contents (D.Dialog_aux.respond q (Session_light.get trans.db.session trans.tr path)))
with Db_light.UnqualifiedPath -> `Absent) |> k
| Badop.Children (D.Query range as q) ->
- (*Logger.debug "Badop_light.read Children";*)
+ Logger.debug "Badop_light.read Children";
(try
`Answer
(Badop.Children
(D.Dialog_aux.respond q
(Session_light.get_children trans.db.session trans.tr range path)))
with Db_light.UnqualifiedPath -> `Absent) |> k
| Badop.Revisions (D.Query _range as q) ->
- (*Logger.debug "Badop_light.read Revisions";*)
+ Logger.debug "Badop_light.read Revisions";
(try
`Answer
(Badop.Revisions
@@ -124,7 +132,7 @@ let read trans path op k =
|> List.map (fun rev -> rev, Session_light.get_timestamp trans.db.session))))
with Db_light.UnqualifiedPath -> `Absent) |> k
| Badop.Search (D.Query (words, _range_FIXME) as q) ->
- (*Logger.debug "Badop_light.read Search";*)
+ Logger.debug "Badop_light.read Search";
(try
`Answer
(Badop.Search
@@ -140,22 +148,22 @@ type 'which write_op = ('which,transaction,revision) Badop.generic_write_op
let write trans path op k =
match op with
| Badop.Set (D.Query data as q) ->
- (*Logger.debug "Badop_light.write Set";*)
+ Logger.debug "Badop_light.write Set";
Badop.Set (D.Dialog_aux.respond q { trans with tr = Session_light.set trans.tr path data }) |> k
| Badop.Clear (D.Query () as q) ->
- (*Logger.debug "Badop_light.write Clear";*)
+ Logger.debug "Badop_light.write Clear";
Badop.Clear
(D.Dialog_aux.respond q
(try
{ trans with tr = Session_light.remove trans.tr path }
with Db_light.UnqualifiedPath -> trans)) |> k
| Badop.Link (D.Query linkpath as q) ->
- (*Logger.debug "Badop_light.write Link";*)
+ Logger.debug "Badop_light.write Link";
Badop.Link
(D.Dialog_aux.respond q
{ trans with tr = Session_light.set_link trans.tr path linkpath }) |> k
| Badop.Copy (D.Query (copypath,copyrev) as q) ->
- (*Logger.debug "Badop_light.write Copy";*)
+ Logger.debug "Badop_light.write Copy";
Badop.Copy
(D.Dialog_aux.respond q
{ trans with tr = Session_light.set_copy trans.db.session trans.tr path (copypath, copyrev) }) |> k
View
@@ -39,7 +39,7 @@ exception At_leaf
(* Flags *)
let verify = ref false
-let use_od = ref true
+let use_od = ref false
let od_early = ref false
(* Datatypes *)
@@ -136,6 +136,12 @@ let rec copy_node t parent tree =
(* Basic database operations *)
+(*let ta acc f a =
+ let start = Unix.gettimeofday () in
+ let res = f a in
+ acc := !acc +. ((Unix.gettimeofday ()) -. start);
+ res*)
+
let set_version t version = t.version <- version
let set_filemanager t filemanager = t.db_filemanager <- filemanager
let set_max_size t max_size = t.max_size <- max_size
@@ -179,12 +185,14 @@ let ondemand_prime t path tree =
());
tree.disk <- true)
+let ondemand_add_1 = ref 0.0
+
let ondemand_add t path node =
match getdbm t with
| Some dbm ->
#<If$minlevel 10>Logger.log ~color:`yellow "DB-LIGHT : ondemand add path=%s to %s"
(Path.to_string path) (Node_light.to_string node)#<End>;
- Dbm.replace dbm (Encode_light.encode_path path) (Encode_light.encode_node node)
+ (*ta ondemand_add_1*) (Dbm.replace dbm (Encode_light.encode_path path)) (Encode_light.encode_node node)
| None ->
#<If>Logger.log ~color:`red "DB-LIGHT : ondemand_add Dbm is closed"#<End>
@@ -219,6 +227,7 @@ let add_od_act p act =
| None -> ())
#<End>;
Hashtbl.replace odacts p act
+ (*eprintf "add_od_act: #odacts=%d\n%!" (Hashtbl.length odacts)*)
let same_t t1 t2 =
match (t1.db_filemanager, t2.db_filemanager) with
@@ -249,8 +258,8 @@ let action_od () =
then
((*eprintf "od_acts: %s\n%!" (string_of_odacts ());*)
Hashtbl.iter (fun p -> function
- | OD_Add (t, n) -> ondemand_add t p n
- | OD_Remove (t, what) -> ondemand_remove what t p) odacts;
+ | OD_Add (t, n) -> ondemand_add t p n
+ | OD_Remove (t, what) -> ondemand_remove what t p) odacts;
Hashtbl.clear odacts)
let rec ondemand_remove_subtree t path tree_opt =
@@ -399,21 +408,26 @@ let verifies t path = function
| Some _ -> false
| None -> true)
+let update_data_1 = ref 0.0
+let update_data_2 = ref 0.0
+let update_data_3 = ref 0.0
+
let update_data t path data tree =
- (*eprintf "update_data: path=%s ks=%s data=%s tree=%d\n%!"
- (Path.to_string path) (string_of_keyset ks) (Datas.to_string data) (Uid.value tree.uid);*)
+ (*eprintf "update_data: path=%s data=%s tree=%d\n%!" (Path.to_string path) (Datas.to_string data) (Uid.value tree.uid);*)
let _old_data = Node_light.get_content tree.node in
(if not tree.disk
- then (match od_read true t path with
+ then (Node_light.set_content ~max_size:t.max_size tree.node data;
+ (*ta update_data_1*) (od_add t path) tree.node
+ (*match ta update_data_1 (od_read true t) path with
| Some nodes ->
(*eprintf "nodes=%s data=%s kss=%s ks=%s\n%!"
(Node_light.to_string nodes) (Datas.to_string data) (string_of_keyset kss) (string_of_keyset ks);*)
if not (Node_light.equals_data nodes data)
then (Node_light.set_content ~max_size:t.max_size tree.node data;
- od_add t path tree.node)
+ ta update_data_2 (od_add t path) tree.node)
| None ->
Node_light.set_content ~max_size:t.max_size tree.node data;
- od_add t path tree.node)
+ ta update_data_3 (od_add t path) tree.node*))
else
if not (Node_light.equals_data tree.node data)
then (Node_light.set_content ~max_size:t.max_size tree.node data;
@@ -423,14 +437,16 @@ let update_data t path data tree =
(Datas.to_string data) (Datas.to_string _old_data)
(if Node_light.equals_data tree.node data then "new" else "old")#<End>
+let add_tree_1 = ref 0.0
+
let add_tree ?(no_write=false) t path data =
#<If>Logger.log ~color:`yellow "DB-LIGHT : add_tree: path=%s data=%s" (Path.to_string path) (Datas.to_string data)#<End>;
let rec aux pt here tree = function
| [] ->
tree.up := pt;
if no_write
then Node_light.set_content ~max_size:t.max_size tree.node data
- else update_data t path data tree
+ else (*ta add_tree_1*) (update_data t path data) tree
| k::rest ->
(try
let st = Hashtbl.find tree.sts k in
@@ -22,6 +22,11 @@ exception Merge
val verify : bool ref
val use_od : bool ref
val od_early : bool ref
+val add_tree_1 : float ref
+val ondemand_add_1 : float ref
+val update_data_1 : float ref
+val update_data_2 : float ref
+val update_data_3 : float ref
(* types *)
type t
@@ -220,7 +220,8 @@ let good = List.for_all tstk allk
let encode_keylist (kl:Keys.t list) =
String.concat_map ~left:(put_len 'p' 'q' 'P' 'Q' (List.length kl)) "" encode_key kl
-let encode_path (path:Path.t) = encode_keylist (Path.to_list path)
+(*let encode_path (path:Path.t) = encode_keylist (Path.to_list path)*)
+let encode_path (path:Path.t) = Marshal.to_string path []
let decode_keylist s i =
let i, len = get_len 'p' 'q' 'P' 'Q' s i s.[i] in
@@ -233,9 +234,10 @@ let decode_keylist s i =
in
aux i 0 []
-let decode_path s i =
+(*let decode_path s i =
let i, kl = decode_keylist s i in
- i, Path.of_list kl
+ i, Path.of_list kl*)
+let decode_path s i = (String.length s, (Marshal.from_string s i:Path.t))
(*
let p1 = Path.of_list [k1;k2]
@@ -288,19 +290,21 @@ let good = List.for_all tstdi alldi
*)
-let encode_datas = function
+(*let encode_datas = function
| Datas.Data di -> "e"^(encode_dataimpl di)
| Datas.Link p -> "n"^(encode_path p)
| Datas.Copy (_,p) -> "o"^(encode_path p)
- | Datas.UnsetData -> "U"
+ | Datas.UnsetData -> "U"*)
+let encode_datas (path:Datas.t) = Marshal.to_string path []
-let decode_datas s i =
+(*let decode_datas s i =
match s.[i] with
| 'e' -> let i, di = decode_dataimpl s (i+1) in i, Datas.Data di
| 'n' -> let i, p = decode_path s (i+1) in i, Datas.Link p
| 'o' -> let i, p = decode_path s (i+1) in i, Datas.Copy (None,p)
| 'U' -> i+1, Datas.UnsetData
- | _ -> assert false
+ | _ -> assert false*)
+let decode_datas s i = (String.length s, (Marshal.from_string s i:Datas.t))
(*
let d1 = Datas.Data di1
@@ -313,20 +317,22 @@ let tstd d = d = snd (decode_datas (encode_datas d) 0)
let good = List.for_all tstd alld
*)
-let encode_node { Node_light. on_disk; disk_file; content } =
+(*let encode_node { Node_light. on_disk; disk_file; content } =
match on_disk, disk_file with
| true, Some file -> (put_len 'g' 'h' 'G' 'H' (String.length file))^file
- | _, _ -> "k"^(encode_datas content)
+ | _, _ -> "k"^(encode_datas content)*)
+let encode_node (path:Node_light.t) = Marshal.to_string path []
-let decode_node s i =
+(*let decode_node s i =
match s.[i] with
| ('g' | 'h' | 'G' | 'H') as c ->
let i, len = get_len 'g' 'h' 'G' 'H' s i c in
(i+len, { Node_light. on_disk=true; disk_file=Some (String.sub s i len); content=Datas.UnsetData; })
| 'k' ->
let i, d = decode_datas s (i+1) in
i, { Node_light. on_disk=false; disk_file=None; content=d; }
- | _ -> assert false
+ | _ -> assert false*)
+let decode_node s i = (String.length s, (Marshal.from_string s i:Node_light.t))
(*
let n1 = { Node_light. on_disk=false; disk_file=None; content=Datas.Data (DataImpl.Text "abc") }
@@ -20,6 +20,7 @@
(* shorthands *)
module DT = DbTypes
module String = BaseString
+let eprintf fmt = Printf.eprintf fmt
let sprintf fmt = Printf.sprintf fmt
(* debug *)
@@ -199,7 +200,7 @@ let sprintf fmt = Printf.sprintf fmt
let oc = open_out mtree_file in
Mem_tree_light.output_mt oc (Db_light.get_mtree t.db_ref);
close_out oc;
- Logger.log "close_db: mtree_file=%s" mtree_file;
+ #<If$minlevel 20>Logger.log "close_db: mtree_file=%s" mtree_file#<End>;
let _position = position file in
Logger.info "DB-LIGHT : Closing the database at %s" file;
Io_light.close t.file_manager;
@@ -209,7 +210,7 @@ let sprintf fmt = Printf.sprintf fmt
let restart_db_from_last t =
let db = t.db_ref in
let mtree_file = Io_light.get_location t.file_manager^"_mtree" in
- Logger.log "restart_db_from_last: mtree_file=%s" mtree_file;
+ #<If$minlevel 20>Logger.log "restart_db_from_last: mtree_file=%s" mtree_file#<End>;
let has_mtree =
try
let ic = open_in mtree_file in
@@ -544,7 +545,14 @@ let sprintf fmt = Printf.sprintf fmt
(* writing to DB *)
- let set trans path data = Tr.set trans path data
+ (*let last = ref (Unix.gettimeofday())*)
+ let set trans path data =
+ (*eprintf(*Logger.log ~color:`magenta*) "DB-LIGHT : Session_light.set: since last=%f\n%!" ((Unix.gettimeofday()) -. !last);*)
+ (*let start = Unix.gettimeofday () in*)
+ let res = Tr.set trans path data in
+ (*eprintf(*Logger.log ~color:`magenta*) "DB-LIGHT : Session_light.set: time=%f\n%!" ((Unix.gettimeofday()) -. start);*)
+ (*last := Unix.gettimeofday ();*)
+ res
let remove trans path = Tr.remove trans path
Oops, something went wrong.

0 comments on commit 973aed6

Please sign in to comment.