Fix CacheMem bug to allow +2Gb files

src/libraries/abstractmem/UCacheMem.pas

@@ -52,12 +52,12 @@ type
     balance : Integer;
     //
     buffer : TBytes;
-    startPos : Integer;
+    startPos : Int64;
     used_previous : PCacheMemData;
     used_next : PCacheMemData;
     pendingToSave : Boolean;
     function GetSize : Integer;
-    function GetEndPos : Integer;
+    function GetEndPos : Int64;
     procedure Clear;
     function ToString : String;
     procedure DoMark(const ACacheMem : TCacheMem; AMySelfPointer : PCacheMemData; AAddToList : Boolean);
@@ -103,7 +103,7 @@ type
     flushSize : Integer;
     flushElapsedMillis : Int64;
     freememCount : Integer;
-    freememSize : Integer;
+    freememSize : Int64;
     freememElaspedMillis : Int64;
     maxUsedCacheSize : Integer;
     reusedCacheMemDataCount : Integer;
@@ -116,9 +116,9 @@ type
   end;
   {$ENDIF}
 
-  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;
+  TOnNeedDataProc = function(var ABuffer; AStartPos : Int64; ASize: Integer): Integer of object;
+  TOnSaveDataProc = function(const ABuffer; AStartPos : Int64; ASize: Integer): Integer of object;
+  TOnNeedsTotalSizeProc = function(const ABuffer; AStartPos : Int64; ASize: Integer): Integer of object;
 
   ECacheMem = Class(Exception);
 
@@ -130,47 +130,47 @@ type
     FOldestUsed : PCacheMemData;
     FNewestUsed : PCacheMemData;
     FCacheData : TCacheMemDataTree;
-    FPendingToSaveBytes : Integer;
-    FCacheDataBlocks : Integer;
-    FCacheDataSize : Integer;
+    FPendingToSaveBytes : Int64;
+    FCacheDataBlocks : Int64;
+    FCacheDataSize : Int64;
     FOnNeedDataProc : TOnNeedDataProc;
     FOnSaveDataProc : TOnSaveDataProc;
-    FMaxCacheSize: Integer;
-    FMaxCacheDataBlocks: Integer;
-    FDefaultCacheDataBlocksSize : Integer;
+    FMaxCacheSize: Int64;
+    FMaxCacheDataBlocks: Int64;
+    FDefaultCacheDataBlocksSize : Int64;
     FGridCache : Boolean;
-    function FindCacheMemDataByPosition(APosition : Integer; out APCacheMemData : PCacheMemData) : Boolean;
+    function FindCacheMemDataByPosition(APosition : Int64; out APCacheMemData : PCacheMemData) : Boolean;
     procedure Delete(var APCacheMemData : PCacheMemData); overload;
     function FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean; overload;
     procedure CheckMaxMemUsage;
-    function LoadDataExt(var ABuffer; const AStartPos, ASize : Integer) : Boolean;
-    procedure SaveToCacheExt(const ABuffer; ASize, AStartPos : Integer; AMarkAsPendingToSave : Boolean);
+    function LoadDataExt(var ABuffer; AStartPos : Int64; ASize : Integer) : Boolean;
+    procedure SaveToCacheExt(const ABuffer; ASize : Integer; AStartPos : Int64; AMarkAsPendingToSave : Boolean);
   public
     Constructor Create(AOnNeedDataProc : TOnNeedDataProc; AOnSaveDataProc : TOnSaveDataProc);
     Destructor Destroy; override;
     //
     procedure Clear;
-    procedure SaveToCache(const ABuffer; ASize, AStartPos : Integer; AMarkAsPendingToSave : Boolean); overload;
-    procedure SaveToCache(const ABuffer : TBytes; AStartPos : Integer; AMarkAsPendingToSave : Boolean); overload;
-    function LoadData(var ABuffer; const AStartPos, ASize : Integer) : Boolean;
+    procedure SaveToCache(const ABuffer; ASize : Integer; AStartPos : Int64; AMarkAsPendingToSave : Boolean); overload;
+    procedure SaveToCache(const ABuffer : TBytes; AStartPos : Int64; AMarkAsPendingToSave : Boolean); overload;
+    function LoadData(var ABuffer; AStartPos : Int64; ASize : Integer) : Boolean;
     function ToString : String; reintroduce;
     function FlushCache : Boolean; overload;
