From 6afef56cb1e466e36a7df398fd114cf1b5478ed2 Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Fri, 7 Aug 2026 11:08:08 +0000 Subject: [PATCH 1/3] Instrument concurrent named call-site cache Co-authored-by: Ademar Gonzalez --- IronKernel/RuntimeDispatch.fs | 139 ++++++++++++++++++++++++++++------ 1 file changed, 116 insertions(+), 23 deletions(-) diff --git a/IronKernel/RuntimeDispatch.fs b/IronKernel/RuntimeDispatch.fs index 625013f..5e21964 100644 --- a/IronKernel/RuntimeDispatch.fs +++ b/IronKernel/RuntimeDispatch.fs @@ -4,6 +4,10 @@ namespace IronKernel module RuntimeDispatch = open System + open System.IO + open System.Runtime.CompilerServices + open System.Text.Json + open System.Threading open Ast open Errors open Eval @@ -41,6 +45,23 @@ module RuntimeDispatch = let mutable cachedVersion = 0L let mutable cachedCombiner : LispVal = Nil let mutable eagerUnderlying : LispVal voption = ValueNone + let debugGate = obj () + let mutable debugEntryCount = 0 + let mutable debugRefillCount = 0 + let mutable debugExitCount = 0 + + let objectId (value: obj) = + if isNull value then 0 else RuntimeHelpers.GetHashCode(value) + + let debugLog hypothesisId location message (data: obj) = + let payload = + JsonSerializer.Serialize( + {| hypothesisId = hypothesisId + location = location + message = message + data = data + timestamp = DateTimeOffset.UtcNow.ToUnixTimeMilliseconds() |}) + lock debugGate (fun () -> File.AppendAllText("/opt/cursor/logs/debug.log", payload + "\n")) let classifyEager combiner = if not simpleOperands then ValueNone @@ -56,15 +77,28 @@ module RuntimeDispatch = | _ -> ValueNone let cacheValid env = - obj.ReferenceEquals(env, cachedEnv) - && cachedCell.state.version = cachedVersion - && (let mutable consistent = true - let mutable index = 0 - while consistent && index < cachedPath.Length do - let entry = cachedPath.[index] - consistent <- entry.frame.bindings.Count = entry.bindingCount - index <- index + 1 - consistent) + let initialCachedEnv = cachedEnv + let envMatched = obj.ReferenceEquals(env, initialCachedEnv) + let valid = + envMatched + && cachedCell.state.version = cachedVersion + && (let mutable consistent = true + let mutable index = 0 + while consistent && index < cachedPath.Length do + let entry = cachedPath.[index] + consistent <- entry.frame.bindings.Count = entry.bindingCount + index <- index + 1 + consistent) + // #region agent log + if envMatched && not (obj.ReferenceEquals(initialCachedEnv, cachedEnv)) then + debugLog "D" "RuntimeDispatch.fs:cacheValid" "cache environment changed during validation" + (box {| threadId = Environment.CurrentManagedThreadId + invokeEnvId = objectId env + initialCachedEnvId = objectId initialCachedEnv + finalCachedEnvId = objectId cachedEnv + valid = valid |}) + // #endregion + valid let rec evaluateSimpleOperands env evaluated remaining = match remaining with @@ -76,7 +110,22 @@ module RuntimeDispatch = | value :: rest -> evaluateSimpleOperands env (value :: evaluated) rest let dispatch env cont = - match eagerUnderlying with + let dispatchCachedEnv = cachedEnv + let dispatchCachedCell = cachedCell + let dispatchEager = eagerUnderlying + // #region agent log + if not (obj.ReferenceEquals(env, dispatchCachedEnv)) then + debugLog "B" "RuntimeDispatch.fs:dispatch" "dispatch cache belongs to another environment" + (box {| threadId = Environment.CurrentManagedThreadId + invokeEnvId = objectId env + cachedEnvId = objectId dispatchCachedEnv + cachedCellId = if isNull (box dispatchCachedCell) then -1L else dispatchCachedCell.id + eagerId = + match dispatchEager with + | ValueSome underlying -> objectId underlying + | ValueNone -> 0 |}) + // #endregion + match dispatchEager with | ValueSome underlying -> match evaluateSimpleOperands env [] operands with | Choice1Of2 error -> throwError error @@ -84,20 +133,64 @@ module RuntimeDispatch = | ValueNone -> operate env cont cachedCombiner operands member _.Invoke(env: LispVal, cont: LispVal) : ThrowsError = - if not (isNull cachedPath) && cacheValid env then - dispatch env cont - else - match SymbolTable.resolveBindingCellWithPath env name with - | ValueNone -> throwError (UnboundVar("Getting an unbound variable", name)) - | ValueSome(cell, visitedPath) -> - let state = cell.state - cachedEnv <- env - cachedPath <- visitedPath - cachedCell <- cell - cachedVersion <- state.version - cachedCombiner <- state.value - eagerUnderlying <- classifyEager state.value + // #region agent log + if Interlocked.Increment(&debugEntryCount) <= 16 then + debugLog "A" "RuntimeDispatch.fs:Invoke:entry" "named call-site invocation entered" + (box {| threadId = Environment.CurrentManagedThreadId + name = name + invokeEnvId = objectId env + cachedEnvId = objectId cachedEnv + hasCachedPath = not (isNull cachedPath) |}) + // #endregion + let result = + if not (isNull cachedPath) && cacheValid env then dispatch env cont + else + match SymbolTable.resolveBindingCellWithPath env name with + | ValueNone -> throwError (UnboundVar("Getting an unbound variable", name)) + | ValueSome(cell, visitedPath) -> + let state = cell.state + // #region agent log + if Interlocked.Increment(&debugRefillCount) <= 16 then + debugLog "A" "RuntimeDispatch.fs:Invoke:resolved" "cache refill resolved invocation binding" + (box {| threadId = Environment.CurrentManagedThreadId + invokeEnvId = objectId env + resolvedCellId = cell.id + resolvedValueId = objectId state.value + resolvedEagerId = + match classifyEager state.value with + | ValueSome underlying -> objectId underlying + | ValueNone -> 0 + pathLength = visitedPath.Length |}) + // #endregion + cachedEnv <- env + cachedPath <- visitedPath + cachedCell <- cell + cachedVersion <- state.version + cachedCombiner <- state.value + eagerUnderlying <- classifyEager state.value + // #region agent log + if not (obj.ReferenceEquals(env, cachedEnv)) || not (obj.ReferenceEquals(cell, cachedCell)) then + debugLog "B" "RuntimeDispatch.fs:Invoke:published" "cache refill was overwritten before dispatch" + (box {| threadId = Environment.CurrentManagedThreadId + invokeEnvId = objectId env + resolvedCellId = cell.id + cachedEnvId = objectId cachedEnv + cachedCellId = if isNull (box cachedCell) then -1L else cachedCell.id |}) + // #endregion + dispatch env cont + // #region agent log + if Interlocked.Increment(&debugExitCount) <= 16 then + debugLog "C" "RuntimeDispatch.fs:Invoke:exit" "named call-site invocation exited" + (box {| threadId = Environment.CurrentManagedThreadId + invokeEnvId = objectId env + resultKind = + match result with + | Choice1Of2 _ -> "error" + | Choice2Of2 (Obj (:? int)) -> "int" + | Choice2Of2 _ -> "other" |}) + // #endregion + result type GeneratedFunc = Func> From 4ae740526490fbdbdc9f1c43194a97086d9060fc Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Sat, 8 Aug 2026 03:51:45 +0000 Subject: [PATCH 2/3] Revert "Instrument concurrent named call-site cache" This reverts commit 6afef56cb1e466e36a7df398fd114cf1b5478ed2. --- IronKernel/RuntimeDispatch.fs | 139 ++++++---------------------------- 1 file changed, 23 insertions(+), 116 deletions(-) diff --git a/IronKernel/RuntimeDispatch.fs b/IronKernel/RuntimeDispatch.fs index 5e21964..625013f 100644 --- a/IronKernel/RuntimeDispatch.fs +++ b/IronKernel/RuntimeDispatch.fs @@ -4,10 +4,6 @@ namespace IronKernel module RuntimeDispatch = open System - open System.IO - open System.Runtime.CompilerServices - open System.Text.Json - open System.Threading open Ast open Errors open Eval @@ -45,23 +41,6 @@ module RuntimeDispatch = let mutable cachedVersion = 0L let mutable cachedCombiner : LispVal = Nil let mutable eagerUnderlying : LispVal voption = ValueNone - let debugGate = obj () - let mutable debugEntryCount = 0 - let mutable debugRefillCount = 0 - let mutable debugExitCount = 0 - - let objectId (value: obj) = - if isNull value then 0 else RuntimeHelpers.GetHashCode(value) - - let debugLog hypothesisId location message (data: obj) = - let payload = - JsonSerializer.Serialize( - {| hypothesisId = hypothesisId - location = location - message = message - data = data - timestamp = DateTimeOffset.UtcNow.ToUnixTimeMilliseconds() |}) - lock debugGate (fun () -> File.AppendAllText("/opt/cursor/logs/debug.log", payload + "\n")) let classifyEager combiner = if not simpleOperands then ValueNone @@ -77,28 +56,15 @@ module RuntimeDispatch = | _ -> ValueNone let cacheValid env = - let initialCachedEnv = cachedEnv - let envMatched = obj.ReferenceEquals(env, initialCachedEnv) - let valid = - envMatched - && cachedCell.state.version = cachedVersion - && (let mutable consistent = true - let mutable index = 0 - while consistent && index < cachedPath.Length do - let entry = cachedPath.[index] - consistent <- entry.frame.bindings.Count = entry.bindingCount - index <- index + 1 - consistent) - // #region agent log - if envMatched && not (obj.ReferenceEquals(initialCachedEnv, cachedEnv)) then - debugLog "D" "RuntimeDispatch.fs:cacheValid" "cache environment changed during validation" - (box {| threadId = Environment.CurrentManagedThreadId - invokeEnvId = objectId env - initialCachedEnvId = objectId initialCachedEnv - finalCachedEnvId = objectId cachedEnv - valid = valid |}) - // #endregion - valid + obj.ReferenceEquals(env, cachedEnv) + && cachedCell.state.version = cachedVersion + && (let mutable consistent = true + let mutable index = 0 + while consistent && index < cachedPath.Length do + let entry = cachedPath.[index] + consistent <- entry.frame.bindings.Count = entry.bindingCount + index <- index + 1 + consistent) let rec evaluateSimpleOperands env evaluated remaining = match remaining with @@ -110,22 +76,7 @@ module RuntimeDispatch = | value :: rest -> evaluateSimpleOperands env (value :: evaluated) rest let dispatch env cont = - let dispatchCachedEnv = cachedEnv - let dispatchCachedCell = cachedCell - let dispatchEager = eagerUnderlying - // #region agent log - if not (obj.ReferenceEquals(env, dispatchCachedEnv)) then - debugLog "B" "RuntimeDispatch.fs:dispatch" "dispatch cache belongs to another environment" - (box {| threadId = Environment.CurrentManagedThreadId - invokeEnvId = objectId env - cachedEnvId = objectId dispatchCachedEnv - cachedCellId = if isNull (box dispatchCachedCell) then -1L else dispatchCachedCell.id - eagerId = - match dispatchEager with - | ValueSome underlying -> objectId underlying - | ValueNone -> 0 |}) - // #endregion - match dispatchEager with + match eagerUnderlying with | ValueSome underlying -> match evaluateSimpleOperands env [] operands with | Choice1Of2 error -> throwError error @@ -133,64 +84,20 @@ module RuntimeDispatch = | ValueNone -> operate env cont cachedCombiner operands member _.Invoke(env: LispVal, cont: LispVal) : ThrowsError = - // #region agent log - if Interlocked.Increment(&debugEntryCount) <= 16 then - debugLog "A" "RuntimeDispatch.fs:Invoke:entry" "named call-site invocation entered" - (box {| threadId = Environment.CurrentManagedThreadId - name = name - invokeEnvId = objectId env - cachedEnvId = objectId cachedEnv - hasCachedPath = not (isNull cachedPath) |}) - // #endregion - let result = - if not (isNull cachedPath) && cacheValid env then + if not (isNull cachedPath) && cacheValid env then + dispatch env cont + else + match SymbolTable.resolveBindingCellWithPath env name with + | ValueNone -> throwError (UnboundVar("Getting an unbound variable", name)) + | ValueSome(cell, visitedPath) -> + let state = cell.state + cachedEnv <- env + cachedPath <- visitedPath + cachedCell <- cell + cachedVersion <- state.version + cachedCombiner <- state.value + eagerUnderlying <- classifyEager state.value dispatch env cont - else - match SymbolTable.resolveBindingCellWithPath env name with - | ValueNone -> throwError (UnboundVar("Getting an unbound variable", name)) - | ValueSome(cell, visitedPath) -> - let state = cell.state - // #region agent log - if Interlocked.Increment(&debugRefillCount) <= 16 then - debugLog "A" "RuntimeDispatch.fs:Invoke:resolved" "cache refill resolved invocation binding" - (box {| threadId = Environment.CurrentManagedThreadId - invokeEnvId = objectId env - resolvedCellId = cell.id - resolvedValueId = objectId state.value - resolvedEagerId = - match classifyEager state.value with - | ValueSome underlying -> objectId underlying - | ValueNone -> 0 - pathLength = visitedPath.Length |}) - // #endregion - cachedEnv <- env - cachedPath <- visitedPath - cachedCell <- cell - cachedVersion <- state.version - cachedCombiner <- state.value - eagerUnderlying <- classifyEager state.value - // #region agent log - if not (obj.ReferenceEquals(env, cachedEnv)) || not (obj.ReferenceEquals(cell, cachedCell)) then - debugLog "B" "RuntimeDispatch.fs:Invoke:published" "cache refill was overwritten before dispatch" - (box {| threadId = Environment.CurrentManagedThreadId - invokeEnvId = objectId env - resolvedCellId = cell.id - cachedEnvId = objectId cachedEnv - cachedCellId = if isNull (box cachedCell) then -1L else cachedCell.id |}) - // #endregion - dispatch env cont - // #region agent log - if Interlocked.Increment(&debugExitCount) <= 16 then - debugLog "C" "RuntimeDispatch.fs:Invoke:exit" "named call-site invocation exited" - (box {| threadId = Environment.CurrentManagedThreadId - invokeEnvId = objectId env - resultKind = - match result with - | Choice1Of2 _ -> "error" - | Choice2Of2 (Obj (:? int)) -> "int" - | Choice2Of2 _ -> "other" |}) - // #endregion - result type GeneratedFunc = Func> From dc1622b0cce906d12d6770fb5ca64d465bef2430 Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Sat, 8 Aug 2026 03:54:12 +0000 Subject: [PATCH 3/3] Publish named call-site cache as one atomic snapshot The inline cache added in e61e8c0 stored the resolved environment, path, cell, version, combiner and eager-dispatch classification in six independently mutable fields. A caller could validate its own environment against the cache and then dispatch a combiner that another caller had already written, invoking the wrong binding and silently returning the other environment's result. Hold the resolution in one immutable object published with a single volatile reference write, so a refill is never observed half-applied. Co-authored-by: Ademar Gonzalez --- IronKernel.Tests/CompilerTests.fs | 32 ++++++++++++++ IronKernel/RuntimeDispatch.fs | 73 +++++++++++++++++++++---------- 2 files changed, 81 insertions(+), 24 deletions(-) diff --git a/IronKernel.Tests/CompilerTests.fs b/IronKernel.Tests/CompilerTests.fs index a703378..3d26cfd 100644 --- a/IronKernel.Tests/CompilerTests.fs +++ b/IronKernel.Tests/CompilerTests.fs @@ -578,6 +578,38 @@ let ``inline cache preserves raw operands for operatives`` () = assertEqv (invokeSite compiled env) (Atom "whatever") assertEqv (invokeSite compiled env) (Atom "whatever") +[] +let ``inline cache dispatches per environment under concurrent invocation`` () = + // A host embedding the compiler can invoke one compiled form from several + // threads. Publishing the cache field by field let a caller validate its own + // environment and then dispatch a combiner another caller had just stored, + // silently returning the other environment's result. Long parent chains + // widen the resolution window the race needs. + let build result = + let root = freshEnv () + ignore (evalIn root $"(define f (wrap (vau (x) _ {result})))") + let mutable env = root + for _ in 1..1000 do + env <- newEnv [env] + env + + let envA = build 1 + let envB = build 2 + let compiled = compileLispValGuarded envA (parseOk "(f 0)") + let mismatches = ref 0 + + System.Threading.Tasks.Parallel.For( + 0, + 500_000, + System.Action(fun index -> + let env, expected = if index % 2 = 0 then envA, 1 else envB, 2 + match compiled.Invoke(env, newContinuation env) with + | Choice2Of2 (Obj (:? int as actual)) when actual = expected -> () + | _ -> System.Threading.Interlocked.Increment(&mismatches.contents) |> ignore)) + |> ignore + + Assert.Equal(0, mismatches.Value) + [] let ``inline cache reports unbound operand variables`` () = let env = freshEnv () diff --git a/IronKernel/RuntimeDispatch.fs b/IronKernel/RuntimeDispatch.fs index 625013f..392211a 100644 --- a/IronKernel/RuntimeDispatch.fs +++ b/IronKernel/RuntimeDispatch.fs @@ -4,6 +4,7 @@ namespace IronKernel module RuntimeDispatch = open System + open System.Threading open Ast open Errors open Eval @@ -14,6 +15,25 @@ module RuntimeDispatch = | Choice1Of2 error -> throwError error | Choice2Of2 combiner -> operate env cont combiner (Array.toList operands) + /// One call site's resolved binding, immutable once constructed so that it can + /// be published to other threads with a single reference write. + [] + type ResolvedCallSite + ( + env: LispVal, + path: SymbolTable.VisitedFrame[], + cell: BindingCell, + version: int64, + combiner: LispVal, + eagerUnderlying: LispVal voption + ) = + member _.Env = env + member _.Path = path + member _.Cell = cell + member _.Version = version + member _.Combiner = combiner + member _.EagerUnderlying = eagerUnderlying + /// Monomorphic inline cache for a compiled `(name operand ...)` call site. /// /// The cache is valid while the invoking environment is the same instance, @@ -35,12 +55,12 @@ module RuntimeDispatch = | List (_ :: _) -> false | _ -> true) - let mutable cachedEnv : LispVal = Nil - let mutable cachedPath : SymbolTable.VisitedFrame[] = null - let mutable cachedCell : BindingCell = Unchecked.defaultof - let mutable cachedVersion = 0L - let mutable cachedCombiner : LispVal = Nil - let mutable eagerUnderlying : LispVal voption = ValueNone + /// The whole cache is one immutable snapshot behind a single reference so + /// that a refill can never be observed half-applied. Publishing the parts + /// separately let one caller validate its own environment and then + /// dispatch a combiner another caller had already stored, invoking the + /// wrong binding. + let mutable cache : ResolvedCallSite = null let classifyEager combiner = if not simpleOperands then ValueNone @@ -55,13 +75,14 @@ module RuntimeDispatch = | _ -> ValueNone | _ -> ValueNone - let cacheValid env = - obj.ReferenceEquals(env, cachedEnv) - && cachedCell.state.version = cachedVersion - && (let mutable consistent = true + let cacheValid (resolved: ResolvedCallSite) env = + obj.ReferenceEquals(env, resolved.Env) + && resolved.Cell.state.version = resolved.Version + && (let path = resolved.Path + let mutable consistent = true let mutable index = 0 - while consistent && index < cachedPath.Length do - let entry = cachedPath.[index] + while consistent && index < path.Length do + let entry = path.[index] consistent <- entry.frame.bindings.Count = entry.bindingCount index <- index + 1 consistent) @@ -75,29 +96,33 @@ module RuntimeDispatch = | Choice1Of2 error -> Choice1Of2 error | value :: rest -> evaluateSimpleOperands env (value :: evaluated) rest - let dispatch env cont = - match eagerUnderlying with + let dispatch (resolved: ResolvedCallSite) env cont = + match resolved.EagerUnderlying with | ValueSome underlying -> match evaluateSimpleOperands env [] operands with | Choice1Of2 error -> throwError error | Choice2Of2 args -> operate env cont underlying args - | ValueNone -> operate env cont cachedCombiner operands + | ValueNone -> operate env cont resolved.Combiner operands member _.Invoke(env: LispVal, cont: LispVal) : ThrowsError = - if not (isNull cachedPath) && cacheValid env then - dispatch env cont + let cached = Volatile.Read(&cache) + if not (isNull cached) && cacheValid cached env then + dispatch cached env cont else match SymbolTable.resolveBindingCellWithPath env name with | ValueNone -> throwError (UnboundVar("Getting an unbound variable", name)) | ValueSome(cell, visitedPath) -> let state = cell.state - cachedEnv <- env - cachedPath <- visitedPath - cachedCell <- cell - cachedVersion <- state.version - cachedCombiner <- state.value - eagerUnderlying <- classifyEager state.value - dispatch env cont + let resolved = + ResolvedCallSite( + env, + visitedPath, + cell, + state.version, + state.value, + classifyEager state.value) + Volatile.Write(&cache, resolved) + dispatch resolved env cont type GeneratedFunc = Func>