Инкапсуляция работы с памятью. Часть 1

Предыдущая серия была тут - http://18delphi.blogspot.com/2013/07/0.html

Теперь выделим работу с памятью во вспомогательный объект - Tl3PtrLoc.

Модель:

Код:

l3MemUtils.pas:

unit l3MemUtils;

//
// Библиотека "L3$Basic Concepts"
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Требования к низкоуровневым библиотекам::L3$Basic Concepts::MemoryUtils::Tl3MemUtils
//

interface

uses
  Refcounted
  ;

type
 Rl3MemUtils = class of Tl3MemUtils;

 Tl3MemUtils = class(TRefcounted)
 protected
 // protected methods
   class procedure CheckMaxes; virtual;
     {* Сигнатура метода CheckMaxes }
   class procedure StatMemAlloc(aSize: Integer;
     aL3: Boolean); virtual;
 public
 // public methods
   class procedure ReallocLocalMem(var P;
     NewSize: Cardinal);
     {* перераспределить кусок локальной памяти }
   class procedure FreeLocalMem(var P);
     {* освободить кусок локальной памяти }
 end;//Tl3MemUtils

var
   l3MemU : Rl3MemUtils = Tl3MemUtils;
var
   f_LocalMemUsed : Integer;

implementation

uses
  l3MemorySizeUtils
  ;

// start class Tl3MemUtils

class procedure Tl3MemUtils.ReallocLocalMem(var P;
  NewSize: Cardinal);
//#UC START# *51DD561502D9_51DD554C0205_var*
//#UC END# *51DD561502D9_51DD554C0205_var*
begin
//#UC START# *51DD561502D9_51DD554C0205_impl*
 Dec(f_LocalMemUsed, l3MemorySize(Pointer(P)));
 {$IfDef l3DirectUseSystemMemManager}
 if (Pointer(P) = nil) then
 begin
  l3MemU.StatMemAlloc(NewSize, true);
  Pointer(P) := SysGetMem(NewSize)
 end//Pointer(P) = nil
 else
 if (NewSize > 0) then
 begin
  l3MemU.StatMemAlloc(NewSize, true);
  Pointer(P) := SysReallocMem(Pointer(P), NewSize);
 end//NewSize > 0
 else
 begin
  SysFreeMem(Pointer(P));
  Pointer(P) := nil;
 end;//NewSize > 0
 {$Else  l3DirectUseSystemMemManager}
  System.ReallocMem(Pointer(P), NewSize);
 {$EndIf l3DirectUseSystemMemManager}
 Inc(f_LocalMemUsed, l3MemorySize(Pointer(P)));
 l3MemU.CheckMaxes;
//#UC END# *51DD561502D9_51DD554C0205_impl*
end;//Tl3MemUtils.ReallocLocalMem

class procedure Tl3MemUtils.FreeLocalMem(var P);
//#UC START# *51DD62110253_51DD554C0205_var*
//#UC END# *51DD62110253_51DD554C0205_var*
begin
//#UC START# *51DD62110253_51DD554C0205_impl*
 if (Pointer(P) <> nil) then
 begin
  Dec(f_LocalMemUsed, l3MemorySize(Pointer(P)));
  {$IfDef l3DirectUseSystemMemManager}
  SysFreeMem(Pointer(P));
  {$Else  l3DirectUseSystemMemManager}
  System.FreeMem(Pointer(P));
  {$EndIf l3DirectUseSystemMemManager}
 end;//Pointer(P) <> nil
 Pointer(P) := nil;
//#UC END# *51DD62110253_51DD554C0205_impl*
end;//Tl3MemUtils.FreeLocalMem

class procedure Tl3MemUtils.CheckMaxes;
//#UC START# *51DD686A03A3_51DD554C0205_var*
//#UC END# *51DD686A03A3_51DD554C0205_var*
begin
//#UC START# *51DD686A03A3_51DD554C0205_impl*
 // - ничего пока не делаем
//#UC END# *51DD686A03A3_51DD554C0205_impl*
end;//Tl3MemUtils.CheckMaxes

class procedure Tl3MemUtils.StatMemAlloc(aSize: Integer;
  aL3: Boolean);
//#UC START# *51DD6DCE00DF_51DD554C0205_var*
//#UC END# *51DD6DCE00DF_51DD554C0205_var*
begin
//#UC START# *51DD6DCE00DF_51DD554C0205_impl*
 // - ничего пока не делаем
//#UC END# *51DD6DCE00DF_51DD554C0205_impl*
end;//Tl3MemUtils.StatMemAlloc

end.

l3PtrLoc.pas:

unit l3PtrLoc;

//
// Библиотека "L3$Basic Concepts"
// Generated from UML model, root element: UtilityPack::Class Shared Delphi Требования к низкоуровневым библиотекам::L3$Basic Concepts::MemoryUtils::l3PtrLoc
//

