unit MaxLogic.Cache;

System.Classes, System.Diagnostics, System.Generics.Collections, System.Generics.Defaults, System.IOUtils,

System.SyncObjs, System.SysUtils,

MaxLogic.hash.xxHash, MaxLogic.PortableTimer, maxLogic.StrUtils;

EMaxCacheException = class(Exception);

EMaxCacheLoadException = class(EMaxCacheException);

EMaxCacheShutdown = class(EMaxCacheException);

EMaxCacheWaitTimeout = class(EMaxCacheException);

TMaxDependencyStamp = record

MTimeUtcMs: Int64;

SizeBytes: Int64;

Hash32: Cardinal;

HasHash: Boolean;

class function FromFile(const aFileName: string; const aIncludeHash: Boolean = False): TMaxDependencyStamp; static;

function Equals(const aOther: TMaxDependencyStamp): Boolean;

end;

IMaxCacheDependency = interface

['{1CB9C196-0DCC-4B88-A59B-62A0AEE0FC82}']

function IsStale(out aNewStamp: TMaxDependencyStamp): Boolean;

function GetStamp: TMaxDependencyStamp;

end;

TMaxFileDependency = class(TInterfacedObject, IMaxCacheDependency)

private

fAlwaysHashBelowBytes: Int64;

fFileName: string;

fForceHash: Boolean;

fStamp: TMaxDependencyStamp;

function ComputeStamp(const aIncludeHash: Boolean): TMaxDependencyStamp;

function ShouldHash(const aBaseStamp: TMaxDependencyStamp; const aForce: Boolean): Boolean;

public

constructor Create(const aFileName: string; const aAlwaysHashBelowBytes: Int64 = 51200; const aForceHash: Boolean = False);

function GetStamp: TMaxDependencyStamp;

function IsStale(out aNewStamp: TMaxDependencyStamp): Boolean;

property FileName: string read fFileName;

property ForceHash: Boolean read fForceHash;

end;

TMaxCacheKeySize = record

Namespace: string;

Key: string;

EstimatedBytes: Int64;

end;

TMaxCacheMetrics = record

NamespaceCount: Integer;

EntryCount: Integer;

EstimatedMemoryKB: Int64;

Hits: Int64;

Misses: Int64;

Loads: Int64;

LoadFailures: Int64;

InvalidationsDirect: Int64;

InvalidationsByTag: Int64;

EvictionsTtl: Int64;

EvictionsIdle: Int64;

EvictionsSize: Int64;

AvgLoadTimeMs: Double;

P95LoadTimeMs: Double;

TopTenKeysBySize: TArray<TMaxCacheKeySize>;

end;

TMaxNamespaceCacheMetrics = record

Namespace: string;

EntryCount: Integer;

EstimatedMemoryKB: Int64;

end;

TMaxCacheConfig = record

DefaultTtlMs: Integer;

DefaultIdleMs: Integer;

DefaultValidateIntervalMs: Integer;

MaxEntriesGlobal: Integer;

MaxBytesGlobal: Int64;

MaxEntriesPerNamespace: Integer;

MaxBytesPerNamespace: Int64;

MinFailCacheMs: Integer;

DefaultWaitTimeoutMs: Integer;

AlwaysHashBelowBytes: Integer;

SweepIntervalMs: Integer;

SweepBatchSize: Integer;

CaseSensitiveKeys: Boolean;

ReturnStaleOnFailure: Boolean;

class function Default: TMaxCacheConfig; static;

end;

TMaxCacheOptions = class

public

TtlMs: Integer;

IdleMs: Integer;

ValidateIntervalMs: Integer;

FailCacheMs: Integer;

SizeEstimateBytes: Integer;

Tags: TArray<string>;

Dependency: IMaxCacheDependency;

ReturnStaleOnFailure: Boolean;

constructor Create;

end;

IMaxCache = interface

['{9C9FA4E8-B650-485F-8F52-2E6B4C93320D}']

function GetOrCreate(const aNamespace, aKey: string; const aLoader: TFunc<IInterface>; const aOptions: TMaxCacheOptions = nil): IInterface;

procedure Invalidate(const aNamespace, aKey: string);

