Merge pull request #2 from PascalCoinDev/master

Update

CHANGELOG.md

@@ -5,6 +5,13 @@
 - Added usage of AbstractMem library to allow build a PascalCoin version using virtual memory and efficient caching mechanism
   - Must activate {$DEFINE USE_ABSTRACTMEM} at config.inc file
 - Improved performance when downloading Safebox (Fresh installation)
+- JSON-RPC changes:  
+  - Updated "findaccounts": 
+    -New param "end" (integer, -1 for default): Will search from "start" to "end" (if "end"=-1 will search to the end)
+  - New method "findblocks": Will search and return an array of "Block objects"
+    - "start","end","max" : Based on block number and max returns values (max by default=100)
+    - "enc_pubkey" or "b58_pubkey" : If provided will return blocks where pubkey equal to provided
+    - "payload", "payloadsearchtype" : Same workaround than "name" and "namesearchtype" on "findaccounts" method  
 - Fixed bugs:
   - Fixed bugs on "pascalcoin_daemon" (daemon on Linux / Service on Windows) that produced crash on windows and some invalid finalization on Linux
   - Fixed minor bugs

src/core/UPCRPCFindAccounts.pas

@@ -78,6 +78,7 @@ Find accounts by name/type and returns them as an array of "Account Object"
   - `not-for-sale-swap`
 - `listed` : Boolean (DEPRECATED, use `statustype` instead, False by default) - If True returns only for sale accounts
 - `start` : Integer - Start account (by default, 0) - **NOTE:** Is the "start account number", when executing multiple calls you must set `start` value to the latest returned account number + 1 (Except if searching by public key, see below)
+- `end` : Integer - End account (by default -1, equals to "no limit")
 - `max` : Integer - Max of accounts returned in array (by default, 100)
 
 }
@@ -143,7 +144,7 @@ var
   LAccountNumber : Integer;
   LRaw : TRawBytes;
   LSearchByPubkey : Boolean;
-  LStart, LMax : Integer;
+  LStart, LMax, LEnd : Integer;
   LAccountsNumbersList : TAccountsNumbersList;
   LAccount : TAccount;
   i : Integer;
@@ -175,6 +176,7 @@ begin
   end;
   LAccountType := AInputParams.AsInteger('type', -1);
   LStart := AInputParams.AsInteger('start', 0);
+  LEnd := AInputParams.AsInteger('end', -1);
   LMax := AInputParams.AsInteger('max', 100);
   if AInputParams.IndexOfName('statustype')>=0 then begin
     LString := AInputParams.AsString('statustype','all');
@@ -221,6 +223,10 @@ begin
     exit;
   end;
 
+  if (LEnd<0) or (LEnd>=ASender.Node.Bank.AccountsCount) then begin
+    LEnd := ASender.Node.Bank.AccountsCount - 1;
+  end;
+
   // Declare return result (empty by default)
   LOutput := AJSONResponse.GetAsArray('result');
 
@@ -271,7 +277,8 @@ begin
     end;
   end else begin
     // Search by type-forSale-balance
-    for i := LStart to ASender.Node.Bank.AccountsCount - 1 do begin
+    i := LStart;
+    while (Not ASender.Terminated) And (i < LEnd) do begin
       if (LSearchByPubkey) then begin
         if (i>=LAccountsNumbersList.Count) then Break;
         LAccount := ASender.Node.GetMempoolAccount( LAccountsNumbersList.Get(i) );
@@ -283,6 +290,8 @@ begin
         TPascalCoinJSONComp.FillAccountObject(LAccount,LOutput.GetAsObject(LOutput.Count));
         if LOutput.Count>=LMax then break;
       end;
+      inc(i);
+
     end;
   end;
   Result := True;

src/core/UPCRPCFindBlocks.pas