-    function FreeMem(const AMaxMemSize, AMaxBlocks : Integer) : Boolean;
+    function FreeMem(const AMaxMemSize, AMaxBlocks : Int64) : Boolean;
 
     procedure ConsistencyCheck;
 
-    property CacheDataSize : Integer read FCacheDataSize;
+    property CacheDataSize : Int64 read FCacheDataSize;
     // Bytes in cache
 
-    property PendingToSaveSize : Integer read FPendingToSaveBytes;
+    property PendingToSaveSize : Int64 read FPendingToSaveBytes;
     // Bytes in cache pending to flush
 
-    property CacheDataBlocks : Integer read FCacheDataBlocks;
+    property CacheDataBlocks : Int64 read FCacheDataBlocks;
     // Blocks in cache
 
-    property MaxCacheSize : Integer read FMaxCacheSize write FMaxCacheSize;
-    property MaxCacheDataBlocks : Integer read FMaxCacheDataBlocks write FMaxCacheDataBlocks;
-    property DefaultCacheDataBlocksSize : Integer read FDefaultCacheDataBlocksSize write FDefaultCacheDataBlocksSize;
+    property MaxCacheSize : Int64 read FMaxCacheSize write FMaxCacheSize;
+    property MaxCacheDataBlocks : Int64 read FMaxCacheDataBlocks write FMaxCacheDataBlocks;
+    property DefaultCacheDataBlocksSize : Int64 read FDefaultCacheDataBlocksSize write FDefaultCacheDataBlocksSize;
     property GridCache : Boolean read FGridCache write FGridCache;
     {$IFDEF ABSTRACTMEM_ENABLE_STATS}
     procedure ClearStats;
@@ -342,7 +342,7 @@ begin
   if not FindCacheMemDataByPosition(APCacheMemData^.startPos,LConsistency) then Raise ECacheMem.Create(Format('Delete not found for %s',[APCacheMemData^.ToString]));
   Dec(FCacheDataSize,APCacheMemData.GetSize);
   if APCacheMemData^.pendingToSave then begin
-    Dec(FPendingToSaveBytes,APCacheMemData^.GetSize);
+    FPendingToSaveBytes := FPendingToSaveBytes - Int64(APCacheMemData^.GetSize);
   end;
   SetLength(APCacheMemData^.buffer,0);
   APCacheMemData^.UnMark(Self,APCacheMemData);
@@ -361,7 +361,7 @@ begin
   inherited;
 end;
 
-function TCacheMem.FindCacheMemDataByPosition(APosition: Integer; out APCacheMemData: PCacheMemData): Boolean;
+function TCacheMem.FindCacheMemDataByPosition(APosition: Int64; out APCacheMemData: PCacheMemData): Boolean;
   // Will return APCacheMemData that contains APosition
   // When returning FALSE, APCacheMemData.startPos will be < APosition (or NIL)
 var PSearch : PCacheMemData;
@@ -394,7 +394,7 @@ end;
 function TCacheMem.FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean;
 var i : Integer;
   PToCurrent, PToNext : PCacheMemData;
-  LTotalBytesSaved, LTotalBytesError : Integer;
+  LTotalBytesSaved, LTotalBytesError : Int64;
   {$IFDEF ABSTRACTMEM_ENABLE_STATS}
   LTickCount : TTickCount;
   {$ENDIF}
@@ -424,11 +424,11 @@ begin
         if Not Assigned(FOnSaveDataProc) then Exit(False);
         if FOnSaveDataProc(PToCurrent^.buffer[0],PToCurrent^.startPos,PToCurrent^.GetSize)<>PToCurrent^.GetSize then begin
           Result := False;
-          inc(LTotalBytesError,PToCurrent^.GetSize);
+          inc(LTotalBytesError,Int64(PToCurrent^.GetSize));
         end else begin