procedure InvalidateNamespace(const aNamespace: string);

procedure InvalidateByTag(const aScopedTag: string);

procedure InvalidateMany(const aNamespace: string; const aKeys: array of string);

function TryGet(const aNamespace, aKey: string; out aValue: IInterface): Boolean;

function GetMetrics: TMaxCacheMetrics;

function GetNamespaceMetrics(const aNamespace: string): TMaxNamespaceCacheMetrics;

procedure Shutdown;

end;

TMaxCache = class(TInterfacedObject, IMaxCache)

public

class function New(const aConfig: TMaxCacheConfig): IMaxCache; overload; static;

class function New: IMaxCache; overload; static;

class function ScopedTag(const aNamespace, aTag: string): string; static;

public

constructor Create(const aConfig: TMaxCacheConfig);

destructor Destroy; override;

function GetOrCreate(const aNamespace, aKey: string; const aLoader: TFunc<IInterface>; const aOptions: TMaxCacheOptions = nil): IInterface;

procedure Invalidate(const aNamespace, aKey: string);

procedure InvalidateNamespace(const aNamespace: string);

procedure InvalidateByTag(const aScopedTag: string);

procedure InvalidateMany(const aNamespace: string; const aKeys: array of string);

function TryGet(const aNamespace, aKey: string; out aValue: IInterface): Boolean;

function GetMetrics: TMaxCacheMetrics;

function GetNamespaceMetrics(const aNamespace: string): TMaxNamespaceCacheMetrics;

procedure Shutdown;

private

type

TMaxCacheEntryState = (Empty, Loading, Ready, Failed, Obsolete);

TMaxCacheEntry = class

private

fRefCount: Integer;

public

EntrySync: TObject;

State: TMaxCacheEntryState;

Value: IInterface;

CreatedAtMs: Int64;

LastAccessMs: Int64;

ExpiresAtMs: Int64;

IdleExpiresAtMs: Int64;

NextValidateMs: Int64;

ValidateIntervalMs: Integer;

IsValidating: Integer;

WasInvalidated: Integer;

Dependency: IMaxCacheDependency;

Stamp: TMaxDependencyStamp;

Tags: TArray<string>;

SizeEstimateBytes: Int64;

RetryAtMs: Int64;

FailCacheMs: Integer;

ReturnStaleOnFailure: Boolean;

TtlMs: Integer;

IdleMs: Integer;

LastLoadTimeMs: Integer;

LastErrorMsg: string;

LastErrorClassName: string;

constructor Create;

destructor Destroy; override;

procedure AddRef;

procedure Release;

end;

TMaxNamespaceBucket = class

public

Lock: TLightweightMREW;

Items: TDictionary<string, TMaxCacheEntry>;

constructor Create(const aComparer: IEqualityComparer<string>);

destructor Destroy; override;

end;

TMaxTagRef = record

Namespace: string;

Key: string;

end;

private

const

cTagRefSep = #31;

cScopedTagSep = '|';

cGlobalTagPrefix = 'global:';

cMinSweepIntervalMs = 1;

cLoadTimeBoundsCount = 7;

cHistogramBucketCount = cLoadTimeBoundsCount + 1;

cLoadTimeBounds: array[0..cLoadTimeBoundsCount - 1] of Integer = (1, 5, 10, 50, 100, 500, 1000);

private

fConfig: TMaxCacheConfig;

fComparer: IEqualityComparer<string>;

fNamespacesLock: TLightweightMREW;

fNamespaces: TDictionary<string, TMaxNamespaceBucket>;

fTagIndexLock: TLightweightMREW;

fTagIndex: TDictionary<string, TDictionary<string, Byte>>;

fHits: Int64;

fMisses: Int64;

fLoads: Int64;

fLoadFailures: Int64;

fInvalidationsDirect: Int64;

fInvalidationsByTag: Int64;

fEvictionsTtl: Int64;

fEvictionsIdle: Int64;

fEvictionsSize: Int64;

fTotalLoadTimeMs: Int64;

fLoadTimeHistogram: array[0..cHistogramBucketCount - 1] of Int64;

fIsShuttingDown: Integer;

fSweeper: TPortableTimer;

