paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 09:38:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 59727-59729 #bba050e333-#bba050e333, 59740-59743 #0506cd7fb5-#0506cd7fb5, 59745 #c5fdbd440a from trunk:

Browse Source 
FpDebug: Disable assert, until fixed
........
FpDebug (incl lldb/gdb): Fix crash due to wrong cache removed from list. List could have 2 caches with same address, if a smaller cache was replaced by a bigger. Remove could destroy one and remove the other
........
FpDebug: (Linux/Mac) Do not keep files open longer than needed. Systems may limit max files open. (Mac opens many files)
........
FpDebug: Windows, Check dwDebugEventCode before accessing case dependent data
........
FpDebug: Windows, fix leaking filehandles (again), see r59552 #122dfbd2ce / needed until forked processes are handled.
........
LazDebuggerFp: fix getting exception class/msg for 64bit targets
........
Debugger: Limit size of exception message/window
........
FpDebug: fix accessing nil fileloader. Introduced in rev 59729 #f09614b9a8 / Issue #0034657
........

git-svn-id: branches/fixes_2_0@59766 -
This commit is contained in:
maxim 2018-12-09 22:33:15 +00:00
parent 21fb0ba3d9
commit 3e125017ab
9 changed files with 81 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpdebug/fpdbgclasses.pp
View File

@ -822,7 +822,7 @@ destructor TDbgProcess.Destroy;
begin
FProcessID:=0;
Assert(FBreakMap.Count=0, 'No breakpoints left');
//Assert(FBreakMap.Count=0, 'No breakpoints left');
//FreeItemsInMap(FBreakMap);
FreeItemsInMap(FThreadMap);
FreeItemsInMap(FLibMap);

1
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -2948,6 +2948,7 @@ begin
FFiles[i].Sections[Section].Size := p^.Size;
FFiles[i].Sections[Section].VirtualAddress := p^.VirtualAddress;
end;
ALoaderList[i].CloseFileLoader;
end;
end;

12
components/fpdebug/fpdbgloader.pp
View File

@ -77,6 +77,7 @@ type
constructor Create(AFileHandle: THandle; ADebugMap: TObject = nil);
{$endif}
destructor Destroy; override;
procedure CloseFileLoader;
procedure AddToLoaderList(ALoaderList: TDbgImageLoaderList);
function IsValid: Boolean;
property FileName: String read FFileName; // Empty if using USE_WIN_FILE_MAPPING
@ -195,7 +196,7 @@ constructor TDbgImageLoader.Create(AFileName: String; ADebugMap: TObject = nil);
begin
FFileName := AFileName;
FFileLoader := TDbgFileLoader.Create(AFileName);
FImgReader := GetImageReader(FFileLoader, ADebugMap, True);
FImgReader := GetImageReader(FFileLoader, ADebugMap, False);
if FImgReader = nil then FreeAndNil(FFileLoader);
end;
@ -209,7 +210,7 @@ end;
constructor TDbgImageLoader.Create(AFileHandle: THandle; ADebugMap: TObject = nil);
begin
FFileLoader := TDbgFileLoader.Create(AFileHandle);
FImgReader := GetImageReader(FFileLoader, ADebugMap, True);
FImgReader := GetImageReader(FFileLoader, ADebugMap, False);
if FImgReader = nil then FreeAndNil(FFileLoader);
end;
{$endif}
@ -217,9 +218,16 @@ end;
destructor TDbgImageLoader.Destroy;
begin
FreeAndNil(FImgReader);
FreeAndNil(FFileLoader);
inherited Destroy;
end;
procedure TDbgImageLoader.CloseFileLoader;
begin
if FFileLoader <> nil then
FFileLoader.Close;
end;
procedure TDbgImageLoader.AddToLoaderList(ALoaderList: TDbgImageLoaderList);
begin
ALoaderList.Add(Self);

28
components/fpdebug/fpdbgwinclasses.pas
View File

