Fixed bug sorting CacheMem on +4Gb files

src/libraries/abstractmem/UCacheMem.pas

@@ -220,9 +220,11 @@ end;
 
 { TCacheMem }
 
-function _CacheMem_CacheData_Comparer(const Left, Right: PCacheMemData): Integer;
+function _TCacheMemDataTree_Compare(const Left, Right: PCacheMemData): Integer;
 begin
-  Result := Integer(Left^.startPos) - Integer(Right^.startPos);
+  if Left^.startPos < Right^.startPos then Result := -1
+  else if Left^.startPos > Right^.startPos then Result := 1
+  else Result := 0;
 end;
 
 procedure TCacheMem.CheckMaxMemUsage;
@@ -231,7 +233,9 @@ begin
      and
      ((FMaxCacheDataBlocks < 0) or (FCacheDataBlocks<=FMaxCacheDataBlocks)) then Exit;
   // When calling FreeMem will increase call in order to speed
-  FreeMem((FMaxCacheSize-1) SHR 1, (FMaxCacheDataBlocks-1) SHR 1);
+  if not FreeMem((FMaxCacheSize-1) SHR 1, (FMaxCacheDataBlocks-1) SHR 1) then begin
+    raise ECacheMem.Create(Format('FreeMem(%d -> %d,%d -> %d)=False',[FCacheDataSize,(FMaxCacheSize-1) SHR 1,FCacheDataBlocks,(FMaxCacheDataBlocks-1) SHR 1]));
+  end;
 end;
 
 procedure TCacheMem.Clear;
@@ -290,7 +294,7 @@ begin
   if LTotalSize<>FCacheDataSize then raise ECacheMem.Create(Format('Cache size %d <> %d',[LTotalSize,FCacheDataSize]));
   if LTotalPendingSize<>FPendingToSaveBytes then raise ECacheMem.Create(Format('Total pending size %d <> %d',[LTotalPendingSize,FPendingToSaveBytes]));
 
-  LOrder := TOrderedList<PCacheMemData>.Create(False,_CacheMem_CacheData_Comparer);
+  LOrder := TOrderedList<PCacheMemData>.Create(False,_TCacheMemDataTree_Compare);
   try
     PLast := Nil;
     PCurrent := FOldestUsed;
@@ -341,7 +345,7 @@ procedure TCacheMem.Delete(var APCacheMemData : PCacheMemData);
 var LConsistency : PCacheMemData;
 begin
   if not FindCacheMemDataByPosition(APCacheMemData^.startPos,LConsistency) then Raise ECacheMem.Create(Format('Delete not found for %s',[APCacheMemData^.ToString]));
-  Dec(FCacheDataSize,APCacheMemData.GetSize);
+  Dec(FCacheDataSize,Int64(APCacheMemData.GetSize));
   if APCacheMemData^.pendingToSave then begin
     FPendingToSaveBytes := FPendingToSaveBytes - Int64(APCacheMemData^.GetSize);
   end;
@@ -478,7 +482,7 @@ begin
   else LMaxPendingRounds := FCacheDataBlocks - AMaxBlocks;
   //
   PToRemove := FOldestUsed;
-  LListToFlush := TOrderedList<PCacheMemData>.Create(False,_CacheMem_CacheData_Comparer);
+  LListToFlush := TOrderedList<PCacheMemData>.Create(False,_TCacheMemDataTree_Compare);
   try
     LTempCacheDataSize := FCacheDataSize;
     while (Assigned(PToRemove)) and
@@ -487,10 +491,12 @@ begin
       do begin
       Dec(LMaxPendingRounds);
       PToNext := PToRemove^.used_next; // Capture now to avoid future PToRemove updates
-      Dec(LTempCacheDataSize, PToRemove^.GetSize);
+      Dec(LTempCacheDataSize, Int64(PToRemove^.GetSize));
       if (PToRemove^.pendingToSave) then begin
         // Add to list to flush
-        LListToFlush.Add(PToRemove);
+        if LListToFlush.Add(PToRemove)<0 then begin
+          raise ECacheMem.Create(Format('Inconsistent error on Freemem cannot add pending to save: %s',[PToRemove.ToString]));
+        end;
       end else Delete(PToRemove);
       PToRemove := PToNext; // Point to next used
     end;
@@ -501,11 +507,12 @@ begin
       PToRemove := LListToFlush.Get(i);
       Delete( PToRemove );
     end;
+    //
+    if (Result) and (LTempCacheDataSize <> FCacheDataSize) then raise ECacheMem.Create(Format('Inconsistent error on FreeMem Expected size %d <> obtained %d (save list %d)',[LTempCacheDataSize,FCacheDataSize,LListToFlush.Count]));
+    if (Result) and (LMaxPendingRounds>0) then raise ECacheMem.Create(Format('Inconsistent error on FreeMem Expected Max Blocks %d <> obtained %d',[AMaxBlocks,FCacheDataBlocks]));
   finally
     LListToFlush.Free;
   end;
