View Issue Details

IDProjectCategoryView StatusLast Update
0030549FPCRTLpublic2019-09-02 09:25
ReporterJosé MejutoAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityN/A
Status resolvedResolutionfixed 
Platformi386OSWindowsOS VersionSeven
Product Version3.1.1Product BuildN/A 
Target VersionFixed in Version3.3.1 
Summary0030549: Add implementation of TBufferedFileStream
DescriptionAttached is an implementation of TBufferedFileStream.
I was not able to find a class definition from other pascal compiler so I assume that the public interface is the same as TFileStream.

This class is not a plain buffered stream, it is more like a cache as it can handle multiple blocks for read and write of arbitrary size, writen data is available for cache read, last used buffer page discard when cache space is needed...

There is a compatibility issue with direct replace with TFileStream, if a TFileStream is opened with fmOpenWrite (write only) this class requires to be changed to fmOpenReadWrite because the cache system needs to read data from file when a write to cache is performed as the write usually does not will overwrite the page completly and the class must synchronize the contents on disk with the memory contents. There is a solution that is add code in Create that if only fmOpenWrite is passed it will be transparently changed to fmOpenReadWrite but I decided to not take that route.

A bit optimizations can be added in both read and write when data to be read and write covers a complete cache page, but by now I decided to keep it more simple.
Additional InformationA test case is added in another source file, it will check that results of same operation in TFileStream and TBufferedStream returns same data and same positions.

