Черновик. Написать о том как использование "шаблонов" и "примесей" избавляет от "косвенности" и лишнего распределения памяти

Написать о том как использование "шаблонов" и "примесей" избавляет от "косвенности" и лишнего распределения памяти.

На примере Tm3HeaderStream.

Можно ведь так:

type
 TA = class
  private
   fData : Pointer;
  private
   procedure AllocData;
  protected
   function DataSize: Integer; virtual; abstract;
 end;//TA

...

 TC = record
  ...
 end;//TC

 TB = class(TA)
  protected
   function DataSize: Integer; override;
 end;//TB

...

procedure TA.AllocData;
begin
 GetMem(fData, DataSize);
end;
...

function TB.DataSize: Integer; override;
begin
 Result := SizeOf(TC);
end;

А можно так:

type
 TA<T> = class
  private
   fData : T;
 end;/TA

...

 TC = record
  ...
 end;/TC

 TB = class(TA<TC>)
 end;//TB

Мне кажется, что второй вариант - "вкуснее".

Смежные темы:

- Абстрактные контейнеры
- Абстрактные контейнеры. Часть 2
- Пояснение про контейнеры
- Выводим конкретные атомарные контейнеры из абстрактных
- Конкретные контейнеры. Часть 2
- Стандартная библиотека шаблонов
- Коротко. САМОЕ удивительное знание, которое я вынес из книг о программировании
- ToDo. Написать про массивы, списки и итераторы
- Про скрипты, итераторы и обработку исключений. Черновик

Старый код Tm3HeaderStream:

type
        Tm3CustomHeaderStream=    class(Tm3CustomStream)
         {* Поток с заголовком-идентификатором. }
         private


          _Status:                LongWord;


                function          InitProc00000001    (const ABitMask: LongWord
                                                      ): LongWord;

                procedure         DoneProc00000001    (
                                                      );


                function          InitProc00000002    (const ABitMask: LongWord
                                                      ): LongWord;

                procedure         DoneProc00000002    (
                                                      );


                function          InitProc00000004    (const ABitMask: LongWord
                                                      ): LongWord;

                procedure         DoneProc00000004    (
                                                      );


                function          InitProc00000008    (const ABitMask: LongWord
                                                      ): LongWord;

                procedure         DoneProc00000008    (
                                                      );


                function          InitProc00000010    (const ABitMask: LongWord
                                                      ): LongWord;

                procedure         DoneProc00000010    (
                                                      );


         protected


                procedure         CreateContext       (
                                                      ); override;


         private
          FHeaderData:            Pointer;
          FHeaderDataCompare:     Pointer;
          FHeaderDataSize:        LongInt;

          FHeaderFullSize:        LongInt;

          FHeaderSize:            LongInt;

          FHeaderLoaded:          LongInt;
          FHeaderLocked:          LongInt;


         protected
           procedure Cleanup;
                  override;
                  {-}


                property          _HeaderData: Pointer read FHeaderData;


                function          InitHeaderData      (
                                                      ): Pointer; virtual; abstract;

                function          InitHeaderDataSize  (
                                                      ): LongInt; virtual; abstract;

                function          InitHeaderFullSize  (
                                                      ): LongInt; virtual; abstract;


                procedure         DefaultInitAction   (
                                                      ); virtual;

                procedure         DefaultDoneAction   (
                                                      ); virtual;


                procedure         Read                (ABuff: Pointer;
                                                       ASize: LongInt;
                                                       var   AResult: LongInt;
                                                       var   AReturn: HRESULT
                                                      ); override;

                procedure         Write               (ABuff: Pointer;
                                                       ASize: LongInt;
                                                       var   AResult: LongInt;
                                                       var   AReturn: HRESULT
                                                      ); override;


                procedure         Seek                (AOffset       : Int64;
                                                       AOrigin       : TSeekOrigin;
                                                       var   AResult : Int64;
                                                       var   AReturn : HRESULT
                                                      ); override;


                procedure         SetSize             (ASize: Int64;
                                                       var   AReturn: HRESULT
                                                      ); override;


                procedure         LockRegion          (AOffset: Int64;
                                                       ASize: Int64;
                                                       ALockType: LongInt;
                                                       var   AReturn: HRESULT
                                                      ); override;

                procedure         UnlockRegion        (AOffset: Int64;
                                                       ASize: Int64;
                                                       ALockType: LongInt;
                                                       var   AReturn: HRESULT
                                                      ); override;


          function pm_GetSize: Int64;
            override;
            {-}

      function pm_GetLocksSupported: Longint;
        override;
        {-}
      procedure StatStgName(var   AResult : PWideChar;
                            var   AReturn : HRESULT);
        override;
        {-}

         public


          class function          HeaderID            (
                                                      ): TCLSID; virtual; abstract;


                constructor       Create              (const AStream: IStream;
                                                       const AAccess: LongInt
                                                      );
                  {* - создает поток c заголовком вокруг потока aStream. }                                    

                procedure         LoadHeader          (
                                                      );
                  {* - загружает заголовок в память. }                                    

                procedure         SaveHeader          (const AForcedSave: LongBool = False
                                                      );
                  {* - сохраняет заголовок. }


                procedure         LockHeader          (
                                                      );
                  {* - закрывает заголовок. }                                    

                procedure         UnlockHeader        (
                                                      );
                  {* - открывает заголовок. }                                    


         end;//Tm3CustomHeaderStream