@@ -0,0 +1,191 @@
+unit UPCRPCFindBlocks;
+
+{ Copyright (c) 2020 by PascalCoin developers, orignal code by Albert Molina
+
+  Distributed under the MIT software license, see the accompanying file LICENSE
+  or visit http://www.opensource.org/licenses/mit-license.php.
+
+  This unit is a part of the PascalCoin Project, an infinitely scalable
+  cryptocurrency. Find us here:
+  Web: https://www.pascalcoin.org
+  Source: https://github.com/PascalCoin/PascalCoin
+
+  If you like it, consider a donation using Bitcoin:
+  16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk
+
+  THIS LICENSE HEADER MUST NOT BE REMOVED.
+}
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+{$I ./../config.inc}
+
+Uses classes, SysUtils,
+  UJSONFunctions, UAccounts, UBaseTypes, UOpTransaction, UConst,
+  {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
+  URPC, UCrypto, UWallet, UBlockChain, ULog, UPCOrderedLists;
+
+
+Type
+  TRPCFindBlocks = Class
+  private
+  public
+    class function FindBlocks(const ASender : TRPCProcess; const AMethodName : String; AInputParams, AJSONResponse : TPCJSONObject; var AErrorNum : Integer; var AErrorDesc : String) : Boolean;
+  End;
+
+implementation
+
+uses UPCDataTypes;
+
+{ TRPCFindBlocks }
+
+class function TRPCFindBlocks.FindBlocks(const ASender: TRPCProcess;
+  const AMethodName: String; AInputParams, AJSONResponse: TPCJSONObject;
+  var AErrorNum: Integer; var AErrorDesc: String): Boolean;
+
+
+{  RPC "findblocks"
+### findblocks
+Find blocks by name/type and returns them as an array of "Block Object"
+
+##### Params
+- `payload` : String - Name to search
+- `payloadsearchtype` : String - One of those values
+  - `exact` :
+  - `startswith` : (DEFAULT OPTION)
+  - `not-startswith` :
+  - `contains` :
+  - `not-contains` :
+  - `endswith` :
+  - `not-endswith` :
+- `enc_pubkey` or `b58_pubkey` : HEXASTRING or String - Will return blocks with this public key.
+- `start` : Integer - Start block (by default, 0)
+- `end` : Integer - End block (by default -1, equals to "no limit")
+- `max` : Integer - Max of accounts returned in array (by default, 100)
+
+}
+
+type
+  TSearchBlockPayloadType = (st_exact, st_startswith, st_contains, st_endswith, st_not_startswith, st_not_contains, st_not_endswith);
+
+  function _SearchValidPayload(const ASearch : String; const APayload : String; ASearchType : TSearchBlockPayloadType) : Boolean;
+  var i : Integer;
+  begin
+    if (ASearch.Length=0) then Exit(True); // If nothing to search, allways TRUE
+    // Here we know that ASearchName has a value
+    if (APayload.Length=0) then Exit(False); // If account has NO NAME, allways FALSE
+    if (ASearchType=st_exact) then begin
+      Exit( APayload.Equals(ASearch) );  // Must match
+    end;
+
+    i := APayload.IndexOf(ASearch);
+    Result :=
+      ((i=0) and (ASearchType in [st_startswith])) // found at first position
+      or
+      ((i>=0) and (ASearchType in [st_contains])) // found in any pos
+      or
+      ((i=(APayload.Length-1)) and (ASearchType in [st_endswith])) // found at last position
+      or
+      ((i<0) and (ASearchType in [st_not_startswith, st_not_contains, st_not_endswith])) // not found and must not contain in any pos
+      or
+      ((i>=1) and (ASearchType in [st_not_startswith])) // not found at first position
+      or
+      ((i<(APayload.Length-1)) and (ASearchType in [st_not_endswith])); // not found at last position
+  end;
+
+var
+  LPayload : String;
+  LSearchByPayloadType : TSearchBlockPayloadType;
+  LSearchByPubkey : Boolean;
+  LPubKey : TAccountKey;
+
+  function _IsValidBlock(const ABlock : TOperationBlock) : Boolean;
+  begin
+    if (Not _SearchValidPayload(LPayload,ABlock.block_payload.ToString,LSearchByPayloadType)) then Exit(False);
+    if (LSearchByPubkey) then begin
+      if Not (TAccountComp.EqualAccountKeys(LPubKey,ABlock.account_key)) then Exit(False);
+    end;
+
+    Result := True;
+  end;
+
+var
+  LString : String;
+  LAccountNumber : Integer;
+  LRaw : TRawBytes;
+  LStart, LEnd, LMax : Integer;
+  LBlock : TOperationBlock;
+
+  i : Integer;
+  LErrors : String;
+  LOutput : TPCJSONArray;
+  LStartsWith : TOrderedRawList;
+begin
+  // Get Parameters
+  Result := False;
+  LPayload := LowerCase(AInputParams.AsString('payload', '')); // Convert to lowercase...
+  if AInputParams.IndexOfName('payloadsearchtype')>=0 then begin
+    LString := AInputParams.AsString('payloadsearchtype','');
+    if (AnsiSameStr(LString,'exact')) then LSearchByPayloadType := st_exact
+    else if (AnsiSameStr(LString,'startswith')) then LSearchByPayloadType := st_startswith
+    else if (AnsiSameStr(LString,'not-startswith')) then LSearchByPayloadType := st_not_startswith
+    else if (AnsiSameStr(LString,'contains')) then LSearchByPayloadType := st_contains
+    else if (AnsiSameStr(LString,'not-contains')) then LSearchByPayloadType := st_not_contains
+    else if (AnsiSameStr(LString,'endswith')) then LSearchByPayloadType := st_endswith
+    else if (AnsiSameStr(LString,'not-endswith')) then LSearchByPayloadType := st_not_endswith
+    else begin
+      AErrorNum := CT_RPC_ErrNum_InvalidData;
+      AErrorDesc := Format('Invalid "payloadsearchtype" value: "%s"',[LString]);
+      Exit(False);
+    end;
+  end else begin
+    LSearchByPayloadType := st_startswith;
+  end;
+  LStart := AInputParams.AsInteger('start', 0);
+  LMax := AInputParams.AsInteger('max', 100);
+  LEnd := AInputParams.AsInteger('end', -1);
+
+  if LStart < 0 then begin
+    AErrorNum := CT_RPC_ErrNum_InvalidData;
+    AErrorDesc := '"start" param must be >=0';
+    exit;
+  end;
+  if LMax <= 0 then begin
+    AErrorNum := CT_RPC_ErrNum_InvalidData;
+    AErrorDesc := '"max" param must be greater than zero';
+    exit;
+  end;
+
+  if (LEnd<0) or (LEnd>=ASender.Node.Bank.SafeBox.BlocksCount) then begin
+    LEnd := ASender.Node.Bank.SafeBox.BlocksCount - 1;
+  end;
+
+  // Declare return result (empty by default)
+  LOutput := AJSONResponse.GetAsArray('result');
+
+  // Search by PubKey (if provided)
+  If TPascalCoinJSONComp.CapturePubKey(AInputParams, '',LPubKey,LErrors) then begin
+    LSearchByPubkey := True;
+  end else LSearchByPubkey := False;
+    //
+  i := LStart;
+  while (Not ASender.Terminated) And (i < LEnd) do begin
+    LBlock := ASender.Node.Bank.SafeBox.GetBlockInfo(i);
+    if (_IsValidBlock(LBlock)) then begin
+      TPascalCoinJSONComp.FillBlockObject(i,ASender.Node,LOutput.GetAsObject(LOutput.Count));
+      if LOutput.Count>=LMax then break;
+    end;
+    inc(i);
+  end;
+  Result := True;
+end;
+
+initialization
+  TRPCProcess.RegisterProcessMethod('findblocks',TRPCFindBlocks.FindBlocks);
+finalization
+  TRPCProcess.UnregisterProcessMethod('findblocks');
+end.

src/core/URPC.pas

@@ -155,7 +155,7 @@ implementation
 
 Uses  {$IFNDEF FPC}windows,{$ENDIF}
   SysUtils, Synautil,
-  UPCRPCOpData, UPCRPCFindAccounts;
+  UPCRPCOpData, UPCRPCFindAccounts, UPCRPCFindBlocks;
 
 Type
   TRegisteredRPCProcessMethod = Record

src/core/upcdaemon.pas

@@ -26,6 +26,7 @@ uses
   Classes, SysUtils, daemonapp,
   SyncObjs, UOpenSSL, UCrypto, UNode, UFileStorage, UFolderHelper, UWallet, UConst, ULog, UNetProtocol,
   IniFiles, UBaseTypes,
+  {$IF Defined(FPC) and Defined(WINDOWS)}windows,jwawinsvc,crt,{$ENDIF}
   UThread, URPC, UPoolMining, UAccounts, UPCDataTypes;
 
 Const
@@ -91,6 +92,7 @@ Type
   protected
     Procedure DoOnCreate; override;
     Procedure DoOnDestroy; override;
+    Procedure DoOnRun; override;
   public
   end;
 
@@ -412,5 +414,39 @@ begin
   end;
 end;
 
+procedure TPCDaemonMapper.DoOnRun;
+{$IF Defined(FPC) and Defined(WINDOWS)}
+var LDT : TPCDaemonThread;
+{$ENDIF}
+begin
+  inherited DoOnRun;
+  {$IF Defined(FPC) and Defined(WINDOWS)}
+  // We are running -r command on windows
+  if Application.HasOption('d','debug') then begin
+    LDT:=TPCDaemonThread.Create;
+    LDT.FreeOnTerminate:=True;
+    if (Application.HasOption('b','block')) then begin
+      LDT.MaxBlockToRead:=StrToInt64Def(Application.GetOptionValue('b','block'),$FFFFFFFF);
+      TLog.NewLog(ltinfo,ClassName,'Max block to read: '+IntToStr(LDT.MaxBlockToRead));
+    end;
+    LDT.Start;
+    repeat
+      CheckSynchronize(10);
+      Sleep(1);
+
+      if Keypressed then begin
+        if (ReadKey in ['q','Q']) then begin
+          LDT.Terminate;
+        end;
+      end;
+
+    until LDT.Terminated;
+    LDT.Terminate;
+    LDT.WaitFor;
+    Application.Terminate;
+  end;
+  {$ENDIF}
+end;
+
 end.
 

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;
@@ -141,6 +141,7 @@ Type
     property ReadOnly : Boolean read FReadOnly;
     procedure SaveToStream(AStream : TStream);
     procedure CopyFrom(ASource : TAbstractMem);
+    function GetStatsReport(AClearStats : Boolean) : String; virtual;
   End;
 
   TMem = Class(TAbstractMem)
@@ -379,6 +380,11 @@ begin
   Result := ClassName+' v'+FloatToStr(CT_ABSTRACTMEM_VERSION);
 end;
 
+function TAbstractMem.GetStatsReport(AClearStats: Boolean): String;
+begin
+  Result := '';
+end;
+
 function TAbstractMem.GetUsedZoneInfo(const APosition: TAbstractMemPosition; ACheckForUsedZone: Boolean; out AAMZone: TAMZone): Boolean;
 begin
   if (ACheckForUsedZone) then begin
@@ -582,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

@@ -106,13 +106,16 @@ type
     freememSize : Integer;
     freememElaspedMillis : Int64;
     maxUsedCacheSize : Integer;
+    reusedCacheMemDataCount : Integer;
+    reusedCacheMemDataBytes : Int64;
     procedure Clear;
     function ToString : String;
   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);
 