fSweepRunning: Integer;

private

class function NowMs: Int64; static;

class function ClampNonNegative(const aValue: Integer): Integer; static;

class function ReadInt64(var aValue: Int64): Int64; static; inline;

class procedure WriteInt64(var aTarget: Int64; const aValue: Int64); static; inline;

function GetOrCreateBucket(const aNamespace: string): TMaxNamespaceBucket;

function TryGetBucket(const aNamespace: string): TMaxNamespaceBucket;

function TryGetEntry(const aBucket: TMaxNamespaceBucket; const aKey: string): TMaxCacheEntry;

procedure MarkEntryInvalidated(const aEntry: TMaxCacheEntry; const aClearValue: Boolean; out aTags: TArray<string>);

function RemoveEntryIfSame(const aBucket: TMaxNamespaceBucket; const aKey: string; const aEntry: TMaxCacheEntry): Boolean;

function TryBeginLoad(

const aKey: string;

const aBucket: TMaxNamespaceBucket;

const aNowMs: Int64;

const aForceLoad: Boolean;

out aEntry: TMaxCacheEntry): Boolean;

procedure WaitForEntry(const aEntry: TMaxCacheEntry);

procedure EnsureNotShuttingDown;

function IsExpired(const aEntry: TMaxCacheEntry; const aNowMs: Int64; out aEvictKind: Integer): Boolean;

procedure TouchEntry(const aEntry: TMaxCacheEntry; const aNowMs: Int64);

function ValidateDependency(const aEntry: TMaxCacheEntry; const aNowMs: Int64): Boolean;

procedure RegisterTags(const aNamespace, aKey: string; const aTags: TArray<string>);

procedure UnregisterTags(const aNamespace, aKey: string; const aTags: TArray<string>);

function GetTagRefsCopy(const aScopedTag: string): TArray<TMaxTagRef>;

procedure RecordLoadTimeMs(const aElapsedMs: Integer);

class function EstimateP95Ms(const aHistogram: array of Int64): Double; static;

procedure SweeperTimer(aSender: TObject);

procedure SweepTick;

procedure SweepBucket(const aNamespace: string; const aBucket: TMaxNamespaceBucket; const aNowMs: Int64; var aRemaining: Integer);

procedure EnforceSizeCaps(const aNamespace: string; const aBucket: TMaxNamespaceBucket; const aNowMs: Int64; var aRemaining: Integer);

procedure EnforceGlobalSizeCaps(const aBucketPairs: TArray<TPair<string, TMaxNamespaceBucket>>; var aRemaining: Integer);

function InvalidateInternal(const aNamespace, aKey: string; const aCountDirectMetric: Boolean): Boolean;

procedure InvalidateNamespaceInternal(const aNamespace: string; const aCountDirectMetric: Boolean);

end;

TMaxCacheTagRegisterHook = reference to procedure(const aNamespace, aKey: string; const aTags: TArray<string>);

TMaxCacheBeforeInvalidateRemoveHook = reference to procedure(const aNamespace, aKey: string; const aTags: TArray<string>);

procedure MaxCache_SetTagRegisterHook(const aHook: TMaxCacheTagRegisterHook);

procedure MaxCache_ClearTagRegisterHook;

procedure MaxCache_SetBeforeInvalidateRemoveHook(const aHook: TMaxCacheBeforeInvalidateRemoveHook);

procedure MaxCache_ClearBeforeInvalidateRemoveHook;

gTagRegisterHook: TMaxCacheTagRegisterHook;

gBeforeInvalidateRemoveHook: TMaxCacheBeforeInvalidateRemoveHook;

procedure MaxCache_SetTagRegisterHook(const aHook: TMaxCacheTagRegisterHook);

gTagRegisterHook := aHook;

end;

procedure MaxCache_ClearTagRegisterHook;

gTagRegisterHook := nil;

end;

procedure MaxCache_SetBeforeInvalidateRemoveHook(const aHook: TMaxCacheBeforeInvalidateRemoveHook);

gBeforeInvalidateRemoveHook := aHook;

end;

procedure MaxCache_ClearBeforeInvalidateRemoveHook;

gBeforeInvalidateRemoveHook := nil;

end;

