A few words about reading data caching and smart pointers

    I don’t think that I’ll be very mistaken if I say that most readers of this article have a folder on their computer that stores the code that is later used in combat projects. These are small pieces of algorithms that test the very possibility of realizing an idea. I call them "nishtyachki."

    The more a programmer works on his tasks, the more this daddy will swell. So mine has already climbed beyond seven hundred different demo examples.

    But the problem is that in 99 percent of cases all these "nishtyachki" are written to the table, and only the owner of this folder knows about the existence of such practices, and in fact there are sometimes whole bins of ideas, implementation approaches, algorithmic tricks, and simply stopped on the take-off of thoughts that it’s not a sin to share (and suddenly someone takes and develops an approach).

    In this article I will share three best practices that came out of just such “folders with nishtyaks” and have been used in our military projects for more than a year.
    There will be a little assembler - but do not be alarmed, it is there only in the form of an information component.

    Let's start with caching

    I’m unlikely to reveal the secret that reading bytes from a file is bad.

    Well, that means - it’s bad, but it works, and it doesn’t give errors, but the brakes ... The cylinder heads are already scalding like scalded ones, trying to give all the sufferers the data they need, and here we are with our reading of one byte from the file.

    And why do we even read exactly one byte?
    If we ignore the load on the file system a bit and imagine that the file we are reading looks like: “a byte containing the size of the data block + data block, then again a byte containing the size of the data block + data block” - then everything is absolutely logical. In this case, we execute the only true logic, read the prefix containing the size and the data block itself, and then repeat until we hit the end of the file.

    Conveniently? There can even be no questions - of course it is convenient.

    And what do we really have to do to get away from the brakes when reading:
    1. Read immediately a large amount of data into a temporary buffer;
    2. Real reads should already be made from a temporary buffer;
    3. And if there is not enough data in the temporary buffer, again read them from the file and take into account offsets and other related things;

    And such a mess with manual caching in a whole bunch of project places where you need to work with files.

    Not comfortable? Of course it’s inconvenient, I want the same simplicity as in the first version.

    Having comprehended the essence of the problem, our team was born out of the following idea: since working with data goes through the heirs from TStream (TFileStream, TWinHTTHStream, TWinFTPStream) - then can we write a caching proxy on the stream itself? Well, why not, we are not the first to take, for example, the same TStreamAdapter from System.Classes as a sample, which acts as a layer between IStream and abstract TStream.
    A convenient thing, by the way, is I advise.

    Our proxy is made in the form of a banal heir from TStream, so using it you can absolutely freely control the work with data from any other heir of this class.

    In general, the implementation of such proxy streams is quite common. For example, if you omit the TStreamAdapter, you most likely will know such classes as TZCompressionStream and TZDecompressionStream from the ZLib module, which provide a very convenient way to compress and decompress data stored in any arbitrary TStream descendant. Yes, I used to dabble in this before, having implemented a fairly convenient proxy in the form of the TFWZipItemStream class , which, passing all the data through itself, makes its editing “on the fly” and before the heap considers the checksum of all the data passed through it.

    Therefore, having adopted the experience already gained, the TBufferedStream class was born, but as a clarification about working with it, a comment was immediately attached to the class declaration: "// like buffered reading from a stream. ReadOnly !!!"

    But, before starting to study the code of this class, let's write a small console application that measures the load on the application when using various versions of the heirs from TStream, according to the speed of code execution.

    As PayLoad functionality, we will do the following - calculate the offsets for the resource section of each library located in the system directory (GetSystemDirectory) and note the time spent on execution using TBufferedStream, then TFileStream, and finally, TMemoryStream.

    Such a sequence of tests was chosen in order to level the influence of the file system cache, i.e. TBufferedStream will work with uncached data, and the next two tests will (should) be executed much faster due to repeated access to cached (file system) data.

    Who do you think will win?


    First, we need a function that builds a list of files that will be worked on:

    functionGetSystemRootFiles: TStringList;
      Path: string;
      SR: TSearchRec;
      Result := TStringList.Create;
      SetLength(Path, MAX_PATH);
      GetSystemDirectory(@Path[1], MAX_PATH);
      Path := IncludeTrailingPathDelimiter(PChar(Path));
      if FindFirst(Path + '*.dll', faAnyFile, SR) = 0thentryrepeatif SR.FindData.nFileSizeLow > 1024 * 1024 * 2then
            Result.Add(Path + SR.Name);
        until FindNext(SR) <> 0;

    An instance of TStringList is created in it and filled with paths to libraries that are larger than two megabytes in size (enough for a demo).

    The next function will be the general body kit over the start of each test with time measurement, also simple, in fact:
    functionMakeTest(AData: TStringList; StreamType: TStreamClass): DWORD;
      TotalTime: DWORD;
      I: Integer;
      AStream: TStream;
      Writeln(StreamType.ClassName, ': ');
      AStream := nil;
      TotalTime := GetTickCount;
      tryfor I := 0to AData.Count - 1dobeginif StreamType = TBufferedStream then
            AStream := TBufferedStream.Create(AData[I],
              fmOpenRead or fmShareDenyWrite, $4000);
          if StreamType = TFileStream then
            AStream := TFileStream.Create(AData[I], fmOpenRead or fmShareDenyWrite);
          if StreamType = TMemoryStream thenbegin
            AStream := TMemoryStream.Create;
          Write('File: "', AData[I], '" CRC = ');
        Result := GetTickCount - TotalTime;

    PayLoad functionality itself is moved to the common_payload.pas module and looks like the CalcResOffset procedure.
    procedureCalcResOffset(AData: TStream; ReleaseStream: Boolean);var
      IDH: TImageDosHeader;
      NT: TImageNtHeaders;
      Section: TImageSectionHeader;
      I, A, CRC, Size: Integer;
      Buff: array [0..65] of Byte;
    begintry// читаем ImageDosHeader
        AData.ReadBuffer(IDH, SizeOf(TImageDosHeader));
        // смотрим по сигнатуре, что не ошиблись и работаем с правильным файломif IDH.e_magic <> IMAGE_DOS_SIGNATURE thenbegin
          Writeln('Invalid DOS header');
        // прыгаем на начало PE заголовка
        AData.Position := IDH._lfanew;
        // читаем его
        AData.ReadBuffer(NT, SizeOf(TImageNtHeaders));
        // смотрим по сигнатуре, что не ошиблись и работаем с правильным файломif NT.Signature <> IMAGE_NT_SIGNATURE thenbegin
          Writeln('Invalid NT header');
        // делаем "быструю" проверку на наличие секции ресурсовif NT.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress = 0thenbegin
          Writeln('Resource section not found');
        // "прыгаем" в начало списка секций
        AData.Position :=
          IDH._lfanew + SizeOf(TImageFileHeader) + 4 + Nt.FileHeader.SizeOfOptionalHeader;
        // перечисляем их до тех пор...for I := 0to NT.FileHeader.NumberOfSections - 1dobegin
          AData.ReadBuffer(Section, SizeOf(TImageSectionHeader));
          // ...пока не встретим секцию ресурсовif PAnsiChar(@Section.Name[0]) = '.rsrc'thenbegin// а когда найдем ее - сразу "прыгаем" на ее начало
            AData.Position := Section.PointerToRawData;
        // "полезная нагрузка" (PayLoad) - суммируем все байты секции ресурсов// типа контрольная сумма :)
        CRC := 0;
        Size := Section.SizeOfRawData div SizeOf(Buff);
        for I := 0to Size - 1dobegin
          AData.ReadBuffer(Buff[0], SizeOf(Buff));
          for A := Low(Buff) to High(Buff) do
            Inc(CRC, Buff[A]);
      finallyif ReleaseStream then

    It was too lazy to come up with something complicated, clearly demonstrating the need to read the file in pieces, so I decided to stop working with sections of the PE file.

    The objective of this procedure is to calculate the address of the resource section (.rsrc) of the file transferred to it (in the form of a stream) and simply calculate the sum of all bytes placed in this section.

    It immediately shows two, necessary for work, reading the data buffer (DOS header and PE header), after which there is an exit to the resource section, from which data is read in pieces of 64 bytes and summed with the result.
    PS: yes, I am aware that the data from the section is not considered as a whole, because reading goes in blocks and the last, not a multiple of 64 bytes, is not considered, but that's an example.

    Let's run this trouble with this code:
      S: TStringList;
      A, B, C: DWORD;
        S := GetSystemRootFiles;
        try//A := MakeTest(S, TBufferedStream);
          B := MakeTest(S, TFileStream);
          C := MakeTest(S, TMemoryStream);
          //Writeln('TBufferedStream = ', A);
          Writeln('TFileStream = ', B);
          Writeln('TMemoryStream = ', C);
      excepton E: Exception do
          Writeln(E.ClassName, ': ', E.Message);

    We look at the result (in the picture the results from TBufferedStream are already included):

    TFileStream, as expected, fell far behind, but TMemoryStream showed a result very close to the results of TBufferedStream, which we have not yet considered.

    It's okay, the fact is that he did it with a big overhead from memory, because he had to load every library into the application’s memory (drawdown), but he caught up with the speed just for the same reason (avoiding the need to read data from the disk frequently).

    And now TBufferedStream itself:
    TBufferedStream = class(TStream)
      FStream: TStream;
      FOwnership: TStreamOwnership;
      FPosition: Int64;
      FBuff: arrayof byte;
      FBuffStartPosition: Int64;
      FBuffSize: Integer;
      functionGetBuffer_EndPosition: Int64;
      procedureSetBufferSize(Value: Integer);protectedproperty Buffer_StartPosition: Int64 read FBuffStartPosition;
      property Buffer_EndPosition: Int64 read GetBuffer_EndPosition;
      functionBuffer_Read(var Buffer; Size: LongInt): Longint;
      functionBuffer_Update: Boolean;
      functionBuffer_Contains(APosition: Int64): Boolean;
    publicconstructorCreate(AStream: TStream; AOwnership: TStreamOwnership = soReference);overload;
      constructorCreate(const AFileName: string; Mode: Word; ABuffSize: Integer = 1024 * 1024);overload;
      functionRead(var Buffer; Count: Longint): Longint; override;
      functionWrite(const Buffer; Count: Longint): Longint; override;
      functionSeek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
      property BufferSize: Integer read FBuffSize write SetBufferSize;

    The public section is nothing unusual, all the same overlapped Read / Write / Seek, like any other proxy stream.

    The whole trick begins with this function:

    functionTBufferedStream.Read(var Buffer; Count: Longint): Longint;
      Readed: Integer;
      Result := 0;
      while Result < Count dobegin
        Readed := Buffer_Read(PAnsiChar(@Buffer)[Result], Count - Result);
        Inc(Result, Readed);
        if Readed = 0thenifnot Buffer_Update thenExit;

    As you can see from the code, we are trying to read the data by calling the Buffer_Read function, which returns it from the prepared cache, and if we couldn’t read it, we try to reinitialize the cache by calling Buffer_Update.

    The cache reinitialization looks like this:

    functionTBufferedStream.Buffer_Update: Boolean;
      FStream.Position := FPosition;
      FBuffStartPosition := FPosition;
      SetLength(FBuff, FBuffSize);
      SetLength(FBuff, FStream.Read(FBuff[0], FBuffSize));
      Result := Length(FBuff) > 0end;

    Those. we allocate memory for the cache, the size specified in the BufferSize property of the class, and then try to read data from the stream we control into the cache.

    If the data was read successfully, we correct the actual size of the cache (because if you wanted to count megabytes, but only 15 bytes are available, then we will free up unnecessary memory, why do we need extra?).

    The read operation from the cache is just as simple:

    functionTBufferedStream.Buffer_Read(var Buffer; Size: LongInt): Longint;
      Result := 0;
      ifnot Buffer_Contains(FPosition) thenExit;
      Result := Buffer_EndPosition - FPosition + 1;
      if Result > Size then
        Result := Size;
      Move(FBuff[Integer(FPosition - Buffer_StartPosition)], Buffer, Result);
      Inc(FPosition, Result);

    Just check the current position of the stream and make sure that we really store the necessary data available on this offset, after which the banal Move throws the data to an external buffer.

    The remaining methods of this class are too trivial, so I won’t consider them, they can be found in demo examples in the archive for the article: " . \ Src \ bufferedstream \ "

    What ultimately turns out:
    1. The TBufferedStream class has a much smaller (at times) overhead in terms of data reading speed than TFileStream, due to the cache implemented in it. The number of data read operations from the disk (which in itself is a fairly "heavy operation") has been significantly reduced.
    2. For the same reason, the speed overhead is much less than TMemoryStream, because only the necessary data is read into the cache, and not the entire file.
    3. Memory overhead is significantly lower than TMemoryStream, for obvious reasons. Of course, in this case, TFileStream will win in terms of memory costs, but, again, speed ...
    4. The class provides an easy-to-use layer that allows you not to think about the lifetime of the stream it controls and preserves all the functionality necessary for work.


    Then move on to the second part.


    But imagine that the data we want to read is already located in the memory of our application. In order not to overcomplicate, let us dwell on the same libraries discussed in the first part of the article. To perform the same work that was shown in the CalcResOffset function, we need to somehow transfer the library data to some TStream successor (for example, the same TMemoryStream).

    And what will we do in this case?
    In 99 percent of cases, create a TMemoryStream and call the Write (WriteBuffer) function.
    But is this normal, because in fact we simply copy the data that we already have? And after all, we will do this for one single reason - in order to be able to work with data through the usual TStream.

    To fix this superfluous overhead from memory, such a simple class was developed here:

    typeTOnMemoryStream = class(TCustomMemoryStream)
      ///Работаем на уже выделенном блоке памяти.///Писать можем только в случае режима not ReadOnly, и только не выходя за пределы буфераprivate
        FReadOnly: Boolean;
      protectedprocedureSetSize(NewSize: Longint);override;
      publicconstructorCreate(Ptr: Pointer; Size: Longint; ReadOnlyMode: Boolean = True);functionWrite(const Buffer; Count: Longint): Longint; override;
        property ReadOnly: Boolean read FReadOnly write FReadOnly;
    implementation{ TOnMemoryStream }constructorTOnMemoryStream.Create(Ptr: Pointer; Size: Longint; ReadOnlyMode: Boolean = True);begininherited Create;
      SetPointer(Ptr, Size);
      FReadOnly := ReadOnlyMode;
    functionTOnMemoryStream.Write(const Buffer; Count: Longint): Longint;
      Pos: Longint;
    beginif (Position >= 0) and (Count >= 0) and
        (not ReadOnly) and (Position + Count <=Size) thenbegin
        Pos := Position + Count;
        Move(Buffer, Pointer(Longint(Memory) + Position)^, Count);
        Position := Pos;
        Result := Count;
        Result := 0;
    procedureTOnMemoryStream.SetSize(NewSize: Longint);beginraise Exception.Create('TOnMemoryStream.SetSize can not be called.');

    I don’t even know what can be added to this code as a comment, so let's just see how to work with this class.

    program onmemorystream_demo;
    {$APPTYPE CONSOLE}{$R *.res}uses
      common_payload in'..\common\common_payload.pas',
      OnMemoryStream in'OnMemoryStream.pas';
      M: TOnMemoryStream;
        M := TOnMemoryStream.Create(
          1024 * 1024 * 8{позволяем читать данные в пределах 8 мегабайт});
          CalcResOffset(M, False);
      excepton E: Exception do
          Writeln(E.ClassName, ': ', E.Message);

    Everything is simple here - look for the address of the loaded NTDLL.DLL and read its resource section directly from memory, using all the advantages of the stream (and you do not need to copy anything to a temporary buffer.

    Now a few comments on using the class.

    In general, it is very nice if you only use it in data reading operations, but ... as the code shows, it does not prohibit writing data to the memory block it controls, and this can lead to big troubles.We

    can easily overwrite the data critical for the application to work, and then go to the banal AV, therefore, in our projects, using this feature of the class is minimized (literally rebuilding search indexes in the right places on a pre-allocated buffer - it's just that simple).

    By the way, it was for this reason that we refused to use Friendly classes, which allow access to the TCustomMemoryStream.SetPointer call, because in this case, the recording will not be controlled by anyone at all, which may lead to a good such “bad boom” in the end.

    The source code of the class and example can be viewed in the archive: " .src \ onmemorystream \ "

    However, we will move on to the final part of the article.

    A special case of a smartpoiner - SharedPtr

    Now I will teach the bad.

    Let's see how it is customary to work with objects in Delphi. Usually it looks like this:

      T: TObject;
      T := TObject.Create;
      try// работаем с Тfinally

    Beginners in the language, of course, forget about using the finalization section, rolling out pearls like this:

    T := TObject.Create;
    // работаем с Т

    And even then, forgetting about the need to free an object, they don’t tell the Free object.
    Some "advanced beginners" manage to implement even such a "govnokod"

      T := TObject.Create;
      // работаем с Тfinally

    And once I met and with such an implementation:

      T := TObject.Create;
      // работаем с Т

    Well, a man tried - you can see right away.
    However, let's still focus on the first version of the correct code.
    The minus is the following - if we need to work with several classes at the same time, we will have to significantly deploy the code due to the multiple use of the finalization sections:

      T1, T2, T3: TObject;
      T1 := TObject.Create;
        T2 := TObject.Create;
          T3 := TObject.Create;
          try// работаем со всеми тремя экземплярами Т1/Т2/Т3finally

    There is, of course, an option, a little dubious and not used by me, but recently quite often found on the Internet:

    T1 := nil;
    T2 := nil;
    T3 := nil;
      T1 := TObject.Create;
      T2 := TObject.Create;
      T3 := TObject.Create;
      // работаем со всеми тремя экземплярами Т1/Т2/Т3finally

    Due to the initial initialization of each object in this case, an error will not occur when calling Free an object that has not yet been created (if an exception is raised in the constructor of the previous one), but anyway - it looks too doubtful.

    And what do you look at if I say that the call to the Free method can be omitted altogether?
    Yes, yes, just create an object and forget about the fact that it needs to be destroyed.

    What does it look like? Yes, like this:

    T := TObject.Create;
    // работаем с Т

    Well, of course, right here in this form it cannot be done without Memlik - well, we don’t have a garbage collector and other things, but do not rush to say: “Sanya - you are crazy!” ... because you can take the idea from other programming languages ​​and implement it in our , "Great and mighty."

    And we will take the idea from SharedPtr: we look at the documentation .

    The logic of this class is simple - control the lifetime of an object by counting references to it. Fortunately, we can do this - we have such a mechanism, it is called interfaces.

    But not so simple.

    Of course, from a snap, you can roll out such an idea - we implement IUnknown support in the class and everything, as soon as the reference counter to the class instance reaches zero, it will collapse.
    But we can only do this with our own written classes, and what to do with the same TMemoryStream, which has all this feng shui on the drum, because it does not know about the interfaces?

    The most logical is to write another proxy, which will keep a link to the object it controls and will implement reference counting in itself, and upon destruction, the object entrusted to it will crash.

    But here, too, not everything is so rosy. We’ll write a proxy, and what’s written there - the idea has already been voiced, but there will be a big drawdown both in memory and in the speed of working with the class if it uses the classical interface with all the attendants as a link counting mechanism.

    Therefore, we will approach the solution of the problem from the technical side and look at the disadvantages of implementation through the interface:
    program slowsharedptr;
    {$APPTYPE CONSOLE}{$R *.res}uses
    typeTObjectDestroyer = class(TInterfacedObject)
        FObject: TObject;
      publicconstructorCreate(AObject: TObject);destructorDestroy;override;
      TSharedPtr = recordprivate
        FDestroyerObj: TObjectDestroyer;
        FDestroyer: IUnknown;
      publicconstructorCreate(const AValue: TObject);end;
    { TObjectDestroyer }constructorTObjectDestroyer.Create(AObject: TObject);begininherited Create;
      FObject := AObject;
    { TSharedPtr }constructorTSharedPtr.Create(const AValue: TObject);begin
      FDestroyerObj := TObjectDestroyer.Create(AValue);
      FDestroyer := FDestroyerObj;
      I: Integer;
      T: DWORD;
      ReportMemoryLeaksOnShutdown := True;
        T := GetTickCount;
        for I := 0to $FFFFFF do
        Writeln(GetTickCount - T);
      excepton E: Exception do
          Writeln(E.ClassName, ': ', E.Message);

    The time spent on executing this code will be around 3525 milliseconds (remember this number).

    The bottom line: the main logic is released by the TObjectDestroyer class, which works with reference counting and destroys the object passed to it for storage. TSharedPtr - a structure through which the correct work with links occurs at the moment when it goes out of scope (of course, in this case, it can be done without this structure, but ...).
    If you run the example, you will see that the created objects will be destroyed before the application terminates (however, if this were not the case, you would clearly have been informed about this because the ReportMemoryLeaksOnShutdown flag has been set).

    But let's take a closer look - where can there be an overhead that we do not need (both in memory and in speed of execution).

    Well, firstly - TObjectDestroyer.InstanceSize is 20.
    Heh, we get an extra 20 bytes of memory for each object we control, and given that the granularity of the memory manager in Delphi is 12 bytes, then not 20 bytes are lost, but all 24. Think little things? It may be so - but our version should go out (and will be) exactly 12 bytes, because if you remove the overhead, this is the whole thing.

    The second problem is the excessive overhead when calling interface methods.
    Let's remember what the VMT looks like in an object that implements an interface.
    An object's VMT begins with virtual methods of the object itself, including the overlapping methods of the interface, and these overlapping methods do not belong to the interface.
    And only VMT methods of the interface itself follow them, when called, they are redirected (using the CompilerMagic constant, calculated for each interface at the compilation stage) to the real code.

    This can be seen by visually executing the following code:

    constructorTSharedPtr.Create(const AValue: TObject);var
      I: IUnknown;
      FDestroyerObj := TObjectDestroyer.Create(AValue);
      I := FDestroyerObj;

    If you look at the assembler listing, we will see the following:

    slowsharedptr.dpr.51: I._AddRef;
    004D3C73 8B45F4           mov eax,[ebp-$0c]
    004D3C76 50               push eax
    004D3C77 8B00             mov eax,[eax]
    004D3C79 FF5004           call dword ptr [eax+$04] // нас интересует вот этот вызов
    slowsharedptr.dpr.52: I._Release;
    004D3C7C 8B45F4           mov eax,[ebp-$0c]
    004D3C7F 50               push eax
    004D3C80 8B00             mov eax,[eax]
    004D3C82 FF5008           call dword ptr [eax+$08] // и вот этот вызов

    ... which lead to:

    004021A3 83442404F8       add dword ptr [esp+$04],-$08// выход на VMT объекта004021A8 E93FB00000       jmp TInterfacedObject._AddRef

    in the first case, and in the second on:

    004021AD 83442404F8       add dword ptr [esp+$04],-$08// выход на VMT объекта004021B2 E951B00000       jmp TInterfacedObject._Release

    If we inherited in TObjectDestroyer not from IUnknown, but, for example, from IEnumerator, then the compiler would automatically correct the exit addresses for the VMT object in approximately the following way:

    004D3A4B 83442404F0       add dword ptr [esp+$04],-$10// было 8, стало 16004D3A50 E9CB97F3FF       jmp TInterfacedObject._AddRef
    004D3A55 83442404F0       add dword ptr [esp+$04],-$10// т.к. добавились еще несколько функций004D3A5A E9DD97F3FF       jmp TInterfacedObject._Release

    It is through such a jump that the compiler calls the _AddRef and _Release methods when the reference counter changes (for example, when an interface is assigned a new variable, or when it goes out of scope).

    Therefore, now we will conquer all this trouble and write our own interface.

    So we write:

    PObjectDestroyer = ^TObjectDestroyer;
    TObjectDestroyer = recordstrictprivateclassvar VTable: array[0..2] of Pointer;
      classfunctionQueryInterface(Self: PObjectDestroyer; 
        const IID: TGUID; out Obj): HResult; stdcall; static;
      classfunction _AddRef(Self: PObjectDestroyer): Integer; stdcall; static;
      classfunction _Release(Self: PObjectDestroyer): Integer; stdcall; static;
      FVTable: Pointer;
      FRefCount: Integer;
      FObj: TObject;
    publicclassfunctionCreate(AObj: TObject): IUnknown; static;

    Think this is a record type structure?
    Nope - this is the most that object, with its own VMT located in VTable and exactly 12 bytes in size:

    FVTable: Pointer;
    FRefCount: Integer;
    FObj: TObject;

    Now actually the “magic” itself.

    VMT initialization occurs in the following method:

      VTable[0] := @QueryInterface;
      VTable[1] := @_AddRef;
      VTable[2] := @_Release;

    Everything is according to the canons, and Delphi will not even suspect any trick here, because for her it will be an absolutely valid VMT, implemented in accordance with all laws and rules.

    Well, the main constructor looks like this:

    classfunctionTObjectDestroyer.Create(AObj: TObject): IUnknown;
      P: PObjectDestroyer;
    beginif AObj = nilthenExit(nil);
      GetMem(P, SizeOf(TObjectDestroyer));
      P^.FVTable := @VTable;
      P^.FRefCount := 0;
      P^.FObj := AObj;
      Result := IUnknown(P);

    Through GetMem, we allocate space under the InstanceSize of our “supposedly” class, despite the fact that it is actually a structure, after which we initialize the required fields as a pointer to VMT, a reference counter, and a pointer to an object controlled by the class.
    Moreover, we immediately bypass the overhead on the InitInstance call and the associated load.
    Pay attention - the result of calling the constructor is the IUnknown interface.

    Hack? Of course.
    Works? Of course.

    The implementation of the QueryInterface, _AddRef and _Release methods is taken from the standard TIntefacedObject and is not interesting. However, QueryInterface in this approach is essentially redundant, but since we decided to do everything according to the classics, and assume that some kind of “crazy programmer” will still try to pull this method, then we will leave it in its proper place (especially since it and so it should go first in the VMT interface. Well, do not leave a garbage pointer instead?).

    Now let's take a little walk on the structure with which we provided control over links:

    TSharedPtr<T: class> = recordprivate
      FPtr: IUnknown;
      functionGetValue: T; inline;
    publicclassfunctionCreate(AObj: T): TSharedPtr<T>; static; inline;
      classfunctionNull: TSharedPtr<T>; static;
      property Value: T read GetValue;
      functionUnwrap: T;

    The constructor has changed a bit:

    classfunctionTSharedPtr<T>.Create(AObj: T): TSharedPtr<T>;
      Result.FPtr := TObjectDestroyer.Create(AObj);

    However, the essence of this has not changed.
    A new method has been added, through which it will be possible to gain access to the object controlled by our shareware:

    functionTSharedPtr<T>.GetValue: T;
    beginif FPtr = nilthenExit(nil);
      Result := T(PObjectDestroyer(FPtr)^.FObj);

    Well, two utilitarian procedures, the first of which simply reduces the number of links:

    classfunctionTSharedPtr<T>.Null: TSharedPtr<T>;
      Result.FPtr := nil;

    And the second disconnects the object controlled by the class from all this mechanism:

    functionTSharedPtr<T>.Unwrap: T;
    beginif FPtr = nilthenExit(nil);
      Result := T(PObjectDestroyer(FPtr).FObj);
      PObjectDestroyer(FPtr).FObj := nil;
      FPtr := nil;

    Now let's see - why do you need all this?
    Consider the situation:
    For example, we created a certain instance of the class that TObjectDestroyer monitors and gave it out, what will happen in this case?
    That's right - as soon as the execution of the code of the procedure in which the object was created is completed, it will be immediately destroyed and the external code will work with the already killed pointer.

    It is for this purpose that the TSharedPtr class was introduced, through which it is possible to “skip” data on the procedures of our application, without fear of premature destruction of the object. As soon as it really becomes useless for anyone - TObjectDestroyer will crash it instantly and everyone will be nirvana.

    But that is not all.

    Having twisted implementation of TSharedPtr we nevertheless came to the conclusion that it is not entirely successful. And you know why?
    And because such a constructor code seemed to us too redundant:


    Yeah - that’s exactly how it should be called, but in order not to frighten programmers unprepared for such happiness, we decided to add a small wrapper of such a plan:

      TSharedPtr = recordpublicclassfunctionCreate<T:class>(AObj: T): TSharedPtr<T>; static; inline;
    classfunctionTSharedPtr.Create<T>(AObj: T): TSharedPtr<T>;
      Result.FPtr := TObjectDestroyer.Create(AObj);

    After which everything became much more pleasant, and the call of the sharepenter began to look much more familiar, and similar to creating a previously voiced proxy:


    However, enough to rant and look at the drawdown in time (and it, of course, will be):

    We write the code:
    program sharedptr_demo;
    {$APPTYPE CONSOLE}{$R *.res}uses
      StaredPtr in'StaredPtr.pas';
      Count = $FFFFFF;
      I: Integer;
      Start: Cardinal;
      Obj: TObject;
      Start := GetTickCount;
      for I := 0to Count - 1dobegin
        Obj := TObject.Create;
        try// do nothing...finally
      Writeln(PChar('TObject: ' + (GetTickCount - Start).ToString()));
      I: Integer;
      Start: Cardinal;
      Start := GetTickCount;
      for I := 0to Count - 1do
      Writeln(PChar('AutoDestroy: ' + (GetTickCount - Start).ToString()));
      I: Integer;
      Start: Cardinal;
      Start := GetTickCount;
      for I := 0to Count - 1do
      Writeln(PChar('SharedPtr: ' + (GetTickCount - Start).ToString()));
      excepton E: Exception do
          Writeln(E.ClassName, ': ', E.Message);

    And look what happened:

    In the first version of the sharepointer, there was a delay of 3525 milliseconds, the new version is the number 2917 - they tried for nothing, it turns out.
    However - what kind of AutoDestroy is it, which overtook the ball protector by a whole second?

    This is a helper, and this is bad.
    Bad, because this helper is implemented on TObject:

      TObjectHelper = classhelperfor TObject
      publicfunctionAutoDestroy: IUnknown; inline;
    { TObjectHelper }functionTObjectHelper.AutoDestroy: IUnknown;
      Result := TObjectDestroyer.Create(Self);

    The fact is that, at least in XE4, the conflict with overlapping helpers is still not defeated, i.e. if you have your own helper over TStream and you try to connect TObjectHelper to it in a couple - the project will not work out.
    I don’t know if this problem was solved in XE7, but it is definitely present in the four, and for this reason we do not use this piece of code, although it is much more productive than using the TSharedPtr structure.

    Now let's look at the penultimate moment, which I talked about above, namely, about implementing a jump on VMT, for this we will write two simple procedures:

      I: IUnknown;
      I := TInterfacedObject.Create;

    At the very beginning, I mentioned that using the simplest TSharedPtr in the very first example is a bit redundant. Yes, this is so, in that case you could just remember the interface link in a local variable (which TSharedPtr essentially does, though in a slightly different way);

    So, let's see what happens in this version of the code:

    1. Creating an object and initializing the interface:

    sharedptr_demo.dpr.60: I := TInterfacedObject.Create;
    004192BB B201             mov dl,$01004192BD A11C1E4000       mov eax,[$00401e1c]
    004192C2 E899C5FEFF       call TObject.Create
    004192C7 8BD0             mov edx,eax
    004192C9 85D2             test edx,edx
    004192CB 7403             jz $004192d0
    004192CD 83EAF8           sub edx,-$08004192D0 8D45FC           lea eax,[ebp-$04]
    004192D3 E8C801FFFF       call @IntfCopy

    2. Calling up the finalization section:

    sharedptr_demo.dpr.61: end;
    004192D8 33C0             xor eax,eax
    004192DA 5A               pop edx
    004192DB 59               pop ecx
    004192DC 59               pop ecx
    004192DD 648910           mov fs:[eax],edx
    004192E0 68F5924100       push $004192f5
    004192E5 8D45FC           lea eax,[ebp-$04]
    004192E8 E89B01FFFF       call @IntfClear // <<< нас интересует вот этот вызов004192ED C3               ret

    3. After that, the control is transferred to @IntfClear, where the previously announced jump awaits us:

    00401DE1 83442404F8       add dword ptr [esp+$04],-$0800401DE6 E951770000       jmp TInterfacedObject._Release

    And what happens in the use of TObjectDestroyer?


    1. Creating an object and creating the TObjectDestroyer itself:

    sharedptr_demo.dpr.66: TObjectDestroyer.Create(TObject.Create);
    004D3C27 B201             mov dl,$01004D3C29 A184164000       mov eax,[$00401684]
    004D3C2E E89945F3FF       call TObject.Create
    004D3C33 8D55FC           lea edx,[ebp-$04]
    004D3C36 E8B5FBFFFF       call TObjectDestroyer.Create

    Yes, there is an overhead, superfluous action, after all. However, what about the destruction?

    2. Everything is very simple:

    sharedptr_demo.dpr.67: end;
    004D3C3B 33C0             xor eax,eax
    004D3C3D 5A               pop edx
    004D3C3E 59               pop ecx
    004D3C3F 59               pop ecx
    004D3C40 648910           mov fs:[eax],edx
    004D3C43 68583C4D00       push $004d3c58
    004D3C48 8D45FC           lea eax,[ebp-$04]
    004D3C4B E8DC92F3FF       call @IntfClear
    004D3C50 C3               ret

    Almost identical to the first option.
    But the most interesting thing will happen when @IntfClear is called, it will skip excess VMT jumps and transfer control immediately to the class function TObjectDestroyer._Release.
    As a result, we saved on the call of two instructions (add and jmp), but unfortunately this is by far the least that can be done, because in case of using a proxy, overhead costs are simply not inevitable.

    In conclusion, it remains only to see how to use the mechanism of automatic destruction of an object in practice:

    For example, create a file stream and write some constant into it:

      F: TFileStream;
      ConstData: DWORD;
      ConstData := $DEADBEEF;
      F := TFileStream.Create('data.bin', fmCreate);
      F.WriteBuffer(ConstData, SizeOf(ConstData));

    Yes, that’s all - the life time of the stream is controlled, and no excessive feeble efforts are required.
    In this case, the TSharedPtr structure is not used, because There is no need to pass a pointer between code sections and TObjectDestroyer functionality is sufficient.

    Now let's read the value of the constant from the file and display it, and right away we will look at the data transfer between the procedures.

    This is how we create the object controlled by the sharepoint:

    functionCreateReadStream: TSharedPtr<TFileStream>;
      Result := TSharedPtr.Create(TFileStream.Create('data.bin',
        fmOpenRead or fmShareDenyWrite));

    And so we get data from this object:

      F: TSharedPtr<TFileStream>;
      ConstData: DWORD;
      F := CreateReadStream;
      F.Value.ReadBuffer(ConstData, SizeOf(ConstData));
      Writeln(IntToHex(ConstData, 8));

    As you can see, the code has not changed much when compared with the classical approach to software development.

    Pros - the need to use TRY..FINALLY blocks has disappeared, the code has become less overloaded in volume.

    Cons - a small overhead in speed and the designers have expanded a bit, forcing us to call TSharedPtr.Create each time (in the case of transferring data to the external) or TObjectDestroyer to control the lifetime.
    Also, an additional parameter Value has appeared, through which you can access the controlled object in the case of using TSharedPtr, but it's easy enough to get used to it, especially since this is all that dolphies can do in terms of syntactic sugar.

    Although I still dream that there will be a DEFAULT method of the object (or a property of an enumerated type) that can be called without specifying its name by simply accessing the class variable, then we would declare the Value property of the TSharedPtr class default and work with the base object, even not knowing that he is under the control of a proxy :)


    There is only one conclusion - I got tired of painting all this.

    But seriously, all three of the above approaches are quite convenient, in fact, and I use the first two almost everywhere.

    With TSharedPtr, of course, I'm cautious.

    Do not think that it is bad - for another reason. I still (over so many years of practice) feel uncomfortable observing the code without using the finalization sections, although I, of course, understand with the back cerebellum that all this will work as it should - but ... it’s not usual.

    Therefore, I use TSharedPtr only in a few special cases - when you need to let an object go free into an external code that I do not control, although my colleagues hold a slightly different point of view and use it quite often (of course, not everywhere, because you see for yourself that its main minus - double drawdown in speed, as retribution for ease of use).

    And on this, perhaps, I am rounded off.

    Check your bins - share, because there certainly is something useful.

    The source code for demos is available at this link .

    Also popular now: