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

Debugger: refactor

Browse Source 
git-svn-id: trunk@44471 -
This commit is contained in:
martin 2014-03-19 17:17:03 +00:00
parent d7a192f709
commit e221726c5a
5 changed files with 229 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
components/debuggerintf/dbgintfdebuggerbase.pp
View File

@ -981,11 +981,11 @@ type
FLine: Integer; FLine: Integer;
FArguments: TStrings; FArguments: TStrings;
protected protected
// for use in TThreadEntry ONLY //// for use in TThreadEntry ONLY
function GetThreadId: Integer; virtual; abstract; //function GetThreadId: Integer; virtual; abstract;
function GetThreadName: String; virtual; abstract; //function GetThreadName: String; virtual; abstract;
function GetThreadState: String; virtual; abstract; //function GetThreadState: String; virtual; abstract;
procedure SetThreadState(AValue: String); virtual; abstract; //procedure SetThreadState(AValue: String); virtual; abstract;
function GetArgumentCount: Integer; function GetArgumentCount: Integer;
function GetArgumentName(const AnIndex: Integer): String; function GetArgumentName(const AnIndex: Integer): String;
function GetArgumentValue(const AnIndex: Integer): String; function GetArgumentValue(const AnIndex: Integer): String;
@ -995,13 +995,14 @@ type
function GetSource: String; virtual; function GetSource: String; virtual;
function GetValidity: TDebuggerDataState; virtual; function GetValidity: TDebuggerDataState; virtual;
procedure SetValidity(AValue: TDebuggerDataState); virtual; procedure SetValidity(AValue: TDebuggerDataState); virtual;
//procedure ClearLocation; // TODO need a way to call Changed on TCallStack or TThreads // corrently done in SetThreadState
procedure InitFields(const AIndex:Integer; const AnAddress: TDbgPtr; procedure InitFields(const AIndex:Integer; const AnAddress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String; const AnArguments: TStrings; const AFunctionName: String;
const ALine: Integer; AValidity: TDebuggerDataState); const ALine: Integer; AValidity: TDebuggerDataState);
public public
constructor Create; constructor Create;
function CreateCopy: TCallStackEntry; virtual;
destructor Destroy; override; destructor Destroy; override;
procedure Assign(AnOther: TCallStackEntry); virtual;
procedure Init(const AnAddress: TDbgPtr; procedure Init(const AnAddress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String; const AnArguments: TStrings; const AFunctionName: String;
const AUnitName, AClassName, AProcName, AFunctionArgs: String; const AUnitName, AClassName, AProcName, AFunctionArgs: String;
@ -1010,6 +1011,7 @@ type
const AnArguments: TStrings; const AFunctionName: String; const AnArguments: TStrings; const AFunctionName: String;
const FileName, FullName: String; const FileName, FullName: String;
const ALine: Integer; AState: TDebuggerDataState = ddsValid); virtual; const ALine: Integer; AState: TDebuggerDataState = ddsValid); virtual;
procedure ClearLocation; virtual; // TODO need a way to call Changed on TCallStack or TThreads // corrently done in SetThreadState
function GetFunctionWithArg: String; function GetFunctionWithArg: String;
//function IsCurrent: Boolean; //function IsCurrent: Boolean;
//procedure MakeCurrent; //procedure MakeCurrent;
@ -1023,10 +1025,10 @@ type
property Source: String read GetSource; property Source: String read GetSource;
property Validity: TDebuggerDataState read GetValidity write SetValidity; property Validity: TDebuggerDataState read GetValidity write SetValidity;
public public
// for use in TThreadEntry ONLY //// for use in TThreadEntry ONLY
property ThreadId: Integer read GetThreadId; //property ThreadId: Integer read GetThreadId;
property ThreadName: String read GetThreadName; //property ThreadName: String read GetThreadName;
property ThreadState: String read GetThreadState write SetThreadState; //property ThreadState: String read GetThreadState write SetThreadState;
end; end;
{ TCallStackBase } { TCallStackBase }
@ -1046,7 +1048,7 @@ type
function GetRawEntries: TMap; virtual; abstract; function GetRawEntries: TMap; virtual; abstract;
public public
constructor Create; constructor Create;
constructor CreateCopy(const ASource: TCallStackBase); function CreateCopy: TCallStackBase; virtual;
procedure Assign(AnOther: TCallStackBase); virtual; procedure Assign(AnOther: TCallStackBase); virtual;
procedure PrepareRange({%H-}AIndex, {%H-}ACount: Integer); virtual; abstract; procedure PrepareRange({%H-}AIndex, {%H-}ACount: Integer); virtual; abstract;
@ -1298,29 +1300,52 @@ type
TThreadsMonitor = class; TThreadsMonitor = class;
{ TThreadEntry }
TThreadEntry = class(TObject)
private
FTopFrame: TCallStackEntry;
protected
FThreadId: Integer;
FThreadName: String;
FThreadState: String;
procedure SetThreadState(AValue: String); virtual;
function CreateStackEntry: TCallStackEntry; virtual;
public
constructor Create;
function CreateCopy: TThreadEntry; virtual;
destructor Destroy; override;
procedure Assign(AnOther: TThreadEntry); virtual;
published
property ThreadId: Integer read FThreadId;
property ThreadName: String read FThreadName;
property ThreadState: String read FThreadState write SetThreadState;
property TopFrame: TCallStackEntry read FTopFrame;
end;
{ TThreadsBase } { TThreadsBase }
TThreads = class(TObject) TThreads = class(TObject)
protected protected
function GetEntryBase(const AnIndex: Integer): TCallStackEntry; virtual; abstract; function GetEntryBase(const AnIndex: Integer): TThreadEntry; virtual; abstract;
function GetEntryByIdBase(const AnID: Integer): TCallStackEntry; virtual; abstract; function GetEntryByIdBase(const AnID: Integer): TThreadEntry; virtual; abstract;
function GetCurrentThreadId: Integer; virtual; abstract; function GetCurrentThreadId: Integer; virtual; abstract;
procedure SetCurrentThreadId(AValue: Integer); virtual; abstract; procedure SetCurrentThreadId(AValue: Integer); virtual; abstract;
public public
function Count: Integer; virtual; abstract; function Count: Integer; virtual; abstract;
procedure Clear; virtual; abstract; procedure Clear; virtual; abstract;
procedure Add(AThread: TCallStackEntry); virtual; abstract; procedure Add(AThread: TThreadEntry); virtual; abstract;
procedure Remove(AThread: TCallStackEntry); virtual; abstract; procedure Remove(AThread: TThreadEntry); virtual; abstract;
function CreateEntry(const AIndex:Integer; const AnAdress: TDbgPtr; function CreateEntry(const AnAdress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String; const AnArguments: TStrings; const AFunctionName: String;
const FileName, FullName: String; const FileName, FullName: String;
const ALine: Integer; const ALine: Integer;
const AThreadId: Integer; const AThreadName: String; const AThreadId: Integer; const AThreadName: String;
const AThreadState: String; const AThreadState: String;
AState: TDebuggerDataState = ddsValid): TCallStackEntry; virtual; abstract; AState: TDebuggerDataState = ddsValid): TThreadEntry; virtual; abstract;
procedure SetValidity(AValidity: TDebuggerDataState); virtual; abstract; procedure SetValidity(AValidity: TDebuggerDataState); virtual; abstract;
property Entries[const AnIndex: Integer]: TCallStackEntry read GetEntryBase; default; property Entries[const AnIndex: Integer]: TThreadEntry read GetEntryBase; default;
property EntryById[const AnID: Integer]: TCallStackEntry read GetEntryByIdBase; property EntryById[const AnID: Integer]: TThreadEntry read GetEntryByIdBase;
property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId; property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId;
end; end;
@ -1899,6 +1924,46 @@ begin
end; end;
end; end;
{ TThreadEntry }
procedure TThreadEntry.SetThreadState(AValue: String);
begin
if FThreadState = AValue then Exit;
FThreadState := AValue;
end;
function TThreadEntry.CreateStackEntry: TCallStackEntry;
begin
Result := TCallStackEntry.Create;
end;
constructor TThreadEntry.Create;
begin
FTopFrame := CreateStackEntry;
inherited Create;
end;
function TThreadEntry.CreateCopy: TThreadEntry;
begin
Result := TThreadEntry.Create;
Result.Assign(Self);
end;
destructor TThreadEntry.Destroy;
begin
inherited Destroy;
FreeAndNil(FTopFrame);
end;
procedure TThreadEntry.Assign(AnOther: TThreadEntry);
begin
FTopFrame.Free;
FTopFrame := AnOther.TopFrame.CreateCopy;
FThreadId := AnOther.FThreadId;
FThreadName := AnOther.FThreadName;
FThreadState := AnOther.FThreadState;
end;
{ TThreadsMonitor } { TThreadsMonitor }
function TThreadsMonitor.GetSupplier: TThreadsSupplier; function TThreadsMonitor.GetSupplier: TThreadsSupplier;
@ -2508,10 +2573,10 @@ begin
inherited; inherited;
end; end;
constructor TCallStackBase.CreateCopy(const ASource: TCallStackBase); function TCallStackBase.CreateCopy: TCallStackBase;
begin begin
Create; Result := TCallStackBase.Create;
Assign(ASource); Result.Assign(Self);
end; end;
procedure TCallStackBase.Assign(AnOther: TCallStackBase); procedure TCallStackBase.Assign(AnOther: TCallStackBase);
@ -3524,6 +3589,13 @@ begin
FValidity := AValue; FValidity := AValue;
end; end;
procedure TCallStackEntry.ClearLocation;
begin
InitFields(0, 0, nil, '', 0, Validity);
if Arguments <> nil then
Arguments.Clear;
end;
procedure TCallStackEntry.InitFields(const AIndex: Integer; const AnAddress: TDbgPtr; procedure TCallStackEntry.InitFields(const AIndex: Integer; const AnAddress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String; const ALine: Integer; const AnArguments: TStrings; const AFunctionName: String; const ALine: Integer;
AValidity: TDebuggerDataState); AValidity: TDebuggerDataState);
@ -3543,12 +3615,28 @@ begin
FArguments := TStringlist.Create; FArguments := TStringlist.Create;
end; end;
function TCallStackEntry.CreateCopy: TCallStackEntry;
begin
Result := TCallStackEntry.Create;
Result.Assign(Self);
end;
destructor TCallStackEntry.Destroy; destructor TCallStackEntry.Destroy;
begin begin
inherited Destroy; inherited Destroy;
FreeAndNil(FArguments); FreeAndNil(FArguments);
end; end;
procedure TCallStackEntry.Assign(AnOther: TCallStackEntry);
begin
FValidity := AnOther.FValidity;
FIndex := AnOther.FIndex;
FAddress := AnOther.FAddress;
FFunctionName := AnOther.FFunctionName;
FLine := AnOther.FLine;
FArguments.Assign(AnOther.FArguments);
end;
procedure TCallStackEntry.Init(const AnAddress: TDbgPtr; const AnArguments: TStrings; procedure TCallStackEntry.Init(const AnAddress: TDbgPtr; const AnArguments: TStrings;
const AFunctionName: String; const AUnitName, AClassName, AProcName, AFunctionArgs: String; const AFunctionName: String; const AUnitName, AClassName, AProcName, AFunctionArgs: String;
const ALine: Integer; AState: TDebuggerDataState); const ALine: Integer; AState: TDebuggerDataState);
@ -3621,7 +3709,7 @@ var
begin begin
Clear; Clear;
for i := 0 to AnOther.FList.Count-1 do for i := 0 to AnOther.FList.Count-1 do
FList.Add(TCallStackBase.CreateCopy(TCallStackBase(AnOther.FList[i]))); FList.Add(TCallStackBase(AnOther.FList[i]).CreateCopy);
end; end;
procedure TCallStackList.Add(ACallStack: TCallStackBase); procedure TCallStackList.Add(ACallStack: TCallStackBase);