class function TMaxDependencyStamp.FromFile(const aFileName: string; const aIncludeHash: Boolean): TMaxDependencyStamp;

lDt: TDateTime;

lBytes: TBytes;

Result.MTimeUtcMs := 0;

Result.SizeBytes := -1;

Result.Hash32 := 0;

Result.HasHash := False;

if (aFileName = '') or (not TFile.Exists(aFileName)) then

Exit;

Result.SizeBytes := TFile.GetSize(aFileName);

lDt := TFile.GetLastWriteTimeUtc(aFileName);

Result.MTimeUtcMs := Round(lDt * 86400000.0);

if aIncludeHash then

begin

lBytes := TFile.ReadAllBytes(aFileName);

if Length(lBytes) = 0 then

Result.Hash32 := xxHash32(nil, 0, 0)

else

Result.Hash32 := xxHash32(@lBytes[0], Length(lBytes), 0);

Result.HasHash := True;

end;

end;

function TMaxDependencyStamp.Equals(const aOther: TMaxDependencyStamp): Boolean;

if MTimeUtcMs <> aOther.MTimeUtcMs then

Exit(False);

if SizeBytes <> aOther.SizeBytes then

Exit(False);

if HasHash and aOther.HasHash and (Hash32 <> aOther.Hash32) then

Exit(False);

Result := True;

end;

constructor TMaxFileDependency.Create(const aFileName: string; const aAlwaysHashBelowBytes: Int64; const aForceHash: Boolean);

inherited Create;

fFileName := aFileName;

fAlwaysHashBelowBytes := aAlwaysHashBelowBytes;

fForceHash := aForceHash;

fStamp.MTimeUtcMs := 0;

fStamp.SizeBytes := -1;

fStamp.Hash32 := 0;

fStamp.HasHash := False;

end;

function TMaxFileDependency.ShouldHash(const aBaseStamp: TMaxDependencyStamp; const aForce: Boolean): Boolean;

if aForce then

Exit(True);

if (aBaseStamp.SizeBytes >= 0) and (aBaseStamp.SizeBytes <= fAlwaysHashBelowBytes) then

Exit(True);

if not fStamp.Equals(aBaseStamp) then

Exit(True);

Result := False;

end;

function TMaxFileDependency.ComputeStamp(const aIncludeHash: Boolean): TMaxDependencyStamp;

Result := TMaxDependencyStamp.FromFile(fFileName, aIncludeHash);

end;

function TMaxFileDependency.GetStamp: TMaxDependencyStamp;

lBase: TMaxDependencyStamp;

lIncludeHash: Boolean;

lBase := ComputeStamp(False);

lIncludeHash := fForceHash or ((lBase.SizeBytes >= 0) and (lBase.SizeBytes <= fAlwaysHashBelowBytes));

if lIncludeHash then

fStamp := ComputeStamp(True)

else

fStamp := lBase;

Result := fStamp;

end;

function TMaxFileDependency.IsStale(out aNewStamp: TMaxDependencyStamp): Boolean;

lBase: TMaxDependencyStamp;

lIncludeHash: Boolean;

lBase := ComputeStamp(False);

lIncludeHash := ShouldHash(lBase, fForceHash);

if lIncludeHash then

aNewStamp := ComputeStamp(True)

else

aNewStamp := lBase;

Result := not fStamp.Equals(aNewStamp);

end;

class function TMaxCacheConfig.Default: TMaxCacheConfig;

Result.DefaultTtlMs := 0;

Result.DefaultIdleMs := 0;

Result.DefaultValidateIntervalMs := 0;

Result.MaxEntriesGlobal := 0;

Result.MaxBytesGlobal := 0;

Result.MaxEntriesPerNamespace := 0;

Result.MaxBytesPerNamespace := 0;

Result.MinFailCacheMs := 500;

Result.DefaultWaitTimeoutMs := 30000;

Result.AlwaysHashBelowBytes := 51200;

Result.SweepIntervalMs := 10000;

Result.SweepBatchSize := 200;

Result.CaseSensitiveKeys := True;

Result.ReturnStaleOnFailure := False;

end;

constructor TMaxCacheOptions.Create;

inherited Create;