@@ -131,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;
@@ -160,10 +164,12 @@ 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;
     {$ENDIF}
+    function GetStatsReport(AClearStats : Boolean) : String;
   End;
 
 implementation
@@ -222,7 +228,6 @@ end;
 
 procedure TCacheMem.Clear;
 var P, PCurr : PCacheMemData;
-  i : Integer;
 begin
   PCurr := FCacheData.FindLowest;
   while (Assigned(PCurr)) do begin
@@ -316,6 +321,7 @@ begin
   FCacheDataBlocks := 0;
   FPendingToSaveBytes := 0;
   FCacheDataSize := 0;
+  FDefaultCacheDataBlocksSize := 4000;
   FOnNeedDataProc := AOnNeedDataProc;
   FOnSaveDataProc := AOnSaveDataProc;
   FOldestUsed := Nil;
@@ -345,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;
@@ -405,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
@@ -495,14 +501,25 @@ begin
   {$ENDIF}
 end;
 
+function TCacheMem.GetStatsReport(AClearStats: Boolean): String;
+begin
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  Result := FCacheMemStats.ToString;
+  if AClearStats then ClearStats;
+  {$ELSE}
+  Result := '';
+  {$ENDIF}
+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
@@ -513,42 +530,59 @@ 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;
 
 
 var
   LNewP, PCurrent, PToDelete : PCacheMemData;
