paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-25 06:22:45 +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;
FArguments: TStrings;
protected
// for use in TThreadEntry ONLY
function GetThreadId: Integer; virtual; abstract;
function GetThreadName: String; virtual; abstract;
function GetThreadState: String; virtual; abstract;
procedure SetThreadState(AValue: String); virtual; abstract;
//// for use in TThreadEntry ONLY
//function GetThreadId: Integer; virtual; abstract;
//function GetThreadName: String; virtual; abstract;
//function GetThreadState: String; virtual; abstract;
//procedure SetThreadState(AValue: String); virtual; abstract;
function GetArgumentCount: Integer;
function GetArgumentName(const AnIndex: Integer): String;
function GetArgumentValue(const AnIndex: Integer): String;
@ -995,13 +995,14 @@ type
function GetSource: String; virtual;
function GetValidity: 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;
const AnArguments: TStrings; const AFunctionName: String;
const ALine: Integer; AValidity: TDebuggerDataState);
public
constructor Create;
function CreateCopy: TCallStackEntry; virtual;
destructor Destroy; override;
procedure Assign(AnOther: TCallStackEntry); virtual;
procedure Init(const AnAddress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String;
const AUnitName, AClassName, AProcName, AFunctionArgs: String;
@ -1010,6 +1011,7 @@ type
const AnArguments: TStrings; const AFunctionName: String;
const FileName, FullName: String;
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 IsCurrent: Boolean;
//procedure MakeCurrent;
@ -1023,10 +1025,10 @@ type
property Source: String read GetSource;
property Validity: TDebuggerDataState read GetValidity write SetValidity;
public
// for use in TThreadEntry ONLY
property ThreadId: Integer read GetThreadId;
property ThreadName: String read GetThreadName;
property ThreadState: String read GetThreadState write SetThreadState;
//// for use in TThreadEntry ONLY
//property ThreadId: Integer read GetThreadId;
//property ThreadName: String read GetThreadName;
//property ThreadState: String read GetThreadState write SetThreadState;
end;
{ TCallStackBase }
@ -1046,7 +1048,7 @@ type
function GetRawEntries: TMap; virtual; abstract;
public
constructor Create;
constructor CreateCopy(const ASource: TCallStackBase);
function CreateCopy: TCallStackBase; virtual;
procedure Assign(AnOther: TCallStackBase); virtual;
procedure PrepareRange({%H-}AIndex, {%H-}ACount: Integer); virtual; abstract;
@ -1298,29 +1300,52 @@ type
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 }
TThreads = class(TObject)
protected
function GetEntryBase(const AnIndex: Integer): TCallStackEntry; virtual; abstract;
function GetEntryByIdBase(const AnID: Integer): TCallStackEntry; virtual; abstract;
function GetEntryBase(const AnIndex: Integer): TThreadEntry; virtual; abstract;
function GetEntryByIdBase(const AnID: Integer): TThreadEntry; virtual; abstract;
function GetCurrentThreadId: Integer; virtual; abstract;
procedure SetCurrentThreadId(AValue: Integer); virtual; abstract;
public
function Count: Integer; virtual; abstract;
procedure Clear; virtual; abstract;
procedure Add(AThread: TCallStackEntry); virtual; abstract;
procedure Remove(AThread: TCallStackEntry); virtual; abstract;
function CreateEntry(const AIndex:Integer; const AnAdress: TDbgPtr;
procedure Add(AThread: TThreadEntry); virtual; abstract;
procedure Remove(AThread: TThreadEntry); virtual; abstract;
function CreateEntry(const AnAdress: TDbgPtr;
const AnArguments: TStrings; const AFunctionName: String;
const FileName, FullName: String;
const ALine: Integer;
const AThreadId: Integer; const AThreadName: String;
const AThreadState: String;
AState: TDebuggerDataState = ddsValid): TCallStackEntry; virtual; abstract;
AState: TDebuggerDataState = ddsValid): TThreadEntry; virtual; abstract;
procedure SetValidity(AValidity: TDebuggerDataState); virtual; abstract;
property Entries[const AnIndex: Integer]: TCallStackEntry read GetEntryBase; default;
property EntryById[const AnID: Integer]: TCallStackEntry read GetEntryByIdBase;
property Entries[const AnIndex: Integer]: TThreadEntry read GetEntryBase; default;
property EntryById[const AnID: Integer]: TThreadEntry read GetEntryByIdBase;
property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId;
end;
@ -1899,6 +1924,46 @@ begin
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 }
function TThreadsMonitor.GetSupplier: TThreadsSupplier;
@ -2508,10 +2573,10 @@ begin
inherited;
end;
constructor TCallStackBase.CreateCopy(const ASource: TCallStackBase);
function TCallStackBase.CreateCopy: TCallStackBase;
begin
Create;
Assign(ASource);
Result := TCallStackBase.Create;
Result.Assign(Self);
end;
procedure TCallStackBase.Assign(AnOther: TCallStackBase);
@ -3524,6 +3589,13 @@ begin
FValidity := AValue;
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;
const AnArguments: TStrings; const AFunctionName: String; const ALine: Integer;
AValidity: TDebuggerDataState);
@ -3543,12 +3615,28 @@ begin
FArguments := TStringlist.Create;
end;
function TCallStackEntry.CreateCopy: TCallStackEntry;
begin
Result := TCallStackEntry.Create;
Result.Assign(Self);
end;
destructor TCallStackEntry.Destroy;
begin
inherited Destroy;
FreeAndNil(FArguments);
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;
const AFunctionName: String; const AUnitName, AClassName, AProcName, AFunctionArgs: String;
const ALine: Integer; AState: TDebuggerDataState);
@ -3621,7 +3709,7 @@ var
begin
Clear;
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;
procedure TCallStackList.Add(ACallStack: TCallStackBase);

4
components/lazdebuggerfp/fpgdbmidebugger.pp
View File

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

22
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

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

217
debugger/debugger.pp
View File

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