From f737797457740c35a075eab0adad829481c90d32 Mon Sep 17 00:00:00 2001 From: martin Date: Wed, 9 Jan 2019 20:50:23 +0000 Subject: [PATCH] FpDebugServer: fix compilation / support multiple addresses per breakpoint git-svn-id: trunk@60048 - --- .../app/fpdserver/debuginoutputprocessor.pas | 4 +- .../fpdebug/app/fpdserver/debugtcpserver.pas | 4 + .../fpdebug/app/fpdserver/debugthread.pas | 110 ++++++++++++--- .../app/fpdserver/debugthreadcommand.pas | 126 +++++++++--------- .../fpdebug/app/fpdserver/fpdserver.lpi | 16 +-- .../fpdebug/app/fpdserver/fpdserver.lpr | 2 +- .../fpdserverdebugger.pas | 40 ++++-- .../fpdserverdebuggercommands.inc | 4 +- 8 files changed, 202 insertions(+), 104 deletions(-) diff --git a/components/fpdebug/app/fpdserver/debuginoutputprocessor.pas b/components/fpdebug/app/fpdserver/debuginoutputprocessor.pas index 8a24cb98d0..045dc3c211 100644 --- a/components/fpdebug/app/fpdserver/debuginoutputprocessor.pas +++ b/components/fpdebug/app/fpdserver/debuginoutputprocessor.pas @@ -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 diff --git a/components/fpdebug/app/fpdserver/debugtcpserver.pas b/components/fpdebug/app/fpdserver/debugtcpserver.pas index 21fb14e7bf..9414c3ff94 100644 --- a/components/fpdebug/app/fpdserver/debugtcpserver.pas +++ b/components/fpdebug/app/fpdserver/debugtcpserver.pas @@ -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; diff --git a/components/fpdebug/app/fpdserver/debugthread.pas b/components/fpdebug/app/fpdserver/debugthread.pas index c47c8b3bc1..f846e199a5 100644 --- a/components/fpdebug/app/fpdserver/debugthread.pas +++ b/components/fpdebug/app/fpdserver/debugthread.pas @@ -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; + 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; diff --git a/components/fpdebug/app/fpdserver/debugthreadcommand.pas b/components/fpdebug/app/fpdserver/debugthreadcommand.pas index 52aa140b9b..af0c695b1f 100644 --- a/components/fpdebug/app/fpdserver/debugthreadcommand.pas +++ b/components/fpdebug/app/fpdserver/debugthreadcommand.pas @@ -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; diff --git a/components/fpdebug/app/fpdserver/fpdserver.lpi b/components/fpdebug/app/fpdserver/fpdserver.lpi index b5909a54ac..7335f04560 100644 --- a/components/fpdebug/app/fpdserver/fpdserver.lpi +++ b/components/fpdebug/app/fpdserver/fpdserver.lpi @@ -1,7 +1,7 @@ - + @@ -15,9 +15,6 @@ - - - @@ -25,9 +22,10 @@ - - - + + + + @@ -45,7 +43,6 @@ - @@ -70,7 +67,6 @@ - @@ -95,7 +91,7 @@ - + diff --git a/components/fpdebug/app/fpdserver/fpdserver.lpr b/components/fpdebug/app/fpdserver/fpdserver.lpr index 0d21f287a7..969bcc3bd2 100644 --- a/components/fpdebug/app/fpdserver/fpdserver.lpr +++ b/components/fpdebug/app/fpdserver/fpdserver.lpr @@ -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. diff --git a/components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebugger.pas b/components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebugger.pas index b7864fb1f9..4aaf4e87ca 100644 --- a/components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebugger.pas @@ -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 diff --git a/components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebuggercommands.inc b/components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebuggercommands.inc index d0615d59d4..f336e0d0c1 100644 --- a/components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebuggercommands.inc +++ b/components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebuggercommands.inc @@ -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;