bigbrainpro.pas

内存管理程序

  {$ENDIF}
  OldCode:=EndThreadAddr^;
  EndThreadAddr^:=NewCode;
  {$IFNDEF LINUX}
  VirtualProtect(EndThreadAddr,5,OldProtect,Protect);
  FlushInstructionCache(GetCurrentProcess, EndThreadAddr,5);
  {$ENDIF}
end;

//------------------------------------------------------------------------------
procedure NewEndThread(exitCode:integer); register;
begin

  if ThreadMemMan <> nil then begin
    if ThreadMemMan is TThreadBlockManager then begin
//      TThreadBlockManager(ThreadMemMan).EmptyBlocksToMain;

      ManMan.FreeManager(ThreadMemMan);
    end;
  end;

  ThreadMemMan := nil;
  {$IFDEF LINUX}
  pthread_exit(Pointer(exitCode))
  {$ELSE}
  ExitThread(exitCode);
  {$ENDIF}
end;
//------------------------------------------------------------------------------
function NewGetMem(Size: integer): pointer;
var
  lman: TBlockManager;
begin
//  b := SingleCPU;
//  if b then
//    MainMan.Lock;


  lman := ThreadMemMan;
  if lman = nil then begin
    lman := ManMan.NewManager;
    ThreadMemMan := lman;
    TThreadBlockManager(lman).MainMan := MainMan;
  end;

  result := lMan.NeedMemory(Size);

//  if b then
//    MainMan.Unlock;

end;

//------------------------------------------------------------------------------
function NewFreeMem(p: pointer): integer;
var
  block: PSuperMemBlock;
//  man: TBlockManager;
  list: PLockedBlockList;
//  b: boolean;
label
  retry;
begin
//  b := SingleCPU;
//  if b then
//    MainMan.Lock;

  result := 0;