TtlMs := 0;

IdleMs := 0;

ValidateIntervalMs := 0;

FailCacheMs := 0;

SizeEstimateBytes := 0;

Tags := [];

Dependency := nil;

ReturnStaleOnFailure := False;

end;

constructor TMaxCache.TMaxCacheEntry.Create;

inherited Create;

fRefCount := 1;

EntrySync := TObject.Create;

State := TMaxCacheEntryState.Empty;

Value := nil;

CreatedAtMs := 0;

LastAccessMs := 0;

ExpiresAtMs := 0;

IdleExpiresAtMs := 0;

NextValidateMs := 0;

ValidateIntervalMs := 0;

IsValidating := 0;

WasInvalidated := 0;

Dependency := nil;

Stamp.MTimeUtcMs := 0;

Stamp.SizeBytes := -1;

Stamp.Hash32 := 0;

Stamp.HasHash := False;

Tags := [];

SizeEstimateBytes := 0;

RetryAtMs := 0;

FailCacheMs := 0;

ReturnStaleOnFailure := False;

TtlMs := 0;

IdleMs := 0;

LastLoadTimeMs := 0;

LastErrorMsg := '';

LastErrorClassName := '';

end;

destructor TMaxCache.TMaxCacheEntry.Destroy;

EntrySync.Free;

inherited Destroy;

end;

procedure TMaxCache.TMaxCacheEntry.AddRef;

TInterlocked.Increment(fRefCount);

end;

procedure TMaxCache.TMaxCacheEntry.Release;

if TInterlocked.Decrement(fRefCount) = 0 then

Free;

end;

constructor TMaxCache.TMaxNamespaceBucket.Create(const aComparer: IEqualityComparer<string>);

inherited Create;

Items := TDictionary<string, TMaxCacheEntry>.Create(aComparer);

end;

destructor TMaxCache.TMaxNamespaceBucket.Destroy;

lEntry: TMaxCacheEntry;

for lEntry in Items.Values do

lEntry.Release;

Items.Free;

inherited Destroy;

end;

class function TMaxCache.New(const aConfig: TMaxCacheConfig): IMaxCache;

Result := TMaxCache.Create(aConfig);

end;

class function TMaxCache.New: IMaxCache;

Result := TMaxCache.Create(TMaxCacheConfig.Default);

end;

class function TMaxCache.ScopedTag(const aNamespace, aTag: string): string;

if aTag.StartsWith(cGlobalTagPrefix, True) then

Exit(aTag);

if aTag.IndexOf(cScopedTagSep) >= 0 then

raise EMaxCacheException.Create('Tag must be unscoped (no "|") unless it starts with global:');

Result := aNamespace + cScopedTagSep + aTag;

end;

constructor TMaxCache.Create(const aConfig: TMaxCacheConfig);

lInterval: Integer;

inherited Create;

fConfig := aConfig;

if fConfig.CaseSensitiveKeys then

fComparer := TFastCaseAwareComparer.Ordinal

else

fComparer := TFastCaseAwareComparer.OrdinalIgnoreCase;

fNamespaces := TDictionary<string, TMaxNamespaceBucket>.Create(fComparer);

fTagIndex := TDictionary<string, TDictionary<string, Byte>>.Create(fComparer);

fHits := 0;

fMisses := 0;

fLoads := 0;

fLoadFailures := 0;

fInvalidationsDirect := 0;

fInvalidationsByTag := 0;

fEvictionsTtl := 0;

fEvictionsIdle := 0;

fEvictionsSize := 0;

fTotalLoadTimeMs := 0;

FillChar(fLoadTimeHistogram, SizeOf(fLoadTimeHistogram), 0);

fIsShuttingDown := 0;

fSweeper := nil;

fSweepRunning := 0;

lInterval := ClampNonNegative(fConfig.SweepIntervalMs);

if lInterval < cMinSweepIntervalMs then

lInterval := cMinSweepIntervalMs;

if (fConfig.SweepIntervalMs > 0) and (fConfig.SweepBatchSize > 0) then

begin

fSweeper := TPortableTimer.Create;

fSweeper.SchedulingMode := tmFixedDelay;

fSweeper.OnTimer := SweeperTimer;

