AbstractMem library version 1.1

- Improve CacheMem performance using predefined size blocks by default on Cache, this increases speed (on PascalCoin tested) up to 4x vs previous version
- Added tests
- Fixed bug on CacheMem when replacing initial position of buffer

src/libraries/abstractmem/ConfigAbstractMem.inc

@@ -39,9 +39,13 @@
 
   Version 1.0 - May 2020
   - Integration with PascalCoin project and final tests
-  
+
+  Version 1.1 - Nov 2020
+  - Improve CacheMem performance using predefined size blocks by default on Cache, this increases speed (on PascalCoin tested) up to 4x vs previous version
+  - Added tests
+  - Fixed bug on CacheMem when replacing initial position of buffer
 
 }
 
 const
-  CT_ABSTRACTMEM_VERSION = 1.0; // Each revision should increase this version...
+  CT_ABSTRACTMEM_VERSION = 1.1; // Each revision should increase this version...

src/libraries/abstractmem/UAbstractBTree.pas

@@ -51,6 +51,10 @@ uses
 
 {$I ./ConfigAbstractMem.inc }
 
+{$IFDEF ABSTRACTMEM_TESTING_MODE}
+  {$DEFINE ABSTRACTMEM_CHECK}
+{$ENDIF}
+
 type
   TAVLTreePosition = (poParent, poLeft, poRight);
 
@@ -533,13 +537,19 @@ end;
 
 function TAVLAbstractTree<T>.Find(const AData: T): T;
 var Comp: integer;
+  {$IFDEF ABSTRACTMEM_CHECK}
   LPreviousSearch : TOrderedList<T>;
+  {$ENDIF}
 begin
+  {$IFDEF ABSTRACTMEM_CHECK}
   LPreviousSearch := TOrderedList<T>.Create(False,FOnCompare); // Protection against circular "malformed" structure
   try
+  {$ENDIF}
     Result:=Root;
     while (Not IsNil(Result)) do begin
+      {$IFDEF ABSTRACTMEM_CHECK}
       if LPreviousSearch.Add(Result)<0 then raise EAVLAbstractTree.Create('Circular T structure at Find for T='+ToString(Result)+ ' searching for '+ToString(AData));
+      {$ENDIF}
       Comp:=fOnCompare(AData,Result);
       if Comp=0 then exit;
       if Comp<0 then begin
@@ -548,20 +558,28 @@ begin
         Result:=GetPosition(Result,poRight);
       end;
     end;
+  {$IFDEF ABSTRACTMEM_CHECK}
   finally
     LPreviousSearch.Free;
   end;
+  {$ENDIF}
 end;
 
 function TAVLAbstractTree<T>.FindInsertPos(const AData: T): T;
 var Comp: integer;
+  {$IFDEF ABSTRACTMEM_CHECK}
   LPreviousSearch : TOrderedList<T>;
+  {$ENDIF}
 begin
+  {$IFDEF ABSTRACTMEM_CHECK}
   LPreviousSearch := TOrderedList<T>.Create(False,FOnCompare); // Protection against circular "malformed" structure
   try
+  {$ENDIF}
     Result:=Root;
     while (Not IsNil(Result)) do begin
+      {$IFDEF ABSTRACTMEM_CHECK}
       if LPreviousSearch.Add(Result)<0 then raise EAVLAbstractTree.Create('Circular T structure at FindInsertPos for T='+ToString(Result)+ ' searching for '+ToString(AData));
+      {$ENDIF}
       Comp:=fOnCompare(AData,Result);
       if Comp<0 then begin
         if (HasPosition(Result,poLeft)) then begin
@@ -577,9 +595,11 @@ begin
         end;
       end;
     end;
+  {$IFDEF ABSTRACTMEM_CHECK}
   finally
     LPreviousSearch.Free;
   end;
+  {$ENDIF}
 end;
 
 function TAVLAbstractTree<T>.FindSuccessor(const ANode: T): T;

src/libraries/abstractmem/UAbstractMem.pas

@@ -122,7 +122,7 @@ Type
     function IsAbstractMemInfoStable : Boolean; virtual;
     procedure SaveHeader;
   public
