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

FpDebugServer: fix compilation / support multiple addresses per breakpoint

Browse Source 
git-svn-id: trunk@60048 -
This commit is contained in:
martin 2019-01-09 20:50:23 +00:00
parent 5f6279e73e
commit f737797457
8 changed files with 202 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpdebug/app/fpdserver/debuginoutputprocessor.pas
View File

@ -144,8 +144,8 @@ begin
JSonEvent := TJSONObject.Create;
try
JSonEvent.Add('type',FpEventTypeNames[AnEvent.EventType]);
if AnEvent.BreakpointAddr<>0 then
JSonEvent.Add('breakpointLocation', FormatAddress(AnEvent.BreakpointAddr));
if AnEvent.BreakpointServerIdr<>0 then
JSonEvent.Add('BreakpointServerIdr', AnEvent.BreakpointServerIdr);
if AnEvent.SendByConnectionIdentifier>0 then
JSonEvent.Add('connIdentifier', AnEvent.SendByConnectionIdentifier);
if AnEvent.Validity<>ddsUnknown then

4
components/fpdebug/app/fpdserver/debugtcpserver.pas
View File

@ -8,7 +8,9 @@ uses
Classes,
SysUtils,
ssockets,
{$IFDEF UNIX}
BaseUnix,
{$ENDIF}
debugthread,
sockets,
syncobjs,
@ -189,7 +191,9 @@ begin
FData := data;
// Set non-blocking
{$IFDEF UNIX}
fpfcntl(FData.Handle,F_SETFL,O_NONBLOCK);
{$ENDIF}
FDebugThread := ADebugThread;
FDebugTcpServer := ADebugTcpServer;