fSweeper.Start(Cardinal(lInterval));

end;

end;

destructor TMaxCache.Destroy;

lBucket: TMaxNamespaceBucket;

lSet: TDictionary<string, Byte>;

Shutdown;

if fSweeper <> nil then

begin

fSweeper.Stop;

fSweeper.Free;

fSweeper := nil;

end;

fNamespacesLock.BeginWrite;

try

for lBucket in fNamespaces.Values do

lBucket.Free;

fNamespaces.Free;

fNamespaces := nil;

finally

fNamespacesLock.EndWrite;

end;

fTagIndexLock.BeginWrite;

try

if fTagIndex <> nil then

begin

for lSet in fTagIndex.Values do

lSet.Free;

fTagIndex.Free;

end;

fTagIndex := nil;

finally

fTagIndexLock.EndWrite;

end;

inherited Destroy;

end;

class function TMaxCache.NowMs: Int64;

Result := (TStopwatch.GetTimeStamp * 1000) div TStopwatch.Frequency;

end;

class function TMaxCache.ClampNonNegative(const aValue: Integer): Integer;

if aValue < 0 then

Exit(0);

Result := aValue;

end;

class function TMaxCache.ReadInt64(var aValue: Int64): Int64;

Result := TInterlocked.CompareExchange(aValue, 0, 0);

Result := aValue;

end;

class procedure TMaxCache.WriteInt64(var aTarget: Int64; const aValue: Int64);

TInterlocked.Exchange(aTarget, aValue);

aTarget := aValue;

end;

procedure TMaxCache.EnsureNotShuttingDown;

if TInterlocked.CompareExchange(fIsShuttingDown, 0, 0) <> 0 then

raise EMaxCacheShutdown.Create('Cache is shutting down');

end;

function TMaxCache.TryGetBucket(const aNamespace: string): TMaxNamespaceBucket;

Result := nil;

fNamespacesLock.BeginRead;

try

fNamespaces.TryGetValue(aNamespace, Result);

finally

fNamespacesLock.EndRead;

end;

end;

function TMaxCache.GetOrCreateBucket(const aNamespace: string): TMaxNamespaceBucket;

Result := TryGetBucket(aNamespace);

if Result <> nil then

Exit;

fNamespacesLock.BeginWrite;

try

if not fNamespaces.TryGetValue(aNamespace, Result) then

begin

Result := TMaxNamespaceBucket.Create(fComparer);

fNamespaces.Add(aNamespace, Result);

end;

finally

fNamespacesLock.EndWrite;

end;

end;

function TMaxCache.TryGetEntry(const aBucket: TMaxNamespaceBucket; const aKey: string): TMaxCacheEntry;

Result := nil;

aBucket.Lock.BeginRead;

try

if aBucket.Items.TryGetValue(aKey, Result) then

Result.AddRef

else

Result := nil;

finally

aBucket.Lock.EndRead;

end;

end;

procedure TMaxCache.MarkEntryInvalidated(const aEntry: TMaxCacheEntry; const aClearValue: Boolean; out aTags: TArray<string>);

aTags := [];

TMonitor.Enter(aEntry.EntrySync);

try

aTags := aEntry.Tags;

aEntry.WasInvalidated := 1;

aEntry.State := TMaxCacheEntryState.Obsolete;

if aClearValue then

aEntry.Value := nil;

TMonitor.PulseAll(aEntry.EntrySync);

finally

TMonitor.Exit(aEntry.EntrySync);

end;

end;

function TMaxCache.RemoveEntryIfSame(const aBucket: TMaxNamespaceBucket; const aKey: string; const aEntry: TMaxCacheEntry): Boolean;

lCurrent: TMaxCacheEntry;

Result := False;

aBucket.Lock.BeginWrite;

try

if aBucket.Items.TryGetValue(aKey, lCurrent) and (lCurrent = aEntry) then

begin

aBucket.Items.Remove(aKey);

Result := True;

end;

finally

aBucket.Lock.EndWrite;

end;

end;

function TMaxCache.IsExpired(const aEntry: TMaxCacheEntry; const aNowMs: Int64; out aEvictKind: Integer): Boolean;

