paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 03:49:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

gdbmi debugger: small refactor, move release-lock to debuggerintf

Browse Source 
git-svn-id: trunk@58148 -
This commit is contained in:
martin 2018-06-05 21:38:20 +00:00
parent 75417ff3a2
commit 28ff72d0c2
2 changed files with 21 additions and 30 deletions
components
debuggerintf
dbgintfdebuggerbase.pp
lazdebuggergdbmi
gdbmidebugger.pp

22
components/debuggerintf/dbgintfdebuggerbase.pp
View File

@ -1764,6 +1764,7 @@ type
FOnBreakPointHit: TDebuggerBreakPointHitEvent;
FWorkingDir: String;
FDestroyNotificationList: array [TDebuggerNotifyReason] of TMethodList;
FReleaseLock: Integer;
procedure DebuggerEnvironmentChanged(Sender: TObject);
procedure EnvironmentChanged(Sender: TObject);
//function GetUnitInfoProvider: TDebuggerUnitInfoProvider;
@ -1809,6 +1810,9 @@ type
procedure SetState(const AValue: TDBGState);
procedure SetErrorState(const AMsg: String; const AInfo: String = '');
procedure DoRelease; virtual;
// prevent destruction while nested in any call
procedure LockRelease; virtual;
procedure UnlockRelease; virtual;
public
class function Caption: String; virtual; // The name of the debugger as shown in the debuggeroptions
class function ExePaths: String; virtual; // The default locations of the exe
@ -1883,7 +1887,7 @@ type
property State: TDBGState read FState; // The current state of the debugger
property SupportedCommands: TDBGCommands read GetSupportedCommands; // All available commands of the debugger
property TargetWidth: Byte read GetTargetWidth; // Currently only 32 or 64
property Waiting: Boolean read GetWaiting; // Set when the debugger is wating for a command to complete
//property Waiting: Boolean read GetWaiting; // Set when the debugger is wating for a command to complete
property Watches: TWatchesSupplier read FWatches; // list of all watches etc
property Threads: TThreadsSupplier read FThreads;
property WorkingDir: String read FWorkingDir write FWorkingDir; // The working dir of the exe being debugged
@ -6095,9 +6099,25 @@ end;
procedure TDebuggerIntf.DoRelease;
begin
SetState(dsDestroying);
if FReleaseLock > 0
then exit;
Self.Free;
end;
procedure TDebuggerIntf.LockRelease;
begin
inc(FReleaseLock);
end;
procedure TDebuggerIntf.UnlockRelease;
begin
dec(FReleaseLock);
if (FReleaseLock = 0) and (State = dsDestroying)
then Release;
end;
procedure TDebuggerIntf.StepInto;
begin
if ReqCmd(dcStepInto, []) then exit;

29
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -763,7 +763,6 @@ type
FRunQueueOnUnlock: Boolean;
FDebuggerFlags: TGDBMIDebuggerFlags;
FSourceNames: TStringList; // Objects[] -> TMap[Integer|Integer] -> TDbgPtr
FReleaseLock: Integer;
FInProcessStopped: Boolean; // paused, but maybe state run
FCommandNoneMiState: Array [TGDBMIExecCommandType] of Boolean;
FCommandAsyncState: Array [TGDBMIExecCommandType] of Boolean;
@ -814,10 +813,6 @@ type
deprecated;
function GDBSourceAdress(const ASource: String; ALine, {%H-}AColumn: Integer; out AAddr: TDbgPtr): Boolean;
// prevent destruction while nested in any call
procedure LockRelease;
procedure UnlockRelease;
// ---
procedure ClearSourceInfo;
function FindBreakpoint(const ABreakpoint: Integer): TDBGBreakPoint;
@ -885,7 +880,6 @@ type
property TargetFlags: TGDBMITargetFlags read FTargetInfo.TargetFlags write FTargetInfo.TargetFlags;
property PauseWaitState: TGDBMIPauseWaitState read FPauseWaitState;
property DebuggerFlags: TGDBMIDebuggerFlags read FDebuggerFlags;
procedure DoRelease; override; // Destroy self (or schedule)
procedure DoUnknownException(Sender: TObject; AnException: Exception);
procedure DoNotifyAsync(Line: String);
@ -7383,8 +7377,6 @@ end;
constructor TGDBMIDebugger.Create(const AExternalDebugger: String);
begin
FReleaseLock := 0;
FMainAddrBreak := TGDBMIInternalBreakPoint.Create('main');
FBreakErrorBreak := TGDBMIInternalBreakPoint.Create('FPC_BREAK_ERROR');
FRunErrorBreak := TGDBMIInternalBreakPoint.Create('FPC_RUNERROR');
@ -7683,15 +7675,6 @@ begin
Registers.CurrentRegistersList.Clear;
end;
procedure TGDBMIDebugger.DoRelease;
begin
SetState(dsDestroying);
if FReleaseLock > 0
then exit;
inherited DoRelease;
end;
procedure TGDBMIDebugger.DoUnknownException(Sender: TObject; AnException: Exception);
var
I: Integer;
@ -8535,18 +8518,6 @@ begin
LinesList.Free;
end;
procedure TGDBMIDebugger.LockRelease;
begin
inc(FReleaseLock);
end;
procedure TGDBMIDebugger.UnlockRelease;
begin
dec(FReleaseLock);
if (FReleaseLock = 0) and (State = dsDestroying)
then Release;
end;
function TGDBMIDebugger.GDBStepInto: Boolean;
begin
Result := False;