Currently SetSize has not been tested.
TagsNo tags attached.
Fixed in Revision42901
FPCOldBugId
FPCTarget3.2.0
Attached Files
  • ubufferedfilestream.pas (19,291 bytes)
    unit ubufferedfilestream;
    
    {$mode objfpc}{$H+}
    
    interface
    
    uses
      Classes, SysUtils;
    
    type
    
      { TBufferedFileStream }
    
      TBufferedFileStream = class(TFileStream)
      private
        const
          TSTREAMCACHEPAGE_SIZE_DEFAULT=4*1024;
          TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT=8;
        type
          TStreamCacheEntry=record
            IsDirty: Boolean;
            LastTick: NativeUInt;
            PageBegin: int64;
            PageRealSize: integer;
            Buffer: Pointer;
          end;
          PStreamCacheEntry=^TStreamCacheEntry;
      private
        FCachePages: array of PStreamCacheEntry;
        FCacheLastUsedPage: integer;
        FCacheStreamPosition: int64;
        FCacheStreamSize: int64;
        FOpCounter: NativeUInt;
        FStreamCachePageSize: integer;
        FStreamCachePageMaxCount: integer;
        FEmergencyFlag: Boolean;
        procedure ClearCache;
        procedure WriteDirtyPage(const aPage: PStreamCacheEntry);
        procedure WriteDirtyPage(const aIndex: integer);
        procedure WriteDirtyPages;
        procedure EmergencyWriteDirtyPages;
        procedure FreePage(const aPage: PStreamCacheEntry; const aFreeBuffer: Boolean); inline;
        function  LookForPositionInPages: Boolean;
        function  ReadPageForPosition: Boolean;
        function  ReadPageBeforeWrite: Boolean;
        function  FreeOlderInUsePage(const aFreeBuffer: Boolean=false): PStreamCacheEntry;
        function  GetOpCounter: NativeUInt; inline;
        function  DoCacheRead(var Buffer; Count: Longint): Longint;
        function  DoCacheWrite(const Buffer; Count: Longint): Longint;
      protected
        function  GetPosition: Int64; override;
        procedure SetPosition(const Pos: Int64); override;
        function  GetSize: Int64; override;
        procedure SetSize64(const NewSize: Int64); override;
        procedure SetSize(NewSize: Longint); override;overload;
        procedure SetSize(const NewSize: Int64); override;overload;
      public
        // Warning using Mode=fmOpenWrite because the write buffer
        // needs to read, as this class is a cache system not a dumb buffer.
        constructor Create(const AFileName: string; Mode: Word);
        constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal);
        destructor  Destroy; override;
        function  Seek(Offset: Longint; Origin: Word): Longint; override; overload;
        function  Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; overload;
        function  Read(var Buffer; Count: Longint): Longint; override;
        function  Write(const Buffer; Count: Longint): Longint; override;
        // Flush write-cache content to disk
        procedure Flush;
        // re-initialize the cache with aCacheBlockCount block
        // of aCacheBlockSize bytes in each block.
        procedure InitializeCache(const aCacheBlockSize: integer; const aCacheBlockCount: integer);
      end;
    
    implementation
    
    resourcestring
      cErrCacheUnexpectedPageDiscard='CACHE: Unexpected behaviour. Discarded page.';
      cErrCacheUnableToReadExpected= 'CACHE: Unable to read expected bytes (Open for write only ?). Expected: %d, effective read: %d';
      cErrCacheUnableToWriteExpected='CACHE: Unable to write expected bytes (Open for read only ?). Expected: %d, effective write: %d';
      cErrCacheInternal=             'CACHE: Internal error.';
    
        { TBufferedFileStream }
    
    procedure TBufferedFileStream.ClearCache;
    var
      j: integer;
      pStream: PStreamCacheEntry;
    begin
      try
        WriteDirtyPages;
      finally
        for j := 0 to Pred(FStreamCachePageMaxCount) do begin
          pStream:=FCachePages[j];
          if Assigned(pStream) then begin
            if Assigned(pStream^.Buffer) then Freemem(pStream^.Buffer);
            Dispose(pStream);
            FCachePages[j]:=nil;
          end;
        end;
      end;
    end;
    
    procedure TBufferedFileStream.WriteDirtyPage(const aPage: PStreamCacheEntry);
    var
      lEffectiveBytesWrite: integer;
    begin
      inherited Seek(aPage^.PageBegin,soBeginning);
      lEffectiveBytesWrite:=inherited Write(aPage^.Buffer^,aPage^.PageRealSize);
      if lEffectiveBytesWrite<>aPage^.PageRealSize then begin
        EmergencyWriteDirtyPages;
        Raise EStreamError.CreateFmt(cErrCacheUnableToWriteExpected,[aPage^.PageRealSize,lEffectiveBytesWrite,IntToStr(aPage^.PageBegin)]);
      end;
      aPage^.IsDirty:=False;
      aPage^.LastTick:=GetOpCounter;
    end;
    
    procedure TBufferedFileStream.WriteDirtyPage(const aIndex: integer);
    var
      pCache: PStreamCacheEntry;
    begin
      pCache:=FCachePages[aIndex];
      if Assigned(pCache) then begin
        WriteDirtyPage(pCache);
      end;
    end;
    
    procedure TBufferedFileStream.WriteDirtyPages;
    var
      j: integer;
      pCache: PStreamCacheEntry;
    begin
      for j := 0 to Pred(FStreamCachePageMaxCount) do begin
        pCache:=FCachePages[j];
        if Assigned(pCache) then begin
          if pCache^.IsDirty then begin
            WriteDirtyPage(pCache);
          end;
        end;
      end;
    end;
    
    procedure TBufferedFileStream.EmergencyWriteDirtyPages;
    var
      j: integer;
      pCache: PStreamCacheEntry;
    begin
      // Are we already in a emergency write dirty pages ??
      if FEmergencyFlag then exit;
      FEmergencyFlag:=true;
      // This procedure tries to save all dirty pages inconditional
      // because a write fail happens, so everything in cache will
      // be dumped to stream if possible, trying to save as much
      // information as possible.
      for j := 0 to Pred(FStreamCachePageMaxCount) do begin
        pCache:=FCachePages[j];
        if Assigned(pCache) then begin
          if pCache^.IsDirty then begin
            try
              WriteDirtyPage(pCache);
            except on e: Exception do begin
              // Do nothing, eat exception if happen.
              // This way the cache still holds data to be
              // written (that fails) and can be written later
              // if write fail conditions change.
              end;
            end;
          end;
        end;
      end;
      FEmergencyFlag:=False;
    end;
    
    procedure TBufferedFileStream.FreePage(const aPage: PStreamCacheEntry;
      const aFreeBuffer: Boolean);
    begin
      aPage^.PageBegin:=0;
      aPage^.PageRealSize:=0;
      aPage^.LastTick:=0;
      aPage^.IsDirty:=false;
      if aFreeBuffer then begin
        FreeMem(aPage^.Buffer);
        aPage^.Buffer:=nil;
      end;
    end;
    
    function TBufferedFileStream.LookForPositionInPages: Boolean;
    var
      j: integer;
      pCache: PStreamCacheEntry;
    begin
      Result:=false;
      for j := 0 to Pred(FStreamCachePageMaxCount) do begin
        pCache:=FCachePages[j];
        if Assigned(pCache^.Buffer) then begin
          if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+pCache^.PageRealSize) then begin
            FCacheLastUsedPage:=j;
            Result:=true;
            exit;
          end;
        end;
      end;
    end;
    
    function TBufferedFileStream.ReadPageForPosition: Boolean;
    var
      j: integer;
      pCache: PStreamCacheEntry=nil;
      lStreamPosition: int64;
    begin
      // Find free page entry
      for j := 0 to Pred(FStreamCachePageMaxCount) do begin
        if not Assigned(FCachePages[j]^.Buffer) then begin
          pCache:=FCachePages[j];
          FCacheLastUsedPage:=j;
          break;
        end;
      end;
      if not Assigned(pCache) then begin
        // Free last used page
        pCache:=FreeOlderInUsePage(false);
      end;
      if not Assigned(pCache^.Buffer) then begin
        Getmem(pCache^.Buffer,FStreamCachePageSize);
      end;
      lStreamPosition:=(FCacheStreamPosition div FStreamCachePageSize)*FStreamCachePageSize;
      inherited Seek(lStreamPosition,soBeginning);
      pCache^.PageBegin:=lStreamPosition;
      pCache^.PageRealSize:=inherited Read(pCache^.Buffer^,FStreamCachePageSize);
      if pCache^.PageRealSize=FStreamCachePageSize then begin
        pCache^.LastTick:=GetOpCounter;
        Result:=true;
      end else begin
        if FCacheStreamPosition<lStreamPosition+pCache^.PageRealSize then begin
          pCache^.LastTick:=GetOpCounter;
          Result:=true;
        end else begin
          Result:=false;
        end;
      end;
    end;
    
    function TBufferedFileStream.ReadPageBeforeWrite: Boolean;
    var
      j: integer;
      pCache: PStreamCacheEntry=nil;
      lStreamPosition: int64;
      lExpectedBytesToRead: integer;
      lEffectiveRead: integer;
    begin
      // Find free page entry
      for j := 0 to Pred(FStreamCachePageMaxCount) do begin
        if not Assigned(FCachePages[j]^.Buffer) then begin
          pCache:=FCachePages[j];
          FCacheLastUsedPage:=j;
          break;
        end;
      end;
      if not Assigned(pCache) then begin
        // Free last used page
        pCache:=FreeOlderInUsePage(false);
      end;
      if not Assigned(pCache^.Buffer) then begin
        Getmem(pCache^.Buffer,FStreamCachePageSize);
      end;
      lStreamPosition:=(FCacheStreamPosition div FStreamCachePageSize)*FStreamCachePageSize;
      inherited Seek(lStreamPosition,soBeginning);
      if (lStreamPosition+FStreamCachePageSize) > FCacheStreamSize then begin
        lExpectedBytesToRead:=FCacheStreamSize-lStreamPosition;
      end else begin
        lExpectedBytesToRead:=FStreamCachePageSize;
      end;
      pCache^.PageBegin:=lStreamPosition;
      pCache^.PageRealSize:=inherited Read(pCache^.Buffer^,FStreamCachePageSize);
      if pCache^.PageRealSize<>lExpectedBytesToRead then begin
        lEffectiveRead:=pCache^.PageRealSize;
        pCache^.IsDirty:=false;
        pCache^.LastTick:=0;
        pCache^.PageBegin:=0;
        pCache^.PageRealSize:=0;
        Freemem(pCache^.Buffer);
        pCache^.Buffer:=nil;
        Raise EStreamError.CreateFmt(cErrCacheUnableToReadExpected,[lExpectedBytesToRead,lEffectiveRead]);
      end;
      pCache^.LastTick:=GetOpCounter;
      Result:=true;
    end;
    
    function TBufferedFileStream.FreeOlderInUsePage(const aFreeBuffer: Boolean
      ): PStreamCacheEntry;
    var
      j: integer;
      lOlderTick: int64=High(int64);
      lOlderEntry: integer=-1;
    begin
      for j := 0 to Pred(FStreamCachePageMaxCount) do begin
        Result:=FCachePages[j];
        if Assigned(Result^.Buffer) then begin
          if Result^.LastTick<lOlderTick then begin
            lOlderTick:=Result^.LastTick;
            lOlderEntry:=j;
          end;
        end;
      end;
      if lOlderEntry=-1 then begin
        Raise Exception.Create(cErrCacheInternal);
      end;
      Result:=FCachePages[lOlderEntry];
      FCacheLastUsedPage:=lOlderEntry;
      if Result^.IsDirty then begin
        WriteDirtyPage(Result);
      end;
      FreePage(Result,aFreeBuffer);
    end;
    
    function TBufferedFileStream.GetOpCounter: NativeUInt;
    begin
      Result:=FOpCounter;
      {$PUSH}
      {$Q-}
      inc(FOpCounter);
      {$POP}
    end;
    
    function TBufferedFileStream.DoCacheRead(var Buffer; Count: Longint): Longint;
    var
      pCache: PStreamCacheEntry;
      lAvailableInThisPage: integer;
      lPositionInPage: integer;
      lNewBuffer: PBYTE;
    begin
      pCache:=FCachePages[FCacheLastUsedPage];
      if Assigned(pCache) then begin
        // Check if FCacheStreamPosition is in range
        if Assigned(pCache^.Buffer) then begin
          if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+pCache^.PageRealSize) then begin
            // Position is in range, so read available data from this page up to count or page end
            lPositionInPage:=(FCacheStreamPosition-pCache^.PageBegin);
            lAvailableInThisPage:=pCache^.PageRealSize - lPositionInPage;
            if lAvailableInThisPage>=Count then begin
              move((PBYTE(pCache^.Buffer)+lPositionInPage)^,Buffer,Count);
              inc(FCacheStreamPosition,Count);
              Result:=Count;
              pCache^.LastTick:=GetOpCounter;
              exit;
            end else begin
              move((PBYTE(pCache^.Buffer)+lPositionInPage)^,Buffer,lAvailableInThisPage);
              inc(FCacheStreamPosition,lAvailableInThisPage);
              if pCache^.PageRealSize=FStreamCachePageSize then begin
                lNewBuffer:=PBYTE(@Buffer)+lAvailableInThisPage;
                Result:=lAvailableInThisPage+DoCacheRead(lNewBuffer^,Count-lAvailableInThisPage);
              end else begin
                // This cache page is not filled, so it is the last one
                // in the file, nothing more to read...
                pCache^.LastTick:=GetOpCounter;
                Result:=lAvailableInThisPage;
              end;
              exit;
            end;
          end else begin
            // The position is in other cache page or not in cache at all, so look for
            // position in cached pages or allocate a new page.
            if LookForPositionInPages then begin
              Result:=DoCacheRead(Buffer,Count);
              exit;
            end else begin
              if ReadPageForPosition then begin
                Result:=DoCacheRead(Buffer,Count);
              end else begin
                Result:=0;
              end;
              exit;
            end;
          end;
        end else begin
          if ReadPageForPosition then begin
            Result:=DoCacheRead(Buffer,Count);
          end else begin
            Result:=0;
          end;
          exit;
        end;
      end else begin
        // The page has been discarded for some unknown reason
        Raise EStreamError.Create(cErrCacheUnexpectedPageDiscard);
      end;
    end;
    
    function TBufferedFileStream.DoCacheWrite(const Buffer; Count: Longint): Longint;
    var
      pCache: PStreamCacheEntry;
      lAvailableInThisPage: integer;
      lPositionInPage: integer;
      lNewBuffer: PBYTE;
    begin
      pCache:=FCachePages[FCacheLastUsedPage];
      if Assigned(pCache) then begin
        // Check if FCacheStreamPosition is in range
        if Assigned(pCache^.Buffer) then begin
          if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+FStreamCachePageSize) then begin
            // Position is in range, so write data up to end of page
            lPositionInPage:=(FCacheStreamPosition-pCache^.PageBegin);
            lAvailableInThisPage:=FStreamCachePageSize - lPositionInPage;
            if lAvailableInThisPage>=Count then begin
              move(Buffer,(PBYTE(pCache^.Buffer)+lPositionInPage)^,Count);
              if not pCache^.IsDirty then pCache^.IsDirty:=true;
              inc(FCacheStreamPosition,Count);
              // Update page size
              if lPositionInPage+Count > pCache^.PageRealSize then pCache^.PageRealSize:=lPositionInPage+Count;
              // Update file size
              if FCacheStreamPosition>FCacheStreamSize then FCacheStreamSize:=FCacheStreamPosition;
              Result:=Count;
              pCache^.LastTick:=GetOpCounter;
              exit;
            end else begin
              move(Buffer,(PBYTE(pCache^.Buffer)+lPositionInPage)^,lAvailableInThisPage);
              if not pCache^.IsDirty then pCache^.IsDirty:=true;
              inc(FCacheStreamPosition,lAvailableInThisPage);
              // Update page size
              if lPositionInPage+Count > pCache^.PageRealSize then pCache^.PageRealSize:=lPositionInPage+lAvailableInThisPage;
              // Update file size
              if FCacheStreamPosition>FCacheStreamSize then FCacheStreamSize:=FCacheStreamPosition;
    
              Assert(pCache^.PageRealSize=FStreamCachePageSize,'This must not happend');
              lNewBuffer:=PBYTE(@Buffer)+lAvailableInThisPage;
              Result:=lAvailableInThisPage+DoCacheWrite(lNewBuffer^,Count-lAvailableInThisPage);
              exit;
            end;
          end else begin
            // The position is in other cache page or not in cache at all, so look for
            // position in cached pages or allocate a new page.
            if LookForPositionInPages then begin
              Result:=DoCacheWrite(Buffer,Count);
              exit;
            end else begin
              if ReadPageBeforeWrite then begin
                Result:=DoCacheWrite(Buffer,Count);
              end else begin
                Result:=0;
              end;
              exit;
            end;
          end;
        end else begin
          if ReadPageBeforeWrite then begin
            Result:=DoCacheWrite(Buffer,Count);
          end else begin
            Result:=0;
          end;
          exit;
        end;
      end else begin
        // The page has been discarded for some unknown reason
        Raise EStreamError.Create(cErrCacheUnexpectedPageDiscard);
      end;
    end;
    
    function TBufferedFileStream.GetPosition: Int64;
    begin
      Result:=FCacheStreamPosition;
    end;
    
    procedure TBufferedFileStream.SetPosition(const Pos: Int64);
    begin
      if Pos<0 then begin
        FCacheStreamPosition:=0;
      end else begin
        FCacheStreamPosition:=Pos;
      end;
    end;
    
    function TBufferedFileStream.GetSize: Int64;
    begin
      Result:=FCacheStreamSize;
    end;
    
    procedure TBufferedFileStream.SetSize64(const NewSize: Int64);
    var
      j: integer;
      pCache: PStreamCacheEntry;
    begin
      WriteDirtyPages;
      inherited SetSize64(NewSize);
      FCacheStreamSize:=inherited Seek(0,soFromEnd);
      for j := 0 to Pred(FStreamCachePageMaxCount) do begin
        pCache:=FCachePages[j];
        if Assigned(pCache^.Buffer) and (pCache^.PageRealSize+pCache^.PageBegin>FCacheStreamSize) then begin
          // This page is out of bounds the new file size
          // so discard it.
          FreePage(pCache,True);
          break;
        end;
      end;
    end;
    
    procedure TBufferedFileStream.SetSize(NewSize: Longint);
    begin
      SetSize64(NewSize);
    end;
    
    procedure TBufferedFileStream.SetSize(const NewSize: Int64);
    begin
      SetSize64(NewSize);
    end;
    
    constructor TBufferedFileStream.Create(const AFileName: string; Mode: Word);
    begin
      // Initialize with 8 blocks of 4096 bytes
      InitializeCache(TSTREAMCACHEPAGE_SIZE_DEFAULT,TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT);
      inherited Create(AFileName,Mode);
      FCacheStreamSize:=inherited Seek(int64(0),soEnd);
    end;
    
    constructor TBufferedFileStream.Create(const AFileName: string; Mode: Word;
      Rights: Cardinal);
    begin
      // Initialize with 8 blocks of 4096 bytes
      InitializeCache(TSTREAMCACHEPAGE_SIZE_DEFAULT,TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT);
      inherited Create(AFileName,Mode,Rights);
      FCacheStreamSize:=inherited Seek(int64(0),soEnd);
    end;
    
    function TBufferedFileStream.Read(var Buffer; Count: Longint): Longint;
    begin
      Result:=DoCacheRead(Buffer,Count);
    end;
    
    function TBufferedFileStream.Write(const Buffer; Count: Longint): Longint;
    begin
      Result:=DoCacheWrite(Buffer,Count);
    end;
    
    procedure TBufferedFileStream.Flush;
    begin
      WriteDirtyPages;
    end;
    
    function TBufferedFileStream.Seek(Offset: Longint; Origin: Word): Longint;
    begin
      Result:=Seek(int64(OffSet),TSeekOrigin(Origin));
    end;
    
    function TBufferedFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
    var
      lNewOffset: int64;
    begin
      Case Origin of
        soEnd:
          begin
            lNewOffset:=FCacheStreamSize+Offset;
          end;
        soBeginning:
          begin
            lNewOffset:=0+Offset;
          end;
        soCurrent:
          begin
            lNewOffset:=FCacheStreamPosition+Offset;
          end;
      end;
      if lNewOffset>0 then begin
        FCacheStreamPosition:=lNewOffset;
        Result:=lNewOffset;
      end else begin
        // This is compatible with FPC stream
        // as it returns the negative value :-?
        // but in fact does not move the read pointer.
        Result:=-1;
      end;
    end;
    
    procedure TBufferedFileStream.InitializeCache(const aCacheBlockSize: integer;
      const aCacheBlockCount: integer);
    var
      j: integer;
    begin
      ClearCache;
      FStreamCachePageSize:=aCacheBlockSize;
      FStreamCachePageMaxCount:=aCacheBlockCount;
      FCacheStreamSize:=inherited Seek(0,soEnd);
      SetLength(FCachePages,FStreamCachePageMaxCount);
      for j := 0 to Pred(FStreamCachePageMaxCount) do begin
        FCachePages[j]:=New(PStreamCacheEntry);
        FillByte(FCachePages[j]^,Sizeof(PStreamCacheEntry^),0);
      end;
    end;
    
    destructor TBufferedFileStream.Destroy;
    begin
      ClearCache;
      inherited Destroy;
    end;
    
    end.
    
    
    ubufferedfilestream.pas (19,291 bytes)
  • ubufferedfilestreamt1.pas (12,508 bytes)
    unit ubufferedfilestreamt1;
    
    {$mode objfpc}{$H+}
    
    interface
    
    uses
      Classes, SysUtils, fpcunit, testregistry,
      ubufferedfilestream;
    
    type
    
      { TTestBufferedFileStream }
    
      TTestBufferedFileStream= class(TTestCase)
      private
      const
        TEST_RANDOM_READS=10000;
        TEST_SEQUENTIAL_READS=1000000;
        TEST_FILENAME='testfile.bin';
        TEST_WRITEC_FILE='testwritecache.bin';
        TEST_WRITEF_FILE='testwritedirec.bin';
      private
        function CompareStreams(const aStream1: TStream; const aStream2: TStream): Boolean;
      protected
        procedure SetUp; override;
        procedure TearDown; override;
      published
        procedure TestCacheRead;
        procedure TestCacheWrite;
        procedure TestCacheSeek;
      end;
    
    implementation
    
    procedure TTestBufferedFileStream.TestCacheRead;
    var
      lBufferedStream: TBufferedFileStream;
      lStream: TFileStream;
      b: array [0..10000-1] of char;
      j,k: integer;
      lBytesToRead: integer;
      lEffectiveRead: integer;
      {$IFDEF CHECK_AGAINST_FILE}
      lEffectiveRead2: integer;
      {$ENDIF}
      lReadPosition: int64;
      lCheckInitV: integer;
      lTick: QWord;
    begin
      b[0]:=#0; // Avoid initalization hint
      lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
      lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
      try
        RandSeed:=1;
        Randomize;
        lTick:=GetTickCount64;
        for j := 0 to Pred(TEST_RANDOM_READS) do begin
          lBytesToRead:=Random(10000);
          lReadPosition:=Random(lBufferedStream.Size);
          lBufferedStream.Position:=lReadPosition;
    
          lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);
    
          {$IFDEF CHECK_AGAINST_FILE}
          // Now read without cache
          lStream.Position:=lReadPosition;
          lEffectiveRead2:=lStream.Read(b2,lBytesToRead);
          if lEffectiveRead<>lEffectiveRead2 then begin
            FAIL('Read length mismatch');
          end;
          if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin
            FAIL('Compare buffer data error');
          end;
          F.Position:=0;
          {$ELSE}
          lCheckInitV:=lReadPosition mod 10;
          for k := 0 to Pred(lEffectiveRead) do begin
            if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
              FAIL('Expected data error');
            end;
            inc(lCheckInitV);
          end;
          {$ENDIF}
        end;
        writeln('CACHE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.');
    
        RandSeed:=1;
        Randomize;
    
        writeln('Same operation without cache');
        lTick:=GetTickCount64;
        for j := 0 to Pred(TEST_RANDOM_READS) do begin
          lBytesToRead:=Random(10000);
          lReadPosition:=Random(lBufferedStream.Size);
    
          lStream.Position:=lReadPosition;
          lEffectiveRead:=lStream.Read(b,lBytesToRead);
    
          lCheckInitV:=lReadPosition mod 10;
          for k := 0 to Pred(lEffectiveRead) do begin
            if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
              FAIL('Expected data error');
            end;
            inc(lCheckInitV);
          end;
        end;
        writeln('FILE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.');
    
        writeln('Check sequential read');
    
        RandSeed:=1;
        Randomize;
        lTick:=GetTickCount64;
        lBytesToRead:=1;
        lReadPosition:=0;
        lBufferedStream.Position:=lReadPosition;
        lStream.Position:=lReadPosition;
        for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin
    
          lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);
    
          {$IFDEF CHECK_AGAINST_FILE}
          // Now read without cache
          lEffectiveRead2:=lStream.Read(b2,lBytesToRead);
          if lEffectiveRead<>lEffectiveRead2 then begin
            FAIL('Read length mismatch');
          end;
          if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin
            FAIL('Compare buffer data error');
          end;
          F.Position:=0;
          {$ELSE}
          lCheckInitV:=lReadPosition mod 10;
          for k := 0 to Pred(lEffectiveRead) do begin
            if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
              FAIL('Expected data error');
            end;
            inc(lCheckInitV);
          end;
          {$ENDIF}
          inc(lReadPosition,lBytesToRead);
        end;
        writeln('CACHE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.');
    
        RandSeed:=1;
        Randomize;
        lTick:=GetTickCount64;
        lBytesToRead:=1;
        lReadPosition:=0;
        lStream.Position:=lReadPosition;
        for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin
    
          lEffectiveRead:=lStream.Read(b,lBytesToRead);
    
          lCheckInitV:=lReadPosition mod 10;
          for k := 0 to Pred(lEffectiveRead) do begin
            if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
              FAIL('Expected data error');
            end;
            inc(lCheckInitV);
          end;
          inc(lReadPosition,lBytesToRead);
        end;
        writeln('FILE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.');
    
        writeln('CACHE Trying read beyond limits');
        lBufferedStream.Position:=lBufferedStream.Size-1;
        lEffectiveRead:=lBufferedStream.Read(b,2);
        if lEffectiveRead<>1 then begin
          FAIL('Read beyond limits, returned bytes: '+inttostr(lEffectiveRead));
        end else begin
          Writeln('CACHE OK, read beyond limits returns 0 bytes.');
        end;
      finally
        lBufferedStream.Free;
        lStream.Free;
      end;
    end;
    
    procedure TTestBufferedFileStream.TestCacheWrite;
    const
      EXPECTED_SIZE=10000000;
      TEST_ROUNDS=100000;
    var
      lBufferedStream: TBufferedFileStream;
      lStream: TFileStream;
      lVerifyStream1,lVerifyStream2: TFileStream;
      b: array [0..10000-1] of char;
      j: integer;
      lBytesToWrite: integer;
      lWritePosition: int64;
    begin
      writeln('Testing write cache');
      // All test should return the same random sequence
      RandSeed:=1;
      Randomize;
      for j := 0 to Pred(10000) do begin
        b[j]:='0';
      end;
      lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmCreate);
      lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmCreate);
      try
        for j := 0 to Pred(EXPECTED_SIZE div Sizeof(b)) do begin
          lBufferedStream.Write(b,sizeof(b));
          lStream.Write(b,sizeof(b));
        end;
        for j := 0 to Pred(Sizeof(b)) do begin
          b[j]:=char(ord('0')+j mod 10);
        end;
      finally
        lBufferedStream.Free;
        lStream.Free;
      end;
      lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmOpenReadWrite);
      lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenWrite);
      try
        for j := 0 to Pred(TEST_ROUNDS) do begin
          if lStream.Size<>lBufferedStream.Size then begin
            FAIL('Mismatched lengths');
          end;
          lWritePosition:=Random(EXPECTED_SIZE);
          lBytesToWrite:=Random(sizeof(b));
          lBufferedStream.Position:=lWritePosition;
          lStream.Position:=lWritePosition;
          lBufferedStream.Write(b,lBytesToWrite);
          lStream.Write(b,lBytesToWrite);
          if j mod 1273 = 0 then write(j,' / ',TEST_ROUNDS,#13);
        end;
        writeln(TEST_ROUNDS,' / ',TEST_ROUNDS);
        if lStream.Size<>lBufferedStream.Size then begin
          FAIL('Mismatched lengths');
        end;
      finally
        lBufferedStream.Free;
        lStream.Free;
      end;
    
      // Verify both generated files are identical.
      lVerifyStream1:=TFileStream.Create(TEST_WRITEC_FILE,fmOpenRead or fmShareDenyWrite);
      lVerifyStream2:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenRead or fmShareDenyWrite);
      try
        if not CompareStreams(lVerifyStream1,lVerifyStream2) then begin
          FAIL('Streams are different!!');
        end else begin
          writeln('Streams are identical. OK.');
        end;
      finally
        lVerifyStream1.Free;
        lVerifyStream2.Free;
      end;
    end;
    
    procedure TTestBufferedFileStream.TestCacheSeek;
    var
      lBufferedStream: TBufferedFileStream;
      lStream: TFileStream;
      bBuffered: array [0..10000] of BYTE;
      bStream: array [0..10000] of BYTE;
    begin
      bBuffered[0]:=0; // Avoid initalization hint
      bStream[0]:=0; // Avoid initalization hint
      lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
      lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
      try
        writeln('Set position=-1');
        lStream.Position:=-1;
        writeln('TFileStream position=',lStream.Position);
        lBufferedStream.Position:=-1;
        writeln('Buffered    position=',lBufferedStream.Position);
        if lStream.Position<>lBufferedStream.Position then begin
          FAIL('Positions are not the same.');
        end else begin
          writeln('Positions are the same.');
        end;
    
        writeln('Read data when position=-1');
        writeln('TFileStream read bytes  : ',lStream.Read(bBuffered[0],10));
        writeln('TFileStream end position: ',lStream.Position);
        writeln('Buffered      read bytes: ',lBufferedStream.Read(bStream[0],10));
        writeln('Buffered    end position: ',lBufferedStream.Position);
        if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
          FAIL('Read data or positions are not the same.');
        end else begin
          writeln('Read data at -1 is the same.');
        end;
    
        writeln('Testing Seek operations');
        writeln('Seek -1 from beginning');
        writeln('Stream seek result  : ',lStream.Seek(-1,soBeginning));
        writeln('Buffered seek result: ',lBufferedStream.Seek(-1,soBeginning));
    
        writeln('Read data when Seek -1');
        writeln('TFileStream read bytes  : ',lStream.Read(bBuffered[0],10));
        writeln('TFileStream end position: ',lStream.Position);
        writeln('Buffered      read bytes: ',lBufferedStream.Read(bStream[0],10));
        writeln('Buffered    end position: ',lBufferedStream.Position);
        if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
          FAIL('Read data or positions are not the same.');
        end else begin
          writeln('Read data at -1 is the same.');
        end;
    
        writeln('Seek -current*2 from current');
        writeln('Stream seek result  : ',lStream.Seek(lStream.Position*-2,soCurrent));
        writeln('Buffered seek result: ',lBufferedStream.Seek(lBufferedStream.Position*-2,soCurrent));
        writeln('Read data when Seek from current -current*2');
        writeln('TFileStream read bytes  : ',lStream.Read(bBuffered[0],10));
        writeln('TFileStream end position: ',lStream.Position);
        writeln('Buffered      read bytes: ',lBufferedStream.Read(bStream[0],10));
        writeln('Buffered    end position: ',lBufferedStream.Position);
        if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
          FAIL('Read data or positions are not the same.');
        end else begin
          writeln('Read data at -current*2 is the same.');
        end;
      finally
        lBufferedStream.Free;
        lStream.Free;
      end;
    end;
    
    procedure TTestBufferedFileStream.SetUp;
    var
      F: TFileStream;
      b: array [0..10000-1] of char;
      j: integer;
    begin
      for j := 0 to Pred(10000) do begin
        b[j]:=char(ord('0')+j mod 10);
      end;
      F:=TFileStream.Create(TEST_FILENAME,fmCreate);
      for j := 0 to Pred(1000) do begin
        F.Write(b,sizeof(b));
      end;
      F.Free;
    end;
    
    procedure TTestBufferedFileStream.TearDown;
    begin
      DeleteFile(TEST_FILENAME);
      DeleteFile(TEST_WRITEC_FILE);
      DeleteFile(TEST_WRITEF_FILE);
    end;
    
    function TTestBufferedFileStream.CompareStreams(const aStream1: TStream;
      const aStream2: TStream): Boolean;
    const
      BUFFER_SIZE=5213; // Odd number
    var
      b1: array [0..BUFFER_SIZE-1] of BYTE;
      b2: array [0..BUFFER_SIZE-1] of BYTE;
      lReadBytes: integer;
      lAvailable: integer;
      lEffectiveRead1: integer;
      lEffectiveRead2: integer;
    begin
      b1[0]:=0; // Avoid initalization hint
      b2[0]:=0; // Avoid initalization hint
      Result:=false;
      if aStream1.Size<>aStream2.Size then exit;
      aStream1.Position:=0;
      aStream2.Position:=0;
      while aStream1.Position<aStream1.Size do begin
        lAvailable:=aStream1.Size-aStream1.Position;
        if lAvailable>=BUFFER_SIZE then begin
          lReadBytes:=BUFFER_SIZE;
        end else begin
          lReadBytes:=aStream1.Size-aStream1.Position;
        end;
        lEffectiveRead1:=aStream1.Read(b1[0],lReadBytes);
        lEffectiveRead2:=aStream2.Read(b2[0],lReadBytes);
        if lEffectiveRead1<>lEffectiveRead2 then exit;
        if not CompareMem(@b1[0],@b2[0],lEffectiveRead1) then exit;
      end;
      Result:=true;
    end;
    
    initialization
    
      RegisterTest(TTestBufferedFileStream);
    end.
    
    
    ubufferedfilestreamt1.pas (12,508 bytes)