...
// start class Tm3CustomHeaderStream

function Tm3CustomHeaderStream.InitProc00000001(const ABitMask: LongWord): LongWord;
begin
 {$IfDef m3UseL3Memory}
 m3HeaderBuffers^.AllocItem(FHeaderData, FHeaderFullSize, InitHeaderData, FHeaderDataSize);
 {$Else  m3UseL3Memory}
 m2MEMAllocBuff(FHeaderData,FHeaderFullSize,InitHeaderData,FHeaderDataSize);
 {$EndIf m3UseL3Memory}
 Result:=ABitMask;
end;

procedure Tm3CustomHeaderStream.DoneProc00000001;
begin
 {$IfDef m3UseL3Memory}
 m3HeaderBuffers^.FreeItem(FHeaderData);
 {$Else  m3UseL3Memory}
 m2MEMFree(FHeaderData);
 {$EndIf m3UseL3Memory}
end;

function Tm3CustomHeaderStream.InitProc00000002(const ABitMask: LongWord): LongWord;
begin
 if not ReadOnly then
 {$IfDef m3UseL3Memory}
  m3HeaderBuffers^.AllocItem(FHeaderDataCompare, FHeaderFullSize, InitHeaderData, FHeaderDataSize);
 {$Else  m3UseL3Memory}
  m2MEMAllocBuff(FHeaderDataCompare,FHeaderFullSize,InitHeaderData,FHeaderDataSize);
 {$EndIf m3UseL3Memory}
 Result:=ABitMask;
end;

procedure Tm3CustomHeaderStream.DoneProc00000002;
begin
 {$IfDef m3UseL3Memory}
 m3HeaderBuffers^.FreeItem(FHeaderDataCompare);
 {$Else  m3UseL3Memory}
 m2MEMFree(FHeaderDataCompare);
 {$EndIf m3UseL3Memory}
end;

function Tm3CustomHeaderStream.InitProc00000004(const ABitMask: LongWord): LongWord;
begin
 {$IFDEF _m3AUTOCREATEHEADER1}
 if (_Stream <> nil) then begin
  LockHeader;
  try
   if (m2COMGetSize(_Stream) = 0) then begin
    Assert(m2COMCheckAccess(m2COMModeAccess(m2COMGetStatStgMode(_Stream)),STGM_WRITE));
    FHeaderLoaded:=1;
    SaveHeader(True);
   end;//m2COMGetSize(_Stream) = 0
  finally
   UnlockHeader;
  end;
 end;//_Stream <> nil
 {$ENDIF}
 Result:=ABitMask;
end;

procedure Tm3CustomHeaderStream.DoneProc00000004;
begin
end;

function Tm3CustomHeaderStream.InitProc00000008(const ABitMask: LongWord): LongWord;
begin
 DefaultInitAction;
 Result:=ABitMask;
end;

procedure Tm3CustomHeaderStream.DoneProc00000008(
                                                  );
begin
 DefaultDoneAction;
end;

function Tm3CustomHeaderStream.InitProc00000010(const ABitMask: LongWord): LongWord;
begin
 if (_Stream <> nil) AND (m2COMGetStatStgMode(_Stream) AND STGM_WRITE = 0) then
  m2COMSetPosition(Int64(FHeaderSize),_Stream);
 Result:=ABitMask;
end;

procedure Tm3CustomHeaderStream.DoneProc00000010;
begin
end;

procedure Tm3CustomHeaderStream.CreateContext;
begin
 inherited;
 FHeaderDataSize:=InitHeaderDataSize;
 FHeaderFullSize:=InitHeaderFullSize;
 FHeaderSize:=CAnyGUIDLength+SizeOf(LongInt)+SizeOf(FHeaderFullSize)+FHeaderFullSize;