-  LLastAddedPosition, LBytesCount, LSizeToStore : Integer;
+  LLastAddedPosition, LBytesCount, LSizeToStore, LNewStartPos : Integer;
   LTempData : TBytes;
+  LTempCapturedSize : Integer;
   LTmpResult : Boolean;
 begin
   if ASize<0 then raise ECacheMem.Create(Format('Invalid load size %d',[ASize]));
   if ASize=0 then Exit(True);
-  if (FindCacheMemDataByPosition(AStartPos,PCurrent)) then begin
-    if (PCurrent^.GetSize - (AStartPos - PCurrent^.startPos)) >= ASize then begin
-      // PStart has all needed info
+
+  if (FDefaultCacheDataBlocksSize>0) then begin
+    LNewStartPos := (((AStartPos-1) DIV FDefaultCacheDataBlocksSize) + 0 ) * FDefaultCacheDataBlocksSize;
+    LSizeToStore := (((ASize-1) DIV FDefaultCacheDataBlocksSize) + 1 ) * FDefaultCacheDataBlocksSize;
+    if (LNewStartPos + LSizeToStore) < (AStartPos + ASize) then begin
+      inc(LSizeToStore, FDefaultCacheDataBlocksSize);
+    end;
+  end else begin
+    LSizeToStore := ASize;
+    LNewStartPos := AStartPos;
+  end;
+
+  if (FindCacheMemDataByPosition(LNewStartPos,PCurrent)) then begin
+    if (PCurrent^.GetEndPos >= (AStartPos + ASize)) then begin
+      // PCurrent has all needed info
       Move(PCurrent^.buffer[ AStartPos-PCurrent^.startPos ],ABuffer,ASize);
       PCurrent^.MarkAsUsed(Self,PCurrent);
       Result := True;
