热门标签 | HotTags
当前位置:  开发笔记 > 编程语言 > 正文

delphi,IOCP之内存分配池[1]

不费话上代码{******************************************************************************}{@UnitName

不费话上代码

 

{******************************************************************************}
{ @UnitName     : uVirtualMemPool.pas                                          }
{ @Project      : QsIOCP                                                       }
{ @Copyright    : -                                                            }
{ @Author       : 奔腾的心(7180001)                                            }
{ @Description  : 分页式虚拟内存管理                                           }
{ @FileVersion  : 1.0.0.0                                                      }
{ @CreateDate   : 2011-07-16                                                   }
{ @Comment      : -                                                            }
{ @LastUpdate   : 2011-07-20                                                   }
{******************************************************************************}
unit uVirtualMemPool;

interface

uses
  SysUtils, Windows;

type
  TVirtualMemPool = class;

  PSBTNode = ^TSBTNode;
  TSBTNode = record
    IsUse:          Boolean;
    count:          Cardinal;
    value:          Pointer;
    data:           Cardinal;
    size:           Cardinal;
    lch,rch:        PSBTNode;
  end;

  // 平衡二叉查找树SBT
  TSizeBalancedTree = class
  private
    VMPool:         TVirtualMemPool;
    // 节点数
    NodeCount:      Cardinal;
    // 根节点,空节点
    root,null:      PSBTNode;
    // 左旋转
    procedure lrotate(var x: PSBTNode); inline;
    // 右旋转
    procedure rrotate(var x: PSBTNode); inline;
    // 保持性质
    procedure maintain(var t: PSBTNode; const flag: Boolean); inline;
    // 增加
    procedure TreeAdd(var t: PSBTNode; v: PSBTNode); inline;
    // 移除
    function TreeRemove(var t: PSBTNode; var n: PSBTNode; v: Cardinal): Cardinal; inline;
    // 返回第 x 大的元素
    function TreeSelect(var t: PSBTNode; k: Cardinal; var r: Cardinal): Cardinal; inline;
    // 查找
    function TreeFind(var t: PSBTNode; v: Cardinal): Boolean; inline;
    // 排名
    function TreeRank(var t: PSBTNode; v: Cardinal): Cardinal; inline;
    // 向前,大
    function TreeSucc(var t: PSBTNode; v: Cardinal): Cardinal; inline;
    // 向后,小
    function TreePred(var t: PSBTNode; v: Cardinal): Cardinal; inline;
  public
    constructor Create(AVMpool: TVirtualMemPool);
    destructor Destroy; override;
    procedure add(v: PSBTNode);
    function remove(v: Cardinal): PSBTNode;
    function select(k: Cardinal): Cardinal; inline;
    function find(v: Cardinal): Boolean; inline;
    function rank(v: Cardinal): Cardinal; inline;
    function succ(v: Cardinal): Cardinal; inline;
    function pred(v: Cardinal): Cardinal; inline;
  end;

  // 内存管理
  TVirtualMemPool = class
  private
    m_VMLock:         TRTLCriticalSection;
    m_NMLock:         TRTLCriticalSection;
    m_PageSize:       Cardinal;
    m_Count:          Cardinal;
    m_UseHeightCount: Cardinal;
    m_lpBase:         Pointer;
    m_Buckets:        array of PSBTNode;
    m_SBTStorage:     TSizeBalancedTree;
  private
    function GetCount: Cardinal;
    function GetUseCount: Cardinal;
    function GetFreeCount: Cardinal;
    function GetUseHeightCount: Cardinal;
    procedure InitMemPool(ACount: Integer);
    procedure Clear;
  public
    property Count: Cardinal read GetCount;
    property UseCount: Cardinal read GetUseCount;
    property FreeCount: Cardinal read GetFreeCount;
    property UseHeightCount: Cardinal read GetUseHeightCount;
  public
    constructor Create(ACount: Integer);
    destructor Destroy; override;
  public
    function VMAlloc(dwSize: Cardinal; IsLock: Boolean = True): Pointer;
    function VMReAlloc(var P; dwSize: Cardinal): Pointer;
    function VMFree(var P; IsLock: Boolean = True): Boolean;
  end;

implementation

{ TSizeBalancedTree }
constructor TSizeBalancedTree.Create(AVMpool: TVirtualMemPool);
begin
  VMPool := AVMpool;
  NodeCount := 0;
  new(null);
  null^.data := Cardinal(-1);
  null^.size := 0;
  null^.lch := null;
  null^.rch := null;
  root := null;
end;

destructor TSizeBalancedTree.Destroy;
begin
  NodeCount := 0;
  Dispose(null);
  inherited Destroy;
end;

procedure TSizeBalancedTree.lrotate(var x: PSBTNode);
var
  y: PSBTNode;
begin
  y := x^.rch;
  x^.rch := y^.lch;
  y^.lch := x;
  y^.size := x^.size;
  x^.size := x^.lch^.size+x^.rch^.size+1;
  x := y;
end;

procedure TSizeBalancedTree.rrotate(var x: PSBTNode);
var
  y: PSBTNode;
begin
  y := x^.lch;
  x^.lch := y^.rch;
  y^.rch := x;
  y^.size := x^.size;
  x^.size := x^.lch^.size+x^.rch^.size+1;
  x := y;
end;

procedure TSizeBalancedTree.maintain(var t: PSBTNode; const flag: Boolean);
begin
  if t=null then
    exit;
  if not flag then
    if t^.lch^.lch^.size>t^.rch^.size then
      rrotate(t)
    else if t^.lch^.rch^.size>t^.rch^.size then
    begin
      lrotate(t^.lch);
      rrotate(t);
    end
    else
      exit
  else if t^.rch^.rch^.size>t^.lch^.size then
    lrotate(t)
  else if t^.rch^.lch^.size>t^.lch^.size then
  begin
    rrotate(t^.rch);
    lrotate(t);
  end
  else
    exit;
  maintain(t^.lch, false);
  maintain(t^.rch, true);
  maintain(t, false);
  maintain(t, true);
end;

procedure TSizeBalancedTree.TreeAdd(var t: PSBTNode; v: PSBTNode);
begin
  if v^.IsUse=False then
    Exit;
  if t=null then
  begin
    t := v;
    //进入的内存设置为未使用
    t^.IsUse := False;
    t^.count := 0;
    t^.size := 1;
    t^.lch := null;
    t^.rch := null;
    Inc(NodeCount);
  end
  else begin
    inc(t^.size);
    if v^.data      TreeAdd(t^.lch, v)
    else
      TreeAdd(t^.rch, v);
    maintain(t, v^.data>=t^.data);
  end;
end;

function TSizeBalancedTree.TreeRemove(var t: PSBTNode; var n: PSBTNode; v: Cardinal): Cardinal;
var
  tmp: PSBTNode;
begin
  //Result := Cardinal(-1);
  dec(t^.size);
  if(v=t^.data) or ((vt^.data) and (t^.rch=null)) then
  begin
    Result := t^.data;
    if(t^.lch=null) or (t^.rch=null) then
    begin
      if t^.lch=null then
      begin
        tmp := t;
        t := tmp^.rch;
        if tmp<>null then
        begin
          n := tmp;
          Dec(NodeCount);
          Exit;
        end;
      end;
      if t^.rch=null then
      begin
        tmp := t;
        t := tmp^.lch;
        if tmp<>null then
        begin
          n := tmp;
          Dec(NodeCount);
          Exit;
        end;
      end;
    end
    else
      t^.data := TreeRemove(t^.lch, n, t^.data+1);
  end
  else if v    Result := TreeRemove(t^.lch, n, v)
  else
    Result := TreeRemove(t^.rch, n, v);
end;

function TSizeBalancedTree.TreeSelect(var t: PSBTNode; k: Cardinal; var r: Cardinal): Cardinal;
begin
  if t=null then
  begin
    Result := Cardinal(-1);
    Exit;
  end;
  Inc(r);
  if (k=t^.lch^.size+1) then
  begin
    Result := t^.data;
    exit;
  end;
  if k<=t^.lch^.size then
    Result := TreeSelect(t^.lch, k, r)
  else
    Result := TreeSelect(t^.rch, k-1-t^.lch^.size, r);
end;

function TSizeBalancedTree.TreeFind(var t: PSBTNode; v: Cardinal): Boolean;
begin
  if t=null then
  begin
    Result := false;
    exit;
  end;
  if v    Result := TreeFind(t^.lch,v)
  else
    Result := (v=t^.data) or TreeFind(t^.rch,v);
end;

function TSizeBalancedTree.TreeRank(var t: PSBTNode; v: Cardinal): Cardinal;
begin
  if t=null then
  begin
    Result := 1;
    exit;
  end;
  if v    Result := TreeRank(t^.lch,v)
  else
    Result := t^.lch^.size+1+TreeRank(t^.rch,v);
end;

function TSizeBalancedTree.TreeSucc(var t: PSBTNode; v: Cardinal): Cardinal;
var
  tmp:Cardinal;
begin
  if t=null then
  begin
    Result := v;
    exit;
  end;
  if v>=t^.data then
    Result := TreeSucc(t^.rch,v)
  else
  begin
    tmp:=TreeSucc(t^.lch,v);
    if tmp=v then
      tmp := t^.data;
    Result := tmp;
  end;
end;

function TSizeBalancedTree.TreePred(var t: PSBTNode; v: Cardinal): Cardinal;
var
  tmp: Cardinal;
begin
  if t=null then
  begin
    Result := v;
    exit;
  end;
  if v<=t^.data then
    Result := TreePred(t^.lch, v)
  else
  begin
    tmp := TreePred(t^.rch,v);
    if tmp=v then
      tmp := t^.data;
    Result := tmp;
  end;
end;

procedure TSizeBalancedTree.add(v: PSBTNode);
begin
  TreeAdd(root, v);
end;

function TSizeBalancedTree.remove(v: Cardinal): PSBTNode;
var
  v2: Cardinal;
  C: Pointer;
  P: PSBTNode;
begin
  Result := nil;
  TreeRemove(root, Result, v);
  if Result=nil then
    Exit;
  v2 := Result^.data;
  Result^.data := v;
  //移出的内存设置为使用
  Result^.IsUse := True;
  //value交换
  C := VMPool.m_Buckets[v2]^.value;
  VMPool.m_Buckets[v2]^.value := VMPool.m_Buckets[v]^.value;
  VMPool.m_Buckets[v]^.value := C;
  //位置交换
  P := VMPool.m_Buckets[v2];
  VMPool.m_Buckets[v2] := VMPool.m_Buckets[v];
  VMPool.m_Buckets[v] := P;
end;

function TSizeBalancedTree.select(k: Cardinal): Cardinal;
var
  R: Cardinal;
begin
  R := 0;
  if root=null then
  begin
    Result := Cardinal(-1);
    Exit;
  end;
  Result := TreeSelect(root, k, R);
end;

function TSizeBalancedTree.find(v: Cardinal): Boolean;
begin
  Result := TreeFind(root, v);
end;

function TSizeBalancedTree.rank(v: Cardinal): Cardinal;
begin
  Result := TreeRank(root, v);
end;

function TSizeBalancedTree.succ(v: Cardinal): Cardinal;
begin
  Result := TreeSucc(root, v);
end;

function TSizeBalancedTree.pred(v: Cardinal): Cardinal;
begin
  Result := TreePred(root, v);
end;

{ TVirtualMemPool }
constructor TVirtualMemPool.Create(ACount: Integer);
var
  SysInfo: TSystemInfo;
begin
  inherited Create;;
  InitializeCriticalSection(m_VMLock);
  InitializeCriticalSection(m_NMLock);
  GetSystemInfo(SysInfo);
  m_PageSize := SysInfo.dwPageSize;
  m_SBTStorage := TSizeBalancedTree.Create(Self);
  m_Count := ACount;
  m_UseHeightCount := 0;
  InitMemPool(m_Count);
end;

destructor TVirtualMemPool.Destroy;
begin
  FreeAndNil(m_SBTStorage);
  Clear;
  VirtualFree(m_lpBase, 0, MEM_RELEASE);
  DeleteCriticalSection(m_NMLock);
  DeleteCriticalSection(m_VMLock);
  inherited Destroy;
end;

function TVirtualMemPool.GetCount: Cardinal;
begin
  Result := m_Count;
end;

function TVirtualMemPool.GetUseCount: Cardinal;
begin
  EnterCriticalSection(m_NMLock);
  try
    Result := m_Count - m_SBTStorage.NodeCount;
  finally
    LeaveCriticalSection(m_NMLock);
  end;
end;

function TVirtualMemPool.GetFreeCount: Cardinal;
begin
  EnterCriticalSection(m_NMLock);
  try
    Result := m_SBTStorage.NodeCount;
  finally
    LeaveCriticalSection(m_NMLock);
  end;
end;

function TVirtualMemPool.GetUseHeightCount: Cardinal;
begin
  if m_UseHeightCount    m_UseHeightCount := GetUseCount;
  Result := m_UseHeightCount;
end;

procedure TVirtualMemPool.InitMemPool(ACount: Integer);
var
  I: Integer;
begin
  EnterCriticalSection(m_VMLock);
  try
    // 申请大块内存
    m_lpBase := VirtualAlloc(nil,
    ACount*m_PageSize,
    MEM_RESERVE,
    PAGE_NOACCESS);
    SetLength(m_Buckets, ACount);
    //debug('m_lpBase: %d, NumberOfNode: %d', [Cardinal(m_lpBase), NumberOfNode]);
    for I := 0 to ACount-1 do
    begin
      { 为第I页地址提交内存。 }
      New(m_Buckets[I]);
      m_Buckets[I]^.IsUse := True;
      m_Buckets[I]^.data := I;
      m_Buckets[I]^.value := VirtualAlloc(Pointer(Cardinal(m_lpBase)+(I*m_PageSize)),
                             m_PageSize,
                             MEM_COMMIT,
                             PAGE_READWRITE);
      //debug('I: %d=%d', [I, Cardinal(m_Buckets[I]^.value)]);
      //ZeroMemory(m_Buckets[I]^.value, m_PageSize);
      m_SBTStorage.add(m_Buckets[I]);
    end;
  finally
    LeaveCriticalSection(m_VMLock);
  end;
end;

procedure TVirtualMemPool.Clear;
var
  I: Integer;
begin
  EnterCriticalSection(m_VMLock);
  try
    for I := 0 to Length(m_Buckets)-1 do
    begin
      Dispose(m_Buckets[I]);
    end;
  finally
    LeaveCriticalSection(m_VMLock);
  end;
end;

function TVirtualMemPool.VMAlloc(dwSize: Cardinal; IsLock: Boolean = True): Pointer;
var
  N, M, D1, D2, NStart, NEnd: Integer;
  P: PSBTNode;
begin
  if FreeCount<=0 then
  begin
    raise Exception.Create('No free pages in main memory.');
    Exit;
  end;
  if IsLock then EnterCriticalSection(m_VMLock);
  try
    N := dwSize div m_PageSize;
    if (dwSize mod m_PageSize)<>0 then
      Inc(N);
    M := 1;
    D2 := -1;
    D1 := m_SBTStorage.select(1);
    if D1<0 then
    begin
      Result := nil;
      Exit;
    end;
    if N<=1 then
    begin
      NStart := D1;
      //移出使用中的对像
      P := m_SBTStorage.remove(NStart);
      if P=nil then
      begin
        Result := nil;
        Exit;
      end;
      P^.count := 1;
      Result := P^.value;
      Exit;
    end;
    while True do
    begin
      //右旋转
      D2 := m_SBTStorage.succ(D1);
      if D2=D1 then
        Break;
      if D2=D1+1 then
      begin
        Inc(M);
      end
      else
      begin
        M := 1;
      end;
      if M>=N then
        Break;
      D1 := D2;
    end;
    NStart := D2 - N + 1;
    NEnd := NStart + N;
    P := m_SBTStorage.remove(NStart);
    P^.count := N;
    Result := P^.value;
    Inc(NStart);
    while NStart    begin
      m_SBTStorage.remove(NStart);
      Inc(NStart);
    end;
  finally
    if IsLock then LeaveCriticalSection(m_VMLock);
  end;
end;

function TVirtualMemPool.VMReAlloc(var P; dwSize: Cardinal): Pointer;
var
  OldN, M, NewN, NEnd: Cardinal;
  NewP: Pointer;
begin
  Result := nil;
  if Pointer(P)=nil then
  begin
    Result := VMAlloc(dwSize);
    Exit;
  end;
  EnterCriticalSection(m_VMLock);
  try
    M := (Cardinal(Pointer(P))-Cardinal(m_lpBase)) div m_PageSize;
    // 原页数
    OldN := m_Buckets[M]^.count;
    // 新页数
    NewN := dwSize div m_PageSize;
    if (dwSize mod m_PageSize)<>0 then
      Inc(NewN);
    // 新页数=原页数
    if NewN=OldN then
    begin
      Result := Pointer(P);
    end
    // 新页数<原页数,多余的页放回页表
    else if NewN    begin
      NEnd := M + OldN;
      m_Buckets[M]^.count := OldN-NewN;
      M := M + NewN;
      while M      begin
        m_SBTStorage.add(m_Buckets[M]);
        Inc(M);
      end;
      Result := Pointer(P);
    end
    // 新页数>原页数,重新申请并Copy原数据到新数据
    else if NewN>OldN then
    begin
      NewP := VMAlloc(dwSize, False);
      //原数据Copy到新数据中
      if NewP<>nil then
        CopyMemory(NewP, Pointer(P), OldN*m_PageSize);
      //放回原页数
      VMFree(P, False);
      //返回
      Pointer(P) := NewP;
      Result := NewP;
    end;
  finally
    LeaveCriticalSection(m_VMLock);
  end;
end;

function TVirtualMemPool.VMFree(var P; IsLock: Boolean = True): Boolean;
var
  M, N, NEnd: Cardinal;
begin
  if Pointer(P)=nil then
    Exit;
  if IsLock then EnterCriticalSection(m_VMLock);
  try
    M := (Cardinal(Pointer(P))-Cardinal(m_lpBase)) div m_PageSize;
    Pointer(P) := nil;
    // 页数
    N := m_Buckets[M]^.count;
    NEnd := M + N;
    // 放回
    while M    begin
      m_SBTStorage.add(m_Buckets[M]);
      Inc(M);
    end;
  finally
    if IsLock then LeaveCriticalSection(m_VMLock);
  end;
  Result := True;
end;

end.

用法

var

 VMM: TVirtualMemPool;

 p: Pointer;

begin

  VMM := TVirtualMemPool.Create(100000);

  //申请内存

  p := VMM.VMAlloc(1024);

  //重新申请大小

  p := VMM.VMReAlloc(1024);

  //释放内存

  VMM.VMFree(p);

  VMM.Free;

end;

 

 

具体代码大家可以慢慢看,另请高手看到后不要取笑,希望高手能优化一份并共享出来!

代码里使用的方法基本与linux内存管理原理差不多!可能也与windows内存管理大同小异吧!

不对之处请高手指正


推荐阅读
  • 使用nodejs爬取b站番剧数据,计算最佳追番推荐
    本文介绍了如何使用nodejs爬取b站番剧数据,并通过计算得出最佳追番推荐。通过调用相关接口获取番剧数据和评分数据,以及使用相应的算法进行计算。该方法可以帮助用户找到适合自己的番剧进行观看。 ... [详细]
  • Java太阳系小游戏分析和源码详解
    本文介绍了一个基于Java的太阳系小游戏的分析和源码详解。通过对面向对象的知识的学习和实践,作者实现了太阳系各行星绕太阳转的效果。文章详细介绍了游戏的设计思路和源码结构,包括工具类、常量、图片加载、面板等。通过这个小游戏的制作,读者可以巩固和应用所学的知识,如类的继承、方法的重载与重写、多态和封装等。 ... [详细]
  • Commit1ced2a7433ea8937a1b260ea65d708f32ca7c95eintroduceda+Clonetraitboundtom ... [详细]
  • 在说Hibernate映射前,我们先来了解下对象关系映射ORM。ORM的实现思想就是将关系数据库中表的数据映射成对象,以对象的形式展现。这样开发人员就可以把对数据库的操作转化为对 ... [详细]
  • 本文介绍了PE文件结构中的导出表的解析方法,包括获取区段头表、遍历查找所在的区段等步骤。通过该方法可以准确地解析PE文件中的导出表信息。 ... [详细]
  • Java学习笔记之面向对象编程(OOP)
    本文介绍了Java学习笔记中的面向对象编程(OOP)内容,包括OOP的三大特性(封装、继承、多态)和五大原则(单一职责原则、开放封闭原则、里式替换原则、依赖倒置原则)。通过学习OOP,可以提高代码复用性、拓展性和安全性。 ... [详细]
  • JDK源码学习之HashTable(附带面试题)的学习笔记
    本文介绍了JDK源码学习之HashTable(附带面试题)的学习笔记,包括HashTable的定义、数据类型、与HashMap的关系和区别。文章提供了干货,并附带了其他相关主题的学习笔记。 ... [详细]
  • 本文详细介绍了GetModuleFileName函数的用法,该函数可以用于获取当前模块所在的路径,方便进行文件操作和读取配置信息。文章通过示例代码和详细的解释,帮助读者理解和使用该函数。同时,还提供了相关的API函数声明和说明。 ... [详细]
  • Iamtryingtomakeaclassthatwillreadatextfileofnamesintoanarray,thenreturnthatarra ... [详细]
  • Java容器中的compareto方法排序原理解析
    本文从源码解析Java容器中的compareto方法的排序原理,讲解了在使用数组存储数据时的限制以及存储效率的问题。同时提到了Redis的五大数据结构和list、set等知识点,回忆了作者大学时代的Java学习经历。文章以作者做的思维导图作为目录,展示了整个讲解过程。 ... [详细]
  • 本文介绍了OC学习笔记中的@property和@synthesize,包括属性的定义和合成的使用方法。通过示例代码详细讲解了@property和@synthesize的作用和用法。 ... [详细]
  • JavaSE笔试题-接口、抽象类、多态等问题解答
    本文解答了JavaSE笔试题中关于接口、抽象类、多态等问题。包括Math类的取整数方法、接口是否可继承、抽象类是否可实现接口、抽象类是否可继承具体类、抽象类中是否可以有静态main方法等问题。同时介绍了面向对象的特征,以及Java中实现多态的机制。 ... [详细]
  • 自动轮播,反转播放的ViewPagerAdapter的使用方法和效果展示
    本文介绍了如何使用自动轮播、反转播放的ViewPagerAdapter,并展示了其效果。该ViewPagerAdapter支持无限循环、触摸暂停、切换缩放等功能。同时提供了使用GIF.gif的示例和github地址。通过LoopFragmentPagerAdapter类的getActualCount、getActualItem和getActualPagerTitle方法可以实现自定义的循环效果和标题展示。 ... [详细]
  • 本文介绍了一个题目的解法,通过二分答案来解决问题,但困难在于如何进行检查。文章提供了一种逃逸方式,通过移动最慢的宿管来锁门时跑到更居中的位置,从而使所有合格的寝室都居中。文章还提到可以分开判断两边的情况,并使用前缀和的方式来求出在任意时刻能够到达宿管即将锁门的寝室的人数。最后,文章提到可以改成O(n)的直接枚举来解决问题。 ... [详细]
  • C++字符字符串处理及字符集编码方案
    本文介绍了C++中字符字符串处理的问题,并详细解释了字符集编码方案,包括UNICODE、Windows apps采用的UTF-16编码、ASCII、SBCS和DBCS编码方案。同时说明了ANSI C标准和Windows中的字符/字符串数据类型实现。文章还提到了在编译时需要定义UNICODE宏以支持unicode编码,否则将使用windows code page编译。最后,给出了相关的头文件和数据类型定义。 ... [详细]
author-avatar
潮爆啊--_317
这个家伙很懒,什么也没留下!
PHP1.CN | 中国最专业的PHP中文社区 | DevBox开发工具箱 | json解析格式化 |PHP资讯 | PHP教程 | 数据库技术 | 服务器技术 | 前端开发技术 | PHP框架 | 开发工具 | 在线工具
Copyright © 1998 - 2020 PHP1.CN. All Rights Reserved | 京公网安备 11010802041100号 | 京ICP备19059560号-4 | PHP1.CN 第一PHP社区 版权所有