{ $Id$ } { /*************************************************************************** debugmanager.pp --------------- TDebugManager controls all debugging related stuff in the IDE. ***************************************************************************/ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** } unit DebugManager; {$mode objfpc}{$H+} interface {$I ide.inc} {off $define VerboseDebugger} uses {$IFDEF IDE_MEM_CHECK} MemCheck, {$ENDIF} Classes, SysUtils, math, // LCL LCLType, LCLIntf, Forms, Controls, Dialogs, ExtCtrls, // LazUtils LazFileUtils, LazFileCache, LazLoggerBase, Laz2_XMLCfg, LazUTF8, LazTracer, LazMethodList, // Codetools CodeCache, CodeToolManager, PascalParserTool, CodeTree, // BuildIntf ProjectIntf, CompOptsIntf, // IDEIntf IDEWindowIntf, SrcEditorIntf, MenuIntf, IDECommands, LazIDEIntf, IdeIntfStrConsts, IDEDialogs, ToolBarIntf, InputHistory, // DebuggerIntf DbgIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfMiscClasses, DbgIntfPseudoTerminal, // LazDebuggerIntf LazDebuggerIntf, LazDebuggerIntfBaseTypes, // IDEDebugger IdeDebuggerStringConstants, DebuggerDlg, WatchesDlg, BreakPointsdlg, BreakPropertyDlg, LocalsDlg, WatchPropertyDlg, CallStackDlg, EvaluateDlg, RegistersDlg, AssemblerDlg, DebugOutputForm, ExceptionDlg, InspectDlg, PseudoTerminalDlg, FeedbackDlg, ThreadDlg, HistoryDlg, ProcessDebugger, IdeDebuggerBase, IdeDebuggerOpts, EnvDebuggerOptions, IdeDebuggerBackendValueConv, Debugger, BaseDebugManager, // IdeConfig LazConf, // IDE CompilerOptions, SourceEditor, ProjectDefs, Project, LazarusIDEStrConsts, MainBar, MainIntf, MainBase, BaseBuildManager, SourceMarks, DebugEventsForm, EnvGuiOptions; type { TDebugEventLogManager } TDebugEventLogManager = class(TObject, TDebuggerEventLogInterface) private FEventDialog: TDbgEventsForm; FHiddenDebugEventsLog: TStringList; FTargetWidth: Integer; procedure SetEventDialog(AValue: TDbgEventsForm); function FormatBreakPointAddress(const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec): String; protected procedure DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String); public procedure LogCustomEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String); procedure LogEventBreakPointHit(const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec); procedure LogEventWatchPointTriggered(const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec; const AOldWatchedVal, ANewWatchedVal: String); procedure LogEventWatchPointScope(const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec); public destructor Destroy; override; procedure ClearDebugEventsLog; property EventDialog: TDbgEventsForm read FEventDialog write SetEventDialog; property TargetWidth: Integer read FTargetWidth write FTargetWidth; end; { TDebugManager } TDebugManager = class(TBaseDebugManager) procedure DebuggerIdle(Sender: TObject); function DoProjectClose(Sender: TObject; AProject: TLazProject): TModalResult; procedure DoProjectModified(Sender: TObject); private FAsmWindowShouldAutoClose: Boolean; procedure BreakAutoContinueTimer(Sender: TObject); procedure OnRunTimer(Sender: TObject); // Menu events procedure mnuViewDebugDialogClick(Sender: TObject); procedure mnuResetDebuggerClicked(Sender: TObject); procedure mnuAddWatchClicked(Sender: TObject); procedure mnuAddBpAddress(Sender: TObject); procedure mnuAddBpSource(Sender: TObject); procedure mnuAddBpData(Sender: TObject); procedure mnuAddBpDataAtCursor(Sender: TObject); // Debugger events procedure DebuggerBreakPointHit({%H-}ADebugger: TDebuggerIntf; ABreakPoint: TBaseBreakPoint; var {%H-}ACanContinue: Boolean); procedure DebuggerBeforeChangeState(ADebugger: TDebuggerIntf; AOldState: TDBGState); procedure DebuggerChangeState(ADebugger: TDebuggerIntf; OldState: TDBGState); procedure DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec); procedure DoDebuggerCurrentLine(Sender: TObject); procedure DebuggerOutput(Sender: TObject; const AText: String); procedure DebuggerConsoleOutput(Sender: TObject; const AText: String); function DebuggerFeedback(Sender: TObject; const AText, AInfo: String; AType: TDBGFeedbackType; AButtons: TDBGFeedbackResults): TDBGFeedbackResult; procedure DebuggerException(Sender: TObject; const AExceptionType: TDBGExceptionType; const AExceptionClass: String; const AExceptionLocation: TDBGLocationRec; const AExceptionText: String; out AContinue: Boolean); // Dialog events procedure DebugDialogDestroy(Sender: TObject); private FDebugger: TDebuggerIntf; FEventLogManager: TDebugEventLogManager; FUnitInfoProvider: TDebuggerUnitInfoProvider; FDialogs: array[TDebugDialogType] of TDebuggerDlg; FInStateChange: Boolean; FPrevShownWindow: HWND; FStepping, FAsmStepping: Boolean; // keep track of the last reported location FCurrentLocation: TDBGLocationRec; FCallStackNotification: TCallStackNotification; // last hit breakpoint FCurrentBreakpoint: TIDEBreakpoint; FAutoContinueTimer: TTimer; FIsInitializingDebugger: Boolean; FStateNotificationList, FWatchesInvalidatedNotificationList: TMethodList; // When a source file is not found, the user can choose one // here are all choices stored FUserSourceFiles: TStringList; // when the debug output log is not open, store the debug log internally FHiddenDebugOutputLog: TStringList; FRunTimer: TTimer; FAttachToID: String; procedure SetDebugger(const ADebugger: TDebuggerIntf); // Breakpoint routines procedure CreateSourceMarkForBreakPoint(const ABreakpoint: TIDEBreakPoint; ASrcEdit: TSourceEditor); procedure GetSourceEditorForBreakPoint(const ABreakpoint: TIDEBreakPoint; var ASrcEdit: TSourceEditor); // Dialog routines procedure DestroyDebugDialog(const ADialogType: TDebugDialogType); procedure InitDebugOutputDlg; procedure InitDebugEventsDlg; procedure InitBreakPointDlg; procedure InitWatchesDlg; procedure InitThreadsDlg; procedure InitPseudoTerminal; procedure InitLocalsDlg; procedure InitCallStackDlg; procedure InitEvaluateDlg; procedure InitRegistersDlg; procedure InitAssemblerDlg; procedure InitInspectDlg; procedure InitHistoryDlg; procedure FreeDebugger; procedure ResetDebugger; function GetLaunchPathAndExe(out LaunchingCmdLine, LaunchingApplication, LaunchingParams: String; PromptOnError: Boolean = True): Boolean; protected function GetState: TDBGState; override; function GetCommands: TDBGCommands; override; function GetPseudoTerminal: TPseudoTerminal; override; function GetDebuggerClass: TDebuggerClass; {$IFDEF DBG_WITH_DEBUGGER_DEBUG} function GetDebugger: TDebuggerIntf; override; {$ENDIF} function GetCurrentDebuggerClass: TDebuggerClass; override; (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *) function AttachDebugger: TModalResult; procedure CallWatchesInvalidatedHandlers(Sender: TObject); function GetAvailableCommands: TDBGCommands; function CanRunDebugger: Boolean; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; procedure Reset; override; procedure ConnectMainBarEvents; override; procedure ConnectSourceNotebookEvents; override; procedure SetupMainBarShortCuts; override; procedure SetupSourceMenuShortCuts; override; procedure UpdateButtonsAndMenuItems; override; procedure UpdateToolStatus; override; procedure EnvironmentOptsChanged; override; procedure LoadProjectSpecificInfo(XMLConfig: TXMLConfig; Merge: boolean); procedure SaveProjectSpecificInfo(XMLConfig: TXMLConfig; Flags: TProjectWriteFlags); procedure DoRestoreDebuggerMarks(AnUnitInfo: TUnitInfo); procedure ClearDebugOutputLog; procedure ClearDebugEventsLog; procedure DoBackendConverterChanged; override; function RequiredCompilerOpts(ATargetCPU, ATargetOS: String ): TDebugCompilerRequirements; override; function InitDebugger(AFlags: TDbgInitFlags = []): Boolean; override; function DoSetBreakkPointWarnIfNoDebugger: boolean; function DoPauseProject: TModalResult; override; function DoShowExecutionPoint: TModalResult; override; function DoStepIntoProject: TModalResult; override; function DoStepOverProject: TModalResult; override; function DoStepIntoInstrProject: TModalResult; override; function DoStepOverInstrProject: TModalResult; override; function DoStepOutProject: TModalResult; override; function DoStepToCursor: TModalResult; override; function DoRunToCursor: TModalResult; override; function DoStopProject: TModalResult; override; procedure DoToggleCallStack; override; procedure DoSendConsoleInput(AText: String); override; procedure ProcessCommand(Command: word; var Handled: boolean); override; //Some debuugers may do things like ProcessMessages while processing commands //and that can cause side-effects //The debugger may run it's queue either during UnLockCommandProcessing or later procedure LockCommandProcessing; override; procedure UnLockCommandProcessing; override; function StartDebugging: TModalResult; override; // returns immediately function RunDebugger: TModalResult; override; // waits till program ends procedure EndDebugging; override; procedure Attach(AProcessID: String); override; function FillProcessList(AList: TRunningProcessInfoList): boolean; override; procedure Detach; override; function Evaluate(const AExpression: String; ACallback: TDBGEvaluateResultCallback; EvalFlags: TWatcheEvaluateFlags = []): Boolean; override; function Modify(const AExpression, ANewValue: String): Boolean; override; procedure EvaluateModify(const AExpression: String; AWatch: TWatch = nil); override; procedure Inspect(const AExpression: String; AWatch: TWatch = nil); override; function GetFullFilename(const AUnitinfo: TDebuggerUnitInfo; out Filename: string; AskUserIfNotFound: Boolean): Boolean; override; function GetFullFilename(var Filename: string; AskUserIfNotFound: Boolean): Boolean; override; procedure JumpToUnitSource(AFileName: String; ALine: Integer; AMapLineFromDebug: Boolean = True); override; procedure JumpToUnitSource(AnUnitInfo: TDebuggerUnitInfo; ALine: Integer; AMapLineFromDebug: Boolean = True); override; function DoCreateBreakPoint(const AFilename: string; ALine: integer; WarnIfNoDebugger: boolean): TModalResult; override; function DoCreateBreakPoint(const AFilename: string; ALine: integer; WarnIfNoDebugger: boolean; out ABrkPoint: TIDEBreakPoint; AnUpdating: Boolean = False): TModalResult; override; function DoCreateBreakPoint(const AnAddr: TDBGPtr; WarnIfNoDebugger: boolean; out ABrkPoint: TIDEBreakPoint; AnUpdating: Boolean = False): TModalResult; override; function DoDeleteBreakPoint(const AFilename: string; ALine: integer): TModalResult; override; function DoDeleteBreakPointAtMark(const ASourceMarkObj: TObject): TModalResult; override; function ShowBreakPointProperties(const ABreakpoint: TIDEBreakPoint): TModalresult; override; function ShowWatchProperties(const AWatch: TCurrentWatch; AWatchExpression: String = ''): TModalresult; override; // Dialog routines procedure CreateDebugDialog(Sender: TObject; aFormName: string; var AForm: TCustomForm; DoDisableAutoSizing: boolean); override; procedure ViewDebugDialog(const ADialogType: TDebugDialogType; BringToFront: Boolean = true; Show: Boolean = true; DoDisableAutoSizing: boolean = false; InitFromSourceEdit: boolean = True ); override; procedure ViewDisassembler(AnAddr: TDBGPtr; BringToFront: Boolean = True; Show: Boolean = true; DoDisableAutoSizing: boolean = false); override; procedure RegisterStateChangeHandler(AHandler: TDebuggerStateChangeNotification); override; procedure UnregisterStateChangeHandler(AHandler: TDebuggerStateChangeNotification); override; procedure RegisterWatchesInvalidatedHandler(AHandler: TNotifyEvent); override; procedure UnregisterWatchesInvalidatedHandler(AHandler: TNotifyEvent); override; end; function GetDebugManager: TDebugManager; property DebugBossMgr: TDebugManager read GetDebugManager; function DBGDateTimeFormatter(const aValue: string): string; function ResolveLocationForLaunchApplication(ALaunchApp: String): String; implementation var DBG_LOCATION_INFO: PLazLoggerLogGroup; function GetDebugManager: TDebugManager; begin Result := TDebugManager(DebugBoss); end; function DBGDateTimeFormatter(const aValue: string): string; var FS: TFormatSettings; MyDate: Extended; begin FillChar(FS{%H-}, SizeOf(TFormatSettings), 0); FS.DecimalSeparator := '.'; if TryStrToFloat(aValue, MyDate, FS) then begin // it is important to know datetime for all TDate/TTime/TDateTime if SameValue(Frac(MyDate), 0) then Result := DateToStr(MyDate) else if SameValue(Int(MyDate), 0) then Result := TimeToStr(MyDate) else Result := DateTimeToStr(MyDate); end else Result := aValue; end; function ResolveLocationForLaunchApplication(ALaunchApp: String): String; var tmp: String; begin Result := ALaunchApp; if not FilenameIsAbsolute(ALaunchApp) then begin tmp := CreateAbsolutePath(ALaunchApp, Project1.Directory); if FileIsExecutable(tmp) then begin Result := tmp; end else if ExtractFilePath(ALaunchApp) = '' then begin tmp := FindDefaultExecutablePath(ALaunchApp); if tmp <> '' then Result := tmp; end; end; end; type { TManagedBreakPoint } TManagedBreakPoint = class(TIDEBreakPoint) private FSourceMark: TSourceMark; FCurrentDebugExeLine: Integer; procedure OnSourceMarkBeforeFree(Sender: TObject); procedure OnSourceMarkCreatePopupMenu(SenderMark: TSourceMark; const AddMenuItem: TAddMenuItemProc); procedure OnSourceMarkGetHint(SenderMark: TSourceMark; var Hint: string); procedure OnSourceMarkPositionChanged(Sender: TObject); procedure OnToggleEnableMenuItemClick(Sender: TObject); procedure OnDeleteMenuItemClick(Sender: TObject); procedure OnViewPropertiesMenuItemClick(Sender: TObject); protected procedure DoChanged; override; procedure SetSourceMark(const AValue: TSourceMark); procedure UpdateSourceMark; procedure UpdateSourceMarkImage; procedure UpdateSourceMarkLineColor; function DebugExeLine: Integer; override; // If known, the line in the compiled exe public procedure CopySourcePositionToBreakPoint; procedure SetLocation(const ASource: String; const ALine: Integer); override; property SourceMark: TSourceMark read FSourceMark write SetSourceMark; end; { TManagedBreakPoints } TManagedBreakPoints = class(TIDEBreakPoints) private FManager: TDebugManager; protected procedure NotifyAdd(const ABreakPoint: TIDEBreakPoint); override; procedure NotifyRemove(const ABreakPoint: TIDEBreakPoint); override; procedure Update(Item: TCollectionItem); override; public constructor Create(const AManager: TDebugManager); end; { TProjectExceptions } TProjectExceptions = class(TIDEExceptions) protected procedure SetIgnoreAll(const AValue: Boolean); override; procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; procedure Update(Item: TCollectionItem); override; end; { TDebugEventLogManager } procedure TDebugEventLogManager.SetEventDialog(AValue: TDbgEventsForm); begin if FEventDialog = AValue then Exit; If AValue = nil then begin if FHiddenDebugEventsLog=nil then FHiddenDebugEventsLog:=TStringList.Create; FEventDialog.GetEvents(FHiddenDebugEventsLog); end else if FHiddenDebugEventsLog <> nil then begin AValue.SetEvents(FHiddenDebugEventsLog); FreeAndNil(FHiddenDebugEventsLog); end; FEventDialog := AValue; end; function TDebugEventLogManager.FormatBreakPointAddress( const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec): String; var SrcName: String; begin SrcName := ALocation.SrcFullName; if SrcName = '' then SrcName := ALocation.SrcFile; if SrcName <> '' then Result := Format(dbgEventBreakAtAddressSourceLine, [IntToHex(ALocation.Address, FTargetWidth), SrcName, ALocation.SrcLine]) else if (ABreakpoint <> nil) and (ABreakPoint.Kind = bpkSource) then Result := Format(dbgEventBreakAtAddressOriginSourceOriginLine, [IntToHex(ALocation.Address, FTargetWidth), ABreakpoint.Source, ABreakpoint.Line]) else Result := Format(dbgEventBreakAtAddress, [IntToHex(ALocation.Address, FTargetWidth)]); end; procedure TDebugEventLogManager.DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String); var Rec: TDBGEventRec; begin if EventDialog <> nil then begin EventDialog.AddEvent(ACategory, AEventType, AText) end else begin // store it internally, and copy it to the dialog, when the user opens it if FHiddenDebugEventsLog=nil then FHiddenDebugEventsLog := TStringList.Create; if EnvironmentDebugOpts.DebuggerEventLogCheckLineLimit then begin while FHiddenDebugEventsLog.Count >= EnvironmentDebugOpts.DebuggerEventLogLineLimit do FHiddenDebugEventsLog.Delete(0); end; Rec.Category := Ord(ACategory); Rec.EventType := Ord(AEventType); FHiddenDebugEventsLog.AddObject(AText, TObject(Rec.Ptr)); end; end; procedure TDebugEventLogManager.LogCustomEvent( const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String); begin DebuggerEvent(nil, ACategory, AEventType, AText); end; procedure TDebugEventLogManager.LogEventBreakPointHit( const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec); var Msg: String; begin if ABreakpoint = nil then Msg := dbgEventBreakUnknownBreakPoint else case ABreakPoint.Kind of bpkSource: Msg := dbgEventBreakSourceBreakPoint; bpkAddress: Msg := dbgEventBreakAddressBreakPoint; bpkData: Msg := dbgEventBreakWatchPoint; // should not be here, use LogEventWatchPointTriggered(); end; LogCustomEvent(ecBreakpoint, etBreakpointHit, Format(Msg, [FormatBreakPointAddress(ABreakpoint, ALocation)])); end; procedure TDebugEventLogManager.LogEventWatchPointTriggered( const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec; const AOldWatchedVal, ANewWatchedVal: String); var Msg, Loc: String; begin Loc := FormatBreakPointAddress(ABreakpoint, ALocation); if ABreakpoint = nil then Msg := Format(dbgEventUnknownWatchPointTriggered, [Loc, AOldWatchedVal, ANewWatchedVal]) else case ABreakPoint.Kind of bpkSource: Msg := Format(dbgEventBreakSourceBreakPoint , [Loc]); // should not be here bpkAddress: Msg := Format(dbgEventBreakAddressBreakPoint, [Loc]); // should not be here bpkData: Msg := Format(dbgEventWatchTriggered, [ABreakpoint.WatchData, Loc, AOldWatchedVal, ANewWatchedVal]); end; LogCustomEvent(ecBreakpoint, etBreakpointHit, Msg ); end; procedure TDebugEventLogManager.LogEventWatchPointScope( const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec); var Msg, Loc: String; begin Loc := FormatBreakPointAddress(ABreakpoint, ALocation); if ABreakpoint = nil then Msg := Format(dbgEventUnknownWatchPointScopeEnded, [Loc]) else case ABreakPoint.Kind of bpkSource: Msg := Format(dbgEventBreakSourceBreakPoint , [Loc]); // should not be here bpkAddress: Msg := Format(dbgEventBreakAddressBreakPoint, [Loc]); // should not be here bpkData: Format(dbgEventWatchScopeEnded, [ABreakpoint.WatchData, Loc]) end; LogCustomEvent(ecBreakpoint, etBreakpointHit, Msg ); end; destructor TDebugEventLogManager.Destroy; begin FreeAndNil(FHiddenDebugEventsLog); inherited Destroy; end; procedure TDebugEventLogManager.ClearDebugEventsLog; begin if EventDialog <> nil then EventDialog.Clear; FreeAndNil(FHiddenDebugEventsLog); end; { TProjectExceptions } procedure TProjectExceptions.SetIgnoreAll(const AValue: Boolean); begin // Todo: move to Changed or Update, but they are called too often... if (IgnoreAll <> AValue) and (Project1 <> nil) then Project1.Modified := True; inherited SetIgnoreAll(AValue); end; procedure TProjectExceptions.Notify(Item: TCollectionItem; Action: TCollectionNotification); begin inherited Notify(Item, Action); if Project1 <> nil then Project1.Modified := True; end; procedure TProjectExceptions.Update(Item: TCollectionItem); begin inherited Update(Item); if Project1 <> nil then Project1.Modified := True; end; { TManagedBreakPoints } constructor TManagedBreakPoints.Create(const AManager: TDebugManager); begin FManager := AManager; inherited Create(TManagedBreakPoint); end; procedure TManagedBreakPoints.NotifyAdd(const ABreakPoint: TIDEBreakPoint); begin {$ifdef VerboseDebugger} debugln('TManagedBreakPoints.NotifyAdd A ',ABreakpoint.Source,' ',IntToStr(ABreakpoint.Line)); {$endif} inherited; FManager.CreateSourceMarkForBreakPoint(ABreakpoint,nil); Project1.Modified := True; end; procedure TManagedBreakPoints.NotifyRemove(const ABreakPoint: TIDEBreakPoint); begin {$ifdef VerboseDebugger} debugln(['TManagedBreakPoints.NotifyRemove A ',ABreakpoint.Source,' ',ABreakpoint.Line,' ',TManagedBreakPoint(ABreakpoint).SourceMark <> nil]); {$endif} inherited; if FManager.FCurrentBreakpoint = ABreakPoint then FManager.FCurrentBreakpoint := nil; TManagedBreakPoint(ABreakpoint).SourceMark.Free; if Project1 <> nil then Project1.Modified := True; end; procedure TManagedBreakPoints.Update(Item: TCollectionItem); begin inherited Update(Item); if (Project1 <> nil) and (Item is TIDEBreakPoint) and (TIDEBreakPoint(Item).UserModified) then begin Project1.Modified := True; TIDEBreakPoint(Item).UserModified := False; end; end; { TManagedBreakPoint } procedure TManagedBreakPoint.SetSourceMark(const AValue: TSourceMark); begin if FSourceMark=AValue then exit; if FSourceMark<>nil then begin FSourceMark.RemoveAllHandlersForObject(Self); FSourceMark.Data:=nil; end; FSourceMark:=AValue; if FSourceMark<>nil then begin FSourceMark.IncChangeLock; FSourceMark.AddPositionChangedHandler(@OnSourceMarkPositionChanged); FSourceMark.AddBeforeFreeHandler(@OnSourceMarkBeforeFree); FSourceMark.Data:=Self; FSourceMark.IsBreakPoint:=true; FSourceMark.Line:=Line; FSourceMark.Visible:=true; FSourceMark.AddGetHintHandler(@OnSourceMarkGetHint); FSourceMark.AddCreatePopupMenuHandler(@OnSourceMarkCreatePopupMenu); UpdateSourceMark; FSourceMark.DecChangeLock; end; end; procedure TManagedBreakPoint.OnSourceMarkPositionChanged(Sender: TObject); begin CopySourcePositionToBreakPoint; end; procedure TManagedBreakPoint.OnToggleEnableMenuItemClick(Sender: TObject); begin Enabled:=not Enabled; end; procedure TManagedBreakPoint.OnDeleteMenuItemClick(Sender: TObject); begin ReleaseReference; end; procedure TManagedBreakPoint.OnViewPropertiesMenuItemClick(Sender: TObject); begin DebugBoss.ShowBreakPointProperties(Self); end; procedure TManagedBreakPoint.OnSourceMarkBeforeFree(Sender: TObject); begin SourceMark:=nil; end; procedure TManagedBreakPoint.OnSourceMarkGetHint(SenderMark: TSourceMark; var Hint: string); begin Hint := GetBreakPointStateDescription(Self) + LineEnding + Format('%s: %d' + LineEnding + '%s %s' + LineEnding + '%s: %s', [lisHitCount, Hitcount, lisAction, GetBreakPointActionsDescription(Self), lisCondition, Expression]); if SenderMark<>nil then ; end; procedure TManagedBreakPoint.OnSourceMarkCreatePopupMenu( SenderMark: TSourceMark; const AddMenuItem: TAddMenuItemProc); begin if Enabled then AddMenuItem(lisDisableBreakPoint, True, @OnToggleEnableMenuItemClick) else AddMenuItem(lisEnableBreakPoint, True, @OnToggleEnableMenuItemClick); AddMenuItem(lisDeleteBreakPoint, True, @OnDeleteMenuItemClick); AddMenuItem(lisViewBreakPointProperties, True, @OnViewPropertiesMenuItemClick); if SenderMark<>nil then ; end; procedure TManagedBreakPoint.DoChanged; begin inherited DoChanged; UpdateSourceMark; end; procedure TManagedBreakPoint.CopySourcePositionToBreakPoint; begin if FSourceMark=nil then exit; SetLocation(Source,FSourceMark.Line); end; procedure TManagedBreakPoint.SetLocation(const ASource: String; const ALine: Integer); var NewDebugExeLine: Integer; begin NewDebugExeLine := DebugExeLine; if (Source = ASource) and (Line = ALine) and (FCurrentDebugExeLine = NewDebugExeLine) then exit; inherited SetLocation(ASource, ALine); FCurrentDebugExeLine := NewDebugExeLine; if Project1 <> nil then Project1.Modified := True; end; procedure TManagedBreakPoint.UpdateSourceMarkImage; var Img: Integer; begin if SourceMark = nil then Exit; case Valid of vsValid: if Enabled then Img := SourceEditorMarks.ActiveBreakPointImg else Img := SourceEditorMarks.InactiveBreakPointImg; vsInvalid: if Enabled then Img := SourceEditorMarks.InvalidBreakPointImg else Img := SourceEditorMarks.InvalidDisabledBreakPointImg; vsPending: if Enabled then Img := SourceEditorMarks.PendingBreakPointImg else Img := SourceEditorMarks.InactiveBreakPointImg; else if Enabled then Img := SourceEditorMarks.UnknownBreakPointImg else Img := SourceEditorMarks.UnknownDisabledBreakPointImg; end; SourceMark.ImageIndex := Img; end; procedure TManagedBreakPoint.UpdateSourceMarkLineColor; var aha: TAdditionalHilightAttribute; begin if SourceMark = nil then Exit; aha := ahaNone; case Valid of vsValid: if Enabled then aha := ahaEnabledBreakpoint else aha := ahaDisabledBreakpoint; vsInvalid: if Enabled then aha := ahaInvalidBreakpoint else aha := ahaDisabledBreakpoint; else if Enabled then aha := ahaUnknownBreakpoint else aha := ahaDisabledBreakpoint; end; SourceMark.LineColorAttrib := aha; end; function TManagedBreakPoint.DebugExeLine: Integer; var se: TSourceEditor; begin Result := Line; if (FSourceMark <> nil) and (FSourceMark.SourceEditor <> nil) then Result := TSourceEditor(FSourceMark.SourceEditor).SourceToDebugLine(Line) else begin se := SourceEditorManager.SourceEditorIntfWithFilename(Source); if se <> nil then Result := se.SourceToDebugLine(Line); end; end; procedure TManagedBreakPoint.UpdateSourceMark; begin if SourceMark = nil then Exit; SourceMark.IncChangeLock; SourceMark.Line := Line; UpdateSourceMarkImage; UpdateSourceMarkLineColor; SourceMark.DecChangeLock; end; // Helper function for TDebugManager.GetFullFilename. function FindFullFilenameSrc(const AUnitinfo: TDebuggerUnitInfo): boolean; var SrcUnitName: String; SrcInFilename: String; SrcFilename: String; Code: TCodeBuffer; ProcDef: String; CurCodeTool: TCodeTool; CurCodeNode: TCodeTreeNode; CodePos: TCodeXYPosition; begin Result:=false; // search unit in project unit path SrcUnitName := AUnitinfo.UnitName; SrcInFilename := ''; with CodeToolBoss.DirectoryCachePool do SrcFilename := FindUnitSourceInCompletePath('', SrcUnitName, SrcInFilename); if SrcFilename='' then exit; // load unit Code := CodeToolBoss.LoadFile(SrcFilename,true,false); if Code=nil then exit; // read error // procedure declaration: classname.functionname ProcDef := ''; if AUnitinfo.SrcClassName<>'' then ProcDef := AUnitinfo.SrcClassName+'.'; ProcDef := ProcDef+AUnitinfo.FunctionName; // search proc in unit if not CodeToolBoss.FindProcDeclaration(Code,ProcDef,CurCodeTool,CurCodeNode, [phpWithoutParamList,phpWithoutBrackets,phpWithoutClassKeyword,phpWithoutSemicolon]) then exit; // get file, line, column if CurCodeNode.Desc=ctnProcedure then CurCodeNode := CurCodeNode.FirstChild; // jump to Name instead of keyword 'procedure' if not CurCodeTool.CleanPosToCaret(CurCodeNode.StartPos,CodePos) then exit; AUnitinfo.LocationFullFile := CodePos.Code.Filename; AUnitinfo.SrcLine := CodePos.Y; //DumpStack; Result:=true; end; function TDebugManager.GetFullFilename(const AUnitinfo: TDebuggerUnitInfo; out Filename: string; AskUserIfNotFound: Boolean): Boolean; function ResolveFromDbg: Boolean; begin Filename := AUnitinfo.FileName; Result := (Filename<>'') and GetFullFilename(Filename, False) and FileExistsUTF8(Filename); if Result then Exit; Filename := AUnitinfo.DbgFullName; if Filename='' then Exit(False); Result := FileExistsUTF8(Filename); if not Result then Result := GetFullFilename(Filename, AskUserIfNotFound); end; begin Result := False; if Destroying or (AUnitinfo = nil) then exit; Filename := AUnitinfo.LocationFullFile; Result := Filename <> ''; if (dlfSearchByFunctionName in AUnitinfo.Flags) and (AUnitinfo.FunctionName<>'') and FindFullFilenameSrc(AUnitinfo) then exit; case AUnitinfo.LocationType of dltUnknown: Result := ResolveFromDbg; dltUnresolvable: Result := False; dltProject: begin Filename := TrimFilename(AUnitinfo.LocationName); Filename := MainIDE.FindSourceFile(Filename, Project1.Directory, [fsfSearchForProject, fsfUseIncludePaths, fsfUseDebugPath, {fsfMapTempToVirtualFiles,} fsfSkipPackages]); Result := Filename <> ''; if not Result then Result := ResolveFromDbg; end; dltPackage: Result := ResolveFromDbg; end; if Result then AUnitinfo.LocationFullFile := Filename else begin Filename := AUnitinfo.FileName; if AskUserIfNotFound then AUnitinfo.LocationType := dltUnresolvable; end; end; function TDebugManager.GetFullFilename(var Filename: string; AskUserIfNotFound: Boolean): Boolean; var SrcFile, SrcFN, UserFilename: String; n: Integer; OpenDialog: TIDEOpenDialog; AnUnitInfo: TLazProjectFile; begin Result := False; if Destroying or (Filename = '') then exit; (* The below currently does not work for unsaved projects *) //Result := FilenameIsAbsolute(Filename); //if Result then exit; // TODO, check for virtual file, and flag it // Project1.IsVirtual // Left(Filename,1, xxx) = LazarusIDE.GetTestBuildDirectory // some debuggers (e.g. gdb) sometimes returns linux path delims under windows // => fix that Filename := TrimFilename(Filename); SrcFile := MainIDE.FindSourceFile(Filename, Project1.Directory, [fsfSearchForProject, fsfUseIncludePaths, fsfUseDebugPath{, fsfMapTempToVirtualFiles}]); if (SrcFile <> '') and (not FilenameIsAbsolute(SrcFile)) and (Project1.IsVirtual) and FileExistsUTF8(AppendPathDelim(LazarusIDE.GetTestBuildDirectory)+SrcFile) then SrcFile := AppendPathDelim(LazarusIDE.GetTestBuildDirectory)+SrcFile; if SrcFile = '' then SrcFile := Filename; SrcFN := ExtractFilenameOnly(SrcFile); if not FilenameIsAbsolute(SrcFile) then begin // first attempt to get a longer name // short file, look in the user list for n := 0 to FUserSourceFiles.Count - 1 do begin UserFilename := FUserSourceFiles[n]; if (CompareFileNames(SrcFN, ExtractFilenameOnly(UserFilename)) = 0) and FileExistsUTF8(UserFilename) then begin FUserSourceFiles.Move(n, 0); // move most recent first SrcFile := UserFilename; Break; end; end; end; if not FilenameIsAbsolute(SrcFile) then begin AnUnitInfo := Project1.FindFile(SrcFile, [pfsfOnlyEditorFiles]); if AnUnitInfo <> nil then begin // the file is an unsaved file -> can not be extended Result := True; Filename := SrcFile; Exit; end; end; if ((not FilenameIsAbsolute(SrcFile)) or (not FileExistsUTF8(SrcFile))) and AskUserIfNotFound then begin if IDEMessageDialog(lisFileNotFound, Format(lisTheFileWasNotFoundDoYouWantToLocateItYourself, [SrcFile, LineEnding]), mtConfirmation, [mbYes, mbNo]) <> mrYes then Exit; repeat OpenDialog:=IDEOpenDialogClass.Create(nil); try InputHistories.ApplyFileDialogSettings(OpenDialog); OpenDialog.Title:=lisOpenFile+' '+SrcFile; OpenDialog.Options:=OpenDialog.Options+[ofFileMustExist]; OpenDialog.FileName := SrcFile; if not OpenDialog.Execute then exit; SrcFile:=CleanAndExpandFilename(OpenDialog.FileName); InputHistories.StoreFileDialogSettings(OpenDialog); finally OpenDialog.Free; end; until FilenameIsAbsolute(SrcFile) and FileExistsUTF8(SrcFile); FUserSourceFiles.Insert(0, SrcFile); end; if (SrcFile<>'') and ( (not FilenameIsAbsolute(SrcFile)) or FileExistsUTF8(SrcFile) ) then begin Filename:=SrcFile; Result:=True; end; end; procedure TDebugManager.JumpToUnitSource(AFileName: String; ALine: Integer; AMapLineFromDebug: Boolean); var ok: Boolean; JmpFlags: TJumpToCodePosFlags; begin debugln(DBG_LOCATION_INFO, ['JumpToUnitSource Filename =', AFileName ]); // avoid any process-messages, so this proc can not be re-entered (avoid opening one files many times) LockCommandProcessing; try ok := false; JmpFlags := [jfAddJumpPoint, jfFocusEditor, jfMarkLine, jfSearchVirtualFullPath]; if AMapLineFromDebug then JmpFlags := JmpFlags + [jfMapLineFromDebug]; if FilenameIsAbsolute(AFilename) then ok := MainIDEInterface.DoJumpToSourcePosition(AFilename, 0, ALine, 0, JmpFlags) = mrOK; if not ok then MainIDEInterface.DoJumpToSourcePosition(AFilename, 0, ALine, 0, JmpFlags+[jfDoNotExpandFilename]); finally UnLockCommandProcessing; end; end; procedure TDebugManager.JumpToUnitSource(AnUnitInfo: TDebuggerUnitInfo; ALine: Integer; AMapLineFromDebug: Boolean); var Filename: String; ok: Boolean; JmpFlags: TJumpToCodePosFlags; begin if AnUnitInfo = nil then exit; debugln(DBG_LOCATION_INFO, ['JumpToUnitSource AnUnitInfo=', AnUnitInfo.DebugText ]); // avoid any process-messages, so this proc can not be re-entered (avoid opening one files many times) LockCommandProcessing; try (* Maybe trim the filename here and use jfDoNotExpandFilename ExpandFilename works with the current IDE path, and may be wrong *) // TODO: better detection of unsaved project files if GetFullFilename(AnUnitInfo, Filename, False) then begin ok := false; if ALine <= 0 then ALine := AnUnitInfo.SrcLine; JmpFlags := [jfAddJumpPoint, jfFocusEditor, jfMarkLine, jfSearchVirtualFullPath]; if AMapLineFromDebug then JmpFlags := JmpFlags + [jfMapLineFromDebug]; if FilenameIsAbsolute(Filename) then ok := MainIDEInterface.DoJumpToSourcePosition(Filename, 0, ALine, 0, JmpFlags) = mrOK; if not ok then MainIDEInterface.DoJumpToSourcePosition(Filename, 0, ALine, 0, JmpFlags+[jfDoNotExpandFilename]); end; finally UnLockCommandProcessing; end; end; procedure TDebugManager.DebuggerConsoleOutput(Sender: TObject; const AText: String); begin if not HasConsoleSupport then exit;; if FDialogs[ddtPseudoTerminal] = nil then ViewDebugDialog(ddtPseudoTerminal, False, False); TPseudoConsoleDlg(FDialogs[ddtPseudoTerminal]).AddOutput(AText); end; function TDebugManager.DebuggerFeedback(Sender: TObject; const AText, AInfo: String; AType: TDBGFeedbackType; AButtons: TDBGFeedbackResults): TDBGFeedbackResult; begin Result := ExecuteFeedbackDialog(AText, AInfo, AType, AButtons); end; procedure TDebugManager.DebuggerIdle(Sender: TObject); begin FSnapshots.DoDebuggerIdle; end; function TDebugManager.DoProjectClose(Sender: TObject; AProject: TLazProject): TModalResult; begin if AProject<>Project1 then exit(mrCancel); ResetDebugger; Result := mrOK; end; procedure TDebugManager.DoProjectModified(Sender: TObject); begin if Project1 <> nil then Project1.Modified := True; end; procedure TDebugManager.mnuAddBpAddress(Sender: TObject); var NewBreakpoint: TIDEBreakPoint; begin NewBreakpoint := BreakPoints.Add(0, True); if ShowBreakPointProperties(NewBreakpoint) <> mrOk then ReleaseRefAndNil(NewBreakpoint) else NewBreakpoint.EndUpdate; end; procedure TDebugManager.mnuAddBpSource(Sender: TObject); var NewBreakpoint: TIDEBreakPoint; SrcEdit: TSourceEditor; begin SrcEdit := SourceEditorManager.GetActiveSE; if SrcEdit <> nil then NewBreakpoint := BreakPoints.Add(SrcEdit.FileName, SrcEdit.CurrentCursorYLine, True) else NewBreakpoint := BreakPoints.Add('', 0, True); if DebugBoss.ShowBreakPointProperties(NewBreakpoint) <> mrOk then ReleaseRefAndNil(NewBreakpoint) else NewBreakpoint.EndUpdate; end; procedure TDebugManager.mnuAddBpData(Sender: TObject); var NewBreakpoint: TIDEBreakPoint; begin NewBreakpoint := BreakPoints.Add('', wpsGlobal, wpkWrite, True); if ShowBreakPointProperties(NewBreakpoint) = mrOk then begin NewBreakpoint.EndUpdate; ViewDebugDialog(ddtBreakpoints, False); end else ReleaseRefAndNil(NewBreakpoint); end; procedure TDebugManager.mnuAddBpDataAtCursor(Sender: TObject); var SE: TSourceEditor; WatchVar: String; NewBreakpoint: TIDEBreakPoint; begin SE := SourceEditorManager.GetActiveSE; if Assigned(SE) then begin if SE.SelectionAvailable then WatchVar := SE.Selection else WatchVar := SE.GetOperandAtCurrentCaret; if (WatchVar <> '') and SE.EditorComponent.Focused then begin // TODO: find existing? NewBreakpoint := BreakPoints.Add(WatchVar, wpsGlobal, wpkWrite, True); if ShowBreakPointProperties(NewBreakpoint) = mrOk then begin NewBreakpoint.EndUpdate; ViewDebugDialog(ddtBreakpoints, False); end else NewBreakpoint.ReleaseReference; exit; end; end; // watch was not added automatically => show a dialog mnuAddBpData(nil); end; procedure TDebugManager.BreakAutoContinueTimer(Sender: TObject); begin FAutoContinueTimer.Enabled := False; FDebugger.Run; end; procedure TDebugManager.OnRunTimer(Sender: TObject); begin FRunTimer.Enabled:=false; if dmsWaitForRun in FManagerStates then RunDebugger else if dmsWaitForAttach in FManagerStates then AttachDebugger; end; procedure TDebugManager.DebuggerBreakPointHit(ADebugger: TDebuggerIntf; ABreakPoint: TBaseBreakPoint; var ACanContinue: Boolean); begin FCurrentBreakPoint := nil; if FBreakPoints = nil then Exit; if ABreakpoint = nil then Exit; FCurrentBreakpoint := nil; if (ABreakPoint is TDBGBreakPoint) and (TDBGBreakPoint(ABreakPoint).Slave is TIDEBreakPoint) then FCurrentBreakpoint := TIDEBreakPoint(TDBGBreakPoint(ABreakPoint).Slave) else DebugLn('ERROR: Breakpoint does not have correct class, or IDE slave breakpoint'); // TODO: remove / fallback to old behaviour if FCurrentBreakpoint = nil then FCurrentBreakPoint := FBreakPoints.Find(ABreakPoint.Source, ABreakPoint.Line); end; procedure TDebugManager.mnuViewDebugDialogClick(Sender: TObject); var xCommand: Integer; begin if (Sender is TIDESpecialCommand) and (TIDESpecialCommand(Sender).Command<>nil) then xCommand := TIDESpecialCommand(Sender).Command.Command else if Sender is TIDECommand then xCommand := TIDECommand(Sender).Command else xCommand := -1; case xCommand of ecToggleWatches : ViewDebugDialog(ddtWatches); ecToggleBreakPoints : ViewDebugDialog(ddtBreakpoints); ecToggleDebuggerOut : ViewDebugDialog(ddtOutput); ecToggleLocals : ViewDebugDialog(ddtLocals); ecToggleCallStack : ViewDebugDialog(ddtCallStack); ecToggleRegisters : ViewDebugDialog(ddtRegisters); ecToggleAssembler : ViewDebugDialog(ddtAssembler); ecToggleDebugEvents : ViewDebugDialog(ddtEvents); ecEvaluate : ViewDebugDialog(ddtEvaluate); ecInspect : ViewDebugDialog(ddtInspect); ecViewPseudoTerminal: ViewDebugDialog(ddtPseudoTerminal); ecViewThreads : ViewDebugDialog(ddtThreads); ecViewHistory : ViewDebugDialog(ddtHistory); else raise Exception.CreateFmt('IDE Internal error: TDebugManager.mnuViewDebugDialogClick, wrong command parameter %d.', [xCommand]); end; end; procedure TDebugManager.mnuResetDebuggerClicked(Sender: TObject); begin ResetDebugger; end; procedure TDebugManager.mnuAddWatchClicked(Sender: TObject); var SE: TSourceEditor; WatchVar: String; w: TCurrentWatch; begin SE := SourceEditorManager.GetActiveSE; if Assigned(SE) then begin if SE.SelectionAvailable then WatchVar := SE.Selection else WatchVar := SE.GetOperandAtCurrentCaret; if (WatchVar <> '') and (SE.SourceNotebook.Active or SE.EditorComponent.Focused) then begin Watches.CurrentWatches.BeginUpdate; try w := Watches.CurrentWatches.Find(WatchVar); if w = nil then w := Watches.CurrentWatches.Add(WatchVar); if (w <> nil) then begin w.Enabled := True; if EnvironmentDebugOpts.DebuggerAutoSetInstanceFromClass then w.EvaluateFlags := w.EvaluateFlags + [defClassAutoCast]; ViewDebugDialog(ddtWatches, False); Exit; end; finally Watches.CurrentWatches.EndUpdate; end; end; end; // watch was not added automatically => show a dialog if ShowWatchProperties(nil, '') = mrOK then ViewDebugDialog(ddtWatches, False); end; //----------------------------------------------------------------------------- // Debugger events //----------------------------------------------------------------------------- procedure TDebugManager.DebuggerException(Sender: TObject; const AExceptionType: TDBGExceptionType; const AExceptionClass: String; const AExceptionLocation: TDBGLocationRec; const AExceptionText: String; out AContinue: Boolean); function GetTitle: String; begin Result := Project1.GetTitle; if Result = '' then Result := ExtractFileName(FDebugger.FileName); end; const MAX_CLASSNAME_LEN = 256; // shortstring MAX_MSG_DISPLAY_LEN = 2048; // just sanity var ExpClassName, ExceptMsg: string; msg, SrcText: String; Ignore: Boolean; Editor: TSourceEditor; i: Integer; begin if Destroying then begin AContinue := True; Exit; end else AContinue := False; ExpClassName := AExceptionClass; if Length(ExpClassName) > MAX_CLASSNAME_LEN then ExpClassName := copy(ExpClassName, 1, MAX_CLASSNAME_LEN) + '...'; if AExceptionText = '' then msg := Format(lisProjectSRaisedExceptionClassS, [GetTitle, ExpClassName]) else begin ExceptMsg := AExceptionText; if Length(ExceptMsg) > MAX_MSG_DISPLAY_LEN then ExceptMsg := copy(ExceptMsg, 1, MAX_MSG_DISPLAY_LEN) + '...'; // if AExceptionText is not a valid UTF8 string, // then assume it has the ansi encoding and convert it if FindInvalidUTF8Codepoint(pchar(ExceptMsg),length(ExceptMsg)) > 0 then ExceptMsg := AnsiToUtf8(ExceptMsg); msg := Format(lisProjectSRaisedExceptionClassSWithMessageSS, [GetTitle, ExpClassName, LineEnding, ExceptMsg]); end; if AExceptionLocation.SrcFile <> '' then begin if AExceptionLocation.SrcLine <> 0 then begin SrcText := ''; if (AExceptionLocation.SrcFullName <> '') then begin Editor := SourceEditorManager.SourceEditorIntfWithFilename(AExceptionLocation.SrcFullName); if Editor <> nil then begin try i := Editor.DebugToSourceLine(AExceptionLocation.SrcLine); if i > 0 then SrcText := Trim(Editor.Lines[i-1]); except end; end; end; if SrcText <> '' then msg := msg + Format(lisProjectSRaisedExceptionInFileLineSrc, [LineEnding, AExceptionLocation.SrcFile, AExceptionLocation.SrcLine, SrcText]) else msg := msg + Format(lisProjectSRaisedExceptionInFileLine, [LineEnding, AExceptionLocation.SrcFile, AExceptionLocation.SrcLine]); end else msg := msg + Format(lisProjectSRaisedExceptionInFileAddress, [LineEnding, AExceptionLocation.SrcFile, AExceptionLocation.Address]); end else if AExceptionLocation.Address <> 0 then begin msg := msg + Format(lisProjectSRaisedExceptionAtAddress, [LineEnding, AExceptionLocation.Address]); end; if (AExceptionType in [deInternal, deRunError]) then begin AContinue := ExecuteExceptionDialog(msg, Ignore, AExceptionType in [deInternal, deRunError]) = mrCancel; if Ignore then begin Exceptions.AddIfNeeded(ExpClassName); Exceptions.Find(ExpClassName).Enabled := True; end; end else begin IDEMessageDialog(lisCCOErrorCaption, msg, mtError, [mbOk]); end; end; procedure TDebugManager.DebuggerOutput(Sender: TObject; const AText: String); begin if Destroying then exit; if FDialogs[ddtOutput] <> nil then TDbgOutputForm(FDialogs[ddtOutput]).AddText(AText) else begin // store it internally, and copy it to the dialog, when the user opens it if fHiddenDebugOutputLog=nil then fHiddenDebugOutputLog:=TStringList.Create; fHiddenDebugOutputLog.Add(AText); while fHiddenDebugOutputLog.Count>100 do fHiddenDebugOutputLog.Delete(0); end; end; procedure TDebugManager.DebuggerBeforeChangeState(ADebugger: TDebuggerIntf; AOldState: TDBGState); var DialogType: TDebugDialogType; begin if Destroying or (MainIDE=nil) or (MainIDE.ToolStatus=itExiting) then exit; if AOldState=dsNone then ; assert((ADebugger=FDebugger) and (ADebugger<>nil), 'TDebugManager.OnDebuggerChangeState'); FInStateChange := True; for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do if FDialogs[DialogType] <> nil then FDialogs[DialogType].BeginUpdate; if FDebugger.State <> dsPause then FCurrentWatches.Clear; if FDebugger.State = dsInternalPause then exit; // set debug windows to ignore / no updating end; procedure TDebugManager.DebuggerChangeState(ADebugger: TDebuggerIntf; OldState: TDBGState); procedure UnlockDialogs; var DialogType: TDebugDialogType; begin if not FInStateChange then exit; FInStateChange := False; for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do if FDialogs[DialogType] <> nil then FDialogs[DialogType].EndUpdate; end; //const // dsNone, dsIdle, dsStop, dsPause, dsInit, dsRun, dsError //STATENAME: array[TDBGState] of string = ( // 'dsNone', 'dsIdle', 'dsStop', 'dsPause', 'dsInit', 'dsRun', 'dsError' //); var MsgResult: TModalResult; i: Integer; begin if Destroying or (MainIDE=nil) or (MainIDE.ToolStatus=itExiting) then begin UnlockDialogs; exit; end; assert((ADebugger=FDebugger) and (ADebugger<>nil), 'TDebugManager.OnDebuggerChangeState'); if (FDebugger.State in [dsRun]) then FCurrentBreakpoint := nil; if not (FDebugger.State in [dsPause, dsInternalPause]) then FCallStackNotification.OnChange := nil; if not((OldState = dsInternalPause) and (State = dsPause)) then begin // OldState=dsInternalPause means we already have a snapshot // Notify FSnapshots of new state (while dialogs still in updating) // TODO: Maybe move to TIDEBreakPoint.DoHit if (FCurrentBreakpoint <> nil) and (bpaTakeSnapshot in FCurrentBreakpoint.Actions) and (State in [dsPause, dsInternalPause]) then begin FSnapshots.DoStateChange(OldState); FSnapshots.Current.AddToSnapshots; FSnapshots.DoDebuggerIdle(True); end else if FDebugger.State <> dsInternalPause then FSnapshots.DoStateChange(OldState); end; UnlockDialogs; for i := 0 to FStateNotificationList.Count-1 do TDebuggerStateChangeNotification(FStateNotificationList[i])(ADebugger, OldState); if FDebugger.State = dsInternalPause then exit; if FDebugger.State=dsError then begin Include(FManagerStates,dmsDebuggerObjectBroken); if dmsInitializingDebuggerObject in FManagerStates then Include(FManagerStates,dmsInitializingDebuggerObjectFailed); end; //DebugLn('[TDebugManager.OnDebuggerChangeState] state: ', STATENAME[FDebugger.State]); // All conmmands // ------------------- // dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcStepOverInstrcution, dcStepIntoInstrcution, // dcStepTo, dcJumpto, dcBreak, dcWatch // ------------------- UpdateButtonsAndMenuItems; // Next may call ResetDebugger, then FDebugger is gone UpdateToolStatus; FAutoContinueTimer.Enabled := false; if FDebugger = nil then exit; if (FDebugger.State in [dsRun]) then begin // hide IDE during run if EnvironmentGuiOpts.Desktop.HideIDEOnRun and (MainIDE.ToolStatus=itDebugger) and not FStepping then MainIDE.HideIDE; if (FPrevShownWindow <> 0) and not FStepping then begin SetForegroundWindow(FPrevShownWindow); FPrevShownWindow := 0; end; end else if FDebugger.State <> dsInit then begin if (FCurrentBreakPoint <> nil) and (FCurrentBreakPoint.AutoContinueTime > 0) then begin FAutoContinueTimer.Enabled := True; FAutoContinueTimer.Interval := FCurrentBreakPoint.AutoContinueTime; end else if (OldState in [dsRun]) then begin if not FStepping then begin FPrevShownWindow := GetForegroundWindow; if EnvironmentGuiOpts.Desktop.HideIDEOnRun then MainIDE.UnhideIDE; if not EnvironmentGuiOpts.Desktop.SingleTaskBarButton and not EnvironmentGuiOpts.Desktop.HideIDEOnRun then Application.BringToFront; end; end; end; // unmark execution line if (not (FDebugger.State in [dsInit, dsPause])) and (SourceEditorManager <> nil) then SourceEditorManager.ClearExecutionLines; if (FDebugger.State in [dsPause, dsInit]) and (SourceEditorManager <> nil) then SourceEditorManager.FillExecutionMarks; if not (FDebugger.State in [dsRun, dsPause, dsInit]) and (SourceEditorManager <> nil) then begin SourceEditorManager.ClearExecutionMarks; // Refresh DebugExeLine for i := 0 to FBreakPoints.Count - 1 do FBreakPoints[i].SetLocation(FBreakPoints[i].Source, FBreakPoints[i].Line); end; case FDebugger.State of dsError: begin {$ifdef VerboseDebugger} DebugLn('Ooops, the debugger entered the error state'); {$endif} // shutting down lazarus may kill gdb, so we get an error if not Application.Terminated then FeedbackDlg.ExecuteFeedbackDialog (Format(lisDebuggerErrorOoopsTheDebuggerEnteredTheErrorState, [LineEnding]) + LineEnding + LineEnding + FDebugger.ErrorStateMessage, FDebugger.ErrorStateInfo, ftError, [frStop]); end; dsStop: begin // TODO: TDebugger.SetFileName sets dsStop during startup (leading to OldState=dsIdle) FPrevShownWindow:=0; if (OldState<>dsIdle) then begin MainIDE.DoCallRunFinishedHandler; if not FDebugger.SkipStopMessage then begin if (FDebugger.ExitCode <> 0) and EnvironmentDebugOpts.DebuggerShowExitCodeMessage then begin i := 4; if FDebugger.ExitCode > 65535 then i := 8; {$PUSH}{$R-} MsgResult:=IDEQuestionDialog(lisExecutionStopped, Format(lisExecutionStoppedExitCode, [LineEnding+'', FDebugger.ExitCode, IntToHex(FDebugger.ExitCode, i)]), mtInformation, [mrOK, lisBtnOk, mrYesToAll, lisDoNotShowThisMessageAgain], ''); {$POP} if MsgResult=mrYesToAll then EnvironmentDebugOpts.DebuggerShowExitCodeMessage:=false; end else if EnvironmentDebugOpts.DebuggerShowStopMessage then begin MsgResult:=IDEQuestionDialog(lisExecutionStopped, lisExecutionStopped, mtInformation, [mrOK, lisBtnOk, mrYesToAll, lisDoNotShowThisMessageAgain], ''); if MsgResult=mrYesToAll then EnvironmentDebugOpts.DebuggerShowStopMessage:=false; end; end; if EnvironmentDebugOpts.DebuggerResetAfterRun or FDebugger.NeedReset then ResetDebugger else FDebugger.FileName := ''; // SetState(dsIdle) via ResetStateToIdle if FDialogs[ddtAssembler] <> nil then begin TAssemblerDlg(FDialogs[ddtAssembler]).SetLocation(nil, 0); if FAsmWindowShouldAutoClose then TAssemblerDlg(FDialogs[ddtAssembler]).Close; end; end; end; dsInit: begin if FDialogs[ddtPseudoTerminal] <> nil then TPseudoConsoleDlg(FDialogs[ddtPseudoTerminal]).Clear; end; end; end; procedure TDebugManager.DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec); var SrcLine, TId: Integer; begin FCallStackNotification.OnChange := nil; if (Sender<>FDebugger) or (Sender=nil) then exit; if FDebugger.State = dsInternalPause then exit; if Destroying then exit; FCurrentLocation := ALocation; SrcLine := FCurrentLocation.SrcLine; if (SrcLine < 1) and (SrcLine <> -2) // TODO: this should move to the debugger // SrcLine will be -2 after stepping (gdbmi) and not FAsmStepping then begin TId := Threads.CurrentThreads.CurrentThreadId; if CallStack.CurrentCallStackList.EntriesForThreads[TId].HasAtLeastCount(30) = nbUnknown then begin FCallStackNotification.OnChange := @DoDebuggerCurrentLine; if FDialogs[ddtAssembler] <> nil then TAssemblerDlg(FDialogs[ddtAssembler]).SetLocation(FDebugger, FCurrentLocation.Address); exit; end; end; DoDebuggerCurrentLine(nil); end; procedure TDebugManager.DoDebuggerCurrentLine(Sender: TObject); // debugger paused program due to pause or error // -> show the current execution line in editor // if SrcLine < 1 then no source is available function FileLocationToId(ALoc: TDBGLocationRec): string; begin Result := IntToStr(length(ALoc.SrcFile)) + ':' + ALoc.SrcFile + ':' + IntToStr(length(ALoc.SrcFullName)) + ':' + ALoc.SrcFullName; end; var SrcFullName: String; NewSource: TCodeBuffer; Editor: TSourceEditor; SrcLine: Integer; c, i, TId: Integer; StackEntry: TIdeCallStackEntry; Flags: TJumpToCodePosFlags; CurrentSourceUnitInfo: TDebuggerUnitInfo; a: Boolean; begin FCallStackNotification.OnChange := nil; if FDebugger.State = dsInternalPause then exit; if Destroying then exit; SrcLine := FCurrentLocation.SrcLine; CurrentSourceUnitInfo := nil; if (SrcLine < 1) and (SrcLine <> -2) // TODO: this should move to the debugger // SrcLine will be -2 after stepping (gdbmi) and not FAsmStepping then begin // jump to the deepest stack frame with debugging info // TODO: Only below the frame supplied by debugger i:=0; TId := Threads.CurrentThreads.CurrentThreadId; if CallStack.CurrentCallStackList.EntriesForThreads[TId].HasAtLeastCount(30) = nbUnknown then begin FCallStackNotification.OnChange := @DoDebuggerCurrentLine; exit; end; c := CallStack.CurrentCallStackList.EntriesForThreads[TId].CountLimited(30); while (i < c) do begin StackEntry := CallStack.CurrentCallStackList.EntriesForThreads[TId].Entries[i]; if StackEntry.Validity = ddsRequested then begin// not yet available FCallStackNotification.OnChange := @DoDebuggerCurrentLine; exit; end; if StackEntry.Line > 0 then begin CurrentSourceUnitInfo := StackEntry.UnitInfo; CurrentSourceUnitInfo.AddReference; SrcLine := StackEntry.Line; StackEntry.MakeCurrent; Break; end; Inc(i); end; end else begin CurrentSourceUnitInfo := FUnitInfoProvider.GetUnitInfoFor(FCurrentLocation.SrcFile, FCurrentLocation.SrcFullName); CurrentSourceUnitInfo.AddReference; end; // TODO: do in DebuggerChangeState / Only currently State change locks execution of gdb // Must be after stack frame selection (for inspect) if FDialogs[ddtAssembler] <> nil then TAssemblerDlg(FDialogs[ddtAssembler]).SetLocation(FDebugger, FCurrentLocation.Address); if (SrcLine > 0) and (CurrentSourceUnitInfo <> nil) and GetFullFilename(CurrentSourceUnitInfo, SrcFullName, True) then begin // Load the file NewSource := CodeToolBoss.LoadFile(SrcFullName, true, false); if NewSource = nil then begin if not (dlfLoadError in CurrentSourceUnitInfo.Flags) then begin IDEMessageDialog(lisDebugUnableToLoadFile, Format(lisDebugUnableToLoadFile2, [SrcFullName]), mtError,[mbCancel]); CurrentSourceUnitInfo.Flags := CurrentSourceUnitInfo.Flags + [dlfLoadError]; end; SrcLine := -1; end; end else begin NewSource := Nil; SrcLine := -1; end; ReleaseRefAndNil(CurrentSourceUnitInfo); // clear old error and execution lines if SourceEditorManager <> nil then begin SourceEditorManager.ClearExecutionLines; SourceEditorManager.ClearErrorLines; end; if SrcLine < 1 then begin a := FAsmWindowShouldAutoClose or (FDialogs[ddtAssembler] = nil) or (not FDialogs[ddtAssembler].Visible); ViewDebugDialog(ddtAssembler); FAsmWindowShouldAutoClose := a and EnvironmentDebugOpts.DebuggerAutoCloseAsm; FAsmStepping := False; exit; end; if (FDialogs[ddtAssembler] <> nil) and FAsmWindowShouldAutoClose then TAssemblerDlg(FDialogs[ddtAssembler]).Close; Editor := nil; if SourceEditorManager <> nil then Editor := SourceEditorManager.SourceEditorIntfWithFilename(NewSource.Filename); // jump editor to execution line Flags := [jfAddJumpPoint, jfSearchVirtualFullPath]; if (FCurrentBreakPoint = nil) or (FCurrentBreakPoint.AutoContinueTime = 0) then include(Flags, jfFocusEditor); i := SrcLine; if (Editor <> nil) then i := Editor.DebugToSourceLine(i); if not (FAsmStepping and (FDialogs[ddtAssembler] <> nil) and FDialogs[ddtAssembler].IsVisible and FDialogs[ddtAssembler].Active ) then if MainIDE.DoJumpToCodePosition(nil,nil,NewSource,1,i,-1,-1,-1,Flags)<>mrOk then exit; FAsmStepping := False; // mark execution line if (Editor = nil) and (SourceEditorManager <> nil) then Editor := SourceEditorManager.ActiveEditor; if Editor <> nil then begin if not Editor.HasExecutionMarks then Editor.FillExecutionMarks; Editor.ExecutionLine := i; end; end; //----------------------------------------------------------------------------- // Debugger dialog routines //----------------------------------------------------------------------------- // Common handler // The tag of the destroyed form contains the form variable pointing to it procedure TDebugManager.DebugDialogDestroy(Sender: TObject); var DlgType: TDebugDialogType; begin for DlgType:=Low(TDebugDialogType) to High(TDebugDialogType) do begin if FDialogs[DlgType]<>Sender then continue; case DlgType of ddtOutput: begin if fHiddenDebugOutputLog=nil then fHiddenDebugOutputLog:=TStringList.Create; TDbgOutputForm(FDialogs[ddtOutput]).GetLogText(fHiddenDebugOutputLog); end; ddtEvents: begin FEventLogManager.EventDialog := nil; end; end; FDialogs[DlgType]:=nil; exit; end; RaiseGDBException('Invalid debug window '+Sender.ClassName); end; procedure TDebugManager.ViewDebugDialog(const ADialogType: TDebugDialogType; BringToFront: Boolean; Show: Boolean; DoDisableAutoSizing: boolean; InitFromSourceEdit: boolean); const DEBUGDIALOGCLASS: array[TDebugDialogType] of TDebuggerDlgClass = ( TDbgOutputForm, TDbgEventsForm, TBreakPointsDlg, TWatchesDlg, TLocalsDlg, TCallStackDlg, TEvaluateDlg, TRegistersDlg, TAssemblerDlg, TIDEInspectDlg, TPseudoConsoleDlg, TThreadsDlg, THistoryDialog ); var CurDialog: TDebuggerDlg; begin if Destroying then exit; if (ADialogType = ddtPseudoTerminal) and not HasConsoleSupport then exit; if ADialogType = ddtAssembler then FAsmWindowShouldAutoClose := False; if FDialogs[ADialogType] = nil then begin CurDialog := TDebuggerDlg(DEBUGDIALOGCLASS[ADialogType].NewInstance); if FInStateChange then CurDialog.BeginUpdate; CurDialog.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDebugManager.ViewDebugDialog'){$ENDIF}; CurDialog.Create(Self); FDialogs[ADialogType]:=CurDialog; CurDialog.Name:= DebugDialogNames[ADialogType]; CurDialog.Tag := Integer(ADialogType); CurDialog.OnDestroy := @DebugDialogDestroy; case ADialogType of ddtOutput: InitDebugOutputDlg; ddtEvents: InitDebugEventsDlg; ddtBreakpoints: InitBreakPointDlg; ddtWatches: InitWatchesDlg; ddtLocals: InitLocalsDlg; ddtRegisters: InitRegistersDlg; ddtCallStack: InitCallStackDlg; ddtEvaluate: InitEvaluateDlg; ddtAssembler: InitAssemblerDlg; ddtInspect: InitInspectDlg; ddtPseudoTerminal: InitPseudoTerminal; ddtThreads: InitThreadsDlg; ddtHistory: InitHistoryDlg; end; end else begin CurDialog:=FDialogs[ADialogType]; CurDialog.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDebugManager.ViewDebugDialog'){$ENDIF}; if (CurDialog is TBreakPointsDlg) then begin if (Project1<>nil) then TBreakPointsDlg(CurDialog).BaseDirectory:=Project1.Directory; end; if (CurDialog is TAssemblerDlg) then begin TAssemblerDlg(CurDialog).SetLocation(FDebugger, FCurrentLocation.Address); end; if InitFromSourceEdit then begin if (CurDialog is TIDEInspectDlg) and (SourceEditorManager.GetActiveSE <> nil) then begin if SourceEditorManager.GetActiveSE.SelectionAvailable then TIDEInspectDlg(CurDialog).Execute(SourceEditorManager.GetActiveSE.Selection) else TIDEInspectDlg(CurDialog).Execute(SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret); end; if (CurDialog is TEvaluateDlg) and (SourceEditorManager.GetActiveSE <> nil) then begin if SourceEditorManager.GetActiveSE.SelectionAvailable then TEvaluateDlg(CurDialog).Execute(SourceEditorManager.GetActiveSE.Selection) else TEvaluateDlg(CurDialog).Execute(SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret); end; end; end; if not DoDisableAutoSizing then CurDialog.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDebugManager.ViewDebugDialog'){$ENDIF}; if Show then begin CurDialog.BeginUpdate; IDEWindowCreators.ShowForm(CurDialog,BringToFront,vmOnlyMoveOffScreenToVisible); CurDialog.EndUpdate; end; end; procedure TDebugManager.ViewDisassembler(AnAddr: TDBGPtr; BringToFront: Boolean; Show: Boolean; DoDisableAutoSizing: boolean); begin ViewDebugDialog(ddtAssembler, BringToFront, Show, DoDisableAutoSizing); if FDialogs[ddtAssembler] <> nil then TAssemblerDlg(FDialogs[ddtAssembler]).SetLocation(FDebugger, FCurrentLocation.Address, AnAddr); end; procedure TDebugManager.RegisterStateChangeHandler( AHandler: TDebuggerStateChangeNotification); begin FStateNotificationList.Add(TMethod(AHandler)); end; procedure TDebugManager.UnregisterStateChangeHandler( AHandler: TDebuggerStateChangeNotification); begin FStateNotificationList.Remove(TMethod(AHandler)); end; procedure TDebugManager.RegisterWatchesInvalidatedHandler(AHandler: TNotifyEvent ); begin FWatchesInvalidatedNotificationList.Add(TMethod(AHandler)); end; procedure TDebugManager.UnregisterWatchesInvalidatedHandler( AHandler: TNotifyEvent); begin FWatchesInvalidatedNotificationList.Remove(TMethod(AHandler)); end; procedure TDebugManager.DestroyDebugDialog(const ADialogType: TDebugDialogType); begin if FDialogs[ADialogType] = nil then Exit; FDialogs[ADialogType].OnDestroy := nil; FDialogs[ADialogType].Free; FDialogs[ADialogType] := nil; end; procedure TDebugManager.InitDebugOutputDlg; var TheDialog: TDbgOutputForm; begin TheDialog := TDbgOutputForm(FDialogs[ddtOutput]); if FHiddenDebugOutputLog <> nil then begin TheDialog.SetLogText(FHiddenDebugOutputLog); FreeAndNil(FHiddenDebugOutputLog); end; end; procedure TDebugManager.InitDebugEventsDlg; var TheDialog: TDbgEventsForm; begin TheDialog := TDbgEventsForm(FDialogs[ddtEvents]); FEventLogManager.EventDialog := TheDialog; end; procedure TDebugManager.InitBreakPointDlg; var TheDialog: TBreakPointsDlg; begin TheDialog:=TBreakPointsDlg(FDialogs[ddtBreakpoints]); if Project1 <> nil then TheDialog.BaseDirectory := Project1.Directory; TheDialog.BreakPoints := FBreakPoints; end; procedure TDebugManager.InitWatchesDlg; var TheDialog: TWatchesDlg; begin TheDialog := TWatchesDlg(FDialogs[ddtWatches]); TheDialog.WatchesMonitor := FWatches; TheDialog.ThreadsMonitor := FThreads; TheDialog.CallStackMonitor := FCallStack; TheDialog.BreakPoints := FBreakPoints; TheDialog.SnapshotManager := FSnapshots; end; procedure TDebugManager.InitThreadsDlg; var TheDialog: TThreadsDlg; begin TheDialog := TThreadsDlg(FDialogs[ddtThreads]); TheDialog.ThreadsMonitor := FThreads; TheDialog.SnapshotManager := FSnapshots; end; procedure TDebugManager.InitPseudoTerminal; //var // TheDialog: TPseudoConsoleDlg; begin if not HasConsoleSupport then exit; //TheDialog := TPseudoConsoleDlg(FDialogs[ddtPseudoTerminal]); end; procedure TDebugManager.InitLocalsDlg; var TheDialog: TLocalsDlg; begin TheDialog := TLocalsDlg(FDialogs[ddtLocals]); TheDialog.LocalsMonitor := FLocals; TheDialog.ThreadsMonitor := FThreads; TheDialog.CallStackMonitor := FCallStack; TheDialog.SnapshotManager := FSnapshots; end; procedure TDebugManager.InitRegistersDlg; var TheDialog: TRegistersDlg; begin TheDialog := TRegistersDlg(FDialogs[ddtRegisters]); TheDialog.ThreadsMonitor := FThreads; TheDialog.CallStackMonitor := FCallStack; TheDialog.RegistersMonitor := FRegisters; end; procedure TDebugManager.InitAssemblerDlg; var TheDialog: TAssemblerDlg; begin TheDialog := TAssemblerDlg(FDialogs[ddtAssembler]); TheDialog.BreakPoints := FBreakPoints; TheDialog.Disassembler := FDisassembler; TheDialog.DebugManager := Self; TheDialog.SetLocation(FDebugger, FCurrentLocation.Address); end; procedure TDebugManager.InitInspectDlg; var TheDialog: TIDEInspectDlg; begin TheDialog := TIDEInspectDlg(FDialogs[ddtInspect]); if (SourceEditorManager.GetActiveSE = nil) then exit; if SourceEditorManager.GetActiveSE.SelectionAvailable then TheDialog.Execute(SourceEditorManager.GetActiveSE.Selection) else TheDialog.Execute(SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret); end; procedure TDebugManager.InitHistoryDlg; var TheDialog: THistoryDialog; begin TheDialog := THistoryDialog(FDialogs[ddtHistory]); TheDialog.SnapshotManager := FSnapshots; end; procedure TDebugManager.InitCallStackDlg; var TheDialog: TCallStackDlg; begin TheDialog := TCallStackDlg(FDialogs[ddtCallStack]); TheDialog.CallStackMonitor := FCallStack; TheDialog.BreakPoints := FBreakPoints; TheDialog.ThreadsMonitor := FThreads; TheDialog.SnapshotManager := FSnapshots; end; procedure TDebugManager.InitEvaluateDlg; var TheDialog: TEvaluateDlg; begin TheDialog := TEvaluateDlg(FDialogs[ddtEvaluate]); if (SourceEditorManager.GetActiveSE = nil) then exit; if SourceEditorManager.GetActiveSE.SelectionAvailable then TheDialog.EvalExpression := SourceEditorManager.GetActiveSE.Selection else TheDialog.EvalExpression := SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret; end; constructor TDebugManager.Create(TheOwner: TComponent); var DialogType: TDebugDialogType; begin FInStateChange := False; for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do FDialogs[DialogType] := nil; FDebugger := nil; FUnitInfoProvider := TDebuggerUnitInfoProvider.Create; FBreakPoints := TManagedBreakPoints.Create(Self); FBreakPointGroups := TIDEBreakPointGroups.Create; FWatches := TIdeWatchesMonitor.Create; FWatches.OnWatchesInvalidated := @CallWatchesInvalidatedHandlers; FThreads := TIdeThreadsMonitor.Create; FExceptions := TProjectExceptions.Create; FSignals := TIDESignals.Create; FLocals := TIdeLocalsMonitor.Create; FLineInfo := TIDELineInfo.Create; FCallStack := TIdeCallStackMonitor.Create; FDisassembler := TIDEDisassembler.Create; FRegisters := TIdeRegistersMonitor.Create; FCallStackNotification := TCallStackNotification.Create; FCallStackNotification.AddReference; FCallStack.AddNotification(FCallStackNotification); FSnapshots := TSnapshotManager.Create; FSnapshots.Threads := FThreads; FSnapshots.CallStack := FCallStack; FSnapshots.Watches := FWatches; FSnapshots.Locals := FLocals; FSnapshots.UnitInfoProvider := FUnitInfoProvider; FStateNotificationList := TMethodList.Create; FWatchesInvalidatedNotificationList := TMethodList.Create; FUserSourceFiles := TStringList.Create; FAutoContinueTimer := TTimer.Create(Self); FAutoContinueTimer.Enabled := False; FAutoContinueTimer.OnTimer := @BreakAutoContinueTimer; FRunTimer := TTimer.Create(Self); FRunTimer.Interval := 1; FRunTimer.OnTimer := @OnRunTimer; FWatches.OnModified := @DoProjectModified; FCurrentWatches := TCurrentWatches.Create(FWatches); FIsInitializingDebugger:= False; inherited Create(TheOwner); LazarusIDE.AddHandlerOnProjectClose(@DoProjectClose); RegisterValueFormatter(skSimple, 'TDate', @DBGDateTimeFormatter); RegisterValueFormatter(skFloat, 'TDate', @DBGDateTimeFormatter); RegisterValueFormatter(skSimple, 'TTime', @DBGDateTimeFormatter); RegisterValueFormatter(skFloat, 'TTime', @DBGDateTimeFormatter); RegisterValueFormatter(skSimple, 'TDateTime', @DBGDateTimeFormatter); RegisterValueFormatter(skFloat, 'TDateTime', @DBGDateTimeFormatter); FEventLogManager := TDebugEventLogManager.Create; end; destructor TDebugManager.Destroy; var DialogType: TDebugDialogType; begin FDestroying := true; LazarusIDE.RemoveHandlerOnProjectClose(@DoProjectClose); FreeAndNil(FAutoContinueTimer); for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do DestroyDebugDialog(DialogType); if FCallStackNotification <> nil then FCallStackNotification.ReleaseReference; SetDebugger(nil); FreeAndNil(FCurrentWatches); FreeAndNil(FEventLogManager); FreeAndNil(FSnapshots); FreeAndNil(FWatches); FreeAndNil(FThreads); FreeAndNil(FBreakPoints); FreeAndNil(FBreakPointGroups); FreeAndNil(FCallStack); FreeAndNil(FDisassembler); FreeAndNil(FExceptions); FreeAndNil(FSignals); FreeAndNil(FLocals); FreeAndNil(FLineInfo); FreeAndNil(FRegisters); FreeAndNil(FUserSourceFiles); FreeAndNil(FHiddenDebugOutputLog); FreeAndNil(FUnitInfoProvider); FreeAndNil(FStateNotificationList); FreeAndNil(FWatchesInvalidatedNotificationList); inherited Destroy; end; procedure TDebugManager.Reset; begin FBreakPoints.Clear; FBreakPointGroups.Clear; FWatches.Clear; FThreads.Clear; FExceptions.Reset; FSignals.Reset; FUserSourceFiles.Clear; FUnitInfoProvider.Clear; end; procedure TDebugManager.ConnectMainBarEvents; begin with MainIDEBar do begin itmViewWatches.OnClick := @mnuViewDebugDialogClick; itmViewWatches.Tag := Ord(ddtWatches); itmViewBreakPoints.OnClick := @mnuViewDebugDialogClick; itmViewBreakPoints.Tag := Ord(ddtBreakPoints); itmViewLocals.OnClick := @mnuViewDebugDialogClick; itmViewLocals.Tag := Ord(ddtLocals); itmViewRegisters.OnClick := @mnuViewDebugDialogClick; itmViewRegisters.Tag := Ord(ddtRegisters); itmViewCallStack.OnClick := @mnuViewDebugDialogClick; itmViewCallStack.Tag := Ord(ddtCallStack); itmViewThreads.OnClick := @mnuViewDebugDialogClick; itmViewThreads.Tag := Ord(ddtThreads); itmViewAssembler.OnClick := @mnuViewDebugDialogClick; itmViewAssembler.Tag := Ord(ddtAssembler); itmViewDebugOutput.OnClick := @mnuViewDebugDialogClick; itmViewDebugOutput.Tag := Ord(ddtOutput); itmViewDebugEvents.OnClick := @mnuViewDebugDialogClick; itmViewDebugEvents.Tag := Ord(ddtEvents); if itmViewPseudoTerminal <> nil then begin itmViewPseudoTerminal.OnClick := @mnuViewDebugDialogClick; itmViewPseudoTerminal.Tag := Ord(ddtPseudoTerminal); end; itmViewDbgHistory.OnClick := @mnuViewDebugDialogClick; itmViewDbgHistory.Tag := Ord(ddtHistory); itmRunMenuResetDebugger.OnClick := @mnuResetDebuggerClicked; itmRunMenuInspect.OnClick := @mnuViewDebugDialogClick; itmRunMenuInspect.Tag := Ord(ddtInspect); itmRunMenuEvaluate.OnClick := @mnuViewDebugDialogClick; itmRunMenuEvaluate.Tag := Ord(ddtEvaluate); itmRunMenuAddWatch.OnClick := @mnuAddWatchClicked; itmRunMenuAddBpSource.OnClick := @mnuAddBpSource; itmRunMenuAddBpAddress.OnClick := @mnuAddBpAddress; itmRunMenuAddBpWatchPoint.OnClick := @mnuAddBpData; // TODO: add capacibilities to DebuggerClass // and disable unsuported items end; end; procedure TDebugManager.ConnectSourceNotebookEvents; begin SrcEditMenuAddWatchAtCursor.OnClick:=@mnuAddWatchClicked; SrcEditMenuAddWatchPointAtCursor.OnClick:=@mnuAddBpDataAtCursor; SrcEditMenuEvaluateModify.OnClick:=@mnuViewDebugDialogClick; SrcEditMenuEvaluateModify.Tag := Ord(ddtEvaluate); SrcEditMenuInspect.OnClick:=@mnuViewDebugDialogClick; SrcEditMenuInspect.Tag := Ord(ddtInspect); end; function GetCommand(ACommand: word): TIDECommand; begin Result:=IDECommandList.FindIDECommand(ACommand); if Result<>nil then RegisterIDEButtonCommand(Result); end; procedure TDebugManager.SetupMainBarShortCuts; begin with MainIDEBar do begin itmViewWatches.Command:=GetCommand(ecToggleWatches); itmViewBreakpoints.Command:=GetCommand(ecToggleBreakPoints); itmViewDebugOutput.Command:=GetCommand(ecToggleDebuggerOut); itmViewDebugEvents.Command:=GetCommand(ecToggleDebugEvents); itmViewLocals.Command:=GetCommand(ecToggleLocals); itmViewRegisters.Command:=GetCommand(ecToggleRegisters); itmViewCallStack.Command:=GetCommand(ecToggleCallStack); itmViewAssembler.Command:=GetCommand(ecToggleAssembler); itmViewThreads.Command:=GetCommand(ecViewThreads); if itmViewPseudoTerminal <> nil then itmViewPseudoTerminal.Command:=GetCommand(ecViewPseudoTerminal); itmViewDbgHistory.Command:=GetCommand(ecViewHistory); itmRunMenuInspect.Command:=GetCommand(ecInspect); itmRunMenuEvaluate.Command:=GetCommand(ecEvaluate); itmRunMenuAddWatch.Command:=GetCommand(ecAddWatch); itmRunMenuAddBpSource.Command:=GetCommand(ecAddBpSource); itmRunMenuAddBpAddress.Command:=GetCommand(ecAddBpAddress); itmRunMenuAddBpWatchPoint.Command:=GetCommand(ecAddBpDataWatch); end; end; procedure TDebugManager.SetupSourceMenuShortCuts; begin SrcEditMenuToggleBreakpoint.Command:=GetCommand(ecToggleBreakPoint); SrcEditMenuStepToCursor.Command:=GetCommand(ecStepToCursor); SrcEditMenuRunToCursor.Command:=GetCommand(ecRunToCursor); SrcEditMenuEvaluateModify.Command:=GetCommand(ecEvaluate); SrcEditMenuAddWatchAtCursor.Command:=GetCommand(ecAddWatch); SrcEditMenuAddWatchPointAtCursor.Command:=GetCommand(ecAddBpDataWatch); SrcEditMenuInspect.Command:=GetCommand(ecInspect); SrcEditMenuViewCallStack.Command:=GetCommand(ecToggleCallStack); end; procedure TDebugManager.UpdateButtonsAndMenuItems; var DebuggerIsValid: boolean; CanRun: Boolean; AvailCommands: TDBGCommands; CurState: TDBGState; begin if (MainIDE=nil) or (MainIDE.ToolStatus = itExiting) then exit; CurState := dsStop; if FDebugger <> nil then CurState := FDebugger.State; AvailCommands := GetAvailableCommands; DebuggerIsValid:=(MainIDE.ToolStatus in [itNone, itDebugger]); CanRun := CanRunDebugger; with MainIDEBar do begin // For 'run' and 'step' bypass 'idle', so we can set the filename later // Run itmRunMenuRun.Enabled := (CanRun and (dcRun in AvailCommands)) or ((Project1<>nil) and Project1.CompilerOptions.RunWithoutDebug); itmRunMenuRunWithDebugging.Enabled := CanRun and (dcRun in AvailCommands); itmRunMenuRunWithDebugging.Visible := (Project1<>nil) and Project1.CompilerOptions.RunWithoutDebug; itmRunMenuRunWithoutDebugging.Visible := (Project1<>nil) and (not Project1.CompilerOptions.RunWithoutDebug); // Pause itmRunMenuPause.Enabled := CanRun and ((dcPause in AvailCommands) or FAutoContinueTimer.Enabled); // Show execution point itmRunMenuShowExecutionPoint.Enabled := CanRun and (CurState = dsPause); // Step into itmRunMenuStepInto.Enabled := CanRun and (dcStepInto in AvailCommands); // Step over itmRunMenuStepOver.Enabled := CanRun and (dcStepOver in AvailCommands); // Step out itmRunMenuStepOut.Enabled := CanRun and (dcStepOut in AvailCommands) and (CurState = dsPause); // Step to cursor itmRunMenuStepToCursor.Enabled := CanRun and (dcStepTo in AvailCommands); // Run to cursor itmRunMenuRunToCursor.Enabled := CanRun and (dcRunTo in AvailCommands); // Stop itmRunMenuStop.Enabled := (CanRun and (MainIDE.ToolStatus = itDebugger) and (CurState in [dsPause, dsInternalPause, dsInit, dsRun, dsError])) or (MainIDE.ToolStatus = itBuilder); //Attach / Detach itmRunMenuAttach.Enabled := DebuggerIsValid and (dcAttach in AvailCommands); itmRunMenuDetach.Enabled := DebuggerIsValid and (dcDetach in AvailCommands); // Evaluate itmRunMenuEvaluate.Enabled := CanRun and (dcEvaluate in AvailCommands); // Evaluate / modify SrcEditMenuEvaluateModify.Enabled := CanRun and (dcEvaluate in AvailCommands); // Add watch itmRunMenuAddWatch.Enabled := True; // always allow to add a watch // Add Breakpoint itmRunMenuAddBpSource.Enabled := True; itmRunMenuAddBpAddress.Enabled := True; itmRunMenuAddBpWatchPoint.Enabled := True; // TODO: add capacibilities to DebuggerClass // menu view //itmViewRegisters.Enabled := DebuggerIsValid; //itmViewAssembler.Enabled := DebuggerIsValid; end; end; procedure TDebugManager.UpdateToolStatus; const TOOLSTATEMAP: array[TDBGState] of TIDEToolStatus = ( //dsNone, dsIdle, dsStop, dsPause, dsInternalPause, dsInit, dsRun, dsError, dsDestroying itNone, itNone, itNone, itDebugger, itDebugger, itDebugger, itDebugger, itNone, itNone ); begin // Next may call ResetDebugger, then FDebugger is gone if MainIDE.ToolStatus in [itNone,itDebugger] then begin if FDebugger = nil then MainIDE.ToolStatus := itNone else MainIDE.ToolStatus := TOOLSTATEMAP[FDebugger.State]; end; end; procedure TDebugManager.EnvironmentOptsChanged; begin if FDebugger <> nil then begin if EnvironmentDebugOpts.DebuggerAllowFunctionCalls then FDebugger.EnabledFeatures := FDebugger.EnabledFeatures + [dfEvalFunctionCalls] else FDebugger.EnabledFeatures := FDebugger.EnabledFeatures - [dfEvalFunctionCalls]; end; end; {------------------------------------------------------------------------------ procedure TDebugManager.LoadProjectSpecificInfo(XMLConfig: TXMLConfig; Merge: boolean); Called when the main project is loaded from the XMLConfig. ------------------------------------------------------------------------------} procedure TDebugManager.LoadProjectSpecificInfo(XMLConfig: TXMLConfig; Merge: boolean); begin if not Merge then begin FExceptions.LoadFromXMLConfig(XMLConfig,'Debugging/'+XMLExceptionsNode+'/'); end; // keep it simple: just load from the session and don't merge FBreakPointGroups.LoadFromXMLConfig(XMLConfig, 'Debugging/'+XMLBreakPointGroupsNode+'/'); FBreakPoints.LoadFromXMLConfig(XMLConfig,'Debugging/'+XMLBreakPointsNode+'/', @Project1.ConvertFromLPIFilename, @FBreakPointGroups.GetGroupByName); FWatches.LoadFromXMLConfig(XMLConfig,'Debugging/'+XMLWatchesNode+'/'); end; {------------------------------------------------------------------------------ procedure TDebugManager.SaveProjectSpecificInfo(XMLConfig: TXMLConfig; Flags: TProjectWriteFlags); Called when the main project is saved to an XMLConfig. ------------------------------------------------------------------------------} procedure TDebugManager.SaveProjectSpecificInfo(XMLConfig: TXMLConfig; Flags: TProjectWriteFlags); begin if not (pwfSkipSeparateSessionInfo in Flags) then begin FBreakPointGroups.SaveToXMLConfig(XMLConfig, 'Debugging/'+XMLBreakPointGroupsNode+'/', pwfCompatibilityMode in Flags); FBreakPoints.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLBreakPointsNode+'/', pwfCompatibilityMode in Flags, @Project1.ConvertToLPIFilename); FWatches.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLWatchesNode+'/', pwfCompatibilityMode in Flags); end; if not (pwfSkipProjectInfo in Flags) then begin // exceptions are not part of the project info (#0015256) FExceptions.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLExceptionsNode+'/', pwfCompatibilityMode in Flags); end; end; procedure TDebugManager.DoRestoreDebuggerMarks(AnUnitInfo: TUnitInfo); var ASrcEdit: TSourceEditor; i: Integer; CurBreakPoint: TIDEBreakPoint; SrcFilename: String; begin if (AnUnitInfo.OpenEditorInfoCount = 0) or Destroying then exit; ASrcEdit := TSourceEditor(AnUnitInfo.OpenEditorInfo[0].EditorComponent); // set breakpoints for this unit SrcFilename:=AnUnitInfo.Filename; for i := 0 to FBreakpoints.Count-1 do begin CurBreakPoint := FBreakpoints[i]; if CompareFileNames(CurBreakPoint.Source, SrcFilename) = 0 then CreateSourceMarkForBreakPoint(CurBreakPoint, ASrcEdit); end; end; procedure TDebugManager.CreateSourceMarkForBreakPoint( const ABreakpoint: TIDEBreakPoint; ASrcEdit: TSourceEditor); var ManagedBreakPoint: TManagedBreakPoint; NewSrcMark: TSourceMark; begin if not (ABreakpoint is TManagedBreakPoint) then RaiseGDBException('TDebugManager.CreateSourceMarkForBreakPoint'); ManagedBreakPoint:=TManagedBreakPoint(ABreakpoint); if (ManagedBreakPoint.SourceMark<>nil) or Destroying then exit; if ASrcEdit=nil then GetSourceEditorForBreakPoint(ManagedBreakPoint,ASrcEdit); if ASrcEdit=nil then exit; NewSrcMark:=TSourceMark.Create(ASrcEdit, nil); ManagedBreakPoint.SourceMark:=NewSrcMark; SourceEditorMarks.Add(NewSrcMark); end; procedure TDebugManager.GetSourceEditorForBreakPoint( const ABreakpoint: TIDEBreakPoint; var ASrcEdit: TSourceEditor); var Filename: String; begin Filename:=ABreakpoint.Source; if Filename<>'' then ASrcEdit:=SourceEditorManager.SourceEditorIntfWithFilename(ABreakpoint.Source) else ASrcEdit:=nil; end; procedure TDebugManager.CreateDebugDialog(Sender: TObject; aFormName: string; var AForm: TCustomForm; DoDisableAutoSizing: boolean); function ItIs(Prefix: string): boolean; begin Result:=SysUtils.CompareText(copy(aFormName,1,length(Prefix)),Prefix)=0; end; var DlgType: TDebugDialogType; begin for DlgType:=Low(TDebugDialogType) to High(TDebugDialogType) do if ItIs(DebugDialogNames[DlgType]) then begin ViewDebugDialog(DlgType,false,false,DoDisableAutoSizing); AForm:=FDialogs[DlgType]; exit; end; raise Exception.Create('TDebugManager.CreateDebugDialog invalid FormName "'+aFormName+'"'); end; procedure TDebugManager.ClearDebugOutputLog; begin if FDialogs[ddtOutput] <> nil then TDbgOutputForm(FDialogs[ddtOutput]).Clear else if fHiddenDebugOutputLog<>nil then fHiddenDebugOutputLog.Clear; end; procedure TDebugManager.ClearDebugEventsLog; begin FEventLogManager.ClearDebugEventsLog; end; procedure TDebugManager.DoBackendConverterChanged; begin ValueConverterSelectorList.Lock; ProjectValueConverterSelectorList := nil; try ValueConverterSelectorList.Clear; if (Project1 <> nil) and (Project1.UseBackendConverterFromProject) then Project1.BackendConverterConfig.AssignEnabledTo(ValueConverterSelectorList, True); if (Project1 = nil) or (Project1.UseBackendConverterFromIDE) then DebuggerOptions.BackendConverterConfig.AssignEnabledTo(ValueConverterSelectorList, True); if (Project1 <> nil) then ProjectValueConverterSelectorList := Project1.BackendConverterConfig; finally ValueConverterSelectorList.Unlock; end; end; function TDebugManager.RequiredCompilerOpts(ATargetCPU, ATargetOS: String ): TDebugCompilerRequirements; begin if DebuggerClass = nil then exit([]); Result := DebuggerClass.RequiredCompilerOpts(ATargetCPU, ATargetOS); end; //----------------------------------------------------------------------------- // Debugger routines //----------------------------------------------------------------------------- procedure TDebugManager.FreeDebugger; var dbg: TDebuggerIntf; begin dbg := FDebugger; SetDebugger(nil); dbg.Release; FManagerStates := []; FIsInitializingDebugger:= False; if MainIDE.ToolStatus = itDebugger then MainIDE.ToolStatus := itNone; end; procedure TDebugManager.ResetDebugger; var OldState: TDBGState; begin OldState := State; if OldState = dsNone then Exit; FDebugger.BeginReset; EndDebugging; // OnDebuggerChangeState(FDebugger, OldState); // InitDebugger; end; function TDebugManager.GetLaunchPathAndExe(out LaunchingCmdLine, LaunchingApplication, LaunchingParams: String; PromptOnError: Boolean ): Boolean; procedure ClearPathAndExe; begin LaunchingApplication := ''; LaunchingParams := ''; LaunchingCmdLine := ''; end; var NewDebuggerClass: TDebuggerClass; begin Result := False; NewDebuggerClass := GetDebuggerClass; LaunchingCmdLine := BuildBoss.GetRunCommandLine; SplitCmdLine(LaunchingCmdLine, LaunchingApplication, LaunchingParams); if NewDebuggerClass.RequiresLocalExecutable then LaunchingApplication := ResolveLocationForLaunchApplication(LaunchingApplication); (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 Se Debugger.RequiresLocalExecutable *) if NewDebuggerClass.RequiresLocalExecutable then begin if BuildBoss.GetProjectUsesAppBundle then begin // it is Application Bundle (darwin only) if not DirectoryExistsUTF8(LaunchingApplication) then begin if not PromptOnError then ClearPathAndExe else begin BuildBoss.WriteDebug_RunCommandLine; if IDEMessageDialog(lisLaunchingApplicationInvalid, Format(lisTheLaunchingApplicationBundleDoesNotExists, [LaunchingApplication, LineEnding, LineEnding, LineEnding+LineEnding]), mtError, [mbYes, mbNo, mbCancel]) = mrYes then begin if not BuildBoss.CreateProjectApplicationBundle then Exit; end else Exit; end; end; if (NewDebuggerClass = TProcessDebugger) and (LaunchingApplication <> '') then begin // use executable path inside Application Bundle (darwin only) LaunchingApplication := LaunchingApplication + '/Contents/MacOS/' + ExtractFileNameOnly(LaunchingApplication); end; end else if not FileIsExecutable(LaunchingApplication) then begin BuildBoss.WriteDebug_RunCommandLine; if not PromptOnError then ClearPathAndExe else begin IDEMessageDialog(lisLaunchingApplicationInvalid, Format(lisTheLaunchingApplicationDoesNotExistsOrIsNotExecuta, [LaunchingApplication, LineEnding, LineEnding+LineEnding]), mtError, [mbOK]); Exit; end; end; // check if debugger needs an Exe and the exe is there if (NewDebuggerClass.NeedsExePath) and not FileIsExecutable(Project1.GetParsedDebuggerFilename) then begin if not PromptOnError then ClearPathAndExe else begin debugln(['Info: (lazarus) [TDebugManager.GetLaunchPathAndExe] Project1.DebuggerFilename="',Project1.DebuggerFilename,'"']); IDEMessageDialog(lisDebuggerInvalid, Format(lisTheDebuggerDoesNotExistsOrIsNotExecutableSeeEnviro, [Project1.DebuggerFilename, LineEnding, LineEnding+LineEnding]), mtError,[mbOK]); Exit; end; end; end; // if NewDebuggerClass.RequiresLocalExecutable then Result := True; end; function TDebugManager.InitDebugger(AFlags: TDbgInitFlags): Boolean; var LaunchingCmdLine, LaunchingApplication, LaunchingParams: String; NewWorkingDir: String; NewDebuggerClass: TDebuggerClass; DbgCfg: TDebuggerPropertiesConfig; begin {$ifdef VerboseDebugger} DebugLn('[TDebugManager.DoInitDebugger] A'); {$endif} Result := False; if FIsInitializingDebugger then begin DebugLn('[TDebugManager.DoInitDebugger] *** Re-Entered'); exit; end; if Destroying or (Project1 = nil) then Exit; if not(difInitForAttach in AFlags) then begin if (Project1.MainUnitID < 0) then Exit; if not GetLaunchPathAndExe(LaunchingCmdLine, LaunchingApplication, LaunchingParams) then exit; end else GetLaunchPathAndExe(LaunchingCmdLine, LaunchingApplication, LaunchingParams, False); FUnitInfoProvider.Clear; FIsInitializingDebugger:= True; try NewDebuggerClass := GetDebuggerClass; if (dmsDebuggerObjectBroken in FManagerStates) then begin FreeDebugger; FIsInitializingDebugger:= True; // been reset by FreeDebuger end; // check if debugger is already created with the right type if (FDebugger <> nil) and (not (FDebugger.ClassType = NewDebuggerClass) // exact class match or (FDebugger.ExternalDebugger <> Project1.GetParsedDebuggerFilename) or (FDebugger.State in [dsError]) ) then begin // the current debugger is the wrong type -> free it FreeDebugger; FIsInitializingDebugger:= True; // been reset by FreeDebuger end; // create debugger object if FDebugger = nil then SetDebugger(NewDebuggerClass.Create(Project1.GetParsedDebuggerFilename)); if FDebugger = nil then begin // something went wrong Exit; end; DbgCfg := Project1.CurrentDebuggerPropertiesConfig; if (DbgCfg <> nil) and (DbgCfg.DebuggerProperties <> nil) then FDebugger.GetProperties.Assign(DbgCfg.DebuggerProperties); ClearDebugOutputLog; if EnvironmentDebugOpts.DebuggerEventLogClearOnRun then ClearDebugEventsLog; //ensure to unset all evemts in SetDebugger() FDebugger.OnBreakPointHit := @DebuggerBreakPointHit; FDebugger.OnBeforeState := @DebuggerBeforeChangeState; FDebugger.OnState := @DebuggerChangeState; FDebugger.OnCurrent := @DebuggerCurrentLine; FDebugger.OnDbgOutput := @DebuggerOutput; FDebugger.OnDbgEvent := @FEventLogManager.DebuggerEvent; FDebugger.OnException := @DebuggerException; FDebugger.OnConsoleOutput := @DebuggerConsoleOutput; FDebugger.OnFeedback := @DebuggerFeedback; FDebugger.OnIdle := @DebuggerIdle; FDebugger.EventLogHandler := FEventLogManager; FEventLogManager.TargetWidth := FDebugger.TargetWidth div 8; if FDebugger.State = dsNone then begin Include(FManagerStates,dmsInitializingDebuggerObject); Exclude(FManagerStates,dmsInitializingDebuggerObjectFailed); // The following commands may call ProcessMessages, and FDebugger can be nil after each FDebugger.Init; Exclude(FManagerStates,dmsInitializingDebuggerObject); if (FDebugger = nil) or (dmsInitializingDebuggerObjectFailed in FManagerStates) then begin FreeDebugger; Exit; end; end; if not(difInitForAttach in AFlags) then begin Project1.RunParameterOptions.AssignEnvironmentTo(FDebugger.Environment); NewWorkingDir := BuildBoss.GetRunWorkingDir; if NewDebuggerClass.RequiresLocalExecutable and (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *) (NewWorkingDir<>'') and (not DirectoryExistsUTF8(NewWorkingDir)) then begin IDEMessageDialog(lisUnableToRun, Format(lisTheWorkingDirectoryDoesNotExistPleaseCheckTheWorki, [NewWorkingDir, LineEnding]), mtError,[mbCancel]); exit; end; // The following commands may call ProcessMessages, and FDebugger can be nil after each if (FDebugger <> nil) then begin if NewDebuggerClass.RequiresLocalExecutable then FDebugger.WorkingDir:=AppendPathDelim(NewWorkingDir) else if Project1.RunParameterOptions.GetActiveMode <> nil then FDebugger.WorkingDir:=Project1.RunParameterOptions.GetActiveMode.WorkingDirectory; end; // set filename after workingdir if FDebugger <> nil then FDebugger.FileName := LaunchingApplication; if FDebugger <> nil then FDebugger.Arguments := LaunchingParams; if FDebugger <> nil then FDebugger.ShowConsole := not Project1.CompilerOptions.Win32GraphicApp; end else begin // attach if (FDebugger <> nil) and (LaunchingApplication <> '') then FDebugger.FileName := LaunchingApplication; end; // check if debugging needs restart // mwe: can this still happen ? if (FDebugger = nil) or (dmsDebuggerObjectBroken in FManagerStates) then begin FreeDebugger; Exit; end; Result := True; finally // Since ProcessMessages has been called, debugger may have been reseted, even during initialization... if not FIsInitializingDebugger then begin Result := False; ResetDebugger; end; FIsInitializingDebugger:= False; end; {$ifdef VerboseDebugger} DebugLn('[TDebugManager.DoInitDebugger] END'); {$endif} end; function TDebugManager.DoSetBreakkPointWarnIfNoDebugger: boolean; var DbgClass: TDebuggerClass; begin DbgClass := Project1.CurrentDebuggerClass; if (DbgClass=nil) or (DbgClass.NeedsExePath and (not FileIsExecutableCached(Project1.GetParsedDebuggerFilename))) then begin if IDEQuestionDialog(lisDbgMangNoDebuggerSpecified, Format(lisDbgMangThereIsNoDebuggerSpecifiedSettingBreakpointsHaveNo,[LineEnding]), mtWarning, [mrCancel, mrIgnore, lisDbgMangSetTheBreakpointAnyway]) <> mrIgnore then exit(false); end; Result:=true; end; // still part of main, should go here when processdebugger is finished // //function TDebugManager.DoRunProject: TModalResult; function TDebugManager.DoPauseProject: TModalResult; begin Result := mrCancel; if (MainIDE.ToolStatus <> itDebugger) or (FDebugger = nil) or Destroying then Exit; FAutoContinueTimer.Enabled := False; FDebugger.Pause; Result := mrOk; end; function TDebugManager.DoShowExecutionPoint: TModalResult; begin Result := mrCancel; if (MainIDE.ToolStatus <> itDebugger) or (FDebugger = nil) or Destroying then Exit; DebuggerCurrentLine(FDebugger, FCurrentLocation); Result := mrOk; end; function TDebugManager.DoStepIntoProject: TModalResult; begin if (MainIDE.DoInitProjectRun <> mrOK) or (MainIDE.ToolStatus <> itDebugger) or (FDebugger = nil) or Destroying then begin Result := mrAbort; Exit; end; FStepping:=True; FAsmStepping := False; FDebugger.StepInto; Result := mrOk; end; function TDebugManager.DoStepOverProject: TModalResult; begin if (MainIDE.DoInitProjectRun <> mrOK) or (MainIDE.ToolStatus <> itDebugger) or (FDebugger = nil) or Destroying then begin Result := mrAbort; Exit; end; FStepping:=True; FAsmStepping := False; FDebugger.StepOver; Result := mrOk; end; function TDebugManager.DoStepIntoInstrProject: TModalResult; begin if (MainIDE.DoInitProjectRun <> mrOK) or (MainIDE.ToolStatus <> itDebugger) or (FDebugger = nil) or Destroying then begin Result := mrAbort; Exit; end; FStepping:=True; FAsmStepping := True; FDebugger.StepIntoInstr; Result := mrOk; // Todo: move to DebuggerChangeState (requires the last run-command-type to be avail) ViewDebugDialog(ddtAssembler); end; function TDebugManager.DoStepOverInstrProject: TModalResult; begin if (MainIDE.DoInitProjectRun <> mrOK) or (MainIDE.ToolStatus <> itDebugger) or (FDebugger = nil) or Destroying then begin Result := mrAbort; Exit; end; FStepping:=True; FAsmStepping := True; FDebugger.StepOverInstr; Result := mrOk; // Todo: move to DebuggerChangeState (requires the last run-command-type to be avail) ViewDebugDialog(ddtAssembler); end; function TDebugManager.DoStepOutProject: TModalResult; begin if (FDebugger = nil) or not(dcStepOut in FDebugger.Commands) then begin Result := mrAbort; Exit; end; if (MainIDE.DoInitProjectRun <> mrOK) or (MainIDE.ToolStatus <> itDebugger) or (FDebugger = nil) or Destroying then begin Result := mrAbort; Exit; end; FStepping:=True; FAsmStepping := False; FDebugger.StepOut; Result := mrOk; end; function TDebugManager.DoStopProject: TModalResult; begin Result := mrCancel; FRunTimer.Enabled:=false; Exclude(FManagerStates,dmsWaitForRun); Exclude(FManagerStates,dmsWaitForAttach); FAsmStepping := False; SourceEditorManager.ClearExecutionLines; if (MainIDE.ToolStatus=itDebugger) and (FDebugger<>nil) and (not Destroying) then begin FDebugger.Stop; end; if (dmsDebuggerObjectBroken in FManagerStates) then begin if (MainIDE.ToolStatus=itDebugger) then MainIDE.ToolStatus:=itNone; end; FUnitInfoProvider.Clear; // Maybe keep locations? But clear "not found"/"not loadable" flags? Result := mrOk; end; procedure TDebugManager.DoToggleCallStack; begin ViewDebugDialog(ddtCallStack); end; procedure TDebugManager.DoSendConsoleInput(AText: String); begin if FDebugger <> nil then FDebugger.SendConsoleInput(AText); end; procedure TDebugManager.ProcessCommand(Command: word; var Handled: boolean); var AvailCommands: TDBGCommands; CanRun: Boolean; begin //debugln('TDebugManager.ProcessCommand ',dbgs(Command)); Handled := True; CanRun := CanRunDebugger; AvailCommands := GetAvailableCommands; case Command of ecPause: DoPauseProject; ecStepInto: if CanRun and (dcStepInto in AvailCommands) then DoStepIntoProject; ecStepOver: if CanRun and (dcStepOver in AvailCommands) then DoStepOverProject; ecStepIntoInstr: if CanRun and (dcStepIntoInstr in AvailCommands) then DoStepIntoInstrProject; ecStepOverInstr: if CanRun and (dcStepOverInstr in AvailCommands) then DoStepOverInstrProject; ecStepIntoContext: if CanRun then begin if (FDialogs[ddtAssembler] <> nil) and FDialogs[ddtAssembler].Active then begin if dcStepIntoInstr in AvailCommands then DoStepIntoInstrProject; end else begin if dcStepInto in AvailCommands then DoStepIntoProject; end; end; ecStepOverContext: if CanRun then begin if (FDialogs[ddtAssembler] <> nil) and FDialogs[ddtAssembler].Active then begin if dcStepOverInstr in AvailCommands then DoStepOverInstrProject; end else begin if dcStepOver in AvailCommands then DoStepOverProject; end; end; ecStepOut: if CanRun and (dcStepOut in AvailCommands) then DoStepOutProject; ecStepToCursor: if CanRun and (dcStepTo in AvailCommands) then DoStepToCursor; ecRunToCursor: if CanRun and (dcRunTo in AvailCommands) then DoRunToCursor; ecStopProgram: DoStopProject; ecResetDebugger: ResetDebugger; ecToggleCallStack: DoToggleCallStack; ecEvaluate: ViewDebugDialog(ddtEvaluate); ecInspect: ViewDebugDialog(ddtInspect); ecToggleWatches: ViewDebugDialog(ddtWatches); ecToggleBreakPoints: ViewDebugDialog(ddtBreakpoints); ecToggleDebuggerOut: ViewDebugDialog(ddtOutput); ecToggleDebugEvents: ViewDebugDialog(ddtEvents); ecToggleLocals: ViewDebugDialog(ddtLocals); ecViewPseudoTerminal: ViewDebugDialog(ddtPseudoTerminal); ecViewThreads: ViewDebugDialog(ddtThreads); ecViewHistory: ViewDebugDialog(ddtHistory); else Handled := False; end; end; procedure TDebugManager.LockCommandProcessing; begin if assigned(FDebugger) then FDebugger.LockCommandProcessing; end; procedure TDebugManager.UnLockCommandProcessing; begin if assigned(FDebugger) then FDebugger.UnLockCommandProcessing; end; function TDebugManager.StartDebugging: TModalResult; begin {$ifdef VerboseDebugger} DebugLn('TDebugManager.StartDebugging A ',DbgS(FDebugger<>nil),' Destroying=',DbgS(Destroying)); {$endif} Result:=mrCancel; if Destroying then exit; if FManagerStates*[dmsWaitForRun, dmsWaitForAttach] <> [] then exit; if (FDebugger <> nil) then begin // dmsRunning + dsPause => evaluating stack+watches after run if (dmsRunning in FManagerStates) then begin if (FDebugger.State = dsPause) then FDebugger.Run; exit; end; {$ifdef VerboseDebugger} DebugLn('TDebugManager.StartDebugging B ',FDebugger.ClassName); {$endif} // check if debugging needs restart if (dmsDebuggerObjectBroken in FManagerStates) and (MainIDE.ToolStatus=itDebugger) then begin MainIDE.ToolStatus:=itNone; Result:=mrCancel; exit; end; Include(FManagerStates,dmsWaitForRun); FRunTimer.Enabled:=true; Result:=mrOk; end; end; function TDebugManager.RunDebugger: TModalResult; begin {$ifdef VerboseDebugger} DebugLn('TDebugManager.RunDebugger A ',DbgS(FDebugger<>nil),' Destroying=',DbgS(Destroying)); {$endif} Result:=mrCancel; if Destroying then exit; Exclude(FManagerStates,dmsWaitForRun); if dmsRunning in FManagerStates then exit; if MainIDE.ToolStatus<>itDebugger then exit; if (FDebugger <> nil) then begin {$ifdef VerboseDebugger} DebugLn('TDebugManager.RunDebugger B ',FDebugger.ClassName); {$endif} // check if debugging needs restart if (dmsDebuggerObjectBroken in FManagerStates) and (MainIDE.ToolStatus=itDebugger) then begin MainIDE.ToolStatus:=itNone; Result:=mrCancel; exit; end; Include(FManagerStates,dmsRunning); FStepping:=False; FAsmStepping := False; try FDebugger.Run; finally Exclude(FManagerStates,dmsRunning); end; Result:=mrOk; end; end; procedure TDebugManager.EndDebugging; begin FRunTimer.Enabled:=false; Exclude(FManagerStates,dmsWaitForRun); Exclude(FManagerStates,dmsWaitForAttach); if FDebugger <> nil then FDebugger.Done; // if not already freed FreeDebugger; end; procedure TDebugManager.Attach(AProcessID: String); begin if Destroying then exit; if FManagerStates*[dmsWaitForRun, dmsWaitForAttach, dmsRunning] <> [] then exit; if (FDebugger <> nil) then begin // check if debugging needs restart if (dmsDebuggerObjectBroken in FManagerStates) and (MainIDE.ToolStatus=itDebugger) then begin MainIDE.ToolStatus:=itNone; exit; end; FAttachToID := AProcessID; Include(FManagerStates,dmsWaitForAttach); FRunTimer.Enabled:=true; end; end; function TDebugManager.FillProcessList(AList: TRunningProcessInfoList): boolean; begin Result := (not Destroying) and (MainIDE.ToolStatus in [itDebugger, itNone]) and (FDebugger <> nil) and FDebugger.GetProcessList(AList); end; procedure TDebugManager.Detach; begin FRunTimer.Enabled:=false; Exclude(FManagerStates,dmsWaitForRun); Exclude(FManagerStates,dmsWaitForAttach); SourceEditorManager.ClearExecutionLines; if (MainIDE.ToolStatus=itDebugger) and (FDebugger<>nil) and (not Destroying) then begin FDebugger.Detach; end; if (dmsDebuggerObjectBroken in FManagerStates) then begin if (MainIDE.ToolStatus=itDebugger) then MainIDE.ToolStatus:=itNone; end; FUnitInfoProvider.Clear; // Maybe keep locations? But clear "not found"/"not loadable" flags? end; function TDebugManager.Evaluate(const AExpression: String; ACallback: TDBGEvaluateResultCallback; EvalFlags: TWatcheEvaluateFlags): Boolean; begin Result := (not Destroying) and (MainIDE.ToolStatus = itDebugger) and (FDebugger <> nil) and (dcEvaluate in FDebugger.Commands) and FDebugger.Evaluate(AExpression, ACallback, EvalFlags); end; function TDebugManager.Modify(const AExpression, ANewValue: String): Boolean; begin Result := (not Destroying) and (MainIDE.ToolStatus = itDebugger) and (FDebugger <> nil) and (dcModify in FDebugger.Commands) and FDebugger.Modify(AExpression, ANewValue); end; procedure TDebugManager.EvaluateModify(const AExpression: String; AWatch: TWatch ); begin if Destroying then Exit; ViewDebugDialog(ddtEvaluate, True, True, False, False); if FDialogs[ddtEvaluate] <> nil then TEvaluateDlg(FDialogs[ddtEvaluate]).Execute(AExpression, AWatch); end; procedure TDebugManager.Inspect(const AExpression: String; AWatch: TWatch); begin if Destroying then Exit; ViewDebugDialog(ddtInspect, True, True, False, False); if FDialogs[ddtInspect] <> nil then begin TIDEInspectDlg(FDialogs[ddtInspect]).Execute(AExpression, AWatch); end; end; function TDebugManager.DoCreateBreakPoint(const AFilename: string; ALine: integer; WarnIfNoDebugger: boolean): TModalResult; var ABrkPoint: TIDEBreakPoint; begin Result := DoCreateBreakPoint(AFilename, ALine, WarnIfNoDebugger, ABrkPoint); end; function TDebugManager.DoCreateBreakPoint(const AFilename: string; ALine: integer; WarnIfNoDebugger: boolean; out ABrkPoint: TIDEBreakPoint; AnUpdating: Boolean): TModalResult; begin ABrkPoint := nil; if WarnIfNoDebugger and not DoSetBreakkPointWarnIfNoDebugger then exit(mrCancel); ABrkPoint := FBreakPoints.Add(AFilename, ALine, AnUpdating); Result := mrOK; end; function TDebugManager.DoCreateBreakPoint(const AnAddr: TDBGPtr; WarnIfNoDebugger: boolean; out ABrkPoint: TIDEBreakPoint; AnUpdating: Boolean ): TModalResult; begin ABrkPoint := nil; if WarnIfNoDebugger and not DoSetBreakkPointWarnIfNoDebugger then exit(mrCancel); ABrkPoint := FBreakPoints.Add(AnAddr, AnUpdating); Result := mrOK; end; function TDebugManager.DoDeleteBreakPoint(const AFilename: string; ALine: integer): TModalResult; var OldBreakPoint: TIDEBreakPoint; begin LockCommandProcessing; try OldBreakPoint:=FBreakPoints.Find(AFilename,ALine); if OldBreakPoint=nil then exit(mrOk); ReleaseRefAndNil(OldBreakPoint); Project1.Modified:=true; Result := mrOK; finally UnLockCommandProcessing; end; end; function TDebugManager.DoDeleteBreakPointAtMark(const ASourceMarkObj: TObject ): TModalResult; var OldBreakPoint: TIDEBreakPoint; ASourceMark: TSourceMark absolute ASourceMarkObj; begin LockCommandProcessing; try // consistency check if (ASourceMarkObj=nil) or (not (ASourceMarkObj is TSourceMark)) or (not ASourceMark.IsBreakPoint) or (ASourceMark.Data=nil) or (not (ASourceMark.Data is TIDEBreakPoint)) then RaiseGDBException('TDebugManager.DoDeleteBreakPointAtMark'); {$ifdef VerboseDebugger} DebugLn('TDebugManager.DoDeleteBreakPointAtMark A ',ASourceMark.GetFilename, ' ',IntToStr(ASourceMark.Line)); {$endif} OldBreakPoint:=TIDEBreakPoint(ASourceMark.Data); {$ifdef VerboseDebugger} DebugLn('TDebugManager.DoDeleteBreakPointAtMark B ',OldBreakPoint.ClassName, ' ',OldBreakPoint.Source,' ',IntToStr(OldBreakPoint.Line)); {$endif} ReleaseRefAndNil(OldBreakPoint); Project1.Modified:=true; Result := mrOK; finally UnLockCommandProcessing; end; end; function TDebugManager.DoStepToCursor: TModalResult; var ActiveSrcEdit: TSourceEditorInterface; ActiveUnitInfo: TUnitInfo; UnitFilename: string; begin {$ifdef VerboseDebugger} DebugLn('TDebugManager.DoStepToCursor A'); {$endif} if (FDebugger = nil) or not(dcStepTo in FDebugger.Commands) then begin Result := mrAbort; Exit; end; if (MainIDE.DoInitProjectRun <> mrOK) or (MainIDE.ToolStatus <> itDebugger) or (FDebugger = nil) or Destroying then begin Result := mrAbort; Exit; end; {$ifdef VerboseDebugger} DebugLn('TDebugManager.DoStepToCursor B'); {$endif} Result := mrCancel; MainIDE.GetCurrentUnitInfo(ActiveSrcEdit,ActiveUnitInfo); if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil) then begin IDEMessageDialog(lisRunToFailed, lisPleaseOpenAUnitBeforeRun, mtError, [mbCancel]); Result := mrCancel; Exit; end; if not ActiveUnitInfo.Source.IsVirtual then UnitFilename:=ActiveUnitInfo.Filename else UnitFilename:=BuildBoss.GetTestUnitFilename(ActiveUnitInfo); {$ifdef VerboseDebugger} DebugLn('TDebugManager.DoStepToCursor C'); {$endif} FDebugger.StepTo(ExtractFilename(UnitFilename), TSourceEditor(ActiveSrcEdit).EditorComponent.CaretY); {$ifdef VerboseDebugger} DebugLn('TDebugManager.DoStepToCursor D'); {$endif} Result := mrOK; end; function TDebugManager.DoRunToCursor: TModalResult; var ActiveSrcEdit: TSourceEditorInterface; ActiveUnitInfo: TUnitInfo; UnitFilename: string; begin if (MainIDE.DoInitProjectRun <> mrOK) or (MainIDE.ToolStatus <> itDebugger) or (FDebugger = nil) or Destroying then begin Result := mrAbort; Exit; end; MainIDE.GetCurrentUnitInfo(ActiveSrcEdit,ActiveUnitInfo); if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil) then begin IDEMessageDialog(lisRunToFailed, lisPleaseOpenAUnitBeforeRun, mtError, [mbCancel]); Result := mrCancel; Exit; end; if not ActiveUnitInfo.Source.IsVirtual then UnitFilename:=ActiveUnitInfo.Filename else UnitFilename:=BuildBoss.GetTestUnitFilename(ActiveUnitInfo); FStepping:=True; FAsmStepping := False; FDebugger.RunTo(ExtractFilename(UnitFilename), TSourceEditor(ActiveSrcEdit).EditorComponent.CaretY); Result := mrOK; end; function TDebugManager.GetState: TDBGState; begin if FDebugger = nil then Result := dsNone else Result := FDebugger.State; end; function TDebugManager.GetCommands: TDBGCommands; begin if FDebugger = nil then Result := [] else Result := FDebugger.Commands; end; function TDebugManager.GetPseudoTerminal: TPseudoTerminal; begin if FDebugger = nil then Result := nil else Result := FDebugger.PseudoTerminal; end; function TDebugManager.GetDebuggerClass: TDebuggerClass; begin Result := Project1.CurrentDebuggerClass; if Result = nil then Result := TProcessDebugger; end; {$IFDEF DBG_WITH_DEBUGGER_DEBUG} function TDebugManager.GetDebugger: TDebuggerIntf; begin Result := FDebugger; end; {$ENDIF} function TDebugManager.GetCurrentDebuggerClass: TDebuggerClass; begin Result := GetDebuggerClass; end; function TDebugManager.AttachDebugger: TModalResult; begin Result:=mrCancel; if Destroying then exit; Exclude(FManagerStates,dmsWaitForAttach); if dmsRunning in FManagerStates then exit; if MainIDE.ToolStatus<>itDebugger then exit; if (FDebugger <> nil) then begin // check if debugging needs restart if (dmsDebuggerObjectBroken in FManagerStates) and (MainIDE.ToolStatus=itDebugger) then begin MainIDE.ToolStatus:=itNone; Result:=mrCancel; exit; end; Include(FManagerStates,dmsRunning); FStepping:=False; FAsmStepping := False; try FDebugger.Attach(FAttachToID); finally Exclude(FManagerStates,dmsRunning); end; Result:=mrOk; end; end; procedure TDebugManager.CallWatchesInvalidatedHandlers(Sender: TObject); begin FWatchesInvalidatedNotificationList.CallNotifyEvents(Self); end; function TDebugManager.GetAvailableCommands: TDBGCommands; var CurState: TDBGState; begin Result := []; if FDebugger <> nil then begin Result := FDebugger.Commands; CurState := FDebugger.State; if CurState = dsError then begin CurState := dsStop; Result := GetDebuggerClass.SupportedCommandsFor(dsStop); end; end else begin Result := GetDebuggerClass.SupportedCommandsFor(dsStop); CurState := dsStop; end; end; function TDebugManager.CanRunDebugger: Boolean; var DebuggerIsValid: Boolean; SrcEdit: TSourceEditorInterface; AnUnitInfo: TUnitInfo; begin DebuggerIsValid:=(MainIDE.ToolStatus in [itNone, itDebugger]); // For 'run' and 'step' bypass 'idle', so we can set the filename later Result:=false; if (Project1<>nil) and DebuggerIsValid then begin MainIDE.GetCurrentUnitInfo(SrcEdit,AnUnitInfo); Result:=( (AnUnitInfo<>nil) and (AnUnitInfo.RunFileIfActive) ) or ( ((Project1.CompilerOptions.ExecutableType=cetProgram) or ((Project1.RunParameterOptions.GetActiveMode<>nil) and (Project1.RunParameterOptions.GetActiveMode.HostApplicationFilename<>''))) and (pfRunnable in Project1.Flags) ); end; end; function TDebugManager.ShowBreakPointProperties(const ABreakpoint: TIDEBreakPoint): TModalresult; begin Result := TBreakPropertyDlg.Create(Self, ABreakpoint).ShowModal; end; function TDebugManager.ShowWatchProperties(const AWatch: TCurrentWatch; AWatchExpression: String = ''): TModalresult; begin Result := TWatchPropertyDlg.Create(Self, AWatch, AWatchExpression).ShowModal; end; procedure TDebugManager.SetDebugger(const ADebugger: TDebuggerIntf); begin if FDebugger = ADebugger then Exit; FRunTimer.Enabled:=false; Exclude(FManagerStates,dmsWaitForRun); Exclude(FManagerStates,dmsWaitForAttach); if FDebugger <> nil then begin FDebugger.OnBreakPointHit := nil; FDebugger.OnBeforeState := nil; FDebugger.OnState := nil; FDebugger.OnCurrent := nil; FDebugger.OnDbgOutput := nil; FDebugger.OnDbgEvent := nil; FDebugger.OnException := nil; FDebugger.OnConsoleOutput := nil; FDebugger.OnFeedback := nil; FDebugger.OnIdle := nil; FDebugger.Exceptions := nil; FDebugger.EventLogHandler := nil; end; FDebugger := ADebugger; if FDebugger = nil then begin TManagedBreakpoints(FBreakpoints).Master := nil; FWatches.Supplier := nil; FThreads.Supplier := nil; FLocals.Supplier := nil; FLineInfo.Master := nil; FCallStack.Supplier := nil; FDisassembler.Master := nil; FSignals.Master := nil; FRegisters.Supplier := nil; FSnapshots.Debugger := nil; end else begin TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints; FWatches.Supplier := FDebugger.WatchSupplier; FThreads.Supplier := FDebugger.Threads; FThreads.UnitInfoProvider := FUnitInfoProvider; FLocals.Supplier := FDebugger.Locals; FLineInfo.Master := FDebugger.LineInfo; FCallStack.Supplier := FDebugger.CallStack; FCallStack.UnitInfoProvider := FUnitInfoProvider; FDisassembler.Master := FDebugger.Disassembler; FSignals.Master := FDebugger.Signals; FRegisters.Supplier := FDebugger.Registers; FSnapshots.Debugger := FDebugger; FDebugger.Exceptions := FExceptions; end; end; initialization DBG_LOCATION_INFO := DebugLogger.FindOrRegisterLogGroup('DBG_LOCATION_INFO' {$IFDEF DBG_LOCATION_INFO} , True {$ENDIF} ); if DBG_LOCATION_INFO=nil then ; end.