diff options
| -rw-r--r-- | lib/abstract/Storage.ml | 3 | ||||
| -rw-r--r-- | lib/backend/storage/LMDB.ml | 16 | ||||
| -rw-r--r-- | lib/kernel/SubstantialRelation.ml | 2 |
3 files changed, 17 insertions, 4 deletions
diff --git a/lib/abstract/Storage.ml b/lib/abstract/Storage.ml index e921be9..888a354 100644 --- a/lib/abstract/Storage.ml +++ b/lib/abstract/Storage.ml @@ -9,6 +9,9 @@ module type STORAGE = sig (** begin a transaction within `connection` *) val start : connection -> (transaction, Concepts.Condition.condition) result + (** begin a read-only transaction, which may be held alongside others *) + val start_read : connection -> (transaction, Concepts.Condition.condition) result + (** `commit` the current transaction *) val commit : transaction -> (unit, Concepts.Condition.condition) result diff --git a/lib/backend/storage/LMDB.ml b/lib/backend/storage/LMDB.ml index be23128..92de30e 100644 --- a/lib/backend/storage/LMDB.ml +++ b/lib/backend/storage/LMDB.ml @@ -118,6 +118,11 @@ module C = struct module Errors = struct let mdb_notfound = -30798 end + + module Flags = struct + let mdb_notls = Unsigned.UInt.of_int 0x200000 + let mdb_rdonly = Unsigned.UInt.of_int 0x20000 + end end module Error = struct @@ -147,7 +152,9 @@ let connect (c : Concepts.Configuration.term) = let* path, mode = parse c in begin let* env = C.mdb_env_create' () in - match C.mdb_env_open env path Unsigned.UInt.zero (PosixTypes.Mode.of_int mode) with + (* NOTLS ties readers to transactions rather than threads, so one + thread can hold several read transactions (nested cursors). *) + match C.mdb_env_open env path C.Flags.mdb_notls (PosixTypes.Mode.of_int mode) with | Error x -> C.mdb_env_close env; Error x | Ok () -> let* tx = C.mdb_txn_begin' env C.null_txn Unsigned.UInt.zero in @@ -160,11 +167,14 @@ let connect (c : Concepts.Configuration.term) = Concepts.Condition.( complement ("path" |=| Concepts.Value.String path & "mode" |=| Concepts.Value.Integer mode) ) -let start ({env; dbi} : connection) = - C.mdb_txn_begin' env C.null_txn Unsigned.UInt.zero +let begin_with flags ({env; dbi} : connection) = + C.mdb_txn_begin' env C.null_txn flags |> Result.map (fun tx -> {tx; dbi; active = true;}) |> Result.map_error Error.lmdb_error +let start = begin_with Unsigned.UInt.zero +let start_read = begin_with C.Flags.mdb_rdonly + let commit transaction = if not transaction.active then Error Error.closed_transaction else begin diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml index 1b58e9a..d3f306b 100644 --- a/lib/kernel/SubstantialRelation.ml +++ b/lib/kernel/SubstantialRelation.ml @@ -130,7 +130,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct let scan storage relation ~keep = let open Utilities.Result in - let* tx = S.start storage in + let* tx = S.start_read storage in let* node = tuple_node tx relation in let closed = ref false in let close () = if not !closed then begin closed := true; ignore (S.abort tx) end in |