4
components/lazdebuggerfp/fpgdbmidebugger.pp
View File

@ -1186,7 +1186,7 @@ end;
function TFpGDBMIDebugger.GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr; function TFpGDBMIDebugger.GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
var var
t: TCallStackEntry; t: TThreadEntry;
s: TCallStackBase; s: TCallStackBase;
f: TCallStackEntry; f: TCallStackEntry;
//Instr: TGDBMIDebuggerInstruction; //Instr: TGDBMIDebuggerInstruction;
@ -1225,7 +1225,7 @@ begin
exit; exit;
end; end;
if AStackFrame = 0 then begin if AStackFrame = 0 then begin
Result := t.Address; Result := t.TopFrame.Address;
//DebugLn(['Returning addr from Threads', dbgs(Result)]); //DebugLn(['Returning addr from Threads', dbgs(Result)]);
exit; exit;
end; end;

22
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -1419,8 +1419,8 @@ type
FCurrentThreadId: Integer; FCurrentThreadId: Integer;
FCurrentThreads: TThreads; FCurrentThreads: TThreads;
FSuccess: Boolean; FSuccess: Boolean;
FThreads: Array of TCallStackEntry; FThreads: Array of TThreadEntry;
function GetThread(AnIndex: Integer): TCallStackEntry; function GetThread(AnIndex: Integer): TThreadEntry;
protected protected
function DoExecute: Boolean; override; function DoExecute: Boolean; override;
public public
@ -1428,7 +1428,7 @@ type
destructor Destroy; override; destructor Destroy; override;
//function DebugText: String; override; //function DebugText: String; override;
function Count: Integer; function Count: Integer;
property Threads[AnIndex: Integer]: TCallStackEntry read GetThread; property Threads[AnIndex: Integer]: TThreadEntry read GetThread;
property CurrentThreadId: Integer read FCurrentThreadId; property CurrentThreadId: Integer read FCurrentThreadId;
property Success: Boolean read FSuccess; property Success: Boolean read FSuccess;
property CurrentThreads: TThreads read FCurrentThreads write FCurrentThreads; property CurrentThreads: TThreads read FCurrentThreads write FCurrentThreads;
@ -1938,7 +1938,7 @@ function TGDBMIDebuggerInstruction.ProcessInputFromGdb(const AData: String): Boo
S: String; S: String;
ct: TThreads; ct: TThreads;
i: Integer; i: Integer;
t: TCallStackEntry; t: TThreadEntry;
begin begin
S := GetPart(['*'], [','], Line); S := GetPart(['*'], [','], Line);
if S = 'running' if S = 'running'
@ -1986,7 +1986,7 @@ function TGDBMIDebuggerInstruction.ProcessInputFromGdb(const AData: String): Boo
S: String; S: String;
i, x: Integer; i, x: Integer;
ct: TThreads; ct: TThreads;
t: TCallStackEntry; t: TThreadEntry;
begin begin
S := GetPart('=', ',', Line, False, False); S := GetPart('=', ',', Line, False, False);
x := StringCase(S, ['thread-created', 'thread-exited', 'thread-group-started']); x := StringCase(S, ['thread-created', 'thread-exited', 'thread-group-started']);
@ -2000,7 +2000,7 @@ function TGDBMIDebuggerInstruction.ProcessInputFromGdb(const AData: String): Boo
case x of case x of
0: begin 0: begin
if t = nil then begin if t = nil then begin
t := ct.CreateEntry(0, 0, nil, '', '', '', 0, i, '', 'unknown'); t := ct.CreateEntry(0, nil, '', '', '', 0, i, '', 'unknown');
ct.Add(t); ct.Add(t);
t.Free; t.Free;
end end
@ -2368,7 +2368,7 @@ var
S: String; S: String;
i: Integer; i: Integer;
ct: TThreads; ct: TThreads;
t: TCallStackEntry; t: TThreadEntry;
begin begin
Result := False; Result := False;
S := GetPart('*', ',', Line); S := GetPart('*', ',', Line);
@ -2419,7 +2419,7 @@ var
S: String; S: String;
i, x: Integer; i, x: Integer;
ct: TThreads; ct: TThreads;
t: TCallStackEntry; t: TThreadEntry;
begin begin
S := GetPart('=', ',', Line, False, False); S := GetPart('=', ',', Line, False, False);
x := StringCase(S, ['thread-created', 'thread-exited']); x := StringCase(S, ['thread-created', 'thread-exited']);
@ -2433,7 +2433,7 @@ var
case x of case x of
0: begin 0: begin
if t = nil then begin if t = nil then begin
t := FTheDebugger.Threads.CurrentThreads.CreateEntry(0, 0, nil, '', '', '', 0, i, '', 'unknown'); t := FTheDebugger.Threads.CurrentThreads.CreateEntry(0, nil, '', '', '', 0, i, '', 'unknown');
ct.Add(t); ct.Add(t);
t.Free; t.Free;
end end
@ -3090,7 +3090,7 @@ end;
{ TGDBMIDebuggerCommandThreads } { TGDBMIDebuggerCommandThreads }
function TGDBMIDebuggerCommandThreads.GetThread(AnIndex: Integer): TCallStackEntry; function TGDBMIDebuggerCommandThreads.GetThread(AnIndex: Integer): TThreadEntry;
begin begin
Result := FThreads[AnIndex]; Result := FThreads[AnIndex];
end; end;
@ -3160,7 +3160,7 @@ begin
FThreads[i] := CurrentThreads.CreateEntry( FThreads[i] := CurrentThreads.CreateEntry(
0, addr, addr,
Arguments, Arguments,
func, func,
filename, fullname, filename, fullname,

217
debugger/debugger.pp
View File

@ -1100,17 +1100,14 @@ type
{ TCallStackEntry } { TCallStackEntry }
{ TIdeCallStackEntry }
TIdeCallStackEntry = class(TCallStackEntry) TIdeCallStackEntry = class(TCallStackEntry)
private private
FOwner: TIdeCallStack; FOwner: TIdeCallStack;
FUnitInfo: TDebuggerUnitInfo; FUnitInfo: TDebuggerUnitInfo;
procedure SetUnitInfo(AUnitInfo: TDebuggerUnitInfo); procedure SetUnitInfo(AUnitInfo: TDebuggerUnitInfo);
protected protected
// for use in TThreadEntry ONLY
function GetThreadId: Integer; override;
function GetThreadName: String; override;
function GetThreadState: String; override;
procedure SetThreadState(AValue: String); override;
function GetUnitInfoProvider: TDebuggerUnitInfoProvider; virtual; function GetUnitInfoProvider: TDebuggerUnitInfoProvider; virtual;
protected protected
function GetFunctionName: String; override; function GetFunctionName: String; override;
@ -1124,13 +1121,13 @@ type
APath: string; APath: string;
AUnitInvoPrv: TDebuggerUnitInfoProvider = nil AUnitInvoPrv: TDebuggerUnitInfoProvider = nil
); );
procedure ClearLocation; // TODO need a way to call Changed on TCallStack or TThreads // corrently done in SetThreadState
public public
constructor Create(const AIndex:Integer; const AnAdress: TDbgPtr; constructor Create(const AIndex:Integer; const AnAdress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String; const AnArguments: TStrings; const AFunctionName: String;
const AUnitInfo: TDebuggerUnitInfo; const AUnitInfo: TDebuggerUnitInfo;
const ALine: Integer; AState: TDebuggerDataState = ddsValid); overload; const ALine: Integer; AState: TDebuggerDataState = ddsValid); overload;
constructor CreateCopy(const ASource: TIdeCallStackEntry); function CreateCopy: TCallStackEntry; override;
//procedure Assign(AnOther: TCallStackEntry); override; // FunitInfo is not assigned
destructor Destroy; override; destructor Destroy; override;
procedure Init(const AnAdress: TDbgPtr; procedure Init(const AnAdress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String; const AnArguments: TStrings; const AFunctionName: String;
@ -1140,6 +1137,7 @@ type
const AnArguments: TStrings; const AFunctionName: String; const AnArguments: TStrings; const AFunctionName: String;
const FileName, FullName: String; const FileName, FullName: String;
const ALine: Integer; AState: TDebuggerDataState = ddsValid); override; const ALine: Integer; AState: TDebuggerDataState = ddsValid); override;
procedure ClearLocation; override; // TODO need a way to call Changed on TCallStack or TThreads // corrently done in SetThreadState
function IsCurrent: Boolean; function IsCurrent: Boolean;
procedure MakeCurrent; procedure MakeCurrent;
property UnitInfo: TDebuggerUnitInfo read FUnitInfo; property UnitInfo: TDebuggerUnitInfo read FUnitInfo;
@ -1180,6 +1178,7 @@ type
procedure SetCurrentValidity(AValidity: TDebuggerDataState); override; procedure SetCurrentValidity(AValidity: TDebuggerDataState); override;
public public
constructor Create; constructor Create;
function CreateCopy: TCallStackBase; override;
destructor Destroy; override; destructor Destroy; override;
procedure Assign(AnOther: TCallStackBase); procedure Assign(AnOther: TCallStackBase);
procedure PrepareRange({%H-}AIndex, {%H-}ACount: Integer); override; procedure PrepareRange({%H-}AIndex, {%H-}ACount: Integer); override;
@ -1364,21 +1363,29 @@ type
property OnCurrent; property OnCurrent;
end; end;
TIdeThreadEntry = class;
TIdeThreads = class; TIdeThreads = class;
{ TIdeThreadFrameEntry }
TIdeThreadFrameEntry = class(TIdeCallStackEntry)
private
FThread: TIdeThreadEntry;
protected
function GetUnitInfoProvider: TDebuggerUnitInfoProvider; override;
end;
{ TThreadEntry } { TThreadEntry }
TIdeThreadEntry = class(TIdeCallStackEntry) { TIdeThreadEntry }
TIdeThreadEntry = class(TThreadEntry)
private private
FThreadOwner: TIdeThreads; FThreadOwner: TIdeThreads;
FThreadId: Integer; function GetTopFrame: TIdeThreadFrameEntry;
FThreadName: String;
FThreadState: String;
protected protected
function GetUnitInfoProvider: TDebuggerUnitInfoProvider; override; function CreateStackEntry: TCallStackEntry; override;
function GetThreadId: Integer; override; function GetUnitInfoProvider: TDebuggerUnitInfoProvider;
function GetThreadName: String; override;
function GetThreadState: String; override;
procedure SetThreadState(AValue: String); override; procedure SetThreadState(AValue: String); override;
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig;
@ -1390,14 +1397,15 @@ type
AUnitInvoPrv: TDebuggerUnitInfoProvider = nil AUnitInvoPrv: TDebuggerUnitInfoProvider = nil
); reintroduce; ); reintroduce;
public public
constructor Create(const AIndex:Integer; const AnAdress: TDbgPtr; constructor Create(const AnAdress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String; const AnArguments: TStrings; const AFunctionName: String;
const FileName, FullName: String; const FileName, FullName: String;
const ALine: Integer; const ALine: Integer;
const AThreadId: Integer; const AThreadName: String; const AThreadId: Integer; const AThreadName: String;
const AThreadState: String; const AThreadState: String;
AState: TDebuggerDataState = ddsValid); overload; AState: TDebuggerDataState = ddsValid); overload;
constructor CreateCopy(const ASource: TIdeThreadEntry); function CreateCopy: TThreadEntry; override;
property TopFrame: TIdeThreadFrameEntry read GetTopFrame;
end; end;
{ TIdeThreads } { TIdeThreads }
@ -1411,8 +1419,8 @@ type
protected protected
procedure SetCurrentThreadId(AValue: Integer); override; procedure SetCurrentThreadId(AValue: Integer); override;
function GetCurrentThreadId: Integer; override; function GetCurrentThreadId: Integer; override;
function GetEntryBase(const AnIndex: Integer): TCallStackEntry; override; function GetEntryBase(const AnIndex: Integer): TThreadEntry; override;
function GetEntryByIdBase(const AnID: Integer): TCallStackEntry; override; function GetEntryByIdBase(const AnID: Integer): TThreadEntry; override;
procedure Assign(AOther: TIdeThreads); procedure Assign(AOther: TIdeThreads);
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig;
APath: string; APath: string;
@ -1427,15 +1435,15 @@ type
destructor Destroy; override; destructor Destroy; override;
function Count: Integer; override; function Count: Integer; override;
procedure Clear; override; procedure Clear; override;
procedure Add(AThread: TCallStackEntry); override; procedure Add(AThread: TThreadEntry); override;
procedure Remove(AThread: TCallStackEntry); override; procedure Remove(AThread: TThreadEntry); override;
function CreateEntry(const AIndex:Integer; const AnAdress: TDbgPtr; function CreateEntry(const AnAdress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String; const AnArguments: TStrings; const AFunctionName: String;
const FileName, FullName: String; const FileName, FullName: String;
const ALine: Integer; const ALine: Integer;
const AThreadId: Integer; const AThreadName: String; const AThreadId: Integer; const AThreadName: String;
const AThreadState: String; const AThreadState: String;
AState: TDebuggerDataState = ddsValid): TCallStackEntry; override; AState: TDebuggerDataState = ddsValid): TThreadEntry; override;
procedure SetValidity(AValidity: TDebuggerDataState); override; procedure SetValidity(AValidity: TDebuggerDataState); override;
property Entries[const AnIndex: Integer]: TIdeThreadEntry read GetEntry; default; property Entries[const AnIndex: Integer]: TIdeThreadEntry read GetEntry; default;
property EntryById[const AnID: Integer]: TIdeThreadEntry read GetEntryById; property EntryById[const AnID: Integer]: TIdeThreadEntry read GetEntryById;
@ -1457,13 +1465,13 @@ type
constructor Create(AMonitor: TIdeThreadsMonitor); constructor Create(AMonitor: TIdeThreadsMonitor);
function Count: Integer; override; function Count: Integer; override;
procedure Clear; override; procedure Clear; override;
function CreateEntry(const AIndex:Integer; const AnAdress: TDbgPtr; function CreateEntry(const AnAdress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String; const AnArguments: TStrings; const AFunctionName: String;
const FileName, FullName: String; const FileName, FullName: String;
const ALine: Integer; const ALine: Integer;
const AThreadId: Integer; const AThreadName: String; const AThreadId: Integer; const AThreadName: String;
const AThreadState: String; const AThreadState: String;
AState: TDebuggerDataState = ddsValid): TCallStackEntry; override; AState: TDebuggerDataState = ddsValid): TThreadEntry; override;
procedure SetValidity(AValidity: TDebuggerDataState); override; procedure SetValidity(AValidity: TDebuggerDataState); override;
end; end;
@ -1871,6 +1879,13 @@ begin
Result:=bpaStop; Result:=bpaStop;
end; end;
{ TIdeThreadFrameEntry }
function TIdeThreadFrameEntry.GetUnitInfoProvider: TDebuggerUnitInfoProvider;
begin
Result := FThread.GetUnitInfoProvider;
end;
{ TIDEBreakPointGroupList } { TIDEBreakPointGroupList }
function TIDEBreakPointGroupList.GetItem(AIndex: Integer): TIDEBreakPointGroup; function TIDEBreakPointGroupList.GetItem(AIndex: Integer): TIDEBreakPointGroup;
@ -3889,7 +3904,7 @@ begin
It.First; It.First;
while (not IT.EOM) while (not IT.EOM)
do begin do begin
AnOther.AddEntry(TIdeCallStackEntry.CreateCopy(TIdeCallStackEntry(It.DataPtr^))); AnOther.AddEntry(TIdeCallStackEntry(It.DataPtr^).CreateCopy as TIdeCallStackEntry);
It.Next; It.Next;
end; end;
It.Free; It.Free;
@ -4206,12 +4221,12 @@ begin
inherited Clear; inherited Clear;
end; end;
function TCurrentThreads.CreateEntry(const AIndex: Integer; const AnAdress: TDbgPtr; function TCurrentThreads.CreateEntry(const AnAdress: TDbgPtr; const AnArguments: TStrings;
const AnArguments: TStrings; const AFunctionName: String; const FileName, FullName: String; const AFunctionName: String; const FileName, FullName: String; const ALine: Integer;
const ALine: Integer; const AThreadId: Integer; const AThreadName: String; const AThreadId: Integer; const AThreadName: String; const AThreadState: String;
const AThreadState: String; AState: TDebuggerDataState): TCallStackEntry; AState: TDebuggerDataState): TThreadEntry;
begin begin
Result := inherited CreateEntry(AIndex, AnAdress, AnArguments, AFunctionName, FileName, Result := inherited CreateEntry(AnAdress, AnArguments, AFunctionName, FileName,
FullName, ALine, AThreadId, AThreadName, AThreadState, AState); FullName, ALine, AThreadId, AThreadName, AThreadState, AState);
TIdeThreadEntry(Result).FThreadOwner := self; TIdeThreadEntry(Result).FThreadOwner := self;
end; end;
@ -4422,6 +4437,17 @@ end;
{ TThreadEntry } { TThreadEntry }
function TIdeThreadEntry.GetTopFrame: TIdeThreadFrameEntry;
begin
Result := TIdeThreadFrameEntry(inherited TopFrame);
end;
function TIdeThreadEntry.CreateStackEntry: TCallStackEntry;
begin
Result := TIdeThreadFrameEntry.Create;
TIdeThreadFrameEntry(Result).FThread := Self;
end;
function TIdeThreadEntry.GetUnitInfoProvider: TDebuggerUnitInfoProvider; function TIdeThreadEntry.GetUnitInfoProvider: TDebuggerUnitInfoProvider;
begin begin
if FThreadOwner = nil then if FThreadOwner = nil then
@ -4430,32 +4456,17 @@ begin
Result := (FThreadOwner as TCurrentThreads).FMonitor.UnitInfoProvider; Result := (FThreadOwner as TCurrentThreads).FMonitor.UnitInfoProvider;
end; end;
function TIdeThreadEntry.GetThreadId: Integer;
begin
Result := FThreadId;
end;
function TIdeThreadEntry.GetThreadName: String;
begin
Result := FThreadName;
end;
function TIdeThreadEntry.GetThreadState: String;
begin
Result := FThreadState;
end;
procedure TIdeThreadEntry.SetThreadState(AValue: String); procedure TIdeThreadEntry.SetThreadState(AValue: String);
begin begin
if FThreadState = AValue then Exit; if ThreadState = AValue then Exit;
FThreadState := AValue; inherited SetThreadState(AValue);
ClearLocation; TopFrame.ClearLocation;
end; end;
procedure TIdeThreadEntry.LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string; procedure TIdeThreadEntry.LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
AUnitInvoPrv: TDebuggerUnitInfoProvider = nil); AUnitInvoPrv: TDebuggerUnitInfoProvider = nil);
begin begin
inherited LoadDataFromXMLConfig(AConfig, APath, AUnitInvoPrv); TIdeCallStackEntry(TopFrame).LoadDataFromXMLConfig(AConfig, APath, AUnitInvoPrv);
FThreadId := AConfig.GetValue(APath + 'ThreadId', -1); FThreadId := AConfig.GetValue(APath + 'ThreadId', -1);
FThreadName := AConfig.GetValue(APath + 'ThreadName', ''); FThreadName := AConfig.GetValue(APath + 'ThreadName', '');
FThreadState := AConfig.GetValue(APath + 'ThreadState', ''); FThreadState := AConfig.GetValue(APath + 'ThreadState', '');
@ -4464,36 +4475,28 @@ end;
procedure TIdeThreadEntry.SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; procedure TIdeThreadEntry.SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string;
AUnitInvoPrv: TDebuggerUnitInfoProvider = nil); AUnitInvoPrv: TDebuggerUnitInfoProvider = nil);
begin begin
inherited SaveDataToXMLConfig(AConfig, APath, AUnitInvoPrv); TIdeCallStackEntry(TopFrame).SaveDataToXMLConfig(AConfig, APath, AUnitInvoPrv);
AConfig.SetValue(APath + 'ThreadId', FThreadId); AConfig.SetValue(APath + 'ThreadId', ThreadId);
AConfig.SetValue(APath + 'ThreadName', FThreadName); AConfig.SetValue(APath + 'ThreadName', ThreadName);
AConfig.SetValue(APath + 'ThreadState', FThreadState); AConfig.SetValue(APath + 'ThreadState', ThreadState);
end; end;
constructor TIdeThreadEntry.Create(const AIndex: Integer; const AnAdress: TDbgPtr; constructor TIdeThreadEntry.Create(const AnAdress: TDbgPtr; const AnArguments: TStrings;
const AnArguments: TStrings; const AFunctionName: String; const FileName, FullName: String; const AFunctionName: String; const FileName, FullName: String; const ALine: Integer;
const ALine: Integer; const AThreadId: Integer; const AThreadName: String; const AThreadId: Integer; const AThreadName: String; const AThreadState: String;
const AThreadState: String; AState: TDebuggerDataState); AState: TDebuggerDataState);
var
loc: TDebuggerUnitInfo;
begin begin
if GetUnitInfoProvider = nil then inherited Create;
loc := nil TopFrame.Init(AnAdress, AnArguments, AFunctionName, FileName, FullName, ALine, AState);
else
loc := GetUnitInfoProvider.GetUnitInfoFor(FileName, FullName);
inherited Create(AIndex, AnAdress, AnArguments, AFunctionName,
loc, ALine, AState);
FThreadId := AThreadId; FThreadId := AThreadId;
FThreadName := AThreadName; FThreadName := AThreadName;
FThreadState := AThreadState; FThreadState := AThreadState;
end; end;
constructor TIdeThreadEntry.CreateCopy(const ASource: TIdeThreadEntry); function TIdeThreadEntry.CreateCopy: TThreadEntry;
begin begin
inherited CreateCopy(ASource); Result := TIdeThreadEntry.Create;
FThreadId := ASource.FThreadId; Result.Assign(Self);
FThreadName := ASource.FThreadName;
FThreadState := ASource.FThreadState;
end; end;
{ TIdeThreads } { TIdeThreads }
@ -4529,14 +4532,14 @@ begin
Result := FCurrentThreadId; Result := FCurrentThreadId;
end; end;
function TIdeThreads.GetEntryBase(const AnIndex: Integer): TCallStackEntry; function TIdeThreads.GetEntryBase(const AnIndex: Integer): TThreadEntry;
begin begin
Result := TCallStackEntry(GetEntry(AnIndex)); Result := TThreadEntry(GetEntry(AnIndex));
end; end;
function TIdeThreads.GetEntryByIdBase(const AnID: Integer): TCallStackEntry; function TIdeThreads.GetEntryByIdBase(const AnID: Integer): TThreadEntry;
begin begin
Result := TCallStackEntry(GetEntryById(AnID)); Result := TThreadEntry(GetEntryById(AnID));
end; end;
procedure TIdeThreads.Assign(AOther: TIdeThreads); procedure TIdeThreads.Assign(AOther: TIdeThreads);
@ -4546,7 +4549,7 @@ begin
Clear; Clear;
FCurrentThreadId := AOther.FCurrentThreadId; FCurrentThreadId := AOther.FCurrentThreadId;
for i := 0 to AOther.FList.Count-1 do for i := 0 to AOther.FList.Count-1 do
FList.Add(TIdeThreadEntry.CreateCopy(TIdeThreadEntry(AOther.FList[i]))); FList.Add(TIdeThreadEntry(AOther.FList[i]).CreateCopy);
end; end;
procedure TIdeThreads.LoadDataFromXMLConfig(const AConfig: TXMLConfig; APath: string; procedure TIdeThreads.LoadDataFromXMLConfig(const AConfig: TXMLConfig; APath: string;
@ -4603,14 +4606,14 @@ begin
end; end;
end; end;
procedure TIdeThreads.Add(AThread: TCallStackEntry); procedure TIdeThreads.Add(AThread: TThreadEntry);
begin begin
FList.Add(TIdeThreadEntry.CreateCopy(AThread as TIdeThreadEntry)); FList.Add((AThread as TIdeThreadEntry).CreateCopy);
if FList.Count = 1 then if FList.Count = 1 then
FCurrentThreadId := (AThread as TIdeThreadEntry).ThreadId; FCurrentThreadId := (AThread as TIdeThreadEntry).ThreadId;
end; end;
procedure TIdeThreads.Remove(AThread: TCallStackEntry); procedure TIdeThreads.Remove(AThread: TThreadEntry);
begin begin
FList.Remove(AThread); FList.Remove(AThread);
if FCurrentThreadId = (AThread as TIdeThreadEntry).ThreadId then begin if FCurrentThreadId = (AThread as TIdeThreadEntry).ThreadId then begin
@ -4622,12 +4625,12 @@ begin
AThread.Free; AThread.Free;
end; end;
function TIdeThreads.CreateEntry(const AIndex: Integer; const AnAdress: TDbgPtr; function TIdeThreads.CreateEntry(const AnAdress: TDbgPtr; const AnArguments: TStrings;
const AnArguments: TStrings; const AFunctionName: String; const FileName, FullName: String; const AFunctionName: String; const FileName, FullName: String; const ALine: Integer;
const ALine: Integer; const AThreadId: Integer; const AThreadName: String; const AThreadId: Integer; const AThreadName: String; const AThreadState: String;
const AThreadState: String; AState: TDebuggerDataState): TCallStackEntry; AState: TDebuggerDataState): TThreadEntry;
begin begin
Result := TIdeThreadEntry.Create(AIndex, AnAdress, AnArguments, AFunctionName, FileName, Result := TIdeThreadEntry.Create(AnAdress, AnArguments, AFunctionName, FileName,
FullName, ALine, AThreadId, AThreadName, AThreadState, AState); FullName, ALine, AThreadId, AThreadName, AThreadState, AState);
TIdeThreadEntry(Result).FThreadOwner := self; TIdeThreadEntry(Result).FThreadOwner := self;
end; end;
@ -6380,11 +6383,10 @@ begin
InitFields(AIndex, AnAdress, AnArguments, AFunctionName, ALine, AState); InitFields(AIndex, AnAdress, AnArguments, AFunctionName, ALine, AState);
end; end;
constructor TIdeCallStackEntry.CreateCopy(const ASource: TIdeCallStackEntry); function TIdeCallStackEntry.CreateCopy: TCallStackEntry;
begin begin
Create(ASource.Index, ASource.Address, ASource.Arguments, Result := TIdeCallStackEntry.Create;
ASource.FunctionName, ASource.FUnitInfo, Result.Assign(Self);
ASource.Line, ASource.Validity);
end; end;
destructor TIdeCallStackEntry.Destroy; destructor TIdeCallStackEntry.Destroy;
@ -6399,7 +6401,7 @@ procedure TIdeCallStackEntry.Init(const AnAdress: TDbgPtr; const AnArguments: TS
var var
loc: TDebuggerUnitInfo; loc: TDebuggerUnitInfo;
begin begin
assert(FOwner is TCurrentCallStack, 'FOwner is TCurrentCallStack'); assert((FOwner = nil) or (FOwner is TCurrentCallStack), 'FOwner is TCurrentCallStack');
inherited Init(AnAdress, AnArguments, AFunctionName, AUnitName, AClassName, AProcName, inherited Init(AnAdress, AnArguments, AFunctionName, AUnitName, AClassName, AProcName,
AFunctionArgs, ALine, AState); AFunctionArgs, ALine, AState);
@ -6417,7 +6419,7 @@ procedure TIdeCallStackEntry.Init(const AnAdress: TDbgPtr; const AnArguments: TS
var var
loc: TDebuggerUnitInfo; loc: TDebuggerUnitInfo;
begin begin
assert(FOwner is TCurrentCallStack, 'FOwner is TCurrentCallStack'); assert((FOwner = nil) or (FOwner is TCurrentCallStack), 'FOwner is TCurrentCallStack');
inherited Init(AnAdress, AnArguments, AFunctionName, FileName, FullName, ALine, AState); inherited Init(AnAdress, AnArguments, AFunctionName, FileName, FullName, ALine, AState);
if GetUnitInfoProvider = nil then if GetUnitInfoProvider = nil then
@ -6466,29 +6468,6 @@ begin
if FUnitInfo <> nil then FUnitInfo.AddReference; if FUnitInfo <> nil then FUnitInfo.AddReference;
end; end;
function TIdeCallStackEntry.GetThreadId: Integer;
begin
Assert(false, 'thread only');
Result := 0;
end;
function TIdeCallStackEntry.GetThreadName: String;
begin
Assert(false, 'thread only');
Result := '';
end;
function TIdeCallStackEntry.GetThreadState: String;
begin
Assert(false, 'thread only');
Result := '';
end;
procedure TIdeCallStackEntry.SetThreadState(AValue: String);
begin
Assert(false, 'thread only');
end;
function TIdeCallStackEntry.GetUnitInfoProvider: TDebuggerUnitInfoProvider; function TIdeCallStackEntry.GetUnitInfoProvider: TDebuggerUnitInfoProvider;
begin begin
Result := (FOwner as TCurrentCallStack).FMonitor.UnitInfoProvider; Result := (FOwner as TCurrentCallStack).FMonitor.UnitInfoProvider;
@ -6557,9 +6536,7 @@ end;
procedure TIdeCallStackEntry.ClearLocation; procedure TIdeCallStackEntry.ClearLocation;
begin begin
InitFields(0, 0, nil, '', 0, Validity); inherited ClearLocation;
if Arguments <> nil then
Arguments.Clear;
SetUnitInfo(TDebuggerUnitInfo.Create('','')); SetUnitInfo(TDebuggerUnitInfo.Create('',''));
end; end;
@ -6608,7 +6585,7 @@ var
i: Integer; i: Integer;
begin begin
for i := 0 to FList.Count-1 do begin for i := 0 to FList.Count-1 do begin
AnOther.AddEntry(TIdeCallStackEntry.CreateCopy(TIdeCallStackEntry(FList[i]))); AnOther.AddEntry(TIdeCallStackEntry(FList[i]).CreateCopy as TIdeCallStackEntry);
end; end;
end; end;
@ -6727,6 +6704,12 @@ begin
inherited; inherited;
end; end;
function TIdeCallStack.CreateCopy: TCallStackBase;
begin
Result := TIdeCallStack.Create;
Result.Assign(Self);
end;
function TIdeCallStack.GetRawEntries: TMap; function TIdeCallStack.GetRawEntries: TMap;
begin begin
assert(False, 'TCallStack.GetRawEntries'); assert(False, 'TCallStack.GetRawEntries');

10
debugger/threaddlg.pp
View File

@ -138,11 +138,11 @@ begin
lvThreads.Items[i].SubItems[0] := IntToStr(Threads[i].ThreadId); lvThreads.Items[i].SubItems[0] := IntToStr(Threads[i].ThreadId);
lvThreads.Items[i].SubItems[1] := Threads[i].ThreadName; lvThreads.Items[i].SubItems[1] := Threads[i].ThreadName;
lvThreads.Items[i].SubItems[2] := Threads[i].ThreadState; lvThreads.Items[i].SubItems[2] := Threads[i].ThreadState;
s := Threads[i].Source; s := Threads[i].TopFrame.Source;
if s = '' then s := ':' + IntToHex(Threads[i].Address, 8); if s = '' then s := ':' + IntToHex(Threads[i].TopFrame.Address, 8);
lvThreads.Items[i].SubItems[3] := s; lvThreads.Items[i].SubItems[3] := s;
lvThreads.Items[i].SubItems[4] := IntToStr(Threads[i].Line); lvThreads.Items[i].SubItems[4] := IntToStr(Threads[i].TopFrame.Line);
lvThreads.Items[i].SubItems[5] := Threads[i].GetFunctionWithArg; lvThreads.Items[i].SubItems[5] := Threads[i].TopFrame.GetFunctionWithArg;
lvThreads.Items[i].Data := Threads[i]; lvThreads.Items[i].Data := Threads[i];
end; end;
finally finally
@ -210,7 +210,7 @@ begin
Entry := TIdeThreadEntry(Item.Data); Entry := TIdeThreadEntry(Item.Data);
if Entry = nil then Exit; if Entry = nil then Exit;
JumpToUnitSource(Entry.UnitInfo, Entry.Line); JumpToUnitSource(Entry.TopFrame.UnitInfo, Entry.TopFrame.Line);
end; end;
function TThreadsDlg.GetSelectedSnapshot: TSnapshot; function TThreadsDlg.GetSelectedSnapshot: TSnapshot;