memmapper.dpr

delphi开发语言下的源代码分析

var
  smallTab: ^TSmallTab;
  curAlloc: PChar;                // 指向当前用于分配的提交空间(块)
  remBytes: Integer;              // curAlloc 块的大小
  availPtr: ^TFree;               // 大于4K(cSmallSize)的空闲块链表

// 块是在用块
function IsUsed(p: pChar): Boolean;
begin
  Result := PUsed(p)^.sizeFlags and cThisUsedFlag <> 0
end;

// 块是空闲块(空闲块的首尾的TFree.size值一致)
function IsFree(p: pChar; MaxSize: Cardinal): Boolean;
begin
  if PFree(p)^.size > MaxSize then
    Result := False
  else
    Result := PFree(p)^.size = PFree(p + PFree(p).size - SizeOf(TFree))^.size;
end;

// 通过块的cPrevFreeFlag标志检测上一个块的状态
// (* block 'p' is Used! *)
function PrevIsFree(p: pChar): Boolean;
begin
  Result := PUsed(p).sizeFlags and cPrevFreeFlag <> 0;
end;

// 块是Gap
function IsGap(p: pChar): Boolean;
begin
  Result := (PUsed(p)^.sizeFlags and (cThisUsedFlag or cFillerFlag)) = (cThisUsedFlag or cFillerFlag);
end;

// 检测一个块的有效性
function IsValid(n: pChar; preFree: Boolean): Boolean;
begin
  if IsUsed(n) then
    Result := preFree = PrevIsFree(n)
  else
    Result := IsFree(n, MaxInt);
end;

// 是无效块
// (* 1. 不能从当前块得到下一个块的状态或者性质, 但是可以得到下一个块的首地址;
//    2. 仅当当前块是TUsed时, 才可以从当前块得到上一个块是否TFree的状态;
//    3. 如果当前块是Gap, 则不可能再有后续块(在当前提交的地址空间中). *)
function IsInValid(p: pChar; MaxSize: Cardinal; prevFree: Boolean): boolean;
var
  size : Cardinal;
begin
  if IsUsed(p) then
  begin
    size := PUsed(p).sizeFlags and not cFlags;
    if (prevFree <> PrevIsFree(p)) or  // 在用块的cPrevFreeFlag标志不正确
       (size > MaxSize) then           // 块长度大于最大可能的长度值
      Result := True
    else  // Gap记录块长大于SizeOf(TFree); 或在用的块长度小于SizeOf(TFree), 但又不是Gap
      Result :=  IsGap(p) xor (size < SizeOf(TFree));
  end
  else
    Result := not IsFree(p, MaxSize);  // 空闲块的首尾标TFree记录不一致
end;

// curAlloc要么是提交空间的第一个块, 要么就一定附在一个Used块之后
function IsCurAlloc(p: pChar; MaxSize: Cardinal; prevFree: Boolean) : boolean;
begin
  if prevFree then
    Result := False
  else
    Result := IsInValid(p, MaxSize, prevFree);
end;

// 一个小内存块释放后, 总是被放入到smallTab中. 因此, 可以通过验证这个内存块指针
// 来确认PtrList中的哪一个Heap块是smallTab
function FindSmallTab(aPtr:Pointer; PtrList: TList): Pointer;
var
  size : Cardinal;
  p,n : PFree;
  i : Integer;
begin
  size := RawGetSize(aPtr);
  System.FreeMem(aPtr);

  if PtrList.Count = 1 then
    Result := PtrList[0]
  else
  begin
    dec(PChar(aPtr), SizeOf(TUsed));
    for i := 0 to PtrList.Count - 1 do
    begin
      Result := PtrList[i];
      if Result <> nil then
      begin
        p := TSmallTab(Result^)[size div cAlign];
        n := p;
        if p <> nil then
          repeat
            if n = aPtr then
              Exit
            else
              n := n^.next;
          until (n=nil) or (p=n);
      end;
    end;
    Result := nil;
  end;
end;

var
  UsedBlockNum : Integer = 0;

function EnumMemBlock(mPtr: Pointer; mType: TMemBlock; pData: Pointer): Boolean;
begin
  case mType of
   mbUsed :
     begin
       if UsedBlockNum >= 0 then
         TList(pData^)[UsedBlockNum] := mPtr;
       dec(UsedBlockNum);
      // if UsedBlockNum < 0 then ERROR
     end;

  mbFree :
    if (availPtr = nil) and
       (PFree(mPtr)^.size > cSmallSize) then
    begin
      availPtr := mPtr;
      repeat
        Pointer(availPtr) := availPtr^.next;
      until (availPtr = mPtr) or (availPtr^.size = 0);
    end;
  end;
end;

function EnumCommittedBlock(RootPtr: PBlockDesc; EnumFun: TEnumMemBlock; var pData) : Integer;
var
  size, freeSize, userSize, overhead: Cardinal;
  f: PFree;
  a, e: PChar;
  b: PBlockDesc;
  prevFree: Boolean;