Activities

José Mejuto

2016-09-02 18:05

reporter  

ubufferedfilestream.pas (19,291 bytes)
unit ubufferedfilestream;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type

  { TBufferedFileStream }

  TBufferedFileStream = class(TFileStream)
  private
    const
      TSTREAMCACHEPAGE_SIZE_DEFAULT=4*1024;
      TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT=8;
    type
      TStreamCacheEntry=record
        IsDirty: Boolean;
        LastTick: NativeUInt;
        PageBegin: int64;
        PageRealSize: integer;
        Buffer: Pointer;
      end;
      PStreamCacheEntry=^TStreamCacheEntry;
  private
    FCachePages: array of PStreamCacheEntry;
    FCacheLastUsedPage: integer;
    FCacheStreamPosition: int64;
    FCacheStreamSize: int64;
    FOpCounter: NativeUInt;
    FStreamCachePageSize: integer;
    FStreamCachePageMaxCount: integer;
    FEmergencyFlag: Boolean;
    procedure ClearCache;
    procedure WriteDirtyPage(const aPage: PStreamCacheEntry);
    procedure WriteDirtyPage(const aIndex: integer);
    procedure WriteDirtyPages;
    procedure EmergencyWriteDirtyPages;
    procedure FreePage(const aPage: PStreamCacheEntry; const aFreeBuffer: Boolean); inline;
    function  LookForPositionInPages: Boolean;
    function  ReadPageForPosition: Boolean;
    function  ReadPageBeforeWrite: Boolean;
    function  FreeOlderInUsePage(const aFreeBuffer: Boolean=false): PStreamCacheEntry;
    function  GetOpCounter: NativeUInt; inline;
    function  DoCacheRead(var Buffer; Count: Longint): Longint;
    function  DoCacheWrite(const Buffer; Count: Longint): Longint;
  protected
    function  GetPosition: Int64; override;
    procedure SetPosition(const Pos: Int64); override;
    function  GetSize: Int64; override;
    procedure SetSize64(const NewSize: Int64); override;
    procedure SetSize(NewSize: Longint); override;overload;
    procedure SetSize(const NewSize: Int64); override;overload;
  public
    // Warning using Mode=fmOpenWrite because the write buffer
    // needs to read, as this class is a cache system not a dumb buffer.
    constructor Create(const AFileName: string; Mode: Word);
    constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal);
    destructor  Destroy; override;
    function  Seek(Offset: Longint; Origin: Word): Longint; override; overload;
    function  Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; overload;
    function  Read(var Buffer; Count: Longint): Longint; override;
    function  Write(const Buffer; Count: Longint): Longint; override;
    // Flush write-cache content to disk
    procedure Flush;
    // re-initialize the cache with aCacheBlockCount block
    // of aCacheBlockSize bytes in each block.
    procedure InitializeCache(const aCacheBlockSize: integer; const aCacheBlockCount: integer);
  end;

