unit FpGdbmiDebugger; {$mode objfpc}{$H+} interface uses Classes, sysutils, GDBMIDebugger, BaseDebugManager, Debugger, GDBMIMiscClasses, maps, FpDbgLoader, FpDbgDwarf, LazLoggerBase, LazLoggerProfiling; type { TFpGDBMIDebugger } TFpGDBMIDebugger = class(TGDBMIDebugger) private FImageLoader: TDbgImageLoader; FDwarfInfo: TDbgDwarf; protected function CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging; override; function CreateLineInfo: TDBGLineInfo; override; procedure DoState(const OldState: TDBGState); override; function HasDwarf: Boolean; procedure LoadDwarf; procedure UnLoadDwarf; public class function Caption: String; override; public destructor Destroy; override; end; implementation type { TFpGDBMIDebuggerCommandStartDebugging } TFpGDBMIDebuggerCommandStartDebugging = class(TGDBMIDebuggerCommandStartDebugging) protected function DoExecute: Boolean; override; end; { TFpGDBMILineInfo } TFpGDBMILineInfo = class(TDBGLineInfo) //class(TGDBMILineInfo) private FRequestedSources: TStringList; protected function FpDebugger: TFpGDBMIDebugger; procedure DoStateChange(const AOldState: TDBGState); override; procedure ClearSources; public constructor Create(const ADebugger: TDebugger); 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; { TFpGDBMILineInfo } function TFpGDBMILineInfo.FpDebugger: TFpGDBMIDebugger; begin Result := TFpGDBMIDebugger(Debugger); end; procedure TFpGDBMILineInfo.DoStateChange(const AOldState: TDBGState); begin //inherited DoStateChange(AOldState); if not (Debugger.State in [dsPause, dsInternalPause, dsRun]) then ClearSources; end; procedure TFpGDBMILineInfo.ClearSources; begin FRequestedSources.Clear; end; constructor TFpGDBMILineInfo.Create(const ADebugger: TDebugger); begin FRequestedSources := TStringList.Create; inherited Create(ADebugger); end; destructor TFpGDBMILineInfo.Destroy; begin FreeAndNil(FRequestedSources); inherited Destroy; end; function TFpGDBMILineInfo.Count: Integer; begin Result := FRequestedSources.Count; end; function TFpGDBMILineInfo.GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; var Map: PDWarfLineMap; begin Result := 0; if not FpDebugger.HasDwarf then exit; //Result := FpDebugger.FDwarfInfo.GetLineAddress(FRequestedSources[AIndex], ALine); Map := PDWarfLineMap(FRequestedSources.Objects[AIndex]); if Map <> nil then Result := Map^.GetAddressForLine(ALine); end; function TFpGDBMILineInfo.GetInfo(AAdress: TDbgPtr; out ASource, ALine, AOffset: Integer): Boolean; begin Result := False; //ASource := ''; //ALine := 0; //if not FpDebugger.HasDwarf then // exit(nil); //FpDebugger.FDwarfInfo. end; function TFpGDBMILineInfo.IndexOf(const ASource: String): integer; begin Result := FRequestedSources.IndexOf(ASource); end; procedure TFpGDBMILineInfo.Request(const ASource: String); begin if not FpDebugger.HasDwarf then exit; FRequestedSources.AddObject(ASource, TObject(FpDebugger.FDwarfInfo.GetLineAddressMap(ASource))); DoChange(ASource); end; procedure TFpGDBMILineInfo.Cancel(const ASource: String); begin // end; { TFpGDBMIDebuggerCommandStartDebugging } function TFpGDBMIDebuggerCommandStartDebugging.DoExecute: Boolean; begin TFpGDBMIDebugger(FTheDebugger).LoadDwarf; Result := inherited DoExecute; end; { TFpGDBMIDebugger } procedure TFpGDBMIDebugger.DoState(const OldState: TDBGState); begin inherited DoState(OldState); if State in [dsStop, dsError, dsNone] then UnLoadDwarf; end; function TFpGDBMIDebugger.HasDwarf: Boolean; begin Result := FDwarfInfo <> nil; end; procedure TFpGDBMIDebugger.LoadDwarf; begin UnLoadDwarf; debugln(['TFpGDBMIDebugger.LoadDwarf ']); FImageLoader := TDbgImageLoader.Create(FileName); FDwarfInfo := TDbgDwarf.Create(FImageLoader); FDwarfInfo.LoadCompilationUnits; end; procedure TFpGDBMIDebugger.UnLoadDwarf; begin debugln(['TFpGDBMIDebugger.UnLoadDwarf ']); FreeAndNil(FDwarfInfo); FreeAndNil(FImageLoader); end; function TFpGDBMIDebugger.CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging; begin Result := TFpGDBMIDebuggerCommandStartDebugging.Create(Self, AContinueCommand); end; function TFpGDBMIDebugger.CreateLineInfo: TDBGLineInfo; begin Result := TFpGDBMILineInfo.Create(Self); end; class function TFpGDBMIDebugger.Caption: String; begin Result := 'GNU remote debugger (with fpdebug)'; end; destructor TFpGDBMIDebugger.Destroy; begin UnLoadDwarf; inherited Destroy; end; initialization RegisterDebugger(TFpGDBMIDebugger); end.