end;

procedure Tm3CustomHeaderStream.DefaultInitAction;
begin
 LoadHeader;
end;

procedure   Tm3CustomHeaderStream.DefaultDoneAction;
begin
 SaveHeader;
end;

procedure   Tm3CustomHeaderStream.Read(ABuff: Pointer;
                                       ASize: LongInt;
                                       var   AResult: LongInt;
                                       var   AReturn: HRESULT
                                      );
begin
 if SUCCEEDED(AReturn) then
  AReturn:=_Stream.Read(ABuff,ASize,@AResult);
end;

procedure   Tm3CustomHeaderStream.Write(ABuff: Pointer;
                                        ASize: LongInt;
                                        var   AResult: LongInt;
                                        var   AReturn: HRESULT
                                       );
begin
 if SUCCEEDED(AReturn) then
  AReturn:=_Stream.Write(ABuff,ASize,@AResult);
end;

procedure Tm3CustomHeaderStream.Seek(AOffset     : Int64;
                                     AOrigin     : TSeekOrigin;
                                     var AResult : Int64;
                                     var AReturn : HRESULT);
var
 LOffset : Int64;
begin
 if SUCCEEDED(AReturn) then
 begin
  if (AOrigin = soBeginning) then
   LOffset:=AOffset+Int64(FHeaderSize)
  else
  if (AOrigin = soEnd) then
  begin
   Assert(false, 'Если это всплывёт, то можно этот Assert временно закомментирровать');
   LOffset := AOffset;
  end//AOrigin = soEnd
  else
   LOffset := AOffset;
  AResult:=m2COMSeek(_Stream,LOffset,Ord(AOrigin))-Int64(FHeaderSize);
 end;//SUCCEEDED(AReturn)
end;

procedure Tm3CustomHeaderStream.SetSize(ASize: Int64;
                                        var   AReturn: HRESULT);
begin
 if SUCCEEDED(AReturn) then
  AReturn:=_Stream.SetSize(ASize+Int64(FHeaderSize));
end;

procedure Tm3CustomHeaderStream.LockRegion(AOffset: Int64;
                                           ASize: Int64;
                                           ALockType: LongInt;
                                           var   AReturn: HRESULT);
begin
 if SUCCEEDED(AReturn) then
  AReturn:=_Stream.LockRegion(Int64(FHeaderSize)+AOffset,ASize,ALockType);
end;

procedure Tm3CustomHeaderStream.UnlockRegion(AOffset: Int64;
                                             ASize: Int64;
                                             ALockType: LongInt;
                                             var   AReturn: HRESULT);
begin
 if SUCCEEDED(AReturn) then
  AReturn:=_Stream.UnlockRegion(Int64(FHeaderSize)+AOffset,ASize,ALockType);
end;

function Tm3CustomHeaderStream.pm_GetSize: Int64;
  //override;
  {-}
begin
 Result:=m2COMGetStatStgSize(_Stream)-Int64(FHeaderSize);
end;

function Tm3CustomHeaderStream.pm_GetLocksSupported: Longint;
  //override;
  {-}
begin
 Result:=m2COMGetStatStgLocks(_Stream);
end;

procedure Tm3CustomHeaderStream.StatStgName(var   AResult : PWideChar;
                                            var   AReturn : HRESULT);
  //override;
  {-}
begin
 if SUCCEEDED(AReturn) then
  try
   aResult := m2COMGetStatStgName(_Stream);
  except
   on E: EOleSysError do aReturn := E.ErrorCode;
  end;//try..except
end;

constructor Tm3CustomHeaderStream.Create(const AStream: IStream;
                                         const AAccess: LongInt);
begin
 inherited;
 m2InitOperation(_Status,InitProc00000001($00000001));
 m2InitOperation(_Status,InitProc00000002($00000002));
 m2InitOperation(_Status,InitProc00000004($00000004));
 m2InitOperation(_Status,InitProc00000008($00000008));
 m2InitOperation(_Status,InitProc00000010($00000010));
end;

procedure Tm3CustomHeaderStream.Cleanup;
begin
 m2DoneOperation(_Status,$00000010,DoneProc00000010);
 m2DoneOperation(_Status,$00000008,DoneProc00000008);
 m2DoneOperation(_Status,$00000004,DoneProc00000004);
 m2DoneOperation(_Status,$00000002,DoneProc00000002);
 m2DoneOperation(_Status,$00000001,DoneProc00000001);
 inherited;
 FHeaderData := nil;//            Pointer;
 FHeaderDataCompare := nil;//     Pointer;
 FHeaderDataSize := 0;//        LongInt;

 FHeaderFullSize := 0;//        LongInt;

 FHeaderSize := 0;//            LongInt;

 FHeaderLoaded := 0;//          LongInt;
 FHeaderLocked := 0;//         LongInt;
 _Status := 0;