+      {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+      inc(FCacheMemStats.reusedCacheMemDataCount);
+      inc(FCacheMemStats.reusedCacheMemDataBytes,ASize);
+      {$ENDIF}
       Exit;
     end;
+  end else if Not Assigned(PCurrent) then begin
+    PCurrent := FCacheData.FindLowest;
   end;
 
   // Will need to create a new "linar struct" because not found a linear struct previously
   New( LNewP );
   try
     LNewP.Clear;
-
-    LSizeToStore := ASize;
+    LNewP.startPos := LNewStartPos;
     SetLength(LNewP^.buffer, LSizeToStore);
 
-    LNewP.startPos := AStartPos;
-
     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
@@ -562,9 +596,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)
@@ -584,12 +618,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
@@ -620,7 +661,7 @@ begin
 end;
 
 function TCacheMem.ToString: String;
-var i : Integer;
+var
   LLines : TStrings;
   LPct : Double;
   PCurrent : PCacheMemData;
@@ -661,6 +702,8 @@ begin
       PCurrent^.MarkAsUsed(Self,PCurrent);
       Exit;
     end;
+  end else if Not Assigned(PCurrent) then begin
+    PCurrent := FCacheData.FindLowest;
   end;
 
   // Will need to create a new "linar struct" because not found a linear struct previously
@@ -861,11 +904,17 @@ begin
   freememCount := 0;
   freememSize := 0;
   freememElaspedMillis := 0;
+  reusedCacheMemDataCount := 0;
+  reusedCacheMemDataBytes := 0;
 end;
 
 function TCacheMemStats.ToString: String;
 begin