-          inc(LTotalBytesSaved,PToCurrent^.GetSize);
+          inc(LTotalBytesSaved,Int64(PToCurrent^.GetSize));
           PToCurrent^.pendingToSave := False;
-          Dec(FPendingToSaveBytes,PToCurrent^.GetSize);
+          FPendingToSaveBytes := FPendingToSaveBytes - Int64(PToCurrent^.GetSize);
         end;
       end;
       PToNext := PToCurrent^.used_next;
@@ -450,10 +450,10 @@ begin
   Result := FlushCache(Nil); // FlushCache without a list, without order
 end;
 
-function TCacheMem.FreeMem(const AMaxMemSize, AMaxBlocks: Integer) : Boolean;
+function TCacheMem.FreeMem(const AMaxMemSize, AMaxBlocks: Int64) : Boolean;
 var
   i, LPreviousCacheDataSize, LTempCacheDataSize,
-  LFinalMaxMemSize, LMaxPendingRounds : Integer;
+  LFinalMaxMemSize, LMaxPendingRounds : Int64;
   PToRemove, PToNext : PCacheMemData;
   LListToFlush : TOrderedList<PCacheMemData>;
   {$IFDEF ABSTRACTMEM_ENABLE_STATS}
@@ -522,9 +522,9 @@ begin
   {$ENDIF}
 end;
 
-function TCacheMem.LoadData(var ABuffer; const AStartPos, ASize: Integer): Boolean;
+function TCacheMem.LoadData(var ABuffer; AStartPos : Int64; ASize: Integer): Boolean;
 Var
-  LNewStartPos, LIndex, LLoadSize, LMoveSize : Integer;
+  LNewStartPos, LIndex, LLoadSize, LMoveSize : Int64;
   Lpc : PByte;
   LData : TBytes;
 begin
@@ -552,7 +552,7 @@ begin
   end;
 end;
 
-function TCacheMem.LoadDataExt(var ABuffer; const AStartPos, ASize: Integer): Boolean;
+function TCacheMem.LoadDataExt(var ABuffer; AStartPos : Int64; ASize: Integer): Boolean;
   // Will return a Pointer to AStartPos
 
   function _CaptureDataFromOnNeedDataProc(ACapturePosStart, ACaptureSize : Integer; var ACapturedData : TBytes; out ACapturedSize : Integer) : Boolean;
@@ -578,7 +578,7 @@ function TCacheMem.LoadDataExt(var ABuffer; const AStartPos, ASize: Integer): Bo
 
 var
   LNewP, PCurrent, PToDelete : PCacheMemData;
-  LLastAddedPosition, LBytesCount, LSizeToStore, LNewStartPos : Integer;
+  LLastAddedPosition, LBytesCount, LSizeToStore, LNewStartPos : Int64;
   LTempData : TBytes;
   LTempCapturedSize : Integer;
   LTmpResult : Boolean;
@@ -691,7 +691,7 @@ begin
   Inc(FCacheDataBlocks);
   //
   if (LNewP^.pendingToSave) then begin
-    inc(FPendingToSaveBytes,LNewP^.GetSize);
+    FPendingToSaveBytes := FPendingToSaveBytes + Int64(LNewP^.GetSize);
   end;
 
   Move(LNewP^.buffer[ AStartPos-LNewP^.startPos ],ABuffer,ASize);
@@ -699,7 +699,7 @@ begin
   CheckMaxMemUsage;
 end;
 
-procedure TCacheMem.SaveToCacheExt(const ABuffer; ASize, AStartPos: Integer; AMarkAsPendingToSave : Boolean);
+procedure TCacheMem.SaveToCacheExt(const ABuffer; ASize: Integer; AStartPos: Int64; AMarkAsPendingToSave : Boolean);
 var
   LNewP, PCurrent, PToDelete : PCacheMemData;
   LLastAddedPosition, LBytesCount : Integer;
@@ -713,7 +713,7 @@ begin
       Move(ABuffer,PCurrent^.buffer[ AStartPos - PCurrent^.startPos ], ASize);
       if (Not PCurrent^.pendingToSave) and (AMarkAsPendingToSave) then begin
         PCurrent^.pendingToSave := True;