implementation

resourcestring
  cErrCacheUnexpectedPageDiscard='CACHE: Unexpected behaviour. Discarded page.';
  cErrCacheUnableToReadExpected= 'CACHE: Unable to read expected bytes (Open for write only ?). Expected: %d, effective read: %d';
  cErrCacheUnableToWriteExpected='CACHE: Unable to write expected bytes (Open for read only ?). Expected: %d, effective write: %d';
  cErrCacheInternal=             'CACHE: Internal error.';

    { TBufferedFileStream }

procedure TBufferedFileStream.ClearCache;
var
  j: integer;
  pStream: PStreamCacheEntry;
begin
  try
    WriteDirtyPages;
  finally
    for j := 0 to Pred(FStreamCachePageMaxCount) do begin
      pStream:=FCachePages[j];
      if Assigned(pStream) then begin
        if Assigned(pStream^.Buffer) then Freemem(pStream^.Buffer);
        Dispose(pStream);
        FCachePages[j]:=nil;
      end;
    end;
  end;
end;

procedure TBufferedFileStream.WriteDirtyPage(const aPage: PStreamCacheEntry);
var
  lEffectiveBytesWrite: integer;
begin
  inherited Seek(aPage^.PageBegin,soBeginning);
  lEffectiveBytesWrite:=inherited Write(aPage^.Buffer^,aPage^.PageRealSize);
  if lEffectiveBytesWrite<>aPage^.PageRealSize then begin
    EmergencyWriteDirtyPages;
    Raise EStreamError.CreateFmt(cErrCacheUnableToWriteExpected,[aPage^.PageRealSize,lEffectiveBytesWrite,IntToStr(aPage^.PageBegin)]);
  end;
  aPage^.IsDirty:=False;
  aPage^.LastTick:=GetOpCounter;