@ -508,14 +508,17 @@ begin
end;
end;
case MDebugEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_BREAKPOINT,
EXCEPTION_SINGLE_STEP: begin
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
end
if MDebugEvent.dwDebugEventCode = EXCEPTION_DEBUG_EVENT then
case MDebugEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_BREAKPOINT,
EXCEPTION_SINGLE_STEP: begin
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
end
else
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_EXCEPTION_NOT_HANDLED);
end
else
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_EXCEPTION_NOT_HANDLED);
end;
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
result := true;
end;
@ -524,6 +527,15 @@ begin
result := Windows.WaitForDebugEvent(MDebugEvent, INFINITE);
ProcessIdentifier:=MDebugEvent.dwProcessId;
ThreadIdentifier:=MDebugEvent.dwThreadId;
// Should be done in AnalyseDebugEvent, but that is not called for forked processes
if (MDebugEvent.dwDebugEventCode = CREATE_PROCESS_DEBUG_EVENT) and
(MDebugEvent.dwProcessId <> ProcessID) and
(MDebugEvent.CreateProcessInfo.hFile <> 0)
then begin
CloseHandle(MDebugEvent.CreateProcessInfo.hFile);
MDebugEvent.CreateProcessInfo.hFile := 0;
end;
end;
function TDbgWinProcess.AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent;
@ -818,7 +830,7 @@ begin
end;
CREATE_PROCESS_DEBUG_EVENT: begin
//DumpEvent('CREATE_PROCESS_DEBUG_EVENT');
if MDebugEvent.dwProcessId = TDbgWinThread(AThread).Process.ProcessID then begin;
if MDebugEvent.dwProcessId = TDbgWinThread(AThread).Process.ProcessID then begin
//main process
StartProcess(MDebugEvent.dwThreadId, MDebugEvent.CreateProcessInfo); // hfile will be closed by TDbgImageLoader
FJustStarted := true;

4
components/fpdebug/fpdmemorytools.pas
View File

