From 15754fca9a152b729c26ab55dc1510bc63b631af Mon Sep 17 00:00:00 2001 From: martin Date: Tue, 8 Apr 2014 13:35:38 +0000 Subject: [PATCH] LazDebuggerFp (pure): add line info git-svn-id: trunk@44646 - --- components/fpdebug/fpdbgclasses.pp | 4 + components/fpdebug/fpdbgcontroller.pas | 12 +- .../lazdebuggerfp/fpdebugdebugger.pas | 145 +++++++++++++++++- 3 files changed, 159 insertions(+), 2 deletions(-) diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index f7de7618ed..b42f8ed7b3 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -137,6 +137,7 @@ type TDbgInstance = class(TObject) private FName: String; + FOnDebugInfoLoaded: TNotifyEvent; FProcess: TDbgProcess; FBreakList: TList; FDbgInfo: TDbgInfo; @@ -157,6 +158,7 @@ type property Process: TDbgProcess read FProcess; property DbgInfo: TDbgInfo read FDbgInfo; + property OnDebugInfoLoaded: TNotifyEvent read FOnDebugInfoLoaded write FOnDebugInfoLoaded; end; { TDbgLibrary } @@ -414,6 +416,8 @@ begin FLoader := InitializeLoader; FDbgInfo := TFpDwarfInfo.Create(FLoader); TFpDwarfInfo(FDbgInfo).LoadCompilationUnits; + if Assigned(FOnDebugInfoLoaded) then + FOnDebugInfoLoaded(Self); end; function TDbgInstance.RemoveBreak(const AFileName: String; ALine: Cardinal): Boolean; diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index 0d12d8ba91..ab852126f3 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/components/fpdebug/fpdbgcontroller.pas @@ -25,6 +25,7 @@ type private FExecutableFilename: string; FOnCreateProcessEvent: TOnCreateProcessEvent; + FOnDebugInfoLoaded: TNotifyEvent; FOnExceptionEvent: TOnExceptionEvent; FOnHitBreakpointEvent: TOnHitBreakpointEvent; FOnLog: TOnLog; @@ -34,6 +35,7 @@ type FPDEvent: TFPDEvent; procedure SetExecutableFilename(AValue: string); procedure SetOnLog(AValue: TOnLog); + procedure DoOnDebugInfoLoaded(Sender: TObject); protected FMainProcess: TDbgProcess; FCurrentProcess: TDbgProcess; @@ -58,12 +60,19 @@ type property OnHitBreakpointEvent: TOnHitBreakpointEvent read FOnHitBreakpointEvent write FOnHitBreakpointEvent; property OnProcessExitEvent: TOnProcessExitEvent read FOnProcessExitEvent write FOnProcessExitEvent; property OnExceptionEvent: TOnExceptionEvent read FOnExceptionEvent write FOnExceptionEvent; + property OnDebugInfoLoaded: TNotifyEvent read FOnDebugInfoLoaded write FOnDebugInfoLoaded; end; implementation { TDbgController } +procedure TDbgController.DoOnDebugInfoLoaded(Sender: TObject); +begin + if Assigned(FOnDebugInfoLoaded) then + FOnDebugInfoLoaded(Self); +end; + procedure TDbgController.SetExecutableFilename(AValue: string); begin if FExecutableFilename=AValue then Exit; @@ -106,9 +115,10 @@ begin end; FCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(FExecutableFilename, ''); - FCurrentProcess.OnLog:=OnLog; if assigned(FCurrentProcess) then begin + FCurrentProcess.OnDebugInfoLoaded := @DoOnDebugInfoLoaded; + FCurrentProcess.OnLog:=OnLog; Log('Got PID: %d, TID: %d', [FCurrentProcess.ProcessID, FCurrentProcess.ThreadID]); result := true; end; diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index 956fa9774d..ff820ec157 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -16,7 +16,7 @@ uses DbgIntfBaseTypes, DbgIntfDebuggerBase, FpPascalParser, - FPDbgController; + FPDbgController, FpDbgDwarfDataClasses; type @@ -49,7 +49,10 @@ type procedure FDbgControllerCreateProcessEvent(var continue: boolean); procedure FDbgControllerProcessExitEvent(AExitCode: DWord); procedure FDbgControllerExceptionEvent(var continue: boolean); + procedure FDbgControllerDebugInfoLoaded(Sender: TObject); + function GetDebugInfo: TDbgInfo; protected + function CreateLineInfo: TDBGLineInfo; override; function CreateWatches: TWatchesSupplier; override; function CreateRegisters: TRegisterSupplier; override; function RequestCommand(const ACommand: TDBGCommand; @@ -59,6 +62,8 @@ type procedure OnLog(AString: String); procedure StartDebugLoop; procedure DebugLoopFinished; + + property DebugInfo: TDbgInfo read GetDebugInfo; public constructor Create(const AExternalDebugger: String); override; destructor Destroy; override; @@ -68,6 +73,27 @@ type function GetSupportedCommands: TDBGCommands; override; end; + { TFpLineInfo } + + TFpLineInfo = class(TDBGLineInfo) //class(TGDBMILineInfo) + private + FRequestedSources: TStringList; + protected + function FpDebugger: TFpDebugDebugger; + procedure DoStateChange(const {%H-}AOldState: TDBGState); override; + procedure ClearSources; + procedure DebugInfoChanged; + public + constructor Create(const ADebugger: TDebuggerIntf); + destructor Destroy; override; + function Count: Integer; override; + function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; override; + function GetInfo(AAdress: TDbgPtr; out ASource, ALine, AOffset: Integer): Boolean; override; + function IndexOf(const ASource: String): integer; override; + procedure Request(const ASource: String); override; + procedure Cancel(const ASource: String); override; + end; + { TFPWatches } TFPWatches = class(TWatchesSupplier) @@ -120,6 +146,101 @@ begin ARegisters.DataValidity:=ddsValid; end; +{ TFpLineInfo } + +function TFpLineInfo.FpDebugger: TFpDebugDebugger; +begin + Result := TFpDebugDebugger(Debugger); +end; + +procedure TFpLineInfo.DoStateChange(const AOldState: TDBGState); +begin + //inherited DoStateChange(AOldState); + if not (Debugger.State in [dsPause, dsInternalPause, dsRun]) then + ClearSources; +end; + +procedure TFpLineInfo.ClearSources; +begin + FRequestedSources.Clear; +end; + +procedure TFpLineInfo.DebugInfoChanged; +var + i: Integer; + Src: String; +begin + if (FpDebugger.DebugInfo = nil) or not(FpDebugger.DebugInfo is TFpDwarfInfo) then + exit; + + for i := 0 to FRequestedSources.Count - 1 do begin + if FRequestedSources.Objects[i] = nil then begin + Src := FRequestedSources[i]; + FRequestedSources.Objects[i] := TObject(TFpDwarfInfo(FpDebugger.DebugInfo).GetLineAddressMap(Src)); + if FRequestedSources.Objects[i] <> nil then + DoChange(Src); + end; + end; +end; + +constructor TFpLineInfo.Create(const ADebugger: TDebuggerIntf); +begin + FRequestedSources := TStringList.Create; + inherited Create(ADebugger); +end; + +destructor TFpLineInfo.Destroy; +begin + FreeAndNil(FRequestedSources); + inherited Destroy; +end; + +function TFpLineInfo.Count: Integer; +begin + Result := FRequestedSources.Count; +end; + +function TFpLineInfo.GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; +var + Map: PDWarfLineMap; +begin + Result := 0; + if not((FpDebugger.DebugInfo <> nil) and (FpDebugger.DebugInfo is TFpDwarfInfo)) then + exit; + Map := PDWarfLineMap(FRequestedSources.Objects[AIndex]); + if Map <> nil then + Result := Map^.GetAddressForLine(ALine); +end; + +function TFpLineInfo.GetInfo(AAdress: TDbgPtr; out ASource, ALine, + AOffset: Integer): Boolean; +begin + Result := False; +end; + +function TFpLineInfo.IndexOf(const ASource: String): integer; +begin + Result := FRequestedSources.IndexOf(ASource); +end; + +procedure TFpLineInfo.Request(const ASource: String); +var + i: Integer; +begin + if (FpDebugger.DebugInfo = nil) or not(FpDebugger.DebugInfo is TFpDwarfInfo) then begin + FRequestedSources.AddObject(ASource, nil); + exit; + end; + i := FRequestedSources.AddObject(ASource, TObject(TFpDwarfInfo(FpDebugger.DebugInfo).GetLineAddressMap(ASource))); + if FRequestedSources.Objects[i] <> nil then + DoChange(ASource); +end; + +procedure TFpLineInfo.Cancel(const ASource: String); +begin + // +end; + { TFPWatches } function TFPWatches.FpDebugger: TFpDebugDebugger; @@ -238,6 +359,18 @@ begin end; end; +function TFpDebugDebugger.GetDebugInfo: TDbgInfo; +begin + Result := nil; + if (FDbgController <> nil) and (FDbgController.CurrentProcess<> nil) then + Result := FDbgController.CurrentProcess.DbgInfo; +end; + +function TFpDebugDebugger.CreateLineInfo: TDBGLineInfo; +begin + Result := TFpLineInfo.Create(Self); +end; + function TFpDebugDebugger.CreateWatches: TWatchesSupplier; begin Result := TFPWatches.Create(Self); @@ -248,8 +381,17 @@ begin Result := TFPRegisters.Create(Self); end; +procedure TFpDebugDebugger.FDbgControllerDebugInfoLoaded(Sender: TObject); +begin + if LineInfo <> nil then begin + TFpLineInfo(LineInfo).DebugInfoChanged; + end; +end; + procedure TFpDebugDebugger.FreeDebugThread; begin + if FFpDebugThread = nil then + exit; FFpDebugThread.Terminate; RTLeventSetEvent(FFpDebugThread.StartDebugLoopEvent); FFpDebugThread.WaitFor; @@ -369,6 +511,7 @@ begin FDbgController.OnHitBreakpointEvent:=@FDbgControllerHitBreakpointEvent; FDbgController.OnProcessExitEvent:=@FDbgControllerProcessExitEvent; FDbgController.OnExceptionEvent:=@FDbgControllerExceptionEvent; + FDbgController.OnDebugInfoLoaded := @FDbgControllerDebugInfoLoaded; end; destructor TFpDebugDebugger.Destroy;