end;

procedure TBufferedFileStream.WriteDirtyPage(const aIndex: integer);
var
  pCache: PStreamCacheEntry;
begin
  pCache:=FCachePages[aIndex];
  if Assigned(pCache) then begin
    WriteDirtyPage(pCache);
  end;
end;

procedure TBufferedFileStream.WriteDirtyPages;
var
  j: integer;
  pCache: PStreamCacheEntry;
begin
  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
    pCache:=FCachePages[j];
    if Assigned(pCache) then begin
      if pCache^.IsDirty then begin
        WriteDirtyPage(pCache);
      end;
    end;
  end;
end;

procedure TBufferedFileStream.EmergencyWriteDirtyPages;
var
  j: integer;
  pCache: PStreamCacheEntry;
begin
  // Are we already in a emergency write dirty pages ??
  if FEmergencyFlag then exit;
  FEmergencyFlag:=true;
  // This procedure tries to save all dirty pages inconditional
  // because a write fail happens, so everything in cache will
  // be dumped to stream if possible, trying to save as much
  // information as possible.
  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
    pCache:=FCachePages[j];
    if Assigned(pCache) then begin
      if pCache^.IsDirty then begin
        try
          WriteDirtyPage(pCache);
        except on e: Exception do begin
          // Do nothing, eat exception if happen.
          // This way the cache still holds data to be
          // written (that fails) and can be written later
          // if write fail conditions change.
          end;
        end;
      end;
    end;
  end;
  FEmergencyFlag:=False;
end;

procedure TBufferedFileStream.FreePage(const aPage: PStreamCacheEntry;
  const aFreeBuffer: Boolean);
begin
  aPage^.PageBegin:=0;
  aPage^.PageRealSize:=0;
  aPage^.LastTick:=0;
  aPage^.IsDirty:=false;
  if aFreeBuffer then begin
    FreeMem(aPage^.Buffer);
    aPage^.Buffer:=nil;
  end;
end;

function TBufferedFileStream.LookForPositionInPages: Boolean;
var
  j: integer;
  pCache: PStreamCacheEntry;
begin
  Result:=false;
  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
    pCache:=FCachePages[j];
    if Assigned(pCache^.Buffer) then begin
      if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+pCache^.PageRealSize) then begin
        FCacheLastUsedPage:=j;
        Result:=true;
        exit;
      end;
    end;
  end;
end;

function TBufferedFileStream.ReadPageForPosition: Boolean;
var
  j: integer;
  pCache: PStreamCacheEntry=nil;
  lStreamPosition: int64;
begin
  // Find free page entry
  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
    if not Assigned(FCachePages[j]^.Buffer) then begin
      pCache:=FCachePages[j];
      FCacheLastUsedPage:=j;
      break;
    end;
  end;
  if not Assigned(pCache) then begin
    // Free last used page
    pCache:=FreeOlderInUsePage(false);
  end;
  if not Assigned(pCache^.Buffer) then begin
    Getmem(pCache^.Buffer,FStreamCachePageSize);
  end;
  lStreamPosition:=(FCacheStreamPosition div FStreamCachePageSize)*FStreamCachePageSize;
  inherited Seek(lStreamPosition,soBeginning);
  pCache^.PageBegin:=lStreamPosition;
  pCache^.PageRealSize:=inherited Read(pCache^.Buffer^,FStreamCachePageSize);
  if pCache^.PageRealSize=FStreamCachePageSize then begin
    pCache^.LastTick:=GetOpCounter;
    Result:=true;
  end else begin
    if FCacheStreamPosition<lStreamPosition+pCache^.PageRealSize then begin
      pCache^.LastTick:=GetOpCounter;
      Result:=true;
    end else begin
      Result:=false;
    end;
  end;
end;

function TBufferedFileStream.ReadPageBeforeWrite: Boolean;
var
  j: integer;
  pCache: PStreamCacheEntry=nil;
  lStreamPosition: int64;
  lExpectedBytesToRead: integer;
  lEffectiveRead: integer;
begin
  // Find free page entry
  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
    if not Assigned(FCachePages[j]^.Buffer) then begin
      pCache:=FCachePages[j];
      FCacheLastUsedPage:=j;
      break;
    end;
  end;
  if not Assigned(pCache) then begin
    // Free last used page
    pCache:=FreeOlderInUsePage(false);
  end;
  if not Assigned(pCache^.Buffer) then begin
    Getmem(pCache^.Buffer,FStreamCachePageSize);
  end;
  lStreamPosition:=(FCacheStreamPosition div FStreamCachePageSize)*FStreamCachePageSize;
  inherited Seek(lStreamPosition,soBeginning);
  if (lStreamPosition+FStreamCachePageSize) > FCacheStreamSize then begin
    lExpectedBytesToRead:=FCacheStreamSize-lStreamPosition;
  end else begin
    lExpectedBytesToRead:=FStreamCachePageSize;
  end;
  pCache^.PageBegin:=lStreamPosition;
  pCache^.PageRealSize:=inherited Read(pCache^.Buffer^,FStreamCachePageSize);
  if pCache^.PageRealSize<>lExpectedBytesToRead then begin
    lEffectiveRead:=pCache^.PageRealSize;
    pCache^.IsDirty:=false;
    pCache^.LastTick:=0;
    pCache^.PageBegin:=0;
    pCache^.PageRealSize:=0;
    Freemem(pCache^.Buffer);
    pCache^.Buffer:=nil;
    Raise EStreamError.CreateFmt(cErrCacheUnableToReadExpected,[lExpectedBytesToRead,lEffectiveRead]);
  end;
  pCache^.LastTick:=GetOpCounter;
  Result:=true;
