aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel
diff options
context:
space:
mode:
Diffstat (limited to 'lib/kernel')
-rw-r--r--lib/kernel/Initialization.ml2
-rw-r--r--lib/kernel/Initialization.mli1
-rw-r--r--lib/kernel/Runtime.ml50
3 files changed, 50 insertions, 3 deletions
diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml
index 767dcca..375070f 100644
--- a/lib/kernel/Initialization.ml
+++ b/lib/kernel/Initialization.ml
@@ -100,8 +100,6 @@ module Make (Store : Abstract.Storage.STORAGE) = struct
let* () = store_fixed_root tx root in
Ok root
- let read connection = with_transaction connection read_in_transaction
-
let initialize connection =
with_transaction connection (fun tx ->
let open Utilities.Result in
diff --git a/lib/kernel/Initialization.mli b/lib/kernel/Initialization.mli
index 4f98215..5c348bd 100644
--- a/lib/kernel/Initialization.mli
+++ b/lib/kernel/Initialization.mli
@@ -5,6 +5,5 @@ val fixed_label : string
val fixed_label_address : address
module Make (Store : Abstract.Storage.STORAGE) : sig
- val read : Store.connection -> (branch_index_root option, Concepts.Condition.condition) result
val initialize : Store.connection -> (branch_index_root, Concepts.Condition.condition) result
end
diff --git a/lib/kernel/Runtime.ml b/lib/kernel/Runtime.ml
new file mode 100644
index 0000000..6b4f5a4
--- /dev/null
+++ b/lib/kernel/Runtime.ml
@@ -0,0 +1,50 @@
+module type REGISTRY_STRATEGY = sig
+ type 'a state
+ (* The exact snapshot observed on acquire *)
+ type 'a token
+
+ val create : 'a -> 'a state
+ val acquire : 'a state -> 'a * 'a token
+ val publish : 'a state -> 'a token -> 'a -> (unit, Concepts.Condition.condition) result
+end
+
+module Error = struct
+ open Concepts.Condition
+ let registry_conflict () =
+ let msg = "Failed to update the in-memory object registry." in
+ condition "registry-object-update-conflict" msg empty
+end
+
+module CAS : REGISTRY_STRATEGY = struct
+ type 'a state = 'a Atomic.t
+ type 'a token = 'a
+ let create = Atomic.make
+ let acquire state =
+ let photograph = Atomic.get state in
+ (* Just the same here because of CAS. On MVCC this would be a version number*)
+ photograph, photograph
+ let publish state token next =
+ if Atomic.compare_and_set state token next then Ok ()
+ else Error (Error.registry_conflict ())
+end
+
+(* module MVCC : REGISTRY_STRATEGY = struct end *)
+(* module RCU : REGISTRY_STRATEGY = struct end *)
+
+module Make (Strategy : REGISTRY_STRATEGY) (Store: Abstract.Storage.STORAGE) = struct
+ module Init = Initialization.Make(Store)
+
+ type photograph =
+ { branch_index_root: Concepts.Hash.hash
+ ; registry : Backend.Managers.Object.rnt_object_tree }
+
+ type t =
+ { connection : Store.connection
+ ; state : photograph Strategy.state }
+
+ let initialize configuration : (t, Concepts.Condition.condition) result =
+ let open Utilities.Result in
+ let* connection = Store.connect configuration in
+ let* branch_index_root = Init.initialize connection in
+
+end