From e90a1cadbfcd1f30d8b348768128c3597ce8ddc6 Mon Sep 17 00:00:00 2001 From: martin Date: Thu, 15 Aug 2013 16:16:23 +0000 Subject: [PATCH] dbg: add basic support for gdbserver git-svn-id: trunk@42405 - --- debugger/cmdlinedebugger.pp | 12 +++++--- debugger/gdbmidebugger.pp | 53 +++++++++++++++++++++++--------- debugger/gdbmiserverdebugger.pas | 19 ++++++++++++ ide/debugmanager.pas | 2 +- 4 files changed, 65 insertions(+), 21 deletions(-) diff --git a/debugger/cmdlinedebugger.pp b/debugger/cmdlinedebugger.pp index c72968b5d9..1f7b6a81df 100644 --- a/debugger/cmdlinedebugger.pp +++ b/debugger/cmdlinedebugger.pp @@ -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; diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index 081683ba2a..4ad565def9 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -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; diff --git a/debugger/gdbmiserverdebugger.pas b/debugger/gdbmiserverdebugger.pas index d09ddeaaae..2d601fc62b 100644 --- a/debugger/gdbmiserverdebugger.pas +++ b/debugger/gdbmiserverdebugger.pas @@ -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; diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 117ea955e5..782d2a8a8e 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -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;