mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-02 22:40:24 +02:00
Debugger: refactor
git-svn-id: trunk@44467 -
This commit is contained in:
martin
parent
245d81b151
commit
3d8ea62914
@ -972,46 +972,56 @@ type
|
||||
|
||||
{ TCallStackEntryBase }
|
||||
|
||||
TCallStackEntryBase = class(TObject)
|
||||
TCallStackEntry = class(TObject)
|
||||
private
|
||||
FValidity: TDebuggerDataState;
|
||||
FIndex: Integer;
|
||||
FAddress: TDbgPtr;
|
||||
FFunctionName: String;
|
||||
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;
|
||||
function GetArgumentCount: Integer;
|
||||
function GetArgumentName(const AnIndex: Integer): String;
|
||||
function GetArgumentValue(const AnIndex: Integer): String;
|
||||
protected
|
||||
function GetAddress: TDbgPtr; virtual; abstract;
|
||||
function GetArgumentCount: Integer; virtual; abstract;
|
||||
function GetArgumentName(const AnIndex: Integer): String; virtual; abstract;
|
||||
function GetArgumentValue(const AnIndex: Integer): String; virtual; abstract;
|
||||
function GetFunctionName: String; virtual; abstract;
|
||||
function GetIndex: Integer; virtual; abstract;
|
||||
function GetLine: Integer; virtual; abstract;
|
||||
function GetSource: String; virtual; abstract;
|
||||
function GetState: TDebuggerDataState; virtual; abstract;
|
||||
procedure SetState(AValue: TDebuggerDataState); virtual; abstract;
|
||||
property Arguments: TStrings read FArguments;
|
||||
function GetFunctionName: String; virtual;
|
||||
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
|
||||
procedure Init(const AnAdress: TDbgPtr;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Init(const AnAddress: TDbgPtr;
|
||||
const AnArguments: TStrings; const AFunctionName: String;
|
||||
const AUnitName, AClassName, AProcName, AFunctionArgs: String;
|
||||
const ALine: Integer; AState: TDebuggerDataState = ddsValid); virtual; abstract;
|
||||
procedure Init(const AnAdress: TDbgPtr;
|
||||
const ALine: Integer; AState: TDebuggerDataState = ddsValid); virtual;
|
||||
procedure Init(const AnAddress: TDbgPtr;
|
||||
const AnArguments: TStrings; const AFunctionName: String;
|
||||
const FileName, FullName: String;
|
||||
const ALine: Integer; AState: TDebuggerDataState = ddsValid); virtual; abstract;
|
||||
function GetFunctionWithArg: String; virtual; abstract;
|
||||
const ALine: Integer; AState: TDebuggerDataState = ddsValid); virtual;
|
||||
function GetFunctionWithArg: String;
|
||||
//function IsCurrent: Boolean;
|
||||
//procedure MakeCurrent;
|
||||
property Address: TDbgPtr read GetAddress;
|
||||
property Address: TDbgPtr read FAddress;
|
||||
property ArgumentCount: Integer read GetArgumentCount;
|
||||
property ArgumentNames[const AnIndex: Integer]: String read GetArgumentName;
|
||||
property ArgumentValues[const AnIndex: Integer]: String read GetArgumentValue;
|
||||
property FunctionName: String read GetFunctionName;
|
||||
property Index: Integer read GetIndex;
|
||||
property Line: Integer read GetLine;
|
||||
property FunctionName: String read FFunctionName;
|
||||
property Index: Integer read FIndex;
|
||||
property Line: Integer read FLine;
|
||||
property Source: String read GetSource;
|
||||
property State: TDebuggerDataState read GetState write SetState;
|
||||
property Validity: TDebuggerDataState read GetValidity write SetValidity;
|
||||
public
|
||||
// for use in TThreadEntry ONLY
|
||||
property ThreadId: Integer read GetThreadId;
|
||||
@ -1023,29 +1033,33 @@ type
|
||||
|
||||
TCallStackBase = class(TFreeNotifyingObject)
|
||||
protected
|
||||
function GetNewCurrentIndex: Integer; virtual; abstract;
|
||||
function GetEntryBase(AIndex: Integer): TCallStackEntryBase; virtual; abstract;
|
||||
function GetThreadId: Integer; virtual; abstract;
|
||||
procedure SetThreadId(AValue: Integer); virtual; abstract;
|
||||
function GetCount: Integer; virtual; abstract;
|
||||
FCurrent: Integer;
|
||||
FThreadId: Integer;
|
||||
function GetNewCurrentIndex: Integer; virtual;
|
||||
function GetEntryBase(AIndex: Integer): TCallStackEntry; virtual; abstract;
|
||||
function GetCount: Integer; virtual;
|
||||
procedure SetCount(AValue: Integer); virtual; abstract;
|
||||
function GetCurrent: Integer; virtual; abstract;
|
||||
procedure SetCurrent(AValue: Integer); virtual; abstract;
|
||||
function GetCurrent: Integer; virtual;
|
||||
procedure SetCurrent(AValue: Integer); virtual;
|
||||
function GetHighestUnknown: Integer; virtual;
|
||||
function GetLowestUnknown: Integer; virtual;
|
||||
function GetRawEntries: TMap; virtual; abstract;
|
||||
public
|
||||
constructor Create;
|
||||
constructor CreateCopy(const ASource: TCallStackBase);
|
||||
procedure Assign(AnOther: TCallStackBase); virtual;
|
||||
|
||||
procedure PrepareRange({%H-}AIndex, {%H-}ACount: Integer); virtual; abstract;
|
||||
procedure DoEntriesCreated; virtual; abstract;
|
||||
procedure DoEntriesUpdated; virtual; abstract;
|
||||
procedure SetCountValidity(AValidity: TDebuggerDataState); virtual; abstract;
|
||||
procedure SetHasAtLeastCountInfo(AValidity: TDebuggerDataState; AMinCount: Integer = -1); virtual; abstract;
|
||||
procedure SetCurrentValidity(AValidity: TDebuggerDataState); virtual; abstract;
|
||||
procedure SetCountValidity(AValidity: TDebuggerDataState); virtual;
|
||||
procedure SetHasAtLeastCountInfo(AValidity: TDebuggerDataState; AMinCount: Integer = -1); virtual;
|
||||
procedure SetCurrentValidity(AValidity: TDebuggerDataState); virtual;
|
||||
function CountLimited(ALimit: Integer): Integer; virtual; abstract;
|
||||
property Count: Integer read GetCount write SetCount;
|
||||
property CurrentIndex: Integer read GetCurrent write SetCurrent;
|
||||
property Entries[AIndex: Integer]: TCallStackEntryBase read GetEntryBase;
|
||||
property ThreadId: Integer read GetThreadId write SetThreadId;
|
||||
property Entries[AIndex: Integer]: TCallStackEntry read GetEntryBase;
|
||||
property ThreadId: Integer read FThreadId write FThreadId;
|
||||
property NewCurrentIndex: Integer read GetNewCurrentIndex;
|
||||
|
||||
property RawEntries: TMap read GetRawEntries;
|
||||
@ -1056,14 +1070,21 @@ type
|
||||
{ TCallStackListBase }
|
||||
|
||||
TCallStackList = class
|
||||
private
|
||||
FList: TList;
|
||||
function GetEntry(const AIndex: Integer): TCallStackBase;
|
||||
function GetEntryForThread(const AThreadId: Integer): TCallStackBase;
|
||||
protected
|
||||
function GetEntryBase(const AIndex: Integer): TCallStackBase; virtual; abstract;
|
||||
function GetEntryForThreadBase(const AThreadId: Integer): TCallStackBase; virtual; abstract;
|
||||
function NewEntryForThread(const AThreadId: Integer): TCallStackBase; virtual;
|
||||
public
|
||||
procedure Clear; virtual; abstract;
|
||||
function Count: Integer; virtual; abstract; // Count of already requested CallStacks (via ThreadId)
|
||||
property Entries[const AIndex: Integer]: TCallStackBase read GetEntryBase; default;
|
||||
property EntriesForThreads[const AThreadId: Integer]: TCallStackBase read GetEntryForThreadBase;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Assign(AnOther: TCallStackList); virtual;
|
||||
procedure Add(ACallStack: TCallStackBase);
|
||||
procedure Clear; virtual;
|
||||
function Count: Integer; virtual; // Count of already requested CallStacks (via ThreadId)
|
||||
property Entries[const AIndex: Integer]: TCallStackBase read GetEntry; default;
|
||||
property EntriesForThreads[const AThreadId: Integer]: TCallStackBase read GetEntryForThread;
|
||||
end;
|
||||
|
||||
{ TCallStackSupplier }
|
||||
@ -1281,25 +1302,25 @@ type
|
||||
|
||||
TThreads = class(TObject)
|
||||
protected
|
||||
function GetEntryBase(const AnIndex: Integer): TCallStackEntryBase; virtual; abstract;
|
||||
function GetEntryByIdBase(const AnID: Integer): TCallStackEntryBase; virtual; abstract;
|
||||
function GetEntryBase(const AnIndex: Integer): TCallStackEntry; virtual; abstract;
|
||||
function GetEntryByIdBase(const AnID: Integer): TCallStackEntry; 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: TCallStackEntryBase); virtual; abstract;
|
||||
procedure Remove(AThread: TCallStackEntryBase); virtual; abstract;
|
||||
procedure Add(AThread: TCallStackEntry); virtual; abstract;
|
||||
procedure Remove(AThread: TCallStackEntry); virtual; abstract;
|
||||
function 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 = ddsValid): TCallStackEntryBase; virtual; abstract;
|
||||
AState: TDebuggerDataState = ddsValid): TCallStackEntry; virtual; abstract;
|
||||
procedure SetValidity(AValidity: TDebuggerDataState); virtual; abstract;
|
||||
property Entries[const AnIndex: Integer]: TCallStackEntryBase read GetEntryBase; default;
|
||||
property EntryById[const AnID: Integer]: TCallStackEntryBase read GetEntryByIdBase;
|
||||
property Entries[const AnIndex: Integer]: TCallStackEntry read GetEntryBase; default;
|
||||
property EntryById[const AnID: Integer]: TCallStackEntry read GetEntryByIdBase;
|
||||
property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId;
|
||||
end;
|
||||
|
||||
@ -2450,6 +2471,26 @@ end;
|
||||
|
||||
{ TCallStackBase }
|
||||
|
||||
function TCallStackBase.GetNewCurrentIndex: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TCallStackBase.GetCount: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TCallStackBase.GetCurrent: Integer;
|
||||
begin
|
||||
Result := FCurrent;
|
||||
end;
|
||||
|
||||
procedure TCallStackBase.SetCurrent(AValue: Integer);
|
||||
begin
|
||||
FCurrent := AValue;
|
||||
end;
|
||||
|
||||
function TCallStackBase.GetHighestUnknown: Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
@ -2460,6 +2501,41 @@ begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
constructor TCallStackBase.Create;
|
||||
begin
|
||||
FThreadId := -1;
|
||||
FCurrent := -1;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
constructor TCallStackBase.CreateCopy(const ASource: TCallStackBase);
|
||||
begin
|
||||
Create;
|
||||
Assign(ASource);
|
||||
end;
|
||||
|
||||
procedure TCallStackBase.Assign(AnOther: TCallStackBase);
|
||||
begin
|
||||
ThreadId := AnOther.ThreadId;
|
||||
FCurrent := AnOther.FCurrent;
|
||||
end;
|
||||
|
||||
procedure TCallStackBase.SetCountValidity(AValidity: TDebuggerDataState);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TCallStackBase.SetHasAtLeastCountInfo(AValidity: TDebuggerDataState;
|
||||
AMinCount: Integer);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TCallStackBase.SetCurrentValidity(AValidity: TDebuggerDataState);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
{ TRunningProcessInfo }
|
||||
|
||||
constructor TRunningProcessInfo.Create(APID: Cardinal; const AImageName: string);
|
||||
@ -2833,7 +2909,7 @@ const
|
||||
var
|
||||
CallStack: TCallStackBase;
|
||||
I, Count: Integer;
|
||||
Entry: TCallStackEntryBase;
|
||||
Entry: TCallStackEntry;
|
||||
StackString: String;
|
||||
begin
|
||||
Debugger.SetState(dsInternalPause);
|
||||
@ -3410,9 +3486,163 @@ begin
|
||||
FDebugger := ADebugger;
|
||||
end;
|
||||
|
||||
{ =========================================================================== }
|
||||
{ TCallStackEntry }
|
||||
|
||||
function TCallStackEntry.GetArgumentCount: Integer;
|
||||
begin
|
||||
Result := FArguments.Count;
|
||||
end;
|
||||
|
||||
function TCallStackEntry.GetArgumentName(const AnIndex: Integer): String;
|
||||
begin
|
||||
Result := FArguments.Names[AnIndex];
|
||||
end;
|
||||
|
||||
function TCallStackEntry.GetArgumentValue(const AnIndex: Integer): String;
|
||||
begin
|
||||
Result := FArguments[AnIndex];
|
||||
Result := GetPart('=', '', Result);
|
||||
end;
|
||||
|
||||
function TCallStackEntry.GetFunctionName: String;
|
||||
begin
|
||||
Result := FFunctionName;
|
||||
end;
|
||||
|
||||
function TCallStackEntry.GetSource: String;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TCallStackEntry.GetValidity: TDebuggerDataState;
|
||||
begin
|
||||
Result := FValidity;
|
||||
end;
|
||||
|
||||
procedure TCallStackEntry.SetValidity(AValue: TDebuggerDataState);
|
||||
begin
|
||||
FValidity := AValue;
|
||||
end;
|
||||
|
||||
procedure TCallStackEntry.InitFields(const AIndex: Integer; const AnAddress: TDbgPtr;
|
||||
const AnArguments: TStrings; const AFunctionName: String; const ALine: Integer;
|
||||
AValidity: TDebuggerDataState);
|
||||
begin
|
||||
FIndex := AIndex;
|
||||
FAddress := AnAddress;
|
||||
if AnArguments <> nil
|
||||
then FArguments.Assign(AnArguments);
|
||||
FFunctionName := AFunctionName;
|
||||
FLine := ALine;
|
||||
FValidity := AValidity;
|
||||
end;
|
||||
|
||||
constructor TCallStackEntry.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FArguments := TStringlist.Create;
|
||||
end;
|
||||
|
||||
destructor TCallStackEntry.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FreeAndNil(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);
|
||||
begin
|
||||
InitFields(FIndex, AnAddress, AnArguments, AFunctionName, ALine, AState);
|
||||
end;
|
||||
|
||||
procedure TCallStackEntry.Init(const AnAddress: TDbgPtr; const AnArguments: TStrings;
|
||||
const AFunctionName: String; const FileName, FullName: String; const ALine: Integer;
|
||||
AState: TDebuggerDataState);
|
||||
begin
|
||||
InitFields(FIndex, AnAddress, AnArguments, AFunctionName, ALine, AState);
|
||||
end;
|
||||
|
||||
function TCallStackEntry.GetFunctionWithArg: String;
|
||||
var
|
||||
S: String;
|
||||
m: Integer;
|
||||
begin
|
||||
S := '';
|
||||
for m := 0 to ArgumentCount - 1 do
|
||||
begin
|
||||
if S <> '' then
|
||||
S := S + ', ';
|
||||
S := S + ArgumentValues[m];
|
||||
end;
|
||||
if S <> '' then
|
||||
S := '(' + S + ')';
|
||||
Result := FunctionName + S;
|
||||
end;
|
||||
|
||||
{ TCallStackList }
|
||||
|
||||
function TCallStackList.GetEntry(const AIndex: Integer): TCallStackBase;
|
||||
begin
|
||||
Result := TCallStackBase(FList[AIndex]);
|
||||
end;
|
||||
|
||||
function TCallStackList.GetEntryForThread(const AThreadId: Integer): TCallStackBase;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i := Count - 1;
|
||||
while (i >= 0) and (TCallStackBase(FList[i]).ThreadId <> AThreadId) do dec(i);
|
||||
if i >= 0
|
||||
then Result := TCallStackBase(FList[i])
|
||||
else Result := NewEntryForThread(AThreadId);
|
||||
end;
|
||||
|
||||
function TCallStackList.NewEntryForThread(const AThreadId: Integer): TCallStackBase;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
constructor TCallStackList.Create;
|
||||
begin
|
||||
FList := TList.Create;
|
||||
end;
|
||||
|
||||
destructor TCallStackList.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
Clear;
|
||||
FreeAndNil(FList);
|
||||
end;
|
||||
|
||||
procedure TCallStackList.Assign(AnOther: TCallStackList);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Clear;
|
||||
for i := 0 to AnOther.FList.Count-1 do
|
||||
FList.Add(TCallStackBase.CreateCopy(TCallStackBase(AnOther.FList[i])));
|
||||
end;
|
||||
|
||||
procedure TCallStackList.Add(ACallStack: TCallStackBase);
|
||||
begin
|
||||
FList.Add(ACallStack);
|
||||
end;
|
||||
|
||||
procedure TCallStackList.Clear;
|
||||
begin
|
||||
while FList.Count > 0 do begin
|
||||
TObject(FList[0]).Free;
|
||||
FList.Delete(0);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCallStackList.Count: Integer;
|
||||
begin
|
||||
Result := FList.Count;
|
||||
end;
|
||||
|
||||
{ TCallStackSupplier }
|
||||
{ =========================================================================== }
|
||||
|
||||
procedure TCallStackSupplier.Changed;
|
||||
begin
|
||||
@ -3455,7 +3685,7 @@ end;
|
||||
|
||||
procedure TCallStackSupplier.RequestEntries(ACallstack: TCallStackBase);
|
||||
var
|
||||
e: TCallStackEntryBase;
|
||||
e: TCallStackEntry;
|
||||
It: TMapIterator;
|
||||
begin
|
||||
DebugLn(DBG_DATA_MONITORS, ['DebugDataMonitor: TCallStackSupplier.RequestEntries']);
|
||||
@ -3465,10 +3695,10 @@ begin
|
||||
then if not It.EOM
|
||||
then It.Next;
|
||||
|
||||
while (not IT.EOM) and (TCallStackEntryBase(It.DataPtr^).Index < ACallstack.HighestUnknown)
|
||||
while (not IT.EOM) and (TCallStackEntry(It.DataPtr^).Index < ACallstack.HighestUnknown)
|
||||
do begin
|
||||
e := TCallStackEntryBase(It.DataPtr^);
|
||||
if e.State = ddsRequested then e.State := ddsInvalid;
|
||||
e := TCallStackEntry(It.DataPtr^);
|
||||
if e.Validity = ddsRequested then e.Validity := ddsInvalid;
|
||||
It.Next;
|
||||
end;
|
||||
It.Free;
|
||||
|
||||
@ -1186,9 +1186,9 @@ end;
|
||||
|
||||
function TFpGDBMIDebugger.GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
|
||||
var
|
||||
t: TCallStackEntryBase;
|
||||
t: TCallStackEntry;
|
||||
s: TCallStackBase;
|
||||
f: TCallStackEntryBase;
|
||||
f: TCallStackEntry;
|
||||
//Instr: TGDBMIDebuggerInstruction;
|
||||
begin
|
||||
(*
|
||||
|
||||
@ -1419,8 +1419,8 @@ type
|
||||
FCurrentThreadId: Integer;
|
||||
FCurrentThreads: TThreads;
|
||||
FSuccess: Boolean;
|
||||
FThreads: Array of TCallStackEntryBase;
|
||||
function GetThread(AnIndex: Integer): TCallStackEntryBase;
|
||||
FThreads: Array of TCallStackEntry;
|
||||
function GetThread(AnIndex: Integer): TCallStackEntry;
|
||||
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]: TCallStackEntryBase read GetThread;
|
||||
property Threads[AnIndex: Integer]: TCallStackEntry 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: TCallStackEntryBase;
|
||||
t: TCallStackEntry;
|
||||
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: TCallStackEntryBase;
|
||||
t: TCallStackEntry;
|
||||
begin
|
||||
S := GetPart('=', ',', Line, False, False);
|
||||
x := StringCase(S, ['thread-created', 'thread-exited', 'thread-group-started']);
|
||||
@ -2368,7 +2368,7 @@ var
|
||||
S: String;
|
||||
i: Integer;
|
||||
ct: TThreads;
|
||||
t: TCallStackEntryBase;
|
||||
t: TCallStackEntry;
|
||||
begin
|
||||
Result := False;
|
||||
S := GetPart('*', ',', Line);
|
||||
@ -2419,7 +2419,7 @@ var
|
||||
S: String;
|
||||
i, x: Integer;
|
||||
ct: TThreads;
|
||||
t: TCallStackEntryBase;
|
||||
t: TCallStackEntry;
|
||||
begin
|
||||
S := GetPart('=', ',', Line, False, False);
|
||||
x := StringCase(S, ['thread-created', 'thread-exited']);
|
||||
@ -3090,7 +3090,7 @@ end;
|
||||
|
||||
{ TGDBMIDebuggerCommandThreads }
|
||||
|
||||
function TGDBMIDebuggerCommandThreads.GetThread(AnIndex: Integer): TCallStackEntryBase;
|
||||
function TGDBMIDebuggerCommandThreads.GetThread(AnIndex: Integer): TCallStackEntry;
|
||||
begin
|
||||
Result := FThreads[AnIndex];
|
||||
end;
|
||||
@ -6541,7 +6541,7 @@ var
|
||||
AList[i].Free;
|
||||
end;
|
||||
|
||||
procedure UpdateEntry(AnEntry: TCallStackEntryBase; AArgInfo, AFrameInfo : TGDBMINameValueList);
|
||||
procedure UpdateEntry(AnEntry: TCallStackEntry; AArgInfo, AFrameInfo : TGDBMINameValueList);
|
||||
var
|
||||
i, j, n, e, NameEnd: Integer;
|
||||
Arguments: TStringList;
|
||||
@ -6710,7 +6710,7 @@ func="??"
|
||||
var
|
||||
Args: TGDBMINameValueListArray;
|
||||
Frames: TGDBMINameValueListArray;
|
||||
e: TCallStackEntryBase;
|
||||
e: TCallStackEntry;
|
||||
begin
|
||||
try
|
||||
CurStartIdx := AStartIdx;
|
||||
@ -6726,7 +6726,7 @@ func="??"
|
||||
then if not It.EOM
|
||||
then IT.Next;
|
||||
while it.Valid and (not It.EOM) do begin
|
||||
e := TCallStackEntryBase(It.DataPtr^);
|
||||
e := TCallStackEntry(It.DataPtr^);
|
||||
if e.Index > AEndIdx then break;
|
||||
UpdateEntry(e, Args[e.Index-AStartIdx], Frames[e.Index-AStartIdx]);
|
||||
It.Next;
|
||||
@ -6761,10 +6761,10 @@ begin
|
||||
if not It.Locate(StartIdx)
|
||||
then if not It.EOM
|
||||
then IT.Next;
|
||||
StartIdx := TCallStackEntryBase(It.DataPtr^).Index;
|
||||
StartIdx := TCallStackEntry(It.DataPtr^).Index;
|
||||
EndIdx := StartIdx;
|
||||
It.Next;
|
||||
while (not It.EOM) and (TCallStackEntryBase(It.DataPtr^).Index = EndIdx+1) do begin
|
||||
while (not It.EOM) and (TCallStackEntry(It.DataPtr^).Index = EndIdx+1) do begin
|
||||
inc(EndIdx);
|
||||
if EndIdx = FCallstack.HighestUnknown then
|
||||
Break;
|
||||
|
||||
@ -108,13 +108,13 @@ type
|
||||
FPowerImgIdx, FPowerImgIdxGrey: Integer;
|
||||
FInUpdateView: Boolean;
|
||||
FUpdateFlags: set of (ufNeedUpdating);
|
||||
function GetImageIndex(Entry: TCallStackEntry): Integer;
|
||||
function GetImageIndex(Entry: TIdeCallStackEntry): Integer;
|
||||
procedure SetViewLimit(const AValue: Integer);
|
||||
procedure SetViewStart(AStart: Integer);
|
||||
procedure SetViewMax;
|
||||
procedure GotoIndex(AIndex: Integer);
|
||||
function GetCurrentEntry: TCallStackEntry;
|
||||
function GetFunction(const Entry: TCallStackEntry): string;
|
||||
function GetCurrentEntry: TIdeCallStackEntry;
|
||||
function GetFunction(const Entry: TIdeCallStackEntry): string;
|
||||
procedure UpdateView;
|
||||
procedure JumpToSource;
|
||||
procedure CopyToClipBoard;
|
||||
@ -126,7 +126,7 @@ type
|
||||
procedure EnableAllActions;
|
||||
function GetSelectedSnapshot: TSnapshot;
|
||||
function GetSelectedThreads(Snap: TSnapshot): TIdeThreads;
|
||||
function GetSelectedCallstack: TCallStack;
|
||||
function GetSelectedCallstack: TIdeCallStack;
|
||||
procedure DoBreakPointsChanged; override;
|
||||
procedure BreakPointChanged(const ASender: TIDEBreakPoints; const ABreakpoint: TIDEBreakPoint);
|
||||
procedure CallStackChanged(Sender: TObject);
|
||||
@ -245,9 +245,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCallStackDlg.GetImageIndex(Entry: TCallStackEntry): Integer;
|
||||
function TCallStackDlg.GetImageIndex(Entry: TIdeCallStackEntry): Integer;
|
||||
|
||||
function GetBreakPoint(Entry: TCallStackEntry): TIDEBreakPoint; inline;
|
||||
function GetBreakPoint(Entry: TIdeCallStackEntry): TIDEBreakPoint; inline;
|
||||
var
|
||||
FileName: String;
|
||||
begin
|
||||
@ -271,11 +271,11 @@ procedure TCallStackDlg.UpdateView;
|
||||
var
|
||||
n: Integer;
|
||||
Item: TListItem;
|
||||
Entry: TCallStackEntry;
|
||||
Entry: TIdeCallStackEntry;
|
||||
First, Count, MaxCnt: Integer;
|
||||
Source: String;
|
||||
Snap: TSnapshot;
|
||||
CStack: TCallStack;
|
||||
CStack: TIdeCallStack;
|
||||
begin
|
||||
if (not ToolButtonPower.Down) or FInUpdateView then exit;
|
||||
if IsUpdating then begin
|
||||
@ -436,7 +436,7 @@ begin
|
||||
else Result := ThreadsMonitor.Snapshots[Snap];
|
||||
end;
|
||||
|
||||
function TCallStackDlg.GetSelectedCallstack: TCallStack;
|
||||
function TCallStackDlg.GetSelectedCallstack: TIdeCallStack;
|
||||
var
|
||||
Snap: TSnapshot;
|
||||
Threads: TIdeThreads;
|
||||
@ -461,7 +461,7 @@ begin
|
||||
else Result := CallStackMonitor.CurrentCallStackList.EntriesForThreads[tid];
|
||||
end;
|
||||
|
||||
function TCallStackDlg.GetCurrentEntry: TCallStackEntry;
|
||||
function TCallStackDlg.GetCurrentEntry: TIdeCallStackEntry;
|
||||
var
|
||||
CurItem: TListItem;
|
||||
idx: Integer;
|
||||
@ -480,7 +480,7 @@ end;
|
||||
|
||||
procedure TCallStackDlg.JumpToSource;
|
||||
var
|
||||
Entry: TCallStackEntry;
|
||||
Entry: TIdeCallStackEntry;
|
||||
begin
|
||||
Entry := GetCurrentEntry;
|
||||
if Entry = nil then Exit;
|
||||
@ -491,7 +491,7 @@ end;
|
||||
procedure TCallStackDlg.CopyToClipBoard;
|
||||
var
|
||||
n: integer;
|
||||
Entry: TCallStackEntry;
|
||||
Entry: TIdeCallStackEntry;
|
||||
S: String;
|
||||
begin
|
||||
Clipboard.Clear;
|
||||
@ -514,7 +514,7 @@ end;
|
||||
procedure TCallStackDlg.ToggleBreakpoint(Item: TListItem);
|
||||
var
|
||||
idx: Integer;
|
||||
Entry: TCallStackEntry;
|
||||
Entry: TIdeCallStackEntry;
|
||||
BreakPoint: TIDEBreakPoint;
|
||||
FileName: String;
|
||||
Ctrl: Boolean;
|
||||
@ -597,7 +597,7 @@ end;
|
||||
|
||||
procedure TCallStackDlg.actSetAsCurrentClick(Sender : TObject);
|
||||
var
|
||||
Entry: TCallStackEntry;
|
||||
Entry: TIdeCallStackEntry;
|
||||
begin
|
||||
try
|
||||
DisableAllActions;
|
||||
@ -636,7 +636,7 @@ end;
|
||||
|
||||
procedure TCallStackDlg.actShowDisassExecute(Sender: TObject);
|
||||
var
|
||||
Entry: TCallStackEntry;
|
||||
Entry: TIdeCallStackEntry;
|
||||
begin
|
||||
Entry := GetCurrentEntry;
|
||||
if (Entry = nil) or (Entry.Address = 0) then Exit;
|
||||
@ -681,8 +681,8 @@ procedure TCallStackDlg.BreakPointChanged(const ASender: TIDEBreakPoints;
|
||||
const ABreakpoint: TIDEBreakPoint);
|
||||
var
|
||||
i, idx: Integer;
|
||||
Entry: TCallStackEntry;
|
||||
Stack: TCallStack;
|
||||
Entry: TIdeCallStackEntry;
|
||||
Stack: TIdeCallStack;
|
||||
begin
|
||||
DebugLn(DBG_DATA_MONITORS, ['DebugDataWindow: TCallStackDlg.BreakPointChanged ', DbgSName(ASender), ' Upd:', IsUpdating]);
|
||||
Stack := GetSelectedCallstack;
|
||||
@ -808,7 +808,7 @@ begin
|
||||
UpdateView;
|
||||
end;
|
||||
|
||||
function TCallStackDlg.GetFunction(const Entry: TCallStackEntry): string;
|
||||
function TCallStackDlg.GetFunction(const Entry: TIdeCallStackEntry): string;
|
||||
begin
|
||||
Result := Entry.GetFunctionWithArg;
|
||||
end;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -299,7 +299,7 @@ var
|
||||
Snap: TSnapshot;
|
||||
Threads: TIdeThreads;
|
||||
tid: LongInt;
|
||||
Stack: TCallStack;
|
||||
Stack: TIdeCallStack;
|
||||
begin
|
||||
if (CallStackMonitor = nil) or (ThreadsMonitor = nil)
|
||||
then begin
|
||||
|
||||
@ -61,6 +61,20 @@ type
|
||||
ExtraOpts, NamePostFix: string;
|
||||
end;
|
||||
|
||||
{ TTestCallStackList }
|
||||
|
||||
TTestCallStackList = class(TCallStackList)
|
||||
protected
|
||||
function NewEntryForThread(const AThreadId: Integer): TCallStackBase; override;
|
||||
end;
|
||||
|
||||
{ TTestCallStackMonitor }
|
||||
|
||||
TTestCallStackMonitor = class(TCallStackMonitor)
|
||||
protected
|
||||
function CreateCallStackList: TCallStackList; override;
|
||||
end;
|
||||
|
||||
{ TBaseList }
|
||||
|
||||
TBaseList = class
|
||||
@ -200,8 +214,8 @@ type
|
||||
TGDBTestCase = class(TTestCase)
|
||||
private
|
||||
// stuff for the debugger
|
||||
FCallStack: TIdeCallStackMonitor;
|
||||
FDisassembler: TIDEDisassembler;
|
||||
FCallStack: TTestCallStackMonitor;
|
||||
FDisassembler: TBaseDisassembler;
|
||||
FExceptions: TBaseExceptions;
|
||||
//FSignals: TBaseSignals;
|
||||
//FBreakPoints: TIDEBreakPoints;
|
||||
@ -279,8 +293,8 @@ type
|
||||
//property BreakPoints: TIDEBreakPoints read FBreakpoints; // A list of breakpoints for the current project
|
||||
//property BreakPointGroups: TIDEBreakPointGroups read FBreakPointGroups;
|
||||
property Exceptions: TBaseExceptions read FExceptions; // A list of exceptions we should ignore
|
||||
property CallStack: TIdeCallStackMonitor read FCallStack;
|
||||
property Disassembler: TIDEDisassembler read FDisassembler;
|
||||
property CallStack: TTestCallStackMonitor read FCallStack;
|
||||
property Disassembler: TBaseDisassembler read FDisassembler;
|
||||
property Locals: TIdeLocalsMonitor read FLocals;
|
||||
property LineInfo: TIDELineInfo read FLineInfo;
|
||||
property Registers: TRegistersMonitor read FRegisters;
|
||||
@ -289,7 +303,6 @@ type
|
||||
property Threads: TIdeThreadsMonitor read FThreads;
|
||||
end;
|
||||
|
||||
|
||||
function GetCompilers: TCompilerList;
|
||||
function GetDebuggers: TDebuggerList;
|
||||
|
||||
@ -371,6 +384,21 @@ begin
|
||||
Debuggers := Result;
|
||||
end;
|
||||
|
||||
{ TTestCallStackMonitor }
|
||||
|
||||
function TTestCallStackMonitor.CreateCallStackList: TCallStackList;
|
||||
begin
|
||||
Result := TTestCallStackList.Create;
|
||||
end;
|
||||
|
||||
{ TTestCallStackList }
|
||||
|
||||
function TTestCallStackList.NewEntryForThread(const AThreadId: Integer): TCallStackBase;
|
||||
begin
|
||||
Result := TCallStackBase.Create;
|
||||
Result.ThreadId := AThreadId;
|
||||
end;
|
||||
|
||||
{ TGDBTestCase }
|
||||
|
||||
procedure TGDBTestCase.DoDbgOutPut(Sender: TObject; const AText: String);
|
||||
@ -532,8 +560,8 @@ begin
|
||||
//FSignals := TBaseSignals.Create(TBaseSignal);
|
||||
FLocals := TIdeLocalsMonitor.Create;
|
||||
FLineInfo := TIDELineInfo.Create;
|
||||
FCallStack := TIdeCallStackMonitor.Create;
|
||||
FDisassembler := TIDEDisassembler.Create;
|
||||
FCallStack := TTestCallStackMonitor.Create;
|
||||
FDisassembler := TBaseDisassembler.Create;
|
||||
FRegisters := TRegistersMonitor.Create;
|
||||
|
||||
Result := GdbClass.Create(DebuggerInfo.ExeName);
|
||||
@ -546,7 +574,7 @@ begin
|
||||
FLocals.Supplier := Result.Locals;
|
||||
FLineInfo.Master := Result.LineInfo;
|
||||
FCallStack.Supplier := Result.CallStack;
|
||||
FDisassembler.Master := Result.Disassembler;
|
||||
//FDisassembler.Master := Result.Disassembler;
|
||||
Result.Exceptions := FExceptions;
|
||||
//FSignals.Master := Result.Signals;
|
||||
FRegisters.Supplier := Result.Registers;
|
||||
@ -569,7 +597,7 @@ begin
|
||||
FLocals.Supplier := nil;
|
||||
FLineInfo.Master := nil;
|
||||
FCallStack.Supplier := nil;
|
||||
FDisassembler.Master := nil;
|
||||
//FDisassembler.Master := nil;
|
||||
//FExceptions.Master := nil;
|
||||
//FSignals.Master := nil;
|
||||
// FRegisters.Master := nil;
|
||||
|
||||
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, LCLProc,
|
||||
DbgIntfBaseTypes, DbgIntfDebuggerBase, GDBMIDebugger, Debugger, DebugManager, maps;
|
||||
DbgIntfBaseTypes, DbgIntfDebuggerBase, GDBMIDebugger, Debugger, TestBase, DebugManager, maps;
|
||||
|
||||
type
|
||||
TTestDisAssRegion = record
|
||||
@ -42,7 +42,7 @@ type
|
||||
|
||||
TTestDisAss = class(TTestCase)
|
||||
protected
|
||||
FCallStack: TIdeCallStackMonitor;
|
||||
FCallStack: TTestCallStackMonitor;
|
||||
FExceptions: TBaseExceptions;
|
||||
//FSignals: TBaseSignals;
|
||||
//FBreakPoints: TIDEBreakPoints;
|
||||
@ -324,7 +324,7 @@ end;
|
||||
|
||||
procedure TTestDisAss.Disassemble;
|
||||
var
|
||||
IdeDisAss: TIDEDisassembler;
|
||||
IdeDisAss: TBaseDisassembler;
|
||||
Gdb: TTestBrkGDBMIDebugger;
|
||||
|
||||
procedure Init;
|
||||
@ -332,8 +332,9 @@ var
|
||||
FreeAndNil(IdeDisAss);
|
||||
FreeAndNil(Gdb);
|
||||
Gdb := TTestBrkGDBMIDebugger.Create('');
|
||||
IdeDisAss := TIDEDisassembler.Create;
|
||||
IdeDisAss.Master := Gdb.Disassembler;
|
||||
//IdeDisAss := TBaseDisassembler.Create;
|
||||
//IdeDisAss.Master := Gdb.Disassembler;
|
||||
IdeDisAss := Gdb.Disassembler;
|
||||
|
||||
FWatches := TIdeWatchesMonitor.Create;
|
||||
FThreads := TIdeThreadsMonitor.Create;
|
||||
@ -341,7 +342,7 @@ var
|
||||
//FSignals := TBaseSignals.Create(TBaseSignal);
|
||||
FLocals := TIdeLocalsMonitor.Create;
|
||||
FLineInfo := TIDELineInfo.Create;
|
||||
FCallStack := TIdeCallStackMonitor.Create;
|
||||
FCallStack := TTestCallStackMonitor.Create;
|
||||
FRegisters := TRegistersMonitor.Create;
|
||||
|
||||
//TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints;
|
||||
@ -515,7 +516,7 @@ begin
|
||||
CleanGdb;
|
||||
{%endregion}
|
||||
end;//xxxxxxxxxxxx
|
||||
FreeAndNil(IdeDisAss);
|
||||
//FreeAndNil(IdeDisAss);
|
||||
FreeAndNil(Gdb);
|
||||
end;
|
||||
|
||||
|
||||
@ -202,12 +202,12 @@ end;
|
||||
|
||||
procedure TThreadsDlg.JumpToSource;
|
||||
var
|
||||
Entry: TThreadEntry;
|
||||
Entry: TIdeThreadEntry;
|
||||
Item: TListItem;
|
||||
begin
|
||||
Item := lvThreads.Selected;
|
||||
if Item = nil then exit;
|
||||
Entry := TThreadEntry(Item.Data);
|
||||
Entry := TIdeThreadEntry(Item.Data);
|
||||
if Entry = nil then Exit;
|
||||
|
||||
JumpToUnitSource(Entry.UnitInfo, Entry.Line);
|
||||
|
||||
@ -306,7 +306,7 @@ var
|
||||
Snap: TSnapshot;
|
||||
Threads: TIdeThreads;
|
||||
tid: LongInt;
|
||||
Stack: TCallStack;
|
||||
Stack: TIdeCallStack;
|
||||
begin
|
||||
if (CallStackMonitor = nil) or (ThreadsMonitor = nil)
|
||||
then begin
|
||||
|
||||
@ -1284,7 +1284,7 @@ var
|
||||
Editor: TSourceEditor;
|
||||
SrcLine: Integer;
|
||||
c, i, TId: Integer;
|
||||
StackEntry: TCallStackEntry;
|
||||
StackEntry: TIdeCallStackEntry;
|
||||
Flags: TJumpToCodePosFlags;
|
||||
CurrentSourceUnitInfo: TDebuggerUnitInfo;
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user