lExpiresAt: Int64;

lIdleExpiresAt: Int64;

aEvictKind := 0;

lExpiresAt := ReadInt64(aEntry.ExpiresAtMs);

if (lExpiresAt > 0) and (aNowMs >= lExpiresAt) then

begin

aEvictKind := 1;

Exit(True);

end;

lIdleExpiresAt := ReadInt64(aEntry.IdleExpiresAtMs);

if (lIdleExpiresAt > 0) and (aNowMs >= lIdleExpiresAt) then

begin

aEvictKind := 2;

Exit(True);

end;

Result := False;

end;

procedure TMaxCache.TouchEntry(const aEntry: TMaxCacheEntry; const aNowMs: Int64);

WriteInt64(aEntry.LastAccessMs, aNowMs);

if aEntry.IdleMs > 0 then

WriteInt64(aEntry.IdleExpiresAtMs, aNowMs + aEntry.IdleMs);

end;

function TMaxCache.ValidateDependency(const aEntry: TMaxCacheEntry; const aNowMs: Int64): Boolean;

lShouldValidate: Boolean;

lNewStamp: TMaxDependencyStamp;

lIsStale: Boolean;

lNext: Int64;

if aEntry.Dependency = nil then

Exit(True);

if aEntry.ValidateIntervalMs = 0 then

lShouldValidate := True

else

lShouldValidate := (aNowMs >= ReadInt64(aEntry.NextValidateMs));

if not lShouldValidate then

Exit(True);

if TInterlocked.CompareExchange(aEntry.IsValidating, 1, 0) <> 0 then

Exit(True); // another thread validates; optimistic

try

// Another thread may have completed validation between our first check and winning the CAS.

// Re-check "due" under the entry monitor to guarantee at most one validation per interval.

TMonitor.Enter(aEntry.EntrySync);

try

if aEntry.ValidateIntervalMs = 0 then

lShouldValidate := True

else

lShouldValidate := (aNowMs >= ReadInt64(aEntry.NextValidateMs));

finally

TMonitor.Exit(aEntry.EntrySync);

end;

if not lShouldValidate then

Exit(True);

lIsStale := False;

try

lIsStale := aEntry.Dependency.IsStale(lNewStamp);

except

lIsStale := True;

end;

TMonitor.Enter(aEntry.EntrySync);

try

if aEntry.ValidateIntervalMs = 0 then

lNext := aNowMs

else

lNext := aNowMs + aEntry.ValidateIntervalMs;

WriteInt64(aEntry.NextValidateMs, lNext);

if lIsStale and (aEntry.State = TMaxCacheEntryState.Ready) then

aEntry.State := TMaxCacheEntryState.Obsolete;

finally

TMonitor.Exit(aEntry.EntrySync);

end;

Result := not lIsStale;

finally

TInterlocked.Exchange(aEntry.IsValidating, 0);

end;

end;

procedure TMaxCache.WaitForEntry(const aEntry: TMaxCacheEntry);

lTimeout: Integer;

lRetryAt: Int64;

lFailCacheMs: Integer;

lTimeout := fConfig.DefaultWaitTimeoutMs;

if lTimeout <= 0 then

lTimeout := 30000;

lRetryAt := 0;

lFailCacheMs := 0;

TMonitor.Enter(aEntry.EntrySync);

try

if aEntry.State <> TMaxCacheEntryState.Loading then

Exit;

if not TMonitor.Wait(aEntry.EntrySync, lTimeout) then

begin

if aEntry.State = TMaxCacheEntryState.Loading then

begin

aEntry.State := TMaxCacheEntryState.Failed;

aEntry.LastErrorMsg := 'Timed out waiting for cache entry load';

aEntry.LastErrorClassName := EMaxCacheWaitTimeout.ClassName;

lFailCacheMs := aEntry.FailCacheMs;

if lFailCacheMs < fConfig.MinFailCacheMs then

lFailCacheMs := fConfig.MinFailCacheMs;

aEntry.FailCacheMs := lFailCacheMs;

lRetryAt := NowMs + lFailCacheMs;

WriteInt64(aEntry.RetryAtMs, lRetryAt);

TMonitor.PulseAll(aEntry.EntrySync);

