aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel/Runtime.ml
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/kernel/Runtime.ml47
1 files changed, 21 insertions, 26 deletions
diff --git a/lib/kernel/Runtime.ml b/lib/kernel/Runtime.ml
index 6b4f5a4..aa69791 100644
--- a/lib/kernel/Runtime.ml
+++ b/lib/kernel/Runtime.ml
@@ -1,50 +1,45 @@
-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
+ condition "registry-object-update-conflict" "Failed to update the in-memory object registry"
+ empty
end
-module CAS : REGISTRY_STRATEGY = struct
+module CAS : Backend.Managers.Object.RUNTIME_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 ())
+ 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)
+module Make (Strategy : Backend.Managers.Object.RUNTIME_STRATEGY) (Store : Abstract.Storage.STORAGE) =
+struct
+ module Init = Initialization.Make (Store)
+ module Objects = Backend.Managers.Object.Make (Strategy)
- type photograph =
- { branch_index_root: Concepts.Hash.hash
- ; registry : Backend.Managers.Object.rnt_object_tree }
+ type t = {connection: Store.connection; objects: Objects.t}
- 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
-
+ (* Registry reconstruction from the branch index is the loader boundary.
+ Until that loader exists, publish only the permanent /system namespace;
+ importantly, the discovered root remains part of the photograph. *)
+ let objects = Objects.create ~branch_index_root ~registry:Backend.Managers.Object.root in
+ Ok {connection; objects}
+
+ let connection runtime = runtime.connection
+ let objects runtime = runtime.objects
end