end;

procedure Tm3CustomHeaderStream.LoadHeader(
                                            );
var
 LBodyCRC        : LongInt;
 LHeaderID       : AnsiString;
 LHeaderFullSize : LongInt;
 LPosition       : Int64;
begin
 if (FHeaderLoaded = 0) then
 begin
  if (_Stream <> nil) AND (m2COMGetStatStgMode(_Stream) AND STGM_WRITE = 0) then
  begin
   // - мы не можем считать Header - значит он уже должен быть у нас
   LPosition:=m2COMGetPosition(_Stream);
   try
    m2COMSetPosition(0,_Stream);

    m2COMCLSIDFromStream(_Stream,LHeaderID);
    m2COMReadBuffer(_Stream,LBodyCRC,SizeOf(LBodyCRC));

    m2COMReadBuffer(_Stream,LHeaderFullSize,SizeOf(LHeaderFullSize));
    m2CheckValue((LHeaderID = GUIDToString(HeaderID)) and
                 (LHeaderFullSize = FHeaderFullSize));

    m2COMReadBuffer(_Stream,FHeaderData^,FHeaderFullSize);
   finally
    m2COMSetPosition(LPosition,_Stream);
   end;//try..finally
   m2MEMCopy(FHeaderDataCompare,FHeaderData,FHeaderDataSize);
  end;//_Stream <> nil..
 end;//FHeaderLoaded = 0
 Inc(FHeaderLoaded);
end;

procedure Tm3CustomHeaderStream.SaveHeader(const AForcedSave: LongBool);
var
 LBodyCRC  : LongInt;
 LPosition : Int64;
 l_Fake    : Int64;
begin
 Dec(FHeaderLoaded);
 if (FHeaderLoaded = 0) AND (_Stream <> nil) AND not ReadOnly then
 begin
  if AForcedSave or
     (m2MEMCompare(FHeaderData,FHeaderDataCompare,FHeaderDataSize) <> 0) then
  begin
     m2MEMCopy(FHeaderDataCompare,FHeaderData,FHeaderDataSize);
   LPosition:=m2COMGetPosition(_Stream);
   try
    LBodyCRC := 0;
    if AForcedSave then
    begin
     if l3IFail(_Stream.Seek(0, STREAM_SEEK_SET, l_Fake)) then
      Exit;
     m2COMCLSIDToStream(_Stream,GUIDToString(HeaderID));
    end//AForcedSave
    else
    if l3IFail(_Stream.Seek(CAnyGUIDLength, STREAM_SEEK_SET, l_Fake)) then
     Exit;
    m2COMWriteBuffer(_Stream,LBodyCRC,SizeOf(LBodyCRC));
    m2COMWriteBuffer(_Stream,FHeaderFullSize,SizeOf(FHeaderFullSize));
    m2COMWriteBuffer(_Stream,FHeaderData^,FHeaderFullSize);
   finally
    _Stream.Seek(lPosition, STREAM_SEEK_SET, l_Fake);
   end;//try..finally
  end;//AForcedSave..
 end;//FHeaderLoaded = 0..
end;

procedure Tm3CustomHeaderStream.LockHeader;
begin
 if ((FHeaderLocked = 0) and m2COMIsLocksSupported(_Stream)) then
  m2COMTimeLock(_Stream,CAnyGUIDLength,Int64(FHeaderSize)-CAnyGUIDLength);
 Inc(FHeaderLocked);
end;

procedure Tm3CustomHeaderStream.UnlockHeader;
begin
 Dec(FHeaderLocked);
 if ((FHeaderLocked = 0) and m2COMIsLocksSupported(_Stream)) then
  m2COMTimeUnlock(_Stream,CAnyGUIDLength,Int64(FHeaderSize)-CAnyGUIDLength);
end;
...

Новый код, я вскоре выложу.

Он НА ПОРЯДОК - короче и читабельнее.

Вот уж как "быдло-код" становится "просто кодом" (
- http://programmingmindstream.blogspot.ru/2014/08/blog-post_59.html
- http://programmingmindstream.blogspot.ru/2014/08/mindstream-firemonkey.html?showComment=1407782559954#c112802013383687686
- http://programmingmindstream.blogspot.ru/2014/08/di-service-locator.html
).