@ -245,7 +245,7 @@ type
* TODO: allow to pre-read and cache Target mem (e.g. before reading all fields of a record
*)
TFpDbgMemLocationType = (
mlfUninitialized := 0, // like invalid, but not known // 0 means objet fields will start wint this
mlfUninitialized := 0, // like invalid, but not known // This (0) is the initial value
mlfInvalid,
mlfTargetMem, // an address in the target (debuggee) process
mlfSelfMem, // an address in this(the debuggers) process memory; the data is in TARGET format (endian, ...)
@ -747,7 +747,7 @@ begin
if ACache = nil then
exit;
FCaches.Remove(ACache);
FCaches.RemovePointer(ACache);
ACache.Free;
end;

16
components/fpdebug/fpimgreaderbase.pas
View File

@ -52,6 +52,7 @@ type
FMapHandle: THandle;
FModulePtr: Pointer;
{$else}
FFileName: String;
FStream: TStream;
FList: TList;
{$endif}
@ -61,6 +62,7 @@ type
constructor Create(AFileHandle: THandle);
{$endif}
destructor Destroy; override;
procedure Close;
function Read(AOffset, ASize: QWord; AMem: Pointer): QWord;
function LoadMemory(AOffset, ASize: QWord; out AMem: Pointer): QWord;
procedure UnloadMemory({%H-}AMem: Pointer);
@ -122,6 +124,7 @@ begin
try
if cls.isValid(ASource) then begin
Result := cls.Create(ASource, ADebugMap, OwnSource);
ASource.Close;
Exit;
end
else
@ -132,6 +135,7 @@ begin
end;
end;
end;
ASource.Close;
Result := nil;
end;
@ -162,6 +166,7 @@ begin
if (FileExists(s)) then AFileName := s
end;
{$ENDIF}
FFileName := AFileName;
FStream := TFileStreamUTF8.Create(AFileName, fmOpenRead or fmShareDenyNone);
inherited Create;
{$endif}
@ -212,6 +217,13 @@ begin
{$endif}
end;
procedure TDbgFileLoader.Close;
begin
{$ifNdef USE_WIN_FILE_MAPPING}
FreeAndNil(FStream);
{$endif}
end;
function TDbgFileLoader.Read(AOffset, ASize: QWord; AMem: Pointer): QWord;
begin
{$ifdef USE_WIN_FILE_MAPPING}
@ -221,6 +233,8 @@ begin
Result := 0;
if AMem = nil then
exit;
if FStream = nil then
FStream := TFileStreamUTF8.Create(FFileName, fmOpenRead or fmShareDenyNone);
FStream.Position := AOffset;
Result := FStream.Read(AMem^, ASize);
{$endif}
@ -236,6 +250,8 @@ begin
AMem := AllocMem(ASize);
if AMem = nil then
exit;
if FStream = nil then
FStream := TFileStreamUTF8.Create(FFileName, fmOpenRead or fmShareDenyNone);
FList.Add(AMem);
FStream.Position := AOffset;
Result := FStream.Read(AMem^, ASize);

18
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -1590,19 +1590,27 @@ var
AnExceptionObjectLocation: TDBGPtr;
ExceptionClass: string;
ExceptionMessage: string;
RegDxDwarfIndex: byte;
RegDxDwarfIndex, RegFirstArg: Cardinal;
ExceptItem: TBaseException;
begin
// Using regvar:
// In all their wisdom, people decided to give the (r)dx register dwarf index
// 1 on for x86_64 and index 2 for i386.
if FDbgController.CurrentProcess.Mode=dm32 then
RegDxDwarfIndex:=2
else
if FDbgController.CurrentProcess.Mode=dm32 then begin
RegDxDwarfIndex:=2;
RegFirstArg := 0; // AX
end else begin
RegDxDwarfIndex:=1;
{$IFDEF windows}
// Must be Win64
RegFirstArg := 2; // RCX
{$ELSE}
RegFirstArg := 5; // RDI
{$ENDIF}
end;
AnExceptionLocation:=GetLocationRec(FDbgController.CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(RegDxDwarfIndex).NumValue);
AnExceptionObjectLocation:=FDbgController.CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(0).NumValue;
AnExceptionObjectLocation:=FDbgController.CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(RegFirstArg).NumValue;
ExceptionClass := '';
ExceptionMessage := '';
if AnExceptionObjectLocation <> 0 then begin

5
debugger/exceptiondlg.pas
View File

@ -28,7 +28,8 @@ unit ExceptionDlg;
interface
uses
Classes, Forms, Dialogs, StdCtrls, Buttons, IDEImagesIntf, LazarusIDEStrConsts;
Classes, math, Forms, Dialogs, StdCtrls, Buttons, IDEImagesIntf,
LazarusIDEStrConsts;
type
@ -88,6 +89,8 @@ end;
function TIDEExceptionDlg.Execute(AMessage: String; out IgnoreException: Boolean): TModalResult;
begin
lblMessage.Constraints.MaxWidth := max(1, Screen.DesktopWidth-10);
lblMessage.Constraints.MaxHeight := max(1, Screen.DesktopHeight-100);
lblMessage.Caption := AMessage;
Result := ShowModal;
IgnoreException := cbIgnoreExceptionType.Checked;

19
ide/debugmanager.pas
View File

@ -1163,8 +1163,11 @@ procedure TDebugManager.DebuggerException(Sender: TObject;
Result := ExtractFileName(FDebugger.FileName);
end;
const
MAX_CLASSNAME_LEN = 256; // shortstring
MAX_MSG_DISPLAY_LEN = 2048; // just sanity
var
ExceptMsg: string;
ExpClassName, ExceptMsg: string;
msg, SrcText: String;
Ignore: Boolean;
Editor: TSourceEditor;
@ -1178,18 +1181,24 @@ begin
else
AContinue := False;
ExpClassName := AExceptionClass;
if Length(ExpClassName) > MAX_CLASSNAME_LEN then
ExpClassName := copy(ExpClassName, 1, MAX_CLASSNAME_LEN) + '...';
if AExceptionText = ''
then
msg := Format(lisProjectSRaisedExceptionClassS,
[GetTitle, AExceptionClass])
[GetTitle, ExpClassName])
else begin
ExceptMsg := AExceptionText;
if Length(ExceptMsg) > MAX_MSG_DISPLAY_LEN then
ExceptMsg := copy(ExceptMsg, 1, MAX_MSG_DISPLAY_LEN) + '...';
// if AExceptionText is not a valid UTF8 string,
// then assume it has the ansi encoding and convert it
if FindInvalidUTF8Codepoint(pchar(ExceptMsg),length(ExceptMsg)) > 0 then
ExceptMsg := AnsiToUtf8(ExceptMsg);
msg := Format(lisProjectSRaisedExceptionClassSWithMessageSS,
[GetTitle, AExceptionClass, LineEnding, ExceptMsg]);
[GetTitle, ExpClassName, LineEnding, ExceptMsg]);
end;
if AExceptionLocation.SrcFile <> '' then begin
@ -1225,8 +1234,8 @@ begin
if (AExceptionType in [deInternal, deRunError]) then begin
AContinue := ExecuteExceptionDialog(msg, Ignore, AExceptionType in [deInternal, deRunError]) = mrCancel;
if Ignore then begin
Exceptions.AddIfNeeded(AExceptionClass);
Exceptions.Find(AExceptionClass).Enabled := True;
Exceptions.AddIfNeeded(ExpClassName);
Exceptions.Find(ExpClassName).Enabled := True;
end;
end
else begin