-        inc(FPendingToSaveBytes,PCurrent^.GetSize);
+        FPendingToSaveBytes := FPendingToSaveBytes + Int64(PCurrent^.GetSize);
       end;
       PCurrent^.MarkAsUsed(Self,PCurrent);
       Exit;
@@ -778,20 +778,20 @@ begin
   Inc(FCacheDataBlocks);
   //
   if (LNewP^.pendingToSave) then begin
-    inc(FPendingToSaveBytes,LNewP^.GetSize);
+    FPendingToSaveBytes := FPendingToSaveBytes + Int64(LNewP^.GetSize);
   end;
 
   CheckMaxMemUsage;
 end;
 
-procedure TCacheMem.SaveToCache(const ABuffer: TBytes; AStartPos: Integer; AMarkAsPendingToSave : Boolean);
+procedure TCacheMem.SaveToCache(const ABuffer: TBytes; AStartPos: Int64; AMarkAsPendingToSave : Boolean);
 begin
   SaveToCache(ABuffer[0],Length(ABuffer),AStartPos,AMarkAsPendingToSave);
 end;
 
-procedure TCacheMem.SaveToCache(const ABuffer; ASize, AStartPos: Integer; AMarkAsPendingToSave: Boolean);
+procedure TCacheMem.SaveToCache(const ABuffer; ASize: Integer; AStartPos: Int64; AMarkAsPendingToSave: Boolean);
 Var
-  LNewStartPos, LSizeToStore : Integer;
+  LNewStartPos, LSizeToStore : Int64;
   Lpc : PByte;
   LLeftBuff : TBytes;
 begin
@@ -945,9 +945,9 @@ begin
 end;
 
 
-function TCacheMemData.GetEndPos: Integer;
+function TCacheMemData.GetEndPos: Int64;
 begin
-  Result := Self.startPos + Self.GetSize - 1;
+  Result := Self.startPos + Int64(Self.GetSize) - 1;
 end;
 
 function TCacheMemData.GetSize: Integer;

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) : Integer;
-    function OnCacheSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
+    function OnCacheNeedDataProc(var ABuffer; AStartPos : Int64; ASize: Integer): Integer;
+    function OnCacheSaveDataProc(const ABuffer; AStartPos : Int64; ASize: Integer): Integer;
     procedure SetMaxCacheSize(const Value: Integer);
     function GetMaxCacheSize: Integer;
     function GetMaxCacheDataBlocks: Integer;
@@ -308,12 +308,12 @@ begin
   end;
 end;
 
-function TFileMem.OnCacheNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Integer;
+function TFileMem.OnCacheNeedDataProc(var ABuffer; AStartPos : Int64; ASize: Integer): Integer;
 begin
   Result := inherited Read(AStartPos,ABuffer,ASize);
 end;
 
-function TFileMem.OnCacheSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Integer;
+function TFileMem.OnCacheSaveDataProc(const ABuffer; AStartPos : Int64; ASize: Integer): Integer;
 begin
   Result := inherited Write(AStartPos,ABuffer,ASize);
 end;

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

@@ -19,8 +19,11 @@ interface
    TestTCacheMem = class(TTestCase)
    strict private
      FCurrentMem : TBytes;
