From cf050463faa996acaeb30fd81c4045b51573386d Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Sun, 2 Aug 2026 19:44:43 -0300 Subject: runtime with cas skeleton --- lib/kernel/Initialization.ml | 2 -- lib/kernel/Initialization.mli | 1 - lib/kernel/Runtime.ml | 50 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 50 insertions(+), 3 deletions(-) create mode 100644 lib/kernel/Runtime.ml (limited to 'lib') 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 -- cgit v1.2.3