110
components/fpdebug/app/fpdserver/debugthread.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes,
SysUtils,
SysUtils, fgl,
FPDbgController,
FpDbgDwarfDataClasses,
FpdMemoryTools,
@ -69,7 +69,7 @@ type
LogLevel: TFPDLogLevel;
InstructionPointerRegValue: TDBGPtr;
AnUID: variant;
BreakpointAddr: TDBGPtr;
BreakpointServerIdr: Integer;
LocationRec: TDBGLocationRec;
Validity: TDebuggerDataState;
Addr1: TDBGPtr;
@ -92,6 +92,26 @@ type
TFpDebugThread = class;
{ TFpServerDbgController }
TFpServerDbgController = class(TDbgController)
private type
TBreakPointIdMap = specialize TFPGMap<Integer, TFpInternalBreakpoint>;
function DoBreakPointCompare(Key1, Key2: Pointer): Integer;
private
FBreakPointIdCnt: Integer;
FBreakPointIdMap: TBreakPointIdMap;
public
constructor Create; override;
destructor Destroy; override;
function AddInternalBreakPointToId(ABrkPoint: TFpInternalBreakpoint): Integer;
function GetInternalBreakPointFromId(AnId: Integer): TFpInternalBreakpoint;
function GetIdFromInternalBreakPoint(ABrkPoint: TFpInternalBreakpoint): Integer;
procedure RemoveInternalBreakPoint(AnId: Integer);
//procedure RemoveInternalBreakPoint(ABrkPoint: TFpInternalBreakpoint);
procedure ClearInternalBreakPoint;
end;
{ TFpDebugThreadCommand }
// The base class for all commands that can be send to the debug-thread.
@ -116,11 +136,11 @@ type
// the controller's debug loop. (This means it is only executed when the debuggee is paused or stopped)
// Should return true on success, false on a failure. Set DoProcessLoop to true when the debuggee should continue,
// make it false if the debuggee should stay in a paused state.
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; virtual; abstract;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; virtual; abstract;
// This method is called before the command is queued for execution in the controller's debug loop. This
// can happen in any thread. If DoQueueCommand is true, the result is ignored or else a success-event is
// send if the result is true, a failure if the result is false.
function PreExecute(AController: TDbgController; out DoQueueCommand: boolean): boolean; virtual;
function PreExecute(AController: TFpServerDbgController; out DoQueueCommand: boolean): boolean; virtual;
// The name that is used to identify the command
class function TextName: string; virtual; abstract;
// The identifier of the Listener that has send this command
@ -134,7 +154,7 @@ type
TFpDebugThread = class(TThread)
private
FCommandQueue: TFpDebugThreadCommandQueue;
FController: TDbgController;
FController: TFpServerDbgController;
FListenerList: TThreadList;
FMemConverter: TFpDbgMemConvertorLittleEndian;
FMemReader: TDbgMemReader;
@ -143,7 +163,7 @@ type
procedure FreeConsoleOutputThread;
protected
// Handlers for the FController-events
procedure FControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: TDbgBreakpoint);
procedure FControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: TFpInternalBreakpoint);
procedure FControllerProcessExitEvent(ExitCode: DWord);
procedure FControllerCreateProcessEvent(var continue: boolean);
procedure FControllerDebugInfoLoaded(Sender: TObject);
@ -211,6 +231,58 @@ type
procedure Execute; override;
end;
{ TFpServerDbgController }
function TFpServerDbgController.DoBreakPointCompare(Key1, Key2: Pointer
): Integer;
begin
Result := PPointer(Key1)^ - PPointer(Key1)^;
end;
constructor TFpServerDbgController.Create;
begin
FBreakPointIdMap := TBreakPointIdMap.Create;
FBreakPointIdMap.OnDataPtrCompare := @DoBreakPointCompare;
inherited Create;
end;
destructor TFpServerDbgController.Destroy;
begin
inherited Destroy;
FBreakPointIdMap.Free;
end;
function TFpServerDbgController.AddInternalBreakPointToId(
ABrkPoint: TFpInternalBreakpoint): Integer;
begin
inc(FBreakPointIdCnt);
Result := FBreakPointIdCnt;
FBreakPointIdMap.Add(Result, ABrkPoint);
end;
function TFpServerDbgController.GetInternalBreakPointFromId(AnId: Integer
): TFpInternalBreakpoint;
begin
if not FBreakPointIdMap.TryGetData(AnId, Result) then
Result := nil;
end;
function TFpServerDbgController.GetIdFromInternalBreakPoint(
ABrkPoint: TFpInternalBreakpoint): Integer;
begin
Result := FBreakPointIdMap.IndexOfData(ABrkPoint);
end;
procedure TFpServerDbgController.RemoveInternalBreakPoint(AnId: Integer);
begin
FBreakPointIdMap.Remove(AnId);
end;
procedure TFpServerDbgController.ClearInternalBreakPoint;
begin
FBreakPointIdMap.Clear;
end;
constructor TFpWaitForConsoleOutputThread.Create(ADebugThread: TFpDebugThread);
begin
Inherited create(false);
@ -302,7 +374,7 @@ begin
AnEvent.Message:=Format('%s-command failed.',[TextName]);
end;
function TFpDebugThreadCommand.PreExecute(AController: TDbgController; out DoQueueCommand: boolean): boolean;
function TFpDebugThreadCommand.PreExecute(AController: TFpServerDbgController; out DoQueueCommand: boolean): boolean;
begin
DoQueueCommand:=true;
result:=true;
@ -327,7 +399,7 @@ begin
AnEvent.AnUID:=null;
AnEvent.SendByConnectionIdentifier:=-1;
AnEvent.InstructionPointerRegValue:=0;
AnEvent.BreakpointAddr:=0;
AnEvent.BreakpointServerIdr:=0;
AnEvent.LocationRec.Address:=0;
AnEvent.Validity:=ddsUnknown;
SetLength(AnEvent.StackEntryArray,0);
@ -358,16 +430,24 @@ begin
end;
end;
procedure TFpDebugThread.FControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: TDbgBreakpoint);
procedure TFpDebugThread.FControllerHitBreakpointEvent(var continue: boolean;
const Breakpoint: TFpInternalBreakpoint);
var
ADebugEvent: TFpDebugEvent;
AnId: Integer;
begin
ClearEvent(ADebugEvent);
ADebugEvent.EventType:=etEvent;
ADebugEvent.EventName:='BreakPoint';
ADebugEvent.InstructionPointerRegValue:=FController.CurrentProcess.GetInstructionPointerRegisterValue;
if assigned(Breakpoint) then
ADebugEvent.BreakpointAddr:=Breakpoint.Location;
ADebugEvent.InstructionPointerRegValue:=FController.CurrentThread.GetInstructionPointerRegisterValue;
if assigned(Breakpoint) then begin
(* There may be several breakpoints at this address.
For now sending the IP address allows the IDE to find the same breakpoint(s) as the fpdserver app.
*)
AnId := FController.GetIdFromInternalBreakPoint(Breakpoint);
ADebugEvent.BreakpointServerIdr := AnId;
end;
SendEvent(ADebugEvent);
continue:=false;
@ -382,7 +462,7 @@ begin
ClearEvent(ADebugEvent);
ADebugEvent.EventType:=etEvent;
ADebugEvent.EventName:='ExitProcess';
ADebugEvent.InstructionPointerRegValue:=FController.CurrentProcess.GetInstructionPointerRegisterValue;
ADebugEvent.InstructionPointerRegValue:=FController.CurrentThread.GetInstructionPointerRegisterValue;
SendEvent(ADebugEvent);
end;
@ -394,7 +474,7 @@ begin
ClearEvent(ADebugEvent);
ADebugEvent.EventType:=etEvent;
ADebugEvent.EventName:='CreateProcess';
ADebugEvent.InstructionPointerRegValue:=FController.CurrentProcess.GetInstructionPointerRegisterValue;
ADebugEvent.InstructionPointerRegValue:=FController.CurrentThread.GetInstructionPointerRegisterValue;
SendEvent(ADebugEvent);
@ -409,7 +489,7 @@ var
ARunLoop: boolean;
AnEvent: TFpDebugEvent;
begin
FController := TDbgController.Create;
FController := TFpServerDbgController.Create;
FController.RedirectConsoleOutput:=true;
FController.OnCreateProcessEvent:=@FControllerCreateProcessEvent;
FController.OnProcessExitEvent:=@FControllerProcessExitEvent;

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

