bigbrainpro.pas

内存管理程序

procedure TBlockManager.InitBlocks;
var
  t: integer;
begin
  for t:=0 to MAXBIT do begin
    {$IFDEF USELISTCLASS}
    self.Fblocks[t] := TLockedBlockList.create(self);
    self.FFreeblocks[t] := TLockedBlockList.create(self);
    self.Fblocks[t].FreeTo := self.FFreeblocks[t];
    self.FFreeblocks[t].AllocTo := self.Fblocks[t];

    {$ELSE}
    self.Fblocks[t].init(self);
    self.FFreeblocks[t].init(self);
    self.Fblocks[t].FreeTo := self.FFreeblocks[t];
    self.FFreeblocks[t].AllocTo := self.Fblocks[t];
    {$ENDIF}

    self.FFreeblocks[t].FreePool := true;
  end;

end;

procedure TBlockManager.InjectBlock(block: PSuperMemBlock);
begin
  Lock;
{$IFDEF EXTRA_ERR_CHECKING}try{$ENDIF}
    LinkFreed(block);
{$IFDEF EXTRA_ERR_CHECKING}finally{$ENDIF}
    Unlock;
{$IFDEF EXTRA_ERR_CHECKING}end;{$ENDIF}

end;

procedure TBlockManager.LinkAllocated(block: PSuperMemBlock);
begin
  smb_SetAvailable(block, false);
  FBlocks[block.SizeIndex].LockedLInk(block);
end;

procedure TBlockManager.LinkFreed(block: PSuperMemBlock);
begin
  smb_SetAvailable(block, true);
  FFreeBlocks[block.SizeIndex].LockedLink(block);

end;

procedure TBlockManager.Lock;
begin
  {$IFDEF LOCKMAN}
  EnterCriticalSection(sect);
  {$ENDIF}
end;

function TBlockManager.NeedBlock(USerSize: integer): PSuperMemBlock;
var
  freeBlock: PSuperMemBlock;
  iSizeIndex: integer;
begin
  //see if there are free blocks of the given size index

  //determine which list to look in
  iSizeIndex := GetSizeIndex(InflateSize(UserSize));

  //get a pointer to the first recorded free block of the given size index
  freeBlock := FFreeBlocks[iSizeIndex].LockedExtract;

  if freeBlock = nil then begin
    //if there are no free blocks of the given size then allocate a new one
    result := self.AllocateNewBlock(UserSize);
    PSuperMemBlock(result).UsedBytes := UserSize;
    LinkAllocated(result);
  end else begin
    //otherwise reactivate the freed block
    result := freeBlock;
    if not smb_GetAvailable(result) then
      beep(100,10);
    //UnlinkFreed(result);
    PSuperMemBlock(result).UsedBytes := UserSize;
    LinkAllocated(result);
  end;




end;

function TBlockManager.NeedMemory(UserSize: integer): pointer;
begin
  result := pchar(NeedBlock(UserSize))+SizeOf(TSuperMemBlock);
end;

procedure TBlockManager.NoNeedBlock(block: pSuperMemBlock);
begin
  UnlinkAllocated(block);
//  if block.pad <> 0 then
//    beep(100,10);

  LinkFreed(block);






end;

procedure TBlockManager.NoNeedMemory(p: pointer);
var
  block: PSuperMemBlock;
begin
  block := pSuperMEmBlock(pchar(p)-pointer(SizeOf(TsuperMemBlock)));
  NoNeedBlock(block);
end;

procedure TBlockManager.RemanageBlock(block: PSuperMemBlock);
begin
  Lock;
{$IFDEF EXTRA_ERR_CHECKING}try{$ENDIF}
    LinkAllocated(block);
{$IFDEF EXTRA_ERR_CHECKING}finally{$ENDIF}
    Unlock;
{$IFDEF EXTRA_ERR_CHECKING}end;{$ENDIF}

end;

function TBlockManager.ResizeBlock(block: pSuperMEmBlock; Size: integer): PSuperMemBlock;
begin
  if (Size < smb_GetUserAreaSize(block)) then begin
    result := block;
    block.UsedBytes := Size;
//    CheckMem;
  end else begin
    result := NeedBlock(Size);
    MoveMem32(smb_GetUserDataArea(result), smb_GetUserDataArea(block), LesserOf(Size, block.UsedBytes));
    NoNeedBlock(block);
  end;

  result.UsedBytes := Size;


