paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 11:49:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

DebuggerIntf: In r49328 #ec422cddc6 the nestedprocvars modeswitch is used. Bug report #28306 shows that this does not work on win32-fpc 2.6.4. Probably a compiler bug. This patch avoids the use of nestedprocvars with fpc versions 2.x.x

Browse Source 
git-svn-id: trunk@49396 -
This commit is contained in:
joost 2015-06-21 18:10:51 +00:00
parent 0d184d1540
commit c20f70ce0c
3 changed files with 84 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
components/debuggerintf/dbgintfdebuggerbase.pp
View File

@ -32,7 +32,14 @@
unit DbgIntfDebuggerBase;
{$mode objfpc}{$H+}
{$modeswitch nestedprocvars}
{$ifndef VER2}
{$define disassemblernestedproc}
{$endif VER2}
{$ifdef disassemblernestedproc}
{$modeswitch nestedprocvars}
{$endif disassemblernestedproc}
interface
@ -1337,9 +1344,9 @@ type
{ TDBGDisassemblerRangeExtender }
TDoDisassembleRangeProc = function(AnEntryRanges: TDBGDisassemblerEntryMap; AFirstAddr, ALastAddr: TDisassemblerAddress; StopAfterAddress: TDBGPtr; StopAfterNumLines: Integer): Boolean is nested;
TDisassembleCancelProc = function(): Boolean is nested;
TDisassembleAdjustToKnowFunctionStart = function (var AStartAddr: TDisassemblerAddress): Boolean is nested;
TDoDisassembleRangeProc = function(AnEntryRanges: TDBGDisassemblerEntryMap; AFirstAddr, ALastAddr: TDisassemblerAddress; StopAfterAddress: TDBGPtr; StopAfterNumLines: Integer): Boolean {$ifdef disassemblernestedproc} is nested {$else} of object{$endif};
TDisassembleCancelProc = function(): Boolean {$ifdef disassemblernestedproc} is nested {$else} of object {$endif};
TDisassembleAdjustToKnowFunctionStart = function (var AStartAddr: TDisassemblerAddress): Boolean {$ifdef disassemblernestedproc} is nested {$else} of object {$endif};
TDBGDisassemblerRangeExtender = class
private

38
components/fpdebug/app/fpdserver/debugthreadcommand.pas
View File