-    procedure Write(const APosition : Integer; const ABuffer; ASize : Integer); overload; virtual;
+    function Write(const APosition : Integer; const ABuffer; ASize : Integer) : Integer; overload; virtual;
     function Read(const APosition : Integer; var ABuffer; ASize : Integer) : Integer; overload; virtual;
 
     Constructor Create(AInitialPosition : Integer; AReadOnly : Boolean); virtual;
@@ -588,12 +588,13 @@ begin
   end;
 end;
 
-procedure TAbstractMem.Write(const APosition: Integer; const ABuffer; ASize: Integer);
+function TAbstractMem.Write(const APosition: Integer; const ABuffer; ASize: Integer) : Integer;
 begin
   FLock.Acquire;
   Try
     CheckInitialized(True);
     if AbsoluteWrite(PositionToAbsolute(APosition),ABuffer,ASize)<>ASize then raise EAbstractMem.Create('Cannot write expected size');
+    Result := ASize;
   Finally
     FLock.Release;
   End;

src/libraries/abstractmem/UCacheMem.pas

@@ -113,8 +113,9 @@ type
   end;
   {$ENDIF}
 
-  TOnNeedDataProc = function(var ABuffer; AStartPos : Integer; ASize : Integer) : Boolean of object;
-  TOnSaveDataProc = function(const ABuffer; AStartPos : Integer; ASize : Integer) : Boolean of object;
+  TOnNeedDataProc = function(var ABuffer; AStartPos : Integer; ASize : Integer) : Integer of object;
+  TOnSaveDataProc = function(const ABuffer; AStartPos : Integer; ASize : Integer) : Integer of object;
+  TOnNeedsTotalSizeProc = function(const ABuffer; AStartPos : Integer; ASize : Integer) : Integer of object;
 
   ECacheMem = Class(Exception);
 
@@ -133,6 +134,7 @@ type
     FOnSaveDataProc : TOnSaveDataProc;
     FMaxCacheSize: Integer;
     FMaxCacheDataBlocks: Integer;
+    FDefaultCacheDataBlocksSize : Integer;
     function FindCacheMemDataByPosition(APosition : Integer; out APCacheMemData : PCacheMemData) : Boolean;
     procedure Delete(var APCacheMemData : PCacheMemData); overload;
     function FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean; overload;
@@ -162,6 +164,7 @@ type
 
     property MaxCacheSize : Integer read FMaxCacheSize write FMaxCacheSize;
     property MaxCacheDataBlocks : Integer read FMaxCacheDataBlocks write FMaxCacheDataBlocks;
+    property DefaultCacheDataBlocksSize : Integer read FDefaultCacheDataBlocksSize write FDefaultCacheDataBlocksSize;
     {$IFDEF ABSTRACTMEM_ENABLE_STATS}
     procedure ClearStats;
     property CacheMemStats : TCacheMemStats read FCacheMemStats;
@@ -318,6 +321,7 @@ begin
   FCacheDataBlocks := 0;
   FPendingToSaveBytes := 0;
   FCacheDataSize := 0;
+  FDefaultCacheDataBlocksSize := 4000;
   FOnNeedDataProc := AOnNeedDataProc;
   FOnSaveDataProc := AOnSaveDataProc;
   FOldestUsed := Nil;
@@ -347,8 +351,8 @@ begin
 end;
 
 function TCacheMem.FindCacheMemDataByPosition(APosition: Integer; out APCacheMemData: PCacheMemData): Boolean;
-  // Will return FCacheData index at AiCacheDataPos that contains APosition
-  // When returning FALSE, AiCacheDataPos will be index of previous FCacheData position to use
+  // Will return APCacheMemData that contains APosition
+  // When returning FALSE, APCacheMemData.startPos will be < APosition (or NIL)
 var PSearch : PCacheMemData;
 begin
   APCacheMemData := Nil;
@@ -407,7 +411,7 @@ begin
       if (PToCurrent^.pendingToSave) then begin
 
         if Not Assigned(FOnSaveDataProc) then Exit(False);
-        if Not FOnSaveDataProc(PToCurrent^.buffer[0],PToCurrent^.startPos,PToCurrent^.GetSize) then begin
+        if FOnSaveDataProc(PToCurrent^.buffer[0],PToCurrent^.startPos,PToCurrent^.GetSize)<>PToCurrent^.GetSize then begin
           Result := False;
           inc(LTotalBytesError,PToCurrent^.GetSize);
         end else begin
