Menu
▾
▴
jcl-checkins-diff
|
From: <ou...@us...> - 2006-05-01 16:29:42
|
Revision: 1627 Author: outchy Date: 2006-05-01 09:29:36 -0700 (Mon, 01 May 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1627&view=rev Log Message: ----------- Mantis 3664 constructor export name fixed. Modified Paths: -------------- trunk/jcl/source/windows/JclDebug.pas Modified: trunk/jcl/source/windows/JclDebug.pas =================================================================== --- trunk/jcl/source/windows/JclDebug.pas 2006-05-01 16:17:04 UTC (rev 1626) +++ trunk/jcl/source/windows/JclDebug.pas 2006-05-01 16:29:36 UTC (rev 1627) @@ -511,8 +511,10 @@ function GetCount: Integer; procedure CorrectOnAccess(ASkipFirstItem: Boolean); public - constructor Create(ARaw: Boolean; AIgnoreLevels: DWORD; AFirstCaller: Pointer; - ADelayedTrace: Boolean = False); + constructor Create(ARaw: Boolean; AIgnoreLevels: DWORD; + AFirstCaller: Pointer); overload; + constructor Create(ARaw: Boolean; AIgnoreLevels: DWORD; + AFirstCaller: Pointer; ADelayedTrace: Boolean); overload; destructor Destroy; override; procedure ForceStackTracing; procedure AddToStrings(Strings: TStrings; IncludeModuleName: Boolean = False; @@ -3313,6 +3315,12 @@ TraceStackFrames; end; +constructor TJclStackInfoList.Create(ARaw: Boolean; AIgnoreLevels: DWORD; + AFirstCaller: Pointer); +begin + Create(ARaw, AIgnoreLevels, AFirstCaller, False); +end; + destructor TJclStackInfoList.Destroy; begin if Assigned(FStackData) then This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-05-18 22:41:36
|
Revision: 1659 Author: outchy Date: 2006-05-18 15:41:27 -0700 (Thu, 18 May 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1659&view=rev Log Message: ----------- Access violation fix Modified Paths: -------------- trunk/jcl/source/windows/JclDebug.pas Modified: trunk/jcl/source/windows/JclDebug.pas =================================================================== --- trunk/jcl/source/windows/JclDebug.pas 2006-05-18 16:04:47 UTC (rev 1658) +++ trunk/jcl/source/windows/JclDebug.pas 2006-05-18 22:41:27 UTC (rev 1659) @@ -355,9 +355,13 @@ protected function CreateDebugInfo(const Module: HMODULE): TJclDebugInfoSource; public - class procedure RegisterDebugInfoSource(const InfoSourceClass: TJclDebugInfoSourceClass); - class procedure UnRegisterDebugInfoSource(const InfoSourceClass: TJclDebugInfoSourceClass); - class procedure NeedInfoSourceClassList; + class procedure RegisterDebugInfoSource( + const InfoSourceClass: TJclDebugInfoSourceClass); + class procedure UnRegisterDebugInfoSource( + const InfoSourceClass: TJclDebugInfoSourceClass); + class procedure RegisterDebugInfoSourceFirst( + const InfoSourceClass: TJclDebugInfoSourceClass); + class procedure NeedInfoSourceClassList; function GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; property ItemFromModule[const Module: HMODULE]: TJclDebugInfoSource read GetItemFromModule; property Items[Index: Integer]: TJclDebugInfoSource read GetItems; @@ -2423,7 +2427,7 @@ var I: Integer; begin - NeedDebugInfoList; + NeedInfoSourceClassList; for I := 0 to InfoSourceClassList.Count - 1 do begin @@ -2510,6 +2514,14 @@ InfoSourceClassList.Add(Pointer(InfoSourceClass)); end; +class procedure TJclDebugInfoList.RegisterDebugInfoSourceFirst( + const InfoSourceClass: TJclDebugInfoSourceClass); +begin + NeedInfoSourceClassList; + + InfoSourceClassList.Insert(0, Pointer(InfoSourceClass)); +end; + class procedure TJclDebugInfoList.UnRegisterDebugInfoSource( const InfoSourceClass: TJclDebugInfoSourceClass); begin This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-06-13 17:28:48
|
Revision: 1676 Author: outchy Date: 2006-06-13 10:28:30 -0700 (Tue, 13 Jun 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1676&view=rev Log Message: ----------- Paths are now concatenated. Modified Paths: -------------- trunk/jcl/source/windows/JclDebug.pas Modified: trunk/jcl/source/windows/JclDebug.pas =================================================================== --- trunk/jcl/source/windows/JclDebug.pas 2006-06-10 18:56:24 UTC (rev 1675) +++ trunk/jcl/source/windows/JclDebug.pas 2006-06-13 17:28:30 UTC (rev 1676) @@ -2812,9 +2812,9 @@ begin SearchPath := StrEnsureSuffix(DirSeparator, ExtractFilePath(GetModulePath(GetCurrentProcess)) + GetCurrentFolder); if GetEnvironmentVar(EnvironmentVarNtSymbolPath, EnvironmentVarValue) then - SearchPath := StrEnsureSuffix(DirSeparator, EnvironmentVarValue); + SearchPath := StrEnsureSuffix(DirSeparator, EnvironmentVarValue) + SearchPath; if GetEnvironmentVar(EnvironmentVarAlternateNtSymbolPath, EnvironmentVarValue) then - SearchPath := StrEnsureSuffix(DirSeparator, EnvironmentVarValue); + SearchPath := StrEnsureSuffix(DirSeparator, EnvironmentVarValue) + SearchPath; if IsWinNT then Result := SymInitializeFunc(GetCurrentProcess, PChar(SearchPath), False) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-06-18 10:25:29
|
Revision: 1677 Author: outchy Date: 2006-06-18 03:25:20 -0700 (Sun, 18 Jun 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1677&view=rev Log Message: ----------- Fix from Eric Grange: empty name when no info matches the address. Modified Paths: -------------- trunk/jcl/source/windows/JclDebug.pas Modified: trunk/jcl/source/windows/JclDebug.pas =================================================================== --- trunk/jcl/source/windows/JclDebug.pas 2006-06-13 17:28:30 UTC (rev 1676) +++ trunk/jcl/source/windows/JclDebug.pas 2006-06-18 10:25:20 UTC (rev 1677) @@ -2382,19 +2382,23 @@ Value, Name: Integer; StartAddr, ModuleStartAddr, ItemAddr: DWORD; P: Pointer; + Found: Boolean; begin ModuleStartAddr := ModuleStartFromAddr(Addr); P := MakePtr(PJclDbgHeader(FStream.Memory)^.SourceNames); Name := 0; StartAddr := 0; ItemAddr := 0; + Found := False; while ReadValue(P, Value) do begin Inc(StartAddr, Value); if Addr < StartAddr then begin if ItemAddr < ModuleStartAddr then - Name := 0; + Name := 0 + else + Found := True; Break; end else @@ -2404,7 +2408,10 @@ Inc(Name, Value); end; end; - Result := DataToStr(Name); + if Found then + Result := DataToStr(Name) + else + Result := ''; end; //=== { TJclDebugInfoSource } ================================================ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-12-26 13:20:23
|
Revision: 1843
http://svn.sourceforge.net/jcl/?rev=1843&view=rev
Author: outchy
Date: 2006-12-26 05:20:20 -0800 (Tue, 26 Dec 2006)
Log Message:
-----------
Reworking default order of debug sources: exports has the lowest priority but will be used if the symbol source is based on exports.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2006-12-23 10:31:33 UTC (rev 1842)
+++ trunk/jcl/source/windows/JclDebug.pas 2006-12-26 13:20:20 UTC (rev 1843)
@@ -2536,12 +2536,12 @@
{$IFNDEF DEBUG_NO_MAP}
InfoSourceClassList.Add(Pointer(TJclDebugInfoMap));
{$ENDIF !DEBUG_NO_MAP}
+ {$IFNDEF DEBUG_NO_SYMBOLS}
+ InfoSourceClassList.Add(Pointer(TJclDebugInfoSymbols));
+ {$ENDIF !DEBUG_NO_SYMBOLS}
{$IFNDEF DEBUG_NO_EXPORTS}
InfoSourceClassList.Add(Pointer(TJclDebugInfoExports));
{$ENDIF !DEBUG_NO_EXPORTS}
- {$IFNDEF DEBUG_NO_SYMBOLS}
- InfoSourceClassList.Add(Pointer(TJclDebugInfoSymbols));
- {$ENDIF !DEBUG_NO_SYMBOLS}
end;
end;
@@ -2951,7 +2951,7 @@
Result := Result and SymGetModuleInfoFunc(ProcessHandle, Module, ModuleInfo);
end;
- Result := Result and (ModuleInfo.SymType <> SymNone);
+ Result := Result and not (ModuleInfo.SymType in [SymNone, SymExport]);
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-01-16 22:29:52
|
Revision: 1894
http://svn.sourceforge.net/jcl/?rev=1894&view=rev
Author: outchy
Date: 2007-01-16 14:29:50 -0800 (Tue, 16 Jan 2007)
Log Message:
-----------
C++Builder 6 has a strange bug with pointer parameters with default value.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-01-16 14:39:09 UTC (rev 1893)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-01-16 22:29:50 UTC (rev 1894)
@@ -542,9 +542,11 @@
procedure CorrectOnAccess(ASkipFirstItem: Boolean);
public
constructor Create(ARaw: Boolean; AIgnoreLevels: DWORD;
- AFirstCaller: Pointer; ABaseOfStack: Pointer = nil); overload;
+ AFirstCaller: Pointer); overload;
constructor Create(ARaw: Boolean; AIgnoreLevels: DWORD;
- AFirstCaller: Pointer; ADelayedTrace: Boolean; ABaseOfStack: Pointer = nil); overload;
+ AFirstCaller: Pointer; ADelayedTrace: Boolean); overload;
+ constructor Create(ARaw: Boolean; AIgnoreLevels: DWORD;
+ AFirstCaller: Pointer; ADelayedTrace: Boolean; ABaseOfStack: Pointer); overload;
destructor Destroy; override;
procedure ForceStackTracing;
procedure AddToStrings(Strings: TStrings; IncludeModuleName: Boolean = False;
@@ -557,8 +559,11 @@
property Raw: Boolean read FRaw;
end;
+function JclCreateStackList(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer): TJclStackInfoList; overload;
function JclCreateStackList(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer;
- DelayedTrace: Boolean = False; BaseOfStack: Pointer = nil): TJclStackInfoList;
+ DelayedTrace: Boolean): TJclStackInfoList; overload;
+function JclCreateStackList(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer;
+ DelayedTrace: Boolean; BaseOfStack: Pointer): TJclStackInfoList; overload;
function JclLastExceptStackList: TJclStackInfoList;
function JclLastExceptStackListToStrings(Strings: TStrings; IncludeModuleName: Boolean = False;
@@ -3601,7 +3606,20 @@
IncludeVAdress);
end;
+function JclCreateStackList(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer): TJclStackInfoList;
+begin
+ Result := TJclStackInfoList.Create(Raw, AIgnoreLevels, FirstCaller, False, nil);
+ GlobalStackList.AddObject(Result);
+end;
+
function JclCreateStackList(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer;
+ DelayedTrace: Boolean): TJclStackInfoList;
+begin
+ Result := TJclStackInfoList.Create(Raw, AIgnoreLevels, FirstCaller, DelayedTrace, nil);
+ GlobalStackList.AddObject(Result);
+end;
+
+function JclCreateStackList(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer;
DelayedTrace: Boolean; BaseOfStack: Pointer): TJclStackInfoList;
begin
Result := TJclStackInfoList.Create(Raw, AIgnoreLevels, FirstCaller, DelayedTrace, BaseOfStack);
@@ -3622,6 +3640,18 @@
//=== { TJclStackInfoList } ==================================================
constructor TJclStackInfoList.Create(ARaw: Boolean; AIgnoreLevels: DWORD;
+ AFirstCaller: Pointer);
+begin
+ Create(ARaw, AIgnoreLevels, AFirstCaller, False, nil);
+end;
+
+constructor TJclStackInfoList.Create(ARaw: Boolean; AIgnoreLevels: DWORD;
+ AFirstCaller: Pointer; ADelayedTrace: Boolean);
+begin
+ Create(ARaw, AIgnoreLevels, AFirstCaller, ADelayedTrace, nil);
+end;
+
+constructor TJclStackInfoList.Create(ARaw: Boolean; AIgnoreLevels: DWORD;
AFirstCaller: Pointer; ADelayedTrace: Boolean; ABaseOfStack: Pointer);
var
Item: TJclStackInfoItem;
@@ -3652,12 +3682,6 @@
TraceStackFrames;
end;
-constructor TJclStackInfoList.Create(ARaw: Boolean; AIgnoreLevels: DWORD;
- AFirstCaller: Pointer; ABaseOfStack: Pointer);
-begin
- Create(ARaw, AIgnoreLevels, AFirstCaller, False, ABaseOfStack);
-end;
-
destructor TJclStackInfoList.Destroy;
begin
if Assigned(FStackData) then
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-02-06 17:28:20
|
Revision: 1913
http://svn.sourceforge.net/jcl/?rev=1913&view=rev
Author: outchy
Date: 2007-02-06 09:28:14 -0800 (Tue, 06 Feb 2007)
Log Message:
-----------
Handle MAP files made by Delphi 2005 and earlier versions of the IDE: the modules can now contain more than one segment of code (used to be named "CODE" and "ICODE").
Both segments (if present to keep backward compatibility with previous versions of Delphi) are stored in Jedi Debug Data (either inserted in the binary or placed in the .jdbg file).
Minor change: symbols in MAP files generated by C++Builder may contain spaces in their names, they are now kept.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-04 18:37:27 UTC (rev 1912)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-06 17:28:14 UTC (rev 1913)
@@ -131,7 +131,7 @@
constructor Create(const MapFileName: TFileName); virtual;
destructor Destroy; override;
procedure Parse;
- class function MapStringToStr(MapString: PJclMapString): string;
+ class function MapStringToStr(MapString: PJclMapString; IgnoreSpaces: Boolean = False): string;
class function MapStringToFileName(MapString: PJclMapString): string;
property LinkerBug: Boolean read FLinkerBug;
property LinkerBugUnitName: string read GetLinkerBugUnitName;
@@ -170,38 +170,52 @@
end;
// MAP file scanner
+ PJclMapSegmentClass = ^TJclMapSegmentClass;
+ TJclMapSegmentClass = record
+ Segment: Word;
+ Addr: DWORD;
+ VA: DWORD;
+ Len: DWORD;
+ SectionName: PJclMapString;
+ GroupName: PJclMapString;
+ end;
+
PJclMapSegment = ^TJclMapSegment;
TJclMapSegment = record
- StartAddr: DWORD;
- EndAddr: DWORD;
+ Segment: Word;
+ StartVA: DWORD; // VA relative to (module base address + $10000)
+ EndVA: DWORD;
UnitName: PJclMapString;
end;
PJclMapProcName = ^TJclMapProcName;
TJclMapProcName = record
- Addr: DWORD;
+ Segment: Word;
+ VA: DWORD; // VA relative to (module base address + $10000)
ProcName: PJclMapString;
end;
PJclMapLineNumber = ^TJclMapLineNumber;
TJclMapLineNumber = record
- Addr: DWORD;
+ Segment: Word;
+ VA: DWORD; // VA relative to (module base address + $10000)
LineNumber: Integer;
end;
TJclMapScanner = class(TJclAbstractMapParser)
private
+ FSegmentClasses: array of TJclMapSegmentClass;
FLineNumbers: array of TJclMapLineNumber;
FProcNames: array of TJclMapProcName;
FSegments: array of TJclMapSegment;
FSourceNames: array of TJclMapProcName;
- FLastValidAddr: TJclMapAddress;
FLineNumbersCnt: Integer;
FLineNumberErrors: Integer;
FNewUnitFileName: PJclMapString;
FProcNamesCnt: Integer;
- FTopValidAddr: Integer;
+ FSegmentCnt: Integer;
protected
+ function AddrToVA(const Addr: DWORD): DWORD;
procedure ClassTableItem(const Address: TJclMapAddress; Len: Integer; SectionName, GroupName: PJclMapString); override;
procedure SegmentItem(const Address: TJclMapAddress; Len: Integer; GroupName, UnitName: PJclMapString); override;
procedure PublicsByNameItem(const Address: TJclMapAddress; Name: PJclMapString); override;
@@ -211,6 +225,7 @@
procedure Scan;
public
constructor Create(const MapFileName: TFileName); override;
+ // Addr are virtual addresses relative to (module base address + $10000)
function LineNumberFromAddr(Addr: DWORD): Integer; overload;
function LineNumberFromAddr(Addr: DWORD; var Offset: Integer): Integer; overload;
function ModuleNameFromAddr(Addr: DWORD): string;
@@ -1022,7 +1037,8 @@
SetString(Result, PStart, PEnd - PStart);
end;
-class function TJclAbstractMapParser.MapStringToStr(MapString: PJclMapString): string;
+class function TJclAbstractMapParser.MapStringToStr(MapString: PJclMapString;
+ IgnoreSpaces: Boolean): string;
var
P: PChar;
begin
@@ -1041,8 +1057,12 @@
else
begin
P := MapString;
- while not (P^ in [AnsiSpace, AnsiCarriageReturn, '(']) do
- Inc(P);
+ if IgnoreSpaces then
+ while not (P^ in [AnsiCarriageReturn, '(']) do
+ Inc(P)
+ else
+ while not (P^ in [AnsiSpace, AnsiCarriageReturn, '(']) do
+ Inc(P);
end;
SetString(Result, MapString, P - MapString);
end;
@@ -1267,7 +1287,7 @@
begin
A := ReadAddress;
P1 := ReadString;
- SkipWhiteSpace;
+ SkipEndLine; // compatibility with C++Builder MAP files
PublicsByNameItem(A, P1);
end;
if SyncToHeader(PublicsByValueHeader) then
@@ -1275,7 +1295,7 @@
begin
A := ReadAddress;
P1 := ReadString;
- SkipWhiteSpace;
+ SkipEndLine; // compatibility with C++Builder MAP files
PublicsByValueItem(A, P1);
end;
while SyncToPrefix(LineNumbersPrefix) do
@@ -1331,14 +1351,16 @@
Name: PJclMapString);
begin
if Assigned(FOnPublicsByName) then
- FOnPublicsByName(Self, Address, MapStringToStr(Name));
+ // MAP files generated by C++Builder have spaces in their identifier names
+ FOnPublicsByName(Self, Address, MapStringToStr(Name, True));
end;
procedure TJclMapParser.PublicsByValueItem(const Address: TJclMapAddress;
Name: PJclMapString);
begin
if Assigned(FOnPublicsByValue) then
- FOnPublicsByValue(Self, Address, MapStringToStr(Name));
+ // MAP files generated by C++Builder have spaces in their identifier names
+ FOnPublicsByValue(Self, Address, MapStringToStr(Name, True));
end;
procedure TJclMapParser.SegmentItem(const Address: TJclMapAddress;
@@ -1356,9 +1378,35 @@
Scan;
end;
+function TJclMapScanner.AddrToVA(const Addr: DWORD): DWORD;
+begin
+ // MAP file format was changed in Delphi 2005
+ // before Delphi 2005: segments started at offset 0
+ // only one segment of code
+ // after Delphi 2005: segments started at code base address (module base address + $10000)
+ // 2 segments of code
+ if (Length(FSegmentClasses) > 0) and (FSegmentClasses[0].Addr > 0) then
+ // Delphi 2005 and earlier
+ // The first segment should be code starting at module base address + $10000
+ Result := Addr - FSegmentClasses[0].Addr
+ else
+ // before Delphi 2005
+ Result := Addr;
+end;
+
procedure TJclMapScanner.ClassTableItem(const Address: TJclMapAddress; Len: Integer;
SectionName, GroupName: PJclMapString);
+var
+ C: Integer;
begin
+ C := Length(FSegmentClasses);
+ SetLength(FSegmentClasses, C + 1);
+ FSegmentClasses[C].Segment := Address.Segment;
+ FSegmentClasses[C].Addr := Address.Offset;
+ FSegmentClasses[C].VA := AddrToVA(Address.Offset);
+ FSegmentClasses[C].Len := Len;
+ FSegmentClasses[C].SectionName := SectionName;
+ FSegmentClasses[C].GroupName := GroupName;
end;
function TJclMapScanner.LineNumberFromAddr(Addr: DWORD): Integer;
@@ -1370,7 +1418,7 @@
function Search_MapLineNumber(Item1, Item2: Pointer): Integer;
begin
- Result := Integer(PJclMapLineNumber(Item1)^.Addr) - PInteger(Item2)^;
+ Result := Integer(PJclMapLineNumber(Item1)^.VA) - PInteger(Item2)^;
end;
function TJclMapScanner.LineNumberFromAddr(Addr: DWORD; var Offset: Integer): Integer;
@@ -1382,37 +1430,44 @@
Result := 0;
Offset := 0;
I := SearchDynArray(FLineNumbers, SizeOf(FLineNumbers[0]), Search_MapLineNumber, @Addr, True);
- if (I <> -1) and (FLineNumbers[I].Addr >= ModuleStartAddr) then
+ if (I <> -1) and (FLineNumbers[I].VA >= ModuleStartAddr) then
begin
Result := FLineNumbers[I].LineNumber;
- Offset := Addr - FLineNumbers[I].Addr;
+ Offset := Addr - FLineNumbers[I].VA;
end;
end;
procedure TJclMapScanner.LineNumbersItem(LineNumber: Integer; const Address: TJclMapAddress);
var
- C: Integer;
+ SegIndex, C: Integer;
+ VA: DWORD;
+ Added: Boolean;
begin
- // Try to eliminate invalid line numbers caused by bug in the linker
- if (FLastValidAddr.Offset = 0) or ((Address.Offset > 0) and (Address.Offset <= FTopValidAddr) and
- (FLastValidAddr.Segment = Address.Segment) and (FLastValidAddr.Offset < Address.Offset)) then
+ Added := False;
+ for SegIndex := Low(FSegmentClasses) to High(FSegmentClasses) do
+ if (FSegmentClasses[SegIndex].Segment = Address.Segment)
+ and (DWORD(Address.Offset) < FSegmentClasses[SegIndex].Len) then
begin
- FLastValidAddr := Address;
+ VA := AddrToVA(DWORD(Address.Offset) + FSegmentClasses[SegIndex].Addr);
if FLineNumbersCnt mod 256 = 0 then
SetLength(FLineNumbers, FLineNumbersCnt + 256);
- FLineNumbers[FLineNumbersCnt].Addr := Address.Offset;
+ FLineNumbers[FLineNumbersCnt].Segment := FSegmentClasses[SegIndex].Segment;
+ FLineNumbers[FLineNumbersCnt].VA := VA;
FLineNumbers[FLineNumbersCnt].LineNumber := LineNumber;
Inc(FLineNumbersCnt);
+ Added := True;
if FNewUnitFileName <> nil then
begin
C := Length(FSourceNames);
SetLength(FSourceNames, C + 1);
- FSourceNames[C].Addr := Address.Offset;
+ FSourceNames[C].Segment := FSegmentClasses[SegIndex].Segment;
+ FSourceNames[C].VA := VA;
FSourceNames[C].ProcName := FNewUnitFileName;
FNewUnitFileName := nil;
end;
- end
- else
+ Break;
+ end;
+ if not Added then
Inc(FLineNumberErrors);
end;
@@ -1427,7 +1482,7 @@
begin
Result := '';
for I := Length(FSegments) - 1 downto 0 do
- if (FSegments[I].StartAddr <= Addr) and (FSegments[I].EndAddr >= Addr) then
+ if (FSegments[I].StartVA <= Addr) and (Addr < FSegments[I].EndVA) then
begin
Result := MapStringToStr(FSegments[I].UnitName);
Break;
@@ -1440,9 +1495,9 @@
begin
Result := DWORD(-1);
for I := Length(FSegments) - 1 downto 0 do
- if (FSegments[I].StartAddr <= Addr) and (FSegments[I].EndAddr >= Addr) then
+ if (FSegments[I].StartVA <= Addr) and (Addr < FSegments[I].EndVA) then
begin
- Result := FSegments[I].StartAddr;
+ Result := FSegments[I].StartVA;
Break;
end;
end;
@@ -1456,7 +1511,7 @@
function Search_MapProcName(Item1, Item2: Pointer): Integer;
begin
- Result := Integer(PJclMapProcName(Item1)^.Addr) - PInteger(Item2)^;
+ Result := Integer(PJclMapProcName(Item1)^.VA) - PInteger(Item2)^;
end;
function TJclMapScanner.ProcNameFromAddr(Addr: DWORD; var Offset: Integer): string;
@@ -1468,10 +1523,10 @@
Result := '';
Offset := 0;
I := SearchDynArray(FProcNames, SizeOf(FProcNames[0]), Search_MapProcName, @Addr, True);
- if (I <> -1) and (FProcNames[I].Addr >= ModuleStartAddr) then
+ if (I <> -1) and (FProcNames[I].VA >= ModuleStartAddr) then
begin
- Result := MapStringToStr(FProcNames[I].ProcName);
- Offset := Addr - FProcNames[I].Addr;
+ Result := MapStringToStr(FProcNames[I].ProcName, True);
+ Offset := Addr - FProcNames[I].VA;
end;
end;
@@ -1481,53 +1536,84 @@
end;
procedure TJclMapScanner.PublicsByValueItem(const Address: TJclMapAddress; Name: PJclMapString);
+var
+ SegIndex: Integer;
begin
- if Address.Segment = 1 then
+ for SegIndex := Low(FSegmentClasses) to High(FSegmentClasses) do
+ if (FSegmentClasses[SegIndex].Segment = Address.Segment)
+ and (DWORD(Address.Offset) < FSegmentClasses[SegIndex].Len) then
begin
if FProcNamesCnt mod 256 = 0 then
SetLength(FProcNames, FProcNamesCnt + 256);
- FProcNames[FProcNamesCnt].Addr := Address.Offset;
+ FProcNames[FProcNamesCnt].Segment := FSegmentClasses[SegIndex].Segment;
+ FProcNames[FProcNamesCnt].VA := AddrToVA(DWORD(Address.Offset) + FSegmentClasses[SegIndex].Addr);
FProcNames[FProcNamesCnt].ProcName := Name;
Inc(FProcNamesCnt);
+ Break;
end;
end;
+function Sort_MapLineNumber(Item1, Item2: Pointer): Integer;
+begin
+ Result := Integer(PJclMapLineNumber(Item1)^.VA) - Integer(PJclMapLineNumber(Item2)^.VA);
+end;
+
+function Sort_MapProcName(Item1, Item2: Pointer): Integer;
+begin
+ Result := Integer(PJclMapProcName(Item1)^.VA) - Integer(PJclMapProcName(Item2)^.VA);
+end;
+
+function Sort_MapSegment(Item1, Item2: Pointer): Integer;
+begin
+ Result := Integer(PJclMapSegment(Item1)^.StartVA) - Integer(PJclMapSegment(Item2)^.StartVA);
+end;
+
procedure TJclMapScanner.Scan;
begin
- FLastValidAddr.Segment := 0;
- FLastValidAddr.Offset := 0;
- FTopValidAddr := 0;
FLineNumberErrors := 0;
+ FSegmentCnt := 0;
+ FProcNamesCnt := 0;
Parse;
SetLength(FLineNumbers, FLineNumbersCnt);
SetLength(FProcNames, FProcNamesCnt);
+ SetLength(FSegments, FSegmentCnt);
+ SortDynArray(FLineNumbers, SizeOf(FLineNumbers[0]), Sort_MapLineNumber);
+ SortDynArray(FProcNames, SizeOf(FProcNames[0]), Sort_MapProcName);
+ SortDynArray(FSegments, SizeOf(FSegments[0]), Sort_MapSegment);
+ SortDynArray(FSourceNames, SizeOf(FSourceNames[0]), Sort_MapProcName);
end;
procedure TJclMapScanner.SegmentItem(const Address: TJclMapAddress; Len: Integer;
GroupName, UnitName: PJclMapString);
var
- C: Integer;
+ SegIndex: Integer;
+ VA: DWORD;
begin
- if Address.Segment = 1 then
+ for SegIndex := Low(FSegmentClasses) to High(FSegmentClasses) do
+ if (FSegmentClasses[SegIndex].Segment = Address.Segment)
+ and (DWORD(Address.Offset) < FSegmentClasses[SegIndex].Len) then
begin
- C := Length(FSegments);
- SetLength(FSegments, C + 1);
- FSegments[C].StartAddr := Address.Offset;
- FSegments[C].EndAddr := Address.Offset + Len;
- FSegments[C].UnitName := UnitName;
- FTopValidAddr := Max(FTopValidAddr, Address.Offset + Len);
+ VA := AddrToVA(DWORD(Address.Offset) + FSegmentClasses[SegIndex].Addr);
+ if FSegmentCnt mod 16 = 0 then
+ SetLength(FSegments, FSegmentCnt + 16);
+ FSegments[FSegmentCnt].Segment := FSegmentClasses[SegIndex].Segment;
+ FSegments[FSegmentCnt].StartVA := VA;
+ FSegments[FSegmentCnt].EndVA := VA + DWORD(Len);
+ FSegments[FSegmentCnt].UnitName := UnitName;
+ Inc(FSegmentCnt);
+ Break;
end;
end;
function TJclMapScanner.SourceNameFromAddr(Addr: DWORD): string;
var
I: Integer;
- ModuleStartAddr: DWORD;
+ ModuleStartVA: DWORD;
begin
- ModuleStartAddr := ModuleStartFromAddr(Addr);
+ ModuleStartVA := ModuleStartFromAddr(Addr);
Result := '';
I := SearchDynArray(FSourceNames, SizeOf(FSourceNames[0]), Search_MapProcName, @Addr, True);
- if (I <> -1) and (FSourceNames[I].Addr >= ModuleStartAddr) then
+ if (I <> -1) and (FSourceNames[I].VA >= ModuleStartVA) then
Result := MapStringToStr(FSourceNames[I].ProcName);
end;
@@ -1932,13 +2018,10 @@
procedure TJclBinDebugGenerator.CreateData;
var
- FileHeader: TJclDbgHeader;
WordList: TStringList;
WordStream: TMemoryStream;
- I, D: Integer;
- S: string;
- L1, L2, L3: Integer;
- FirstWord, SecondWord: Integer;
+ LastSegmentID: Word;
+ LastSegmentStored: Boolean;
function AddWord(const S: string): Integer;
var
@@ -1988,7 +2071,35 @@
LastValue := Value;
end;
+ function IsSegmentStored(SegID: Word): Boolean;
+ var
+ SegIndex: Integer;
+ GroupName: string;
+ begin
+ if (SegID <> LastSegmentID) then
+ begin
+ LastSegmentID := $FFFF;
+ LastSegmentStored := False;
+ for SegIndex := Low(FSegmentClasses) to High(FSegmentClasses) do
+ if FSegmentClasses[SegIndex].Segment = SegID then
+ begin
+ LastSegmentID := FSegmentClasses[SegIndex].Segment;
+ GroupName := MapStringToStr(FSegmentClasses[SegIndex].GroupName);
+ LastSegmentStored := (GroupName = 'CODE') or (GroupName = 'ICODE');
+ Break;
+ end;
+ end;
+ Result := LastSegmentStored;
+ end;
+
+var
+ FileHeader: TJclDbgHeader;
+ I, D: Integer;
+ S: string;
+ L1, L2, L3: Integer;
+ FirstWord, SecondWord: Integer;
begin
+ LastSegmentID := $FFFF;
WordStream := TMemoryStream.Create;
WordList := TStringList.Create;
try
@@ -2006,8 +2117,9 @@
L1 := 0;
L2 := 0;
for I := 0 to Length(FSegments) - 1 do
+ if IsSegmentStored(FSegments[I].Segment) then
begin
- WriteValueOfs(FSegments[I].StartAddr, L1);
+ WriteValueOfs(FSegments[I].StartVA, L1);
WriteValueOfs(AddWord(MapStringToStr(FSegments[I].UnitName)), L2);
end;
WriteValue(MaxInt);
@@ -2016,8 +2128,9 @@
L1 := 0;
L2 := 0;
for I := 0 to Length(FSourceNames) - 1 do
+ if IsSegmentStored(FSourceNames[I].Segment) then
begin
- WriteValueOfs(FSourceNames[I].Addr, L1);
+ WriteValueOfs(FSourceNames[I].VA, L1);
WriteValueOfs(AddWord(MapStringToStr(FSourceNames[I].ProcName)), L2);
end;
WriteValue(MaxInt);
@@ -2027,9 +2140,11 @@
L2 := 0;
L3 := 0;
for I := 0 to Length(FProcNames) - 1 do
+ if IsSegmentStored(FProcNames[I].Segment) then
begin
- WriteValueOfs(FProcNames[I].Addr, L1);
- S := MapStringToStr(FProcNames[I].ProcName);
+ WriteValueOfs(FProcNames[I].VA, L1);
+ // MAP files generated by C++Builder have spaces in their names
+ S := MapStringToStr(FProcNames[I].ProcName, True);
D := Pos('.', S);
if D = 1 then
begin
@@ -2056,8 +2171,9 @@
L1 := 0;
L2 := 0;
for I := 0 to Length(FLineNumbers) - 1 do
+ if IsSegmentStored(FLineNumbers[I].Segment) then
begin
- WriteValueOfs(FLineNumbers[I].Addr, L1);
+ WriteValueOfs(FLineNumbers[I].VA, L1);
WriteValueOfs(FLineNumbers[I].LineNumber, L2);
end;
WriteValue(MaxInt);
@@ -2088,18 +2204,18 @@
var
P: Pointer;
Value, LineNumber, C, Ln: Integer;
- CurrAddr: DWORD;
+ CurrVA: DWORD;
begin
if FLineNumbers = nil then
begin
LineNumber := 0;
- CurrAddr := 0;
+ CurrVA := 0;
C := 0;
Ln := 0;
P := MakePtr(PJclDbgHeader(FStream.Memory)^.LineNumbers);
while ReadValue(P, Value) do
begin
- Inc(CurrAddr, Value);
+ Inc(CurrVA, Value);
ReadValue(P, Value);
Inc(LineNumber, Value);
if C = Ln then
@@ -2110,7 +2226,7 @@
Ln := Ln + Ln div 4;
SetLength(FLineNumbers, Ln);
end;
- FLineNumbers[C].Addr := CurrAddr;
+ FLineNumbers[C].VA := CurrVA;
FLineNumbers[C].LineNumber := LineNumber;
Inc(C);
end;
@@ -2215,21 +2331,21 @@
var
P: Pointer;
Value, LineNumber: Integer;
- CurrAddr, ModuleStartAddr, ItemAddr: DWORD;
+ CurrVA, ModuleStartVA, ItemVA: DWORD;
begin
- ModuleStartAddr := ModuleStartFromAddr(Addr);
+ ModuleStartVA := ModuleStartFromAddr(Addr);
LineNumber := 0;
Offset := 0;
if FCacheData then
begin
CacheLineNumbers;
for Value := Length(FLineNumbers) - 1 downto 0 do
- if FLineNumbers[Value].Addr <= Addr then
+ if FLineNumbers[Value].VA <= Addr then
begin
- if FLineNumbers[Value].Addr >= ModuleStartAddr then
+ if FLineNumbers[Value].VA >= ModuleStartVA then
begin
LineNumber := FLineNumbers[Value].LineNumber;
- Offset := Addr - FLineNumbers[Value].Addr;
+ Offset := Addr - FLineNumbers[Value].VA;
end;
Break;
end;
@@ -2237,14 +2353,14 @@
else
begin
P := MakePtr(PJclDbgHeader(FStream.Memory)^.LineNumbers);
- CurrAddr := 0;
- ItemAddr := 0;
+ CurrVA := 0;
+ ItemVA := 0;
while ReadValue(P, Value) do
begin
- Inc(CurrAddr, Value);
- if Addr < CurrAddr then
+ Inc(CurrVA, Value);
+ if Addr < CurrVA then
begin
- if ItemAddr < ModuleStartAddr then
+ if ItemVA < ModuleStartVA then
begin
LineNumber := 0;
Offset := 0;
@@ -2253,10 +2369,10 @@
end
else
begin
- ItemAddr := CurrAddr;
+ ItemVA := CurrVA;
ReadValue(P, Value);
Inc(LineNumber, Value);
- Offset := Addr - CurrAddr;
+ Offset := Addr - CurrVA;
end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-02-14 18:54:11
|
Revision: 1920
http://svn.sourceforge.net/jcl/?rev=1920&view=rev
Author: ahuser
Date: 2007-02-14 10:53:29 -0800 (Wed, 14 Feb 2007)
Log Message:
-----------
Fixed missing location where the exception was raised.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-12 19:14:04 UTC (rev 1919)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-14 18:53:29 UTC (rev 1920)
@@ -3962,8 +3962,7 @@
CallInstructionSize: Cardinal;
StackTop: DWORD;
begin
- Clear;
- Capacity := 16; // reduce ReallocMem calls
+ Capacity := 32; // reduce ReallocMem calls, must be > 1 because the caller's EIP register is already in the list
if DelayedTrace then
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-02-14 19:02:13
|
Revision: 1921
http://svn.sourceforge.net/jcl/?rev=1921&view=rev
Author: ahuser
Date: 2007-02-14 11:02:08 -0800 (Wed, 14 Feb 2007)
Log Message:
-----------
Fixed missing location where the exception was raised. (StackFrames)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-14 18:53:29 UTC (rev 1920)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-14 19:02:08 UTC (rev 1921)
@@ -3933,8 +3933,7 @@
StackFrame: PStackFrame;
StackInfo: TStackInfo;
begin
- Clear;
- Capacity := 16; // reduce ReallocMem calls
+ Capacity := 32; // reduce ReallocMem calls, must be > 1 because the caller's EIP register is already in the list
// Start at level 0
StackInfo.Level := 0;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-02-14 19:41:37
|
Revision: 1923
http://svn.sourceforge.net/jcl/?rev=1923&view=rev
Author: ahuser
Date: 2007-02-14 11:41:34 -0800 (Wed, 14 Feb 2007)
Log Message:
-----------
Added stMainThreadOnly
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-14 19:06:34 UTC (rev 1922)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-14 19:41:34 UTC (rev 1923)
@@ -667,7 +667,7 @@
type
TJclStackTrackingOption =
(stStack, stExceptFrame, stRawMode, stAllModules, stStaticModuleList,
- stDelayedTrace, stTraceEAbort);
+ stDelayedTrace, stTraceEAbort, stMainThreadOnly);
TJclStackTrackingOptions = set of TJclStackTrackingOption;
var
@@ -3616,15 +3616,17 @@
var
IsMultiThreaded: Boolean;
begin
- IsMultiThreaded := IsMultiThread;
- if IsMultiThreaded then
- FLock.Enter;
- try
- if FModulesList <> ModulesList then
+ if FModulesList <> ModulesList then
+ begin
+ IsMultiThreaded := IsMultiThread;
+ if IsMultiThreaded then
+ FLock.Enter;
+ try
FreeAndNil(ModulesList);
- finally
- if IsMultiThreaded then
- FLock.Leave;
+ finally
+ if IsMultiThreaded then
+ FLock.Leave;
+ end;
end;
end;
@@ -4293,7 +4295,8 @@
procedure DoExceptNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean;
BaseOfStack: Pointer);
begin
- if TrackingActive and ((stTraceEAbort in JclStackTrackingOptions) or not (ExceptObj is EAbort)) then
+ if TrackingActive and ((stTraceEAbort in JclStackTrackingOptions) or not (ExceptObj is EAbort)) and
+ (not (stMainThreadOnly in JclStackTrackingOptions) or (GetCurrentThreadId = MainThreadID)) then
begin
if stStack in JclStackTrackingOptions then
DoExceptionStackTrace(ExceptObj, ExceptAddr, OSException, BaseOfStack);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-02-14 23:17:35
|
Revision: 1927
http://svn.sourceforge.net/jcl/?rev=1927&view=rev
Author: outchy
Date: 2007-02-14 15:17:33 -0800 (Wed, 14 Feb 2007)
Log Message:
-----------
Eliminating duplicates in unit names
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-14 22:44:22 UTC (rev 1926)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-14 23:17:33 UTC (rev 1927)
@@ -3203,13 +3203,17 @@
IncludeStartProcLineOffset: Boolean; IncludeVAdress: Boolean): string;
var
Info, StartProcInfo: TJclLocationInfo;
- OffsetStr, StartProcOffsetStr: string;
+ OffsetStr, StartProcOffsetStr, FixedProcedureName: string;
Module : HMODULE;
begin
OffsetStr := '';
if GetLocationInfo(Addr, Info) then
with Info do
begin
+ FixedProcedureName := ProcedureName;
+ if Pos(UnitName + '.', FixedProcedureName) = 1 then
+ FixedProcedureName := Copy(FixedProcedureName, Length(UnitName) + 2, Length(FixedProcedureName) - Length(UnitName) - 1);
+
if LineNumber > 0 then
begin
if IncludeStartProcLineOffset and GetLocationInfo(Pointer(Cardinal(Info.Address) -
@@ -3224,7 +3228,7 @@
else
OffsetStr := Format(' - $%x', [-OffsetFromLineNumber])
end;
- Result := Format('[%p] %s.%s (Line %u, "%s"%s)%s', [Addr, UnitName, ProcedureName, LineNumber,
+ Result := Format('[%p] %s.%s (Line %u, "%s"%s)%s', [Addr, UnitName, FixedProcedureName, LineNumber,
SourceName, StartProcOffsetStr, OffsetStr]);
end
else
@@ -3232,9 +3236,9 @@
if IncludeAddressOffset then
OffsetStr := Format(' + $%x', [OffsetFromProcName]);
if UnitName <> '' then
- Result := Format('[%p] %s.%s%s', [Addr, UnitName, ProcedureName, OffsetStr])
+ Result := Format('[%p] %s.%s%s', [Addr, UnitName, FixedProcedureName, OffsetStr])
else
- Result := Format('[%p] %s%s', [Addr, ProcedureName, OffsetStr]);
+ Result := Format('[%p] %s%s', [Addr, FixedProcedureName, OffsetStr]);
end;
end
else
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-02-14 23:31:47
|
Revision: 1928
http://svn.sourceforge.net/jcl/?rev=1928&view=rev
Author: ahuser
Date: 2007-02-14 15:31:31 -0800 (Wed, 14 Feb 2007)
Log Message:
-----------
Fixed: Trace Stack frames included the JclDebug/JclExceptHook stack frames.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-14 23:17:33 UTC (rev 1927)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-14 23:31:31 UTC (rev 1928)
@@ -2592,6 +2592,7 @@
begin
NeedInfoSourceClassList;
+ Result := nil;
for I := 0 to InfoSourceClassList.Count - 1 do
begin
Result := TJclDebugInfoSourceClass(InfoSourceClassList.Items[I]).Create(Module);
@@ -3665,7 +3666,7 @@
procedure CorrectExceptStackListTop(List: TJclStackInfoList; SkipFirstItem: Boolean);
var
- TopItem,I, FoundPos: Integer;
+ TopItem, I, FoundPos: Integer;
begin
FoundPos := -1;
if SkipFirstItem then
@@ -3948,7 +3949,13 @@
// Get the current stack frame from the EBP register
StackFrame := FFrameEBP
else
- StackFrame := GetEBP;
+ begin
+ // We define the bottom of the valid stack to be the current ESP pointer
+ if BaseOfStack = 0 then
+ BaseOfStack := DWORD(GetEBP);
+ // Get a pointer to the current bottom of the stack
+ StackFrame := PStackFrame(BaseOfStack);
+ end;
// We define the bottom of the valid stack to be the current EBP Pointer
// There is a TIB field called pvStackUserBase, but this includes more of the
@@ -4063,7 +4070,7 @@
// First check that the address is within range of our code segment!
C8P := PDWORD(CodeAddr - 8);
C4P := PDWORD(CodeAddr - 4);
- Result := (CodeAddr > 8) and ValidCodeAddr(DWORD(C8P), FModuleInfoList) and not IsBadReadPtr(C8P, 8);
+ Result := (CodeAddr > 8) and not IsBadReadPtr(C8P, 8) and ValidCodeAddr(DWORD(C8P), FModuleInfoList);
// Now check to see if the instruction preceding the return address
// could be a valid CALL instruction
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-02-15 21:50:26
|
Revision: 1934
http://svn.sourceforge.net/jcl/?rev=1934&view=rev
Author: outchy
Date: 2007-02-15 13:50:24 -0800 (Thu, 15 Feb 2007)
Log Message:
-----------
Minor style cleaning
Validating memory before read
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-15 21:02:59 UTC (rev 1933)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-15 21:50:24 UTC (rev 1934)
@@ -2842,39 +2842,32 @@
function TJclDebugInfoExports.IsAddressInThisExportedFunction(Addr: PByteArray; FunctionStartAddr: Cardinal): Boolean;
begin
Dec(Cardinal(Addr), 6);
- while Cardinal(Addr) > FunctionStartAddr do
+ Result := False;
+
+ while (Cardinal(Addr) > FunctionStartAddr) do
begin
+ if IsBadReadPtr(Addr, 6) then
+ Exit;
+
if (Addr[0] = $C2) and // ret $xxxx
(((Addr[3] = $90) and (Addr[4] = $90) and (Addr[5] = $90)) or // nop
((Addr[3] = $CC) and (Addr[4] = $CC) and (Addr[5] = $CC))) then // int 3
- begin
- Result := False;
Exit;
- end
- else
+
if (Addr[0] = $C3) and // ret
(((Addr[1] = $90) and (Addr[2] = $90) and (Addr[3] = $90)) or // nop
((Addr[1] = $CC) and (Addr[2] = $CC) and (Addr[3] = $CC))) then // int 3
- begin
- Result := False;
Exit;
- end
- else
+
if (Addr[0] = $E9) and // jmp rel-far
(((Addr[5] = $90) and (Addr[6] = $90) and (Addr[7] = $90)) or // nop
((Addr[5] = $CC) and (Addr[6] = $CC) and (Addr[7] = $CC))) then // int 3
- begin
- Result := False;
Exit;
- end
- else
+
if (Addr[0] = $EB) and // jmp rel-near
(((Addr[2] = $90) and (Addr[3] = $90) and (Addr[4] = $90)) or // nop
((Addr[2] = $CC) and (Addr[3] = $CC) and (Addr[4] = $CC))) then // int 3
- begin
- Result := False;
Exit;
- end;
Dec(Cardinal(Addr));
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-05-22 19:58:22
|
Revision: 2013
http://svn.sourceforge.net/jcl/?rev=2013&view=rev
Author: ahuser
Date: 2007-05-22 12:58:20 -0700 (Tue, 22 May 2007)
Log Message:
-----------
Fixed Mantis #4125: Memory leak in GetLocationInfo
(Mantis #4125)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-05-22 16:43:49 UTC (rev 2012)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-05-22 19:58:20 UTC (rev 2013)
@@ -2709,6 +2709,7 @@
var
Item: TJclDebugInfoSource;
begin
+ Finalize(Info);
FillChar(Info, SizeOf(Info), #0);
Item := ItemFromModule[ModuleFromAddr(Addr)];
if Item <> nil then
@@ -3317,6 +3318,7 @@
DebugInfoCritSect.Leave;
end;
except
+ Finalize(Result);
FillChar(Result, SizeOf(Result), #0);
end;
end;
@@ -4192,6 +4194,52 @@
StoreToList(StackInfo);
end;
+function SearchForStackPtrManipulation(StackPtr: Pointer; Proc: Pointer): Pointer;
+{$IFDEF SUPPORTS_INLINE}
+inline;
+{$ENDIF SUPPORTS_INLINE}
+{var
+ Addr: PByteArray;}
+begin
+{ Addr := Proc;
+ while (Addr <> nil) and (Cardinal(Addr) > Cardinal(Proc) - $100) and not IsBadReadPtr(Addr, 6) do
+ begin
+ if (Addr[0] = $55) and // push ebp
+ (Addr[1] = $8B) and (Addr[2] = $EC) then // mov ebp,esp
+ begin
+ if (Addr[3] = $83) and (Addr[4] = $C4) then // add esp,c8
+ begin
+ Result := Pointer(Integer(StackPtr) - ShortInt(Addr[5]));
+ Exit;
+ end;
+ Break;
+ end;
+
+ if (Addr[0] = $C2) and // ret $xxxx
+ (((Addr[3] = $90) and (Addr[4] = $90) and (Addr[5] = $90)) or // nop
+ ((Addr[3] = $CC) and (Addr[4] = $CC) and (Addr[5] = $CC))) then // int 3
+ Break;
+
+ if (Addr[0] = $C3) and // ret
+ (((Addr[1] = $90) and (Addr[2] = $90) and (Addr[3] = $90)) or // nop
+ ((Addr[1] = $CC) and (Addr[2] = $CC) and (Addr[3] = $CC))) then // int 3
+ Break;
+
+ if (Addr[0] = $E9) and // jmp rel-far
+ (((Addr[5] = $90) and (Addr[6] = $90) and (Addr[7] = $90)) or // nop
+ ((Addr[5] = $CC) and (Addr[6] = $CC) and (Addr[7] = $CC))) then // int 3
+ Break;
+
+ if (Addr[0] = $EB) and // jmp rel-near
+ (((Addr[2] = $90) and (Addr[3] = $90) and (Addr[4] = $90)) or // nop
+ ((Addr[2] = $CC) and (Addr[3] = $CC) and (Addr[4] = $CC))) then // int 3
+ Break;
+
+ Dec(Cardinal(Addr));
+ end;}
+ Result := StackPtr;
+end;
+
procedure TJclStackInfoList.TraceStackRaw;
var
StackInfo: TStackInfo;
@@ -4219,6 +4267,9 @@
StackTop := TopOfStack;
+ if Count > 0 then
+ StackPtr := SearchForStackPtrManipulation(StackPtr, Pointer(Items[0].StackInfo.CallerAdr));
+
// We will not be able to fill in all the fields in the StackInfo record,
// so just blank it all out first
FillChar(StackInfo, SizeOf(StackInfo), 0);
@@ -4238,6 +4289,7 @@
Inc(StackInfo.Level);
// then report it back to our caller
StoreToList(StackInfo);
+ StackPtr := SearchForStackPtrManipulation(StackPtr, Pointer(StackInfo.CallerAdr));
end;
// Look at the next DWORD on the stack
Inc(StackPtr);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2006-10-08 20:25:09
|
Revision: 1793
http://svn.sourceforge.net/jcl/?rev=1793&view=rev
Author: ahuser
Date: 2006-10-08 13:25:00 -0700 (Sun, 08 Oct 2006)
Log Message:
-----------
- Fixed Exception bug in TJclExceptFrameList.AddFrame.
- Speed improvements
- Added stTraceEAbort which is not set by default, so for EAbort exceptions there is no strack tracing.
- Limited stackframe levels to 4096 items
- Fixed IgnoreLevels in DoExceptionStackTrace (from 7 to 9 in RawMode)
- StackFrame: EBP must be above the previous EBP to be valid (temporary usage of EBP as a free register issue)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2006-10-06 17:26:35 UTC (rev 1792)
+++ trunk/jcl/source/windows/JclDebug.pas 2006-10-08 20:25:00 UTC (rev 1793)
@@ -640,7 +640,7 @@
type
TJclStackTrackingOption =
(stStack, stExceptFrame, stRawMode, stAllModules, stStaticModuleList,
- stDelayedTrace);
+ stDelayedTrace, stTraceEAbort);
TJclStackTrackingOptions = set of TJclStackTrackingOption;
var
@@ -735,6 +735,7 @@
const
EnvironmentVarNtSymbolPath = '_NT_SYMBOL_PATH'; // do not localize
EnvironmentVarAlternateNtSymbolPath = '_NT_ALTERNATE_SYMBOL_PATH'; // do not localize
+ MaxStackTraceItems = 4096;
{$IFDEF UNITVERSIONING}
const
@@ -2484,7 +2485,7 @@
else
FreeAndNil(Result);
except
- FreeAndNil(Result);
+ Result.Free;
raise;
end;
end;
@@ -3558,7 +3559,7 @@
RawMode := stRawMode in JclStackTrackingOptions;
Delayed := stDelayedTrace in JclStackTrackingOptions;
if RawMode then
- IgnoreLevels := 7
+ IgnoreLevels := 9
else
IgnoreLevels := 5;
if OSException then
@@ -3703,34 +3704,50 @@
function TJclStackInfoList.NextStackFrame(var StackFrame: PStackFrame; var StackInfo: TStackInfo): Boolean;
var
CallInstructionSize: Cardinal;
+ StackFrameCallersEBP, NewEBP: Cardinal;
+ StackFrameCallerAdr: Cardinal;
begin
// Only report this stack frame into the StockInfo structure
// if the StackFrame pointer, EBP on the stack and return
// address on the stack are valid addresses
+ StackFrameCallersEBP := StackInfo.CallersEBP;
while ValidStackAddr(DWORD(StackFrame)) do
begin
+ // CallersEBP above the previous CallersEBP
+ NewEBP := StackFrame^.CallersEBP;
+ if NewEBP <= StackFrameCallersEBP then
+ Break;
+ StackFrameCallersEBP := NewEBP;
+
// CallerAdr within current process space, code segment etc.
// CallersEBP within current thread stack. Added Mar 12 2002 per Hallvard's suggestion
- if ValidCodeAddr(StackFrame^.CallerAdr, FModuleInfoList) and ValidStackAddr(StackFrame^.CallersEBP + FStackOffset) then
+ StackFrameCallerAdr := StackFrame^.CallerAdr;
+ if ValidCodeAddr(StackFrameCallerAdr, FModuleInfoList) and ValidStackAddr(StackFrameCallersEBP + FStackOffset) then
begin
Inc(StackInfo.Level);
StackInfo.StackFrame := StackFrame;
StackInfo.ParamPtr := PDWORDArray(DWORD(StackFrame) + SizeOf(TStackFrame));
- StackInfo.CallersEBP := StackFrame^.CallersEBP;
+
+ if StackFrameCallersEBP > StackInfo.CallersEBP then
+ StackInfo.CallersEBP := StackFrameCallersEBP
+ else
+ // EBP points to an address that is below the last EBP, so it must be invalid
+ Break;
+
// Calculate the address of caller by subtracting the CALL instruction size (if possible)
- if ValidCallSite(StackFrame^.CallerAdr, CallInstructionSize) then
- StackInfo.CallerAdr := StackFrame^.CallerAdr - CallInstructionSize
+ if ValidCallSite(StackFrameCallerAdr, CallInstructionSize) then
+ StackInfo.CallerAdr := StackFrameCallerAdr - CallInstructionSize
else
- StackInfo.CallerAdr := StackFrame^.CallerAdr;
- StackInfo.DumpSize := StackFrame^.CallersEBP - DWORD(StackFrame);
+ StackInfo.CallerAdr := StackFrameCallerAdr;
+ StackInfo.DumpSize := StackFrameCallersEBP - DWORD(StackFrame);
StackInfo.ParamSize := (StackInfo.DumpSize - SizeOf(TStackFrame)) div 4;
// Step to the next stack frame by following the EBP pointer
- StackFrame := PStackFrame(StackFrame^.CallersEBP + FStackOffset);
+ StackFrame := PStackFrame(StackFrameCallersEBP + FStackOffset);
Result := True;
Exit;
end;
// Step to the next stack frame by following the EBP pointer
- StackFrame := PStackFrame(StackFrame^.CallersEBP + FStackOffset);
+ StackFrame := PStackFrame(StackFrameCallersEBP + FStackOffset);
end;
Result := False;
end;
@@ -3757,9 +3774,11 @@
StackInfo: TStackInfo;
begin
Clear;
+ Capacity := 16; // reduce ReallocMem calls
// Start at level 0
StackInfo.Level := 0;
+ StackInfo.CallersEBP := 0;
if DelayedTrace then
// Get the current stack frame from the EBP register
StackFrame := FFrameEBP
@@ -3771,7 +3790,7 @@
// stack than what would define valid stack frames.
BaseOfStack := DWORD(StackFrame) - 1;
// Loop over and report all valid stackframes
- while NextStackFrame(StackFrame, StackInfo) do
+ while NextStackFrame(StackFrame, StackInfo) and (Count <> MaxStackTraceItems) do
StoreToList(StackInfo);
end;
@@ -3784,6 +3803,7 @@
StackTop: DWORD;
begin
Clear;
+ Capacity := 16; // reduce ReallocMem calls
if DelayedTrace then
begin
@@ -3807,7 +3827,7 @@
// Clear the previous call address
PrevCaller := 0;
// Loop through all of the valid stack space
- while DWORD(StackPtr) < StackTop do
+ while (DWORD(StackPtr) < StackTop) and (Count <> MaxStackTraceItems) do
begin
// If the current DWORD on the stack refers to a valid call site...
if ValidCallSite(StackPtr^, CallInstructionSize) and (StackPtr^ <> PrevCaller) then
@@ -4086,13 +4106,7 @@
function TJclExceptFrameList.AddFrame(AFrame: PExcFrame): TJclExceptFrame;
begin
Result := TJclExceptFrame.Create(AFrame);
- try
- Add(Result);
- except
- Remove(Result);
- Result.Free;
- raise;
- end;
+ Add(Result);
end;
function TJclExceptFrameList.GetItems(Index: Integer): TJclExceptFrame;
@@ -4130,7 +4144,7 @@
procedure DoExceptNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean);
begin
- if TrackingActive then
+ if TrackingActive and ((stTraceEAbort in JclStackTrackingOptions) or not (ExceptObj is EAbort)) then
begin
if stStack in JclStackTrackingOptions then
DoExceptionStackTrace(ExceptObj, ExceptAddr, OSException);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2006-10-09 17:05:59
|
Revision: 1794
http://svn.sourceforge.net/jcl/?rev=1794&view=rev
Author: ahuser
Date: 2006-10-09 10:05:51 -0700 (Mon, 09 Oct 2006)
Log Message:
-----------
- Fixed overflow bug
- Fixed IgnoreLevels for OSExceptions
- Fixed possible endless recursion
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2006-10-08 20:25:00 UTC (rev 1793)
+++ trunk/jcl/source/windows/JclDebug.pas 2006-10-09 17:05:51 UTC (rev 1794)
@@ -41,6 +41,7 @@
interface
{$I jcl.inc}
+{$R-,Q-}
uses
{$IFDEF UNITVERSIONING}
@@ -1096,8 +1097,6 @@
end;
end;
- {$OVERFLOWCHECKS OFF}
-
function ReadHexValue: Integer;
var
C: Char;
@@ -1133,10 +1132,6 @@
until False;
end;
- {$IFDEF OVERFLOWCHECKS_ON}
- {$OVERFLOWCHECKS ON}
- {$ENDIF OVERFLOWCHECKS_ON}
-
function ReadAddress: TJclMapAddress;
begin
Result.Segment := ReadHexValue;
@@ -1539,9 +1534,6 @@
{ D5 D4 D3 D2 D1 D0 C5 C4 | Data byte 2 }
{--------------------------------- }
-{$OVERFLOWCHECKS OFF}
-{$RANGECHECKS OFF}
-
function SimpleCryptString(const S: string): string;
var
I: Integer;
@@ -1692,14 +1684,6 @@
SetLength(Result, DWORD(P) - DWORD(Pointer(Result)) + 1);
end;
-{$IFDEF RANGECHECKS_ON}
-{$RANGECHECKS ON}
-{$ENDIF RANGECHECKS_ON}
-
-{$IFDEF OVERFLOWCHECKS_ON}
-{$OVERFLOWCHECKS ON}
-{$ENDIF OVERFLOWCHECKS_ON}
-
function ConvertMapFileToJdbgFile(const MapFileName: TFileName): Boolean;
var
Dummy1: string;
@@ -1894,8 +1878,6 @@
inherited Destroy;
end;
-{$OVERFLOWCHECKS OFF}
-
function TJclBinDebugGenerator.CalculateCheckSum: Boolean;
var
Header: PJclDbgHeader;
@@ -1920,10 +1902,6 @@
end;
end;
-{$IFDEF OVERFLOWCHECKS_ON}
-{$OVERFLOWCHECKS ON}
-{$ENDIF OVERFLOWCHECKS_ON}
-
procedure TJclBinDebugGenerator.CreateData;
var
FileHeader: TJclDbgHeader;
@@ -2150,8 +2128,6 @@
end;
end;
-{$OVERFLOWCHECKS OFF}
-
procedure TJclBinDebugScanner.CheckFormat;
var
CheckSum: Integer;
@@ -2177,10 +2153,6 @@
end;
end;
-{$IFDEF OVERFLOWCHECKS_ON}
-{$OVERFLOWCHECKS ON}
-{$ENDIF OVERFLOWCHECKS_ON}
-
function TJclBinDebugScanner.DataToStr(A: Integer): string;
var
P: PChar;
@@ -3563,7 +3535,10 @@
else
IgnoreLevels := 5;
if OSException then
- FirstCaller := ExceptAddr
+ begin
+ Inc(IgnoreLevels); // => HandleAnyException
+ FirstCaller := ExceptAddr;
+ end
else
FirstCaller := nil;
// CorrectExceptStackListTop(JclCreateStackList(RawMode, IgnoreLevels, FirstCaller), OSException);
@@ -3699,8 +3674,6 @@
Result := TJclStackInfoItem(Get(Index));
end;
-{$OVERFLOWCHECKS OFF}
-
function TJclStackInfoList.NextStackFrame(var StackFrame: PStackFrame; var StackInfo: TStackInfo): Boolean;
var
CallInstructionSize: Cardinal;
@@ -3752,10 +3725,6 @@
Result := False;
end;
-{$IFDEF OVERFLOWCHECKS_ON}
-{$OVERFLOWCHECKS ON}
-{$ENDIF OVERFLOWCHECKS_ON}
-
procedure TJclStackInfoList.StoreToList(const StackInfo: TStackInfo);
var
Item: TJclStackInfoItem;
@@ -3790,7 +3759,7 @@
// stack than what would define valid stack frames.
BaseOfStack := DWORD(StackFrame) - 1;
// Loop over and report all valid stackframes
- while NextStackFrame(StackFrame, StackInfo) and (Count <> MaxStackTraceItems) do
+ while NextStackFrame(StackFrame, StackInfo) and (inherited Count <> MaxStackTraceItems) do
StoreToList(StackInfo);
end;
@@ -3827,7 +3796,7 @@
// Clear the previous call address
PrevCaller := 0;
// Loop through all of the valid stack space
- while (DWORD(StackPtr) < StackTop) and (Count <> MaxStackTraceItems) do
+ while (DWORD(StackPtr) < StackTop) and (inherited Count <> MaxStackTraceItems) do
begin
// If the current DWORD on the stack refers to a valid call site...
if ValidCallSite(StackPtr^, CallInstructionSize) and (StackPtr^ <> PrevCaller) then
@@ -3875,17 +3844,9 @@
end;
FFrameEBP := GetEBP;
-
- {$OVERFLOWCHECKS OFF}
-
FStackOffset := DWORD(FStackData) - DWORD(StackPtr);
-
FFrameEBP := Pointer(Cardinal(FFrameEBP) + FStackOffset);
TopOfStack := TopOfStack + FStackOffset;
-
- {$IFDEF OVERFLOWCHECKS_ON}
- {$OVERFLOWCHECKS ON}
- {$ENDIF OVERFLOWCHECKS_ON}
end;
// Validate that the code address is a valid code site
@@ -3894,8 +3855,6 @@
// http://developer.intel.com/design/pentiumii/manuals/243191.htm
// Instruction format, Chapter 2 and The CALL instruction: page 3-53, 3-54
-{$OVERFLOWCHECKS OFF}
-
function TJclStackInfoList.ValidCallSite(CodeAddr: DWORD; var CallInstructionSize: Cardinal): Boolean;
var
CodeDWORD4: DWORD;
@@ -3946,10 +3905,6 @@
end;
end;
-{$IFDEF OVERFLOWCHECKS_ON}
-{$OVERFLOWCHECKS ON}
-{$ENDIF OVERFLOWCHECKS_ON}
-
{$IFNDEF STACKFRAMES_ON}
{$STACKFRAMES OFF}
{$ENDIF ~STACKFRAMES_ON}
@@ -4083,14 +4038,14 @@
if FrameKind <> efkUnknown then
begin
Result := Pointer(GetJmpDest(PJmpInstruction(DWORD(@ExcFrame.Desc.Instructions))));
- if Result = nil then
- Result := @ExcFrame.Desc.Instructions;
+ if Result = nil then
+ Result := @ExcFrame.Desc.Instructions;
end
else
begin
Result := Pointer(GetJmpDest(PJmpInstruction(DWORD(@ExcFrame.Desc))));
- if Result = nil then
- Result := @ExcFrame.Desc;
+ if Result = nil then
+ Result := @ExcFrame.Desc;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2006-10-16 19:04:43
|
Revision: 1800
http://svn.sourceforge.net/jcl/?rev=1800&view=rev
Author: ahuser
Date: 2006-10-16 12:04:35 -0700 (Mon, 16 Oct 2006)
Log Message:
-----------
Protection against recursion
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2006-10-16 19:04:13 UTC (rev 1799)
+++ trunk/jcl/source/windows/JclDebug.pas 2006-10-16 19:04:35 UTC (rev 1800)
@@ -522,6 +522,7 @@
FCorrectOnAccess: Boolean;
FSkipFirstItem: Boolean;
FDelayedTrace: Boolean;
+ FInStackTracing: Boolean;
FRaw: Boolean;
FStackOffset: Cardinal;
function GetItems(Index: Integer): TJclStackInfoItem;
@@ -3628,15 +3629,20 @@
procedure TJclStackInfoList.ForceStackTracing;
begin
- if DelayedTrace and Assigned(FStackData) then
+ if DelayedTrace and Assigned(FStackData) and not FInStackTracing then
begin
- if Raw then
- TraceStackRaw
- else
- TraceStackFrames;
- FDelayedTrace := False;
- if FCorrectOnAccess then
- CorrectExceptStackListTop(Self, FSkipFirstItem);
+ FInStackTracing := True;
+ try
+ if Raw then
+ TraceStackRaw
+ else
+ TraceStackFrames;
+ if FCorrectOnAccess then
+ CorrectExceptStackListTop(Self, FSkipFirstItem);
+ finally
+ FInStackTracing := False;
+ FDelayedTrace := False;
+ end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2006-12-23 10:31:35
|
Revision: 1842
http://svn.sourceforge.net/jcl/?rev=1842&view=rev
Author: outchy
Date: 2006-12-23 02:31:33 -0800 (Sat, 23 Dec 2006)
Log Message:
-----------
Mantis 4011 fixed freeing of freed instances
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2006-12-20 17:24:47 UTC (rev 1841)
+++ trunk/jcl/source/windows/JclDebug.pas 2006-12-23 10:31:33 UTC (rev 1842)
@@ -470,8 +470,11 @@
private
FThreadID: DWORD;
FTimeStamp: TDateTime;
+ protected
+ FOnDestroy: TNotifyEvent;
public
constructor Create;
+ destructor Destroy; override;
property ThreadID: DWORD read FThreadID;
property TimeStamp: TDateTime read FTimeStamp;
end;
@@ -3289,6 +3292,13 @@
FTimeStamp := Now;
end;
+destructor TJclStackBaseList.Destroy;
+begin
+ if Assigned(FOnDestroy) then
+ FOnDestroy(Self);
+ inherited Destroy;
+end;
+
//=== { TJclGlobalStackList } ================================================
type
@@ -3300,6 +3310,7 @@
FTIDLocked: Boolean;
function GetExceptStackInfo: TJclStackInfoList;
function GetLastExceptFrameList: TJclExceptFrameList;
+ procedure ItemDestroyed(Sender: TObject);
public
destructor Destroy; override;
procedure AddObject(AObject: TJclStackBaseList);
@@ -3314,13 +3325,11 @@
GlobalStackList: TJclGlobalStackList;
destructor TJclGlobalStackList.Destroy;
-var
- I: Integer;
begin
with LockList do
try
- for I := 0 to Count - 1 do
- TObject(Items[I]).Free;
+ while Count > 0 do
+ TObject(Items[0]).Free;
finally
UnlockList;
end;
@@ -3331,6 +3340,7 @@
var
ReplacedObj: TObject;
begin
+ AObject.FOnDestroy := ItemDestroyed;
with LockList do
try
ReplacedObj := FindObject(AObject.ThreadID, TJclStackBaseListClass(AObject.ClassType));
@@ -3379,6 +3389,16 @@
Result := TJclExceptFrameList(FindObject(GetCurrentThreadId, TJclExceptFrameList));
end;
+procedure TJclGlobalStackList.ItemDestroyed(Sender: TObject);
+begin
+ with LockList do
+ try
+ Remove(Sender);
+ finally
+ UnlockList;
+ end;
+end;
+
procedure TJclGlobalStackList.LockThreadID(TID: DWORD);
begin
with LockList do
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-02-14 23:40:18
|
Revision: 1929
http://svn.sourceforge.net/jcl/?rev=1929&view=rev
Author: outchy
Date: 2007-02-14 15:40:16 -0800 (Wed, 14 Feb 2007)
Log Message:
-----------
Byte offset in the procedure was badly inserted at the beginning of the string if Line numbers are present, module name is selected and VAddress isn't.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-14 23:31:31 UTC (rev 1928)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-14 23:40:16 UTC (rev 1929)
@@ -3251,10 +3251,12 @@
begin
Module := ModuleFromAddr(Addr);
if IncludeVAdress then
+ begin
OffsetStr := Format('(%p) ', [Pointer(DWORD(Addr) - Module - ModuleCodeOffset)]);
+ Result := OffsetStr + Result;
+ end;
if IncludeModuleName then
Insert(Format('{%-12s}', [ExtractFileName(GetModulePath(Module))]), Result, 11);
- Result := OffsetStr + Result;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-02-15 00:43:59
|
Revision: 1930
http://svn.sourceforge.net/jcl/?rev=1930&view=rev
Author: ahuser
Date: 2007-02-14 16:43:57 -0800 (Wed, 14 Feb 2007)
Log Message:
-----------
Fixed: Application disappeared when with XP-Theming and ComCtrl32.dll from the WinSxS directory.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-14 23:40:16 UTC (rev 1929)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-15 00:43:57 UTC (rev 1930)
@@ -2943,7 +2943,7 @@
SymGetSymFromAddrFuncName = 'SymGetSymFromAddr'; // do not localize
SymGetModuleInfoFuncName = 'SymGetModuleInfo'; // do not localize
SymLoadModuleFuncName = 'SymLoadModule'; // do not localize
- SymGetLineFromAddrName = 'SymGetLineFromAddr'; // do not localize
+ SymGetLineFromAddrName = 'SymGetLineFromAddr'; // do not localize
class function TJclDebugInfoSymbols.InitializeDebugSymbols: Boolean;
var
@@ -3067,12 +3067,11 @@
ZeroMemory(@ModuleInfo, SizeOf(ModuleInfo));
ModuleInfo.SizeOfStruct := SizeOf(ModuleInfo);
- if Result
- and ((not SymGetModuleInfoFunc(ProcessHandle, Module, ModuleInfo))
- or (ModuleInfo.BaseOfImage = 0)) then
+ if ((not SymGetModuleInfoFunc(ProcessHandle, Module, ModuleInfo))
+ or (ModuleInfo.BaseOfImage = 0)) then
begin
ModuleFileName := GetModulePath(Module);
- Result := (DWORD(SymLoadModuleFunc(ProcessHandle, 0, PChar(ModuleFileName), nil, 0, 0)) <> 0);
+ Result := (DWORD(SymLoadModuleFunc(ProcessHandle, 0, PChar(ModuleFileName), nil, HInstance, 0)) <> 0);
ZeroMemory(@ModuleInfo, SizeOf(ModuleInfo));
ModuleInfo.SizeOfStruct := SizeOf(ModuleInfo);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-02-15 16:56:02
|
Revision: 1931
http://svn.sourceforge.net/jcl/?rev=1931&view=rev
Author: ahuser
Date: 2007-02-15 08:55:51 -0800 (Thu, 15 Feb 2007)
Log Message:
-----------
Fixed: Delphi 7's map file set both CODE and DATA section to offset 0x0000000.
Fixed: Delphi 2005+ map files contain set the last line of "empty" unit to VA 0x00000000
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-15 00:43:57 UTC (rev 1930)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-15 16:55:51 UTC (rev 1931)
@@ -119,6 +119,7 @@
FStream: TJclFileMappingStream;
function GetLinkerBugUnitName: string;
protected
+ FModule: HMODULE;
FLastUnitName: PJclMapString;
FLastUnitFileName: PJclMapString;
procedure ClassTableItem(const Address: TJclMapAddress; Len: Integer; SectionName, GroupName: PJclMapString); virtual; abstract;
@@ -128,13 +129,14 @@
procedure LineNumberUnitItem(UnitName, UnitFileName: PJclMapString); virtual; abstract;
procedure LineNumbersItem(LineNumber: Integer; const Address: TJclMapAddress); virtual; abstract;
public
- constructor Create(const MapFileName: TFileName); virtual;
+ constructor Create(const MapFileName: TFileName; Module: HMODULE); overload; virtual;
+ constructor Create(const MapFileName: TFileName); overload;
destructor Destroy; override;
procedure Parse;
class function MapStringToStr(MapString: PJclMapString; IgnoreSpaces: Boolean = False): string;
class function MapStringToFileName(MapString: PJclMapString): string;
property LinkerBug: Boolean read FLinkerBug;
- property LinkerBugUnitName: string read GetLinkerBugUnitName;
+ property LinkerBugUnitName: string read GetLinkerBugUnitName;
property Stream: TJclFileMappingStream read FStream;
end;
@@ -224,7 +226,7 @@
procedure LineNumberUnitItem(UnitName, UnitFileName: PJclMapString); override;
procedure Scan;
public
- constructor Create(const MapFileName: TFileName); override;
+ constructor Create(const MapFileName: TFileName; Module: HMODULE); override;
// Addr are virtual addresses relative to (module base address + $10000)
function LineNumberFromAddr(Addr: DWORD): Integer; overload;
function LineNumberFromAddr(Addr: DWORD; var Offset: Integer): Integer; overload;
@@ -269,7 +271,7 @@
protected
procedure CreateData;
public
- constructor Create(const MapFileName: TFileName); override;
+ constructor Create(const MapFileName: TFileName; Module: HMODULE); override;
destructor Destroy; override;
function CalculateCheckSum: Boolean;
property DataStream: TMemoryStream read FDataStream;
@@ -987,12 +989,19 @@
//=== { TJclAbstractMapParser } ==============================================
-constructor TJclAbstractMapParser.Create(const MapFileName: TFileName);
+constructor TJclAbstractMapParser.Create(const MapFileName: TFileName; Module: HMODULE);
begin
+ inherited Create;
+ FModule := Module;
if FileExists(MapFileName) then
FStream := TJclFileMappingStream.Create(MapFileName, fmOpenRead or fmShareDenyWrite);
end;
+constructor TJclAbstractMapParser.Create(const MapFileName: TFileName);
+begin
+ Create(MapFileName, 0);
+end;
+
destructor TJclAbstractMapParser.Destroy;
begin
FreeAndNil(FStream);
@@ -1372,9 +1381,9 @@
//=== { TJclMapScanner } =====================================================
-constructor TJclMapScanner.Create(const MapFileName: TFileName);
+constructor TJclMapScanner.Create(const MapFileName: TFileName; Module: HMODULE);
begin
- inherited Create(MapFileName);
+ inherited Create(MapFileName, Module);
Scan;
end;
@@ -1398,6 +1407,7 @@
SectionName, GroupName: PJclMapString);
var
C: Integer;
+ SectionHeader: PImageSectionHeader;
begin
C := Length(FSegmentClasses);
SetLength(FSegmentClasses, C + 1);
@@ -1407,6 +1417,21 @@
FSegmentClasses[C].Len := Len;
FSegmentClasses[C].SectionName := SectionName;
FSegmentClasses[C].GroupName := GroupName;
+
+ if FModule <> 0 then
+ begin
+ { Fix the section addresses }
+ SectionHeader := PeMapImgFindSectionFromModule(Pointer(FModule), MapStringToStr(SectionName));
+ if SectionHeader = nil then
+ { before Delphi 2005 the class names where used for the section names }
+ SectionHeader := PeMapImgFindSectionFromModule(Pointer(FModule), MapStringToStr(GroupName));
+
+ if SectionHeader <> nil then
+ begin
+ FSegmentClasses[C].Addr := Cardinal(FModule) + SectionHeader.VirtualAddress;
+ FSegmentClasses[C].VA := SectionHeader.VirtualAddress;
+ end;
+ end;
end;
function TJclMapScanner.LineNumberFromAddr(Addr: DWORD): Integer;
@@ -1449,6 +1474,13 @@
and (DWORD(Address.Offset) < FSegmentClasses[SegIndex].Len) then
begin
VA := AddrToVA(DWORD(Address.Offset) + FSegmentClasses[SegIndex].Addr);
+ { Starting with Delphi 2005, "empty" units are listes with the last line and
+ the VA 0001:00000000. When we would accept 0 VAs here, System.pas functions
+ could be mapped to other units and line numbers. Discaring such items should
+ have no impact on the correct information, because there can't be a function
+ that starts at VA 0. }
+ if VA = 0 then
+ Continue;
if FLineNumbersCnt mod 256 = 0 then
SetLength(FLineNumbers, FLineNumbersCnt + 256);
FLineNumbers[FLineNumbersCnt].Segment := FSegmentClasses[SegIndex].Segment;
@@ -1805,7 +1837,7 @@
Generator: TJclBinDebugGenerator;
begin
JDbgFileName := ChangeFileExt(MapFileName, JclDbgFileExtension);
- Generator := TJclBinDebugGenerator.Create(MapFileName);
+ Generator := TJclBinDebugGenerator.Create(MapFileName, 0);
try
MapFileSize := Generator.Stream.Size;
JdbgFileSize := Generator.DataStream.Size;
@@ -1846,7 +1878,7 @@
var
BinDebug: TJclBinDebugGenerator;
begin
- BinDebug := TJclBinDebugGenerator.Create(MapFileName);
+ BinDebug := TJclBinDebugGenerator.Create(MapFileName, 0);
try
Result := InsertDebugDataIntoExecutableFile(ExecutableFileName, BinDebug,
LinkerBugUnit, MapFileSize, JclDebugDataSize, LineNumberErrors);
@@ -1977,9 +2009,9 @@
//=== { TJclBinDebugGenerator } ==============================================
-constructor TJclBinDebugGenerator.Create(const MapFileName: TFileName);
+constructor TJclBinDebugGenerator.Create(const MapFileName: TFileName; Module: HMODULE);
begin
- inherited Create(MapFileName);
+ inherited Create(MapFileName, Module);
FDataStream := TMemoryStream.Create;
FMapFileName := MapFileName;
if FStream <> nil then
@@ -2195,6 +2227,7 @@
constructor TJclBinDebugScanner.Create(AStream: TCustomMemoryStream; CacheData: Boolean);
begin
+ inherited Create;
FCacheData := CacheData;
FStream := AStream;
CheckFormat;
@@ -2712,7 +2745,7 @@
with FScanner do
begin
Info.UnitName := ModuleNameFromAddr(VA);
- Result := (Info.UnitName <> '');
+ Result := Info.UnitName <> '';
if Result then
begin
Info.Address := Addr;
@@ -2732,7 +2765,7 @@
MapFileName := ChangeFileExt(FileName, MapFileExtension);
Result := FileExists(MapFileName);
if Result then
- FScanner := TJclMapScanner.Create(MapFileName);
+ FScanner := TJclMapScanner.Create(MapFileName, Module);
end;
//=== { TJclDebugInfoBinary } ================================================
@@ -2752,7 +2785,7 @@
with FScanner do
begin
Info.UnitName := ModuleNameFromAddr(VA);
- Result := (Info.UnitName) <> '';
+ Result := Info.UnitName <> '';
if Result then
begin
Info.Address := Addr;
@@ -2880,7 +2913,7 @@
begin
VA := VAFromAddr(Addr);
Info.UnitName := FImage.TD32Scanner.ModuleNameFromAddr(VA);
- Result := (Info.UnitName) <> '';
+ Result := Info.UnitName <> '';
if Result then
with Info do
begin
@@ -3207,7 +3240,7 @@
Module : HMODULE;
begin
OffsetStr := '';
- if GetLocationInfo(Addr, Info) then
+ if GetLocationInfo(Addr, Info) then
with Info do
begin
FixedProcedureName := ProcedureName;
@@ -3702,10 +3735,8 @@
Delayed := stDelayedTrace in JclStackTrackingOptions;
if BaseOfStack = nil then
begin
- if RawMode then
- IgnoreLevels := 9
- else
- IgnoreLevels := 5;
+ BaseOfStack := GetEBP;
+ IgnoreLevels := 1;
end
else
IgnoreLevels := Cardinal(-1); // because of the "IgnoreLevels + 1" in TJclStackInfoList.StoreToList()
@@ -4310,7 +4341,7 @@
if TrackingActive and ((stTraceEAbort in JclStackTrackingOptions) or not (ExceptObj is EAbort)) and
(not (stMainThreadOnly in JclStackTrackingOptions) or (GetCurrentThreadId = MainThreadID)) then
begin
- if stStack in JclStackTrackingOptions then
+ if stStack in JclStackTrackingOptions then
DoExceptionStackTrace(ExceptObj, ExceptAddr, OSException, BaseOfStack);
if stExceptFrame in JclStackTrackingOptions then
DoExceptFrameTrace;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-02-15 19:32:04
|
Revision: 1932
http://svn.sourceforge.net/jcl/?rev=1932&view=rev
Author: ahuser
Date: 2007-02-15 11:32:00 -0800 (Thu, 15 Feb 2007)
Log Message:
-----------
Fixed: Workaround for DbgHelp.dll bug that crashes the whole application.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-15 16:55:51 UTC (rev 1931)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-15 19:32:00 UTC (rev 1932)
@@ -675,6 +675,10 @@
var
JclStackTrackingOptions: TJclStackTrackingOptions = [stStack];
+ { JclDebugInfoSymbolPaths specifies a list of paths, separated by ';', in
+ which the DebugInfoSymbol scanner should look for symbol information. }
+ JclDebugInfoSymbolPaths: string = '';
+
function JclStartExceptionTracking: Boolean;
function JclStopExceptionTracking: Boolean;
function JclExceptionTrackingActive: Boolean;
@@ -2950,7 +2954,7 @@
TSymGetModuleInfoFunc = function (hProcess: THandle; dwAddr: DWORD;
var ModuleInfo: TImagehlpModule): Bool; stdcall;
TSymLoadModuleFunc = function (hProcess: THandle; hFile: THandle; ImageName,
- ModuleName: LPSTR; BaseOfDll, SizeOfDll: DWORD): Bool; stdcall;
+ ModuleName: LPSTR; BaseOfDll, SizeOfDll: DWORD): DWORD; stdcall;
TSymGetLineFromAddrFunc = function (hProcess: THandle; dwAddr: DWORD;
pdwDisplacement: PDWORD; var Line: TImageHlpLine): Bool; stdcall;
@@ -2978,6 +2982,23 @@
SymLoadModuleFuncName = 'SymLoadModule'; // do not localize
SymGetLineFromAddrName = 'SymGetLineFromAddr'; // do not localize
+function StrRemoveEmptyPaths(const Paths: string): string;
+var
+ List: TStrings;
+ I: Integer;
+begin
+ List := TStringList.Create;
+ try
+ StrToStrings(Paths, DirSeparator, List, False);
+ for I := 0 to List.Count - 1 do
+ if Trim(List[I]) = '' then
+ List[I] := '';
+ Result := StringsToStr(List, DirSeparator, False);
+ finally
+ List.Free;
+ end;
+end;
+
class function TJclDebugInfoSymbols.InitializeDebugSymbols: Boolean;
var
EnvironmentVarValue, SearchPath: string;
@@ -2994,16 +3015,26 @@
if Result then
begin
- SearchPath := StrEnsureSuffix(DirSeparator, ExtractFilePath(GetModulePath(GetCurrentProcess)) + GetCurrentFolder);
- if GetEnvironmentVar(EnvironmentVarNtSymbolPath, EnvironmentVarValue) then
- SearchPath := StrEnsureSuffix(DirSeparator, EnvironmentVarValue) + SearchPath;
- if GetEnvironmentVar(EnvironmentVarAlternateNtSymbolPath, EnvironmentVarValue) then
- SearchPath := StrEnsureSuffix(DirSeparator, EnvironmentVarValue) + SearchPath;
+ SearchPath := ''; // use default paths
+ if JclDebugInfoSymbolPaths <> '' then
+ begin
+ SearchPath := StrEnsureSuffix(DirSeparator, JclDebugInfoSymbolPaths);
+ SearchPath := StrEnsureNoSuffix(DirSeparator, SearchPath + GetCurrentFolder);
+ if GetEnvironmentVar(EnvironmentVarNtSymbolPath, EnvironmentVarValue) and (EnvironmentVarValue <> '') then
+ SearchPath := StrEnsureNoSuffix(DirSeparator, StrEnsureSuffix(DirSeparator, EnvironmentVarValue) + SearchPath);
+ if GetEnvironmentVar(EnvironmentVarAlternateNtSymbolPath, EnvironmentVarValue) and (EnvironmentVarValue <> '') then
+ SearchPath := StrEnsureNoSuffix(DirSeparator, StrEnsureSuffix(DirSeparator, EnvironmentVarValue) + SearchPath);
+
+ { DbgHelp.dll crashes when an empty path is specified. This also means
+ that the SearchPath must not end with a DirSeparator. }
+ SearchPath := StrRemoveEmptyPaths(SearchPath);
+ end;
+
if IsWinNT then
- Result := SymInitializeFunc(GetCurrentProcess, PChar(SearchPath), False)
+ Result := SymInitializeFunc(GetCurrentProcess, Pointer(SearchPath), False)
else
- Result := SymInitializeFunc(GetCurrentProcessId, PChar(SearchPath), False);
+ Result := SymInitializeFunc(GetCurrentProcessId, Pointer(SearchPath), False);
if Result then
begin
SymOptions := SymGetOptionsFunc or SYMOPT_DEFERRED_LOADS
@@ -3104,7 +3135,7 @@
or (ModuleInfo.BaseOfImage = 0)) then
begin
ModuleFileName := GetModulePath(Module);
- Result := (DWORD(SymLoadModuleFunc(ProcessHandle, 0, PChar(ModuleFileName), nil, HInstance, 0)) <> 0);
+ Result := SymLoadModuleFunc(ProcessHandle, 0, PChar(ModuleFileName), nil, 0, 0) <> 0;
ZeroMemory(@ModuleInfo, SizeOf(ModuleInfo));
ModuleInfo.SizeOfStruct := SizeOf(ModuleInfo);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-02-15 22:12:50
|
Revision: 1935
http://svn.sourceforge.net/jcl/?rev=1935&view=rev
Author: ahuser
Date: 2007-02-15 14:12:47 -0800 (Thu, 15 Feb 2007)
Log Message:
-----------
Unitname not modified for "Unknown functions"
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-15 21:50:24 UTC (rev 1934)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-15 22:12:47 UTC (rev 1935)
@@ -2931,7 +2931,7 @@
{ Check if we have a valid address in an exported function. }
if not IsAddressInThisExportedFunction(Addr, FModule + Items[I].Address) then
begin
- Info.UnitName := '[' + AnsiLowerCase(ExtractFileName(GetModulePath(FModule))) + ']';
+ //Info.UnitName := '[' + AnsiLowerCase(ExtractFileName(GetModulePath(FModule))) + ']'
Info.ProcedureName := Format(RsUnknownFunctionAt, [Info.ProcedureName]);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-02-16 00:34:16
|
Revision: 1936
http://svn.sourceforge.net/jcl/?rev=1936&view=rev
Author: ahuser
Date: 2007-02-15 16:34:14 -0800 (Thu, 15 Feb 2007)
Log Message:
-----------
Fixed access violation by IsBadReadPtr.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-15 22:12:47 UTC (rev 1935)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-16 00:34:14 UTC (rev 1936)
@@ -4178,7 +4178,7 @@
// First check that the address is within range of our code segment!
C8P := PDWORD(CodeAddr - 8);
C4P := PDWORD(CodeAddr - 4);
- Result := (CodeAddr > 8) and not IsBadReadPtr(C8P, 8) and ValidCodeAddr(DWORD(C8P), FModuleInfoList);
+ Result := (CodeAddr > 8) and ValidCodeAddr(DWORD(C8P), FModuleInfoList) and not IsBadReadPtr(C8P, 8);
// Now check to see if the instruction preceding the return address
// could be a valid CALL instruction
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-02-16 17:17:14
|
Revision: 1938
http://svn.sourceforge.net/jcl/?rev=1938&view=rev
Author: outchy
Date: 2007-02-16 09:17:06 -0800 (Fri, 16 Feb 2007)
Log Message:
-----------
fix a problem where the exception stack tracing mechanism seemed to go into an infinite loop (the StackFrame^.CallersEBP was the same as the StackFrame)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2007-02-16 16:57:47 UTC (rev 1937)
+++ trunk/jcl/source/windows/JclDebug.pas 2007-02-16 17:17:06 UTC (rev 1938)
@@ -4030,6 +4030,8 @@
StackInfo.CallerAdr := StackFrameCallerAdr;
StackInfo.DumpSize := StackFrameCallersEBP - DWORD(StackFrame);
StackInfo.ParamSize := (StackInfo.DumpSize - SizeOf(TStackFrame)) div 4;
+ if PStackFrame(StackFrame^.CallersEBP) = StackFrame then
+ Break;
// Step to the next stack frame by following the EBP pointer
StackFrame := PStackFrame(StackFrameCallersEBP + FStackOffset);
Result := True;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
Thanks for helping keep SourceForge clean.
X