-  if (Result) and (LTempCacheDataSize <> FCacheDataSize) then raise ECacheMem.Create(Format('Inconsistent error on FreeMem Expected size %d <> obtained %d',[LTempCacheDataSize,FCacheDataSize]));
-  if (Result) and (LMaxPendingRounds>0) then raise ECacheMem.Create(Format('Inconsistent error on FreeMem Expected Max Blocks %d <> obtained %d',[AMaxBlocks,FCacheDataBlocks]));
 
   Result := (Result) And (FCacheDataSize <= AMaxMemSize);
   {$IFDEF ABSTRACTMEM_ENABLE_STATS}
@@ -691,7 +698,7 @@ begin
   // Save new
   LNewP^.MarkAsUsed(Self,LNewP);
   if Not FCacheData.Add( LNewP ) then raise ECacheMem.Create(Format('Inconsistent LoadData CacheData duplicate for %s',[LNewP^.ToString]));
-  Inc(FCacheDataSize,Length(LNewP^.buffer));
+  Inc(FCacheDataSize,Int64(Length(LNewP^.buffer)));
   Inc(FCacheDataBlocks);
   //
   if (LNewP^.pendingToSave) then begin
@@ -778,7 +785,7 @@ begin
   // Save new
   LNewP^.MarkAsUsed(Self,LNewP);
   if Not FCacheData.Add(LNewP) then raise ECacheMem.Create(Format('Inconsistent SaveToCache CacheData duplicate for %s',[LNewP^.ToString]));
-  Inc(FCacheDataSize,Length(LNewP^.buffer));
+  Inc(FCacheDataSize,Int64(Length(LNewP^.buffer)));
   Inc(FCacheDataBlocks);
   //
   if (LNewP^.pendingToSave) then begin
@@ -1017,13 +1024,6 @@ end;
 
 { TCacheMemDataTree }
 
-function _TCacheMemDataTree_Compare(const Left, Right: PCacheMemData): Integer;
-begin
-  if Left^.startPos < Right^.startPos then Result := -1
-  else if Left^.startPos > Right^.startPos then Result := 1
-  else Result := 0;
-end;
-
 function TCacheMemDataTree.AreEquals(const ANode1, ANode2: PCacheMemData): Boolean;
 begin
   Result := ANode1 = ANode2;

src/libraries/abstractmem/UFileMem.pas

@@ -61,6 +61,7 @@ type
     FFileName: String;
     FIsStableCache: Boolean;
     FIsFlushingCache : Boolean;
+    FIncreaseFileBytes: Int64;
     {$IFDEF ABSTRACTMEM_ENABLE_STATS}
     FStats : TFileMemStats;
     {$ENDIF}
@@ -73,6 +74,7 @@ type
     procedure CacheIsNOTStable; inline;
     function GetUseCache: Boolean;
     procedure SetUseCache(const Value: Boolean);
+    procedure SetIncreaseFileBytes(const Value: Int64);
   protected
     function AbsoluteWrite(const AAbsolutePosition : Int64; const ABuffer; ASize : Integer) : Integer; override;
     function AbsoluteRead(const AAbsolutePosition : Int64; var ABuffer; ASize : Integer) : Integer; override;
@@ -99,6 +101,7 @@ type
     {$IFDEF ABSTRACTMEM_ENABLE_STATS}
     function GetStatsReport(AClearStats : Boolean) : String; override;
     {$ENDIF}
+    property IncreaseFileBytes : Int64 read FIncreaseFileBytes write SetIncreaseFileBytes;
   End;
 
 implementation
@@ -177,6 +180,7 @@ begin
   FIsStableCache := True;
   FIsFlushingCache := False;
   FFileName := AFileName;
+  FIncreaseFileBytes := 1024*4; // 4K by default
   if AReadOnly then LFileMode := fmOpenRead + fmShareDenyNone
   else begin
     if FileExists(AFileName) then LFileMode := fmOpenReadWrite else LFileMode := fmCreate;
@@ -228,6 +232,10 @@ begin
   if (FFileStream.Position<ANextAvailablePos) then raise EFileMem.Create(Format('End file position (%d) is less than next available pos %d',[FFileStream.Position,ANextAvailablePos]));
   // At this time ANextAvailablePos <= FFileStream.Position
   AMaxAvailablePos := ANextAvailablePos + ANeedSize;
+  if FIncreaseFileBytes>0 then begin
+    AMaxAvailablePos := ((((AMaxAvailablePos - 1) DIV FIncreaseFileBytes)+1) * FIncreaseFileBytes);
+  end;
+
   if (FFileStream.Size<AMaxAvailablePos) then begin
     SetLength(LBuff,AMaxAvailablePos - FFileStream.Position);
     FillChar(LBuff[0],Length(LBuff),0);
@@ -336,6 +344,12 @@ begin
   end;
 end;
 
+procedure TFileMem.SetIncreaseFileBytes(const Value: Int64);
+begin
+  if (Value<0) or (Value>(1024*1024*100)) then FIncreaseFileBytes := 0
+  else FIncreaseFileBytes := Value;
+end;
+
 procedure TFileMem.SetMaxCacheDataBlocks(const Value: Integer);
 begin
   if Not Assigned(FCache) then Exit;