Merge pull request #29 from PascalCoinDev/master

Fix issue #207 "out of memory" when compiled with FreePascal

src/config.inc

@@ -69,7 +69,10 @@
 
   // Activate GNUGETTEXT library
   {$DEFINE USE_GNUGETTEXT}
-
+  
+  // Activate usage of TPCTemporalFileStream instead of TBytes in order to minimize mem usage
+  // This also fixes issue #207 High memory usage on FreePascal compiler
+  {$DEFINE USE_BIGBLOCKS_MEM_ON_DISK}
 
 { ********************************************************************
   Don't touch more code, it will addapt based on your preferences

src/core/UAccounts.pas

@@ -480,7 +480,19 @@ Procedure Check_Safebox_Integrity(sb : TPCSafebox; title: String);
 implementation
 
 uses
-  ULog, {$IFnDEF USE_ABSTRACTMEM} UAccountKeyStorage,{$ENDIF} math, UCommon, UPCOperationsBlockValidator;
+  ULog, {$IFnDEF USE_ABSTRACTMEM} UAccountKeyStorage,{$ENDIF} math, UCommon, UPCOperationsBlockValidator, UPCTemporalFileStream;
+
+
+{$IFDEF FPC}
+  {$DEFINE USE_BIGBLOCKS_MEM_ON_DISK}
+  // USE_BIGBLOCKS_MEM_ON_DISK directive is used in order to prevent a FreePascal issue with Heap allocation strategy that
+  // reuses big blocks of disposed memory and fragments it, this causes that when a new big block of same size that previously
+  // freeded mem is needed it will not reuse because has been fragmented...
+  // Tested on FPC version 3.2.0 (2020-11-03) and order versions
+  // Defragmention documented here: https://www.freepascal.org/docs-html/current/prog/progsu172.html
+  // This issue is not detected on current Delphi memory manager (Tested on Delphi 10.3.2)
+{$ENDIF}
+
 
 { This function is for testing purpose only.
   Will check if Account Names are well assigned and stored }
@@ -2181,7 +2193,7 @@ Type
     newBlocks : TOrderedBlockAccountList; // Saves final blocks values on modified blocks
     namesDeleted : TOrderedRawList;
     namesAdded : TOrderedRawList;
-    oldBufferBlocksHash: TBytesBuffer;
+    oldBufferBlocksHash: {$IFDEF USE_BIGBLOCKS_MEM_ON_DISK}TPCTemporalFileStream{$ELSE}TBytesBuffer{$ENDIF};
     oldTotalBalance: Int64;
     oldTotalFee: Int64;
     oldSafeBoxHash : TRawBytes;
@@ -2347,7 +2359,12 @@ begin
     Psnapshot^.newBlocks := FModifiedBlocksFinalState;
     Psnapshot^.namesDeleted := FDeletedNamesSincePreviousSafebox;
     Psnapshot^.namesAdded := FAddedNamesSincePreviousSafebox;
+    {$IFDEF USE_BIGBLOCKS_MEM_ON_DISK}
+    Psnapshot^.oldBufferBlocksHash := TPCTemporalFileStream.Create('oldbufferblockhash');
+    BufferBlocksHash.SaveToStream( Psnapshot^.oldBufferBlocksHash );
+    {$ELSE}
     Psnapshot^.oldBufferBlocksHash := TBytesBuffer.CreateCopy(BufferBlocksHash);
+    {$ENDIF}
     Psnapshot^.oldTotalBalance:=FTotalBalance;
     Psnapshot^.oldTotalFee:=FTotalFee;
     Psnapshot^.oldSafeBoxHash := FSafeBoxHash;
@@ -2923,7 +2940,13 @@ begin
         //
         FPreviousSafeBox.FSubChains.Add(Self);
         //
+        {$IFDEF USE_BIGBLOCKS_MEM_ON_DISK}
+        BufferBlocksHash.Clear;
+        BufferBlocksHash.LoadFromStream( Psnapshot^.oldBufferBlocksHash );
+        {$ELSE}
         BufferBlocksHash.CopyFrom( Psnapshot^.oldBufferBlocksHash );
+        {$ENDIF}
+
         FTotalBalance := Psnapshot^.oldTotalBalance;
         FTotalFee := Psnapshot^.oldTotalFee;
         FSafeBoxHash := Psnapshot^.oldSafeBoxHash;

src/core/UBaseTypes.pas

@@ -98,13 +98,16 @@ Type
     function Replace(startPos : Integer; const buffer : TBytes) : Integer; overload;
     function Replace(startPos : Integer; const buffer; bufferSize : Integer) : Integer; overload;
     property DefaultIncrement : Integer read FDefaultIncrement write SetDefaultIncrement;
-    function Compare(ABytesBuffer : TBytesBuffer) : Integer;
+    function Compare(ABytesBuffer : TBytesBuffer) : Integer; overload;
+    function Compare(AStream : TStream) : Integer; overload;
     procedure SetLength(ANewLength : Integer);
     function Memory : Pointer;
     function MemoryLength : Integer;
     procedure Clear;
     procedure CopyFrom(ABytesBuffer : TBytesBuffer);
     function Capture(AStartPos, ALength : Integer) : TBytes;
+    procedure SaveToStream(AStream : TStream);
+    procedure LoadFromStream(AStream : TStream);
   end;
 
 
@@ -624,6 +627,11 @@ begin
   end;
 end;
 
+procedure TBytesBuffer.SaveToStream(AStream: TStream);
+begin
+  AStream.Write(FBytes[0],Self.Length);
+end;
+
 procedure TBytesBuffer.SetDefaultIncrement(AValue: Integer);
 begin
   if AValue<=0 then FDefaultIncrement:=1024
@@ -690,6 +698,18 @@ begin
   end;
 end;
 
+function TBytesBuffer.Compare(AStream: TStream): Integer;
+var Lbb : TBytesBuffer;
+begin
+  Lbb := TBytesBuffer.Create(DefaultIncrement);
+  try
+    Lbb.LoadFromStream(AStream);
+    Result := Compare(Lbb);
+  finally
+    Lbb.Free;
+  end;
+end;
+
 procedure TBytesBuffer.CopyFrom(ABytesBuffer: TBytesBuffer);
 begin
   System.SetLength(FBytes,System.Length(ABytesBuffer.FBytes));
@@ -725,6 +745,14 @@ begin
   Result := FUsedBytes;
 end;
 
+procedure TBytesBuffer.LoadFromStream(AStream: TStream);
+begin
+  AStream.Position := 0;
+  IncreaseSize(Self.Length + AStream.Size);
+  AStream.Read(FBytes[FUsedBytes],AStream.Size);
+  SetLength(Self.Length + AStream.Size);
+end;
+
 function TBytesBuffer.Memory: Pointer;
 begin
   Result := addr(FBytes[0]);

src/core/UPCTemporalFileStream.pas

@@ -41,7 +41,7 @@ Type
 
 implementation
 
-Uses ULog, UNode;
+Uses {$IFDEF HIGHLOG}ULog, {$ENDIF} UNode;
 
 { TPCTemporalFileStream }
 
@@ -63,18 +63,18 @@ begin
     end;
     inc(i);
   until (Not (FileExists(LFileName)) or (i>5000));
-  TLog.NewLog(ltdebug,ClassName,Format('Creating a new Temporal file Stream: %s',[LFileName]));
+  {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Creating a new Temporal file Stream: %s',[LFileName]));{$ENDIF}
   inherited Create(LFileName,fmCreate+fmShareDenyWrite);
   FTemporalFileName:=LFileName;
 end;
 
 destructor TPCTemporalFileStream.Destroy;
-var LSize : Integer;
+{$IFDEF HIGHLOG}var LSize : Integer;{$ENDIF}
 begin
-  LSize := Size;
+  {$IFDEF HIGHLOG}LSize := Size;{$ENDIF}
   inherited Destroy;
   if FTemporalFileName<>'' then begin
-    TLog.NewLog(ltdebug,ClassName,Format('Deleting a Temporal file Stream (%d bytes): %s',[LSize, FTemporalFileName]));
+    {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Deleting a Temporal file Stream (%d bytes): %s',[LSize, FTemporalFileName]));{$ENDIF}
     DeleteFile(FTemporalFileName);
   end;
 end;

src/tests/PascalCoinUnitTests.lpr

@@ -5,7 +5,7 @@ program UPascalCoinUnitTests;
 uses
   Interfaces, Forms, GuiTestRunner, UCommon.Collections, UCommon.Tests,
   UCommon.Collections.Tests, UMemory.Tests, UThread.Tests, URandomHash.Tests,
-  URandomHash2.Tests, URandomHash;
+  URandomHash2.Tests, URandomHash, ubasetypes.tests;
 
 {$R *.res}
 

src/tests/ubasetypes.tests.pas

@@ -0,0 +1,60 @@
+unit UBaseTypes.Tests;
+
+{$mode delphi}
+{$H+}
+{$modeswitch nestedprocvars}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit,
+  testregistry,
+  UBaseTypes;
+
+type
+
+  { TBytesBufferTest }
+
+  TBytesBufferTest = class(TTestCase)
+    published
+      procedure Test_SaveToStream;
+  end;
+
+implementation
+
+{ TBytesBufferTest }
+
+procedure TBytesBufferTest.Test_SaveToStream;
+var Lbb, Lbb2 : TBytesBuffer;
+  LStream : TStream;
+  LBuffer : TBytes;
+  i : Integer;
+begin
+  SetLength(LBuffer,1000 + Random(1000) );
+  for i:= 0 to High(LBuffer) do begin
+    LBuffer[i] := Random(250)+1;
+  end;
+  Lbb := TBytesBuffer.Create(Random(1000)+100);
+  Lbb.Add(LBuffer);
+  Lbb2 := TBytesBuffer.CreateCopy(Lbb);
+  LStream := TMemoryStream.Create;
+  try
+    Lbb.SaveToStream(LStream);
+    Self.AssertEquals('T1',0,Lbb.Compare(Lbb2));
+    Self.AssertEquals('T2',0,Lbb.Compare(LStream));
+    Lbb2.Clear;
+    Lbb2.LoadFromStream(LStream);
+    Self.AssertEquals('T3',0,Lbb.Compare(Lbb2));
+  finally
+    Lbb.Free;
+    Lbb2.Free;
+  end;
+end;
+
+
+initialization
+  Randomize;
+  RegisterTest(TBytesBufferTest);
+end.
+
+