end;

function TBufferedFileStream.FreeOlderInUsePage(const aFreeBuffer: Boolean
  ): PStreamCacheEntry;
var
  j: integer;
  lOlderTick: int64=High(int64);
  lOlderEntry: integer=-1;
begin
  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
    Result:=FCachePages[j];
    if Assigned(Result^.Buffer) then begin
      if Result^.LastTick<lOlderTick then begin
        lOlderTick:=Result^.LastTick;
        lOlderEntry:=j;
      end;
    end;
  end;
  if lOlderEntry=-1 then begin
    Raise Exception.Create(cErrCacheInternal);
  end;
  Result:=FCachePages[lOlderEntry];
  FCacheLastUsedPage:=lOlderEntry;
  if Result^.IsDirty then begin
    WriteDirtyPage(Result);
  end;
  FreePage(Result,aFreeBuffer);
end;

function TBufferedFileStream.GetOpCounter: NativeUInt;
begin
  Result:=FOpCounter;
  {$PUSH}
  {$Q-}
  inc(FOpCounter);
  {$POP}
end;

function TBufferedFileStream.DoCacheRead(var Buffer; Count: Longint): Longint;
var
  pCache: PStreamCacheEntry;
  lAvailableInThisPage: integer;
  lPositionInPage: integer;
  lNewBuffer: PBYTE;
begin
  pCache:=FCachePages[FCacheLastUsedPage];
  if Assigned(pCache) then begin
    // Check if FCacheStreamPosition is in range
    if Assigned(pCache^.Buffer) then begin
      if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+pCache^.PageRealSize) then begin
        // Position is in range, so read available data from this page up to count or page end
        lPositionInPage:=(FCacheStreamPosition-pCache^.PageBegin);
        lAvailableInThisPage:=pCache^.PageRealSize - lPositionInPage;
        if lAvailableInThisPage>=Count then begin
          move((PBYTE(pCache^.Buffer)+lPositionInPage)^,Buffer,Count);
          inc(FCacheStreamPosition,Count);
          Result:=Count;
          pCache^.LastTick:=GetOpCounter;
          exit;
        end else begin
          move((PBYTE(pCache^.Buffer)+lPositionInPage)^,Buffer,lAvailableInThisPage);
          inc(FCacheStreamPosition,lAvailableInThisPage);
          if pCache^.PageRealSize=FStreamCachePageSize then begin
            lNewBuffer:=PBYTE(@Buffer)+lAvailableInThisPage;
            Result:=lAvailableInThisPage+DoCacheRead(lNewBuffer^,Count-lAvailableInThisPage);
          end else begin
            // This cache page is not filled, so it is the last one
            // in the file, nothing more to read...
            pCache^.LastTick:=GetOpCounter;
            Result:=lAvailableInThisPage;
          end;
          exit;
        end;
      end else begin
        // The position is in other cache page or not in cache at all, so look for
        // position in cached pages or allocate a new page.
        if LookForPositionInPages then begin
          Result:=DoCacheRead(Buffer,Count);
          exit;
        end else begin
          if ReadPageForPosition then begin
            Result:=DoCacheRead(Buffer,Count);
          end else begin
            Result:=0;
          end;
          exit;
        end;
      end;
    end else begin
      if ReadPageForPosition then begin
        Result:=DoCacheRead(Buffer,Count);
      end else begin
        Result:=0;
      end;
      exit;
    end;
  end else begin
    // The page has been discarded for some unknown reason
    Raise EStreamError.Create(cErrCacheUnexpectedPageDiscard);
  end;
end;

function TBufferedFileStream.DoCacheWrite(const Buffer; Count: Longint): Longint;
var
  pCache: PStreamCacheEntry;
  lAvailableInThisPage: integer;
  lPositionInPage: integer;
  lNewBuffer: PBYTE;
begin
  pCache:=FCachePages[FCacheLastUsedPage];
  if Assigned(pCache) then begin
    // Check if FCacheStreamPosition is in range
    if Assigned(pCache^.Buffer) then begin
      if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+FStreamCachePageSize) then begin
        // Position is in range, so write data up to end of page
        lPositionInPage:=(FCacheStreamPosition-pCache^.PageBegin);
        lAvailableInThisPage:=FStreamCachePageSize - lPositionInPage;
        if lAvailableInThisPage>=Count then begin
          move(Buffer,(PBYTE(pCache^.Buffer)+lPositionInPage)^,Count);
          if not pCache^.IsDirty then pCache^.IsDirty:=true;
          inc(FCacheStreamPosition,Count);
          // Update page size
          if lPositionInPage+Count > pCache^.PageRealSize then pCache^.PageRealSize:=lPositionInPage+Count;
          // Update file size
          if FCacheStreamPosition>FCacheStreamSize then FCacheStreamSize:=FCacheStreamPosition;
          Result:=Count;
          pCache^.LastTick:=GetOpCounter;
          exit;
        end else begin
          move(Buffer,(PBYTE(pCache^.Buffer)+lPositionInPage)^,lAvailableInThisPage);
          if not pCache^.IsDirty then pCache^.IsDirty:=true;
          inc(FCacheStreamPosition,lAvailableInThisPage);
          // Update page size
          if lPositionInPage+Count > pCache^.PageRealSize then pCache^.PageRealSize:=lPositionInPage+lAvailableInThisPage;
          // Update file size
          if FCacheStreamPosition>FCacheStreamSize then FCacheStreamSize:=FCacheStreamPosition;

          Assert(pCache^.PageRealSize=FStreamCachePageSize,'This must not happend');
          lNewBuffer:=PBYTE(@Buffer)+lAvailableInThisPage;
          Result:=lAvailableInThisPage+DoCacheWrite(lNewBuffer^,Count-lAvailableInThisPage);
          exit;
        end;
      end else begin
        // The position is in other cache page or not in cache at all, so look for
        // position in cached pages or allocate a new page.
        if LookForPositionInPages then begin
          Result:=DoCacheWrite(Buffer,Count);
          exit;
        end else begin
          if ReadPageBeforeWrite then begin
            Result:=DoCacheWrite(Buffer,Count);
          end else begin
            Result:=0;
          end;
          exit;
        end;
      end;
    end else begin
      if ReadPageBeforeWrite then begin
        Result:=DoCacheWrite(Buffer,Count);
      end else begin
        Result:=0;
      end;
      exit;
    end;
  end else begin
    // The page has been discarded for some unknown reason
    Raise EStreamError.Create(cErrCacheUnexpectedPageDiscard);
  end;
end;

function TBufferedFileStream.GetPosition: Int64;
begin
  Result:=FCacheStreamPosition;
end;

procedure TBufferedFileStream.SetPosition(const Pos: Int64);
begin
  if Pos<0 then begin
    FCacheStreamPosition:=0;
  end else begin
    FCacheStreamPosition:=Pos;
  end;
end;

function TBufferedFileStream.GetSize: Int64;
begin
  Result:=FCacheStreamSize;
end;

procedure TBufferedFileStream.SetSize64(const NewSize: Int64);
var
  j: integer;
  pCache: PStreamCacheEntry;
begin
  WriteDirtyPages;
  inherited SetSize64(NewSize);
  FCacheStreamSize:=inherited Seek(0,soFromEnd);
  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
    pCache:=FCachePages[j];
    if Assigned(pCache^.Buffer) and (pCache^.PageRealSize+pCache^.PageBegin>FCacheStreamSize) then begin
      // This page is out of bounds the new file size
      // so discard it.
      FreePage(pCache,True);
      break;
    end;
  end;
end;

procedure TBufferedFileStream.SetSize(NewSize: Longint);
begin
  SetSize64(NewSize);
end;

procedure TBufferedFileStream.SetSize(const NewSize: Int64);
begin
  SetSize64(NewSize);
end;

constructor TBufferedFileStream.Create(const AFileName: string; Mode: Word);
begin
  // Initialize with 8 blocks of 4096 bytes
  InitializeCache(TSTREAMCACHEPAGE_SIZE_DEFAULT,TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT);
  inherited Create(AFileName,Mode);
  FCacheStreamSize:=inherited Seek(int64(0),soEnd);
end;

constructor TBufferedFileStream.Create(const AFileName: string; Mode: Word;
  Rights: Cardinal);
begin
  // Initialize with 8 blocks of 4096 bytes
  InitializeCache(TSTREAMCACHEPAGE_SIZE_DEFAULT,TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT);
  inherited Create(AFileName,Mode,Rights);
  FCacheStreamSize:=inherited Seek(int64(0),soEnd);
end;

function TBufferedFileStream.Read(var Buffer; Count: Longint): Longint;
begin
  Result:=DoCacheRead(Buffer,Count);
