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

Debugger: Refactor start some -exec-* commands to use object-queue, and callback.

Browse Source 
git-svn-id: trunk@28167 -
This commit is contained in:
martin 2010-11-09 17:07:47 +00:00
parent 3f0760fa6b
commit 2ef911ad23
1 changed files with 275 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

146
debugger/gdbmidebugger.pp
View File

@ -259,7 +259,7 @@ type
procedure QueueCommand(const ACommand: TGDBMIDebuggerCommand);
procedure UnQueueCommand(const ACommand: TGDBMIDebuggerCommand);
procedure CancelAllQueued;
function StartDebugging(const AContinueCommand: String): Boolean;
function StartDebugging(AContinueCommand: TGDBMIDebuggerCommand): Boolean;
protected
procedure QueueExecuteLock;
procedure QueueExecuteUnlock;
@ -346,7 +346,18 @@ type
end;
TGDBMICpuRegisters = Array of TGDBMICpuRegister;
TGDBMIExecCommandType =
( ectContinue, // -exec-continue
ectRun, // -exec-run
ectRunTo, // -exec-until [Source, Line]
ectStepOver, // -exec-next
ectStepOut, // -exec-finish
ectStepInto, // -exec-step
// not yet used
ectStepOverInstruction, // -exec-next-instruction
ectStepIntoInstruction, // -exec-step-instruction
ectReturn // -exec-return (step out immediately, skip execution)
);
TGDBMIEvaluationState = (esInvalid, esRequested, esValid);
{ TGDBMINameValueList }
@ -403,6 +414,24 @@ type
property Result: TGDBMIExecResult read FResult;
end;
{ TGDBMIDebuggerCommandExecute }
TGDBMIDebuggerCommandExecute = class(TGDBMIDebuggerCommand)
private
FResult: TGDBMIExecResult;
FExecType: TGDBMIExecCommandType;
FCommand: String;
protected
procedure DoLockQueueExecute; override;
procedure DoUnockQueueExecute; override;
function DoExecute: Boolean; override;
public
constructor Create(AOwner: TGDBMIDebugger; const ExecType: TGDBMIExecCommandType);
constructor Create(AOwner: TGDBMIDebugger; const ExecType: TGDBMIExecCommandType; Args: array of const);
function DebugText: String; override;
property Result: TGDBMIExecResult read FResult;
end;
{ TGDBMIDebuggerCommandEvaluate }
TGDBMIDebuggerCommandEvaluate = class(TGDBMIDebuggerCommand)
@ -711,6 +740,72 @@ type
eoShr
);
{ TGDBMIDebuggerCommandExecute }
procedure TGDBMIDebuggerCommandExecute.DoLockQueueExecute;
begin
// prevent lock
end;
procedure TGDBMIDebuggerCommandExecute.DoUnockQueueExecute;
begin
// prevent lock
end;
function TGDBMIDebuggerCommandExecute.DoExecute: Boolean;
var
StoppedParams: String;
begin
Result := True;
FTheDebugger.QueueExecuteLock; // prevent other commands from executing
try
if not ExecuteCommand(FCommand, FResult)
then exit;
if (FResult.State <> dsNone)
then FTheDebugger.SetState(FResult.State);
StoppedParams := '';
if FResult.State = dsRun
then Result := FTheDebugger.ProcessRunning(StoppedParams);
finally
FTheDebugger.QueueExecuteUnlock; // allow other commands from executing
end;
if StoppedParams <> ''
then FTheDebugger.ProcessStopped(StoppedParams, FTheDebugger.PauseWaitState = pwsInternal);
end;
constructor TGDBMIDebuggerCommandExecute.Create(AOwner: TGDBMIDebugger;
const ExecType: TGDBMIExecCommandType);
begin
Create(AOwner, ExecType, []);
end;
constructor TGDBMIDebuggerCommandExecute.Create(AOwner: TGDBMIDebugger;
const ExecType: TGDBMIExecCommandType; Args: array of const);
begin
inherited Create(AOwner);
FExecType := ExecType;
case FExecType of
ectContinue: FCommand := '-exec-continue';
ectRun: FCommand := '-exec-run';
ectRunTo: FCommand := Format('-exec-until %s:%d', Args);
ectStepOver: FCommand := '-exec-next';
ectStepOut: FCommand := '-exec-finish';
ectStepInto: FCommand := '-exec-step';
ectStepOverInstruction: FCommand := '-exec-next-instruction';
ectStepIntoInstruction: FCommand := '-exec-step-instruction';
ectReturn: FCommand := '-exec-return';
end;
end;
function TGDBMIDebuggerCommandExecute.DebugText: String;
begin
Result := Format('%s: %s', [ClassName, FCommand]);
end;
{ TGDBMIDebuggerCommandLineSymbolInfo }
function TGDBMIDebuggerCommandLineSymbolInfo.DoExecute: Boolean;
@ -2009,7 +2104,7 @@ begin
// reset state
FPauseWaitState := pwsNone;
// insert continue command
Cmd := TGDBMIDebuggerSimpleCommand.Create(Self, '-exec-continue', [], [], nil, 0);
Cmd := TGDBMIDebuggerCommandExecute.Create(Self, ectContinue);
FCommandQueue.Add(Cmd);
{$IFDEF GDMI_QUEUE_DEBUG}
debugln(['Internal Queueing: exec-continue']);
@ -2638,10 +2733,11 @@ begin
Result := False;
case State of
dsStop: begin
Result := StartDebugging('-exec-continue');
Result := StartDebugging(TGDBMIDebuggerCommandExecute.Create(Self, ectContinue));
end;
dsPause: begin
Result := ExecuteCommand('-exec-continue', [cfExternal]);
QueueCommand(TGDBMIDebuggerCommandExecute.Create(Self, ectContinue));
Result := True;
end;
dsIdle: begin
DebugLn('[WARNING] Debugger: Unable to run in idle state');
@ -2655,10 +2751,11 @@ begin
Result := False;
case State of
dsStop: begin
Result := StartDebugging(Format('-exec-until %s:%d', [ASource, ALine]));
Result := StartDebugging(TGDBMIDebuggerCommandExecute.Create(Self, ectRunTo, [ASource, ALine]));
end;
dsPause: begin
Result := ExecuteCommand('-exec-until %s:%d', [ASource, ALine], [cfExternal]);
QueueCommand(TGDBMIDebuggerCommandExecute.Create(Self, ectRunTo, [ASource, ALine]));
Result := True;
end;
dsIdle: begin
DebugLn('[WARNING] Debugger: Unable to runto in idle state');
@ -2750,10 +2847,11 @@ begin
Result := False;
case State of
dsStop: begin
Result := StartDebugging('');
Result := StartDebugging(nil);
end;
dsPause: begin
Result := ExecuteCommand('-exec-step', [cfExternal]);
QueueCommand(TGDBMIDebuggerCommandExecute.Create(Self, ectStepInto));
Result := True;
end;
dsIdle: begin
DebugLn('[WARNING] Debugger: Unable to step in idle state');
@ -2766,10 +2864,11 @@ begin
Result := False;
case State of
dsStop: begin
Result := StartDebugging('');
Result := StartDebugging(nil);
end;
dsPause: begin
Result := ExecuteCommand('-exec-finish', [cfExternal]);
QueueCommand(TGDBMIDebuggerCommandExecute.Create(Self, ectStepOut));
Result := True;
end;
dsIdle: begin
DebugLn('[WARNING] Debugger: Unable to step out in idle state');
@ -2782,10 +2881,11 @@ begin
Result := False;
case State of
dsStop: begin
Result := StartDebugging('');
Result := StartDebugging(nil);
end;
dsPause: begin
Result := ExecuteCommand('-exec-next', [cfExternal]);
QueueCommand(TGDBMIDebuggerCommandExecute.Create(Self, ectStepOver));
Result := True;
end;
dsIdle: begin
DebugLn('[WARNING] Debugger: Unable to step over in idle state');
@ -3723,7 +3823,7 @@ begin
ExecuteCommand('-stack-select-frame %d', [AIndex], [cfIgnoreError]);
end;
function TGDBMIDebugger.StartDebugging(const AContinueCommand: String): Boolean;
function TGDBMIDebugger.StartDebugging(AContinueCommand: TGDBMIDebuggerCommand): Boolean;
function CheckFunction(const AFunction: String): Boolean;
var
R: TGDBMIExecResult;
@ -3924,6 +4024,7 @@ var
TargetPIDPart: String;
TempInstalled, CanContinue: Boolean;
begin
try
if not (State in [dsStop])
then begin
Result := True;
@ -4077,14 +4178,21 @@ begin
end
else CanContinue := True;
if CanContinue and (AContinueCommand <> '')
then Result := ExecuteCommand(AContinueCommand, [])
else SetState(dsPause);
if CanContinue and (AContinueCommand <> nil)
then begin
QueueCommand(AContinueCommand);
AContinueCommand := nil;
end else
SetState(dsPause);
end
else SetState(R.State);
if State = dsPause
then ProcessFrame;
finally
if assigned(AContinueCommand)
then AContinueCommand.Free;
end;
Result := True;
end;
@ -6260,14 +6368,12 @@ end;
function TGDBMIDebuggerSimpleCommand.DoExecute: Boolean;
var
R: Boolean;
StoppedParams: String;
begin
Result := True;
FTheDebugger.QueueExecuteLock; // prevent other commands from executing
try
R := ExecuteCommand(FCommand, FResult);
if not R
if not ExecuteCommand(FCommand, FResult)
then exit;
if (FResult.State <> dsNone)