mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-10 05:36:10 +02:00
dbg: add basic support for gdbserver
git-svn-id: trunk@42405 -
This commit is contained in:
martin
parent
1f37272726
commit
e90a1cadbf
@ -479,11 +479,13 @@ begin
|
||||
then FOutputBuf := '';
|
||||
FFlushAfterRead := False;
|
||||
|
||||
if ((DBG_CMD_ECHO_FULL <> nil) and (DBG_CMD_ECHO_FULL^.Enabled))
|
||||
then debugln(DBG_CMD_ECHO_FULL, '<< TCmdLineDebugger.ReadLn "',Result,'"')
|
||||
else if (length(Result) < 300)
|
||||
then debugln(DBG_CMD_ECHO, '<< TCmdLineDebugger.ReadLn "',Result,'"')
|
||||
else debugln(DBG_CMD_ECHO, ['<< TCmdLineDebugger.ReadLn "',copy(Result, 1, 200), '" ..(',length(Result)-250,').. "',copy(Result, length(Result)-99, 100),'"']);
|
||||
if not( FReadLineTimedOut and (Result = '') ) then begin
|
||||
if ((DBG_CMD_ECHO_FULL <> nil) and (DBG_CMD_ECHO_FULL^. Enabled))
|
||||
then debugln(DBG_CMD_ECHO_FULL, '<< TCmdLineDebugger.ReadLn "',Result,'"')
|
||||
else if (length(Result) < 300)
|
||||
then debugln(DBG_CMD_ECHO, '<< TCmdLineDebugger.ReadLn "',Result,'"')
|
||||
else debugln(DBG_CMD_ECHO, ['<< TCmdLineDebugger.ReadLn "',copy(Result, 1, 200), '" ..(',length(Result)-250,').. "',copy(Result, length(Result)-99, 100),'"']);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCmdLineDebugger.SendCmdLn(const ACommand: String); overload;
|
||||
|
||||
@ -231,14 +231,15 @@ type
|
||||
FQueueRunLevel: Integer;
|
||||
FState : TGDBMIDebuggerCommandState;
|
||||
FSeenStates: TGDBMIDebuggerCommandStates;
|
||||
FTheDebugger: TGDBMIDebugger; // Set during Execute
|
||||
FLastExecCommand: String;
|
||||
FLastExecResult: TGDBMIExecResult;
|
||||
FLogWarnings, FFullCmdReply: String;
|
||||
FGotStopped: Boolean; // used in ProcessRunning
|
||||
function GetDebuggerProperties: TGDBMIDebuggerPropertiesBase;
|
||||
function GetDebuggerState: TDBGState;
|
||||
function GetTargetInfo: PGDBMITargetInfo;
|
||||
protected
|
||||
FTheDebugger: TGDBMIDebugger; // Set during Execute
|
||||
procedure SetDebuggerState(const AValue: TDBGState);
|
||||
procedure SetDebuggerErrorState(const AMsg: String; const AInfo: String = '');
|
||||
function ErrorStateMessage: String; virtual;
|
||||
@ -659,6 +660,9 @@ type
|
||||
function CreateCommandInit: TGDBMIDebuggerCommandInitDebugger; virtual;
|
||||
function CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging; virtual;
|
||||
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
|
||||
property CurrentCmdIsAsync: Boolean read FCurrentCmdIsAsync;
|
||||
property CurrentCommand: TGDBMIDebuggerCommand read FCurrentCommand;
|
||||
|
||||
procedure ClearCommandQueue;
|
||||
function GetIsIdle: Boolean; override;
|
||||
procedure ResetStateToIdle; override;
|
||||
@ -701,6 +705,8 @@ type
|
||||
procedure LockCommandProcessing; override;
|
||||
procedure UnLockCommandProcessing; override;
|
||||
|
||||
property AsyncModeEnabled: Boolean read FAsyncModeEnabled;
|
||||
|
||||
// internal testing
|
||||
procedure TestCmd(const ACommand: String); override;
|
||||
end;
|
||||
@ -1921,7 +1927,7 @@ end;
|
||||
function TGDBMIDebuggerCommandExecuteBase.ProcessRunning(var AStoppedParams: String; out
|
||||
AResult: TGDBMIExecResult): Boolean;
|
||||
var
|
||||
InLogWarning, GotStopped: Boolean;
|
||||
InLogWarning: Boolean;
|
||||
|
||||
function DoExecAsync(var Line: String): Boolean;
|
||||
var
|
||||
@ -1935,10 +1941,10 @@ var
|
||||
case StringCase(S, ['stopped', 'started', 'disappeared', 'running']) of
|
||||
0: begin // stopped
|
||||
AStoppedParams := Line;
|
||||
GotStopped := True;
|
||||
FGotStopped := True;
|
||||
end;
|
||||
1: ; // Known, but undocumented classes
|
||||
2: GotStopped := True;
|
||||
2: FGotStopped := True;
|
||||
3: begin // running,thread-id="1" // running,thread-id="all"
|
||||
if (FTheDebugger.Threads.Monitor <> nil) and
|
||||
(FTheDebugger.Threads.Monitor.CurrentThreads <> nil)
|
||||
@ -2106,14 +2112,19 @@ var
|
||||
idx: Integer;
|
||||
begin
|
||||
Result := True;
|
||||
debugln(['PROCESS-RUN ----- ', DbgS(self), ' ',ClassName, ' ', DebugText]);
|
||||
AResult.State := dsNone;
|
||||
InLogWarning := False;
|
||||
GotStopped := False;
|
||||
FGotStopped := False;
|
||||
FLogWarnings := '';
|
||||
while FTheDebugger.DebugProcessRunning do
|
||||
begin
|
||||
S := FTheDebugger.ReadLine;
|
||||
if S = '(gdb) ' then Break;
|
||||
S := FTheDebugger.ReadLine(50);
|
||||
if (S = '(gdb) ') or
|
||||
( (S = '') and
|
||||
(self is TGDBMIDebuggerCommandExecute) and (TGDBMIDebuggerCommandExecute(self).FDidKillNow) )
|
||||
then
|
||||
Break;
|
||||
|
||||
while S <> '' do
|
||||
begin
|
||||
@ -2133,7 +2144,7 @@ begin
|
||||
then begin
|
||||
DebugLn(DBG_VERBOSE, '[DBGTGT] ', Copy(S, 1, idx - 1));
|
||||
Delete(S, 1, idx - 1);
|
||||
GotStopped := True;
|
||||
FGotStopped := True;
|
||||
Continue;
|
||||
end
|
||||
else begin
|
||||
@ -2144,10 +2155,11 @@ begin
|
||||
Break;
|
||||
end;
|
||||
|
||||
if FTheDebugger.FAsyncModeEnabled and GotStopped then
|
||||
if FTheDebugger.FAsyncModeEnabled and FGotStopped then
|
||||
break;
|
||||
|
||||
end;
|
||||
debugln('DONE RUN');
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommandExecuteBase.ParseBreakInsertError(var AText: String; out
|
||||
@ -5800,8 +5812,7 @@ begin
|
||||
|
||||
FTheDebugger.FCurrentCmdIsAsync := False;
|
||||
s := GDBMIExecCommandMap[FCurrentExecCmd] + FCurrentExecArg;
|
||||
if TGDBMIDebuggerPropertiesBase(FTheDebugger.GetProperties).UseAsyncCommandMode and
|
||||
FTheDebugger.FCommandAsyncState[FCurrentExecCmd]
|
||||
if FTheDebugger.FAsyncModeEnabled and FTheDebugger.FCommandAsyncState[FCurrentExecCmd]
|
||||
then begin
|
||||
if not ExecuteCommand(s + ' &', FResult) then
|
||||
exit;
|
||||
@ -5945,7 +5956,7 @@ begin
|
||||
then SetDebuggerState(dsStop);
|
||||
|
||||
// Now give the ProcessRunning in the current DoExecute something
|
||||
FTheDebugger.SendCmdLn('print 1');
|
||||
//FTheDebugger.SendCmdLn('print 1');
|
||||
end;
|
||||
|
||||
{ TGDBMIDebuggerCommandLineSymbolInfo }
|
||||
@ -7911,9 +7922,11 @@ procedure TGDBMIDebugger.InterruptTarget;
|
||||
begin
|
||||
debugln(DBGMI_QUEUE_DEBUG, ['TGDBMIDebugger.InterruptTarget: TargetPID=', TargetPID]);
|
||||
|
||||
if FAsyncModeEnabled then begin
|
||||
//if FCurrentCmdIsAsync and (FCurrentCommand <> nil) then begin
|
||||
//if FAsyncModeEnabled then begin
|
||||
if FCurrentCmdIsAsync and (FCurrentCommand <> nil) then begin
|
||||
FCurrentCommand.ExecuteCommand('interrupt', []);
|
||||
FCurrentCommand.ExecuteCommand('info program', []); // trigger "*stopped..." msg. This may be deferred to the cmd after the "interupt"
|
||||
debugln(['PAUSE ----- ', DbgS(FCurrentCommand), ' ',FCurrentCommand.ClassName, ' ', FCurrentCommand.DebugText]);
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -10679,7 +10692,7 @@ var
|
||||
|
||||
OldResult := CurRes;
|
||||
Result := True;
|
||||
case StringCase(ResultClass, ['done', 'running', 'exit', 'error']) of
|
||||
case StringCase(ResultClass, ['done', 'running', 'exit', 'error', 'stopped']) of
|
||||
0: begin // done
|
||||
end;
|
||||
1: begin // running
|
||||
@ -10696,6 +10709,11 @@ var
|
||||
then AResult.State := dsStop
|
||||
else AResult.State := dsError;
|
||||
end;
|
||||
4: begin
|
||||
FGotStopped := True;
|
||||
//AStoppedParams := Line;
|
||||
debugln(['PROCESS-cmd ----- ', DbgS(self), ' ',ClassName, ' ', DebugText]);
|
||||
end;
|
||||
else
|
||||
//TODO: should that better be dsError ?
|
||||
if OldResult and (AResult.State in [dsError, dsStop]) and
|
||||
@ -10810,6 +10828,11 @@ var
|
||||
|
||||
DoDbgEvent(ecProcess, etProcessStart, 'Process Start: ' + FTheDebugger.FileName);
|
||||
end
|
||||
else
|
||||
if S = 'stopped' then begin
|
||||
FGotStopped := True;
|
||||
// StoppedParam ??
|
||||
end
|
||||
else
|
||||
DebugLn(DBG_WARNINGS, '[WARNING] Debugger: Unexpected async-record: ', Line);
|
||||
end;
|
||||
|
||||
@ -43,6 +43,7 @@ type
|
||||
protected
|
||||
function CreateCommandInit: TGDBMIDebuggerCommandInitDebugger; override;
|
||||
function CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging; override;
|
||||
procedure InterruptTarget; override;
|
||||
public
|
||||
class function CreateProperties: TDebuggerProperties; override; // Creates debuggerproperties
|
||||
class function Caption: String; override;
|
||||
@ -76,6 +77,9 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
resourcestring
|
||||
GDBMiSNoAsyncMode = 'GDB does not support async mode';
|
||||
|
||||
type
|
||||
|
||||
{ TGDBMIServerDebuggerCommandInitDebugger }
|
||||
@ -108,6 +112,12 @@ begin
|
||||
Result := inherited DoExecute;
|
||||
if (not FSuccess) then exit;
|
||||
|
||||
if not TGDBMIDebugger(FTheDebugger).AsyncModeEnabled then begin
|
||||
SetDebuggerErrorState(GDBMiSNoAsyncMode);
|
||||
FSuccess := False;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// TODO: Maybe should be done in CommandStart, But Filename, and Environment will be done beforle Start
|
||||
FSuccess := ExecuteCommand(Format('target remote %s:%s',
|
||||
[TGDBMIServerDebuggerProperties(DebuggerProperties).FDebugger_Remote_Hostname,
|
||||
@ -156,6 +166,15 @@ begin
|
||||
Result:= TGDBMIServerDebuggerCommandStartDebugging.Create(Self, AContinueCommand);
|
||||
end;
|
||||
|
||||
procedure TGDBMIServerDebugger.InterruptTarget;
|
||||
begin
|
||||
if not( CurrentCmdIsAsync and (CurrentCommand <> nil) ) then begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
inherited InterruptTarget;
|
||||
end;
|
||||
|
||||
class function TGDBMIServerDebugger.CreateProperties: TDebuggerProperties;
|
||||
begin
|
||||
Result := TGDBMIServerDebuggerProperties.Create;
|
||||
|
||||
@ -57,7 +57,7 @@ uses
|
||||
DebuggerDlg, Watchesdlg, BreakPointsdlg, BreakPropertyDlg, LocalsDlg, WatchPropertyDlg,
|
||||
CallStackDlg, EvaluateDlg, RegistersDlg, AssemblerDlg, DebugOutputForm, ExceptionDlg,
|
||||
InspectDlg, DebugEventsForm, PseudoTerminalDlg, FeedbackDlg, ThreadDlg, HistoryDlg,
|
||||
GDBMIDebugger, SSHGDBMIDebugger, ProcessDebugger,
|
||||
GDBMIDebugger, SSHGDBMIDebugger, ProcessDebugger, GDBMIServerDebugger,
|
||||
BaseDebugManager;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user