Menu
▾
▴
jcl-checkins-diff
|
From: <usc...@us...> - 2008-08-13 20:28:54
|
Revision: 2415
http://jcl.svn.sourceforge.net/jcl/?rev=2415&view=rev
Author: uschuster
Date: 2008-08-13 20:28:48 +0000 (Wed, 13 Aug 2008)
Log Message:
-----------
fixed map file line number parsing (was broken due changes in revision 2412)
Revision Links:
--------------
http://jcl.svn.sourceforge.net/jcl/?rev=2412&view=rev
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2008-08-11 12:23:08 UTC (rev 2414)
+++ trunk/jcl/source/windows/JclDebug.pas 2008-08-13 20:28:48 UTC (rev 2415)
@@ -1137,7 +1137,7 @@
procedure SkipEndLine;
begin
- while not CharIsWhiteSpace(CurrPos^) do
+ while not CharIsReturn(CurrPos^) do
Inc(CurrPos);
SkipWhiteSpace;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2009-03-30 08:58:06
|
Revision: 2711
http://jcl.svn.sourceforge.net/jcl/?rev=2711&view=rev
Author: uschuster
Date: 2009-03-30 08:58:01 +0000 (Mon, 30 Mar 2009)
Log Message:
-----------
added new TJclStackTrackingOption stDisableIfDebuggerAttached to disable the exception notifier if a debugger is attached
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-03-30 08:21:16 UTC (rev 2710)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-03-30 08:58:01 UTC (rev 2711)
@@ -781,7 +781,7 @@
type
TJclStackTrackingOption =
(stStack, stExceptFrame, stRawMode, stAllModules, stStaticModuleList,
- stDelayedTrace, stTraceAllExceptions, stMainThreadOnly);
+ stDelayedTrace, stTraceAllExceptions, stMainThreadOnly, stDisableIfDebuggerAttached);
TJclStackTrackingOptions = set of TJclStackTrackingOption;
{$IFDEF KEEP_DEPRECATED}
@@ -4834,8 +4834,9 @@
procedure DoExceptNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean;
BaseOfStack: Pointer);
begin
- if TrackingActive and Assigned(ExceptObj) and (not IsIgnoredException(ExceptObj.ClassType)) and
- (not (stMainThreadOnly in JclStackTrackingOptions) or (GetCurrentThreadId = MainThreadID)) then
+ if TrackingActive and (not (stDisableIfDebuggerAttached in JclStackTrackingOptions) or (not IsDebuggerAttached)) and
+ Assigned(ExceptObj) and (not IsIgnoredException(ExceptObj.ClassType)) 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...> - 2009-06-06 10:05:02
|
Revision: 2792
http://jcl.svn.sourceforge.net/jcl/?rev=2792&view=rev
Author: outchy
Date: 2009-06-06 10:04:54 +0000 (Sat, 06 Jun 2009)
Log Message:
-----------
Mantis 4771: crash: TJclDebugInfoSymbols and SymLoadModuleFunc
(possible fix)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-06-05 21:52:55 UTC (rev 2791)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-06-06 10:04:54 UTC (rev 2792)
@@ -3126,11 +3126,16 @@
SearchPath := StrRemoveEmptyPaths(SearchPath);
end;
+ // in Windows NT, first argument is a process handle
if IsWinNT and Assigned(SymInitializeWFunc) then
- Result := SymInitializeWFunc(GetCurrentProcessId, PWideChar(WideString(SearchPath)), False)
+ Result := SymInitializeWFunc(GetCurrentProcess, PWideChar(WideString(SearchPath)), False)
else
if IsWinNT and Assigned(SymInitializeAFunc) then
- Result := SymInitializeAFunc(GetCurrentProcess, PAnsiChar(AnsiString(SearchPath)), False);
+ Result := SymInitializeAFunc(GetCurrentProcess, PAnsiChar(AnsiString(SearchPath)), False)
+ else
+ // in Windows 95, 98, ME, first argument is a process identifier
+ if Assigned(SymInitializeAFunc) then
+ Result := SymInitializeAFunc(GetCurrentProcessId, PAnsiChar(AnsiString(SearchPath)), False);
if Result then
begin
SymOptions := SymGetOptionsFunc or SYMOPT_DEFERRED_LOADS
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-06-07 09:44:22
|
Revision: 2795
http://jcl.svn.sourceforge.net/jcl/?rev=2795&view=rev
Author: outchy
Date: 2009-06-07 09:44:21 +0000 (Sun, 07 Jun 2009)
Log Message:
-----------
Mantis 4771: crash: TJclDebugInfoSymbols and SymLoadModuleFunc
(final fix to be verified)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-06-06 16:27:16 UTC (rev 2794)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-06-07 09:44:21 UTC (rev 2795)
@@ -3098,6 +3098,7 @@
var
EnvironmentVarValue, SearchPath: string;
SymOptions: Cardinal;
+ ProcessHandle: THandle;
begin
if DebugSymbolsLoadFailed then
Result := False
@@ -3126,16 +3127,21 @@
SearchPath := StrRemoveEmptyPaths(SearchPath);
end;
- // in Windows NT, first argument is a process handle
- if IsWinNT and Assigned(SymInitializeWFunc) then
- Result := SymInitializeWFunc(GetCurrentProcess, PWideChar(WideString(SearchPath)), False)
+ if IsWinNT then
+ // in Windows NT, first argument is a process handle
+ ProcessHandle := GetCurrentProcess
else
- if IsWinNT and Assigned(SymInitializeAFunc) then
- Result := SymInitializeAFunc(GetCurrentProcess, PAnsiChar(AnsiString(SearchPath)), False)
+ // in Windows 95, 98, ME, first argument is a process identifier
+ ProcessHandle := GetCurrentProcessId;
+
+ if Assigned(SymInitializeWFunc) then
+ Result := SymInitializeWFunc(ProcessHandle, PWideChar(WideString(SearchPath)), False)
else
- // in Windows 95, 98, ME, first argument is a process identifier
if Assigned(SymInitializeAFunc) then
- Result := SymInitializeAFunc(GetCurrentProcessId, PAnsiChar(AnsiString(SearchPath)), False);
+ Result := SymInitializeAFunc(ProcessHandle, PAnsiChar(AnsiString(SearchPath)), False)
+ else
+ Result := False;
+
if Result then
begin
SymOptions := SymGetOptionsFunc or SYMOPT_DEFERRED_LOADS
@@ -3268,7 +3274,13 @@
if Result then
begin
- ProcessHandle := GetCurrentProcess;
+ if IsWinNT and (Win32MajorVersion >= 6) then
+ // ? in Windows NT, first argument is a process handle
+ // in Windows Vista (WinNT_6_Up), first argument is a process handle
+ ProcessHandle := GetCurrentProcess
+ else
+ // in Windows 95, 98, ME, ?WinNT_5_Down first argument is a process identifier
+ ProcessHandle := GetCurrentProcessId;
if Assigned(SymGetModuleInfoWFunc) then
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-06-07 09:50:40
|
Revision: 2796
http://jcl.svn.sourceforge.net/jcl/?rev=2796&view=rev
Author: outchy
Date: 2009-06-07 09:50:12 +0000 (Sun, 07 Jun 2009)
Log Message:
-----------
Mantis 4771: crash: TJclDebugInfoSymbols and SymLoadModuleFunc
(check the result of SymLoadModule before the call to SymGetModuleInfo)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-06-07 09:44:21 UTC (rev 2795)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-06-07 09:50:12 UTC (rev 2796)
@@ -3293,11 +3293,13 @@
ModuleFileName := GetModulePath(Module);
// OF: possible loss of data
Result := SymLoadModuleFunc(ProcessHandle, 0, PAnsiChar(AnsiString(ModuleFileName)), nil, 0, 0) <> 0;
-
- ZeroMemory(@ModuleInfoW, SizeOf(ModuleInfoW));
- ModuleInfoW.SizeOfStruct := SizeOf(ModuleInfoW);
- Result := Result and SymGetModuleInfoWFunc(ProcessHandle, Module, ModuleInfoW);
- Result := Result and not (ModuleInfoW.SymType in [SymNone, SymExport]);
+ if Result then
+ begin
+ ZeroMemory(@ModuleInfoW, SizeOf(ModuleInfoW));
+ ModuleInfoW.SizeOfStruct := SizeOf(ModuleInfoW);
+ Result := SymGetModuleInfoWFunc(ProcessHandle, Module, ModuleInfoW);
+ Result := Result and not (ModuleInfoW.SymType in [SymNone, SymExport]);
+ end;
end;
end
else
@@ -3313,10 +3315,13 @@
// OF: possible loss of data
Result := SymLoadModuleFunc(ProcessHandle, 0, PAnsiChar(AnsiString(ModuleFileName)), nil, 0, 0) <> 0;
- ZeroMemory(@ModuleInfoA, SizeOf(ModuleInfoA));
- ModuleInfoA.SizeOfStruct := SizeOf(ModuleInfoA);
- Result := Result and SymGetModuleInfoAFunc(ProcessHandle, Module, ModuleInfoA);
- Result := Result and not (ModuleInfoA.SymType in [SymNone, SymExport]);
+ if Result then
+ begin
+ ZeroMemory(@ModuleInfoA, SizeOf(ModuleInfoA));
+ ModuleInfoA.SizeOfStruct := SizeOf(ModuleInfoA);
+ Result := SymGetModuleInfoAFunc(ProcessHandle, Module, ModuleInfoA);
+ Result := Result and not (ModuleInfoA.SymType in [SymNone, SymExport]);
+ end;
end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-06-08 18:51:09
|
Revision: 2798
http://jcl.svn.sourceforge.net/jcl/?rev=2798&view=rev
Author: outchy
Date: 2009-06-08 18:50:12 +0000 (Mon, 08 Jun 2009)
Log Message:
-----------
Mantis 4771: crash: TJclDebugInfoSymbols and SymLoadModuleFunc
(search path should not be empty)
(rework the query of symbols when the module is not loaded)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-06-07 10:42:12 UTC (rev 2797)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-06-08 18:50:12 UTC (rev 2798)
@@ -3111,7 +3111,6 @@
if Result then
begin
- SearchPath := ''; // use default paths
if JclDebugInfoSymbolPaths <> '' then
begin
SearchPath := StrEnsureSuffix(DirSeparator, JclDebugInfoSymbolPaths);
@@ -3122,18 +3121,22 @@
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. }
+ // 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;
+ end
+ else
+ // Fix crash SymLoadModuleFunc on WinXP SP3 when SearchPath=''
+ SearchPath := GetCurrentFolder;
if IsWinNT then
// in Windows NT, first argument is a process handle
ProcessHandle := GetCurrentProcess
else
- // in Windows 95, 98, ME, first argument is a process identifier
+ // in Windows 95, 98, ME first argument is a process identifier
ProcessHandle := GetCurrentProcessId;
+ // Debug(WinXPSP3): SymInitializeWFunc==nil
if Assigned(SymInitializeWFunc) then
Result := SymInitializeWFunc(ProcessHandle, PWideChar(WideString(SearchPath)), False)
else
@@ -3271,58 +3274,53 @@
ProcessHandle: THandle;
begin
Result := InitializeDebugSymbols;
-
if Result then
begin
- if IsWinNT and (Win32MajorVersion >= 6) then
- // ? in Windows NT, first argument is a process handle
- // in Windows Vista (WinNT_6_Up), first argument is a process handle
+ if IsWinNT then
+ // in Windows NT, first argument is a process handle
ProcessHandle := GetCurrentProcess
else
- // in Windows 95, 98, ME, ?WinNT_5_Down first argument is a process identifier
+ // in Windows 95, 98, ME, first argument is a process identifier
ProcessHandle := GetCurrentProcessId;
- if Assigned(SymGetModuleInfoWFunc) then
+ if IsWinNT and Assigned(SymGetModuleInfoWFunc) then
begin
ZeroMemory(@ModuleInfoW, SizeOf(ModuleInfoW));
ModuleInfoW.SizeOfStruct := SizeOf(ModuleInfoW);
-
- if ((not SymGetModuleInfoWFunc(ProcessHandle, Module, ModuleInfoW))
- or (ModuleInfoW.BaseOfImage = 0)) then
+ Result := SymGetModuleInfoWFunc(ProcessHandle, Module, ModuleInfoW);
+ if not Result then
begin
+ // the symbols for this module are not loaded yet: load the module and query for the symbol again
ModuleFileName := GetModulePath(Module);
+ ZeroMemory(@ModuleInfoW, SizeOf(ModuleInfoW));
+ ModuleInfoW.SizeOfStruct := SizeOf(ModuleInfoW);
+ // warning: crash on WinXP SP3 when SymInitializeAFunc is called with empty SearchPath
// OF: possible loss of data
- Result := SymLoadModuleFunc(ProcessHandle, 0, PAnsiChar(AnsiString(ModuleFileName)), nil, 0, 0) <> 0;
- if Result then
- begin
- ZeroMemory(@ModuleInfoW, SizeOf(ModuleInfoW));
- ModuleInfoW.SizeOfStruct := SizeOf(ModuleInfoW);
- Result := SymGetModuleInfoWFunc(ProcessHandle, Module, ModuleInfoW);
- Result := Result and not (ModuleInfoW.SymType in [SymNone, SymExport]);
- end;
+ Result := (SymLoadModuleFunc(ProcessHandle, 0, PAnsiChar(AnsiString(ModuleFileName)), nil, 0, 0) <> 0) and
+ SymGetModuleInfoWFunc(ProcessHandle, Module, ModuleInfoW);
end;
+ Result := Result and (ModuleInfoW.BaseOfImage <> 0) and
+ not (ModuleInfoW.SymType in [SymNone, SymExport]);
end
else
if Assigned(SymGetModuleInfoAFunc) then
begin
ZeroMemory(@ModuleInfoA, SizeOf(ModuleInfoA));
ModuleInfoA.SizeOfStruct := SizeOf(ModuleInfoA);
-
- if ((not SymGetModuleInfoAFunc(ProcessHandle, Module, ModuleInfoA))
- or (ModuleInfoA.BaseOfImage = 0)) then
+ Result := SymGetModuleInfoAFunc(ProcessHandle, Module, ModuleInfoA);
+ if not Result then
begin
+ // the symbols for this module are not loaded yet: load the module and query for the symbol again
ModuleFileName := GetModulePath(Module);
+ ZeroMemory(@ModuleInfoA, SizeOf(ModuleInfoA));
+ ModuleInfoA.SizeOfStruct := SizeOf(ModuleInfoA);
+ // warning: crash on WinXP SP3 when SymInitializeAFunc is called with empty SearchPath
// OF: possible loss of data
- Result := SymLoadModuleFunc(ProcessHandle, 0, PAnsiChar(AnsiString(ModuleFileName)), nil, 0, 0) <> 0;
-
- if Result then
- begin
- ZeroMemory(@ModuleInfoA, SizeOf(ModuleInfoA));
- ModuleInfoA.SizeOfStruct := SizeOf(ModuleInfoA);
- Result := SymGetModuleInfoAFunc(ProcessHandle, Module, ModuleInfoA);
- Result := Result and not (ModuleInfoA.SymType in [SymNone, SymExport]);
- end;
+ Result := (SymLoadModuleFunc(ProcessHandle, 0, PAnsiChar(AnsiString(ModuleFileName)), nil, 0, 0) <> 0) and
+ SymGetModuleInfoAFunc(ProcessHandle, Module, ModuleInfoA);
end;
+ Result := Result and (ModuleInfoW.BaseOfImage <> 0) and
+ not (ModuleInfoA.SymType in [SymNone, SymExport]);
end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-06-09 18:09:39
|
Revision: 2801
http://jcl.svn.sourceforge.net/jcl/?rev=2801&view=rev
Author: outchy
Date: 2009-06-09 18:09:34 +0000 (Tue, 09 Jun 2009)
Log Message:
-----------
Style cleaning.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-06-08 21:17:26 UTC (rev 2800)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-06-09 18:09:34 UTC (rev 2801)
@@ -3100,15 +3100,12 @@
SymOptions: Cardinal;
ProcessHandle: THandle;
begin
- if DebugSymbolsLoadFailed then
- Result := False
- else
- if not DebugSymbolsInitialized then
+ Result := DebugSymbolsInitialized;
+ if not DebugSymbolsLoadFailed then
begin
- DebugSymbolsLoadFailed := not LoadDebugFunctions;
+ Result := LoadDebugFunctions;
+ DebugSymbolsLoadFailed := not Result;
- Result := not DebugSymbolsLoadFailed;
-
if Result then
begin
if JclDebugInfoSymbolPaths <> '' then
@@ -3157,9 +3154,7 @@
end
else
UnloadDebugFunctions;
- end
- else
- Result := DebugSymbolsInitialized;
+ end;
end;
class function TJclDebugInfoSymbols.CleanupDebugSymbols: Boolean;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-06-09 18:53:57
|
Revision: 2802
http://jcl.svn.sourceforge.net/jcl/?rev=2802&view=rev
Author: outchy
Date: 2009-06-09 18:53:49 +0000 (Tue, 09 Jun 2009)
Log Message:
-----------
Mantis 4771: crash: TJclDebugInfoSymbols and SymLoadModuleFunc
(function TJclDebugInfoSymbols.InitializeSource should not success when neither SymGetModuleInfoWFunc nor SymGetModuleInfoAFunc are available)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-06-09 18:09:34 UTC (rev 2801)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-06-09 18:53:49 UTC (rev 2802)
@@ -3278,7 +3278,7 @@
// in Windows 95, 98, ME, first argument is a process identifier
ProcessHandle := GetCurrentProcessId;
- if IsWinNT and Assigned(SymGetModuleInfoWFunc) then
+ if Assigned(SymGetModuleInfoWFunc) then
begin
ZeroMemory(@ModuleInfoW, SizeOf(ModuleInfoW));
ModuleInfoW.SizeOfStruct := SizeOf(ModuleInfoW);
@@ -3316,7 +3316,9 @@
end;
Result := Result and (ModuleInfoW.BaseOfImage <> 0) and
not (ModuleInfoA.SymType in [SymNone, SymExport]);
- end;
+ end
+ else
+ Result := False;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-07-27 18:28:39
|
Revision: 2884
http://jcl.svn.sourceforge.net/jcl/?rev=2884&view=rev
Author: outchy
Date: 2009-07-27 18:28:31 +0000 (Mon, 27 Jul 2009)
Log Message:
-----------
This function is not required by the JVCL installer anymore.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-07-27 12:10:12 UTC (rev 2883)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-07-27 18:28:31 UTC (rev 2884)
@@ -311,15 +311,6 @@
function ConvertMapFileToJdbgFile(const MapFileName: TFileName; var LinkerBugUnit: string;
var LineNumberErrors, MapFileSize, JdbgFileSize: Integer): Boolean; overload;
-// do not change this function, it is used by the JVCL installer using dynamic
-// linking (to avoid dependencies in the installer), the signature and name are
-// sensible
-// AnsiString and String types cannot be used because they are managed in
-// memory, the memory manager of the JVCL installer is different of the memory
-// manager used by the JCL package; only pointers and direct values are acceptable
-function InsertDebugDataIntoExecutableFile(ExecutableFileName, MapFileName: PChar;
- var MapFileSize, JclDebugDataSize: Integer): Boolean; overload;
-
function InsertDebugDataIntoExecutableFile(const ExecutableFileName,
MapFileName: TFileName; var LinkerBugUnit: string;
var MapFileSize, JclDebugDataSize: Integer): Boolean; overload;
@@ -2076,19 +2067,6 @@
end;
end;
-// do not change this function, it is used by the JVCL installer using dynamic
-// linking (to avoid dependencies in the installer), the signature and name are
-// sensible
-function InsertDebugDataIntoExecutableFile(ExecutableFileName, MapFileName: PChar;
- var MapFileSize, JclDebugDataSize: Integer): Boolean;
-var
- LinkerBugUnit: string;
-begin
- LinkerBugUnit := '';
- Result := InsertDebugDataIntoExecutableFile(ExecutableFileName, MapFileName,
- LinkerBugUnit, MapFileSize, JclDebugDataSize);
-end;
-
function InsertDebugDataIntoExecutableFile(const ExecutableFileName, MapFileName: TFileName;
var LinkerBugUnit: string; var MapFileSize, JclDebugDataSize: Integer): Boolean;
var
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-07-28 08:56:36
|
Revision: 2885
http://jcl.svn.sourceforge.net/jcl/?rev=2885&view=rev
Author: outchy
Date: 2009-07-28 08:56:17 +0000 (Tue, 28 Jul 2009)
Log Message:
-----------
The procedure name is prefixed by the unit name in latest versions of Delphi.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-07-27 18:28:31 UTC (rev 2884)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-07-28 08:56:17 UTC (rev 2885)
@@ -54,7 +54,7 @@
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF MSWINDOWS}
- Classes, SysUtils, Contnrs,
+ Classes, SysUtils, Contnrs,
JclBase, JclFileUtils, JclPeImage, JclSynch, JclTD32;
// Diagnostics
@@ -108,13 +108,13 @@
// MAP file abstract parser
type
- PJclMapAddress = ^TJclMapAddress;
+ PJclMapAddress = ^TJclMapAddress;
TJclMapAddress = packed record
Segment: Word;
Offset: Integer;
end;
- PJclMapString = PAnsiChar;
+ PJclMapString = PAnsiChar;
TJclAbstractMapParser = class(TObject)
private
@@ -339,7 +339,7 @@
OffsetFromLineNumber: Integer; // Offset from Address to LineNumber symbol location
SourceName: string; // Module file name
DebugInfo: TJclDebugInfoSource; // Location object
- BinaryFileName: string; // Name of the binary file containing the symbol
+ BinaryFileName: string; // Name of the binary file containing the symbol
end;
TJclLocationInfoExValues = set of (lievLocationInfo, lievProcedureStartLocationInfo, lievUnitVersionInfo);
@@ -1635,7 +1635,7 @@
FSegmentClasses[C].GroupName := GroupName;
if FModule <> 0 then
- begin
+ begin
{ Fix the section addresses }
SectionHeader := PeMapImgFindSectionFromModule(Pointer(FModule), MapStringToStr(SectionName));
if SectionHeader = nil then
@@ -2005,12 +2005,12 @@
C := $3F;
end;
case I and $03 of
- 0:
+ 0:
begin
Inc(P);
P^ := C;
end;
- 1:
+ 1:
begin
P^ := P^ or (C and $03) shl 6;
Inc(P);
@@ -2159,7 +2159,7 @@
Inc(LastSection, NtHeaders32^.FileHeader.NumberOfSections - 1);
JclDebugSection := LastSection;
Inc(JclDebugSection);
-
+
// Increase the number of sections
Inc(NtHeaders32^.FileHeader.NumberOfSections);
FillChar(JclDebugSection^, SizeOf(TImageSectionHeader), #0);
@@ -2173,7 +2173,7 @@
StrPLCopy(PAnsiChar(@JclDebugSection^.Name), JclDbgDataResName, IMAGE_SIZEOF_SHORT_NAME);
// JCLDEBUG Characteristics flags
JclDebugSection^.Characteristics := IMAGE_SCN_MEM_READ or IMAGE_SCN_CNT_INITIALIZED_DATA;
-
+
// Size of virtual data area
JclDebugSection^.Misc.VirtualSize := JclDebugDataSize;
VirtualAlignedSize := JclDebugDataSize;
@@ -2185,10 +2185,10 @@
RoundUpToAlignment(JclDebugSection^.SizeOfRawData, NtHeaders32^.OptionalHeader.FileAlignment);
// Update Initialized data size
Inc(NtHeaders32^.OptionalHeader.SizeOfInitializedData, JclDebugSection^.SizeOfRawData);
-
+
// Fill data to alignment
NeedFill := INT_PTR(JclDebugSection^.SizeOfRawData) - JclDebugDataSize;
-
+
// Note: Delphi linker seems to generate incorrect (unaligned) size of
// the executable when adding TD32 debug data so the position could be
// behind the size of the file then.
@@ -2197,14 +2197,14 @@
X := 0;
for I := 1 to NeedFill do
ImageStream.WriteBuffer(X, 1);
-
+
ImageStream.SaveToFile(ExecutableFileName);
end
else
Result := False;
except
Result := False;
- end;
+ end;
finally
ImageStream.Free;
end;
@@ -2482,7 +2482,7 @@
SecondWord := 0;
CurrAddr := 0;
C := 0;
- Ln := 0;
+ Ln := 0;
P := MakePtr(PJclDbgHeader(FStream.Memory)^.Symbols);
while ReadValue(P, Value) do
begin
@@ -3152,7 +3152,7 @@
Result := TempItem;
Break;
end;
- end;
+ end;
if Result = nil then
begin
Result := CreateDebugInfo(Module);
@@ -3616,7 +3616,7 @@
class function TJclDebugInfoSymbols.CleanupDebugSymbols: Boolean;
begin
Result := True;
-
+
if DebugSymbolsInitialized then
Result := SymCleanupFunc(GetCurrentProcess);
@@ -5035,8 +5035,6 @@
end;
function GetJmpDest(Jmp: PJmpInstruction): Pointer;
-type
- PDWORD_PTR = ^DWORD_PTR;
begin
// TODO : 64 bit version
if Jmp.opCode = $E9 then
@@ -5064,6 +5062,8 @@
var
Dest: Pointer;
LocInfo: TJclLocationInfo;
+ FixedProcedureName: string;
+ DotPos: Integer;
begin
FFrameKind := efkUnknown;
if FExcFrame <> nil then
@@ -5074,16 +5074,20 @@
LocInfo := GetLocationInfo(Dest);
if CompareText(LocInfo.UnitName, 'system') = 0 then
begin
- if CompareText(LocInfo.ProcedureName, '@HandleAnyException') = 0 then
+ FixedProcedureName := LocInfo.ProcedureName;
+ DotPos := Pos('.', FixedProcedureName);
+ if DotPos > 0 then
+ FixedProcedureName := Copy(FixedProcedureName, DotPos + 1, Length(FixedProcedureName) - DotPos);
+ if CompareText(FixedProcedureName, '@HandleAnyException') = 0 then
FFrameKind := efkAnyException
else
- if CompareText(LocInfo.ProcedureName, '@HandleOnException') = 0 then
+ if CompareText(FixedProcedureName, '@HandleOnException') = 0 then
FFrameKind := efkOnException
else
- if CompareText(LocInfo.ProcedureName, '@HandleAutoException') = 0 then
+ if CompareText(FixedProcedureName, '@HandleAutoException') = 0 then
FFrameKind := efkAutoException
else
- if CompareText(LocInfo.ProcedureName, '@HandleFinally') = 0 then
+ if CompareText(FixedProcedureName, '@HandleFinally') = 0 then
FFrameKind := efkFinally;
end;
end;
@@ -5519,7 +5523,7 @@
function TJclDebugThreadList.AddStackListToLocationInfoList(ThreadID: DWORD; AList: TJclLocationInfoList): Boolean;
var
I: Integer;
- List: TJclStackInfoList;
+ List: TJclStackInfoList;
begin
Result := False;
FReadLock.Enter;
@@ -6165,7 +6169,7 @@
if IsWinNT then
Result := GetHandleInformation(Handle, Flags)
else
- Result := False;
+ Result := False;
if not Result then
begin
// DuplicateHandle is used as an additional check for those object types not
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-07-28 09:58:38
|
Revision: 2886
http://jcl.svn.sourceforge.net/jcl/?rev=2886&view=rev
Author: outchy
Date: 2009-07-28 09:58:31 +0000 (Tue, 28 Jul 2009)
Log Message:
-----------
Do a copy of the exception frame information to workaround further overrides.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-07-28 08:56:17 UTC (rev 2885)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-07-28 09:58:31 UTC (rev 2886)
@@ -724,16 +724,16 @@
TJclExceptFrame = class(TObject)
private
- FExcFrame: PExcFrame;
FFrameKind: TExceptFrameKind;
+ FCodeLocation: Pointer;
+ FExcTab: array of TExcDescEntry;
protected
- procedure DoDetermineFrameKind;
+ procedure AnalyseExceptFrame(AExcDesc: PExcDesc);
public
- constructor Create(AExcFrame: PExcFrame);
+ constructor Create(AExcDesc: PExcDesc);
function Handles(ExceptObj: TObject): Boolean;
function HandlerInfo(ExceptObj: TObject; var HandlerAt: Pointer): Boolean;
- function CodeLocation: Pointer;
- property ExcFrame: PExcFrame read FExcFrame;
+ property CodeLocation: Pointer read FCodeLocation;
property FrameKind: TExceptFrameKind read FFrameKind;
end;
@@ -5037,11 +5037,11 @@
function GetJmpDest(Jmp: PJmpInstruction): Pointer;
begin
// TODO : 64 bit version
- if Jmp.opCode = $E9 then
- Result := Pointer(INT_PTR(Jmp) + Jmp.distance + 5)
+ if Jmp^.opCode = $E9 then
+ Result := Pointer(INT_PTR(Jmp) + Jmp^.distance + 5)
else
if Jmp.opCode = $EB then
- Result := Pointer(INT_PTR(Jmp) + ShortInt(Jmp.distance) + 2)
+ Result := Pointer(INT_PTR(Jmp) + ShortInt(Jmp^.distance) + 2)
else
Result := nil;
if (Result <> nil) and (PJmpTable(Result).OPCode = $25FF) then
@@ -5051,44 +5051,72 @@
//=== { TJclExceptFrame } ====================================================
-constructor TJclExceptFrame.Create(AExcFrame: PExcFrame);
+constructor TJclExceptFrame.Create(AExcDesc: PExcDesc);
begin
inherited Create;
- FExcFrame := AExcFrame;
- DoDetermineFrameKind;
+ FFrameKind := efkUnknown;
+ FCodeLocation := nil;
+ AnalyseExceptFrame(AExcDesc);
end;
-procedure TJclExceptFrame.DoDetermineFrameKind;
+procedure TJclExceptFrame.AnalyseExceptFrame(AExcDesc: PExcDesc);
var
Dest: Pointer;
LocInfo: TJclLocationInfo;
FixedProcedureName: string;
- DotPos: Integer;
+ DotPos, I: Integer;
begin
- FFrameKind := efkUnknown;
- if FExcFrame <> nil then
+ Dest := GetJmpDest(@AExcDesc^.Jmp);
+ if Dest <> nil then
begin
- Dest := GetJmpDest(@ExcFrame.desc.Jmp);
- if Dest <> nil then
+ // get frame kind
+ LocInfo := GetLocationInfo(Dest);
+ if CompareText(LocInfo.UnitName, 'system') = 0 then
begin
- LocInfo := GetLocationInfo(Dest);
- if CompareText(LocInfo.UnitName, 'system') = 0 then
+ FixedProcedureName := LocInfo.ProcedureName;
+ DotPos := Pos('.', FixedProcedureName);
+ if DotPos > 0 then
+ FixedProcedureName := Copy(FixedProcedureName, DotPos + 1, Length(FixedProcedureName) - DotPos);
+ if CompareText(FixedProcedureName, '@HandleAnyException') = 0 then
+ FFrameKind := efkAnyException
+ else
+ if CompareText(FixedProcedureName, '@HandleOnException') = 0 then
+ FFrameKind := efkOnException
+ else
+ if CompareText(FixedProcedureName, '@HandleAutoException') = 0 then
+ FFrameKind := efkAutoException
+ else
+ if CompareText(FixedProcedureName, '@HandleFinally') = 0 then
+ FFrameKind := efkFinally;
+ end;
+
+ // get location
+ if FFrameKind <> efkUnknown then
+ begin
+ FCodeLocation := GetJmpDest(PJmpInstruction(DWORD(@AExcDesc^.Instructions)));
+ if FCodeLocation = nil then
+ FCodeLocation := @AExcDesc^.Instructions;
+ end
+ else
+ begin
+ FCodeLocation := GetJmpDest(PJmpInstruction(DWORD(AExcDesc)));
+ if FCodeLocation = nil then
+ FCodeLocation := AExcDesc;
+ end;
+
+ // get on handlers
+ if FFrameKind = efkOnException then
+ begin
+ SetLength(FExcTab, AExcDesc^.Cnt);
+ for I := 0 to AExcDesc^.Cnt - 1 do
begin
- FixedProcedureName := LocInfo.ProcedureName;
- DotPos := Pos('.', FixedProcedureName);
- if DotPos > 0 then
- FixedProcedureName := Copy(FixedProcedureName, DotPos + 1, Length(FixedProcedureName) - DotPos);
- if CompareText(FixedProcedureName, '@HandleAnyException') = 0 then
- FFrameKind := efkAnyException
+ if AExcDesc^.ExcTab[I].VTable = nil then
+ begin
+ SetLength(FExcTab, I);
+ Break;
+ end
else
- if CompareText(FixedProcedureName, '@HandleOnException') = 0 then
- FFrameKind := efkOnException
- else
- if CompareText(FixedProcedureName, '@HandleAutoException') = 0 then
- FFrameKind := efkAutoException
- else
- if CompareText(FixedProcedureName, '@HandleFinally') = 0 then
- FFrameKind := efkFinally;
+ FExcTab[I] := AExcDesc^.ExcTab[I];
end;
end;
end;
@@ -5103,18 +5131,19 @@
function TJclExceptFrame.HandlerInfo(ExceptObj: TObject; var HandlerAt: Pointer): Boolean;
var
- I: Integer;
+ I, Count: Integer;
VTable: Pointer;
begin
Result := FrameKind in [efkAnyException, efkAutoException];
if not Result and (FrameKind = efkOnException) then
begin
I := 0;
+ Count := Length(FExcTab);
VTable := Pointer(INT_PTR(ExceptObj.ClassType) + vmtSelfPtr);
- while (I < ExcFrame.Desc.Cnt) and not Result and (VTable <> nil) do
+ while (I < Count) and not Result and (VTable <> nil) do
begin
- Result := (ExcFrame.Desc.ExcTab[I].VTable = nil) or
- (ExcFrame.Desc.ExcTab[I].VTable = VTable);
+ Result := (FExcTab[I].VTable = nil) or
+ (FExcTab[I].VTable = VTable);
if not Result then
begin
Move(PAnsiChar(VTable)[vmtParent - vmtSelfPtr], VTable, 4);
@@ -5126,35 +5155,15 @@
end;
end;
if Result then
- HandlerAt := ExcFrame.Desc.ExcTab[I].Handler;
+ HandlerAt := FExcTab[I].Handler;
end
else
if Result then
- begin
- HandlerAt := GetJmpDest(@ExcFrame.Desc.Instructions);
- if HandlerAt = nil then
- HandlerAt := @ExcFrame.Desc.Instructions;
- end
+ HandlerAt := FCodeLocation
else
HandlerAt := nil;
end;
-function TJclExceptFrame.CodeLocation: Pointer;
-begin
- if FrameKind <> efkUnknown then
- begin
- Result := GetJmpDest(PJmpInstruction(DWORD(@ExcFrame.Desc.Instructions)));
- if Result = nil then
- Result := @ExcFrame.Desc.Instructions;
- end
- else
- begin
- Result := GetJmpDest(PJmpInstruction(DWORD(@ExcFrame.Desc)));
- if Result = nil then
- Result := @ExcFrame.Desc;
- end;
-end;
-
//=== { TJclExceptFrameList } ================================================
constructor TJclExceptFrameList.Create(AIgnoreLevels: Integer);
@@ -5166,7 +5175,7 @@
function TJclExceptFrameList.AddFrame(AFrame: PExcFrame): TJclExceptFrame;
begin
- Result := TJclExceptFrame.Create(AFrame);
+ Result := TJclExceptFrame.Create(AFrame^.Desc);
Add(Result);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-07-28 10:42:15
|
Revision: 2887
http://jcl.svn.sourceforge.net/jcl/?rev=2887&view=rev
Author: outchy
Date: 2009-07-28 10:41:56 +0000 (Tue, 28 Jul 2009)
Log Message:
-----------
reworked TJclExceptFrame.HandlerInfo without dependency on vmtSelfPtr.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-07-28 09:58:31 UTC (rev 2886)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-07-28 10:41:56 UTC (rev 2887)
@@ -5131,31 +5131,37 @@
function TJclExceptFrame.HandlerInfo(ExceptObj: TObject; var HandlerAt: Pointer): Boolean;
var
- I, Count: Integer;
- VTable: Pointer;
+ I: Integer;
+ ObjVTable, VTable, ParentVTable: Pointer;
begin
Result := FrameKind in [efkAnyException, efkAutoException];
if not Result and (FrameKind = efkOnException) then
begin
- I := 0;
- Count := Length(FExcTab);
- VTable := Pointer(INT_PTR(ExceptObj.ClassType) + vmtSelfPtr);
- while (I < Count) and not Result and (VTable <> nil) do
+ HandlerAt := nil;
+ ObjVTable := Pointer(ExceptObj.ClassType);
+ for I := Low(FExcTab) to High(FExcTab) do
begin
- Result := (FExcTab[I].VTable = nil) or
- (FExcTab[I].VTable = VTable);
- if not Result then
+ VTable := ObjVTable;
+ Result := FExcTab[I].VTable = nil;
+ while (not Result) and (VTable <> nil) do
begin
- Move(PAnsiChar(VTable)[vmtParent - vmtSelfPtr], VTable, 4);
- if VTable = nil then
+ Result := (FExcTab[I].VTable = VTable) or
+ (PShortString(PPointer(PInteger(FExcTab[I].VTable)^ + vmtClassName)^)^ =
+ PShortString(PPointer(INT_PTR(VTable) + vmtClassName)^)^);
+ if Result then
+ HandlerAt := FExcTab[I].Handler
+ else
begin
- VTable := Pointer(INT_PTR(ExceptObj.ClassType) + vmtSelfPtr);
- Inc(I);
+ ParentVTable := PPointer(INT_PTR(VTable) + vmtParent)^;
+ if ParentVTable = VTable then
+ VTable := nil
+ else
+ VTable := ParentVTable;
end;
end;
+ if Result then
+ Break;
end;
- if Result then
- HandlerAt := FExcTab[I].Handler;
end
else
if Result then
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-10 10:03:06
|
Revision: 2934
http://jcl.svn.sourceforge.net/jcl/?rev=2934&view=rev
Author: outchy
Date: 2009-08-10 10:02:59 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
revert the frame location storage in the class TJclExceptFrame.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-08-10 10:00:38 UTC (rev 2933)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-08-10 10:02:59 UTC (rev 2934)
@@ -34,7 +34,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -739,15 +739,17 @@
TJclExceptFrame = class(TObject)
private
FFrameKind: TExceptFrameKind;
+ FFrameLocation: Pointer;
FCodeLocation: Pointer;
FExcTab: array of TExcDescEntry;
protected
procedure AnalyseExceptFrame(AExcDesc: PExcDesc);
public
- constructor Create(AExcDesc: PExcDesc);
+ constructor Create(AFrameLocation: Pointer; AExcDesc: PExcDesc);
function Handles(ExceptObj: TObject): Boolean;
function HandlerInfo(ExceptObj: TObject; out HandlerAt: Pointer): Boolean;
property CodeLocation: Pointer read FCodeLocation;
+ property FrameLocation: Pointer read FFrameLocation;
property FrameKind: TExceptFrameKind read FFrameKind;
end;
@@ -5123,10 +5125,11 @@
//=== { TJclExceptFrame } ====================================================
-constructor TJclExceptFrame.Create(AExcDesc: PExcDesc);
+constructor TJclExceptFrame.Create(AFrameLocation: Pointer; AExcDesc: PExcDesc);
begin
inherited Create;
FFrameKind := efkUnknown;
+ FFrameLocation := AFrameLocation;
FCodeLocation := nil;
AnalyseExceptFrame(AExcDesc);
end;
@@ -5257,7 +5260,7 @@
function TJclExceptFrameList.AddFrame(AFrame: PExcFrame): TJclExceptFrame;
begin
- Result := TJclExceptFrame.Create(AFrame^.Desc);
+ Result := TJclExceptFrame.Create(AFrame, AFrame^.Desc);
Add(Result);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-09-12 14:57:53
|
Revision: 3000
http://jcl.svn.sourceforge.net/jcl/?rev=3000&view=rev
Author: outchy
Date: 2009-09-12 14:57:46 +0000 (Sat, 12 Sep 2009)
Log Message:
-----------
renamed MapStringToFileName to MapStringToModuleName since this function extracts the module name.
hardened the implementation of MapStringToModuleName.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-09-12 13:29:35 UTC (rev 2999)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-09-12 14:57:46 UTC (rev 3000)
@@ -143,7 +143,7 @@
destructor Destroy; override;
procedure Parse;
class function MapStringToStr(MapString: PJclMapString; IgnoreSpaces: Boolean = False): string;
- class function MapStringToFileName(MapString: PJclMapString): string;
+ class function MapStringToModuleName(MapString: PJclMapString): string;
property LinkerBug: Boolean read FLinkerBug;
property LinkerBugUnitName: string read GetLinkerBugUnitName;
property Stream: TJclFileMappingStream read FStream;
@@ -1267,7 +1267,7 @@
Result := MapStringToStr(FLinkerBugUnitName);
end;
-class function TJclAbstractMapParser.MapStringToFileName(MapString: PJclMapString): string;
+class function TJclAbstractMapParser.MapStringToModuleName(MapString: PJclMapString): string;
var
PStart, PEnd, PExtension: PJclMapString;
begin
@@ -1281,22 +1281,23 @@
Inc(PEnd);
if (PEnd^ = '=') then
begin
- while not (PEnd^ = NativeSpace) do
+ while (PEnd >= MapString) and not (PEnd^ = NativeSpace) do
Dec(PEnd);
- while ((PEnd-1)^ = NativeSpace) do
+ while (PEnd >= MapString) and ((PEnd-1)^ = NativeSpace) do
Dec(PEnd);
end;
PExtension := PEnd;
- while (PExtension^ <> '.') and (PExtension^ <> '|') and (PExtension >= MapString) do
+ while (PExtension >= MapString) and (PExtension^ <> '.') and (PExtension^ <> '|') do
Dec(PExtension);
if (PExtension^ = '.') then
PEnd := PExtension;
PExtension := PEnd;
- while (PExtension^ <> '|') and (PExtension^ <> '\') and (PExtension >= MapString) do
+ while (PExtension >= MapString) and (PExtension^ <> '|') and (PExtension^ <> '\') do
Dec(PExtension);
- if (PExtension^ = '|') or (PExtension^ = '\') then
+ if PExtension >= MapString then
PStart := PExtension + 1
- else PStart := MapString;
+ else
+ PStart := MapString;
SetString(Result, PStart, PEnd - PStart);
end;
@@ -1629,7 +1630,7 @@
Len: Integer; GroupName, UnitName: PJclMapString);
begin
if Assigned(FOnSegmentItem) then
- FOnSegmentItem(Self, Address, Len, MapStringToStr(GroupName), MapStringToFileName(UnitName));
+ FOnSegmentItem(Self, Address, Len, MapStringToStr(GroupName), MapStringToModuleName(UnitName));
end;
//=== { TJclMapScanner } =====================================================
@@ -1769,7 +1770,7 @@
for I := Length(FSegments) - 1 downto 0 do
if (FSegments[I].StartVA <= Addr) and (Addr < FSegments[I].EndVA) then
begin
- Result := MapStringToStr(FSegments[I].UnitName);
+ Result := MapStringToModuleName(FSegments[I].UnitName);
Break;
end;
end;
@@ -2392,7 +2393,7 @@
if IsSegmentStored(FSegments[I].Segment) then
begin
WriteValueOfs(FSegments[I].StartVA, L1);
- WriteValueOfs(AddWord(MapStringToStr(FSegments[I].UnitName)), L2);
+ WriteValueOfs(AddWord(MapStringToModuleName(FSegments[I].UnitName)), L2);
end;
WriteValue(MaxInt);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-09-12 15:35:46
|
Revision: 3001
http://jcl.svn.sourceforge.net/jcl/?rev=3001&view=rev
Author: outchy
Date: 2009-09-12 15:35:40 +0000 (Sat, 12 Sep 2009)
Log Message:
-----------
TJclMapScanner.SourceNameFromAddr does not work with MAP files generated by C++Builder.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-09-12 14:57:46 UTC (rev 3000)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-09-12 15:35:40 UTC (rev 3001)
@@ -142,8 +142,9 @@
constructor Create(const MapFileName: TFileName); overload;
destructor Destroy; override;
procedure Parse;
+ class function MapStringToFileName(MapString: PJclMapString): string;
+ class function MapStringToModuleName(MapString: PJclMapString): string;
class function MapStringToStr(MapString: PJclMapString; IgnoreSpaces: Boolean = False): string;
- class function MapStringToModuleName(MapString: PJclMapString): string;
property LinkerBug: Boolean read FLinkerBug;
property LinkerBugUnitName: string read GetLinkerBugUnitName;
property Stream: TJclFileMappingStream read FStream;
@@ -1267,6 +1268,28 @@
Result := MapStringToStr(FLinkerBugUnitName);
end;
+class function TJclAbstractMapParser.MapStringToFileName(MapString: PJclMapString): string;
+var
+ PEnd: PJclMapString;
+begin
+ if MapString = nil then
+ begin
+ Result := '';
+ Exit;
+ end;
+ PEnd := MapString;
+ while (PEnd^ <> '=') and not CharIsReturn(Char(PEnd^)) do
+ Inc(PEnd);
+ if (PEnd^ = '=') then
+ begin
+ while (PEnd >= MapString) and not (PEnd^ = NativeSpace) do
+ Dec(PEnd);
+ while (PEnd >= MapString) and ((PEnd-1)^ = NativeSpace) do
+ Dec(PEnd);
+ end;
+ SetString(Result, MapString, PEnd - MapString);
+end;
+
class function TJclAbstractMapParser.MapStringToModuleName(MapString: PJclMapString): string;
var
PStart, PEnd, PExtension: PJclMapString;
@@ -1896,11 +1919,22 @@
I: Integer;
ModuleStartVA: DWORD;
begin
+ // try with line numbers first (Delphi compliance)
ModuleStartVA := ModuleStartFromAddr(Addr);
Result := '';
I := SearchDynArray(FSourceNames, SizeOf(FSourceNames[0]), Search_MapProcName, @Addr, True);
if (I <> -1) and (FSourceNames[I].VA >= ModuleStartVA) then
Result := MapStringToStr(FSourceNames[I].ProcName);
+ if Result = '' then
+ begin
+ // try with module names (C++Builder compliance)
+ for I := Length(FSegments) - 1 downto 0 do
+ if (FSegments[I].StartVA <= Addr) and (Addr < FSegments[I].EndVA) then
+ begin
+ Result := MapStringToFileName(FSegments[I].UnitName);
+ Break;
+ end;
+ end;
end;
// JCL binary debug format string encoding/decoding routines
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-16 20:33:31
|
Revision: 3045
http://jcl.svn.sourceforge.net/jcl/?rev=3045&view=rev
Author: outchy
Date: 2009-10-16 20:33:16 +0000 (Fri, 16 Oct 2009)
Log Message:
-----------
The segment offset is an pointer size unsigned value.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-10-16 17:11:39 UTC (rev 3044)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-10-16 20:33:16 UTC (rev 3045)
@@ -116,7 +116,7 @@
PJclMapAddress = ^TJclMapAddress;
TJclMapAddress = packed record
Segment: Word;
- Offset: Integer;
+ Offset: TJclAddr;
end;
PJclMapString = PAnsiChar;
@@ -1750,7 +1750,7 @@
if (FSegmentClasses[SegIndex].Segment = Address.Segment)
and (DWORD(Address.Offset) < FSegmentClasses[SegIndex].Len) then
begin
- VA := AddrToVA(TJclAddr(Address.Offset) + FSegmentClasses[SegIndex].Addr);
+ VA := AddrToVA(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
@@ -1855,7 +1855,7 @@
if FProcNamesCnt mod 256 = 0 then
SetLength(FProcNames, FProcNamesCnt + 256);
FProcNames[FProcNamesCnt].Segment := FSegmentClasses[SegIndex].Segment;
- FProcNames[FProcNamesCnt].VA := AddrToVA(TJclAddr(Address.Offset) + FSegmentClasses[SegIndex].Addr);
+ FProcNames[FProcNamesCnt].VA := AddrToVA(Address.Offset + FSegmentClasses[SegIndex].Addr);
FProcNames[FProcNamesCnt].ProcName := Name;
Inc(FProcNamesCnt);
Break;
@@ -1902,7 +1902,7 @@
if (FSegmentClasses[SegIndex].Segment = Address.Segment)
and (DWORD(Address.Offset) < FSegmentClasses[SegIndex].Len) then
begin
- VA := AddrToVA(TJclAddr(Address.Offset) + FSegmentClasses[SegIndex].Addr);
+ VA := AddrToVA(Address.Offset + FSegmentClasses[SegIndex].Addr);
if FSegmentCnt mod 16 = 0 then
SetLength(FSegments, FSegmentCnt + 16);
FSegments[FSegmentCnt].Segment := FSegmentClasses[SegIndex].Segment;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-16 20:35:54
|
Revision: 3046
http://jcl.svn.sourceforge.net/jcl/?rev=3046&view=rev
Author: outchy
Date: 2009-10-16 20:35:47 +0000 (Fri, 16 Oct 2009)
Log Message:
-----------
Mantis 4929: some exception during frame dump after exception.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-10-16 20:33:16 UTC (rev 3045)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-10-16 20:35:47 UTC (rev 3046)
@@ -5139,9 +5139,10 @@
JclCreateExceptFrameList(4);
end;
+{$OVERFLOWCHECKS OFF}
+
function GetJmpDest(Jmp: PJmpInstruction): Pointer;
begin
- {$OVERFLOWCHECKS OFF}
// TODO : 64 bit version
if Jmp^.opCode = $E9 then
Result := Pointer(TJclAddr(Jmp) + TJclAddr(Jmp^.distance) + 5)
@@ -5153,11 +5154,12 @@
if (Result <> nil) and (PJmpTable(Result).OPCode = $25FF) then
if not IsBadReadPtr(PJmpTable(Result).Ptr, SizeOf(Pointer)) then
Result := Pointer(PJclAddr(PJmpTable(Result).Ptr)^);
- {$IFDEF OVERFLOWCHECKS_ON}
- {$OVERFLOWCHECKS ON}
- {$ENDIF OVERFLOWCHECKS_ON}
end;
+{$IFDEF OVERFLOWCHECKS_ON}
+{$OVERFLOWCHECKS ON}
+{$ENDIF OVERFLOWCHECKS_ON}
+
//=== { TJclExceptFrame } ====================================================
constructor TJclExceptFrame.Create(AFrameLocation: Pointer; AExcDesc: PExcDesc);
@@ -5239,6 +5241,8 @@
Result := HandlerInfo(ExceptObj, Handler);
end;
+{$OVERFLOWCHECKS OFF}
+
function TJclExceptFrame.HandlerInfo(ExceptObj: TObject; out HandlerAt: Pointer): Boolean;
var
I: Integer;
@@ -5255,7 +5259,6 @@
Result := FExcTab[I].VTable = nil;
while (not Result) and (VTable <> nil) do
begin
- {$OVERFLOWCHECKS OFF}
Result := (FExcTab[I].VTable = VTable) or
(PShortString(PPointer(PJclAddr(FExcTab[I].VTable)^ + TJclAddr(vmtClassName))^)^ =
PShortString(PPointer(TJclAddr(VTable) + TJclAddr(vmtClassName))^)^);
@@ -5269,9 +5272,6 @@
else
VTable := ParentVTable;
end;
- {$IFDEF OVERFLOWCHECKS_ON}
- {$OVERFLOWCHECKS ON}
- {$ENDIF OVERFLOWCHECKS_ON}
end;
if Result then
Break;
@@ -5284,6 +5284,10 @@
HandlerAt := nil;
end;
+{$IFDEF OVERFLOWCHECKS_ON}
+{$OVERFLOWCHECKS ON}
+{$ENDIF OVERFLOWCHECKS_ON}
+
//=== { TJclExceptFrameList } ================================================
constructor TJclExceptFrameList.Create(AIgnoreLevels: Integer);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-16 20:37:32
|
Revision: 3047
http://jcl.svn.sourceforge.net/jcl/?rev=3047&view=rev
Author: outchy
Date: 2009-10-16 20:37:26 +0000 (Fri, 16 Oct 2009)
Log Message:
-----------
Do not disable overflow and range checks in unit JclDebug.pas.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-10-16 20:35:47 UTC (rev 3046)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-10-16 20:37:26 UTC (rev 3047)
@@ -45,8 +45,6 @@
interface
{$I jcl.inc}
-{$RANGECHECKS OFF}
-{$OVERFLOWCHECKS OFF}
uses
{$IFDEF UNITVERSIONING}
@@ -2299,6 +2297,8 @@
inherited Destroy;
end;
+{$OVERFLOWCHECKS OFF}
+
function TJclBinDebugGenerator.CalculateCheckSum: Boolean;
var
Header: PJclDbgHeader;
@@ -2323,6 +2323,10 @@
end;
end;
+{$IFDEF OVERFLOWCHECKS_ON}
+{$OVERFLOWCHECKS ON}
+{$ENDIF OVERFLOWCHECKS_ON}
+
procedure TJclBinDebugGenerator.CreateData;
var
WordList: TStringList;
@@ -2582,6 +2586,8 @@
end;
end;
+{$OVERFLOWCHECKS OFF}
+
procedure TJclBinDebugScanner.CheckFormat;
var
CheckSum: Integer;
@@ -2607,6 +2613,10 @@
end;
end;
+{$IFDEF OVERFLOWCHECKS_ON}
+{$OVERFLOWCHECKS ON}
+{$ENDIF OVERFLOWCHECKS_ON}
+
function TJclBinDebugScanner.DataToStr(A: Integer): string;
var
P: PAnsiChar;
@@ -4506,7 +4516,10 @@
IgnoreLevels := Cardinal(-1); // because of the "IgnoreLevels + 1" in TJclStackInfoList.StoreToList()
if OSException then
begin
- Inc(IgnoreLevels); // => HandleAnyException
+ if IgnoreLevels = Cardinal(-1) then
+ IgnoreLevels := 0
+ else
+ Inc(IgnoreLevels); // => HandleAnyException
FirstCaller := ExceptAddr;
end
else
@@ -4828,7 +4841,8 @@
var
Item: TJclStackInfoItem;
begin
- if StackInfo.Level > IgnoreLevels + 1 then
+ if ((IgnoreLevels = Cardinal(-1)) and (StackInfo.Level > 0)) or
+ (StackInfo.Level > (IgnoreLevels + 1)) then
begin
Item := TJclStackInfoItem.Create;
Item.FStackInfo := StackInfo;
@@ -5171,6 +5185,8 @@
AnalyseExceptFrame(AExcDesc);
end;
+{$RANGECHECKS OFF}
+
procedure TJclExceptFrame.AnalyseExceptFrame(AExcDesc: PExcDesc);
var
Dest: Pointer;
@@ -5234,6 +5250,10 @@
end;
end;
+{$IFDEF RANGECHECKS_ON}
+{$RANGECHECKS ON}
+{$ENDIF RANGECHECKS_ON}
+
function TJclExceptFrame.Handles(ExceptObj: TObject): Boolean;
var
Handler: Pointer;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2009-10-25 19:10:00
|
Revision: 3056
http://jcl.svn.sourceforge.net/jcl/?rev=3056&view=rev
Author: ahuser
Date: 2009-10-25 19:09:49 +0000 (Sun, 25 Oct 2009)
Log Message:
-----------
Fixed RangeCheck Error that occurs in Delphi 2010
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-10-25 18:42:41 UTC (rev 3055)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-10-25 19:09:49 UTC (rev 3056)
@@ -1669,7 +1669,7 @@
// 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
+ if (Length(FSegmentClasses) > 0) and (FSegmentClasses[0].Addr > 0) and (Addr > 0) then
// Delphi 2005 and later
// The first segment should be code starting at module base address + $10000
Result := Addr - FSegmentClasses[0].Addr
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2009-11-04 10:00:29
|
Revision: 3063
http://jcl.svn.sourceforge.net/jcl/?rev=3063&view=rev
Author: ahuser
Date: 2009-11-04 10:00:17 +0000 (Wed, 04 Nov 2009)
Log Message:
-----------
Fixed: Debug-DCUs are compiled with RangeChecks => EIntOverflow in JclDebug
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-11-02 19:25:11 UTC (rev 3062)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-11-04 10:00:17 UTC (rev 3063)
@@ -5036,9 +5036,13 @@
// todo: 64 bit version
// 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(TJclAddr(C8P), FModuleInfoList) and not IsBadReadPtr(C8P, 8);
+ Result := CodeAddr > 8;
+ if Result then
+ begin
+ C8P := PDWORD(CodeAddr - 8);
+ C4P := PDWORD(CodeAddr - 4);
+ Result := ValidCodeAddr(TJclAddr(C8P), FModuleInfoList) and not IsBadReadPtr(C8P, 8);
+ end;
// 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...> - 2009-11-04 12:16:37
|
Revision: 3064
http://jcl.svn.sourceforge.net/jcl/?rev=3064&view=rev
Author: outchy
Date: 2009-11-04 12:12:24 +0000 (Wed, 04 Nov 2009)
Log Message:
-----------
fix compiler warnings complaining about uninitialized variables C4P and C8P.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-11-04 10:00:17 UTC (rev 3063)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-11-04 12:12:24 UTC (rev 3064)
@@ -5042,82 +5042,82 @@
C8P := PDWORD(CodeAddr - 8);
C4P := PDWORD(CodeAddr - 4);
Result := ValidCodeAddr(TJclAddr(C8P), FModuleInfoList) and not IsBadReadPtr(C8P, 8);
- end;
- // Now check to see if the instruction preceding the return address
- // could be a valid CALL instruction
- if Result then
- begin
- try
- CodeDWORD8 := PDWORD(C8P)^;
- CodeDWORD4 := PDWORD(C4P)^;
- // CodeDWORD8 = (ReturnAddr-5):(ReturnAddr-6):(ReturnAddr-7):(ReturnAddr-8)
- // CodeDWORD4 = (ReturnAddr-1):(ReturnAddr-2):(ReturnAddr-3):(ReturnAddr-4)
+ // Now check to see if the instruction preceding the return address
+ // could be a valid CALL instruction
+ if Result then
+ begin
+ try
+ CodeDWORD8 := PDWORD(C8P)^;
+ CodeDWORD4 := PDWORD(C4P)^;
+ // CodeDWORD8 = (ReturnAddr-5):(ReturnAddr-6):(ReturnAddr-7):(ReturnAddr-8)
+ // CodeDWORD4 = (ReturnAddr-1):(ReturnAddr-2):(ReturnAddr-3):(ReturnAddr-4)
- // ModR/M bytes contain the following bits:
- // Mod = (76)
- // Reg/Opcode = (543)
- // R/M = (210)
- RM1 := (CodeDWORD4 shr 24) and $7;
- RM2 := (CodeDWORD4 shr 16) and $7;
- //RM3 := (CodeDWORD4 shr 8) and $7;
- //RM4 := CodeDWORD4 and $7;
- RM5 := (CodeDWORD8 shr 24) and $7;
- //RM6 := (CodeDWORD8 shr 16) and $7;
- //RM7 := (CodeDWORD8 shr 8) and $7;
+ // ModR/M bytes contain the following bits:
+ // Mod = (76)
+ // Reg/Opcode = (543)
+ // R/M = (210)
+ RM1 := (CodeDWORD4 shr 24) and $7;
+ RM2 := (CodeDWORD4 shr 16) and $7;
+ //RM3 := (CodeDWORD4 shr 8) and $7;
+ //RM4 := CodeDWORD4 and $7;
+ RM5 := (CodeDWORD8 shr 24) and $7;
+ //RM6 := (CodeDWORD8 shr 16) and $7;
+ //RM7 := (CodeDWORD8 shr 8) and $7;
- // Check the instruction prior to the potential call site.
- // We consider it a valid call site if we find a CALL instruction there
- // Check the most common CALL variants first
- if ((CodeDWORD8 and $FF000000) = $E8000000) then
- // 5 bytes, "CALL NEAR REL32" (E8 cd)
- CallInstructionSize := 5
- else
- if ((CodeDWORD4 and $F8FF0000) = $10FF0000) and not (RM1 in [4, 5]) then
- // 2 bytes, "CALL NEAR [EAX]" (FF /2) where Reg = 010, Mod = 00, R/M <> 100 (1 extra byte)
- // and R/M <> 101 (4 extra bytes)
- CallInstructionSize := 2
- else
- if ((CodeDWORD4 and $F8FF0000) = $D0FF0000) then
- // 2 bytes, "CALL NEAR EAX" (FF /2) where Reg = 010 and Mod = 11
- CallInstructionSize := 2
- else
- if ((CodeDWORD4 and $00FFFF00) = $0014FF00) then
- // 3 bytes, "CALL NEAR [EAX+EAX*i]" (FF /2) where Reg = 010, Mod = 00 and RM = 100
- // SIB byte not validated
- CallInstructionSize := 3
- else
- if ((CodeDWORD4 and $00F8FF00) = $0050FF00) and (RM2 <> 4) then
- // 3 bytes, "CALL NEAR [EAX+$12]" (FF /2) where Reg = 010, Mod = 01 and RM <> 100 (1 extra byte)
- CallInstructionSize := 3
- else
- if ((CodeDWORD4 and $0000FFFF) = $000054FF) then
- // 4 bytes, "CALL NEAR [EAX+EAX+$12]" (FF /2) where Reg = 010, Mod = 01 and RM = 100
- // SIB byte not validated
- CallInstructionSize := 4
- else
- if ((CodeDWORD8 and $FFFF0000) = $15FF0000) then
- // 6 bytes, "CALL NEAR [$12345678]" (FF /2) where Reg = 010, Mod = 00 and RM = 101
- CallInstructionSize := 6
- else
- if ((CodeDWORD8 and $F8FF0000) = $90FF0000) and (RM5 <> 4) then
- // 6 bytes, "CALL NEAR [EAX+$12345678]" (FF /2) where Reg = 010, Mod = 10 and RM <> 100 (1 extra byte)
- CallInstructionSize := 6
- else
- if ((CodeDWORD8 and $00FFFF00) = $0094FF00) then
- // 7 bytes, "CALL NEAR [EAX+EAX+$1234567]" (FF /2) where Reg = 010, Mod = 10 and RM = 100
- CallInstructionSize := 7
- else
- if ((CodeDWORD8 and $0000FF00) = $00009A00) then
- // 7 bytes, "CALL FAR $1234:12345678" (9A ptr16:32)
- CallInstructionSize := 7
- else
+ // Check the instruction prior to the potential call site.
+ // We consider it a valid call site if we find a CALL instruction there
+ // Check the most common CALL variants first
+ if ((CodeDWORD8 and $FF000000) = $E8000000) then
+ // 5 bytes, "CALL NEAR REL32" (E8 cd)
+ CallInstructionSize := 5
+ else
+ if ((CodeDWORD4 and $F8FF0000) = $10FF0000) and not (RM1 in [4, 5]) then
+ // 2 bytes, "CALL NEAR [EAX]" (FF /2) where Reg = 010, Mod = 00, R/M <> 100 (1 extra byte)
+ // and R/M <> 101 (4 extra bytes)
+ CallInstructionSize := 2
+ else
+ if ((CodeDWORD4 and $F8FF0000) = $D0FF0000) then
+ // 2 bytes, "CALL NEAR EAX" (FF /2) where Reg = 010 and Mod = 11
+ CallInstructionSize := 2
+ else
+ if ((CodeDWORD4 and $00FFFF00) = $0014FF00) then
+ // 3 bytes, "CALL NEAR [EAX+EAX*i]" (FF /2) where Reg = 010, Mod = 00 and RM = 100
+ // SIB byte not validated
+ CallInstructionSize := 3
+ else
+ if ((CodeDWORD4 and $00F8FF00) = $0050FF00) and (RM2 <> 4) then
+ // 3 bytes, "CALL NEAR [EAX+$12]" (FF /2) where Reg = 010, Mod = 01 and RM <> 100 (1 extra byte)
+ CallInstructionSize := 3
+ else
+ if ((CodeDWORD4 and $0000FFFF) = $000054FF) then
+ // 4 bytes, "CALL NEAR [EAX+EAX+$12]" (FF /2) where Reg = 010, Mod = 01 and RM = 100
+ // SIB byte not validated
+ CallInstructionSize := 4
+ else
+ if ((CodeDWORD8 and $FFFF0000) = $15FF0000) then
+ // 6 bytes, "CALL NEAR [$12345678]" (FF /2) where Reg = 010, Mod = 00 and RM = 101
+ CallInstructionSize := 6
+ else
+ if ((CodeDWORD8 and $F8FF0000) = $90FF0000) and (RM5 <> 4) then
+ // 6 bytes, "CALL NEAR [EAX+$12345678]" (FF /2) where Reg = 010, Mod = 10 and RM <> 100 (1 extra byte)
+ CallInstructionSize := 6
+ else
+ if ((CodeDWORD8 and $00FFFF00) = $0094FF00) then
+ // 7 bytes, "CALL NEAR [EAX+EAX+$1234567]" (FF /2) where Reg = 010, Mod = 10 and RM = 100
+ CallInstructionSize := 7
+ else
+ if ((CodeDWORD8 and $0000FF00) = $00009A00) then
+ // 7 bytes, "CALL FAR $1234:12345678" (9A ptr16:32)
+ CallInstructionSize := 7
+ else
+ Result := False;
+ // Because we're not doing a complete disassembly, we will potentially report
+ // false positives. If there is odd code that uses the CALL 16:32 format, we
+ // can also get false negatives.
+ except
Result := False;
- // Because we're not doing a complete disassembly, we will potentially report
- // false positives. If there is odd code that uses the CALL 16:32 format, we
- // can also get false negatives.
- except
- Result := False;
+ end;
end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-12-08 20:45:29
|
Revision: 3089
http://jcl.svn.sourceforge.net/jcl/?rev=3089&view=rev
Author: outchy
Date: 2009-12-08 20:45:18 +0000 (Tue, 08 Dec 2009)
Log Message:
-----------
Patch from Pierre le Riche by email: JclStartExceptionTracking and JclStopExceptionTracking can be called more than one time. The tracking activity is handled the same way reference count and update count are.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-11-25 21:47:49 UTC (rev 3088)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-12-08 20:45:18 UTC (rev 3089)
@@ -5358,7 +5358,7 @@
//=== Exception hooking ======================================================
var
- TrackingActive: Boolean;
+ TrackingActiveCount: Integer;
IgnoredExceptions: TThreadList = nil;
IgnoredExceptionClassNames: TStringList = nil;
IgnoredExceptionClassNamesCritSect: TJclCriticalSection = nil;
@@ -5468,7 +5468,7 @@
procedure DoExceptNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean;
BaseOfStack: Pointer);
begin
- if TrackingActive and (not (stDisableIfDebuggerAttached in JclStackTrackingOptions) or (not IsDebuggerAttached)) and
+ if (TrackingActiveCount > 0) and (not (stDisableIfDebuggerAttached in JclStackTrackingOptions) or (not IsDebuggerAttached)) and
Assigned(ExceptObj) and (not IsIgnoredException(ExceptObj.ClassType)) and
(not (stMainThreadOnly in JclStackTrackingOptions) or (GetCurrentThreadId = MainThreadID)) then
begin
@@ -5481,34 +5481,51 @@
function JclStartExceptionTracking: Boolean;
begin
- if TrackingActive then
- Result := False
+ {Increment the tracking count only if exceptions are already being tracked or tracking can be started
+ successfully.}
+ if TrackingActiveCount = 0 then
+ begin
+ if JclHookExceptions and JclAddExceptNotifier(DoExceptNotify, npFirstChain) then
+ begin
+ TrackingActiveCount := 1;
+ Result := True;
+ end
+ else
+ Result := False;
+ end
else
begin
- Result := JclHookExceptions and JclAddExceptNotifier(DoExceptNotify, npFirstChain);
- TrackingActive := Result;
+ Inc(TrackingActiveCount);
+ Result := False;
end;
end;
function JclStopExceptionTracking: Boolean;
begin
- if TrackingActive then
+ {If the current tracking count is 1, an attempt is made to stop tracking exceptions. If successful the
+ tracking count is set back to 0. If the current tracking count is > 1 it is simply decremented.}
+ if TrackingActiveCount = 1 then
begin
Result := JclRemoveExceptNotifier(DoExceptNotify);
- TrackingActive := False;
+ if Result then
+ Dec(TrackingActiveCount);
end
else
+ begin
+ if TrackingActiveCount > 0 then
+ Dec(TrackingActiveCount);
Result := False;
+ end;
end;
function JclExceptionTrackingActive: Boolean;
begin
- Result := TrackingActive;
+ Result := TrackingActiveCount > 0;
end;
function JclTrackExceptionsFromLibraries: Boolean;
begin
- Result := TrackingActive;
+ Result := TrackingActiveCount > 0;
if Result then
JclInitializeLibrariesHookExcept;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rro...@us...> - 2009-12-28 17:42:32
|
Revision: 3099
http://jcl.svn.sourceforge.net/jcl/?rev=3099&view=rev
Author: rrossmair
Date: 2009-12-28 17:42:18 +0000 (Mon, 28 Dec 2009)
Log Message:
-----------
Provisional fix, to be revised later
(Mantis #4929)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-12-22 05:52:40 UTC (rev 3098)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-12-28 17:42:18 UTC (rev 3099)
@@ -5290,7 +5290,7 @@
HandlerAt := FExcTab[I].Handler
else
begin
- ParentVTable := PPointer(TJclAddr(VTable) + TJclAddr(vmtParent))^;
+ ParentVTable := TClass(VTable).ClassParent;
if ParentVTable = VTable then
VTable := nil
else
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2009-12-29 17:38:45
|
Revision: 3100
http://jcl.svn.sourceforge.net/jcl/?rev=3100&view=rev
Author: uschuster
Date: 2009-12-29 17:38:38 +0000 (Tue, 29 Dec 2009)
Log Message:
-----------
added the helper function JclClearGlobalStackData for DUnit
(This function clears all global stack data that has been generated when an exception was raised.
For the runtime memory leak check within DUnit it is important that the allocated memory before and after the test is equal.
When an exception is raised within a try except block like this
procedure TDUnitTestCase.TestFooException;
begin
try
raise TFooException.Create;
except
end;
end;
in a test then the stack trace gets added to the global stack data and that increases the allocated memory. For DUnit it
seems that the test has leaked memory. To workaround this without overcomplicating the DUnit runtime memory leak check
JclClearGlobalStackData can be used to clear all global stack data before and after the test.)
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-12-28 17:42:18 UTC (rev 3099)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-12-29 17:38:38 UTC (rev 3100)
@@ -688,6 +688,9 @@
IncludeModuleName: Boolean = False; IncludeAddressOffset: Boolean = False;
IncludeStartProcLineOffset: Boolean = False; IncludeVAddress: Boolean = False): Boolean;
+// helper function for DUnit runtime memory leak check
+procedure JclClearGlobalStackData;
+
// Exception frame info routines
type
PJmpInstruction = ^TJmpInstruction;
@@ -4254,6 +4257,7 @@
public
destructor Destroy; override;
procedure AddObject(AObject: TJclStackBaseList);
+ procedure Clear;
procedure LockThreadID(TID: DWORD);
procedure UnlockThreadID;
function FindObject(TID: DWORD; AClass: TJclStackBaseListClass): TJclStackBaseList;
@@ -4295,6 +4299,22 @@
end;
end;
+procedure TJclGlobalStackList.Clear;
+begin
+ with LockList do
+ try
+ while Count > 0 do
+ TObject(Items[0]).Free;
+ { The following call to Clear seems to be useless, but it deallocates memory
+ by setting the lists capacity back to zero. For the runtime memory leak check
+ within DUnit it is important that the allocated memory before and after the
+ test is equal. }
+ Clear; // do not remove
+ finally
+ UnlockList;
+ end;
+end;
+
function TJclGlobalStackList.FindObject(TID: DWORD; AClass: TJclStackBaseListClass): TJclStackBaseList;
var
I: Integer;
@@ -4562,6 +4582,11 @@
IncludeVAddress);
end;
+procedure JclClearGlobalStackData;
+begin
+ GlobalStackList.Clear;
+end;
+
function JclCreateStackList(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer): TJclStackInfoList;
begin
Result := TJclStackInfoList.Create(Raw, AIgnoreLevels, FirstCaller, False, nil, nil);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2010-01-20 19:02:27
|
Revision: 3127
http://jcl.svn.sourceforge.net/jcl/?rev=3127&view=rev
Author: outchy
Date: 2010-01-20 19:02:19 +0000 (Wed, 20 Jan 2010)
Log Message:
-----------
Fix from Embarcadero: EncodeNameString raised 2 distinct range check errors.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2010-01-20 18:10:19 UTC (rev 3126)
+++ trunk/jcl/source/windows/JclDebug.pas 2010-01-20 19:02:19 UTC (rev 3127)
@@ -2040,7 +2040,7 @@
function EncodeNameString(const S: string): AnsiString;
var
- I, StartIndex: Integer;
+ I, StartIndex, EndIndex: Integer;
C: Byte;
P: PByte;
begin
@@ -2060,9 +2060,13 @@
P^ := 2 // store '@' leading char information
else
Dec(P);
- for I := 0 to Length(S) - StartIndex do // including null char
+ EndIndex := Length(S) - StartIndex;
+ for I := 0 to EndIndex do // including null char
begin
- C := Byte(S[I + 1 + StartIndex]);
+ if I = EndIndex then
+ C := 0
+ else
+ C := Byte(S[I + 1 + StartIndex]);
case AnsiChar(C) of
#0:
C := 0;
@@ -2091,7 +2095,7 @@
end;
2:
begin
- P^ := P^ or (C shl 4);
+ P^ := P^ or Byte(C shl 4);
Inc(P);
P^ := (C shr 4) and $03;
end;
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