-  Result := Format('CacheMemStats Flush:%d %d bytes %d millis - FreeMem:%d %d bytes %d millis',[Self.flushCount,Self.flushSize,Self.flushElapsedMillis,Self.freememCount,Self.freememSize,Self.freememElaspedMillis]);
+  Result := Format('CacheMemStats Reused:%d (%d bytes) - Flush:%d (%d bytes) %d millis - FreeMem:%d (%d bytes) %d millis',
+     [Self.reusedCacheMemDataCount,Self.reusedCacheMemDataBytes,
+      Self.flushCount,Self.flushSize,Self.flushElapsedMillis,
+      Self.freememCount,Self.freememSize,
+      Self.freememElaspedMillis]);
 end;
 {$ENDIF}
 

src/libraries/abstractmem/UFileMem.pas

@@ -41,6 +41,19 @@ uses
 type
   EFileMem = Class(Exception);
 
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  TFileMemStats = record
+    ReadsCount : Integer;
+    WriteCount : Integer;
+    ReadsBytesCount : Integer;
+    WriteBytesCount : Integer;
+    IncreaseSizeCount : Integer;
+    IncreaseSizeBytesCount : Integer;
+    function ToString : String;
+    procedure Clear;
+  end;
+  {$ENDIF}
+
   TFileMem = Class(TAbstractMem)
   private
     FFileStream : TFileStream;
@@ -48,8 +61,11 @@ type
     FFileName: String;
     FIsStableCache: Boolean;
     FIsFlushingCache : Boolean;
