unit Myc.Core.FileCache; interface uses System.SysUtils, System.IOUtils, System.Generics.Collections, System.Generics.Defaults, System.SyncObjs, Myc.Futures; type // Manages a cache for time-series data files loaded asynchronously. // The cache is activated by assigning a function to the IsMemoryLow property. // It evicts least-recently-used items when memory is low. TDataFileCache = class type TLoaderFunc = reference to function(const Filename: String): TFuture; private type // Holds metadata for a cached file. TCachedFile = class public Name: String; Age: TDateTime; LastUsed: TDateTime; Data: TFuture; end; private FCachedFiles: TDictionary; FLoader: TLoaderFunc; FLock: TCriticalSection; public constructor Create(const ALoader: TLoaderFunc); destructor Destroy; override; // Removes all items from the cache, waiting for any pending operations to complete. procedure Clear; // Retrieves a data future from the cache or uses the provided loader function to create and cache it. // Caching is only active if the IsMemoryLow property is assigned. function GetOrAdd(const AFileName: string): TFuture; end; var IsMemoryLow: TFunc; implementation uses {$IFDEF MSWINDOWS} Winapi.Windows, {$endif} System.Math; { TDataFileCache } constructor TDataFileCache.Create(const ALoader: TLoaderFunc); begin inherited Create; FLoader := ALoader; FLock := TCriticalSection.Create; FCachedFiles := TObjectDictionary.Create([doOwnsValues]); end; destructor TDataFileCache.Destroy; begin Clear; FCachedFiles.Free; FLock.Free; inherited; end; procedure TDataFileCache.Clear; begin FLock.Enter; try // Wait for any pending load operations to finish before clearing. for var cachedFile in FCachedFiles.Values do cachedFile.Data.WaitFor; FCachedFiles.Clear; finally FLock.Leave; end; end; function TDataFileCache.GetOrAdd(const AFileName: string): TFuture; var fileList: TArray; i: Integer; cachedFile: TCachedFile; currentFileAge: TDateTime; begin // If no memory check function is assigned, caching is disabled. // Simply execute the loader function and return the result. if not Assigned(IsMemoryLow) then begin Result := FLoader(AFilename); exit; end; FLock.Enter; try if IsMemoryLow() then begin // Caching is active. First, try to free memory if needed. fileList := FCachedFiles.Values.ToArray; TArray.Sort( fileList, TComparer.Construct( function(const Left, Right: TCachedFile): Integer begin // Sort by LastUsed timestamp, oldest first. Result := Sign(Left.LastUsed - Right.LastUsed); end ) ); for i := 0 to High(fileList) do begin if not IsMemoryLow() then break; // Stop evicting if memory pressure is relieved. if fileList[i].Name <> AFileName then begin if fileList[i].Data.Done.IsSet then begin FCachedFiles.Remove(fileList[i].Name); fileList[i].Data := TFuture.Null; end; end; end; end; // Check if a valid entry exists in the cache. if FCachedFiles.TryGetValue(AFileName, cachedFile) then begin if FileAge(AFileName, currentFileAge, true) and (currentFileAge = cachedFile.Age) then begin // Cache hit and file is unchanged. Update usage timestamp and return cached future. cachedFile.LastUsed := Now; exit(cachedFile.Data); end else begin // File is stale or no longer exists. Remove from cache. FCachedFiles.Remove(AFileName); end; end; // Cache miss or stale entry. Execute the loader function. Result := FLoader(AFilename); // Create a new cache entry for the loaded future. cachedFile := TCachedFile.Create; cachedFile.Name := AFileName; if FileAge(AFileName, cachedFile.Age, true) then begin cachedFile.Data := Result; cachedFile.LastUsed := Now; FCachedFiles.Add(AFileName, cachedFile); end else begin // If we cannot get the file's age, we cannot cache it reliably. cachedFile.Free; end; finally FLock.Leave; end; end; initialization {$IFDEF MSWINDOWS} IsMemoryLow := function: Boolean var memStatusEx: TMemoryStatusEx; begin Result := false; memStatusEx.dwLength := SizeOf(TMemoryStatusEx); // Initialize the structure size if GlobalMemoryStatusEx(memStatusEx) then begin // memStatusEx.dwMemoryLoad indicates the approximate percentage of physical memory that is in use. Result := memStatusEx.dwMemoryLoad >= 80; end; end; {$endif} end.