mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-15 05:20:16 +02:00
LazDebuggerGdbmi: Step to finally/except for Win64 SEH
git-svn-id: trunk@62314 -
This commit is contained in:
martin
parent
44c48aaf97
commit
5cb2cd173d
@ -50,6 +50,7 @@ type
|
||||
|
||||
TGdbUnEscapeFlags = set of (uefOctal, uefTab, uefNewLine);
|
||||
|
||||
function IsSehFinallyFuncName(AName: String): Boolean;
|
||||
function GetLine(var ABuffer: String): String;
|
||||
function ConvertToCString(const AText: String): String;
|
||||
function ConvertPathDelims(const AFileName: String): String;
|
||||
@ -86,6 +87,14 @@ var
|
||||
LastSmartWritelnCount: integer;
|
||||
LastSmartWritelnTime: double;
|
||||
|
||||
function IsSehFinallyFuncName(AName: String): Boolean;
|
||||
var
|
||||
i: SizeInt;
|
||||
begin
|
||||
i := pos('fin$', AName);
|
||||
Result := (i > 0) and (i <= 3);
|
||||
end;
|
||||
|
||||
procedure SmartWriteln(const s: string);
|
||||
var
|
||||
TimeDiff: TTimeStamp;
|
||||
|
||||
@ -87,7 +87,8 @@ type
|
||||
cfNoTimeoutWarning,
|
||||
//used for old commands, TGDBMIDebuggerSimpleCommand.Create
|
||||
cfscIgnoreState, // ignore the result state of the command
|
||||
cfscIgnoreError // ignore errors
|
||||
cfscIgnoreError, // ignore errors
|
||||
cfNoMemLimits // do not apply either mem limit
|
||||
);
|
||||
TGDBMICommandFlags = set of TGDBMICommandFlag;
|
||||
|
||||
@ -507,10 +508,14 @@ type
|
||||
function GetInstanceClassName(const AInstance: TDBGPtr): String; overload;
|
||||
function GetInstanceClassName(const AExpression: String; const AValues: array of const): String; overload;
|
||||
function GetData(const ALocation: TDbgPtr): TDbgPtr; overload;
|
||||
function GetWordData(const ALocation: TDbgPtr): TDbgPtr; overload;
|
||||
function GetDWordData(const ALocation: TDbgPtr): TDbgPtr; overload;
|
||||
function GetData(const AExpression: String; const AValues: array of const): TDbgPtr; overload;
|
||||
function GetStrValue(const AExpression: String; const AValues: array of const): String;
|
||||
function GetStrValue(const AExpression: String; const AValues: array of const; AFlags: TGDBMICommandFlags = []): String;
|
||||
function GetIntValue(const AExpression: String; const AValues: array of const): Integer;
|
||||
function GetPtrValue(const AExpression: String; const AValues: array of const; {%H-}ConvertNegative: Boolean = False): TDbgPtr;
|
||||
function GetPtrValue(const AExpression: String;
|
||||
const AValues: array of const; {%H-}ConvertNegative: Boolean = False;
|
||||
AFlags: TGDBMICommandFlags = []): TDbgPtr;
|
||||
function CheckHasType(TypeName: String; TypeFlag: TGDBMITargetFlag): TGDBMIExecResult;
|
||||
function PointerTypeCast: string;
|
||||
function FrameToLocation(const AFrame: String = ''): TDBGLocationRec;
|
||||
@ -695,6 +700,7 @@ type
|
||||
FStepBreakPoint: Integer;
|
||||
FInitialFP: TDBGPtr;
|
||||
FStepOverFixNeeded: (sofNotNeeded, sofStepAgain, sofStepOut);
|
||||
FStepStartedInFinSub: (sfsNone, sfsStepStarted, sfsStepExited);
|
||||
protected
|
||||
procedure DoLockQueueExecute; override;
|
||||
procedure DoUnLockQueueExecute; override;
|
||||
@ -795,31 +801,47 @@ type
|
||||
|
||||
TGDBMIInternalAddrBreakPointList = class
|
||||
private type
|
||||
|
||||
{ TGDBMIInternalAddrBreakPointListEntry }
|
||||
|
||||
TGDBMIInternalAddrBreakPointListEntry = record
|
||||
FAddr: TDBGPtr;
|
||||
FId: Integer;
|
||||
FCount: Integer;
|
||||
FBasePointer: Array of TDBGPtr;
|
||||
class Operator =(a,b:TGDBMIInternalAddrBreakPointListEntry)c:Boolean;
|
||||
procedure AddBasePointer(ABp: TDBGPtr);
|
||||
function IndexOfBasePointer(ABp: TDBGPtr): integer;
|
||||
procedure DeleteBasePointer(AnIndex: Integer);
|
||||
end;
|
||||
TBPEntryList = specialize TFPGList<TGDBMIInternalAddrBreakPointListEntry>;
|
||||
|
||||
{ TBPEntryList }
|
||||
|
||||
TBPEntryList = class(specialize TFPGList<TGDBMIInternalAddrBreakPointListEntry>);
|
||||
private
|
||||
FList: TBPEntryList;
|
||||
function IndexOfAddr(AnAddr: TDBGPtr): Integer;
|
||||
function IndexOfId(AnId: integer): Integer;
|
||||
procedure RemoveIndex(ACmd: TGDBMIDebuggerCommand; AnIndex: Integer);
|
||||
function SetBreak(ACmd: TGDBMIDebuggerCommand; AnAddr: TDBGPtr): Integer; virtual;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure AddAddr(ACmd: TGDBMIDebuggerCommand; AnAddr: TDBGPtr);
|
||||
procedure AddAddr(ACmd: TGDBMIDebuggerCommand; AnAddr: TDBGPtr; ABasePtr: TDBGPtr = 0);
|
||||
procedure RemoveAddr(ACmd: TGDBMIDebuggerCommand; AnAddr: TDBGPtr);
|
||||
procedure RemoveId(ACmd: TGDBMIDebuggerCommand; AnId: Integer);
|
||||
procedure RemoveFrameFromId(ACmd: TGDBMIDebuggerCommand; AnId: Integer; ABasePtr: TDBGPtr);
|
||||
function IndexOfAddrWithFrame(AnAddr: TDBGPtr; ABasePtr: TDBGPtr): Integer;
|
||||
procedure ClearAll(ACmd: TGDBMIDebuggerCommand);
|
||||
function HasBreakId(AnId: Integer): boolean;
|
||||
end;
|
||||
|
||||
{ TGDBMIInternalSehFinallyBreakPointList }
|
||||
|
||||
TGDBMIInternalSehFinallyBreakPointList = class(TGDBMIInternalAddrBreakPointList)
|
||||
private
|
||||
function SetBreak(ACmd: TGDBMIDebuggerCommand; AnAddr: TDBGPtr): Integer; override;
|
||||
end;
|
||||
|
||||
{ TGDBMIWatches }
|
||||
|
||||
TGDBMIDebuggerParentFrameCache = record
|
||||
@ -884,10 +906,10 @@ type
|
||||
FRunErrorBreak: TGDBMIInternalBreakPoint;
|
||||
FExceptionBreak: TGDBMIInternalBreakPoint;
|
||||
FPopExceptStack, FCatchesBreak, FReRaiseBreak: TGDBMIInternalBreakPoint;
|
||||
FRtlUnwindExBreak: TGDBMIInternalBreakPoint; // SEH, win64
|
||||
FSehRaiseBreaks: TGDBMIInternalAddrBreakPointList;
|
||||
FRtlUnwindExBreak, FFpcSpecificHandler, FFpcSpecificHandlerCallFin: TGDBMIInternalBreakPoint; // SEH, win64
|
||||
FSehFinallyBreaks, FSehCatchesBreaks: TGDBMIInternalAddrBreakPointList;
|
||||
FPauseWaitState: TGDBMIPauseWaitState;
|
||||
FStoppedReason: (srNone, srRaiseExcept, srReRaiseExcept, srPopExceptStack, srCatches, srRtlUnwind, srSehCatches);
|
||||
FStoppedReason: (srNone, srRaiseExcept, srReRaiseExcept, srPopExceptStack, srCatches, srRtlUnwind, srSehFpcSpecificHndl, srSeh64CallFinally, srSehFinally, srSehCatches);
|
||||
FInExecuteCount: Integer;
|
||||
FInIdle: Boolean;
|
||||
FRunQueueOnUnlock: Boolean;
|
||||
@ -1104,9 +1126,12 @@ type
|
||||
TGDBMIMemoryDumpResultList = class(TGDBMINameValueBasedList)
|
||||
private
|
||||
FAddr: TDBGPtr;
|
||||
function GetDWordAtIdx(Index: Integer): Cardinal;
|
||||
function GetItem(Index: Integer): TPCharWithLen;
|
||||
function GetItemNum(Index: Integer): Integer;
|
||||
function GetItemTxt(Index: Integer): string;
|
||||
function GetQWordAtIdx(Index: Integer): Cardinal;
|
||||
function GetWordAtIdx(Index: Integer): Cardinal;
|
||||
protected
|
||||
procedure PreParse; override;
|
||||
public
|
||||
@ -1115,6 +1140,9 @@ type
|
||||
property Item[Index: Integer]: TPCharWithLen read GetItem;
|
||||
property ItemTxt[Index: Integer]: string read GetItemTxt;
|
||||
property ItemNum[Index: Integer]: Integer read GetItemNum;
|
||||
property WordAtIdx[Index: Integer]: Cardinal read GetWordAtIdx;
|
||||
property DWordAtIdx[Index: Integer]: Cardinal read GetDWordAtIdx;
|
||||
property QWordAtIdx[Index: Integer]: Cardinal read GetQWordAtIdx;
|
||||
property Addr: TDBGPtr read FAddr;
|
||||
function AsText(AStartOffs, ACount: Integer; AAddrWidth: Integer): string;
|
||||
end;
|
||||
@ -2162,7 +2190,10 @@ begin
|
||||
FTheDebugger.FCatchesBreak.Clear(Self);
|
||||
FTheDebugger.FReRaiseBreak.Clear(Self);
|
||||
FTheDebugger.FRtlUnwindExBreak.Clear(Self);
|
||||
FTheDebugger.FSehRaiseBreaks.ClearAll(Self);
|
||||
FTheDebugger.FFpcSpecificHandlerCallFin.Clear(Self);
|
||||
FTheDebugger.FFpcSpecificHandler.Clear(Self);
|
||||
FTheDebugger.FSehFinallyBreaks.ClearAll(Self);
|
||||
FTheDebugger.FSehCatchesBreaks.ClearAll(Self);
|
||||
if DebuggerState = dsError then Exit;
|
||||
end;
|
||||
|
||||
@ -4192,6 +4223,12 @@ begin
|
||||
Result := FNameValueList.Items[Index]^.Name;
|
||||
end;
|
||||
|
||||
function TGDBMIMemoryDumpResultList.GetDWordAtIdx(Index: Integer): Cardinal;
|
||||
begin
|
||||
// TODO: currently only LittleEndian
|
||||
Result := WordAtIdx[Index] + (WordAtIdx[Index+2] << 16);
|
||||
end;
|
||||
|
||||
function TGDBMIMemoryDumpResultList.GetItemTxt(Index: Integer): string;
|
||||
var
|
||||
itm: PGDBMINameValue;
|
||||
@ -4202,6 +4239,18 @@ begin
|
||||
else Result := '';
|
||||
end;
|
||||
|
||||
function TGDBMIMemoryDumpResultList.GetQWordAtIdx(Index: Integer): Cardinal;
|
||||
begin
|
||||
// TODO: currently only LittleEndian
|
||||
Result := DWordAtIdx[Index] + (DWordAtIdx[Index+4] << 32);
|
||||
end;
|
||||
|
||||
function TGDBMIMemoryDumpResultList.GetWordAtIdx(Index: Integer): Cardinal;
|
||||
begin
|
||||
// TODO: currently only LittleEndian
|
||||
Result := ItemNum[Index] + (ItemNum[Index+1] << 8);
|
||||
end;
|
||||
|
||||
procedure TGDBMIMemoryDumpResultList.PreParse;
|
||||
begin
|
||||
FNameValueList.SetPath('memory');
|
||||
@ -5591,6 +5640,8 @@ begin
|
||||
FTheDebugger.FExceptionBreak.SetByAddrMethod := DbgProp.InternalExceptionBrkSetMethod;
|
||||
FTheDebugger.FPopExceptStack.SetByAddrMethod := DbgProp.InternalExceptionBrkSetMethod;
|
||||
FTheDebugger.FRtlUnwindExBreak.SetByAddrMethod := DbgProp.InternalExceptionBrkSetMethod;
|
||||
FTheDebugger.FFpcSpecificHandlerCallFin.SetByAddrMethod := ibmAddrDirect;
|
||||
FTheDebugger.FFpcSpecificHandler.SetByAddrMethod := ibmAddrIndirect; // must be at first asm line
|
||||
|
||||
{$IFdef WITH_GDB_FORCE_EXCEPTBREAK}
|
||||
FTheDebugger.FExceptionBreak.SetByAddr(Self, True);
|
||||
@ -5611,6 +5662,8 @@ begin
|
||||
then
|
||||
Include(FTheDebugger.FDebuggerFlags, dfSetBreakFailed);
|
||||
|
||||
FTheDebugger.FRtlUnwindExBreak.EnableOrSetByAddr(Self);
|
||||
|
||||
SetDebuggerState(dsInit); // triggers all breakpoints to be set.
|
||||
FTheDebugger.RunQueue; // run all the breakpoints
|
||||
Application.ProcessMessages; // workaround, allow source-editor to queue line info request (Async call)
|
||||
@ -5868,6 +5921,8 @@ begin
|
||||
if ieRunErrorBreakPoint in TGDBMIDebuggerPropertiesBase(FTheDebugger.GetProperties).InternalExceptionBreakPoints
|
||||
then FTheDebugger.FRunErrorBreak.SetByAddr(Self);
|
||||
|
||||
FTheDebugger.FRtlUnwindExBreak.EnableOrSetByAddr(Self);
|
||||
|
||||
if not(DebuggerState in [dsPause]) then
|
||||
SetDebuggerState(dsPause);
|
||||
ProcessFrame; // Includes DoLocation
|
||||
@ -6264,6 +6319,21 @@ function TGDBMIDebuggerCommandExecute.ProcessStopped(const AParams: String;
|
||||
FStepOverFixNeeded := sofStepAgain;
|
||||
end;
|
||||
|
||||
procedure CheckSehFinallyExited(const AFrame: String);
|
||||
var
|
||||
Location: TDBGLocationRec;
|
||||
begin
|
||||
if not (FStepStartedInFinSub = sfsStepStarted) then
|
||||
exit;
|
||||
Location := FrameToLocation(AFrame);
|
||||
|
||||
if IsSehFinallyFuncName(FTheDebugger.FCurrentLocation.FuncName) then // check if we left the seh handler
|
||||
exit;
|
||||
|
||||
Result := True;
|
||||
FStepStartedInFinSub := sfsStepExited;
|
||||
end;
|
||||
|
||||
procedure ProcessBreakPoint(ABreakId: Integer; const List: TGDBMINameValueList;
|
||||
AReason: TGDBMIBreakpointReason; AOldVal: String = ''; ANewVal: String = '');
|
||||
var
|
||||
@ -6375,6 +6445,7 @@ var
|
||||
List, List2: TGDBMINameValueList;
|
||||
Reason: String;
|
||||
BreakID: Integer;
|
||||
Addr: TDBGPtr;
|
||||
CanContinue: Boolean;
|
||||
i: Integer;
|
||||
s: String;
|
||||
@ -6528,10 +6599,33 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if FTheDebugger.FSehRaiseBreaks.HasBreakId(BreakID)
|
||||
if FTheDebugger.FFpcSpecificHandler.MatchId(BreakID)
|
||||
then begin
|
||||
FTheDebugger.FStoppedReason := srSehFpcSpecificHndl;
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if FTheDebugger.FFpcSpecificHandlerCallFin.MatchId(BreakID)
|
||||
then begin
|
||||
FTheDebugger.FStoppedReason := srSeh64CallFinally;
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if FTheDebugger.FSehFinallyBreaks.HasBreakId(BreakID)
|
||||
then begin
|
||||
FTheDebugger.FStoppedReason := srSehFinally;
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if FTheDebugger.FSehCatchesBreaks.HasBreakId(BreakID)
|
||||
then begin
|
||||
FTheDebugger.FStoppedReason := srSehCatches;
|
||||
FTheDebugger.FSehRaiseBreaks.RemoveId(Self, BreakID);
|
||||
// no context, as this is always the current context
|
||||
Addr := GetPtrValue('$sp', [], False, [cfNoThreadContext, cfNoStackContext]);
|
||||
FTheDebugger.FSehCatchesBreaks.RemoveFrameFromId(Self, BreakID, Addr);
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
@ -6557,14 +6651,19 @@ begin
|
||||
|
||||
if Reason = 'function-finished'
|
||||
then begin
|
||||
SetDebuggerState(dsPause);
|
||||
ProcessFrame(List.Values['frame'], False);
|
||||
CheckSehFinallyExited(List.Values['frame']);
|
||||
if not Result then begin
|
||||
SetDebuggerState(dsPause);
|
||||
ProcessFrame(List.Values['frame'], False);
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Reason = 'end-stepping-range'
|
||||
then begin
|
||||
CheckIncorrectStepOver;
|
||||
if not Result then
|
||||
CheckSehFinallyExited(List.Values['frame']);
|
||||
if not Result then begin
|
||||
SetDebuggerState(dsPause);
|
||||
ProcessFrame(List.Values['frame'], False);
|
||||
@ -6807,10 +6906,13 @@ const
|
||||
FTheDebugger.FPopExceptStack.EnableOrSetByAddr(Self, True);
|
||||
FTheDebugger.FCatchesBreak.EnableOrSetByAddr(Self, True);
|
||||
end;
|
||||
procedure EnableRtlUnwind; inline;
|
||||
procedure EnableFpcSpecificHandler; inline;
|
||||
begin
|
||||
if TargetInfo^.TargetOS = osWindows then
|
||||
FTheDebugger.FRtlUnwindExBreak.EnableOrSetByAddr(Self);
|
||||
if TargetInfo^.TargetOS = osWindows then begin
|
||||
if TargetInfo^.TargetPtrSize = 8 then begin // 64 bit SEH only
|
||||
FTheDebugger.FFpcSpecificHandler.EnableOrSetByAddr(Self);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
procedure DisablePopCatches; inline;
|
||||
begin
|
||||
@ -6818,10 +6920,92 @@ const
|
||||
FTheDebugger.FCatchesBreak.Disable(Self);
|
||||
end;
|
||||
|
||||
(* PARSE __FPC_specific_handler // Win, 64 bit only
|
||||
RCX => var rec: TExceptionRecord;
|
||||
RDX => frame: Pointer;
|
||||
R8 => var context: TCONTEXT;
|
||||
R9 => var dispatch: TDispatcherContext
|
||||
*)
|
||||
function GetFinallyBasePtr: TDbgPtr; // AT __FPC_specific_handler
|
||||
begin
|
||||
// RPB at finally
|
||||
Result := GetPtrValue(
|
||||
Format('^%s($r8+160)^', [PointerTypeCast]), // 56 = TargetInfo^.TargetPtrSize * 7
|
||||
[]);
|
||||
end;
|
||||
|
||||
procedure GetFinallyBreakPoints64; // AT __FPC_specific_handler
|
||||
const MaxFinallyHandlerCnt = 256; // more finally in a single proc is not probable....
|
||||
var
|
||||
HData, Cnt, IBase, Typ, Addr: TDBGPtr;
|
||||
i: Integer;
|
||||
R: TGDBMIExecResult;
|
||||
MemDump: TGDBMIMemoryDumpResultList;
|
||||
begin
|
||||
(*
|
||||
skip if
|
||||
if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
|
||||
'^%s($rcx+4)^' and $66 = 0
|
||||
*)
|
||||
HData := GetPtrValue(
|
||||
Format('^%s($r9+56)^', [PointerTypeCast]), // 56 = TargetInfo^.TargetPtrSize * 7
|
||||
[]);
|
||||
if HData = 0 then
|
||||
exit;
|
||||
Cnt := GetDWordData(HData);
|
||||
if (Cnt = 0) or (Cnt > MaxFinallyHandlerCnt) then
|
||||
exit;
|
||||
|
||||
IBase := GetPtrValue( Format('^%s($r9+8)^', [PointerTypeCast]), []); // ImageBase
|
||||
|
||||
HData := HData + 4;
|
||||
if not ExecuteCommand('-data-read-memory %u x 1 1 %u', [HData, Cnt*16], R, [cfNoThreadContext, cfNoStackContext, cfNoMemLimits])
|
||||
then
|
||||
exit;
|
||||
if R.State = dsError then exit;
|
||||
|
||||
MemDump := TGDBMIMemoryDumpResultList.Create(R);
|
||||
if MemDump.Count <> Cnt*16 then begin
|
||||
MemDump.Free;
|
||||
exit;
|
||||
end;
|
||||
|
||||
for i := 0 to Integer(Cnt) - 1 do begin
|
||||
Typ := MemDump.DWordAtIdx[i*16]; // GetDWordData(HData);
|
||||
// if (Typ <> 0) and (Typ <> 1) then
|
||||
if (Typ <> 0) then
|
||||
Continue;
|
||||
|
||||
Addr := MemDump.DWordAtIdx[i*16+12]; // GetDWordData(HData+12);
|
||||
// todo line info
|
||||
if Addr = 0 then
|
||||
break;
|
||||
|
||||
{$PUSH}{$Q-}
|
||||
FTheDebugger.FSehFinallyBreaks.AddAddr(Self, IBase + Addr);
|
||||
|
||||
HData := HData + 16; // sizeof(TScopeRec)
|
||||
{$POP}
|
||||
end;
|
||||
|
||||
MemDump.Free;
|
||||
end;
|
||||
|
||||
var
|
||||
FP: TDBGPtr;
|
||||
CurThreadId: Integer;
|
||||
|
||||
function GetCurrentFp: TDBGPtr;
|
||||
begin
|
||||
FContext.ThreadContext := ccUseLocal;
|
||||
FContext.StackContext := ccUseLocal;
|
||||
FContext.StackFrame := 0;
|
||||
FContext.ThreadId := CurThreadId;
|
||||
Result := GetPtrValue('$fp', []);
|
||||
FContext.ThreadContext := ccNotRequired;
|
||||
FContext.StackContext := ccNotRequired;
|
||||
end;
|
||||
|
||||
function DoContinueStepping: Boolean;
|
||||
procedure DoEndStepping;
|
||||
begin
|
||||
@ -6836,55 +7020,96 @@ var
|
||||
var
|
||||
cnt, i: Integer;
|
||||
R: TGDBMIExecResult;
|
||||
Address: TDBGPtr;
|
||||
Address, FrameAddr: TDBGPtr;
|
||||
MemDump: TGDBMIMemoryDumpResultList;
|
||||
begin
|
||||
// TODO: an exception can skip the step-end breakpoint....
|
||||
// TODO: the "break" breakpoint can stop on the current, instead of the next instruction
|
||||
|
||||
Result := False;
|
||||
|
||||
// Did we just leave an SEH finally block?
|
||||
if (FStepStartedInFinSub = sfsStepExited) and (FTheDebugger.FStoppedReason = srNone) then begin
|
||||
// run to next finally
|
||||
if ExecuteCommand('-data-read-memory $pc-2 x 1 1 2', [], R, [cfNoThreadContext, cfNoStackContext, cfNoMemLimits]) and
|
||||
(r.State <> dsError)
|
||||
then begin
|
||||
MemDump := TGDBMIMemoryDumpResultList.Create(R);
|
||||
if (MemDump.Count = 2) and
|
||||
// check for known signature => depends on generated code => more code signatures can be added, if needed
|
||||
(* ffd0 callq *%rax *)
|
||||
(MemDump.WordAtIdx[0] = $d0ff)
|
||||
then begin
|
||||
FTheDebugger.FFpcSpecificHandlerCallFin.Clear(Self);
|
||||
FTheDebugger.FFpcSpecificHandlerCallFin.SetAtCustomAddr(Self, MemDump.Addr);
|
||||
end;
|
||||
MemDump.Free;
|
||||
end;
|
||||
|
||||
FStepStartedInFinSub := sfsNone;
|
||||
FCurrentExecCmd := ectContinue;
|
||||
EnableFpcSpecificHandler;
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// RtlUnwind, set a breakpoint at next except handler (instead of srPopExceptStack/srCatches)
|
||||
if FTheDebugger.FStoppedReason = srRtlUnwind then begin
|
||||
case FTheDebugger.FStoppedReason of
|
||||
srRtlUnwind: begin
|
||||
FrameAddr := GetPtrValue(TargetInfo^.TargetRegisters[r0], []); // RSP at "except"
|
||||
Address := GetPtrValue(TargetInfo^.TargetRegisters[r1], []);
|
||||
if Address <> 0 then
|
||||
FTheDebugger.FSehRaiseBreaks.AddAddr(Self, Address);
|
||||
if (Address <> 0) and (FrameAddr <> 0) and
|
||||
(FTheDebugger.FSehCatchesBreaks.IndexOfAddrWithFrame(Address, FrameAddr) < 0)
|
||||
then
|
||||
FTheDebugger.FSehCatchesBreaks.AddAddr(Self, Address, FrameAddr);
|
||||
FCurrentExecCmd := ectContinue;
|
||||
Result := True;
|
||||
|
||||
// because we can get more exceptions in finally blocks
|
||||
// TODO: remove if finally blocks are entered
|
||||
if RunMode = rmStepToFinally then
|
||||
FTheDebugger.FRtlUnwindExBreak.Disable(Self);
|
||||
exit;
|
||||
end;
|
||||
// SEH
|
||||
srSehCatches, srSehFinally: begin
|
||||
DoEndStepping;
|
||||
exit;
|
||||
end;
|
||||
srSeh64CallFinally: begin
|
||||
FInitialFP := 0; // prevent FixIncorrectStepOver from stepping out
|
||||
FCurrentExecCmd := ectStepInto;
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// F7 or F8 was used in raise exception, stop at next finally or except handler
|
||||
// ecContinue has stopped
|
||||
if RunMode = rmStepToFinally then begin
|
||||
if FTheDebugger.FStoppedReason in [srRaiseExcept, srReRaiseExcept] then begin
|
||||
// should not happen, but with SEH it can happen in finally blocks => continue to except handler
|
||||
FCurrentExecCmd := ectContinue;
|
||||
Result := True;
|
||||
exit;
|
||||
case FTheDebugger.FStoppedReason of
|
||||
srRaiseExcept, srReRaiseExcept: begin
|
||||
// should not happen, but with SEH it can happen in finally blocks => continue to except handler
|
||||
FCurrentExecCmd := ectContinue;
|
||||
Result := True;
|
||||
end;
|
||||
// NONE SEH (if SEH falls through, it will pause as it is not an Pop/Catches)
|
||||
// if NOT at srPopExceptStack/srCatches then ecStepOut should have finished => dsPause
|
||||
srPopExceptStack, srCatches: begin
|
||||
Result := True;
|
||||
FCurrentExecCmd := ectStepOut;
|
||||
end;
|
||||
srSehFpcSpecificHndl: begin
|
||||
GetFinallyBreakPoints64;
|
||||
FInitialFP := 0; // prevent FixIncorrectStepOver from stepping out
|
||||
FCurrentExecCmd := ectContinue;
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
// SEH
|
||||
if FTheDebugger.FStoppedReason = srSehCatches then begin
|
||||
DoEndStepping;
|
||||
exit;
|
||||
end;
|
||||
// NONE SEH (if SEH falls through, it will pause as it is not an Pop/Catches)
|
||||
// if NOT at srPopExceptStack/srCatches then ecStepOut should have finished => dsPause
|
||||
Result := FTheDebugger.FStoppedReason in [srPopExceptStack, srCatches];
|
||||
if Result then
|
||||
FCurrentExecCmd := ectStepOut;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// Not stepping to finally
|
||||
case FTheDebugger.FStoppedReason of
|
||||
// reraise is only enabled while stepping, so no need to check
|
||||
srReRaiseExcept: begin
|
||||
EnablePopCatches;
|
||||
EnableRtlUnwind;
|
||||
EnableFpcSpecificHandler;
|
||||
FCurrentExecCmd := ectContinue;
|
||||
Result := True;
|
||||
exit;
|
||||
@ -6893,15 +7118,28 @@ var
|
||||
if (FExecType in [ectStepOver, ectStepOverInstruction, ectStepOut, ectStepInto]) // ectRunTo
|
||||
then begin
|
||||
EnablePopCatches;
|
||||
EnableRtlUnwind;
|
||||
EnableFpcSpecificHandler;
|
||||
// Continue below => set a breakpoint at the end of the intended stepping range
|
||||
end;
|
||||
// Check the stackframe, if the "current" function has been exited
|
||||
srSehFpcSpecificHndl: begin
|
||||
FrameAddr := GetFinallyBasePtr;
|
||||
if (FrameAddr <> 0) and (FrameAddr >= FInitialFP) then begin
|
||||
GetFinallyBreakPoints64;
|
||||
end;
|
||||
FCurrentExecCmd := ectContinue;
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
srSehCatches: begin
|
||||
i := FindStackFrame(Fp, 0, 1); // -2 already stepped out of the desired frame, enter dsPause
|
||||
if (i = 0) or (i = -2) then begin
|
||||
FrameAddr := GetCurrentFp;
|
||||
if (FrameAddr = 0) or (FrameAddr >= FInitialFP) then begin
|
||||
DoEndStepping;
|
||||
exit;
|
||||
end;
|
||||
FCurrentExecCmd := ectContinue;
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
// Check the stackframe, if the "current" function has been exited
|
||||
srPopExceptStack, srCatches: begin
|
||||
@ -6915,6 +7153,7 @@ var
|
||||
end;
|
||||
end;
|
||||
|
||||
// should be srRaiseExcept;
|
||||
case FExecType of
|
||||
ectContinue, ectRun:
|
||||
begin
|
||||
@ -6963,14 +7202,17 @@ var
|
||||
then inc(i);
|
||||
end;
|
||||
|
||||
if (i = 0) or (i = -2) // -2 already stepped out of the desired frame, enter dsPause
|
||||
if (i = 0) or (i = -2) // -2 already stepped out of the desired frame => NO FStepBreakPoint
|
||||
then begin
|
||||
DoEndStepping;
|
||||
Result := True;
|
||||
FCurrentExecCmd := ectContinue;
|
||||
FCurrentExecArg := '';
|
||||
if FTheDebugger.FStoppedReason <> srRaiseExcept then DoEndStepping; // should not be needed...
|
||||
exit;
|
||||
end;
|
||||
|
||||
if i > 0
|
||||
then begin
|
||||
then begin // set FStepBreakPoint
|
||||
// TODO: move to queue
|
||||
// must use none gdbmi commands
|
||||
FContext.ThreadContext := ccUseGlobal;
|
||||
@ -7012,17 +7254,6 @@ var
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetCurrentFp: TDBGPtr;
|
||||
begin
|
||||
FContext.ThreadContext := ccUseLocal;
|
||||
FContext.StackContext := ccUseLocal;
|
||||
FContext.StackFrame := 0;
|
||||
FContext.ThreadId := CurThreadId;
|
||||
Result := GetPtrValue('$fp', []);
|
||||
FContext.ThreadContext := ccNotRequired;
|
||||
FContext.StackContext := ccNotRequired;
|
||||
end;
|
||||
|
||||
function DoExecCommand(AnExecCmd: TGDBMIExecCommandType; AnExecArg: String): Boolean;
|
||||
var
|
||||
UseMI: Boolean;
|
||||
@ -7084,9 +7315,9 @@ var
|
||||
DisAsm: TGDBMIDisassembleResultList;
|
||||
i: Integer;
|
||||
begin
|
||||
if (FExecType <> ectStepOver) or
|
||||
if (not (FExecType in [ectStepOver, ectStepInto, ectStepOut])) or
|
||||
(TargetInfo^.TargetOS <> osWindows) or
|
||||
(FTheDebugger.FRtlUnwindExBreak.GetInfoAddr(Self) = 0)
|
||||
(not FTheDebugger.FRtlUnwindExBreak.Enabled)
|
||||
then
|
||||
exit;
|
||||
if (not ExecuteCommand('-data-disassemble -s $pc -e $pc+12 -- 0', [], R)) or
|
||||
@ -7096,6 +7327,13 @@ var
|
||||
|
||||
DisAsm := TGDBMIDisassembleResultList.Create(R);
|
||||
try
|
||||
if (FExecType in [ectStepOver, ectStepInto, ectStepOut]) and
|
||||
IsSehFinallyFuncName(DisAsm.Item[0]^.FuncName)
|
||||
then begin
|
||||
FStepStartedInFinSub := sfsStepStarted;
|
||||
EnableFpcSpecificHandler;
|
||||
end;
|
||||
|
||||
i := 0;
|
||||
if (DisAsm.Count > i) and (DisAsm.Item[i]^.Statement = 'nop') then
|
||||
inc(i);
|
||||
@ -7131,18 +7369,20 @@ begin
|
||||
FNextExecQueued := False;
|
||||
FP := 0;
|
||||
FInitialFP := FP;
|
||||
FStepStartedInFinSub := sfsNone;
|
||||
CurThreadId := FTheDebugger.FCurrentThreadId;
|
||||
if not FTheDebugger.FCurrentThreadIdValid then CurThreadId := 1; // TODO, but we need something
|
||||
ContinueStep := False; // A step command was interupted, and is continued on breakpoint
|
||||
FStepBreakPoint := -1;
|
||||
RunMode := rmNormal;
|
||||
|
||||
if (FExecType in [ectStepOver, ectStepInto, ectStepOut]) and
|
||||
(FTheDebugger.FStoppedReason = srRaiseExcept)
|
||||
then begin
|
||||
RunMode := rmStepToFinally;
|
||||
FCurrentExecCmd := ectContinue;
|
||||
EnablePopCatches;
|
||||
EnableRtlUnwind;
|
||||
EnableFpcSpecificHandler;
|
||||
end
|
||||
else
|
||||
CheckWin64StepOverFinally; // Finally is in a subroutine, and may need step into
|
||||
@ -7159,11 +7399,18 @@ begin
|
||||
FTheDebugger.CancelBeforeRun; // TODO: see comment on top of TGDBMIDebuggerBase.QueueCommand
|
||||
FTheDebugger.QueueExecuteLock; // prevent other commands from executing
|
||||
try
|
||||
if (not ContinueStep) and (not (RunMode in [rmStepToFinally])) and
|
||||
(FExecType in [ectStepOver, ectStepInto, ectStepOut, ectStepOverInstruction, ectStepIntoInstruction])
|
||||
then
|
||||
if (not ContinueStep) and (not (RunMode in [rmStepToFinally])) then begin
|
||||
if (FExecType in [ectStepOver, ectStepInto, ectStepOut, ectStepOverInstruction, ectStepIntoInstruction])
|
||||
then begin
|
||||
FP := GetCurrentFp;
|
||||
FInitialFP := FP;
|
||||
//FTheDebugger.FSehFinallyBreaks.ClearAllAboveFramePtr(Self, FP);
|
||||
end;
|
||||
//else
|
||||
//if FExecType in [ectContinue] then begin
|
||||
// FTheDebugger.FSehFinallyBreaks.ClearAll(Self);
|
||||
//end;
|
||||
end;
|
||||
|
||||
FTheDebugger.FCurrentStackFrameValid := False;
|
||||
FTheDebugger.FCurrentThreadIdValid := False;
|
||||
@ -7207,6 +7454,9 @@ begin
|
||||
if StoppedParams <> ''
|
||||
then ContinueExecution := ProcessStopped(StoppedParams, FTheDebugger.PauseWaitState = pwsInternal);
|
||||
|
||||
// FFpcSpecificHandlerCallFin was either hit, or the handler was exited
|
||||
FTheDebugger.FFpcSpecificHandlerCallFin.Clear(Self);
|
||||
|
||||
if ContinueExecution
|
||||
then begin
|
||||
ContinueStep := DoContinueStepping; // will set dsPause, if step has finished
|
||||
@ -7232,8 +7482,8 @@ begin
|
||||
then ExecuteCommand('-break-delete %d', [FStepBreakPoint], [cfNoThreadContext]);
|
||||
FStepBreakPoint := -1;
|
||||
DisablePopCatches;
|
||||
FTheDebugger.FRtlUnwindExBreak.Disable(Self);
|
||||
FTheDebugger.FSehRaiseBreaks.ClearAll(Self);
|
||||
FTheDebugger.FFpcSpecificHandler.Disable(Self);
|
||||
FTheDebugger.FSehFinallyBreaks.ClearAll(Self);
|
||||
FTheDebugger.FMainAddrBreak.Clear(Self);
|
||||
|
||||
if (not ContinueExecution) and (DebuggerState = dsRun) and
|
||||
@ -8056,7 +8306,10 @@ begin
|
||||
FCatchesBreak := TGDBMIInternalBreakPoint.Create('FPC_CATCHES');
|
||||
FReRaiseBreak := TGDBMIInternalBreakPoint.Create('FPC_RERAISE');
|
||||
FRtlUnwindExBreak:= TGDBMIInternalBreakPoint.Create('RtlUnwindEx');
|
||||
FSehRaiseBreaks := TGDBMIInternalAddrBreakPointList.Create;
|
||||
FFpcSpecificHandler := TGDBMIInternalBreakPoint.Create('__FPC_specific_handler');
|
||||
FFpcSpecificHandlerCallFin:= TGDBMIInternalBreakPoint.Create('');
|
||||
FSehFinallyBreaks := TGDBMIInternalSehFinallyBreakPointList.Create;
|
||||
FSehCatchesBreaks := TGDBMIInternalAddrBreakPointList.Create;
|
||||
{$IFdef WITH_GDB_FORCE_EXCEPTBREAK}
|
||||
FBreakErrorBreak.UseForceFlag := True;
|
||||
FRunErrorBreak.UseForceFlag := True;
|
||||
@ -8175,7 +8428,10 @@ begin
|
||||
FreeAndNil(FCatchesBreak);
|
||||
FreeAndNil(FReRaiseBreak);
|
||||
FreeAndNil(FRtlUnwindExBreak);
|
||||
FreeAndNil(FSehRaiseBreaks);
|
||||
FreeAndNil(FFpcSpecificHandler);
|
||||
FreeAndNil(FFpcSpecificHandlerCallFin);
|
||||
FreeAndNil(FSehFinallyBreaks);
|
||||
FreeAndNil(FSehCatchesBreaks);
|
||||
end;
|
||||
|
||||
procedure TGDBMIDebuggerBase.Done;
|
||||
@ -11261,6 +11517,7 @@ begin
|
||||
Instr.AddReference;
|
||||
Instr.Cmd := Self;
|
||||
|
||||
if (not (cfNoMemLimits in AFlags)) then begin
|
||||
if (pos('-stack-list-', ACommand) = 1) or
|
||||
(pos('-thread-info', ACommand) = 1)
|
||||
then begin
|
||||
@ -11315,6 +11572,7 @@ begin
|
||||
else
|
||||
TestForceBreak := (not (dfForceBreakDetected in FTheDebugger.DebuggerFlags)) and
|
||||
(pos('-break-insert -f ', ACommand) = 1); // -f MUST be exactly ONE space after insert
|
||||
end;
|
||||
|
||||
FTheDebugger.FInstructionQueue.RunInstruction(Instr);
|
||||
|
||||
@ -11654,9 +11912,9 @@ var
|
||||
List: TGDBMINameValueList;
|
||||
begin
|
||||
Result := -1;
|
||||
if (MaxDepth < 0) and (not ExecuteCommand('-stack-info-depth', R, [cfNoStackContext]))
|
||||
if (MaxDepth < 0) and (not ExecuteCommand('-stack-info-depth', R, [cfNoStackContext, cfNoMemLimits]))
|
||||
then exit;
|
||||
if (MaxDepth >= 0) and (not ExecuteCommand('-stack-info-depth %d', [MaxDepth], R, [cfNoStackContext]))
|
||||
if (MaxDepth >= 0) and (not ExecuteCommand('-stack-info-depth %d', [MaxDepth], R, [cfNoStackContext, cfNoMemLimits]))
|
||||
then exit;
|
||||
if R.State = dsError
|
||||
then exit;
|
||||
@ -11687,7 +11945,7 @@ begin
|
||||
repeat
|
||||
FContext.StackFrame := Result;
|
||||
|
||||
if not ExecuteCommand('-data-evaluate-expression $fp', R)
|
||||
if not ExecuteCommand('-data-evaluate-expression $fp', R, [cfNoMemLimits])
|
||||
or (R.State = dsError)
|
||||
then begin
|
||||
Result := -1;
|
||||
@ -12053,6 +12311,32 @@ begin
|
||||
Result := GetData(S, []);
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommand.GetWordData(const ALocation: TDbgPtr): TDbgPtr;
|
||||
var
|
||||
S: String;
|
||||
R: TGDBMIExecResult;
|
||||
e: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
Str(ALocation, S);
|
||||
if ExecuteCommand('x/hu ' + S, R, [cfNoMemLimits])
|
||||
then Val(StripLN(GetPart('\t', '', R.Values)), Result, e);
|
||||
if e=0 then ;
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommand.GetDWordData(const ALocation: TDbgPtr): TDbgPtr;
|
||||
var
|
||||
S: String;
|
||||
R: TGDBMIExecResult;
|
||||
e: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
Str(ALocation, S);
|
||||
if ExecuteCommand('x/wu ' + S, R, [cfNoMemLimits])
|
||||
then Val(StripLN(GetPart('\t', '', R.Values)), Result, e);
|
||||
if e=0 then ;
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommand.GetData(const AExpression: String;
|
||||
const AValues: array of const): TDbgPtr;
|
||||
var
|
||||
@ -12060,18 +12344,18 @@ var
|
||||
e: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
if ExecuteCommand('x/d ' + AExpression, AValues, R)
|
||||
if ExecuteCommand('x/d ' + AExpression, AValues, R, [cfNoMemLimits])
|
||||
then Val(StripLN(GetPart('\t', '', R.Values)), Result, e);
|
||||
if e=0 then ;
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommand.GetStrValue(const AExpression: String;
|
||||
const AValues: array of const): String;
|
||||
const AValues: array of const; AFlags: TGDBMICommandFlags): String;
|
||||
var
|
||||
R: TGDBMIExecResult;
|
||||
ResultList: TGDBMINameValueList;
|
||||
begin
|
||||
if ExecuteCommand('-data-evaluate-expression %s', [Format(AExpression, AValues)], R)
|
||||
if ExecuteCommand('-data-evaluate-expression %s', [Format(AExpression, AValues)], R, AFlags)
|
||||
then begin
|
||||
ResultList := TGDBMINameValueList.Create(R);
|
||||
Result := DeleteEscapeChars(ResultList.Values['value']);
|
||||
@ -12086,19 +12370,20 @@ var
|
||||
e: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
Val(GetStrValue(AExpression, AValues), Result, e);
|
||||
Val(GetStrValue(AExpression, AValues, [cfNoMemLimits]), Result, e);
|
||||
if e=0 then ;
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommand.GetPtrValue(const AExpression: String;
|
||||
const AValues: array of const; ConvertNegative: Boolean = False): TDbgPtr;
|
||||
const AValues: array of const; ConvertNegative: Boolean;
|
||||
AFlags: TGDBMICommandFlags): TDbgPtr;
|
||||
var
|
||||
e: Integer;
|
||||
i: Int64;
|
||||
s: String;
|
||||
begin
|
||||
Result := 0;
|
||||
s := GetStrValue(AExpression, AValues);
|
||||
s := GetStrValue(AExpression, AValues, [cfNoMemLimits]+AFlags);
|
||||
if (s <> '') and (s[1] = '-')
|
||||
then begin
|
||||
Val(s, i, e);
|
||||
@ -12441,7 +12726,7 @@ begin
|
||||
SetByName(ACmd);
|
||||
exit;
|
||||
end;
|
||||
if FSetByAddrMethod = ibmAddrDirect then begin
|
||||
if (FSetByAddrMethod = ibmAddrDirect) then begin
|
||||
BreakSet(ACmd, '*'+FName, iblAsterix, coKeepIfSet);
|
||||
if IsBreakSet then
|
||||
exit;
|
||||
@ -12587,6 +12872,35 @@ begin
|
||||
// c := (a.FId = b.FId) and (a.FAddr = b.FAddr);
|
||||
end;
|
||||
|
||||
procedure TGDBMIInternalAddrBreakPointList.TGDBMIInternalAddrBreakPointListEntry.AddBasePointer
|
||||
(ABp: TDBGPtr);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i := Length(FBasePointer);
|
||||
SetLength(FBasePointer, i + 1);
|
||||
FBasePointer[i] := ABp;
|
||||
end;
|
||||
|
||||
function TGDBMIInternalAddrBreakPointList.TGDBMIInternalAddrBreakPointListEntry.IndexOfBasePointer
|
||||
(ABp: TDBGPtr): integer;
|
||||
begin
|
||||
Result := high(FBasePointer);
|
||||
while (Result >= 0) and (FBasePointer[Result] <> ABp) do
|
||||
dec(Result);
|
||||
end;
|
||||
|
||||
procedure TGDBMIInternalAddrBreakPointList.TGDBMIInternalAddrBreakPointListEntry.DeleteBasePointer
|
||||
(AnIndex: Integer);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i := High(FBasePointer);
|
||||
if AnIndex < i then
|
||||
FBasePointer[AnIndex] := FBasePointer[i];
|
||||
SetLength(FBasePointer, i);
|
||||
end;
|
||||
|
||||
{ TGDBMIInternalAddrBreakPointList }
|
||||
|
||||
function TGDBMIInternalAddrBreakPointList.IndexOfAddr(AnAddr: TDBGPtr): Integer;
|
||||
@ -12621,6 +12935,21 @@ begin
|
||||
FList.Delete(AnIndex);
|
||||
end;
|
||||
|
||||
function TGDBMIInternalAddrBreakPointList.SetBreak(ACmd: TGDBMIDebuggerCommand;
|
||||
AnAddr: TDBGPtr): Integer;
|
||||
var
|
||||
R: TGDBMIExecResult;
|
||||
ResultList: TGDBMINameValueList;
|
||||
begin
|
||||
Result := -1;
|
||||
ACmd.ExecuteCommand('-break-insert *%u', [AnAddr], R);
|
||||
if R.State <> dsError then begin
|
||||
ResultList := TGDBMINameValueList.Create(R, ['bkpt']);
|
||||
Result := StrToIntDef(ResultList.Values['number'], -1);
|
||||
ResultList.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TGDBMIInternalAddrBreakPointList.Create;
|
||||
begin
|
||||
FList := TBPEntryList.Create;
|
||||
@ -12633,29 +12962,23 @@ begin
|
||||
end;
|
||||
|
||||
procedure TGDBMIInternalAddrBreakPointList.AddAddr(ACmd: TGDBMIDebuggerCommand;
|
||||
AnAddr: TDBGPtr);
|
||||
AnAddr: TDBGPtr; ABasePtr: TDBGPtr);
|
||||
var
|
||||
R: TGDBMIExecResult;
|
||||
E: TGDBMIInternalAddrBreakPointListEntry;
|
||||
ResultList: TGDBMINameValueList;
|
||||
i: Integer;
|
||||
begin
|
||||
i := IndexOfAddr(AnAddr);
|
||||
if i >= 0 then begin
|
||||
FList.List^[i].FCount := FList.List^[i].FCount + 1;
|
||||
if ABasePtr <> 0 then
|
||||
FList.List^[i].AddBasePointer(ABasePtr);
|
||||
end;
|
||||
|
||||
E.FCount := 1;
|
||||
E.FAddr := AnAddr;
|
||||
|
||||
ACmd.ExecuteCommand('-break-insert *%u', [AnAddr], R);
|
||||
if R.State <> dsError then begin
|
||||
ResultList := TGDBMINameValueList.Create(R, ['bkpt']);
|
||||
E.FId := StrToIntDef(ResultList.Values['number'], -1);
|
||||
ResultList.Free;
|
||||
end
|
||||
else
|
||||
E.FId := -1;
|
||||
if ABasePtr <> 0 then
|
||||
E.AddBasePointer(ABasePtr);
|
||||
E.FId := SetBreak(ACmd, AnAddr);
|
||||
|
||||
FList.Add(E);
|
||||
end;
|
||||
@ -12672,6 +12995,34 @@ begin
|
||||
RemoveIndex(ACmd, IndexOfId(AnId));
|
||||
end;
|
||||
|
||||
procedure TGDBMIInternalAddrBreakPointList.RemoveFrameFromId(
|
||||
ACmd: TGDBMIDebuggerCommand; AnId: Integer; ABasePtr: TDBGPtr);
|
||||
var
|
||||
i: Integer;
|
||||
j: LongInt;
|
||||
begin
|
||||
i := IndexOfId(AnId);
|
||||
if i < 0 then
|
||||
exit;
|
||||
j := FList.List^[i].IndexOfBasePointer(ABasePtr);
|
||||
DebugLn(j<0, 'Frame not found: %x for id %d', [ABasePtr, AnId]);
|
||||
if j < 0 then
|
||||
exit;
|
||||
|
||||
FList.List^[i].DeleteBasePointer(j);
|
||||
RemoveIndex(ACmd, i); // checks FCount;
|
||||
end;
|
||||
|
||||
function TGDBMIInternalAddrBreakPointList.IndexOfAddrWithFrame(AnAddr: TDBGPtr;
|
||||
ABasePtr: TDBGPtr): Integer;
|
||||
begin
|
||||
Result := IndexOfAddr(AnAddr);
|
||||
if Result < 0 then
|
||||
exit;
|
||||
if FList.List^[Result].IndexOfBasePointer(ABasePtr) < 0 then
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
procedure TGDBMIInternalAddrBreakPointList.ClearAll(ACmd: TGDBMIDebuggerCommand);
|
||||
var
|
||||
i: Integer;
|
||||
@ -12692,6 +13043,50 @@ begin
|
||||
Result := IndexOfId(AnId) >= 0;
|
||||
end;
|
||||
|
||||
{ TGDBMIInternalSehFinallyBreakPointList }
|
||||
|
||||
function TGDBMIInternalSehFinallyBreakPointList.SetBreak(
|
||||
ACmd: TGDBMIDebuggerCommand; AnAddr: TDBGPtr): Integer;
|
||||
var
|
||||
R: TGDBMIExecResult;
|
||||
ResultList: TGDBMINameValueList;
|
||||
FileName, FuncName: String;
|
||||
begin
|
||||
if ACmd.ExecuteCommand('info line *' + IntToStr(AnAddr), R) and
|
||||
(R.State <> dsError)
|
||||
then begin
|
||||
(* Line 58 of \"ExceptTestPrg.pas\" starts at address 0x100001650 <fin$0> and ends at 0x100001659 <fin$0+9>.\n"" *)
|
||||
FileName := GetPart(' of \"', '\" starts at', R.Values, False, False);
|
||||
FuncName := GetPart(' starts at ', ' ends at', R.Values, False, False);
|
||||
FuncName := GetPart(' <', '> ', FuncName, False, False);
|
||||
// FuncName := GetPart(' <', ['> ', '+'], FuncName);
|
||||
|
||||
if (FuncName = '') or (FileName = '') or
|
||||
(pos(' ', FuncName) > 0) or (pos('+', FuncName) > 0) or
|
||||
(pos(#10, FuncName) > 0) or (pos(#13, FuncName) > 0) or
|
||||
(pos('fin$', FuncName) < 1)
|
||||
then
|
||||
exit;
|
||||
|
||||
if FuncName[1] = '$' then begin
|
||||
Result := inherited SetBreak(ACmd, AnAddr);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := -1;
|
||||
ACmd.ExecuteCommand('-break-insert "\"%s\":''%s''"', [FileName, FuncName], R);
|
||||
if R.State = dsError then
|
||||
ACmd.ExecuteCommand('-break-insert "\"%s\":%s"', [FileName, FuncName], R);
|
||||
if R.State <> dsError then begin
|
||||
ResultList := TGDBMINameValueList.Create(R, ['bkpt']);
|
||||
Result := StrToIntDef(ResultList.Values['number'], -1);
|
||||
ResultList.Free;
|
||||
end
|
||||
else
|
||||
Result := inherited SetBreak(ACmd, AnAddr);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TGDBMIDebuggerSimpleCommand }
|
||||
|
||||
constructor TGDBMIDebuggerSimpleCommand.Create(AOwner: TGDBMIDebuggerBase;
|
||||
@ -13246,7 +13641,7 @@ var
|
||||
|
||||
if ParentFp = '' then begin
|
||||
// not yet evaluated
|
||||
if ExecuteCommand('-data-evaluate-expression parentfp', R)
|
||||
if ExecuteCommand('-data-evaluate-expression parentfp', R, [cfNoMemLimits])
|
||||
and (R.State <> dsError)
|
||||
then begin
|
||||
List := TGDBMINameValueList.Create(R);
|
||||
@ -13291,7 +13686,7 @@ var
|
||||
FContext.StackFrame := aFrameIdx;
|
||||
|
||||
if (Fp = '') then begin
|
||||
if not ExecuteCommand('-data-evaluate-expression $fp', R)
|
||||
if not ExecuteCommand('-data-evaluate-expression $fp', R, [cfNoMemLimits])
|
||||
or (R.State = dsError)
|
||||
then begin
|
||||
FrameCache^.ParentFPList[aFrameIdx].Fp := '-'; // mark as no Fp (not accesible)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user