From 5562c074da530edff539cf6106b0ee7c92f2a806 Mon Sep 17 00:00:00 2001 From: martin Date: Thu, 3 May 2018 18:52:41 +0000 Subject: [PATCH] IDE, fpDebug, Debuggers: Deal with source lines that have more than one address (e.g. generics). fpDebug: set breakpoints at all addresses of a line. git-svn-id: trunk@57782 - --- components/debuggerintf/dbgintfbasetypes.pas | 1 + .../debuggerintf/dbgintfdebuggerbase.pp | 22 +- components/fpdebug/fpdbgclasses.pp | 286 ++++++++++++------ components/fpdebug/fpdbgcontroller.pas | 28 +- components/fpdebug/fpdbgdwarf.pas | 6 +- components/fpdebug/fpdbgdwarfdataclasses.pas | 187 +++++++++--- components/fpdebug/fpdbginfo.pas | 7 +- components/fpdebug/fpdbgsymtablecontext.pas | 6 - components/fpdebug/fpdbgwinclasses.pas | 14 +- components/lazdebuggergdbmi/gdbmidebugger.pp | 9 +- .../lazdebuggerfp/fpdebugdebugger.pas | 65 ++-- .../lazdebuggerfpgdbmi/fpgdbmidebugger.pp | 10 +- debugger/debugger.pp | 9 +- ide/sourceeditor.pp | 10 +- 14 files changed, 441 insertions(+), 219 deletions(-) diff --git a/components/debuggerintf/dbgintfbasetypes.pas b/components/debuggerintf/dbgintfbasetypes.pas index 725c777240..d7ae79533c 100644 --- a/components/debuggerintf/dbgintfbasetypes.pas +++ b/components/debuggerintf/dbgintfbasetypes.pas @@ -16,6 +16,7 @@ type datatype pointing to data on the target *) TDBGPtr = type QWord; + TDBGPtrArray = Array of TDBGPtr; (* TDbgSymbolKind Enum of types that a value can have. diff --git a/components/debuggerintf/dbgintfdebuggerbase.pp b/components/debuggerintf/dbgintfdebuggerbase.pp index 0ccb826c70..6ffd0cdf6d 100644 --- a/components/debuggerintf/dbgintfdebuggerbase.pp +++ b/components/debuggerintf/dbgintfdebuggerbase.pp @@ -859,8 +859,8 @@ type public constructor Create; function Count: Integer; virtual; - function GetAddress(const {%H-}AIndex: Integer; const {%H-}ALine: Integer): TDbgPtr; virtual; - function GetAddress(const ASource: String; const ALine: Integer): TDbgPtr; + function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; virtual; + function HasAddress(const ASource: String; const ALine: Integer): Boolean; function GetInfo({%H-}AAddress: TDbgPtr; out {%H-}ASource, {%H-}ALine, {%H-}AOffset: Integer): Boolean; virtual; function IndexOf(const {%H-}ASource: String): integer; virtual; procedure Request(const {%H-}ASource: String); virtual; @@ -4254,19 +4254,15 @@ begin inherited Create; end; -function TBaseLineInfo.GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; -begin - Result := 0; -end; - -function TBaseLineInfo.GetAddress(const ASource: String; const ALine: Integer): TDbgPtr; +function TBaseLineInfo.HasAddress(const ASource: String; const ALine: Integer + ): Boolean; var idx: Integer; begin idx := IndexOf(ASource); if idx = -1 - then Result := 0 - else Result := GetAddress(idx, ALine); + then Result := False + else Result := HasAddress(idx, ALine); end; function TBaseLineInfo.GetInfo(AAddress: TDbgPtr; out ASource, ALine, AOffset: Integer): Boolean; @@ -4288,6 +4284,12 @@ begin Result := 0; end; +function TBaseLineInfo.HasAddress(const AIndex: Integer; const ALine: Integer + ): Boolean; +begin + Result := False; +end; + { TDBGLineInfo } procedure TDBGLineInfo.Changed(ASource: String); diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index b82e45dac4..edf1890f42 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -131,7 +131,7 @@ type end; { TDbgThread } - TDbgBreakpoint = class; + TFpInternalBreakpoint = class; TDbgThread = class(TObject) private @@ -172,23 +172,52 @@ type end; TDbgThreadClass = class of TDbgThread; - TDbgBreakpoint = class(TObject) + { TFpInternalBreakpointBase } + + TFpInternalBreakpointBase = class(TObject) + public + function Hit(const AThreadID: Integer; ABreakpointAddress: TDBGPtr): Boolean; virtual; abstract; + procedure SetBreak; virtual; abstract; + procedure ResetBreak; virtual; abstract; + end; + + { TFpInternalBreakpoint } + + TFpInternalBreakpoint = class(TFpInternalBreakpointBase) private FProcess: TDbgProcess; - FLocation: TDbgPtr; + FLocation: TDBGPtrArray; + FOrgValue: Array of Byte; + const + Int3: Byte = $CC; protected - FOrgValue: Byte; property Process: TDbgProcess read FProcess; + property Location: TDBGPtrArray read FLocation; public - constructor Create(const AProcess: TDbgProcess; const ALocation: TDbgPtr); virtual; + constructor Create(const AProcess: TDbgProcess; const ALocation: TDBGPtrArray); virtual; destructor Destroy; override; - function Hit(const AThreadID: Integer): Boolean; virtual; - property Location: TDbgPtr read FLocation; + function Hit(const AThreadID: Integer; ABreakpointAddress: TDBGPtr): Boolean; override; + function HasLocation(const ALocation: TDBGPtr): Boolean; + procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData); - procedure SetBreak; virtual; - procedure ResetBreak; virtual; + procedure SetBreak; override; + procedure ResetBreak; override; end; - TDbgBreakpointClass = class of TDbgBreakpoint; + TFpInternalBreakpointClass = class of TFpInternalBreakpoint; + +// TFpInternalBreakpointList = class(TFpInternalBreakpointBase) +// private +// FList: TFPList; +// public +// destructor Destroy; override; +// procedure Add(ABreakPoint: TFpInternalBreakpoint); +// procedure Remove(ABreakPoint: TFpInternalBreakpoint); +// function IsEmpty: Boolean; +// +//// function Hit(const AThreadID: Integer): Boolean; virtual; +//// procedure SetBreak; virtual; +//// procedure ResetBreak; virtual; +// end; { TDbgInstance } @@ -209,10 +238,9 @@ type constructor Create(const AProcess: TDbgProcess); virtual; destructor Destroy; override; - function AddBreak(const AFileName: String; ALine: Cardinal): TDbgBreakpoint; overload; + function AddBreak(const AFileName: String; ALine: Cardinal): TFpInternalBreakpoint; overload; function AddrOffset: Int64; virtual; // gives the offset between the loaded addresses and the compiled addresses function FindSymbol(AAdress: TDbgPtr): TFpDbgSymbol; - function RemoveBreak(const AFileName: String; ALine: Cardinal): Boolean; procedure LoadInfo; virtual; property Process: TDbgProcess read FProcess; @@ -247,7 +275,7 @@ type procedure ThreadDestroyed(const AThread: TDbgThread); protected - FCurrentBreakpoint: TDbgBreakpoint; // set if we are executing the code at the break + FCurrentBreakpoint: TFpInternalBreakpoint; // set if we are executing the code at the break // if the singlestep is done, set the break again FCurrentWatchpoint: integer; FReEnableBreakStep: Boolean; // Set when we are reenabling a breakpoint @@ -273,13 +301,14 @@ type class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess; virtual; constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); virtual; destructor Destroy; override; - function AddBreak(const ALocation: TDbgPtr): TDbgBreakpoint; overload; + function AddBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload; + function AddBreak(const ALocation: TDBGPtrArray): TFpInternalBreakpoint; overload; function FindSymbol(const AName: String): TFpDbgSymbol; function FindSymbol(AAdress: TDbgPtr): TFpDbgSymbol; function GetLib(const AHandle: THandle; out ALib: TDbgLibrary): Boolean; function GetThread(const AID: Integer; out AThread: TDbgThread): Boolean; - function RemoveBreak(const ALocation: TDbgPtr): Boolean; - function HasBreak(const ALocation: TDbgPtr): Boolean; + function RemoveBreak(const ABreakPoint: TFpInternalBreakpoint): Boolean; + function HasBreak(const ALocation: TDbgPtr): Boolean; // TODO: remove, once an address can have many breakpoints procedure RemoveThread(const AID: DWord); procedure Log(const AString: string; const ALogLevel: TFPDLogLevel = dllDebug); procedure Log(const AString: string; const Options: array of const; const ALogLevel: TFPDLogLevel = dllDebug); @@ -316,7 +345,7 @@ type property ProcessID: integer read FProcessID; property ThreadID: integer read FThreadID; property ExitCode: DWord read FExitCode; - property CurrentBreakpoint: TDbgBreakpoint read FCurrentBreakpoint; + property CurrentBreakpoint: TFpInternalBreakpoint read FCurrentBreakpoint; property CurrentWatchpoint: integer read FCurrentWatchpoint; // Properties valid when last event was an deException @@ -332,7 +361,7 @@ type TOSDbgClasses = class public DbgThreadClass : TDbgThreadClass; - DbgBreakpointClass : TDbgBreakpointClass; + DbgBreakpointClass : TFpInternalBreakpointClass; DbgProcessClass : TDbgProcessClass; end; @@ -373,7 +402,7 @@ begin begin GOSDbgClasses := TOSDbgClasses.create; GOSDbgClasses.DbgThreadClass := TDbgThread; - GOSDbgClasses.DbgBreakpointClass := TDbgBreakpoint; + GOSDbgClasses.DbgBreakpointClass := TFpInternalBreakpoint; GOSDbgClasses.DbgProcessClass := TDbgProcess; {$ifdef windows} RegisterDbgClasses; @@ -627,15 +656,20 @@ end; { TDbgInstance } -function TDbgInstance.AddBreak(const AFileName: String; ALine: Cardinal): TDbgBreakpoint; +function TDbgInstance.AddBreak(const AFileName: String; ALine: Cardinal): TFpInternalBreakpoint; var - addr: TDbgPtr; + addr: TDBGPtrArray; + o: Int64; + i: Integer; begin Result := nil; if not FDbgInfo.HasInfo then Exit; - addr := FDbgInfo.GetLineAddress(AFileName, ALine); - if addr = 0 then Exit; - Result := FProcess.AddBreak(addr - AddrOffset); + if FDbgInfo.GetLineAddresses(AFileName, ALine, addr) then begin + o := AddrOffset; + for i := 0 to High(addr) do + addr[i] := addr[i] - o; + Result := FProcess.AddBreak(addr); + end; end; function TDbgInstance.AddrOffset: Int64; @@ -678,17 +712,6 @@ begin FSymbolTableInfo := TFpSymbolInfo.Create(FLoaderList); end; -function TDbgInstance.RemoveBreak(const AFileName: String; ALine: Cardinal): Boolean; -var - addr: TDbgPtr; -begin - Result := False; - if not FDbgInfo.HasInfo then Exit; - addr := FDbgInfo.GetLineAddress(AFileName, ALine); - if addr = 0 then Exit; - Result := FProcess.RemoveBreak(addr - AddrOffset); -end; - procedure TDbgInstance.SetFileName(const AValue: String); begin FFileName := AValue; @@ -711,20 +734,30 @@ end; { TDbgProcess } -function TDbgProcess.AddBreak(const ALocation: TDbgPtr): TDbgBreakpoint; +function TDbgProcess.AddBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; +var + a: TDBGPtrArray; +begin + SetLength(a, 1); + a[0] := ALocation; + Result := AddBreak(a); +end; + +function TDbgProcess.AddBreak(const ALocation: TDBGPtrArray + ): TFpInternalBreakpoint; +var + a, ip: TDBGPtr; begin - if FBreakMap.HasId(ALocation) then begin - debugln(['TDbgProcess.AddBreak breakpoint already exists at ', dbgs(ALocation)]); - Result := nil; - exit; - end; Result := OSDbgClasses.DbgBreakpointClass.Create(Self, ALocation); - FBreakMap.Add(ALocation, Result); - if (GetInstructionPointerRegisterValue=ALocation) and not assigned(FCurrentBreakpoint) then - begin - FCurrentBreakpoint := Result; - Result.ResetBreak; - end; + // TODO: empty breakpoint (all address failed to set) = nil + ip := GetInstructionPointerRegisterValue; + if not assigned(FCurrentBreakpoint) then + for a in ALocation do + if ip=a then begin + FCurrentBreakpoint := Result; + Result.ResetBreak; + break; + end; end; constructor TDbgProcess.Create(const AFileName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); @@ -741,7 +774,7 @@ begin FThreadMap := TMap.Create(itu4, SizeOf(TDbgThread)); FLibMap := TMap.Create(MAP_ID_SIZE, SizeOf(TDbgLibrary)); - FBreakMap := TMap.Create(MAP_ID_SIZE, SizeOf(TDbgBreakpoint)); + FBreakMap := TMap.Create(MAP_ID_SIZE, SizeOf(TFpInternalBreakpoint)); FCurrentBreakpoint := nil; FCurrentWatchpoint := -1; @@ -776,7 +809,8 @@ destructor TDbgProcess.Destroy; begin FProcessID:=0; - FreeItemsInMap(FBreakMap); + Assert(FBreakMap.Count=0, 'No breakpoints left'); + //FreeItemsInMap(FBreakMap); FreeItemsInMap(FThreadMap); FreeItemsInMap(FLibMap); @@ -959,20 +993,11 @@ begin Log('Unknown thread ID %u for process %u', [AThreadIdentifier, ProcessID]); end; -function TDbgProcess.RemoveBreak(const ALocation: TDbgPtr): Boolean; -var - ABreakPoint: TDbgBreakpoint; +function TDbgProcess.RemoveBreak(const ABreakPoint: TFpInternalBreakpoint + ): Boolean; begin - if FBreakMap = nil - then Result := False - else begin - result := FBreakMap.GetData(ALocation, ABreakPoint); - if result then begin - if ABreakPoint=FCurrentBreakpoint then - FCurrentBreakpoint := nil; - Result := FBreakMap.Delete(ALocation); - end; - end; + if ABreakPoint=FCurrentBreakpoint then + FCurrentBreakpoint := nil; end; function TDbgProcess.HasBreak(const ALocation: TDbgPtr): Boolean; @@ -1061,14 +1086,14 @@ begin if FCurrentBreakpoint = nil then Exit; Result := True; - if not FCurrentBreakpoint.Hit(AThreadId) + if not FCurrentBreakpoint.Hit(AThreadId, BreakpointAddress) then FCurrentBreakpoint := nil; // no need for a singlestep if we continue end; procedure TDbgProcess.MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData); var BreakLocation: TDBGPtr; - Bp: TDbgBreakpoint; + Bp: TFpInternalBreakpoint; Iterator: TMapIterator; begin iterator := TMapIterator.Create(FBreakMap); @@ -1077,9 +1102,7 @@ begin while not Iterator.EOM do begin Iterator.GetData(bp); - BreakLocation := Bp.FLocation; - if (BreakLocation >= AAdress) and (BreakLocation < (AAdress+ASize)) then - TByteArray(AData)[BreakLocation-AAdress] := Bp.FOrgValue; + Bp.MaskBreakpointsInReadData(AAdress, ASize, AData); iterator.Next; end; finally @@ -1125,19 +1148,25 @@ end; function TDbgThread.IsAtStartOfLine: boolean; var - AnAddr: TDBGPtr; + AnAddr, b: TDBGPtr; Sym: TFpDbgSymbol; CU: TDwarfCompilationUnit; + a: TDBGPtrArray; begin - result := true; AnAddr := FProcess.GetInstructionPointerRegisterValue; sym := FProcess.FindSymbol(AnAddr); if (sym is TDbgDwarfSymbolBase) then begin CU := TDbgDwarfSymbolBase(sym).CompilationUnit; - if cu.GetLineAddress(sym.FileName, sym.Line)<>AnAddr then - result := false; - end; + Result := False; + CU.GetLineAddresses(sym.FileName, sym.Line, a); + for b in a do begin + Result := b = AnAddr; + if Result then break; + end; + end + else + Result := True; sym.ReleaseReference; end; @@ -1253,27 +1282,39 @@ end; { TDbgBreak } -constructor TDbgBreakpoint.Create(const AProcess: TDbgProcess; const ALocation: TDbgPtr); +constructor TFpInternalBreakpoint.Create(const AProcess: TDbgProcess; + const ALocation: TDBGPtrArray); +var + i: Integer; begin FProcess := AProcess; FLocation := ALocation; + SetLength(FOrgValue, Length(FLocation)); + for i := 0 to High(FLocation) do + FOrgValue[i] := Int3; // Mark location as NOT applied inherited Create; SetBreak; end; -destructor TDbgBreakpoint.Destroy; +destructor TFpInternalBreakpoint.Destroy; begin ResetBreak; inherited; end; -function TDbgBreakpoint.Hit(const AThreadID: Integer): Boolean; +function TFpInternalBreakpoint.Hit(const AThreadID: Integer; + ABreakpointAddress: TDBGPtr): Boolean; var Thread: TDbgThread; + i: Integer; begin Result := False; - if FOrgValue = $CC then Exit; // breakpoint on a hardcoded breakpoint - // no need to jum back and restore instruction + for i := 0 to High(FLocation) do begin + if (FLocation[i] = ABreakpointAddress) and + (FOrgValue[i] = Int3) + then Exit; // breakpoint on a hardcoded breakpoint + // no need to jum back and restore instruction + end; ResetBreak; if not Process.GetThread(AThreadId, Thread) then Exit; @@ -1284,36 +1325,85 @@ begin Result := true; end; -procedure TDbgBreakpoint.ResetBreak; +function TFpInternalBreakpoint.HasLocation(const ALocation: TDBGPtr): Boolean; +var + i: Integer; begin - if FProcess.ProcessID=0 then - // The process is already exited. - Exit; + Result := True; + for i := 0 to High(FLocation) do begin + if FOrgValue[i] = Int3 then Continue; + if FLocation[i] = ALocation then exit; + end; + Result := False; +end; - if FOrgValue = $CC then Exit; // breakpoint on a hardcoded breakpoint - - if not FProcess.WriteData(FLocation, 1, FOrgValue) - then begin - Log('Unable to reset breakpoint at %s', [FormatAddress(FLocation)]); +procedure TFpInternalBreakpoint.MaskBreakpointsInReadData( + const AAdress: TDbgPtr; const ASize: Cardinal; var AData); +var + i: Integer; +begin + for i := 0 to High(FLocation) do begin + if FOrgValue[i] = Int3 then Continue; + if (FLocation[i] >= AAdress) and (FLocation[i] < (AAdress+ASize)) then + TByteArray(AData)[FLocation[i]-AAdress] := FOrgValue[i]; end; end; -procedure TDbgBreakpoint.SetBreak; -const - Int3: Byte = $CC; +procedure TFpInternalBreakpoint.ResetBreak; +var + i: Integer; + tmp: TFpInternalBreakpoint; + t: Boolean; begin - if not FProcess.ReadData(FLocation, 1, FOrgValue) - then begin - Log('Unable to read breakpoint at '+FormatAddress(FLocation)); - Exit; + t := FProcess.ProcessID=0; // The process has already exited. + + for i := 0 to High(FLocation) do begin + if FOrgValue[i] = Int3 then Continue; // breakpoint on a hardcoded breakpoint + + if (not FProcess.FBreakMap.GetData(FLocation[i], tmp)) or (tmp <> self) then begin + Log('Internal error resetting breakpoint at %s (Address %d out of %d)', [FormatAddress(FLocation[i]), i, Length(FLocation)]); + FOrgValue[i] := Int3; // Mark location as NOT applied + Continue; + end; + + if (not t) then begin + if (not FProcess.WriteData(FLocation[i], 1, FOrgValue[i])) then begin + Log('Unable to reset breakpoint at %s (Address %d out of %d)', [FormatAddress(FLocation[i]), i, Length(FLocation)]); + end; + end; + FProcess.FBreakMap.Delete(FLocation[i]); + + FOrgValue[i] := Int3; // Mark location as NOT applied end; +end; - if FOrgValue = $CC then Exit; // breakpoint on a hardcoded breakpoint +procedure TFpInternalBreakpoint.SetBreak; +var + i: Integer; +begin + for i := 0 to High(FLocation) do begin + FOrgValue[i] := Int3; // Mark location as NOT applied - if not FProcess.WriteData(FLocation, 1, Int3) - then begin - Log('Unable to set breakpoint at '+FormatAddress(FLocation)); - Exit; + if FProcess.FBreakMap.HasId(FLocation[i]) then begin + Log('TFpInternalBreakpoint.SetBreak breakpoint already exists at ' + dbgs(FLocation[i])); + Continue; + end; + + if not FProcess.ReadData(FLocation[i], 1, FOrgValue[i]) + then begin + Log('Unable to read breakpoint at '+FormatAddress(FLocation[i])+' (Address #'+IntToStr(i)+' out of '+IntToStr(Length(FLocation))+')'); + Continue; + end; + + if FOrgValue[i] = Int3 then Continue; // breakpoint on a hardcoded breakpoint + + if not FProcess.WriteData(FLocation[i], 1, Int3) + then begin + Log('Unable to set breakpoint at '+FormatAddress(FLocation[i])+' (Address #'+IntToStr(i)+' out of '+IntToStr(Length(FLocation))+')'); + Continue; + end; + + FProcess.FBreakMap.Add(FLocation[i], Self); end; end; diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index 1ac85beb13..78ee9f71bd 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/components/fpdebug/fpdbgcontroller.pas @@ -16,7 +16,7 @@ uses type TOnCreateProcessEvent = procedure(var continue: boolean) of object; - TOnHitBreakpointEvent = procedure(var continue: boolean; const Breakpoint: TDbgBreakpoint) of object; + TOnHitBreakpointEvent = procedure(var continue: boolean; const Breakpoint: TFpInternalBreakpoint) of object; TOnExceptionEvent = procedure(var continue: boolean; const ExceptionClass, ExceptionMessage: string) of object; TOnProcessExitEvent = procedure(ExitCode: DWord) of object; @@ -53,7 +53,7 @@ type TDbgControllerStepOverInstructionCmd = class(TDbgControllerCmd) private - FHiddenBreakpoint: TDbgBreakpoint; + FHiddenBreakpoint: TFpInternalBreakpoint; FIsSet: boolean; public procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; @@ -84,7 +84,7 @@ type FLastStackPointerValue: TDBGPtr; FLastStackBaseValue: TDBGPtr; FAssumedProcStartStackPointer: TDBGPtr; - FHiddenBreakpoint: TDbgBreakpoint; + FHiddenBreakpoint: TFpInternalBreakpoint; FInstCount: integer; public constructor Create(AController: TDbgController); override; @@ -97,11 +97,11 @@ type TDbgControllerRunToCmd = class(TDbgControllerCmd) private - FHiddenBreakpoint: TDbgBreakpoint; - FLocation: TDBGPtr; + FHiddenBreakpoint: TFpInternalBreakpoint; + FLocation: TDBGPtrArray; FProcess: TDbgProcess; public - constructor Create(AController: TDbgController; ALocation: TDBGPtr); + constructor Create(AController: TDbgController; ALocation: TDBGPtrArray); procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; procedure ResolveEvent(var AnEvent: TFPDEvent; out Handled, Finished: boolean); override; end; @@ -182,7 +182,7 @@ implementation { TDbgControllerRunToCmd } -constructor TDbgControllerRunToCmd.Create(AController: TDbgController; ALocation: TDBGPtr); +constructor TDbgControllerRunToCmd.Create(AController: TDbgController; ALocation: TDBGPtrArray); begin inherited create(AController); FLocation:=ALocation; @@ -191,8 +191,10 @@ end; procedure TDbgControllerRunToCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); begin FProcess := AProcess; - if not assigned(FHiddenBreakpoint) and not AProcess.HasBreak(FLocation) then - FHiddenBreakpoint := AProcess.AddBreak(FLocation); + if not assigned(FHiddenBreakpoint) then // and not AProcess.HasBreak(FLocation) + FHiddenBreakpoint := AProcess.AddBreak(FLocation) + else + FProcess.Log('TDbgControllerRunToCmd.DoContinue: Breakpoint already used'); AProcess.Continue(AProcess, AThread, False); end; @@ -204,7 +206,7 @@ begin Finished := (AnEvent<>deInternalContinue); if Finished and assigned(FHiddenBreakpoint) then begin - FProcess.RemoveBreak(FLocation); + FProcess.RemoveBreak(FHiddenBreakpoint); FHiddenBreakpoint.Free; end; end; @@ -223,7 +225,7 @@ destructor TDbgControllerStepIntoLineCmd.Destroy; begin if assigned(FHiddenBreakpoint) then begin - FController.CurrentProcess.RemoveBreak(FHiddenBreakpoint.Location); + FController.CurrentProcess.RemoveBreak(FHiddenBreakpoint); FreeAndNil(FHiddenBreakpoint); end; inherited Destroy; @@ -318,7 +320,7 @@ begin begin FInto:=false; FInstCount:=0; - FController.CurrentProcess.RemoveBreak(FHiddenBreakpoint.Location); + FController.CurrentProcess.RemoveBreak(FHiddenBreakpoint); FreeAndNil(FHiddenBreakpoint); end else @@ -433,7 +435,7 @@ begin begin if assigned(FHiddenBreakpoint) then begin - FController.FCurrentProcess.RemoveBreak(FHiddenBreakpoint.Location); + FController.FCurrentProcess.RemoveBreak(FHiddenBreakpoint); FHiddenBreakpoint.Free; end; end; diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index e64d16adda..d7a55f34bf 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -90,7 +90,7 @@ type property ThreadId: Integer read FThreadId write FThreadId; property StackFrame: Integer read FStackFrame write FStackFrame; - function ApplyContext(AVal: TFpDbgValue): TFpDbgValue; inline; + procedure ApplyContext(AVal: TFpDbgValue); inline; function SymbolToValue(ASym: TFpDbgSymbol): TFpDbgValue; inline; procedure AddRefToVal(AVal: TFpDbgValue); inline; function GetSelfParameter: TFpDbgValue; virtual; @@ -990,7 +990,7 @@ begin Result := FDwarf.MemManager; end; -function TFpDwarfInfoAddressContext.ApplyContext(AVal: TFpDbgValue): TFpDbgValue; +procedure TFpDwarfInfoAddressContext.ApplyContext(AVal: TFpDbgValue); begin if (AVal <> nil) and (TFpDwarfValueBase(AVal).FContext = nil) then TFpDwarfValueBase(AVal).FContext := Self; @@ -1877,7 +1877,7 @@ end; function TFpDwarfValueChar.GetAsWideString: WideString; begin if FSize > 2 then - Result := inherited GetAsString + Result := inherited GetAsWideString else Result := WideChar(Word(GetAsCardinal)); end; diff --git a/components/fpdebug/fpdbgdwarfdataclasses.pas b/components/fpdebug/fpdbgdwarfdataclasses.pas index b680b97f33..ba0ec01080 100644 --- a/components/fpdebug/fpdbgdwarfdataclasses.pas +++ b/components/fpdebug/fpdbgdwarfdataclasses.pas @@ -395,13 +395,17 @@ type TDWarfLineMap = object private - NextAFterHighestLine: Cardinal; - AddressList: array of QWord; - //Count: Integer; + // FLineIndexList[ line div 256 ] + FLineIndexList: Array of record + LineOffsets: Array of Byte; + Addresses: Array of TDBGPtr; + end; public procedure Init; - procedure SetAddressForLine(ALine: Cardinal; AnAddress: QWord); inline; - function GetAddressForLine(ALine: Cardinal): QWord; inline; + procedure SetAddressForLine(ALine: Cardinal; AnAddress: TDBGPtr); inline; + function GetAddressesForLine(ALine: Cardinal; var AResultList: TDBGPtrArray; + NoData: Boolean = False): Boolean; inline; + // NoData: only return True/False, but nothing in AResultList procedure Compress; end; PDWarfLineMap = ^TDWarfLineMap; @@ -496,6 +500,7 @@ type FAbbrevList: TDwarfAbbrevList; + {$IFDEF DwarfTestAccess} public {$ENDIF} FLineInfo: record Header: Pointer; DataStart: Pointer; @@ -514,10 +519,11 @@ type StateMachine: TDwarfLineInfoStateMachine; StateMachines: TFPObjectList; // list of state machines to be freed end; - + {$IFDEF DwarfTestAccess} private {$ENDIF} + FLineNumberMap: TStringList; - FAddressMap: TMap; + FAddressMap: TMap; // Holds a key for each DW_TAG_subprogram, stores TDwarfAddressInfo FAddressMapBuild: Boolean; FMinPC: QWord; // the min and max PC value found in this unit. @@ -554,7 +560,7 @@ type procedure ScanAllEntries; inline; function GetDefinition(AAbbrevPtr: Pointer; out ADefinition: TDwarfAbbrev): Boolean; inline; function GetLineAddressMap(const AFileName: String): PDWarfLineMap; - function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; + function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): boolean; procedure BuildLineInfo(AAddressInfo: PDwarfAddressInfo; ADoAll: Boolean); function FullFileName(const AFileName:string): String; // On Darwin it could be that the debug-information is not included into the executable by the linker. @@ -605,7 +611,7 @@ type function FindContext(AAddress: TDbgPtr): TFpDbgInfoContext; override; function FindSymbol(AAddress: TDbgPtr): TFpDbgSymbol; override; //function FindSymbol(const AName: String): TDbgSymbol; override; - function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; override; + function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean; override; function GetLineAddressMap(const AFileName: String): PDWarfLineMap; function LoadCompilationUnits: Integer; function PointerFromRVA(ARVA: QWord): Pointer; @@ -1056,8 +1062,8 @@ var else begin // append to existing GapAvail := FTableListGaps[ATableListIndex].EndTable; - assert(AEntry^.EndIndex + AEntry^.LeadHigh - AEntry^.LeadLow + 1 + GapAvail <= FEndTableNextFreeIndex); - AtEnd := AEntry^.EndIndex + AEntry^.EndHigh - AEntry^.EndLow + 1 + GapAvail = FEndTableNextFreeIndex; + assert(Int64(AEntry^.EndIndex) + Int64(AEntry^.LeadHigh) - Int64(AEntry^.LeadLow) + 1 + GapAvail <= FEndTableNextFreeIndex); + AtEnd := Int64(AEntry^.EndIndex) + Int64(AEntry^.EndHigh) - Int64(AEntry^.EndLow) + 1 + GapAvail = FEndTableNextFreeIndex; ANeeded := ALeadByte - AEntry^.EndHigh; if ANeeded <= GapAvail then begin @@ -2780,37 +2786,138 @@ end; procedure TDWarfLineMap.Init; begin - NextAFterHighestLine := 0; - //Count := 0; end; -procedure TDWarfLineMap.SetAddressForLine(ALine: Cardinal; AnAddress: QWord); +procedure TDWarfLineMap.SetAddressForLine(ALine: Cardinal; AnAddress: TDBGPtr); var - i: Integer; + SectLen, SectCnt, i, j, o, o2: Integer; + idx, offset: TDBGPtr; + LineOffsets: Array of Byte; + Addresses: Array of TDBGPtr; begin - i := Length(AddressList); - if i <= ALine then - SetLength(AddressList, ALine + 2000); + idx := ALine div 256; + offset := ALine mod 256; + i := Length(FLineIndexList); + if idx >= i then + SetLength(FLineIndexList, idx+4); - if AddressList[ALine] = 0 then begin - AddressList[ALine] := AnAddress; - //inc(Count); + LineOffsets := FLineIndexList[idx].LineOffsets; + Addresses := FLineIndexList[idx].Addresses; + + if Addresses = nil then begin + SectLen := 192; + SectCnt := 0; + SetLength(FLineIndexList[idx].Addresses, 193); + SetLength(FLineIndexList[idx].LineOffsets, 192); + LineOffsets := FLineIndexList[idx].LineOffsets; + Addresses := FLineIndexList[idx].Addresses; + end + else begin + SectLen := Length(LineOffsets); + SectCnt := Integer(Addresses[SectLen]); + if SectCnt >= SectLen then begin + SectLen := SectCnt + 64; + SetLength(FLineIndexList[idx].Addresses, SectLen+1); + SetLength(FLineIndexList[idx].LineOffsets, SectLen); + LineOffsets := FLineIndexList[idx].LineOffsets; + Addresses := FLineIndexList[idx].Addresses; + end; end; - if ALine > NextAFterHighestLine then - NextAFterHighestLine := ALine+1; + + + i := 0; + o := 0; + while (i < SectCnt) do begin + o2 := o + LineOffsets[i]; + if o2 > offset then break; + o := o2; + inc(i); + end; + + j := SectCnt; + while j > i do begin + LineOffsets[j] := LineOffsets[j-1]; + Addresses[j] := Addresses[j-1]; + dec(j); + end; + + offset := offset - o; + LineOffsets[i] := offset; + Addresses[i] := AnAddress; + + if i < SectCnt then begin + assert(LineOffsets[i+1] >= offset, 'TDWarfLineMap.SetAddressForLine LineOffsets[i+1] > offset'); + LineOffsets[i+1] := LineOffsets[i+1] - offset; + end; + + Addresses[SectLen] := SectCnt + 1; end; -function TDWarfLineMap.GetAddressForLine(ALine: Cardinal): QWord; +function TDWarfLineMap.GetAddressesForLine(ALine: Cardinal; + var AResultList: TDBGPtrArray; NoData: Boolean): Boolean; +var + idx, offset: TDBGPtr; + LineOffsets: Array of Byte; + Addresses: Array of TDBGPtr; + o: Byte; + i, j, k, l: Integer; begin - Result := 0; - if ALine < Length(AddressList) then - Result := AddressList[ALine]; + Result := False; + idx := ALine div 256; + offset := ALine mod 256; + if idx >= Length(FLineIndexList) then + exit; + + LineOffsets := FLineIndexList[idx].LineOffsets; + Addresses := FLineIndexList[idx].Addresses; + if Addresses = nil then + exit; + + l := Length(LineOffsets); + i := 0; + while (i < l) do begin + o := LineOffsets[i]; + if o > offset then exit; + offset := offset - o; + if offset = 0 then break; + inc(i); + end; + + If (offset > 0) then + exit; + + if NoData then begin + Result := True; + exit; + end; + + j := i + 1; + while (j < l) and (LineOffsets[j] = 0) do inc(j); + + k := Length(AResultList); + SetLength(AResultList, k + (j-i)); + while i < j do begin + AResultList[k] := Addresses[i]; + inc(i); + inc(k); + end; + + Result := True; end; procedure TDWarfLineMap.Compress; +var + i, j: Integer; begin - SetLength(AddressList, NextAFterHighestLine); -//DebugLn(['#### ',NextAFterHighestLine, ' / ',Count]); + for i := 0 to high(FLineIndexList) do begin + j := Length(FLineIndexList[i].LineOffsets); + if j <> 0 then begin + j := FLineIndexList[i].Addresses[j]; + SetLength(FLineIndexList[i].Addresses, j+1); + FLineIndexList[i].Addresses[j] := j; + SetLength(FLineIndexList[i].LineOffsets, j); + end; + end; end; { TFpDwarfInfo } @@ -2968,18 +3075,18 @@ begin end; end; -function TFpDwarfInfo.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; +function TFpDwarfInfo.GetLineAddresses(const AFileName: String; + ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean; var n: Integer; CU: TDwarfCompilationUnit; begin + Result := False; for n := 0 to FCompilationUnits.Count - 1 do begin CU := TDwarfCompilationUnit(FCompilationUnits[n]); - Result := CU.GetLineAddress(AFileName, ALine); - if Result <> 0 then Exit; + Result := CU.GetLineAddresses(AFileName, ALine, AResultList) or Result; end; - Result := 0; end; function TFpDwarfInfo.GetLineAddressMap(const AFileName: String): PDWarfLineMap; @@ -3346,7 +3453,10 @@ begin end; addr := FLineInfo.StateMachine.Address; - LineMap^.SetAddressForLine(Line, addr); + if (not FLineInfo.StateMachine.EndSequence) and (FLineInfo.StateMachine.IsStmt) + and (Line > 0) + then + LineMap^.SetAddressForLine(Line, addr); if (Info = nil) or (addr < Info^.StartPC) or @@ -3384,7 +3494,7 @@ begin Result := FAddressMap; end; -function TDwarfCompilationUnit.FullFileName(const AFileName: String): String; +function TDwarfCompilationUnit.FullFileName(const AFileName: string): String; begin Result := AFileName; if FCompDir = '' then exit; @@ -3733,14 +3843,15 @@ begin Result := PDWarfLineMap(FLineNumberMap.Objects[idx]); end; -function TDwarfCompilationUnit.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; +function TDwarfCompilationUnit.GetLineAddresses(const AFileName: String; + ALine: Cardinal; var AResultList: TDBGPtrArray): boolean; var Map: PDWarfLineMap; begin - Result := 0; + Result := False; Map := GetLineAddressMap(AFileName); if Map = nil then exit; - Result := Map^.GetAddressForLine(ALine); + Result := Map^.GetAddressesForLine(ALine, AResultList); end; function TDwarfCompilationUnit.InitLocateAttributeList(AEntry: Pointer; diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 46b94aed1a..0235db3618 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -486,7 +486,7 @@ type function FindSymbol(const {%H-}AName: String): TFpDbgSymbol; virtual; deprecated; function FindSymbol({%H-}AAddress: TDbgPtr): TFpDbgSymbol; virtual; deprecated; property HasInfo: Boolean read FHasInfo; - function GetLineAddress(const {%H-}AFileName: String; {%H-}ALine: Cardinal): TDbgPtr; virtual; + function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean; virtual; //property MemManager: TFpDbgMemReaderBase read GetMemManager write SetMemManager; end; @@ -1379,9 +1379,10 @@ begin Result := nil; end; -function TDbgInfo.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; +function TDbgInfo.GetLineAddresses(const AFileName: String; ALine: Cardinal; + var AResultList: TDBGPtrArray): Boolean; begin - Result := 0; + Result := False; end; procedure TDbgInfo.SetHasInfo; diff --git a/components/fpdebug/fpdbgsymtablecontext.pas b/components/fpdebug/fpdbgsymtablecontext.pas index 640392233d..16195bb306 100644 --- a/components/fpdebug/fpdbgsymtablecontext.pas +++ b/components/fpdebug/fpdbgsymtablecontext.pas @@ -48,7 +48,6 @@ type function FindContext(AAddress: TDbgPtr): TFpDbgInfoContext; override; function FindSymbol(AAddress: TDbgPtr): TFpDbgSymbol; override; function FindSymbol(const AName: String): TFpDbgSymbol; override; - function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; override; property Image64Bit: boolean read FImage64Bit; end; @@ -147,10 +146,5 @@ begin //Result:=FContext.FindSymbol(AName); end; -function TFpSymbolInfo.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; -begin - Result:=inherited GetLineAddress(AFileName, ALine); -end; - end. diff --git a/components/fpdebug/fpdbgwinclasses.pas b/components/fpdebug/fpdbgwinclasses.pas index 5b145cb2a5..c7250d990c 100644 --- a/components/fpdebug/fpdbgwinclasses.pas +++ b/components/fpdebug/fpdbgwinclasses.pas @@ -71,8 +71,8 @@ type { TDbgWinBreakpoint } - TDbgWinBreakpointEvent = procedure(const ASender: TDbgBreakpoint; const AContext: TContext) of object; - TDbgWinBreakpoint = class(TDbgBreakpoint) + TDbgWinBreakpointEvent = procedure(const ASender: TFpInternalBreakpoint; const AContext: TContext) of object; + TDbgWinBreakpoint = class(TFpInternalBreakpoint) public procedure SetBreak; override; procedure ResetBreak; override; @@ -997,15 +997,21 @@ end; { TDbgWinBreakpoint } procedure TDbgWinBreakpoint.SetBreak; +var + a: TDBGPtr; begin inherited; - FlushInstructionCache(Process.Handle, Pointer(PtrUInt(Location)), 1); + for a in Location do + FlushInstructionCache(Process.Handle, Pointer(PtrUInt(a)), 1); end; procedure TDbgWinBreakpoint.ResetBreak; +var + a: TDBGPtr; begin inherited; - FlushInstructionCache(Process.Handle, Pointer(PtrUInt(Location)), 1); + for a in Location do + FlushInstructionCache(Process.Handle, Pointer(PtrUInt(a)), 1); end; { TDbgWinThread } diff --git a/components/lazdebuggergdbmi/gdbmidebugger.pp b/components/lazdebuggergdbmi/gdbmidebugger.pp index adaa7c5a5e..a1835616a0 100644 --- a/components/lazdebuggergdbmi/gdbmidebugger.pp +++ b/components/lazdebuggergdbmi/gdbmidebugger.pp @@ -1070,7 +1070,8 @@ type constructor Create(const ADebugger: TDebuggerIntf); destructor Destroy; override; function Count: Integer; override; - function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; override; + function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; override; + function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; function GetInfo({%H-}AAdress: TDbgPtr; out {%H-}ASource, {%H-}ALine, {%H-}AOffset: Integer): Boolean; override; function IndexOf(const ASource: String): integer; override; procedure Request(const ASource: String); override; @@ -7077,6 +7078,12 @@ begin Result := FSourceIndex.Count; end; +function TGDBMILineInfo.HasAddress(const AIndex: Integer; const ALine: Integer + ): Boolean; +begin + Result := GetAddress(AIndex, ALine) <> 0; +end; + function TGDBMILineInfo.GetSource(const AIndex: integer): String; begin if AIndex < Low(FSourceMaps) then Exit(''); diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index 5e1013bad9..88cb5b841a 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -83,7 +83,7 @@ type FDbgController: TDbgController; FFpDebugThread: TFpDebugThread; FQuickPause: boolean; - FRaiseExceptionBreakpoint: FpDbgClasses.TDBGBreakPoint; + FRaiseExceptionBreakpoint: TFpInternalBreakpoint; FDbgLogMessageList: TFPObjectList; FLogCritSection: TRTLCriticalSection; FMemConverter: TFpDbgMemConvertorLittleEndian; @@ -105,7 +105,7 @@ type function SetSoftwareExceptionBreakpoint: boolean; procedure HandleSoftwareException(out AnExceptionLocation: TDBGLocationRec; var continue: boolean); procedure FreeDebugThread; - procedure FDbgControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: FpDbgClasses.TDbgBreakpoint); + procedure FDbgControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: TFpInternalBreakpoint); procedure FDbgControllerCreateProcessEvent(var {%H-}continue: boolean); procedure FDbgControllerProcessExitEvent(AExitCode: DWord); procedure FDbgControllerExceptionEvent(var continue: boolean; const ExceptionClass, ExceptionMessage: string); @@ -152,9 +152,9 @@ type procedure DoPrepareCallStackEntryList; procedure DoFreeBreakpoint; {$endif linux} - function AddBreak(const ALocation: TDbgPtr): FpDbgClasses.TDbgBreakpoint; overload; - function AddBreak(const AFileName: String; ALine: Cardinal): FpDbgClasses.TDbgBreakpoint; overload; - procedure FreeBreakpoint(const ABreakpoint: FpDbgClasses.TDbgBreakpoint); + function AddBreak(const ALocation: TDbgPtr): TFpInternalBreakpoint; overload; + function AddBreak(const AFileName: String; ALine: Cardinal): TFpInternalBreakpoint; overload; + procedure FreeBreakpoint(const ABreakpoint: TFpInternalBreakpoint); function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; function ReadAddress(const AAdress: TDbgPtr; out AData: TDBGPtr): Boolean; procedure PrepareCallStackEntryList; @@ -186,7 +186,7 @@ type constructor Create(const ADebugger: TDebuggerIntf); destructor Destroy; override; function Count: Integer; override; - function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; override; + function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; override; function GetInfo({%H-}AAddress: TDbgPtr; out {%H-}ASource, {%H-}ALine, {%H-}AOffset: Integer): Boolean; override; function IndexOf(const ASource: String): integer; override; procedure Request(const ASource: String); override; @@ -253,7 +253,7 @@ type private FSetBreakFlag: boolean; FResetBreakFlag: boolean; - FInternalBreakpoint: FpDbgClasses.TDbgBreakpoint; + FInternalBreakpoint: FpDbgClasses.TFpInternalBreakpoint; FIsSet: boolean; procedure SetBreak; procedure ResetBreak; @@ -272,11 +272,11 @@ type FDelayedRemoveBreakpointList: TObjectList; protected procedure DoStateChange(const AOldState: TDBGState); override; - procedure AddBreakpointToDelayedRemoveList(ABreakpoint: FpDbgClasses.TDBGBreakPoint); + procedure AddBreakpointToDelayedRemoveList(ABreakpoint: FpDbgClasses.TFpInternalBreakpoint); public constructor Create(const ADebugger: TDebuggerIntf; const ABreakPointClass: TDBGBreakPointClass); destructor Destroy; override; - function Find(AIntBReakpoint: FpDbgClasses.TDbgBreakpoint): TDBGBreakPoint; + function Find(AIntBReakpoint: FpDbgClasses.TFpInternalBreakpoint): TDBGBreakPoint; end; procedure Register; @@ -670,7 +670,7 @@ end; procedure TFPBreakpoints.DoStateChange(const AOldState: TDBGState); var - ABrkPoint: FpDbgClasses.TDbgBreakpoint; + ABrkPoint: FpDbgClasses.TFpInternalBreakpoint; i: Integer; begin inherited DoStateChange(AOldState); @@ -679,8 +679,8 @@ begin if FDelayedRemoveBreakpointList.Count>0 then for i := FDelayedRemoveBreakpointList.Count-1 downto 0 do begin - ABrkPoint := FpDbgClasses.TDbgBreakpoint(FDelayedRemoveBreakpointList[i]); - TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(ABrkPoint.Location); + ABrkPoint := FpDbgClasses.TFpInternalBreakpoint(FDelayedRemoveBreakpointList[i]); + TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(ABrkPoint); TFpDebugDebugger(Debugger).FreeBreakpoint(ABrkPoint); ABrkPoint := nil; FDelayedRemoveBreakpointList.Delete(i); @@ -688,7 +688,7 @@ begin end; end; -procedure TFPBreakpoints.AddBreakpointToDelayedRemoveList(ABreakpoint: FpDbgClasses.TDBGBreakPoint); +procedure TFPBreakpoints.AddBreakpointToDelayedRemoveList(ABreakpoint: FpDbgClasses.TFpInternalBreakpoint); begin FDelayedRemoveBreakpointList.Add(ABreakpoint); end; @@ -705,7 +705,7 @@ begin inherited Destroy; end; -function TFPBreakpoints.Find(AIntBReakpoint: FpDbgClasses.TDbgBreakpoint): TDBGBreakPoint; +function TFPBreakpoints.Find(AIntBReakpoint: FpDbgClasses.TFpInternalBreakpoint): TDBGBreakPoint; var i: integer; begin @@ -718,8 +718,6 @@ begin result := nil; end; -{ TFPBreakpoint } - procedure TFPBreakpoint.SetBreak; begin assert(FInternalBreakpoint=nil); @@ -742,7 +740,7 @@ begin // freed. And so are the corresponding InternalBreakpoint's. if assigned(Debugger) and assigned(FInternalBreakpoint) then begin - TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(FInternalBreakpoint.Location); + TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(FInternalBreakpoint); TFpDebugDebugger(Debugger).FreeBreakpoint(FInternalBreakpoint); FInternalBreakpoint := nil; end; @@ -779,6 +777,7 @@ begin end else if Debugger.State = dsStop then begin + TFpDebugDebugger(Debugger).FreeBreakpoint(FInternalBreakpoint); FInternalBreakpoint := nil; FIsSet:=false; end; @@ -988,16 +987,18 @@ begin Result := FRequestedSources.Count; end; -function TFpLineInfo.GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; +function TFpLineInfo.HasAddress(const AIndex: Integer; const ALine: Integer + ): Boolean; var Map: PDWarfLineMap; + dummy: TDBGPtrArray; begin - Result := 0; + Result := False; 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); + Result := Map^.GetAddressesForLine(ALine, dummy, True); end; function TFpLineInfo.GetInfo(AAddress: TDbgPtr; out ASource, ALine, @@ -1129,6 +1130,7 @@ begin IncReleaseLock; try SetState(dsStop); + FreeAndNil(FRaiseExceptionBreakpoint); FreeDebugThread; finally DecReleaseLock; @@ -1484,7 +1486,8 @@ begin FFpDebugThread := nil; end; -procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: FpDbgClasses.TDbgBreakpoint); +procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent( + var continue: boolean; const Breakpoint: TFpInternalBreakpoint); var ABreakPoint: TDBGBreakPoint; ALocationAddr: TDBGLocationRec; @@ -1507,7 +1510,7 @@ begin end else if FQuickPause then begin - SetState(dsPause); + SetState(dsPause);//dsInternalPause; continue:=true; exit; end @@ -1537,7 +1540,7 @@ function TFpDebugDebugger.RequestCommand(const ACommand: TDBGCommand; var EvalFlags: TDBGEvaluateFlags; AConsoleTty: string; - addr: TDBGPtr; + addr: TDBGPtrArray; begin result := False; if assigned(FDbgController) then @@ -1612,9 +1615,8 @@ begin result := false; if FDbgController.CurrentProcess.DbgInfo.HasInfo then begin - addr := FDbgController.CurrentProcess.DbgInfo.GetLineAddress(AnsiString(AParams[0].VAnsiString), AParams[1].VInteger); - if addr <> 0 then - begin + if FDbgController.CurrentProcess.DbgInfo.GetLineAddresses(AnsiString(AParams[0].VAnsiString), AParams[1].VInteger, addr) + then begin result := true; FDbgController.InitializeCommand(TDbgControllerRunToCmd.Create(FDbgController, addr)); SetState(dsRun); @@ -1712,7 +1714,7 @@ begin FDbgController.SendEvents(Cont); // This may free the TFpDebugDebugger (self) - FQuickPause:=false; + FQuickPause:=false; // TODO: there may be other events: deInternalContinue, deLoadLibrary... if Cont then begin @@ -1782,7 +1784,8 @@ end; {$endif linux} -function TFpDebugDebugger.AddBreak(const ALocation: TDbgPtr): FpDbgClasses.TDbgBreakpoint; +function TFpDebugDebugger.AddBreak(const ALocation: TDbgPtr + ): TFpInternalBreakpoint; begin {$ifdef linux} FCacheLocation:=ALocation; @@ -1793,7 +1796,8 @@ begin {$endif linux} end; -function TFpDebugDebugger.AddBreak(const AFileName: String; ALine: Cardinal): FpDbgClasses.TDbgBreakpoint; +function TFpDebugDebugger.AddBreak(const AFileName: String; ALine: Cardinal + ): TFpInternalBreakpoint; begin {$ifdef linux} FCacheFileName:=AFileName; @@ -1805,7 +1809,8 @@ begin {$endif linux} end; -procedure TFpDebugDebugger.FreeBreakpoint(const ABreakpoint: FpDbgClasses.TDbgBreakpoint); +procedure TFpDebugDebugger.FreeBreakpoint( + const ABreakpoint: TFpInternalBreakpoint); begin {$ifdef linux} FCacheBreakpoint:=ABreakpoint; diff --git a/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp b/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp index a68da93e29..5fd0bfbfa7 100644 --- a/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp +++ b/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp @@ -197,7 +197,7 @@ type constructor Create(const ADebugger: TDebuggerIntf); destructor Destroy; override; function Count: Integer; override; - function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; override; + function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; 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; @@ -654,17 +654,19 @@ begin Result := FRequestedSources.Count; end; -function TFpGDBMILineInfo.GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; +function TFpGDBMILineInfo.HasAddress(const AIndex: Integer; const ALine: Integer + ): Boolean; var Map: PDWarfLineMap; + dummy: TDBGPtrArray; begin - Result := 0; + Result := False; 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); + Result := Map^.GetAddressesForLine(ALine, dummy, True); end; function TFpGDBMILineInfo.GetInfo(AAdress: TDbgPtr; out ASource, ALine, diff --git a/debugger/debugger.pp b/debugger/debugger.pp index b5bebc6aa5..096a704745 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -944,7 +944,7 @@ type procedure AddNotification(const ANotification: TIDELineInfoNotification); procedure RemoveNotification(const ANotification: TIDELineInfoNotification); function Count: Integer; override; - function GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; override; + function HasAddress(const AIndex: Integer; const ALine: Integer): Boolean; 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; @@ -6862,11 +6862,12 @@ begin else Result := Master.Count; end; -function TIDELineInfo.GetAddress(const AIndex: Integer; const ALine: Integer): TDbgPtr; +function TIDELineInfo.HasAddress(const AIndex: Integer; const ALine: Integer + ): Boolean; begin if Master = nil - then Result := inherited GetAddress(AIndex, ALine) - else Result := Master.GetAddress(AIndex, ALine); + then Result := inherited HasAddress(AIndex, ALine) + else Result := Master.HasAddress(AIndex, ALine); end; function TIDELineInfo.GetInfo(AAdress: TDbgPtr; out ASource, ALine, diff --git a/ide/sourceeditor.pp b/ide/sourceeditor.pp index 24120e6c22..d025a30a1c 100644 --- a/ide/sourceeditor.pp +++ b/ide/sourceeditor.pp @@ -5874,7 +5874,7 @@ procedure TSourceEditor.FillExecutionMarks; var ASource: String; i, idx: integer; - Addr: TDBGPtr; + HasAddr: Boolean; j: Integer; begin if EditorComponent.IDEGutterMarks.HasDebugMarks then Exit; @@ -5899,15 +5899,15 @@ begin try for i := 1 to EditorComponent.Lines.Count do begin - Addr := DebugBoss.LineInfo.GetAddress(idx, i); - if (Addr <> 0) and (j < 0) then + HasAddr := DebugBoss.LineInfo.HasAddress(idx, i); + if (HasAddr) and (j < 0) then j := i; - if (Addr = 0) and (j >= 0) then begin + if (not HasAddr) and (j >= 0) then begin EditorComponent.IDEGutterMarks.SetDebugMarks(j, i-1); j := -1; end; end; - if (Addr <> 0) and (j >= 0) then + if (HasAddr) and (j >= 0) then EditorComponent.IDEGutterMarks.SetDebugMarks(j, EditorComponent.Lines.Count); finally EditorComponent.IDEGutterMarks.EndSetDebugMarks;