@@ -510,11 +514,12 @@ end;
 function TCacheMem.LoadData(var ABuffer; const AStartPos, ASize: Integer): Boolean;
   // Will return a Pointer to AStartPos
 
-  function _CaptureDataFromOnNeedDataProc(ACapturePosStart, ACaptureSize : Integer; var ACapturedData : TBytes) : Boolean;
+  function _CaptureDataFromOnNeedDataProc(ACapturePosStart, ACaptureSize : Integer; var ACapturedData : TBytes; out ACapturedSize : Integer) : Boolean;
   {$IFDEF ABSTRACTMEM_TESTING_MODE}var i : integer;{$ENDIF}
   begin
     SetLength(ACapturedData,ACaptureSize);
     if Not Assigned(FOnNeedDataProc) then begin
+      ACapturedSize := ACaptureSize;
       FillChar(ACapturedData[0],Length(ACapturedData),0);
       {$IFDEF ABSTRACTMEM_TESTING_MODE}
       // TESTING PURPOSE TESTING ONLY
@@ -525,7 +530,8 @@ function TCacheMem.LoadData(var ABuffer; const AStartPos, ASize: Integer): Boole
       {$ENDIF}
       Exit(False);
     end;
-    Result := FOnNeedDataProc(ACapturedData[0],ACapturePosStart,ACaptureSize);
+    ACapturedSize := FOnNeedDataProc(ACapturedData[0],ACapturePosStart,ACaptureSize);
+    Result :=  ACapturedSize = ACaptureSize;
   end;
 
 
@@ -533,6 +539,7 @@ var
   LNewP, PCurrent, PToDelete : PCacheMemData;
   LLastAddedPosition, LBytesCount, LSizeToStore : Integer;
   LTempData : TBytes;
+  LTempCapturedSize : Integer;
   LTmpResult : Boolean;
 begin
   if ASize<0 then raise ECacheMem.Create(Format('Invalid load size %d',[ASize]));
@@ -558,15 +565,23 @@ begin
   try
     LNewP.Clear;
 
-    LSizeToStore := ASize;
-    SetLength(LNewP^.buffer, LSizeToStore);
+    if (FDefaultCacheDataBlocksSize>0) then begin
+      LNewP.startPos := (((AStartPos-1) DIV FDefaultCacheDataBlocksSize) + 0 ) * FDefaultCacheDataBlocksSize;
+      LSizeToStore := (((ASize-1) DIV FDefaultCacheDataBlocksSize) + 1 ) * FDefaultCacheDataBlocksSize;
+      if (LNewP.startPos + LSizeToStore) < (AStartPos + ASize) then begin
+        inc(LSizeToStore, FDefaultCacheDataBlocksSize);
+      end;
+    end else begin
+      LSizeToStore := ASize;
+      LNewP.startPos := AStartPos;
+    end;
 
-    LNewP.startPos := AStartPos;
+    SetLength(LNewP^.buffer, LSizeToStore);
 
     Result := True;
 
-    LLastAddedPosition := AStartPos - 1;
-    while (Assigned(PCurrent)) and ( (LLastAddedPosition) < (LNewP^.GetEndPos) ) do begin
+    LLastAddedPosition := LNewP.startPos - 1;
+    while (Result) and (Assigned(PCurrent)) and ( (LLastAddedPosition) < (LNewP^.GetEndPos) ) do begin
       if (PCurrent^.GetEndPos <= LLastAddedPosition) then PCurrent := FCacheData.FindSuccessor(PCurrent)
       else if (PCurrent^.startPos > LNewP^.GetEndPos) then break
       else begin
@@ -580,9 +595,9 @@ begin
         end else if (PCurrent^.startPos > LLastAddedPosition+1) then begin
           // Need data "between"
           LBytesCount := PCurrent^.startPos - (LLastAddedPosition+1);
-          LTmpResult := _CaptureDataFromOnNeedDataProc(LLastAddedPosition+1,LBytesCount,LTempData);
+          LTmpResult := _CaptureDataFromOnNeedDataProc(LLastAddedPosition+1,LBytesCount,LTempData,LTempCapturedSize);
           Result := Result and LTmpResult;