end;

function TBlockManager.ResizeMemory(p: pointer; Size: integer): pointer;
var
  block: PSuperMemBlock;
begin
  block := PSuperMemBlock(pChar(p)-pointer(SizeOf(TsuperMemBlock)));
  block := ResizeBlock(block, Size);

(*  if block<>block.Addr then
    result := OldMan.ReallocMem(p, size)
  else*)
    result := pchar(block)+SizeOf(TsuperMemBlock);

end;

function TBlockManager.TryLock: boolean;
begin
  {$IFDEF LOCKMAN}
  result := TryEnterCriticalSection(sect);
  {$ELSE}
  result := true;
  {$ENDIF}
end;

procedure TBlockManager.UnlinkAllocated(block: PSuperMemBlock);
begin
  FBlocks[block.SizeIndex].LockedUnlink(block);
end;

procedure TBlockManager.UnlinkFreed(block: PSuperMemBlock);
begin
  FFreeBlocks[block.SizeIndex].LockedUnlink(block);
end;

procedure TBlockManager.Unlock;
begin
  {$IFDEF LOCKMAN}
  LeaveCriticalSection(sect);
  {$ENDIF}
end;

procedure TBlockManager.SetFree(const Value: boolean);
begin
  FFree := Value;
  if value then
    FFreeTime := GetTickCount
  else begin
    FFreeTime := 0;
    FDestroyCountdown := 0;
    if FDestroyCountdown>0 then
      FDestroyCountdown := 0;

  end;




end;

function TBlockManager.GetFree: boolean;
begin
  result := FFree;
end;

procedure TBlockManager.PrefetchExtraBlock(UserSize: integer);
var
  pb: PSuperMemBlock;
begin
  pb  := AllocateNewBlock(UserSize);
  LInkFreed(pb);

end;

procedure TBlockManager.FinalizeBlocks;
var
  t: integer;
begin
  for t:=0 to MAXBIT do begin
    self.Fblocks[t].Finalize;
    self.FFreeblocks[t].Finalize;
  end;

end;

function TBlockManager.GetAllocBytes: integer;
var
  t: integer;
begin
  result :=0;
  for t:=0 to MAXBIT do begin
    inc(result,FBlocks[t].AllocBytes);
  end;

end;

function TBlockManager.GetBlockCount: integer;
var
  t: integer;
begin
  result :=0;
  for t:=0 to MAXBIT do begin
    inc(result,FBlocks[t].BlockCount);
    inc(result,FFreeBlocks[t].BlockCount);
  end;
end;

function TBlockManager.GetFreeBytes: integer;
var
  t: integer;
begin
  result :=0;
  for t:=0 to MAXBIT do begin
    inc(result,FFreeBlocks[t].FreeBytes);
  end;
end;

function TBlockManager.GetUsedBytes: integer;
var
  t: integer;
begin
  result :=0;
  for t:=0 to MAXBIT do begin
    inc(result,FBlocks[t].UsedBytes);
  end;


end;

function TBlockManager.GetWasteBytes: integer;
var
  t: integer;
begin
  result :=0;
  for t:=0 to MAXBIT do begin
    inc(result,FBlocks[t].WasteBytes);
  end;
end;

{ TSuperMemBlock }
function GetSizeIndexSize(BlockSize: integer): integer;
begin
  result := (1 shl (HighOrderBit(BlockSize{$IFDEF LESSWASTE}-SizeOf(TSuperMemBlock){$ENDIF})+1)){$IFDEF LESSWASTE}+SizeOf(TSuperMemBlock){$ENDIF};
end;

function GetSizeIndex(BlockSize: integer): integer;
begin
  result := (HighOrderBit(BlockSize{$IFDEF LESSWASTE}-SizeOf(TSuperMemBlock){$ENDIF})+1);
end;

function AddHeaderToSize(UserSize: integer): integer;
begin
  result := Usersize+SizeOf(TsuperMemBlock);
end;


function smb_GetAvailable(self: PSuperMemBlock): boolean;
begin
  result := self.Flags = 1;
//  result := (self.Flags or 1) = 1;
end;

function smb_GetisLinked(self: PSuperMemBlock): boolean;
begin
  result := (self.FNextBlock<> nil) or (self.FPreviousBlock <> nil);