@ -1,6 +1,14 @@
unit DebugThreadCommand;
{$mode objfpc}{$H+}{$modeswitch nestedprocvars}
{$mode objfpc}{$H+}
{$ifndef VER2}
{$define disassemblernestedproc}
{$endif VER2}
{$ifdef disassemblernestedproc}
{$modeswitch nestedprocvars}
{$endif disassemblernestedproc}
interface
@ -214,6 +222,12 @@ type
FLastEntryEndAddr: TDBGPtr;
function GetAddress: string;
procedure SetAddress(AValue: string);
{$ifndef disassemblernestedproc}
private
FController: TDbgController;
function OnAdjustToKnowFunctionStart(var AStartAddr: TDisassemblerAddress): Boolean;
function OnDoDisassembleRange(AnEntryRanges: TDBGDisassemblerEntryMap; AFirstAddr, ALastAddr: TDisassemblerAddress; AStopAfterAddress: TDBGPtr; AStopAfterNumLines: Integer): Boolean;
{$endif}
public
constructor Create(AListenerIdentifier: integer; AnUID: variant; AOnLog: TOnLog); override;
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
@ -374,13 +388,15 @@ begin
FLinesBefore:=5;
end;
{$ifdef disassemblernestedproc}
function TFpDebugThreadDisassembleCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
{$endif}
function OnAdjustToKnowFunctionStart(var AStartAddr: TDisassemblerAddress): Boolean;
function {$ifndef disassemblernestedproc}TFpDebugThreadDisassembleCommand.{$endif}OnAdjustToKnowFunctionStart(var AStartAddr: TDisassemblerAddress): Boolean;
var
Sym: TFpDbgSymbol;
begin
Sym := AController.CurrentProcess.FindSymbol(AStartAddr.GuessedValue);
Sym := {$ifndef disassemblernestedproc}FController{$else}AController{$endif}.CurrentProcess.FindSymbol(AStartAddr.GuessedValue);
if assigned(Sym) and (Sym.Kind in [skProcedure, skFunction]) then
begin
AStartAddr.Value:=Sym.Address.Address;
@ -392,7 +408,7 @@ function TFpDebugThreadDisassembleCommand.Execute(AController: TDbgController; o
result := false;
end;
function OnDoDisassembleRange(AnEntryRanges: TDBGDisassemblerEntryMap; AFirstAddr, ALastAddr: TDisassemblerAddress; AStopAfterAddress: TDBGPtr; AStopAfterNumLines: Integer): Boolean;
function {$ifndef disassemblernestedproc}TFpDebugThreadDisassembleCommand.{$endif}OnDoDisassembleRange(AnEntryRanges: TDBGDisassemblerEntryMap; AFirstAddr, ALastAddr: TDisassemblerAddress; AStopAfterAddress: TDBGPtr; AStopAfterNumLines: Integer): Boolean;
var
AnAddr: TDBGPtr;
@ -426,7 +442,7 @@ function TFpDebugThreadDisassembleCommand.Execute(AController: TDbgController; o
while ((AStopAfterAddress=0) or (AStopAfterNumLines > -1)) and (AnAddr <= ALastAddr.Value) do
begin
AnEntry.Addr:=AnAddr;
if not AController.CurrentProcess.ReadData(AnAddr, sizeof(CodeBin),CodeBin) then
if not {$ifndef disassemblernestedproc}FController{$else}AController{$endif}.CurrentProcess.ReadData(AnAddr, sizeof(CodeBin),CodeBin) then
begin
Log(Format('Disassemble: Failed to read memory at %s.', [FormatAddress(AnAddr)]), dllDebug);
AnEntry.Statement := 'Failed to read memory';
@ -435,9 +451,9 @@ function TFpDebugThreadDisassembleCommand.Execute(AController: TDbgController; o
else
begin
p := @CodeBin;
FpDbgDisasX86.Disassemble(p, AController.CurrentProcess.Mode=dm64, ADump, AStatement);
FpDbgDisasX86.Disassemble(p, {$ifndef disassemblernestedproc}FController{$else}AController{$endif}.CurrentProcess.Mode=dm64, ADump, AStatement);
Sym := AController.CurrentProcess.FindSymbol(AnAddr);
Sym := {$ifndef disassemblernestedproc}FController{$else}AController{$endif}.CurrentProcess.FindSymbol(AnAddr);
// If this is the last statement for this source-code-line, fill the
// SrcStatementCount from the prior statements.
@ -484,6 +500,10 @@ function TFpDebugThreadDisassembleCommand.Execute(AController: TDbgController; o
result := true;
end;
{$ifndef disassemblernestedproc}
function TFpDebugThreadDisassembleCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
{$endif disassemblernestedproc}
var
i: Integer;
DisassembleRangeExtender: TDBGDisassemblerRangeExtender;
@ -493,6 +513,10 @@ var
ARange: TDBGDisassemblerEntryRange;
begin
{$ifndef disassemblernestedproc}
FController := AController;
{$endif}
result := false;
DoProcessLoop:=false;
if not assigned(AController.CurrentProcess) then

63
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -33,7 +33,14 @@ unit GDBMIDebugger;
{$mode objfpc}
{$H+}
{$modeswitch nestedprocvars}
{$ifndef VER2}
{$define disassemblernestedproc}
{$endif VER2}
{$ifdef disassemblernestedproc}
{$modeswitch nestedprocvars}
{$endif disassemblernestedproc}
{$IFDEF linux} {$DEFINE DBG_ENABLE_TERMINAL} {$ENDIF}
@ -1425,6 +1432,14 @@ type
FRangeIterator: TDBGDisassemblerEntryMapIterator;
FMemDumpsNeeded: array of TGDBMIDisAssAddrRange;
procedure DoProgress;
{$ifndef disassemblernestedproc}
function AdjustToKnowFunctionStart(var AStartAddr: TDisassemblerAddress): Boolean;
function DoDisassembleRange(AnEntryRanges: TDBGDisassemblerEntryMap; AFirstAddr, ALastAddr: TDisassemblerAddress; StopAfterAddress: TDBGPtr; StopAfterNumLines: Integer): Boolean;
function ExecDisassmble(AStartAddr, AnEndAddr: TDbgPtr; WithSrc: Boolean;
AResultList: TGDBMIDisassembleResultList = nil;
ACutBeforeEndAddr: Boolean = False): TGDBMIDisassembleResultList;
function OnCheckCancel: boolean;
{$endif}
protected
function DoExecute: Boolean; override;
public
@ -3831,7 +3846,9 @@ begin
then FOnProgress(Self);
end;
{$ifdef disassemblernestedproc}
function TGDBMIDebuggerCommandDisassemble.DoExecute: Boolean;
{$endif}
const
TrustedValidity = [avFoundFunction, avFoundRange, avFoundStatement];
@ -3844,7 +3861,7 @@ function TGDBMIDebuggerCommandDisassemble.DoExecute: Boolean;
AnAddr.Offset := -1;
end;
function ExecDisassmble(AStartAddr, AnEndAddr: TDbgPtr; WithSrc: Boolean;
function {$ifndef disassemblernestedproc}TGDBMIDebuggerCommandDisassemble.{$endif}ExecDisassmble(AStartAddr, AnEndAddr: TDbgPtr; WithSrc: Boolean;
AResultList: TGDBMIDisassembleResultList = nil;
ACutBeforeEndAddr: Boolean = False): TGDBMIDisassembleResultList;
var
@ -3865,20 +3882,8 @@ function TGDBMIDebuggerCommandDisassemble.DoExecute: Boolean;
do Result.Count := Result.Count - 1;
end;
function ExecMemDump(AStartAddr: TDbgPtr; ACount: Cardinal;
AResultList: TGDBMIMemoryDumpResultList = nil): TGDBMIMemoryDumpResultList;
var
R: TGDBMIExecResult;
begin
Result := AResultList;
ExecuteCommand('-data-read-memory %u x 1 1 %u', [AStartAddr, ACount], R);
if Result <> nil
then Result.Init(R)
else Result := TGDBMIMemoryDumpResultList.Create(R);
end;
// Set Value, based on GuessedValue
function AdjustToKnowFunctionStart(var AStartAddr: TDisassemblerAddress): Boolean;
function {$ifndef disassemblernestedproc}TGDBMIDebuggerCommandDisassemble.{$endif}AdjustToKnowFunctionStart(var AStartAddr: TDisassemblerAddress): Boolean;
var
DisAssList: TGDBMIDisassembleResultList;
DisAssItm: PDisassemblerEntry;
@ -4094,7 +4099,7 @@ function TGDBMIDebuggerCommandDisassemble.DoExecute: Boolean;
*)
// Returns True: If some data was added
// False: if failed to add anything
function DoDisassembleRange(AnEntryRanges: TDBGDisassemblerEntryMap;AFirstAddr,
function {$ifndef disassemblernestedproc}TGDBMIDebuggerCommandDisassemble.{$endif}DoDisassembleRange(AnEntryRanges: TDBGDisassemblerEntryMap;AFirstAddr,
ALastAddr: TDisassemblerAddress; StopAfterAddress: TDBGPtr;
StopAfterNumLines: Integer): Boolean;
@ -4477,6 +4482,27 @@ function TGDBMIDebuggerCommandDisassemble.DoExecute: Boolean;
end;
end;
function {$ifndef disassemblernestedproc}TGDBMIDebuggerCommandDisassemble.{$endif}OnCheckCancel: boolean;
begin
result := dcsCanceled in SeenStates;
end;
{$ifndef disassemblernestedproc}
function TGDBMIDebuggerCommandDisassemble.DoExecute: Boolean;
{$endif disassemblernestedproc}
function ExecMemDump(AStartAddr: TDbgPtr; ACount: Cardinal;
AResultList: TGDBMIMemoryDumpResultList = nil): TGDBMIMemoryDumpResultList;
var
R: TGDBMIExecResult;
begin
Result := AResultList;
ExecuteCommand('-data-read-memory %u x 1 1 %u', [AStartAddr, ACount], R);
if Result <> nil
then Result.Init(R)
else Result := TGDBMIMemoryDumpResultList.Create(R);
end;
procedure AddMemDumps;
var
i: Integer;
@ -4504,11 +4530,6 @@ function TGDBMIDebuggerCommandDisassemble.DoExecute: Boolean;
FreeAndNil(MemDump);
end;
function OnCheckCancel: boolean;
begin
result := dcsCanceled in SeenStates;
end;
var
DisassembleRangeExtender: TDBGDisassemblerRangeExtender;
begin