end;

function TBufferedFileStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result:=DoCacheWrite(Buffer,Count);
end;

procedure TBufferedFileStream.Flush;
begin
  WriteDirtyPages;
end;

function TBufferedFileStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  Result:=Seek(int64(OffSet),TSeekOrigin(Origin));
end;

function TBufferedFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var
  lNewOffset: int64;
begin
  Case Origin of
    soEnd:
      begin
        lNewOffset:=FCacheStreamSize+Offset;
      end;
    soBeginning:
      begin
        lNewOffset:=0+Offset;
      end;
    soCurrent:
      begin
        lNewOffset:=FCacheStreamPosition+Offset;
      end;
  end;
  if lNewOffset>0 then begin
    FCacheStreamPosition:=lNewOffset;
    Result:=lNewOffset;
  end else begin
    // This is compatible with FPC stream
    // as it returns the negative value :-?
    // but in fact does not move the read pointer.
    Result:=-1;
  end;
end;

procedure TBufferedFileStream.InitializeCache(const aCacheBlockSize: integer;
  const aCacheBlockCount: integer);
var
  j: integer;
begin
  ClearCache;
  FStreamCachePageSize:=aCacheBlockSize;
  FStreamCachePageMaxCount:=aCacheBlockCount;
  FCacheStreamSize:=inherited Seek(0,soEnd);
  SetLength(FCachePages,FStreamCachePageMaxCount);
  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
    FCachePages[j]:=New(PStreamCacheEntry);
    FillByte(FCachePages[j]^,Sizeof(PStreamCacheEntry^),0);
  end;
end;

destructor TBufferedFileStream.Destroy;
begin
  ClearCache;
  inherited Destroy;
end;

end.

ubufferedfilestream.pas (19,291 bytes)

José Mejuto

2016-09-02 18:06

reporter  

ubufferedfilestreamt1.pas (12,508 bytes)
unit ubufferedfilestreamt1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpcunit, testregistry,
  ubufferedfilestream;

type

  { TTestBufferedFileStream }

  TTestBufferedFileStream= class(TTestCase)
  private
  const
    TEST_RANDOM_READS=10000;
    TEST_SEQUENTIAL_READS=1000000;
    TEST_FILENAME='testfile.bin';
    TEST_WRITEC_FILE='testwritecache.bin';
    TEST_WRITEF_FILE='testwritedirec.bin';
  private
    function CompareStreams(const aStream1: TStream; const aStream2: TStream): Boolean;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCacheRead;
    procedure TestCacheWrite;
    procedure TestCacheSeek;
  end;

implementation

procedure TTestBufferedFileStream.TestCacheRead;
var
  lBufferedStream: TBufferedFileStream;
  lStream: TFileStream;
  b: array [0..10000-1] of char;
  j,k: integer;
  lBytesToRead: integer;
  lEffectiveRead: integer;
  {$IFDEF CHECK_AGAINST_FILE}
  lEffectiveRead2: integer;
  {$ENDIF}
  lReadPosition: int64;
  lCheckInitV: integer;
  lTick: QWord;
begin
  b[0]:=#0; // Avoid initalization hint
  lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
  lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
  try
    RandSeed:=1;
    Randomize;
    lTick:=GetTickCount64;
    for j := 0 to Pred(TEST_RANDOM_READS) do begin
      lBytesToRead:=Random(10000);
      lReadPosition:=Random(lBufferedStream.Size);
      lBufferedStream.Position:=lReadPosition;

      lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);

      {$IFDEF CHECK_AGAINST_FILE}
      // Now read without cache
      lStream.Position:=lReadPosition;
      lEffectiveRead2:=lStream.Read(b2,lBytesToRead);
      if lEffectiveRead<>lEffectiveRead2 then begin
        FAIL('Read length mismatch');
      end;
      if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin
        FAIL('Compare buffer data error');
      end;
      F.Position:=0;
      {$ELSE}
      lCheckInitV:=lReadPosition mod 10;
      for k := 0 to Pred(lEffectiveRead) do begin
        if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
          FAIL('Expected data error');
        end;
        inc(lCheckInitV);
      end;
      {$ENDIF}
    end;
    writeln('CACHE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.');

    RandSeed:=1;
    Randomize;

    writeln('Same operation without cache');
    lTick:=GetTickCount64;
    for j := 0 to Pred(TEST_RANDOM_READS) do begin
      lBytesToRead:=Random(10000);
      lReadPosition:=Random(lBufferedStream.Size);

      lStream.Position:=lReadPosition;
      lEffectiveRead:=lStream.Read(b,lBytesToRead);

      lCheckInitV:=lReadPosition mod 10;
      for k := 0 to Pred(lEffectiveRead) do begin
        if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
          FAIL('Expected data error');
        end;
        inc(lCheckInitV);
      end;
    end;
    writeln('FILE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.');

    writeln('Check sequential read');

    RandSeed:=1;
    Randomize;
    lTick:=GetTickCount64;
    lBytesToRead:=1;
    lReadPosition:=0;
    lBufferedStream.Position:=lReadPosition;
    lStream.Position:=lReadPosition;
    for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin

      lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);

      {$IFDEF CHECK_AGAINST_FILE}
      // Now read without cache
      lEffectiveRead2:=lStream.Read(b2,lBytesToRead);
      if lEffectiveRead<>lEffectiveRead2 then begin
        FAIL('Read length mismatch');
      end;
      if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin
        FAIL('Compare buffer data error');
      end;
      F.Position:=0;
      {$ELSE}
      lCheckInitV:=lReadPosition mod 10;
      for k := 0 to Pred(lEffectiveRead) do begin
        if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
          FAIL('Expected data error');
        end;
        inc(lCheckInitV);
      end;
      {$ENDIF}
      inc(lReadPosition,lBytesToRead);
    end;
    writeln('CACHE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.');

    RandSeed:=1;
    Randomize;
    lTick:=GetTickCount64;
    lBytesToRead:=1;
    lReadPosition:=0;
    lStream.Position:=lReadPosition;
    for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin

      lEffectiveRead:=lStream.Read(b,lBytesToRead);

      lCheckInitV:=lReadPosition mod 10;
      for k := 0 to Pred(lEffectiveRead) do begin
        if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
          FAIL('Expected data error');
        end;
        inc(lCheckInitV);
      end;
      inc(lReadPosition,lBytesToRead);
    end;
    writeln('FILE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.');

    writeln('CACHE Trying read beyond limits');
    lBufferedStream.Position:=lBufferedStream.Size-1;
    lEffectiveRead:=lBufferedStream.Read(b,2);
    if lEffectiveRead<>1 then begin
      FAIL('Read beyond limits, returned bytes: '+inttostr(lEffectiveRead));
    end else begin
      Writeln('CACHE OK, read beyond limits returns 0 bytes.');
    end;
  finally
    lBufferedStream.Free;
    lStream.Free;
  end;
end;

procedure TTestBufferedFileStream.TestCacheWrite;
const
  EXPECTED_SIZE=10000000;
  TEST_ROUNDS=100000;
var
  lBufferedStream: TBufferedFileStream;
  lStream: TFileStream;
  lVerifyStream1,lVerifyStream2: TFileStream;
  b: array [0..10000-1] of char;
  j: integer;
  lBytesToWrite: integer;
  lWritePosition: int64;
begin
  writeln('Testing write cache');
  // All test should return the same random sequence
  RandSeed:=1;
  Randomize;
  for j := 0 to Pred(10000) do begin
    b[j]:='0';
  end;
  lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmCreate);
  lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmCreate);
  try
    for j := 0 to Pred(EXPECTED_SIZE div Sizeof(b)) do begin
      lBufferedStream.Write(b,sizeof(b));
      lStream.Write(b,sizeof(b));
    end;
    for j := 0 to Pred(Sizeof(b)) do begin
      b[j]:=char(ord('0')+j mod 10);
    end;
  finally
    lBufferedStream.Free;
    lStream.Free;
  end;
  lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmOpenReadWrite);
  lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenWrite);
  try
    for j := 0 to Pred(TEST_ROUNDS) do begin
      if lStream.Size<>lBufferedStream.Size then begin
        FAIL('Mismatched lengths');
      end;
      lWritePosition:=Random(EXPECTED_SIZE);
      lBytesToWrite:=Random(sizeof(b));
      lBufferedStream.Position:=lWritePosition;
      lStream.Position:=lWritePosition;
      lBufferedStream.Write(b,lBytesToWrite);
      lStream.Write(b,lBytesToWrite);
      if j mod 1273 = 0 then write(j,' / ',TEST_ROUNDS,#13);
    end;
    writeln(TEST_ROUNDS,' / ',TEST_ROUNDS);
    if lStream.Size<>lBufferedStream.Size then begin
      FAIL('Mismatched lengths');
    end;
  finally
    lBufferedStream.Free;
    lStream.Free;
  end;

  // Verify both generated files are identical.
  lVerifyStream1:=TFileStream.Create(TEST_WRITEC_FILE,fmOpenRead or fmShareDenyWrite);
  lVerifyStream2:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenRead or fmShareDenyWrite);
  try
    if not CompareStreams(lVerifyStream1,lVerifyStream2) then begin
      FAIL('Streams are different!!');
    end else begin
      writeln('Streams are identical. OK.');
    end;
  finally
    lVerifyStream1.Free;
    lVerifyStream2.Free;
  end;