-    function OnCacheNeedDataProc(var ABuffer; AStartPos : Integer; ASize : Integer) : Boolean;
-    function OnCacheSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Boolean;
+    {$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;
     procedure SetMaxCacheSize(const Value: Integer);
     function GetMaxCacheSize: Integer;
     function GetMaxCacheDataBlocks: Integer;
@@ -64,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
@@ -77,16 +93,46 @@ type
     function LockCache : TCacheMem;
     procedure UnlockCache;
     property FileName : String read FFileName;
+    {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+    function GetStatsReport(AClearStats : Boolean) : String; override;
+    {$ENDIF}
   End;
 
 implementation
 
+{$IFDEF ABSTRACTMEM_ENABLE_STATS}
+{ TFileMemStats }
+
+function TFileMemStats.ToString: String;
+begin
+  Result := Format('FileMemStats Reads:%d (%d b) Writes:%d (%d b) Increases:%d (%d b)',
+    [Self.ReadsCount,Self.ReadsBytesCount,
+     Self.WriteCount,Self.WriteBytesCount,
+     Self.IncreaseSizeCount,Self.IncreaseSizeBytesCount
+     ]);
+end;
+
+procedure TFileMemStats.Clear;
+begin
+  Self.ReadsCount := 0;
+  Self.WriteCount := 0;
+  Self.ReadsBytesCount := 0;
+  Self.WriteBytesCount := 0;
+  Self.IncreaseSizeCount := 0;
+  Self.IncreaseSizeBytesCount := 0;
+end;
+{$ENDIF}
+
 { TFileMem }
 
 function TFileMem.AbsoluteRead(const AAbsolutePosition: Int64; var ABuffer; ASize: Integer): Integer;
 begin
   FFileStream.Seek(AAbsolutePosition,soFromBeginning);
   Result := FFileStream.Read(ABuffer,ASize);
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  inc(FStats.ReadsCount);
+  inc(FStats.ReadsBytesCount,ASize);
+  {$ENDIF}
 end;
 
 function TFileMem.AbsoluteWrite(const AAbsolutePosition: Int64; const ABuffer; ASize: Integer): Integer;
@@ -94,6 +140,10 @@ begin
   FFileStream.Seek(AAbsolutePosition,soFromBeginning);
   Result := FFileStream.Write(ABuffer,ASize);
   CacheIsNOTStable;
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  inc(FStats.WriteCount);
+  inc(FStats.WriteBytesCount,ASize);
+  {$ENDIF}
 end;
 
 procedure TFileMem.CacheIsNOTStable;
@@ -110,6 +160,15 @@ constructor TFileMem.Create(const AFileName: String; AReadOnly: Boolean);
 var LFileMode : Integer;
   LReadOnly : Boolean;
 begin
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  FStats.Clear;
+  FStats.ReadsCount := 0;
+  FStats.WriteCount := 0;
+  FStats.ReadsBytesCount := 0;
+  FStats.WriteBytesCount := 0;
+  FStats.IncreaseSizeCount := 0;
+  FStats.IncreaseSizeBytesCount := 0;
+  {$ENDIF}
   FIsStableCache := True;
   FIsFlushingCache := False;
   FFileName := AFileName;
@@ -148,12 +207,18 @@ begin
     Exit;
   end;
 
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  inc(FStats.IncreaseSizeCount);
+  {$ENDIF}
   FFileStream.Seek(0,soFromEnd);
   // GoTo ANextAvailablePos
   if (FFileStream.Position<ANextAvailablePos) then begin
     SetLength(LBuff,ANextAvailablePos - FFileStream.Position);
     FillChar(LBuff[0],Length(LBuff),0);
     FFileStream.Write(LBuff[0],Length(LBuff));
+    {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+    inc(FStats.IncreaseSizeBytesCount,Length(LBuff));
+    {$ENDIF}
   end;
   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
@@ -162,6 +227,9 @@ begin
     SetLength(LBuff,AMaxAvailablePos - FFileStream.Position);
     FillChar(LBuff[0],Length(LBuff),0);
     FFileStream.Write(LBuff[0],Length(LBuff));
+    {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+    inc(FStats.IncreaseSizeBytesCount,Length(LBuff));
+    {$ENDIF}
   end else AMaxAvailablePos := FFileStream.Size;
   CacheIsNOTStable;
 end;
@@ -196,6 +264,14 @@ begin
   Result := FCache.MaxCacheSize;
 end;
 
+{$IFDEF ABSTRACTMEM_ENABLE_STATS}
+function TFileMem.GetStatsReport(AClearStats : Boolean) : String;
+begin
+  Result := FStats.ToString + #10 + FCache.GetStatsReport(AClearStats);
+  if AClearStats then FStats.Clear;
+end;
+{$ENDIF}
+
 function TFileMem.IsAbstractMemInfoStable: Boolean;
 begin
   Result := FIsStableCache;
@@ -223,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;
@@ -277,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/AbstractMem.Tests.dpr

@@ -0,0 +1,66 @@
+program AbstractMem.Tests;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+// Enable for Console tests
+{.$DEFINE CONSOLE_TESTRUNNER}
+
+{$IFDEF CONSOLE_TESTRUNNER}
+  {$APPTYPE CONSOLE}
+{$ENDIF}
+
+uses
+  {$IFDEF FPC}
+  {$IFDEF CONSOLE_TESTRUNNER}
+  Classes,
+  {$ELSE}
+  Interfaces,
+  Forms,
+  GUITestRunner,
+  {$ENDIF }
+  {$ELSE}
+  Forms,
+  TestFramework,
+  GUITestRunner,
+  TextTestRunner,
+  {$ENDIF }
+  UAbstractBTree in '..\UAbstractBTree.pas',
+  UAbstractMem in '..\UAbstractMem.pas',
+  UAbstractMemTList in '..\UAbstractMemTList.pas',
+  UAVLCache in '..\UAVLCache.pas',
+  UCacheMem in '..\UCacheMem.pas',
+  UFileMem in '..\UFileMem.pas',
+  UOrderedList in '..\UOrderedList.pas',
+  UCacheMem.Tests in 'src\UCacheMem.Tests.pas';
+
+{$IF Defined(FPC) and (Defined(CONSOLE_TESTRUNNER))}
+type
+  TFreePascalConsoleRunner = class(TTestRunner)
+  protected
+  end;
+var
+  Application : TFreePascalConsoleRunner;
+{$ENDIF}
+
+begin
+  {$IF Defined(FPC) and (Defined(CONSOLE_TESTRUNNER))}
+  Application := TFreePascalConsoleRunner.Create(nil);
+  {$ENDIF}
+
+  Application.Initialize;
+  {$IFDEF FPC}
+  {$IF Not Defined(CONSOLE_TESTRUNNER)}
+  Application.CreateForm(TGuiTestRunner, TestRunner);
+  {$ENDIF}
+  Application.Run;
+  {$ELSE}
+  if IsConsole then
+    TextTestRunner.RunRegisteredTests
+  else
+    GUITestRunner.RunRegisteredTests;
+  {$ENDIF}
+end.
+
+

src/libraries/abstractmem/tests/AbstractMem.Tests.lpi

@@ -0,0 +1,79 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="fpcunitproject1"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="3">
+      <Item1>
+        <PackageName Value="fpcunittestrunner"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="FCL"/>
+      </Item3>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="AbstractMem.Tests.dpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <IncludeFiles Value="..;src"/>
+      <OtherUnitFiles Value="..;src"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <SyntaxMode Value="delphi"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

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

@@ -0,0 +1,141 @@
+unit UCacheMem.Tests;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+interface
+ 
+ uses
+   SysUtils,
+   {$IFDEF FPC}
+   fpcunit, testutils, testregistry,
+   {$ELSE}
+   TestFramework,
+   {$ENDIF}
+   UCacheMem;
+ type
+   // Test methods for class TCalc
+   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;
+     procedure CheckBytes(const ABytes : TBytes; ALoadedStartPos, ASize : Integer);
+     procedure InitCurrentMem(ASize : Integer);
+   public
+     procedure SetUp; override;
+     procedure TearDown; override;
+   published
+     procedure TestCacheMem;
+   end;
+
+ implementation
+
+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 := ASize;
+    Move(FCurrentMem[AStartPos],ABuffer,ASize);
+  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): Integer;
+begin
+  if (High(FCurrentMem) >= AStartPos + ASize) then begin
+    Result := ASize;
+    Move(ABuffer,FCurrentMem[AStartPos],ASize);
+  end else begin
+    Result := High(FCurrentMem) - AStartPos;
+    if Result>0 then begin
+      Move(ABuffer,FCurrentMem[AStartPos],Result);
+    end;
+  end;
+end;
+
+procedure TestTCacheMem.SetUp;
+begin
+  SetLength(FCurrentMem,0);
+end;
+
+procedure TestTCacheMem.TearDown;
+begin
+  SetLength(FCurrentMem,0);
+end;
+
+procedure TestTCacheMem.TestCacheMem;
+Var LCMem : TCacheMem;
+  LBuff : TBytes;
+  i : Integer;
+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;
+    while (i+i < High(FCurrentMem)) do begin
+      CheckTrue( LCMem.LoadData(LBuff[0],i,i) );
+      inc(i);
+    end;
+    CheckFalse( LCMem.LoadData( LBuff[0],i,i) );
+
+    LCMem.ConsistencyCheck;
+  Finally
+    LCMem.Free;
+  End;
+end;
+
+initialization
+  RegisterTest(TestTCacheMem{$IFNDEF FPC}.Suite{$ENDIF});
+end.

src/pascalcoin_daemon.lpi

@@ -25,14 +25,14 @@
     </PublishOptions>
     <RunParams>
       <local>
-        <CommandLineParams Value="-r"/>
+        <CommandLineParams Value="-r -d"/>
         <Display Use="True" Value=""/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
         <Mode0 Name="default">
           <local>
-            <CommandLineParams Value="-r"/>
+            <CommandLineParams Value="-r -d"/>
             <Display Use="True" Value=""/>
           </local>
         </Mode0>

src/pascalcoin_daemon.pp

@@ -31,7 +31,11 @@ end;
 
 begin
   Application.Title:='PascalCoin Daemon application';
+  {$IF Defined(FPC) and Defined(WINDOWS)}
+  IsConsole := Not Application.HasOption('r','run');
+  {$ELSE}
   IsConsole:=False;
+  {$ENDIF}
   RegisterDaemonClass(TPCDaemon);
   RegisterDaemonMapper(TPCDaemonMapper);
   Application.GUIMainLoop:[email protected];