-
Notifications
You must be signed in to change notification settings - Fork 51
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Ref: Removed code of profilers from debuger
- Loading branch information
yavfast@gmail.com
committed
Jun 22, 2014
1 parent
d5eb81f
commit 7ccf3bc
Showing
13 changed files
with
1,622 additions
and
1,418 deletions.
There are no files selected for viewing
Large diffs are not rendered by default.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,293 @@ | ||
unit DbgMemoryProfiler; | ||
|
||
interface | ||
|
||
uses System.Classes, WinApi.Windows, Collections.Queues, DbgHookTypes, | ||
System.SysUtils, System.SyncObjs, DebugerTypes; | ||
|
||
type | ||
TProcessMemoryQueue = TQueue<PDbgMemInfoListBuf>; | ||
|
||
TDbgMemoryProfiler = class | ||
private | ||
FProcessMemoryQueue: TProcessMemoryQueue; | ||
|
||
FMemoryCheckMode: LongBool; | ||
FMemoryCallStack: LongBool; | ||
FMemoryCheckDoubleFree: LongBool; | ||
|
||
procedure SetMemoryCallStack(const Value: LongBool); | ||
procedure SetMemoryCheckDoubleFree(const Value: LongBool); | ||
procedure SetMemoryCheckMode(const Value: LongBool); | ||
public | ||
constructor Create; | ||
destructor Destroy; override; | ||
|
||
procedure Clear; | ||
|
||
function ProcessMemoryInfoQueue: LongBool; | ||
procedure ProcessMemoryInfoBuf(const Buf: PDbgMemInfoListBuf); | ||
|
||
function FindMemoryPointer(const Ptr: Pointer; var ThData: PThreadData; var MemInfo: TGetMemInfo): LongBool; | ||
|
||
procedure LoadMemoryInfoPackEx(const MemInfoPack: Pointer; const Count: Cardinal); | ||
|
||
procedure UpdateMemoryInfoObjectTypes; | ||
procedure UpdateMemoryInfoObjectTypesOfThread(ThData: PThreadData); | ||
|
||
property MemoryCheckMode: LongBool read FMemoryCheckMode write SetMemoryCheckMode; | ||
property MemoryCallStack: LongBool read FMemoryCallStack write SetMemoryCallStack; | ||
property MemoryCheckDoubleFree: LongBool read FMemoryCheckDoubleFree write SetMemoryCheckDoubleFree; | ||
end; | ||
|
||
implementation | ||
|
||
uses Debuger; | ||
|
||
const | ||
_MAX_MEM_INFO_BUF_COUNT = 512; | ||
|
||
|
||
{ TDbgMemoryProfiler } | ||
|
||
procedure TDbgMemoryProfiler.Clear; | ||
begin | ||
FProcessMemoryQueue.Clear; | ||
end; | ||
|
||
constructor TDbgMemoryProfiler.Create; | ||
begin | ||
inherited; | ||
|
||
FProcessMemoryQueue := TProcessMemoryQueue.Create(True); | ||
FProcessMemoryQueue.Capacity := _MAX_MEM_INFO_BUF_COUNT + 1; | ||
end; | ||
|
||
destructor TDbgMemoryProfiler.Destroy; | ||
begin | ||
Clear; | ||
|
||
FreeAndNil(FProcessMemoryQueue); | ||
|
||
inherited; | ||
end; | ||
|
||
function TDbgMemoryProfiler.FindMemoryPointer(const Ptr: Pointer; var ThData: PThreadData; var MemInfo: TGetMemInfo): LongBool; | ||
var | ||
Idx: Integer; | ||
begin | ||
Result := False; | ||
|
||
// Èùåì â òåêóùåì ïîòîêå | ||
if ThData <> Nil then | ||
Result := ThData^.DbgGetMemInfo.TryGetValue(Ptr, MemInfo); | ||
|
||
if not Result then | ||
begin | ||
// Èùåì â äðóãèõ ïîòîêàõ | ||
Idx := 0; | ||
repeat | ||
ThData := gvDebuger.GetThreadDataByIdx(Idx); | ||
if ThData <> Nil then | ||
begin | ||
Result := ThData^.DbgGetMemInfo.TryGetValue(Ptr, MemInfo); | ||
|
||
Inc(Idx); | ||
end; | ||
until Result or (ThData = Nil); | ||
end; | ||
end; | ||
|
||
procedure TDbgMemoryProfiler.LoadMemoryInfoPackEx(const MemInfoPack: Pointer; const Count: Cardinal); | ||
var | ||
Buf: PDbgMemInfoListBuf; | ||
begin | ||
if not MemoryCheckMode then | ||
Exit; | ||
|
||
while FProcessMemoryQueue.Count >= _MAX_MEM_INFO_BUF_COUNT do | ||
SwitchToThread; | ||
|
||
Buf := AllocMem(SizeOf(TDbgMemInfoListBuf)); | ||
Buf^.Count := Count; | ||
Buf^.DbgMemInfoList := AllocMem(Count * SizeOf(TDbgMemInfo)); | ||
Buf^.DbgPointIdx := gvDebuger.ProcessData.CurDbgPointIdx; | ||
|
||
if gvDebuger.ReadData(MemInfoPack, Buf^.DbgMemInfoList, Count * SizeOf(TDbgMemInfo)) then | ||
FProcessMemoryQueue.Enqueue(Buf) | ||
else | ||
RaiseDebugCoreException(); | ||
end; | ||
|
||
procedure TDbgMemoryProfiler.ProcessMemoryInfoBuf(const Buf: PDbgMemInfoListBuf); | ||
var | ||
Idx: Integer; | ||
DbgMemInfo: PDbgMemInfo; | ||
ThData: PThreadData; | ||
FoundThData: PThreadData; | ||
MemInfo: TGetMemInfo; | ||
NewMemInfo: TGetMemInfo; | ||
begin | ||
ThData := Nil; | ||
|
||
for Idx := 0 to Buf^.Count - 1 do | ||
begin | ||
DbgMemInfo := @Buf^.DbgMemInfoList^[Idx]; | ||
if (ThData = Nil) or (ThData^.ThreadID <> DbgMemInfo^.ThreadId) then | ||
ThData := gvDebuger.GetThreadData(DbgMemInfo^.ThreadId, True); | ||
|
||
if ThData = Nil then | ||
RaiseDebugCoreException(); | ||
|
||
case DbgMemInfo^.MemInfoType of | ||
miGetMem: | ||
begin | ||
//DoDbgLog(DbgMemInfo^.ThreadId, Format('%s: %p (%d)', ['GetMem', DbgMemInfo^.Ptr, DbgMemInfo^.Size])); | ||
|
||
// Åñëè íàéäåí åù¸ íåîñâîáîæäåííûé îáúåêò, òî îí óæå áûë êåì-òî îñâîáîæäåí | ||
// TODO: Åñëè åñòü òàêèå îáúåêòû, òî ýòî ìû ãäå-òî ïðîïóñòèëè FreeMem | ||
(* | ||
FoundThData := ThData; | ||
if FindMemoryPointer(DbgMemInfo^.Ptr, FoundThData, MemInfo) then | ||
begin | ||
//DoDbgLog(FoundThData^.ThreadId, Format('<<< ERROR!!! FOUND BEFORE GETMEM (%d)', [MemInfo^.Size])); | ||
Dec(FoundThData^.DbgGetMemInfoSize, MemInfo^.Size); | ||
Dec(FProcessData.ProcessGetMemCount); | ||
Dec(FProcessData.ProcessGetMemSize, MemInfo^.Size); | ||
FoundThData^.DbgGetMemInfo.Remove(DbgMemInfo^.Ptr); | ||
end; | ||
*) | ||
|
||
// Äîáàâëÿåì èíôó ïðî íîâûé îáúåêò | ||
NewMemInfo := TGetMemInfo.Create; | ||
|
||
NewMemInfo.PerfIdx := Buf^.DbgPointIdx; | ||
NewMemInfo.ObjAddr := DbgMemInfo^.Ptr; | ||
NewMemInfo.Size := DbgMemInfo^.Size; | ||
NewMemInfo.ObjectType := ''; // Íà ýòîò ìîìåíò òèï åù¸ ìîæåò áûòü íåîïðåäåëåí | ||
|
||
NewMemInfo.LoadStack(@DbgMemInfo^.Stack); | ||
|
||
ThData^.DbgGetMemInfo.AddOrSetValue(DbgMemInfo^.Ptr, NewMemInfo); | ||
TInterlocked.Add(ThData^.DbgGetMemInfoSize, NewMemInfo.Size); | ||
|
||
TInterlocked.Add(gvDebuger.ProcessData.ProcessGetMemCount, 1); | ||
TInterlocked.Add(gvDebuger.ProcessData.ProcessGetMemSize, NewMemInfo.Size); | ||
end; | ||
miFreeMem: | ||
begin | ||
//DoDbgLog(DbgMemInfo^.ThreadId, Format('%s: %p (%d)', ['FreeMem', DbgMemInfo^.Ptr, DbgMemInfo^.Size])); | ||
|
||
FoundThData := ThData; | ||
if FindMemoryPointer(DbgMemInfo^.Ptr, FoundThData, MemInfo) then | ||
begin | ||
TInterlocked.Add(FoundThData^.DbgGetMemInfoSize, -MemInfo.Size); | ||
|
||
TInterlocked.Add(gvDebuger.ProcessData.ProcessGetMemCount, -1); | ||
TInterlocked.Add(gvDebuger.ProcessData.ProcessGetMemSize, -MemInfo.Size); | ||
|
||
FoundThData^.DbgGetMemInfo.Remove(DbgMemInfo^.Ptr); | ||
end | ||
else | ||
begin | ||
// Ñþäà ìîæåò çàéòè, åñëè îáúåêò ñîçäàëñÿ ðàíüøå óñòàíîâêè õóêà íà ìåíåäæåð ïàìÿòè | ||
//RaiseDebugCoreException(); | ||
//DoDbgLog(DbgMemInfo^.ThreadId, '<<< ERROR!!! NOT FOUND FOR FREEMEM'); | ||
|
||
// TODO: Double free ??? | ||
end; | ||
end; | ||
end; | ||
end; | ||
end; | ||
|
||
function TDbgMemoryProfiler.ProcessMemoryInfoQueue: LongBool; | ||
var | ||
Buf: PDbgMemInfoListBuf; | ||
begin | ||
Result := False; | ||
|
||
if not MemoryCheckMode then | ||
Exit; | ||
|
||
try | ||
if FProcessMemoryQueue.Count > 0 then | ||
begin | ||
Buf := FProcessMemoryQueue.Dequeue; | ||
try | ||
ProcessMemoryInfoBuf(Buf); | ||
finally | ||
FreeMemory(Buf^.DbgMemInfoList); | ||
FreeMemory(Buf); | ||
end; | ||
|
||
Result := True; | ||
end; | ||
except | ||
on E: Exception do ; // TODO: | ||
end; | ||
end; | ||
|
||
procedure TDbgMemoryProfiler.SetMemoryCallStack(const Value: LongBool); | ||
begin | ||
FMemoryCallStack := Value; | ||
end; | ||
|
||
procedure TDbgMemoryProfiler.SetMemoryCheckDoubleFree(const Value: LongBool); | ||
begin | ||
FMemoryCheckDoubleFree := Value; | ||
end; | ||
|
||
procedure TDbgMemoryProfiler.SetMemoryCheckMode(const Value: LongBool); | ||
begin | ||
FMemoryCheckMode := Value; | ||
end; | ||
|
||
procedure TDbgMemoryProfiler.UpdateMemoryInfoObjectTypes; | ||
var | ||
Idx: Integer; | ||
ThData: PThreadData; | ||
begin | ||
Idx := 0; | ||
repeat | ||
ThData := gvDebuger.GetThreadDataByIdx(Idx); | ||
if ThData <> Nil then | ||
begin | ||
UpdateMemoryInfoObjectTypesOfThread(ThData); | ||
Inc(Idx); | ||
end; | ||
until ThData = Nil; | ||
|
||
// Ïîòåðÿøêè | ||
(* | ||
GetMemInfo := ProcessData.DbgGetMemInfo; | ||
if GetMemInfo.Count > 0 then | ||
begin | ||
for GetMemInfoItem in GetMemInfo do | ||
GetMemInfoItem.Value^.ObjectType := GetMemInfoItem.Value^.GetObjectType(GetMemInfoItem.Key); | ||
end; | ||
*) | ||
end; | ||
|
||
procedure TDbgMemoryProfiler.UpdateMemoryInfoObjectTypesOfThread(ThData: PThreadData); | ||
var | ||
GetMemInfo: TGetMemInfoList; | ||
GetMemInfoItem: TGetMemInfoItem; | ||
begin | ||
GetMemInfo := ThData^.DbgGetMemInfo; | ||
if GetMemInfo.Count > 0 then | ||
begin | ||
GetMemInfo.LockForRead; | ||
try | ||
for GetMemInfoItem in GetMemInfo do | ||
GetMemInfoItem.Value.CheckObjectType; | ||
finally | ||
GetMemInfo.UnLockForRead; | ||
end; | ||
end; | ||
end; | ||
|
||
end. |
Oops, something went wrong.