-          Move(LTempData[0],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LBytesCount);
+          Move(LTempData[0],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LTempCapturedSize);
           inc(LLastAddedPosition,LBytesCount);
         end;
         // At this point (LLastAddedPosition+1 = PCurrent^.startPos)
@@ -602,12 +617,19 @@ begin
         Delete( PToDelete );
       end;
     end;
-    if (LLastAddedPosition) < (LNewP^.GetEndPos) then begin
+    if (Result) and ((LLastAddedPosition) < (LNewP^.GetEndPos)) then begin
       // That means there is no data available at cache
       LBytesCount := LNewP^.GetSize - (LLastAddedPosition - LNewP^.startPos +1);
-      LTmpResult := _CaptureDataFromOnNeedDataProc(LLastAddedPosition+1,LBytesCount,LTempData);
-      Result := Result and LTmpResult;
-      Move(LTempData[0],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LBytesCount);
+      LTmpResult := _CaptureDataFromOnNeedDataProc(LLastAddedPosition+1,LBytesCount,LTempData,LTempCapturedSize);
+      if (Not LTmpResult) then begin
+        if (LLastAddedPosition+1 + LTempCapturedSize) < (AStartPos + ASize) then begin
+          // Not enough data
+          Result := Result and LTmpResult;
+        end else begin
+          SetLength(LNewP^.buffer, (LLastAddedPosition+1) - LNewP^.startPos + LTempCapturedSize );
+        end;
+      end;
+      Move(LTempData[0],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LTempCapturedSize);
     end;
   Except
     on E:Exception do begin

src/libraries/abstractmem/UFileMem.pas

@@ -64,8 +64,8 @@ type
     {$IFDEF ABSTRACTMEM_ENABLE_STATS}
     FStats : TFileMemStats;
     {$ENDIF}