begin
  Result := GetHeapStatus.HeapErrorCode;
  if Result <> cHeapOk then // 堆已被破坏, 不能继续操作
    Exit;

  curAlloc := nil;
  overhead := 0;
  prevFree := False;
  b := RootPtr.next;
  while b <> RootPtr do begin
    a := b.addr;
    e := a + b.size;

    // 验证curAlloc指针
    if curAlloc = nil then
      remBytes := b.size;


    while a < e do begin
      if (curAlloc = nil) and IsCurAlloc(a, remBytes, prevFree) then
        curAlloc := a;

      if (a = curAlloc) and (remBytes > 0) then begin
        // 如果是curAlloc(它没有prev/next)
        size := remBytes;
        Inc(freeSize, size);
        EnumFun(a, mbFree, @pData);
        if prevFree then
        begin
          Result := cBadCurAlloc;
          prevFree := False;
        end;
      end else begin
        if prevFree <> ((PUsed(a).sizeFlags and cPrevFreeFlag) <> 0) then
          Result := cBadNextBlock;
        if (PUsed(a).sizeFlags and cThisUsedFlag) = 0 then begin
          // 如果是空闲块
          f := PFree(a);
          EnumFun(a, mbFree, @pData);
          if (f.prev.next <> f) or (f.next.prev <> f) or (f.size < sizeof(TFree)) then
            Result := cBadFreeBlock;
          size := f.size;
          Inc(freeSize, size);
          prevFree := True;
        end else begin
          // 如果是在用块
          size := PUsed(a).sizeFlags and not cFlags;
          if (PUsed(a).sizeFlags and cFillerFlag) <> 0 then begin
            // 如果是Gap
            Inc(overhead, size);
            EnumFun(a, mbGap, @pData);
            if (a > b.addr) and (a + size < e) then
              Result := cBadUsedBlock;
          end else begin
            // 如果不是Gap
            Inc(userSize, size-sizeof(TUsed));
            Inc(overhead, sizeof(TUsed));
            EnumFun(a, mbUsed, @pData);
          end;
          prevFree := False;
        end;
      end;

      Inc(a, size);
      if curAlloc = nil then
        dec(remBytes, size);
    end;
    b := b.next;
  end;
end;

var
  i, j: Integer;
  PtrList: TList;
  isCircle: Boolean;
  FailedPtr, ValidPtr: Pointer;

  RootPtr,
  spaceRootPtr,
  committedRootPtr,
  decommittedRootPtr: PBlockDesc;

  bdb, blockDescBlockList: PBlockDescBlock;
  blockDescFreeList: PBlockDesc;

begin
  // 一些任意的内存操作
  if UpperCase(ParamStr(1)) = '/ALL' then
    DoAllTest
  else
    System.GetMem(ValidPtr, 100000);

  System.GetMem(ValidPtr, 200);   // 取200字节的一个内存块作为参考指针
  InitHeapArr;                    // 初始化一个用于收集操作系统的堆的数组
  PtrList := TList.Create;        // 初始化一个指针列表


  // Search blockDescBlockList
  SearchHeapBlock(PtrList, SizeOf(TBlockDescBlock));
  blockDescBlockList := FindBDBList(PtrList);

  // All DescBlock into TList
  PtrList.Clear;
  bdb := blockDescBlockList;
  while bdb <> nil do
  begin
    for i := low(bdb.data) to high(bdb.data) do
      PtrList.add(@bdb.data[i]);
    bdb := bdb.next;
  end;

  // find 4 Roots in List
  // (* 极端情况下, 仅有spaceRootPtr 和 committedRootPtr. 因为:
  //      1. 如果空闲块描述正好用完, 在未发生新的请求之前 blockDescFreeList 为空
  //      2. 如果所有地址空间正好完全被提交, 则 decommittedRootPtr 链表仅有一个ROOT结点, 这在PtrList中不可能查到
  //    从BDB的PtrList中最多只可能查找到4个表, 如果超出, 则可能得到一个无效的BDB链表. *)
  while SearchRoot(PtrList, RootPtr, isCircle) do
  begin
    if not isCircle then
      blockDescFreeList := RootPtr
    else
      if spaceRootPtr = nil then
        spaceRootPtr := RootPtr
      else
        if committedRootPtr = nil then
          committedRootPtr := RootPtr
        else
          if decommittedRootPtr = nil then
            decommittedRootPtr := RootPtr
          else
            // ERROR!!!
  end;

  // All Root into TList
  PtrList.Clear;
  PtrList.Add(spaceRootPtr);
  PtrList.Add(committedRootPtr);
  PtrList.Add(decommittedRootPtr);

  // Condition : a ValidPtr out of decommittedRoot
  decommittedRootPtr := FindDecommittedRoot(ValidPtr, PtrList);
  if decommittedRootPtr <> nil then
  begin
    // Root结点本身是无效的, 仅用于封闭环形链表
    with decommittedRootPtr^.next^ do
      FailedPtr := addr + (size div 2);
    spaceRootPtr := FindSpaceRoot(FailedPtr, PtrList);
    //if spaceRootPtr = nil then error!!!
    committedRootPtr := PtrList[0];
  end;

  writeln;
  writeln(format('%p, %p, %p, %p', [blockDescFreeList, spaceRootPtr, committedRootPtr, decommittedRootPtr]));

  // Enum Committed Block, find curAlloc, remBytes and availPtr
  while AllocMemCount <> PtrList.Count do
  begin
    PtrList.Count := AllocMemCount;
    UsedBlockNum := AllocMemCount - 1;
  end;
  EnumCommittedBlock(committedRootPtr, EnumMemBlock, PtrList);
  writeln('Total Used Memory Block: ', PtrList.count, ' lost: ', UsedBlockNum+1);

  // find smallTab Pointer
  PtrList.Clear;
  SearchHeapBlock(PtrList, SizeOf(TSmallTab));
  smallTab := FindSmallTab(ValidPtr, PtrList);

  writeln(format('Block curAlloc status: %.8x, %d', [DWORD(curAlloc), remBytes]));
  writeln(format('availPtr: %.8x, smallTab: %.8x', [DWORD(availPtr), DWORD(smallTab)]));

  PtrList.Free;

readln;
end.