-     function OnNeedDataProc(var ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
-     function OnSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
+     FReadCount, FSaveCount, FReadBytes, FSaveBytes : Int64;
+     function OnNeedDataProc(var ABuffer; AStartPos : Int64; ASize : Integer) : Integer;
+     function OnSaveDataProc(const ABuffer; AStartPos : Int64; ASize : Integer) : Integer;
+     function OnNeedDataProc_BlackHole(var ABuffer; AStartPos : Int64; ASize : Integer) : Integer;
+     function OnSaveDataProc_BlackHole(const ABuffer; AStartPos : Int64; ASize : Integer) : Integer;
      procedure CheckBytes(const ABytes : TBytes; ALoadedStartPos, ASize : Integer);
      procedure InitCurrentMem(ASize : Integer);
    public
@@ -28,6 +31,7 @@ interface
      procedure TearDown; override;
    published
      procedure TestCacheMem;
+     procedure TestCacheMem_64bits;
    end;
 
  implementation
@@ -54,10 +58,16 @@ begin
   for i :=0 to High(FCurrentMem) do begin
     FCurrentMem[i] := ((i+1) MOD 89);
   end;
+  FReadCount := 0;
+  FSaveCount := 0;
+  FReadBytes := 0;
+  FSaveBytes := 0;
 end;
 
-function TestTCacheMem.OnNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Integer;
+function TestTCacheMem.OnNeedDataProc(var ABuffer; AStartPos: Int64; ASize: Integer): Integer;
 begin
+  inc(FReadCount);
+  inc(FReadBytes,ASize);
   if (Length(FCurrentMem) >= AStartPos + ASize) then begin
     Result := ASize;
     Move(FCurrentMem[AStartPos],ABuffer,ASize);
@@ -69,8 +79,21 @@ begin
   end;
 end;
 
-function TestTCacheMem.OnSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Integer;
+function TestTCacheMem.OnNeedDataProc_BlackHole(var ABuffer; AStartPos: Int64;
+  ASize: Integer): Integer;
+var LBuffer : TBytes;
 begin
+  // Just fill Buffer with 0 bytes
+  FillChar(ABuffer,ASize,0);
+  inc(FReadCount);
+  inc(FReadBytes,ASize);
+  Result := ASize;
+end;
+
+function TestTCacheMem.OnSaveDataProc(const ABuffer; AStartPos: Int64; ASize: Integer): Integer;
+begin
+  inc(FSaveCount);
+  inc(FSaveBytes,ASize);
   if (Length(FCurrentMem) >= AStartPos + ASize) then begin
     Result := ASize;
     Move(ABuffer,FCurrentMem[AStartPos],ASize);
@@ -82,9 +105,21 @@ begin
   end;
 end;
 
+function TestTCacheMem.OnSaveDataProc_BlackHole(const ABuffer; AStartPos: Int64;
+  ASize: Integer): Integer;
+begin
+  inc(FSaveCount);
+  inc(FSaveBytes,ASize);
+  Result := ASize;
+end;
+
 procedure TestTCacheMem.SetUp;
 begin
   SetLength(FCurrentMem,0);
+  FReadCount := 0;
+  FSaveCount := 0;
+  FReadBytes := 0;
+  FSaveBytes := 0;
 end;
 
 procedure TestTCacheMem.TearDown;
@@ -184,6 +219,47 @@ begin
   End;
 end;
 
+procedure TestTCacheMem.TestCacheMem_64bits;
+Var LCMem : TCacheMem;
+  LBuff : TBytes;
+  i : Integer;
+  LStartPos , LEndPos : Int64;
+
+begin
+  InitCurrentMem(0);
+  SetLength(LBuff,256*200);
+  LCMem := TCacheMem.Create(OnNeedDataProc_BlackHole,OnSaveDataProc_BlackHole);
+  Try
+    LCMem.GridCache := False;
+    LCMem.DefaultCacheDataBlocksSize := -1;
+    LCMem.MaxCacheSize := 1024*1024 * 1;
+    LCMem.MaxCacheDataBlocks := 500;
+    Try
+      LStartPos := (256*256*256)-(1024*10);
+      LEndPos := (LStartPos * 256) + Length(LBuff) + 1024;
+      i := 0;
+      repeat
+        inc(i);
+        Inc(LStartPos,Length(LBuff));
+        LCMem.LoadData(LBuff[0],LStartPos,Length(LBuff));
+        if (i MOD 2)=0 then begin
+          LCMem.SaveToCache(LBuff,LStartPos,True);
+        end;
+
+      until LStartPos > LEndPos;
+    Except
+      on E:Exception do begin
+        E.Message := Format('Round %d StartPos:%d %s (%s):%s',[i, LStartPos,LStartPos.ToHexString, E.ClassName,E.Message]);
+        Raise;
+      end;
+    End;
+    // Check replacing initial position of buffer on Load
+    LCMem.Clear;
+  Finally
+    LCMem.Free;
+  End;
+end;
+
 initialization
   RegisterTest(TestTCacheMem{$IFNDEF FPC}.Suite{$ENDIF});
 end.