(*(  if ThreadMemMan = nil then begin
    ThreadMemMan := ManMan.NewManager;
    TThreadBlockManager(ThreadMemMan).MainMan := MainMan;
  end;
  man := TThreadBlockManager(ThreadMemMan);*)

retry:
  block := PSuperMemBlock(pchar(p)-SizeOf(TSuperMemblock));
  list := PLockedBlockList(block.ManagedBy);
//  man := list.Owner;

  list.Lock;
  if PLockedBlockList(block.ManagedBy) <> list then begin
    list.Unlock;
    goto retry;
  end;
  try
    list.Unlink(block);

  finally
    list.Unlock;
  end;

  list.FreeTo.LockedLink(block);

//  if b then
//    MainMan.UnLock;

end;
//------------------------------------------------------------------------------
function NewReallocMem(p: pointer; Size: integer): pointer;
var
  block: PSuperMemBlock;
//  man: TBlockManager;
  dest: pointer;
  i: integer;
//  b: boolean;
label retry;
begin
//  b := SingleCPU;
//  if b then
//    MainMan.Lock;


  //determine if size is small enough to just return same pointer
  block := PSuperMemBlock(pchar(p)-SizeOf(TSuperMemblock));

  i := smb_GetUserAreaSize(block);
  if size < i then  begin
    result := p;
    if block.ReportedUsedBytes = 0 then
      block.ReportedUsedBytes := block.UsedBytes;

    block.UsedBytes := size;

    exit;
  end;

  dest := NewgetMem(size);
  MoveMem32(dest, p, LesserOf(Size, block.UsedBytes));

  NewFreeMem(p);
  result := dest;

//  if b then
//    MainMan.Unlock;

end;


function OldNewGetMem(Size: integer): pointer;
var
  lman: TThreadBlockManager;
begin
  if ThreadMemMan = nil then begin
    ThreadMemMan := ManMan.NewManager;
    TThreadBlockManager(ThreadMemMan).MainMan := MainMan;
  end;

  lman := TThreadBlockManager(ThreadMemMan);
  {$IFDEF HYPERALLOC}
  if not lman.TryLock then begin
    lman := ManMan.LockFirstAvailable;
  end;
  {$ELSE}
  {$IFNDEF LOCKLISTS}
  lMan.Lock;
  {$ENDIF}
  {$ENDIF}
  try

    result := lMan.NeedMemory(Size);

  finally
    {$IFNDEF LOCKLISTS}
      lman.Unlock;
    {$ENDIF}
  end;

end;

//------------------------------------------------------------------------------
function OldNewFreeMem(p: pointer): integer;
var
  block: PSuperMemBlock;
  man: TBlockManager;
label
  retry;
begin
(*  if ThreadMemMan = nil then begin
    ThreadMemMan := TThreadBlockManager.create;
    TThreadBlockManager(ThreadMemMan).MainMan := MainMan;
    ManMan.RegisterManager(ThreadMemMan);
  end;*)

  block := psupermemblock(pchar(p)-SizeOf(TSuperMemBlock));

retry:
  {$IFDEF FREEMAN}ManMan.EnterDangerZone;{$ENDIF}


  man := TBlockManager(PLockedBlockList(block.ManagedBy).owner);
  {$IFNDEF LOCKLISTS}
  Man.Lock;

  {$IFDEF FREEMAN}ManMan.LeaveDangerZone;{$ENDIF}
  if (PLockedBlockList(block.ManagedBy).owner <> man) or (Man=nil) then begin
    Man.Unlock;
    goto retry;
  end;
  {$ENDIF}
  try

    if Man <> nil then
      Man.NoNeedMemory(p);


  finally
    {$IFNDEF LOCKLISTS}
    Man.Unlock;
    {$ENDIF}
  end;


  result := 0;


end;
//------------------------------------------------------------------------------
function OldNewReallocMem(p: pointer; Size: integer): pointer;
var
  block: PSuperMemBlock;
  man: TBlockManager;
label retry;
begin
(*  if ThreadMemMan = nil then begin
    ThreadMemMan := TThreadBlockManager.create;
    TThreadBlockManager(ThreadMemMan).MainMan := MainMan;
    ManMan.RegisterManager(ThreadMemMan);
  end;*)

  block := psupermemblock(pchar(p)-SizeOf(TSuperMemBlock));

retry:
  {$IFDEF FREEMAN}ManMan.EnterDangerZone;{$ENDIF}
  man := TBlockManager(plockedblocklist(block.ManagedBy).owner);
  {$IFNDEF LOCKLISTS}
  Man.Lock;

  {$IFDEF FREEMAN}ManMan.LeaveDangerZone;{$ENDIF}
  if (plockedblocklist(block.ManagedBy).owner <> man) or (Man=nil) then begin
    man.unlock;
    goto retry;
  end;
  {$ENDIF}
  try
    result := Man.ResizeMemory(p, Size);


  finally
    {$IFNDEF LOCKLISTS}
    Man.Unlock;
    {$ENDIF}
  end;

(*  if ThreadMEmMan is TThreadBlockManager then
  with ThreadMemMan as TThreadBlockManager do begin
    if TryLock then begin
      EmptyBlocksToMain;
      UnLock;
    end;
  end;*)





end;

{$IFDEF LINUX}

function InitializeCriticalSection(var lpCriticalSection: TRTLCriticalSection): Integer;
var
  Attribute: TMutexAttribute;
begin
  Result := pthread_mutexattr_init(Attribute);
  if Result <> 0 then Exit;
  try
    Result := pthread_mutexattr_settype(Attribute, PTHREAD_MUTEX_RECURSIVE);
    if Result <> 0 then Exit;

    Result := pthread_mutex_init(lpCriticalSection, Attribute);
  finally
    pthread_mutexattr_destroy(Attribute);
  end;
end;


procedure Beep(freq, duration: integer);
begin

//TODO -cunimplemented: unimplemented block
end;

function GetTickCount: Cardinal;
var
  tv: timeval;
begin
  gettimeofday(tv, nil);
  {$RANGECHECKS OFF}
  Result := int64(tv.tv_sec) * 1000 + tv.tv_usec div 1000;
  {
    I've implemented this correctly for now. I'll argue for using
    an int64 internally, since apparently quite some functionality
    (throttle, etc etc) depends on it, and this value may wrap
    at any point in time.
    For Windows: Uptime > 72 hours isn't really that rare any more,
    For Linux: no control over when this wraps.

    IdEcho has code to circumvent the wrap, but its not very good
    to have code for that at all spots where it might be relevant.

  }
end;

function TryEnterCriticalSection(var lpCriticalSection: TRTLCriticalSection): Boolean;
begin
  Result := pthread_mutex_trylock(lpCriticalSection) <> EBUSY;
end;
{$ENDIF}




{ TLockedArray }

{$IFDEF USELISTCLASS}
constructor TLockedBlockList.Create(Aowner: pointer);
begin
  inherited create;
  Init(Aowner);

end;

destructor TLockedBlockList.Destroy;
begin
  Finalize;
  inherited;
end;
{$ENDIF}

function TLockedBlockList.Extract: PSuperMemBlock;
begin

  if tip = nil then begin
    result := nil;
    exit;
  end
  else begin
    result := tip;
    Unlink(tip);

  end;
end;

procedure TLockedBlockLIst.Finalize;
begin
  DeleteCriticalSection(sect);
end;

procedure TLockedBlockLIst.Init(AOwner: TBlockManager);
begin
  FWasteBytes := 0;
  FFreeBytes := 0;
  FBlockCount := 0;
  FUsedBytes := 0;
  FFreepool := false;

  Fowner := Aowner;
  self.tip := nil;

  InitializeCriticalSection(sect);

end;

procedure TlockedBlockList.Link(block: PSuperMemBlock);
begin
  if (block.Fpreviousblock <> nil)
  or (block.Fnextblock <> nil) then
    halt;

  block.ManagedBy :=   {$IFNDEF USELISTCLASS}@{$ENDIF}self;

  if tip <> nil then begin
    tip.FPreviousBlock := block;
  end;
  block.FNextBlock := tip;


  tip := block;

  smb_SetAvailable(block, FreePool);

  if smb_GetAvailable(block) then begin
    block.UsedBytes := 0;
//    block.WasteBytes := 0;
  end;


  TallyStats(block);


end;

function TLockedBlockLIst.GEtFreeBytes: integer;
begin
  Lock;
{$IFDEF EXTRA_ERR_CHECKING}try{$ENDIF}
    result := FFreeBytes;
{$IFDEF EXTRA_ERR_CHECKING}finally{$ENDIF}
    Unlock;
{$IFDEF EXTRA_ERR_CHECKING}end;{$ENDIF}
end;

function TLockedBlockLIst.GetAllocBytes: integer;
begin
  Lock;
{$IFDEF EXTRA_ERR_CHECKING}try{$ENDIF}
    result := FUsedBytes+FWasteBytes;
{$IFDEF EXTRA_ERR_CHECKING}finally{$ENDIF}
    Unlock;
{$IFDEF EXTRA_ERR_CHECKING}end;{$ENDIF}
end;
function TLockedBlockLIst.GEtBlockCount: integer;
begin
  Lock;
{$IFDEF EXTRA_ERR_CHECKING}try{$ENDIF}
    result := FBlockCount;
{$IFDEF EXTRA_ERR_CHECKING}finally{$ENDIF}
    Unlock;
{$IFDEF EXTRA_ERR_CHECKING}end;{$ENDIF}
end;
function TLockedBlockLIst.GetUsedBytes: integer;
begin
  Lock;
{$IFDEF EXTRA_ERR_CHECKING}try{$ENDIF}
    result := FUsedBytes;
{$IFDEF EXTRA_ERR_CHECKING}finally{$ENDIF}
    Unlock;
{$IFDEF EXTRA_ERR_CHECKING}end;{$ENDIF}
end;

function TLockedBlockLIst.GetWasteBytes: integer;
begin
  Lock;
{$IFDEF EXTRA_ERR_CHECKING}try{$ENDIF}
    result := FWasteBytes;
{$IFDEF EXTRA_ERR_CHECKING}finally{$ENDIF}
    Unlock;
{$IFDEF EXTRA_ERR_CHECKING}end;{$ENDIF}
end;

procedure TLockedBlockLIst.Lock;
begin
  {$IFDEF LOCKLISTS}
  EnterCriticalSection(sect);
  {$ENDIF}
end;

function  TLockedBlockList.LockedExtract: PSuperMemBlock;
begin
  Lock;
{$IFDEF EXTRA_ERR_CHECKING}try{$ENDIF}
    result := Extract;
{$IFDEF EXTRA_ERR_CHECKING}finally{$ENDIF}
    Unlock;
{$IFDEF EXTRA_ERR_CHECKING}end;{$ENDIF}
end;

procedure TlockedBlockList.LockedLInk(block: PSupe