raise EMaxCacheWaitTimeout.Create('Timed out waiting for cache entry load');

end;

end;

finally

TMonitor.Exit(aEntry.EntrySync);

end;

end;

function TMaxCache.TryBeginLoad(

const aKey: string;

const aBucket: TMaxNamespaceBucket;

const aNowMs: Int64;

const aForceLoad: Boolean;

out aEntry: TMaxCacheEntry): Boolean;

lEntry: TMaxCacheEntry;

aEntry := nil;

Result := False;

aBucket.Lock.BeginWrite;

try

if not aBucket.Items.TryGetValue(aKey, lEntry) then

begin

lEntry := TMaxCacheEntry.Create;

lEntry.State := TMaxCacheEntryState.Loading;

WriteInt64(lEntry.CreatedAtMs, aNowMs);

WriteInt64(lEntry.LastAccessMs, aNowMs);

aBucket.Items.Add(aKey, lEntry);

lEntry.AddRef;

aEntry := lEntry;

Exit(True);

end;

lEntry.AddRef;

aEntry := lEntry;

if lEntry.State = TMaxCacheEntryState.Loading then

Exit(False);

if lEntry.State = TMaxCacheEntryState.Failed then

begin

if aNowMs < ReadInt64(lEntry.RetryAtMs) then

Exit(False);

end;

if (not aForceLoad) and (lEntry.State = TMaxCacheEntryState.Ready) then

Exit(False);

lEntry.State := TMaxCacheEntryState.Loading;

Result := True;

finally

aBucket.Lock.EndWrite;

end;

end;

procedure TMaxCache.RegisterTags(const aNamespace, aKey: string; const aTags: TArray<string>);

lTag: string;

lScoped: string;

lRefKey: string;

lSet: TDictionary<string, Byte>;

if Length(aTags) = 0 then

Exit;

lRefKey := aNamespace + cTagRefSep + aKey;

fTagIndexLock.BeginWrite;

try

for lTag in aTags do

begin

lScoped := ScopedTag(aNamespace, lTag);

if not fTagIndex.TryGetValue(lScoped, lSet) then

begin

lSet := TDictionary<string, Byte>.Create(fComparer);

fTagIndex.Add(lScoped, lSet);

end;

lSet.AddOrSetValue(lRefKey, 0);

end;

finally

fTagIndexLock.EndWrite;

end;

end;

procedure TMaxCache.UnregisterTags(const aNamespace, aKey: string; const aTags: TArray<string>);

lTag: string;

lScoped: string;

lRefKey: string;

lSet: TDictionary<string, Byte>;

if Length(aTags) = 0 then

Exit;

lRefKey := aNamespace + cTagRefSep + aKey;

fTagIndexLock.BeginWrite;

try

for lTag in aTags do

begin

lScoped := ScopedTag(aNamespace, lTag);

if fTagIndex.TryGetValue(lScoped, lSet) then

begin

lSet.Remove(lRefKey);

if lSet.Count = 0 then

begin

fTagIndex.Remove(lScoped);

lSet.Free;

end;

end;

end;

finally

fTagIndexLock.EndWrite;

end;

end;

function TMaxCache.GetTagRefsCopy(const aScopedTag: string): TArray<TMaxTagRef>;

lSet: TDictionary<string, Byte>;

lRefKey: string;

lSepPos: Integer;

lIdx: Integer;

Result := [];

fTagIndexLock.BeginRead;

try

if not fTagIndex.TryGetValue(aScopedTag, lSet) then

Exit;

SetLength(Result, lSet.Count);

lIdx := 0;

for lRefKey in lSet.Keys do

begin

lSepPos := lRefKey.IndexOf(cTagRefSep);

if lSepPos > 0 then

begin

Result[lIdx].Namespace := lRefKey.Substring(0, lSepPos);

Result[lIdx].Key := lRefKey.Substring(lSepPos + 1);

Inc(lIdx);

end;

end;

if lIdx <> Length(Result) then

SetLength(Result, lIdx);

finally

fTagIndexLock.EndRead;

end;

end;

procedure TMaxCache.RecordLoadTimeMs(const aElapsedMs: Integer);