interface

uses
  l3MemorySizeUtils
  ;

type
 Tl3PtrLoc = {$IfDef XE4}record{$Else}object{$EndIf}
 private
   f_AsPointer : PMem;
 public
    function Init(aSize: Integer): Boolean;
    function GetSize: Integer;
    procedure SetSize(aSize: Integer);
    procedure Clear;
    function Read(anOfs: Integer;
     aBuf: PMem;
     aBufSize: Integer): Integer;
    function Write(anOfs: Integer;
     aBuf: PMem;
     aBufSize: Integer): Integer;
  public
   property AsPointer: PMem
     read f_AsPointer;
 end;//Tl3PtrLoc

implementation

uses
  l3MemUtils
  ;

// start class Tl3PtrLoc

function Tl3PtrLoc.Init(aSize: Integer): Boolean;
//#UC START# *51DD5D1903C3_51DD567A01B5_var*
//#UC END# *51DD5D1903C3_51DD567A01B5_var*
begin
//#UC START# *51DD5D1903C3_51DD567A01B5_impl*
 f_AsPointer := nil;
 SetSize(aSize);
 Result := (f_AsPointer <> nil);
//#UC END# *51DD5D1903C3_51DD567A01B5_impl*
end;//Tl3PtrLoc.Init

function Tl3PtrLoc.GetSize: Integer;
//#UC START# *51DD5D3800F3_51DD567A01B5_var*
//#UC END# *51DD5D3800F3_51DD567A01B5_var*
begin
//#UC START# *51DD5D3800F3_51DD567A01B5_impl*
 Result := l3MemorySize(f_AsPointer);
//#UC END# *51DD5D3800F3_51DD567A01B5_impl*
end;//Tl3PtrLoc.GetSize

procedure Tl3PtrLoc.SetSize(aSize: Integer);
//#UC START# *51DD5D4F004A_51DD567A01B5_var*
//#UC END# *51DD5D4F004A_51DD567A01B5_var*
begin
//#UC START# *51DD5D4F004A_51DD567A01B5_impl*
 if (aSize = 0) then
  l3MemU.FreeLocalMem(f_AsPointer)
 else 
 if (GetSize < aSize) then
 begin
  // - раньше было <> - сейчас решил попробовать не уменьшать размер памяти
  //   дабы не плодить дефрагментацию.
  if (aSize < 10) then
   l3MemU.ReallocLocalMem(f_AsPointer, aSize)
  else
   l3MemU.ReallocLocalMem(f_AsPointer, (aSize + $F) and $FFFFFFF0);
 end;//GetSize < aSize
//#UC END# *51DD5D4F004A_51DD567A01B5_impl*
end;//Tl3PtrLoc.SetSize

procedure Tl3PtrLoc.Clear;
//#UC START# *51DD5D6F0304_51DD567A01B5_var*
//#UC END# *51DD5D6F0304_51DD567A01B5_var*
begin
//#UC START# *51DD5D6F0304_51DD567A01B5_impl*
 SetSize(0);
//#UC END# *51DD5D6F0304_51DD567A01B5_impl*
end;//Tl3PtrLoc.Clear

function Tl3PtrLoc.Read(anOfs: Integer;
  aBuf: PMem;
  aBufSize: Integer): Integer;
//#UC START# *51DD5E2203B0_51DD567A01B5_var*
//#UC END# *51DD5E2203B0_51DD567A01B5_var*
begin
//#UC START# *51DD5E2203B0_51DD567A01B5_impl*
 Result := 0;
 Assert(false, 'Не реализовано пока');
(* Result := Min(GetSize - anOfs, aBufSize);
 if (Result > 0) then
  l3Move((P + anOfs)^, aBuf^, Result)
 else
  Result := 0;*)
//#UC END# *51DD5E2203B0_51DD567A01B5_impl*
end;//Tl3PtrLoc.Read

function Tl3PtrLoc.Write(anOfs: Integer;
  aBuf: PMem;
  aBufSize: Integer): Integer;
//#UC START# *51DD5E5F02E1_51DD567A01B5_var*
(*var
 OldSize : Integer;
 NewSize : Integer;*)
//#UC END# *51DD5E5F02E1_51DD567A01B5_var*
begin
//#UC START# *51DD5E5F02E1_51DD567A01B5_impl*
 Result := 0;
 Assert(false, 'Не реализовано пока');
(* OldSize := GetSize;
 NewSize := Ofs + BufSize;
 if (NewSize > OldSize) then SetSize(NewSize);
 Result := BufSize;
 l3Move(Buf^, (P + Ofs)^, Result);*)
//#UC END# *51DD5E5F02E1_51DD567A01B5_impl*
end;//Tl3PtrLoc.Write

end.

Исходники - https://sourceforge.net/p/rumtmarc/code-0/17/tree/trunk/Blogger/STL.2/