-    function OnCacheNeedDataProc(var ABuffer; AStartPos : Integer; ASize : Integer) : Boolean;
-    function OnCacheSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Boolean;
+    function OnCacheNeedDataProc(var ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
+    function OnCacheSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
     procedure SetMaxCacheSize(const Value: Integer);
     function GetMaxCacheSize: Integer;
     function GetMaxCacheDataBlocks: Integer;
@@ -80,7 +80,7 @@ type
     Constructor Create(const AFileName : String; AReadOnly : Boolean); reintroduce;
     Destructor Destroy; override;
     function New(AMemSize : Integer) : TAMZone; override;
-    procedure Write(const APosition : Integer; const ABuffer; ASize : Integer); overload; override;
+    function Write(const APosition : Integer; const ABuffer; ASize : Integer) : Integer; overload; override;
     function Read(const APosition : Integer; var ABuffer; ASize : Integer) : Integer; overload; override;
     {$IFDEF ABSTRACTMEM_TESTING_MODE}
     // Warning: Accessing Cache is not Safe Thread protected, use LockCache/UnlockCache instead
@@ -299,15 +299,14 @@ begin
   end;
 end;
 
-function TFileMem.OnCacheNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Boolean;
+function TFileMem.OnCacheNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Integer;
 begin
-  Result := inherited Read(AStartPos,ABuffer,ASize) = ASize;
+  Result := inherited Read(AStartPos,ABuffer,ASize);
 end;
 
-function TFileMem.OnCacheSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Boolean;
+function TFileMem.OnCacheSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Integer;
 begin
-  inherited Write(AStartPos,ABuffer,ASize);
-  Result := True;
+  Result := inherited Write(AStartPos,ABuffer,ASize);
 end;
 
 function TFileMem.Read(const APosition: Integer; var ABuffer; ASize: Integer): Integer;
@@ -353,7 +352,7 @@ begin
   FLock.Release;
 end;
 
-procedure TFileMem.Write(const APosition: Integer; const ABuffer; ASize: Integer);
+function TFileMem.Write(const APosition: Integer; const ABuffer; ASize: Integer) : Integer;
 begin
   if (Not Assigned(FCache)) Or (FIsFlushingCache) then begin
     inherited;

src/libraries/abstractmem/tests/src/UCacheMem.Tests.pas

@@ -19,8 +19,10 @@ interface
    TestTCacheMem = class(TTestCase)
    strict private
      FCurrentMem : TBytes;
-     function OnNeedDataProc(var ABuffer; AStartPos : Integer; ASize : Integer) : Boolean;
-     function OnSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Boolean;
+     function OnNeedDataProc(var ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
+     function OnSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
+     procedure CheckBytes(const ABytes : TBytes; ALoadedStartPos, ASize : Integer);
+     procedure InitCurrentMem(ASize : Integer);
    public
      procedure SetUp; override;
      procedure TearDown; override;
@@ -30,29 +32,59 @@ interface
 
  implementation
 
-function TestTCacheMem.OnNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Boolean;
+procedure TestTCacheMem.CheckBytes(const ABytes: TBytes; ALoadedStartPos, ASize: Integer);
+var i : Integer;
+begin
+  if ASize<=0 then ASize := Length(ABytes)
+  else if ASize > Length(ABytes) then ASize := Length(ABytes);
+
+  for i := 0 to ASize-1 do begin
+    if (ABytes[i] <> ((ALoadedStartPos+i+1) MOD 89)) then begin
+      raise ETestFailure.Create(Format('Value at pos %d (item %d) should be %d instead of %d',[ALoadedStartPos+i,i,((ALoadedStartPos+i) MOD 89),ABytes[i]]));
+    end;
+
+  end;
+
+end;
+
+procedure TestTCacheMem.InitCurrentMem(ASize: Integer);
+var i : Integer;
+begin
+  SetLength(FCurrentMem,ASize);
+  for i :=0 to High(FCurrentMem) do begin
+    FCurrentMem[i] := ((i+1) MOD 89);
+  end;
+end;
+
+function TestTCacheMem.OnNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Integer;
 begin
   if (High(FCurrentMem) >= AStartPos + ASize) then begin
-    Result := True;
+    Result := ASize;
     Move(FCurrentMem[AStartPos],ABuffer,ASize);
-  end else Result := False;
+  end else begin
+    Result := High(FCurrentMem) - AStartPos;
+    if Result>0 then begin
+      Move(FCurrentMem[AStartPos],ABuffer,Result);
+    end;
+  end;
 end;
 
-function TestTCacheMem.OnSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Boolean;
+function TestTCacheMem.OnSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Integer;
 begin
   if (High(FCurrentMem) >= AStartPos + ASize) then begin
-    Result := True;
+    Result := ASize;
     Move(ABuffer,FCurrentMem[AStartPos],ASize);
-  end else Result := False;
+  end else begin
+    Result := High(FCurrentMem) - AStartPos;
+    if Result>0 then begin
+      Move(ABuffer,FCurrentMem[AStartPos],Result);
+    end;
+  end;
 end;
 
 procedure TestTCacheMem.SetUp;
-var i : Integer;
 begin
-  SetLength(FCurrentMem,100000);
-  for i :=0 to High(FCurrentMem) do begin
-    FCurrentMem[i] := i MOD 89;
-  end;
+  SetLength(FCurrentMem,0);
 end;
 
 procedure TestTCacheMem.TearDown;
@@ -67,7 +99,28 @@ Var LCMem : TCacheMem;
 begin
   LCMem := TCacheMem.Create(OnNeedDataProc,OnSaveDataProc);
   Try
+    InitCurrentMem(11);
     SetLength(LBuff,Length(FCurrentMem));
+
+    LCMem.DefaultCacheDataBlocksSize :=10;
+    // Check replacing initial position of buffer on Load
+    LCMem.Clear;
+    LCMem.LoadData(LBuff[0],3,3);
+    CheckBytes(LBuff,3,3);
+    LCMem.LoadData(LBuff[0],1,9);
+    CheckBytes(LBuff,1,9);
+    LCMem.ConsistencyCheck;
+
+    // Check replacing initial position of buffer on Save
+    LCMem.Clear;
+    LCMem.SaveToCache(LBuff[0],3,3,True);
+    LCMem.SaveToCache(LBuff[0],7,0,True);
+    LCMem.ConsistencyCheck;
+
+    LCMem.Clear;
+    InitCurrentMem(100000);
+    SetLength(LBuff,Length(FCurrentMem));
+
     CheckTrue( LCMem.LoadData(LBuff[0],0,100) );
     // Incremental round
     i := 1;
@@ -76,6 +129,7 @@ begin
       inc(i);
     end;
     CheckFalse( LCMem.LoadData( LBuff[0],i,i) );
+
     LCMem.ConsistencyCheck;
   Finally
     LCMem.Free;