end;

procedure TTestBufferedFileStream.TestCacheSeek;
var
  lBufferedStream: TBufferedFileStream;
  lStream: TFileStream;
  bBuffered: array [0..10000] of BYTE;
  bStream: array [0..10000] of BYTE;
begin
  bBuffered[0]:=0; // Avoid initalization hint
  bStream[0]:=0; // Avoid initalization hint
  lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
  lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
  try
    writeln('Set position=-1');
    lStream.Position:=-1;
    writeln('TFileStream position=',lStream.Position);
    lBufferedStream.Position:=-1;
    writeln('Buffered    position=',lBufferedStream.Position);
    if lStream.Position<>lBufferedStream.Position then begin
      FAIL('Positions are not the same.');
    end else begin
      writeln('Positions are the same.');
    end;

    writeln('Read data when position=-1');
    writeln('TFileStream read bytes  : ',lStream.Read(bBuffered[0],10));
    writeln('TFileStream end position: ',lStream.Position);
    writeln('Buffered      read bytes: ',lBufferedStream.Read(bStream[0],10));
    writeln('Buffered    end position: ',lBufferedStream.Position);
    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
      FAIL('Read data or positions are not the same.');
    end else begin
      writeln('Read data at -1 is the same.');
    end;

    writeln('Testing Seek operations');
    writeln('Seek -1 from beginning');
    writeln('Stream seek result  : ',lStream.Seek(-1,soBeginning));
    writeln('Buffered seek result: ',lBufferedStream.Seek(-1,soBeginning));

    writeln('Read data when Seek -1');
    writeln('TFileStream read bytes  : ',lStream.Read(bBuffered[0],10));
    writeln('TFileStream end position: ',lStream.Position);
    writeln('Buffered      read bytes: ',lBufferedStream.Read(bStream[0],10));
    writeln('Buffered    end position: ',lBufferedStream.Position);
    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
      FAIL('Read data or positions are not the same.');
    end else begin
      writeln('Read data at -1 is the same.');
    end;

    writeln('Seek -current*2 from current');
    writeln('Stream seek result  : ',lStream.Seek(lStream.Position*-2,soCurrent));
    writeln('Buffered seek result: ',lBufferedStream.Seek(lBufferedStream.Position*-2,soCurrent));
    writeln('Read data when Seek from current -current*2');
    writeln('TFileStream read bytes  : ',lStream.Read(bBuffered[0],10));
    writeln('TFileStream end position: ',lStream.Position);
    writeln('Buffered      read bytes: ',lBufferedStream.Read(bStream[0],10));
    writeln('Buffered    end position: ',lBufferedStream.Position);
    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
      FAIL('Read data or positions are not the same.');
    end else begin
      writeln('Read data at -current*2 is the same.');
    end;
  finally
    lBufferedStream.Free;
    lStream.Free;
  end;
end;

procedure TTestBufferedFileStream.SetUp;
var
  F: TFileStream;
  b: array [0..10000-1] of char;
  j: integer;
begin
  for j := 0 to Pred(10000) do begin
    b[j]:=char(ord('0')+j mod 10);
  end;
  F:=TFileStream.Create(TEST_FILENAME,fmCreate);
  for j := 0 to Pred(1000) do begin
    F.Write(b,sizeof(b));
  end;
  F.Free;
end;

procedure TTestBufferedFileStream.TearDown;
begin
  DeleteFile(TEST_FILENAME);
  DeleteFile(TEST_WRITEC_FILE);
  DeleteFile(TEST_WRITEF_FILE);
end;

function TTestBufferedFileStream.CompareStreams(const aStream1: TStream;
  const aStream2: TStream): Boolean;
const
  BUFFER_SIZE=5213; // Odd number
var
  b1: array [0..BUFFER_SIZE-1] of BYTE;
  b2: array [0..BUFFER_SIZE-1] of BYTE;
  lReadBytes: integer;
  lAvailable: integer;
  lEffectiveRead1: integer;
  lEffectiveRead2: integer;
begin
  b1[0]:=0; // Avoid initalization hint
  b2[0]:=0; // Avoid initalization hint
  Result:=false;
  if aStream1.Size<>aStream2.Size then exit;
  aStream1.Position:=0;
  aStream2.Position:=0;
  while aStream1.Position<aStream1.Size do begin
    lAvailable:=aStream1.Size-aStream1.Position;
    if lAvailable>=BUFFER_SIZE then begin
      lReadBytes:=BUFFER_SIZE;
    end else begin
      lReadBytes:=aStream1.Size-aStream1.Position;
    end;
    lEffectiveRead1:=aStream1.Read(b1[0],lReadBytes);
    lEffectiveRead2:=aStream2.Read(b2[0],lReadBytes);
    if lEffectiveRead1<>lEffectiveRead2 then exit;
    if not CompareMem(@b1[0],@b2[0],lEffectiveRead1) then exit;
  end;
  Result:=true;
end;

initialization

  RegisterTest(TTestBufferedFileStream);
end.

ubufferedfilestreamt1.pas (12,508 bytes)

rd0x

2019-03-20 16:27

reporter   ~0114942

any news about implementing it?

Michael Van Canneyt

2019-03-20 16:41

administrator   ~0114943

I will look at entering it in the streamex unit this weekend.

Don Siders

2019-03-20 20:27

reporter   ~0114946

I was curious how it differed from TBufStream, TWriteBufStream, and TReadBufStream in fcl. Obviously intended for a different purpose.

Given it's nature and focus, I would have named it TCachedFileStream.

Michael Van Canneyt

2019-03-20 20:43

administrator   ~0114947

Indeed. Either that or TPagedFileStream

rd0x

2019-03-20 21:25

reporter   ~0114948

I found this report because I was searching for Delphi's TBufferedFileStream (http://docwiki.embarcadero.com/Libraries/Rio/en/System.Classes.TBufferedFileStream) in FPC

Michael Van Canneyt

2019-03-20 22:09

administrator   ~0114949

This implementation is far bigger than what the classes unit needs. Hence I thought to keep it separate, and create a reduced implementation with only a single page for the classes unit.

José Mejuto

2019-03-21 11:12

reporter   ~0114957

I wrote this cache FileStream because I need it to access 3 or 4 file positions in a semi-random style, so simple Buffered stream slows down operations instead speedup. Before I wrote it I was looking for a BufferedFileStream and found it in Delphi but no in FPC so I named it TBufferedFileStream as in Delphi, but both of you are right, it should be named TCachedFileStream and a TBufferedFileStream written around TBufStream with read and write procedures in the same class.

From my side you can mark as resolved and drop it to the recycle bin :-)

Michael Van Canneyt

2019-03-21 11:35

administrator   ~0114958

Recycle bin, why ? The class has reasons to exist.

As you correctly point out, for random access, TBufferedFileStream will cause a slowdown... TBufferedStream is good for linear access.

Thaddy de Koning

2019-03-21 11:50

reporter   ~0114959

Last edited: 2019-03-21 11:51

View 2 revisions

I may be wrong, but what he wants is a windowed stream, not a buffered stream, I guess. But the implementation for it is not correct for random access. A windowed stream pattern would solve this partially.
There should be one in KOL as an example (I wrote it).

Michael Van Canneyt

2019-09-02 09:25

administrator   ~0117914

I added the class to the bufstream unit, which already contains a linear read/write buffer. Added the testcase too.

Thanks for the contribution !

Issue History

Date Modified Username Field Change
2016-09-02 18:05 José Mejuto New Issue
2016-09-02 18:05 José Mejuto File Added: ubufferedfilestream.pas
2016-09-02 18:06 José Mejuto File Added: ubufferedfilestreamt1.pas
2016-09-03 22:12 Michael Van Canneyt Assigned To => Michael Van Canneyt
2016-09-03 22:12 Michael Van Canneyt Status new => assigned
2019-03-20 16:27 rd0x Note Added: 0114942
2019-03-20 16:41 Michael Van Canneyt Note Added: 0114943
2019-03-20 20:27 Don Siders Note Added: 0114946
2019-03-20 20:43 Michael Van Canneyt Note Added: 0114947
2019-03-20 21:25 rd0x Note Added: 0114948
2019-03-20 22:09 Michael Van Canneyt Note Added: 0114949
2019-03-21 11:12 José Mejuto Note Added: 0114957
2019-03-21 11:35 Michael Van Canneyt Note Added: 0114958
2019-03-21 11:50 Thaddy de Koning Note Added: 0114959
2019-03-21 11:51 Thaddy de Koning Note Edited: 0114959 View Revisions
2019-09-02 09:25 Michael Van Canneyt Status assigned => resolved
2019-09-02 09:25 Michael Van Canneyt Resolution open => fixed
2019-09-02 09:25 Michael Van Canneyt Fixed in Version => 3.3.1
2019-09-02 09:25 Michael Van Canneyt Fixed in Revision => 42901
2019-09-02 09:25 Michael Van Canneyt FPCTarget => 3.2.0
2019-09-02 09:25 Michael Van Canneyt Note Added: 0117914