* Fixed interrupting GDB on win32

* Reset exename after run so that the exe is not locked on win32

git-svn-id: trunk@6131 -
This commit is contained in:
marc 2004-10-11 23:28:13 +00:00
parent 0f9b054cfc
commit 99952d39d9
2 changed files with 136 additions and 148 deletions

View File

@ -69,6 +69,7 @@ type
dsIdle,
dsStop,
dsPause,
dsInit,
dsRun,
dsError
);
@ -94,6 +95,9 @@ type
dsPause:
The debugger has paused the target. Target variables can be examined
dsInit:
(Optional, Internal) The debugger is about to run
dsRun:
The target is running.
@ -108,8 +112,8 @@ type
const
dcRunCommands = [dcRun,dcStepInto,dcStepOver,dcRunTo];
dsRunStates = [dsRun];
// dcRunCommands = [dcRun,dcStepInto,dcStepOver,dcRunTo];
// dsRunStates = [dsRun];
XMLBreakPointsNode = 'BreakPoints';
XMLBreakPointGroupsNode = 'BreakPointGroups';
@ -263,8 +267,7 @@ type
function GetDebugger: TDebugger;
protected
procedure DoChanged; override;
procedure DoDebuggerStateChange; virtual;
procedure InitTargetStart; virtual;
procedure DoStateChange(const AOldState: TDBGState); virtual;
property Debugger: TDebugger read GetDebugger;
public
constructor Create(ACollection: TCollection); override;
@ -334,8 +337,7 @@ type
function GetItem(const AnIndex: Integer): TDBGBreakPoint;
procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPoint);
protected
procedure DoStateChange; virtual;
procedure InitTargetStart; virtual;
procedure DoStateChange(const AOldState: TDBGState); virtual;
property Debugger: TDebugger read FDebugger;
public
function Add(const ASource: String; const ALine: Integer): TDBGBreakPoint;
@ -471,8 +473,7 @@ type
function GetDebugger: TDebugger;
protected
procedure DoChanged; override;
procedure DoStateChange; virtual;
procedure InitTargetStart; virtual;
procedure DoStateChange(const AOldState: TDBGState); virtual;
property Debugger: TDebugger read GetDebugger;
public
constructor Create(ACollection: TCollection); override;
@ -539,8 +540,7 @@ type
function GetItem(const AnIndex: Integer): TDBGWatch;
procedure SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
protected
procedure DoStateChange; virtual;
procedure InitTargetStart; virtual;
procedure DoStateChange(const AOldState: TDBGState); virtual;
property Debugger: TDebugger read FDebugger;
public
constructor Create(const ADebugger: TDebugger;
@ -605,7 +605,7 @@ type
FOnChange: TNotifyEvent;
protected
procedure DoChange;
procedure DoStateChange; virtual;
procedure DoStateChange(const AOldState: TDBGState); virtual;
function GetCount: Integer; virtual;
property Debugger: TDebugger read FDebugger;
public
@ -709,7 +709,7 @@ type
FOnClear: TNotifyEvent;
protected
function CheckCount: Boolean; override;
procedure DoStateChange; virtual;
procedure DoStateChange(const AOldState: TDBGState); virtual;
property Debugger: TDebugger read FDebugger;
public
constructor Create(const ADebugger: TDebugger);
@ -919,7 +919,7 @@ type
{ TDebugger }
TDebuggerStateChangedEvent = procedure(ADebugger: TDebugger;
OldState: TDBGState) of object;
AOldState: TDBGState) of object;
TDBGOutputEvent = procedure(Sender: TObject; const AText: String) of object;
TDBGCurrentLineEvent = procedure(Sender: TObject;
const ALocation: TDBGLocationRec) of object;
@ -983,7 +983,6 @@ type
virtual; abstract; // True if succesful
procedure SetExitCode(const AValue: Integer);
procedure SetState(const AValue: TDBGState);
procedure InitTargetStart; 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
@ -1013,7 +1012,6 @@ type
function Evaluate(const AExpression: String; var AResult: String): Boolean; // Evaluates the given expression, returns true if valid
function Modify(const AExpression, AValue: String): Boolean; // Modifies the given expression, returns true if valid
function TargetIsStarted: boolean; virtual;
public
property Arguments: String read FArguments write FArguments; // Arguments feed to the program
@ -1064,6 +1062,7 @@ const
'Idle',
'Stop',
'Pause',
'Init',
'Run',
'Error'
);
@ -1086,6 +1085,8 @@ function DBGBreakPointActionNameToAction(const s: string): TIDEBreakPointAction;
implementation
const
INTERNAL_STATES = [dsInit];
COMMANDMAP: array[TDBGState] of TDBGCommands = (
{dsNone } [],
{dsIdle } [dcEnvironment],
@ -1093,6 +1094,7 @@ const
dcEvaluate, dcEnvironment],
{dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak,
dcWatch, dcLocal, dcEvaluate, dcModify, dcEnvironment],
{dsInit } [],
{dsRun } [dcPause, dcStop, dcBreak, dcWatch, dcEnvironment],
{dsError} [dcStop]
);
@ -1306,7 +1308,8 @@ end;
procedure TDebugger.DoState(const OldState: TDBGState);
begin
if Assigned(FOnState) then FOnState(Self,OldState);
if State in INTERNAL_STATES then Exit;
if Assigned(FOnState) then FOnState(Self, OldState);
end;
procedure TDebugger.EnvironmentChanged(Sender: TObject);
@ -1406,11 +1409,6 @@ begin
Result := False;
end;
function TDebugger.TargetIsStarted: boolean;
begin
Result:=FState in [dsRun,dsPause];
end;
procedure TDebugger.Pause;
begin
ReqCmd(dcPause, []);
@ -1420,9 +1418,8 @@ function TDebugger.ReqCmd(const ACommand: TDBGCommand;
const AParams: array of const): Boolean;
begin
if FState = dsNone then Init;
if ACommand in Commands then begin
if (not TargetIsStarted) and (ACommand in dcRunCommands) then
InitTargetStart;
if ACommand in Commands
then begin
Result := RequestCommand(ACommand, AParams);
if not Result then begin
DebugLn('TDebugger.ReqCmd failed: ',DBGCommandNames[ACommand]);
@ -1464,7 +1461,7 @@ procedure TDebugger.SetFileName(const AValue: String);
begin
if FFileName <> AValue
then begin
DebugLn('[TDebugger.SetFileName] ', AValue);
DebugLn('[TDebugger.SetFileName] "', AValue, '"');
if FState in [dsRun, dsPause]
then begin
Stop;
@ -1472,16 +1469,17 @@ begin
if FState <> dsStop
then SetState(dsError);
end;
if FState = dsStop
then begin
// Reset state
FFileName := '';
SetState(dsIdle);
ChangeFileName;
end;
FFileName := AValue;
if (FFilename <> '') and (FState = dsIdle) and ChangeFileName
if (FFilename <> '') and (FState = dsIdle) and ChangeFileName
then SetState(dsStop);
end;
end;
@ -1504,22 +1502,16 @@ var
begin
if AValue <> FState
then begin
OldState := FState;
OldState := FState;
FState := AValue;
FBreakpoints.DoStateChange;
FLocals.DoStateChange;
FCallStack.DoStateChange;
FWatches.DoStateChange;
FBreakpoints.DoStateChange(OldState);
FLocals.DoStateChange(OldState);
FCallStack.DoStateChange(OldState);
FWatches.DoStateChange(OldState);
DoState(OldState);
end;
end;
procedure TDebugger.InitTargetStart;
begin
FBreakPoints.InitTargetStart;
FWatches.InitTargetStart;
end;
procedure TDebugger.StepInto;
begin
if ReqCmd(dcStepInto, []) then exit;
@ -1998,20 +1990,14 @@ begin
then FSlave.Changed;
end;
procedure TDBGBreakPoint.DoDebuggerStateChange;
procedure TDBGBreakPoint.DoStateChange(const AOldState: TDBGState);
begin
end;
if Debugger.State <> dsStop then Exit;
if not (AOldState in [dsIdle, dsNone]) then Exit;
function TDBGBreakPoint.GetDebugger: TDebugger;
begin
Result := TDBGBreakPoints(Collection).FDebugger;
end;
procedure TDBGBreakPoint.InitTargetStart;
begin
BeginUpdate;
try
SetLocation(FSource,GetSourceLine);
SetLocation(FSource, SourceLine);
Enabled := InitialEnabled;
SetHitCount(0);
finally
@ -2019,6 +2005,11 @@ begin
end;
end;
function TDBGBreakPoint.GetDebugger: TDebugger;
begin
Result := TDBGBreakPoints(Collection).FDebugger;
end;
{ =========================================================================== }
{ TIDEBreakPoints }
{ =========================================================================== }
@ -2184,12 +2175,12 @@ begin
inherited Create(ABreakPointClass);
end;
procedure TDBGBreakPoints.DoStateChange;
procedure TDBGBreakPoints.DoStateChange(const AOldState: TDBGState);
var
n: Integer;
begin
for n := 0 to Count - 1 do
GetItem(n).DoDebuggerStateChange;
GetItem(n).DoStateChange(AOldState);
end;
function TDBGBreakPoints.Find(const ASource: String; const ALine: Integer): TDBGBreakPoint;
@ -2207,14 +2198,6 @@ begin
Result := TDBGBreakPoint(inherited GetItem(AnIndex));
end;
procedure TDBGBreakPoints.InitTargetStart;
var
i: Integer;
begin
for i := 0 to Count - 1 do
Items[i].InitTargetStart;
end;
procedure TDBGBreakPoints.SetItem (const AnIndex: Integer; const AValue: TDBGBreakPoint );
begin
inherited SetItem(AnIndex, AValue);
@ -2631,7 +2614,7 @@ begin
then FSlave.Changed;
end;
procedure TDBGWatch.DoStateChange;
procedure TDBGWatch.DoStateChange(const AOldState: TDBGState);
begin
end;
@ -2640,10 +2623,6 @@ begin
Result := TDBGWatches(Collection).FDebugger;
end;
procedure TDBGWatch.InitTargetStart;
begin
end;
{ =========================================================================== }
{ TBaseWatches }
{ =========================================================================== }
@ -2815,12 +2794,12 @@ begin
inherited Create(AWatchClass);
end;
procedure TDBGWatches.DoStateChange;
procedure TDBGWatches.DoStateChange(const AOldState: TDBGState);
var
n: Integer;
begin
for n := 0 to Count - 1 do
GetItem(n).DoStateChange;
GetItem(n).DoStateChange(AOldState);
end;
function TDBGWatches.Find(const AExpression: String): TDBGWatch;
@ -2833,14 +2812,6 @@ begin
Result := TDBGWatch(inherited GetItem(AnIndex));
end;
procedure TDBGWatches.InitTargetStart;
var
i: Integer;
begin
for i := 0 to Count - 1 do
Items[i].InitTargetStart;
end;
procedure TDBGWatches.SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
begin
inherited SetItem(AnIndex, AValue);
@ -2949,7 +2920,7 @@ begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TDBGLocals.DoStateChange;
procedure TDBGLocals.DoStateChange(const AOldState: TDBGState);
begin
end;
@ -3168,20 +3139,19 @@ begin
inherited Create;
end;
procedure TDBGCallStack.DoStateChange;
procedure TDBGCallStack.DoStateChange(const AOldState: TDBGState);
begin
if FDebugger.State = dsPause
then begin
if Assigned(FOnChange) then FOnChange(Self);
end
else begin
if FOldState = dsPause
if AOldState = dsPause
then begin
Clear;
if Assigned(FOnClear) then FOnClear(Self);
end;
end;
FOldState := FDebugger.State;
end;
@ -3572,6 +3542,10 @@ finalization
end.
{ =============================================================================
$Log$
Revision 1.62 2004/10/11 23:28:13 marc
* Fixed interrupting GDB on win32
* Reset exename after run so that the exe is not locked on win32
Revision 1.61 2004/09/14 21:30:36 vincents
replaced writeln by DebugLn

View File

@ -121,6 +121,7 @@ type
function ExecuteCommand(const ACommand: String; AValues: array of const; const AFlags: TGDBMICmdFlags): Boolean; overload;
function ExecuteCommand(const ACommand: String; AValues: array of const; const AFlags: TGDBMICmdFlags; const ACallback: TGDBMICallback): Boolean; overload;
function ExecuteCommand(const ACommand: String; AValues: array of const; var AResultValues: String; const AFlags: TGDBMICmdFlags): Boolean; overload;
function ExecuteCommand(const ACommand: String; AValues: array of const; var AResultState: TDBGState; const AFlags: TGDBMICmdFlags): Boolean; overload;
function ExecuteCommand(const ACommand: String; AValues: array of const; var AResultState: TDBGState; var AResultValues: String; const AFlags: TGDBMICmdFlags): Boolean; overload;
function ExecuteCommand(const ACommand: String; AValues: array of const; var AResultState: TDBGState; var AResultValues: String; const AFlags: TGDBMICmdFlags; const ACallback: TGDBMICallback): Boolean; overload;
function StartDebugging(const AContinueCommand: String): Boolean;
@ -153,15 +154,6 @@ type
implementation
type
TGDBMIBreakPoints = class(TDBGBreakPoints)
private
protected
procedure SetBreakPoints(ResetAll: boolean);
procedure InitTargetStart; override;
public
end;
TGDBMIBreakPoint = class(TDBGBreakPoint)
private
FBreakID: Integer;
@ -173,7 +165,7 @@ type
protected
procedure DoEnableChange; override;
procedure DoExpressionChange; override;
procedure InitTargetStart; override;
procedure DoStateChange(const AOldState: TDBGState); override;
procedure SetLocation(const ASource: String; const ALine: Integer); override;
public
constructor Create(ACollection: TCollection); override;
@ -188,7 +180,7 @@ type
procedure LocalsNeeded;
procedure AddLocals(const AParams:String);
protected
procedure DoStateChange; override;
procedure DoStateChange(const AOldState: TDBGState); override;
function GetCount: Integer; override;
function GetName(const AnIndex: Integer): String; override;
function GetValue(const AnIndex: Integer): String; override;
@ -205,7 +197,7 @@ type
protected
procedure DoEnableChange; override;
procedure DoExpressionChange; override;
procedure DoStateChange; override;
procedure DoStateChange(const AOldState: TDBGState); override;
function GetValue: String; override;
function GetValid: TValidState; override;
public
@ -369,25 +361,39 @@ function TGDBMIDebugger.ChangeFileName: Boolean;
SeperatorPos: integer;
begin
Result := FileName;
if DirectorySeparator<>'/' then
repeat
SeperatorPos := Pos(DirectorySeparator, Result);
if SeperatorPos>0 then begin
Delete(Result, SeperatorPos, 1);
Insert('/', Result, SeperatorPos);
end;
until SeperatorPos=0;
end;
if DirectorySeparator = '/' then Exit;
repeat
SeperatorPos := Pos(DirectorySeparator, Result);
if SeperatorPos <= 0 then Exit;
Delete(Result, SeperatorPos, 1);
Insert('/', Result, SeperatorPos);
until False;
end;
var
S: String;
ResultState: TDBGState;
begin
Result:=false;
if not ExecuteCommand('-file-exec-and-symbols %s',
[GetFileNameForGDB], []) then exit;
if State=dsError then exit;
if not (inherited ChangeFileName) then exit;
if State=dsError then exit;
S := GetFileNameForGDB;
if not ExecuteCommand('-file-exec-and-symbols %s', [S], ResultState, [cfIgnoreError]) then Exit;
if (ResultState = dsError)
and (FileName <> '')
then begin
SetState(dsError);
Exit;
end;
if not (inherited ChangeFileName) then Exit;
if State = dsError then Exit;
if FileName = ''
then begin
Result := True;
Exit;
end;
if tfHasSymbols in FTargetFlags
then begin
// Force setting language
@ -422,7 +428,7 @@ end;
function TGDBMIDebugger.CreateBreakPoints: TDBGBreakPoints;
begin
Result := TGDBMIBreakPoints.Create(Self, TGDBMIBreakPoint);
Result := TDBGBreakPoints.Create(Self, TGDBMIBreakPoint);
end;
function TGDBMIDebugger.CreateCallStack: TDBGCallStack;
@ -518,6 +524,15 @@ begin
Result := ExecuteCommand(ACommand, AValues, ResultState, AResultValues, AFlags, nil);
end;
function TGDBMIDebugger.ExecuteCommand(const ACommand: String;
AValues: array of const; var AResultState: TDBGState;
const AFlags: TGDBMICmdFlags): Boolean;
var
S: String;
begin
Result := ExecuteCommand(ACommand, AValues, AResultState, S, AFlags, nil);
end;
function TGDBMIDebugger.ExecuteCommand(const ACommand: String;
AValues: array of const; var AResultState: TDBGState;
var AResultValues: String; const AFlags: TGDBMICmdFlags): Boolean;
@ -751,44 +766,50 @@ end;
function TGDBMIDebugger.GDBRunTo(const ASource: String;
const ALine: Integer): Boolean;
begin
Result := False;
case State of
dsIdle, dsStop: begin
dsStop: begin
Result := StartDebugging(Format('-exec-until %s:%d', [ASource, ALine]));
end;
dsPause: begin
Result := ExecuteCommand('-exec-until %s:%d', [ASource, ALine], [cfExternal]);
end;
else
Result := False;
dsIdle: begin
DebugLn('[WARNING] Debugger: Unable to runto in idle state');
end;
end;
end;
function TGDBMIDebugger.GDBStepInto: Boolean;
begin
Result := False;
case State of
dsIdle, dsStop: begin
dsStop: begin
Result := StartDebugging('');
end;
dsPause: begin
Result := ExecuteCommand('-exec-step', [cfExternal]);
end;
else
Result := False;
dsIdle: begin
DebugLn('[WARNING] Debugger: Unable to step in idle state');
end;
end;
end;
function TGDBMIDebugger.GDBStepOver: Boolean;
begin
Result := False;
case State of
dsIdle, dsStop: begin
dsStop: begin
Result := StartDebugging('');
end;
dsPause: begin
Result := ExecuteCommand('-exec-next', [cfExternal]);
end;
else
Result := False;
dsIdle: begin
DebugLn('[WARNING] Debugger: Unable to step over in idle state');
end;
end;
end;
@ -928,10 +949,13 @@ begin
if not ParseInitialization
then begin
SetState(dsError);
Exit;
Exit;
end;
ExecuteCommand('-gdb-set confirm off', []);
// for win32, turn off a new console otherwise breaking gdb will fail
// ignore the error on other platforms
ExecuteCommand('-gdb-set new-console off', [cfIgnoreError]);
// try to find the debugger version
ResolveGDBVersion;
@ -1590,6 +1614,7 @@ begin
if ResultState = dsNone
then begin
SetState(dsInit);
if AContinueCommand <> ''
then Result := ExecuteCommand(AContinueCommand, [])
else SetState(dsPause);
@ -1604,29 +1629,6 @@ begin
ExecuteCommand(ACommand, [cfIgnoreError]);
end;
{ =========================================================================== }
{ TGDBMIBreakPoints }
{ =========================================================================== }
procedure TGDBMIBreakPoints.SetBreakPoints(ResetAll: boolean);
var
n: Integer;
BreakPoint: TGDBMIBreakPoint;
begin
for n := 0 to Count - 1 do
begin
BreakPoint := TGDBMIBreakPoint(Items[n]);
if (Breakpoint.FBreakID = 0) or ResetAll
then BreakPoint.SetBreakPoint;
end;
end;
procedure TGDBMIBreakPoints.InitTargetStart;
begin
inherited InitTargetStart;
SetBreakPoints(false);
end;
{ =========================================================================== }
{ TGDBMIBreakPoint }
{ =========================================================================== }
@ -1655,17 +1657,26 @@ begin
inherited;
end;
procedure TGDBMIBreakPoint.DoStateChange(const AOldState: TDBGState);
begin
inherited DoStateChange(AOldState);
case Debugger.State of
dsInit: begin
SetBreakpoint;
end;
dsStop: begin
if AOldState = dsRun
then ReleaseBreakpoint;
end;
end;
end;
procedure TGDBMIBreakPoint.Hit(var ACanContinue: Boolean);
begin
DoHit(HitCount + 1, ACanContinue);
end;
procedure TGDBMIBreakPoint.InitTargetStart;
begin
// initialize values
inherited InitTargetStart;
end;
procedure TGDBMIBreakPoint.SetBreakpoint;
begin
if Debugger = nil then Exit;
@ -1718,11 +1729,10 @@ end;
procedure TGDBMIBreakPoint.SetLocation(const ASource: String;
const ALine: Integer);
begin
//writeln('TGDBMIBreakPoint.SetLocation A ',Source = ASource,' ',Line = ALine);
if (Source = ASource) and (Line = ALine) then exit;
inherited;
if Debugger = nil then Exit;
if TGDBMIDebugger(Debugger).State in [dsStop, dsPause, dsIdle, dsRun]
if TGDBMIDebugger(Debugger).State in [dsStop, dsPause, dsRun]
then SetBreakpoint;
end;
@ -1795,7 +1805,7 @@ begin
FreeAndNil(FLocals);
end;
procedure TGDBMILocals.DoStateChange;
procedure TGDBMILocals.DoStateChange(const AOldState: TDBGState);
begin
if (Debugger <> nil)
and (Debugger.State = dsPause)
@ -1889,7 +1899,7 @@ begin
inherited;
end;
procedure TGDBMIWatch.DoStateChange;
procedure TGDBMIWatch.DoStateChange(const AOldState: TDBGState);
begin
if Debugger = nil then Exit;
@ -2283,6 +2293,10 @@ initialization
end.
{ =============================================================================
$Log$
Revision 1.51 2004/10/11 23:28:13 marc
* Fixed interrupting GDB on win32
* Reset exename after run so that the exe is not locked on win32
Revision 1.50 2004/09/14 21:30:36 vincents
replaced writeln by DebugLn