end;

function smb_HeaderSize(self: PSuperMemBlock): integer;
begin
  result := SizeOf(TSuperMemBlock);
end;

procedure smb_Init(self: PSuperMemBlock; UserSize: integer);
begin
//  Addr := @self;
  smb_SetAvailable(self, true);
  self.FPreviousBlock := nil;
  self.FNextBlock := nil;
  self.ManagedBy := nil;
  self.SizeIndex := GetSizeIndex(UserSize+SizeOf(TSuperMemBlock));
  self.UsedBytes := UserSize;
  self.ReportedUsedBytes := 0;

end;

function InflateSize(Size: integer): integer;
begin
  result := size+SizeOf(TsuperMemBlock);

end;


//Memory Manager Hooks


procedure MoveMem32(D,S: pointer; Size: integer);
asm
{     ->EAX     Pointer to source       }
{       EDX     Pointer to destination  }
{       ECX     Count                   }

        PUSH    ESI
        PUSH    EDI

        MOV     EDI,EAX
        MOV     ESI,EDX

        MOV     EAX,ECX

        CMP     EDI,ESI
        JA      @@down
        JE      @@exit

        SAR     ECX,2           { copy count DIV 4 dwords       }
        JS      @@exit

        REP     MOVSD

        MOV     ECX,EAX
        AND     ECX,03H
        REP     MOVSB           { copy count MOD 4 bytes        }
        JMP     @@exit

@@down:
        LEA     ESI,[ESI+ECX-4] { point ESI to last dword of source     }
        LEA     EDI,[EDI+ECX-4] { point EDI to last dword of dest       }

        SAR     ECX,2           { copy count DIV 4 dwords       }
        JS      @@exit
        STD
        REP     MOVSD

        MOV     ECX,EAX
        AND     ECX,03H         { copy count MOD 4 bytes        }
        ADD     ESI,4-1         { point to last byte of rest    }
        ADD     EDI,4-1
        REP     MOVSB
        CLD
@@exit:
        POP     EDI
        POP     ESI
end;
(*procedure MoveMem32(D,S:Pointer;Size:integer);//!!
asm
  push edi
  push esi
  push ecx
  shr ecx,2
  and ecx, $3FFFFFFF
  mov edi,eax
  mov esi,edx
  rep movsd
  pop ecx
  and ecx,3
  rep movsb
  pop esi
  pop edi
end;*)







procedure smb_SetAvailable(self: PSuperMemblock; b: boolean);
begin
  if b then
    self.Flags := 1
  else
    self.Flags := 0;
end;

procedure smb_SetNextBlock(self: PSuperMemblock; const Value: pointer);
begin
  self.FNextBlock := Value;
end;

procedure smb_SetPreviousBlock(self: PSuperMemblock; const Value: pointer);
begin
  self.FPreviousBlock := Value;
end;

function smb_GetSizeIndexSize(self: PSuperMemblock): integer;
begin
  result := (1 shl self.SizeIndex){$IFDEF LESSWASTE}+SizeOf(TSuperMemBlock){$ENDIF}
end;

function smb_GetUserAreaSize(self: PSuperMemblock): integer;
begin
  result := smb_GetSizeIndexSize(self)-smb_GetHeaderSize(self);
end;

function smb_GetUserDataArea(self: PSuperMemBlock): pointer;
var
  i: integer;
begin
  i := integer(Self);
  inc(i, smb_GetHeaderSize(self));

  result := pointer(i);
end;


function smb_GetWasteBytes(self: PSuperMemblock): integer;
begin
  if self.ReportedUsedBytes > 0 then
    result := smb_GetUserAreaSize(self) - self.ReportedUsedBytes
  else
    result := smb_GetUserAreaSize(self) - self.UsedBytes;

end;

{ TThreadBlockManager }



procedure UnPatchEndThread;
var
  EndThreadAddr:PJump;
  OldProtect,Protect:DWord;
begin
  EndThreadAddr:=Pointer(@EndThread);
  NewCode.Distance:=Integer(@NewEndThread)-(Integer(@EndThread)+5);
  {$IFNDEF LINUX}
  VirtualProtect(EndThreadAddr,5,PAGE_READWRITE,OldProtect);
  {$ENDIF}
  EndThreadAddr^:=OldCode;