From c700bfe1726163e23e8ab89d39bb2eb4975ad7fa Mon Sep 17 00:00:00 2001 From: joost Date: Sun, 4 May 2014 12:08:50 +0000 Subject: [PATCH] LazDebuggerFp (pure): Implemented basic callstack git-svn-id: trunk@44906 - --- components/fpdebug/app/fpd/fpdcommand.pas | 30 +++---- components/fpdebug/fpdbgclasses.pp | 90 +++++++++++++++++++ .../lazdebuggerfp/fpdebugdebugger.pas | 82 +++++++++++++++++ 3 files changed, 186 insertions(+), 16 deletions(-) diff --git a/components/fpdebug/app/fpd/fpdcommand.pas b/components/fpdebug/app/fpd/fpdcommand.pas index c3dffffe92..58816a37e5 100644 --- a/components/fpdebug/app/fpd/fpdcommand.pas +++ b/components/fpdebug/app/fpd/fpdcommand.pas @@ -588,8 +588,8 @@ end; procedure HandleShowCallStack(AParams: String; out CallProcessLoop: boolean); var - Address, Frame, LastFrame: QWord; - Size, Count: integer; + ACallStack: TDbgCallstackEntryList; + i: Integer; begin CallProcessLoop:=false; if (GController.MainProcess = nil) @@ -598,21 +598,19 @@ begin Exit; end; - Address := GController.CurrentProcess.GetInstructionPointerRegisterValue; - Frame := GController.CurrentProcess.GetStackBasePointerRegisterValue;; - Size := sizeof(pointer); - WriteLN('Callstack:'); - WriteLn(' ', FormatAddress(Address)); - LastFrame := 0; - Count := 25; - while (Frame <> 0) and (Frame > LastFrame) do - begin - if not GController.CurrentProcess.ReadData(Frame + Size, Size, Address) or (Address = 0) then Break; - WriteLn(' ', FormatAddress(Address)); - Dec(count); - if Count <= 0 then Exit; - if not GController.CurrentProcess.ReadData(Frame, Size, Frame) then Break; + ACallStack := GController.CurrentProcess.MainThread.CreateCallStackEntryList; + try + for i := 0 to ACallStack.Count-1 do + begin + write(' ', FormatAddress(ACallStack.Items[i].AnAddress),' '); + if ACallStack.Items[i].SourceFile<>'' then + writeln(ACallStack.Items[i].SourceFile,':',ACallStack.Items[i].Line) + else + writeln('unknown'); + end; + finally + ACallStack.Free; end; end; diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index 21bba2885d..224826e005 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -80,6 +80,29 @@ type function FindRegisterByDwarfIndex(AnIdx: cardinal): TDbgRegisterValue; end; + { TDbgCallstackEntry } + TDbgThread = class; + + TDbgCallstackEntry = class + private + FAnAddress: TDBGPtr; + FFrameAdress: TDBGPtr; + FThread: TDbgThread; + FIsSymbolResolved: boolean; + FSymbol: TFpDbgSymbol; + function GetSymbol: TFpDbgSymbol; + function GetLine: integer; + function GetSourceFile: string; + public + constructor create(AThread: TDbgThread; AFrameAddress, AnAddress: TDBGPtr); + property AnAddress: TDBGPtr read FAnAddress; + property FrameAdress: TDBGPtr read FFrameAdress; + property SourceFile: string read GetSourceFile; + property Line: integer read GetLine; + end; + + TDbgCallstackEntryList = specialize TFPGObjectList; + TDbgProcess = class; { TDbgMemReader } @@ -128,6 +151,7 @@ type procedure BeforeContinue; virtual; function AddWatchpoint(AnAddr: TDBGPtr): integer; virtual; function RemoveWatchpoint(AnId: integer): boolean; virtual; + function CreateCallStackEntryList: TDbgCallstackEntryList; virtual; procedure AfterHitBreak; procedure ClearHWBreakpoint; destructor Destroy; override; @@ -337,6 +361,44 @@ begin result := GOSDbgClasses; end; +{ TDbgCallstackEntry } + +function TDbgCallstackEntry.GetSymbol: TFpDbgSymbol; +begin + if not FIsSymbolResolved then + FSymbol := FThread.Process.FindSymbol(FAnAddress); + result := FSymbol; +end; + +function TDbgCallstackEntry.GetLine: integer; +var + Symbol: TFpDbgSymbol; +begin + Symbol := GetSymbol; + if assigned(Symbol) then + result := Symbol.Line + else + result := -1; +end; + +function TDbgCallstackEntry.GetSourceFile: string; +var + Symbol: TFpDbgSymbol; +begin + Symbol := GetSymbol; + if assigned(Symbol) then + result := Symbol.FileName + else + result := ''; +end; + +constructor TDbgCallstackEntry.create(AThread: TDbgThread; AFrameAddress, AnAddress: TDBGPtr); +begin + FThread := AThread; + FFrameAdress:=AFrameAddress; + FAnAddress:=AnAddress; +end; + { TDbgMemReader } constructor TDbgMemReader.Create(ADbgProcess: TDbgProcess); @@ -904,6 +966,34 @@ begin result := false; end; +function TDbgThread.CreateCallStackEntryList: TDbgCallstackEntryList; +var + Address, Frame, LastFrame: QWord; + Size, Count: integer; + AnEntry: TDbgCallstackEntry; +begin + Address := Process.GetInstructionPointerRegisterValue; + Frame := Process.GetStackBasePointerRegisterValue;; + Size := sizeof(pointer); + + result := TDbgCallstackEntryList.Create; + result.FreeObjects:=true; + AnEntry := TDbgCallstackEntry.create(Self, Frame, Address); + Result.Add(AnEntry); + + LastFrame := 0; + Count := 25; + while (Frame <> 0) and (Frame > LastFrame) do + begin + if not Process.ReadData(Frame + Size, Size, Address) or (Address = 0) then Break; + AnEntry := TDbgCallstackEntry.create(Self, Frame, Address); + Result.Add(AnEntry); + Dec(count); + if Count <= 0 then Break; + if not Process.ReadData(Frame, Size, Frame) then Break; + end; +end; + procedure TDbgThread.AfterHitBreak; begin FStepping:=false; diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index bf1e38f08b..5b41702b1c 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -8,6 +8,7 @@ uses Classes, SysUtils, Forms, + Maps, LazLogger, FpDbgClasses, FpDbgInfo, @@ -57,6 +58,7 @@ type function CreateWatches: TWatchesSupplier; override; function CreateLocals: TLocalsSupplier; override; function CreateRegisters: TRegisterSupplier; override; + function CreateCallStack: TCallStackSupplier; override; function CreateDisassembler: TDBGDisassembler; override; function CreateBreakPoints: TDBGBreakPoints; override; function RequestCommand(const ACommand: TDBGCommand; @@ -113,6 +115,19 @@ type destructor Destroy; override; end; + { TFPCallStackSupplier } + + TFPCallStackSupplier = class(TCallStackSupplier) + private + FCallStack: TDbgCallstackEntryList; + protected + procedure DoStateLeavePause; override; + public + procedure RequestCount(ACallstack: TCallStackBase); override; + procedure RequestEntries(ACallstack: TCallStackBase); override; + destructor Destroy; override; + end; + { TFPLocals } TFPLocals = class(TLocalsSupplier) @@ -178,6 +193,68 @@ begin RegisterDebugger(TFpDebugDebugger); end; +{ TFPCallStackSupplier } + +procedure TFPCallStackSupplier.DoStateLeavePause; +begin + FreeAndNil(FCallStack); + inherited DoStateLeavePause; +end; + +procedure TFPCallStackSupplier.RequestCount(ACallstack: TCallStackBase); +var + Address, Frame, LastFrame: QWord; + Size, Count: integer; +begin + if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) + then begin + ACallstack.SetCountValidity(ddsInvalid); + exit; + end; + if not assigned(FCallStack) then + FCallStack := TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.MainThread.CreateCallStackEntryList; + + if FCallStack.Count = 0 then + begin + ACallstack.SetCountValidity(ddsInvalid); + ACallstack.SetHasAtLeastCountInfo(ddsInvalid); + end + else + begin + ACallstack.Count := FCallStack.Count; + ACallstack.SetCountValidity(ddsValid); + end; +end; + +procedure TFPCallStackSupplier.RequestEntries(ACallstack: TCallStackBase); +var + e: TCallStackEntry; + It: TMapIterator; +begin + It := TMapIterator.Create(ACallstack.RawEntries); + + if not It.Locate(ACallstack.LowestUnknown ) + then if not It.EOM + then It.Next; + + while (not IT.EOM) and (TCallStackEntry(It.DataPtr^).Index < ACallstack.HighestUnknown) + do begin + e := TCallStackEntry(It.DataPtr^); + if e.Validity = ddsRequested then + begin + e.Init(FCallStack[e.Index].AnAddress, nil, '', FCallStack[e.Index].SourceFile, '', FCallStack[e.Index].Line, ddsValid); + end; + It.Next; + end; + It.Free; +end; + +destructor TFPCallStackSupplier.Destroy; +begin + FCallStack.Free; + inherited Destroy; +end; + { TFPLocals } function TFPLocals.FpDebugger: TFpDebugDebugger; @@ -711,6 +788,11 @@ begin Result := TFPRegisters.Create(Self); end; +function TFpDebugDebugger.CreateCallStack: TCallStackSupplier; +begin + Result:=TFPCallStackSupplier.Create(Self); +end; + function TFpDebugDebugger.CreateDisassembler: TDBGDisassembler; begin Result:=TFPDBGDisassembler.Create(Self);