@ -43,8 +43,8 @@ type
TFpDebugThreadQuitDebugServerCommand = class(TFpDebugThreadCommand)
public
function PreExecute(AController: TDbgController; out DoQueueCommand: boolean): boolean; override;
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function PreExecute(AController: TFpServerDbgController; out DoQueueCommand: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
end;
@ -54,7 +54,7 @@ type
private
FFileName: string;
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
published
property Filename: string read FFileName write FFileName;
@ -66,7 +66,7 @@ type
private
FConsoleTty: String;
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
published
property ConsoleTty: String read FConsoleTty write FConsoleTty;
@ -76,7 +76,7 @@ type
TFpDebugThreadRunCommand = class(TFpDebugThreadCommand)
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
end;
@ -84,7 +84,7 @@ type
TFpDebugThreadContinueCommand = class(TFpDebugThreadCommand)
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
end;
@ -92,7 +92,7 @@ type
TFpDebugThreadNextCommand = class(TFpDebugThreadCommand)
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
end;
@ -100,7 +100,7 @@ type
TFpDebugThreadStepCommand = class(TFpDebugThreadCommand)
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
end;
@ -108,7 +108,7 @@ type
TFpDebugThreadStepOutCommand = class(TFpDebugThreadCommand)
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
end;
@ -116,7 +116,7 @@ type
TFpDebugThreadStepIntoInstrCommand = class(TFpDebugThreadCommand)
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
end;
@ -124,7 +124,7 @@ type
TFpDebugThreadStepOverInstrCommand = class(TFpDebugThreadCommand)
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
end;
@ -132,7 +132,7 @@ type
TFpDebugThreadStopCommand = class(TFpDebugThreadCommand)
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
end;
@ -142,10 +142,11 @@ type
private
FFileName: string;
FLine: integer;
FBreakPoint: FpDbgClasses.TDbgBreakpoint;
FBreakPoint: TFpInternalBreakpoint;
FBreakServerId: Integer;
public
procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); override;
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
published
property Filename: string read FFileName write FFileName;
@ -156,14 +157,12 @@ type
TFpDebugThreadRemoveBreakpointCommand = class(TFpDebugThreadCommand)
private
FLocationValue: TDBGPtr;
function GetLocation: string;
procedure SetLocation(AValue: string);
FBreakpointServerIdr: Integer;
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
published
property Location: string read GetLocation write SetLocation;
property BreakpointServerIdr: Integer read FBreakpointServerIdr write FBreakpointServerIdr;
end;
{ TFpDebugThreadGetLocationInfoCommand }
@ -177,7 +176,7 @@ type
protected
procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); override;
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
published
property Address: string read GetAddress write SetAddress;
@ -191,7 +190,7 @@ type
FResText: string;
FValidity: TDebuggerDataState;
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); override;
published
@ -204,7 +203,7 @@ type
private
FStackEntryArray: TFpDebugEventCallStackEntryArray;
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); override;
end;
@ -224,13 +223,13 @@ type
procedure SetAddress(AValue: string);
{$ifndef disassemblernestedproc}
private
FController: TDbgController;
FController: TFpServerDbgController;
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;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); override;
published
@ -245,7 +244,7 @@ type
private
FWatchEntryArray: TFpDebugEventWatchEntryArray;
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); override;
end;
@ -256,7 +255,7 @@ type
private
FWatchEntryArray: TFpDebugEventWatchEntryArray;
public
function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
function Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean; override;
class function TextName: string; override;
procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); override;
end;
@ -268,7 +267,7 @@ uses
{ TFpDebugRegistersCommand }
function TFpDebugRegistersCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugRegistersCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
var
ARegisterList: TDbgRegisterValueList;
i: Integer;
@ -304,7 +303,7 @@ end;
{ TFpDebugLocalsCommand }
function TFpDebugLocalsCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugLocalsCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
var
AContext: TFpDbgInfoContext;
ProcVal: TFpDbgValue;
@ -319,7 +318,7 @@ begin
(AController.CurrentProcess.DbgInfo = nil) then
exit;
Reg := AController.CurrentProcess.GetInstructionPointerRegisterValue;
Reg := AController.CurrentThread.GetInstructionPointerRegisterValue;
AContext := AController.CurrentProcess.DbgInfo.FindContext(AController.CurrentThread.ID, 0, Reg);
if (AContext = nil) or (AContext.SymbolAtAddress = nil) then
@ -389,7 +388,7 @@ begin
end;
{$ifdef disassemblernestedproc}
function TFpDebugThreadDisassembleCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugThreadDisassembleCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
{$endif}
function {$ifndef disassemblernestedproc}TFpDebugThreadDisassembleCommand.{$endif}OnAdjustToKnowFunctionStart(var AStartAddr: TDisassemblerAddress): Boolean;
@ -501,7 +500,7 @@ function TFpDebugThreadDisassembleCommand.Execute(AController: TDbgController; o
end;
{$ifndef disassemblernestedproc}
function TFpDebugThreadDisassembleCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugThreadDisassembleCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
{$endif disassemblernestedproc}
var
@ -526,7 +525,7 @@ begin
end;
if FAddressValue=0 then
FStartAddr:=AController.CurrentProcess.GetInstructionPointerRegisterValue
FStartAddr:=AController.CurrentThread.GetInstructionPointerRegisterValue
else
FStartAddr:=FAddressValue;
@ -591,7 +590,7 @@ end;
{ TFpDebugThreadSetConsoleTtyCommand }
function TFpDebugThreadSetConsoleTtyCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugThreadSetConsoleTtyCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
begin
AController.ConsoleTty:=FConsoleTty;
AController.RedirectConsoleOutput:=(AController.ConsoleTty='');
@ -606,7 +605,7 @@ end;
{ TFpDebugThreadStackTraceCommand }
function TFpDebugThreadStackTraceCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugThreadStackTraceCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
var
ThreadCallStack: TDbgCallstackEntryList;
i: integer;
@ -658,7 +657,7 @@ begin
AnEvent.Validity:=FValidity;
end;
function TFpDebugThreadEvaluateCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugThreadEvaluateCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
var
AContext: TFpDbgInfoContext;
APasExpr: TFpPascalExpression;
@ -677,7 +676,7 @@ begin
end;
ADbgInfo := AController.CurrentProcess.DbgInfo;
AContext := ADbgInfo.FindContext(AController.CurrentThread.ID, 0, AController.CurrentProcess.GetInstructionPointerRegisterValue);
AContext := ADbgInfo.FindContext(AController.CurrentThread.ID, 0, AController.CurrentThread.GetInstructionPointerRegisterValue);
if AContext = nil then
begin
FValidity:=ddsInvalid;
@ -727,14 +726,14 @@ end;
{ TFpDebugThreadQuitDebugServerCommand }
function TFpDebugThreadQuitDebugServerCommand.PreExecute(AController: TDbgController; out DoQueueCommand: boolean): boolean;
function TFpDebugThreadQuitDebugServerCommand.PreExecute(AController: TFpServerDbgController; out DoQueueCommand: boolean): boolean;
begin
DoQueueCommand:=false;
CustomApplication.Terminate;
result := true;
end;
function TFpDebugThreadQuitDebugServerCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugThreadQuitDebugServerCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
begin
result := true;
DoProcessLoop := false;
@ -747,17 +746,9 @@ end;
{ TFpDebugThreadRemoveBreakpointCommand }
function TFpDebugThreadRemoveBreakpointCommand.GetLocation: string;
begin
result := FormatAddress(FLocationValue);
end;
procedure TFpDebugThreadRemoveBreakpointCommand.SetLocation(AValue: string);
begin
FLocationValue := Hex2Dec(AValue);
end;
function TFpDebugThreadRemoveBreakpointCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugThreadRemoveBreakpointCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
var
Brk: TFpInternalBreakpoint;
begin
result := false;
DoProcessLoop:=false;
@ -766,8 +757,12 @@ begin
log('Failed to remove breakpoint: No process', dllInfo);
exit;
end;
if (FLocationValue<>0) then
result := AController.CurrentProcess.RemoveBreak(FLocationValue)
if (FBreakpointServerIdr<>0) then begin
Brk := AController.GetInternalBreakPointFromId(FBreakpointServerIdr);
result := AController.CurrentProcess.RemoveBreak(Brk);
Brk.Free; // actually removes it from target process
AController.RemoveInternalBreakPoint(FBreakpointServerIdr);
end
else
log('Failed to remove breakpoint: No location given', dllInfo);
end;
@ -779,7 +774,7 @@ end;
{ TFpDebugThreadStopCommand }
function TFpDebugThreadStopCommand.Execute(AController: TDbgController; out
function TFpDebugThreadStopCommand.Execute(AController: TFpServerDbgController; out
DoProcessLoop: boolean): boolean;
begin
AController.Stop;
@ -794,7 +789,7 @@ end;
{ TFpDebugThreadStepOutCommand }
function TFpDebugThreadStepOutCommand.Execute(AController: TDbgController; out
function TFpDebugThreadStepOutCommand.Execute(AController: TFpServerDbgController; out
DoProcessLoop: boolean): boolean;
begin
AController.StepOut;
@ -810,7 +805,7 @@ end;
{ TFpDebugThreadStepOverInstrCommand }
function TFpDebugThreadStepOverInstrCommand.Execute(
AController: TDbgController; out DoProcessLoop: boolean): boolean;
AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
begin
AController.StepOverInstr;
DoProcessLoop:=true;
@ -825,7 +820,7 @@ end;
{ TFpDebugThreadStepIntoInstrCommand }
function TFpDebugThreadStepIntoInstrCommand.Execute(
AController: TDbgController; out DoProcessLoop: boolean): boolean;
AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
begin
AController.StepIntoInstr;
DoProcessLoop:=true;
@ -839,7 +834,7 @@ end;
{ TFpDebugThreadStepCommand }
function TFpDebugThreadStepCommand.Execute(AController: TDbgController; out
function TFpDebugThreadStepCommand.Execute(AController: TFpServerDbgController; out
DoProcessLoop: boolean): boolean;
begin
AController.Step;
@ -854,7 +849,7 @@ end;
{ TFpDebugThreadNextCommand }
function TFpDebugThreadNextCommand.Execute(AController: TDbgController; out
function TFpDebugThreadNextCommand.Execute(AController: TFpServerDbgController; out
DoProcessLoop: boolean): boolean;
begin
AController.Next;
@ -885,7 +880,7 @@ begin
AnEvent.LocationRec:=FLocationRec;
end;
function TFpDebugThreadGetLocationInfoCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugThreadGetLocationInfoCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
var
sym, symproc: TFpDbgSymbol;
begin
@ -905,7 +900,7 @@ begin
FLocationRec.SrcLine:=0;
if FAddressValue=0 then
FLocationRec.Address := AController.CurrentProcess.GetInstructionPointerRegisterValue
FLocationRec.Address := AController.CurrentThread.GetInstructionPointerRegisterValue
else
FLocationRec.Address := FAddressValue;
@ -938,12 +933,13 @@ end;
procedure TFpDebugThreadAddBreakpointCommand.ComposeSuccessEvent(var AnEvent: TFpDebugEvent);
begin
inherited ComposeSuccessEvent(AnEvent);
AnEvent.BreakpointAddr:=FBreakPoint.Location;
AnEvent.BreakpointServerIdr:=FBreakServerId;
end;
function TFpDebugThreadAddBreakpointCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
function TFpDebugThreadAddBreakpointCommand.Execute(AController: TFpServerDbgController; out DoProcessLoop: boolean): boolean;
begin
result := false;
FBreakServerId := 0;
DoProcessLoop:=false;
if not assigned(AController.CurrentProcess) then
begin
@ -954,6 +950,8 @@ begin
begin
FBreakPoint := AController.CurrentProcess.AddBreak(FileName, Line);
result := assigned(FBreakPoint);
if Result then
FBreakServerId := AController.AddInternalBreakPointToId(FBreakPoint);
end
else
log('Failed to add breakpoint: No filename and line-number given', dllInfo);
@ -990,7 +988,7 @@ end;
{ TFpDebugThreadContinueCommand }
function TFpDebugThreadContinueCommand.Execute(AController: TDbgController; out
function TFpDebugThreadContinueCommand.Execute(AController: TFpServerDbgController; out
DoProcessLoop: boolean): boolean;
begin
DoProcessLoop:=true;
@ -1004,7 +1002,7 @@ end;
{ TFpDebugThreadRunCommand }
function TFpDebugThreadRunCommand.Execute(AController: TDbgController; out
function TFpDebugThreadRunCommand.Execute(AController: TFpServerDbgController; out
DoProcessLoop: boolean): boolean;
begin
DoProcessLoop := AController.Run;
@ -1018,7 +1016,7 @@ end;
{ TFpDebugThreadSetFilenameCommand }
function TFpDebugThreadSetFilenameCommand.Execute(AController: TDbgController;
function TFpDebugThreadSetFilenameCommand.Execute(AController: TFpServerDbgController;
out DoProcessLoop: boolean): boolean;
begin
AController.ExecutableFilename:=FFileName;

16
components/fpdebug/app/fpdserver/fpdserver.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<Version Value="11"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
@ -15,9 +15,6 @@
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
@ -25,9 +22,10 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="2">
<Item1>
@ -45,7 +43,6 @@
<Unit1>
<Filename Value="debugthread.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="debugthread"/>
</Unit1>
<Unit2>
<Filename Value="debugthreadcommand.pas"/>
@ -70,7 +67,6 @@
<Unit6>
<Filename Value="debugscriptserver.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="debugscriptserver"/>
</Unit6>
</Units>
</ProjectOptions>
@ -95,7 +91,7 @@
<Other>
<ExecuteAfter>
<Command Value="codesign -s fpdebug fpdserver"/>
<CompileReasons Run="False"/>
<CompileReasons Compile="False" Build="False" Run="False"/>
</ExecuteAfter>
</Other>
</CompilerOptions>

2
components/fpdebug/app/fpdserver/fpdserver.lpr
View File

@ -214,7 +214,7 @@ var
begin
Application:=TFPDServerApplication.Create(nil);
CustomApplication:=Application;
Application.Title:='FPDebug Server';
Application.Title := 'FPD Server';
Application.Run;
Application.Free;
end.

40
components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebugger.pas
View File

@ -13,8 +13,10 @@ uses
DbgIntfBaseTypes,
maps,
fpjson,
jsonparser,
// jsonparser,
{$IFDEF UNIX}
BaseUnix,
{$ENDIF}
LazLoggerBase,
process,
dialogs,
@ -153,11 +155,11 @@ type
TFPDSendRemoveBreakpointCommand = class(TFPDSendCommand)
private
FLocation: TDBGPtr;
FId: Integer;
protected
procedure ComposeJSon(AJsonObject: TJSONObject); override;
public
constructor create(ALocation: TDBGPtr); virtual;
constructor create(AnId: Integer); virtual;
end;
{ TFPDSendDoCurrentCommand }
@ -352,6 +354,7 @@ type
FResetBreakFlag: boolean;
FIsSet: boolean;
FUID: integer;
FServerId: integer;
procedure SetBreak;
procedure ResetBreak;
protected
@ -365,6 +368,7 @@ type
public
destructor Destroy; override;
property UID: integer read FUID;
property ServerId: Integer read FServerId write FServerId;
end;
{ TFPBreakpoints }
@ -372,6 +376,7 @@ type
TFPBreakpoints = class(TDBGBreakPoints)
public
function FindByUID(AnUID: integer): TFPBreakpoint;
function FindByServerID(AnServerID: integer): TFPBreakpoint;
end;
{ TFPDBGDisassembler }
@ -734,13 +739,13 @@ procedure TFPDSendRemoveBreakpointCommand.ComposeJSon(AJsonObject: TJSONObject);
begin
inherited ComposeJSon(AJsonObject);
AJsonObject.Add('command','removebreakpoint');
AJsonObject.Add('location', Dec2Numb(FLocation, 8, 16));
AJsonObject.Add('BreakpointServerIdr', Dec2Numb(FId, 8, 16));
end;
constructor TFPDSendRemoveBreakpointCommand.create(ALocation: TDBGPtr);
constructor TFPDSendRemoveBreakpointCommand.create(AnId: Integer);
begin
inherited create;
FLocation:=ALocation;
FId:=AnId;
end;
{ TFPDSendResetBreakpointCommand }
@ -909,6 +914,19 @@ begin
result := nil;
end;
function TFPBreakpoints.FindByServerID(AnServerID: integer): TFPBreakpoint;
var
i: integer;
begin
for i := 0 to Count-1 do
if TFPBreakpoint(Items[i]).ServerId=AnServerID then
begin
result := TFPBreakpoint(Items[i]);
exit;
end;
result := nil;
end;
{ TFPDSocketThread }
procedure TFPDSocketThread.ReceivedCommand(Data: PtrInt);
@ -1011,7 +1029,9 @@ begin
else
begin
// Set non-blocking
{$IFDEF UNIX}
fpfcntl(ASocket.Handle,F_SETFL,O_NONBLOCK);
{$ENDIF}
// Read and check FPDebug Server greeting
s := ReadSTringTimeout(100);
@ -1242,14 +1262,14 @@ end;
procedure TFPDServerDebugger.DoHandleBreakpointEvent(AnEvent: TJSONObject);
var
BrkLocation: string;
BrkId: Integer;
Brk: TDBGBreakPoint;
Continue: boolean;
begin
BrkLocation:=AnEvent.Get('breakpointLocation','');
if BrkLocation<>'' then
BrkId:=AnEvent.Get('BreakpointServerIdr',0);
if BrkId<>0 then
begin
Brk := BreakPoints.Find(Hex2Dec(BrkLocation));
Brk := TFPBreakPoints(BreakPoints).FindByServerID(BrkId);
if not assigned(brk) then
debugln('Break on unknown breakpoint')
else

4
components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebuggercommands.inc
View File

@ -108,7 +108,7 @@ begin
ABreakpoint := TFPBreakpoints(FServerDebugger.BreakPoints).FindByUID(CommandUID);
if assigned(ABreakpoint) then
begin
ABreakpoint.Address:=0;
ABreakpoint.ServerId:=0;
ABreakpoint.SetInvalid;
ABreakpoint.DoChanged;
end;
@ -121,7 +121,7 @@ begin
ABreakpoint := TFPBreakpoints(FServerDebugger.BreakPoints).FindByUID(CommandUID);
if assigned(ABreakpoint) then
begin
ABreakpoint.Address:=Hex2Dec(ACommandResponse.get('breakpointLocation','0'));
ABreakpoint.ServerId :=StrToInt(ACommandResponse.get('BreakpointServerIdr','0'));
ABreakpoint.SetValid;
ABreakpoint.DoChanged;
end;