1 { $Id$ }
2 {
3 /***************************************************************************
4 debugmanager.pp
5 ---------------
6 TDebugManager controls all debugging related stuff in the IDE.
7
8
9 ***************************************************************************/
10
11 ***************************************************************************
12 * *
13 * This source is free software; you can redistribute it and/or modify *
14 * it under the terms of the GNU General Public License as published by *
15 * the Free Software Foundation; either version 2 of the License, or *
16 * (at your option) any later version. *
17 * *
18 * This code is distributed in the hope that it will be useful, but *
19 * WITHOUT ANY WARRANTY; without even the implied warranty of *
20 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
21 * General Public License for more details. *
22 * *
23 * A copy of the GNU General Public License is available on the World *
24 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
25 * obtain it by writing to the Free Software Foundation, *
26 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
27 * *
28 ***************************************************************************
29 }
30 unit DebugManager;
31
32 {$mode objfpc}{$H+}
33
34 interface
35
36 {$I ide.inc}
37 {off $define VerboseDebugger}
38
39 uses
40 {$IFDEF IDE_MEM_CHECK}
41 MemCheck,
42 {$ENDIF}
43 Classes, SysUtils, math,
44 // LCL
45 LCLType, LCLIntf, Forms, Controls, Dialogs, ExtCtrls,
46 // LazUtils
47 LazFileUtils, LazFileCache, LazLoggerBase, Laz2_XMLCfg, LazUTF8, LazTracer,
48 // codetools
49 CodeCache, CodeToolManager, PascalParserTool, CodeTree,
50 // IDEIntf
51 IDEWindowIntf, SrcEditorIntf, MenuIntf, IDECommands, LazIDEIntf, ProjectIntf,
52 CompOptsIntf, IDEDialogs, ToolBarIntf,
53 // IDE
54 CompilerOptions, EnvironmentOpts, SourceEditor, ProjectDefs, Project,
55 InputHistory, Debugger, LazarusIDEStrConsts, TransferMacros,
56 MainBar, MainIntf, MainBase, BaseBuildManager, SourceMarks, DebuggerDlg,
57 Watchesdlg, BreakPointsdlg, BreakPropertyDlg, LocalsDlg, WatchPropertyDlg,
58 CallStackDlg, EvaluateDlg, RegistersDlg, AssemblerDlg, DebugOutputForm,
59 ExceptionDlg, InspectDlg, DebugEventsForm, PseudoTerminalDlg, FeedbackDlg,
60 ThreadDlg, HistoryDlg, ProcessDebugger, DbgIntfBaseTypes, DbgIntfDebuggerBase,
61 DbgIntfMiscClasses, DbgIntfPseudoTerminal, BaseDebugManager;
62
63
64 type
65
66 { TDebugEventLogManager }
67
68 TDebugEventLogManager = class(TObject, TDebuggerEventLogInterface)
69 private
70 FEventDialog: TDbgEventsForm;
71 FHiddenDebugEventsLog: TStringList;
72 FTargetWidth: Integer;
73 procedure SetEventDialog(AValue: TDbgEventsForm);
FormatBreakPointAddressnull74 function FormatBreakPointAddress(const ABreakpoint: TDBGBreakPoint;
75 const ALocation: TDBGLocationRec): String;
76 protected
77 procedure DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
78 public
79 procedure LogCustomEvent(const ACategory: TDBGEventCategory;
80 const AEventType: TDBGEventType; const AText: String);
81 procedure LogEventBreakPointHit(const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
82 procedure LogEventWatchPointTriggered(const ABreakpoint: TDBGBreakPoint;
83 const ALocation: TDBGLocationRec; const AOldWatchedVal, ANewWatchedVal: String);
84 procedure LogEventWatchPointScope(const ABreakpoint: TDBGBreakPoint;
85 const ALocation: TDBGLocationRec);
86 public
87 destructor Destroy; override;
88 procedure ClearDebugEventsLog;
89 property EventDialog: TDbgEventsForm read FEventDialog write SetEventDialog;
90 property TargetWidth: Integer read FTargetWidth write FTargetWidth;
91 end;
92
93 { TDebugManager }
94
95 TDebugManager = class(TBaseDebugManager)
96 procedure DebuggerIdle(Sender: TObject);
DoProjectClosenull97 function DoProjectClose(Sender: TObject; AProject: TLazProject): TModalResult;
98 procedure DoProjectModified(Sender: TObject);
99 private
100 FAsmWindowShouldAutoClose: Boolean;
101 procedure BreakAutoContinueTimer(Sender: TObject);
102 procedure OnRunTimer(Sender: TObject);
103 // Menu events
104 procedure mnuViewDebugDialogClick(Sender: TObject);
105 procedure mnuResetDebuggerClicked(Sender: TObject);
106 procedure mnuAddWatchClicked(Sender: TObject);
107 procedure mnuAddBpAddress(Sender: TObject);
108 procedure mnuAddBpSource(Sender: TObject);
109 procedure mnuAddBpData(Sender: TObject);
110 procedure mnuAddBpDataAtCursor(Sender: TObject);
111
112 // Debugger events
113 procedure DebuggerBreakPointHit({%H-}ADebugger: TDebuggerIntf; ABreakPoint: TBaseBreakPoint; var {%H-}ACanContinue: Boolean);
114 procedure DebuggerBeforeChangeState(ADebugger: TDebuggerIntf; AOldState: TDBGState);
115 procedure DebuggerChangeState(ADebugger: TDebuggerIntf; OldState: TDBGState);
116 procedure DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
117 procedure DebuggerOutput(Sender: TObject; const AText: String);
118 procedure DebuggerConsoleOutput(Sender: TObject; const AText: String);
DebuggerFeedbacknull119 function DebuggerFeedback(Sender: TObject; const AText, AInfo: String;
120 AType: TDBGFeedbackType; AButtons: TDBGFeedbackResults): TDBGFeedbackResult;
121 procedure DebuggerException(Sender: TObject;
122 const AExceptionType: TDBGExceptionType;
123 const AExceptionClass: String;
124 const AExceptionLocation: TDBGLocationRec;
125 const AExceptionText: String;
126 out AContinue: Boolean);
127
128 // Dialog events
129 procedure DebugDialogDestroy(Sender: TObject);
130 private
131 FDebugger: TDebuggerIntf;
132 FEventLogManager: TDebugEventLogManager;
133 FUnitInfoProvider: TDebuggerUnitInfoProvider;
134 FDialogs: array[TDebugDialogType] of TDebuggerDlg;
135 FInStateChange: Boolean;
136 FPrevShownWindow: HWND;
137 FStepping: Boolean;
138 // keep track of the last reported location
139 FCurrentLocation: TDBGLocationRec;
140 // last hit breakpoint
141 FCurrentBreakpoint: TIDEBreakpoint;
142 FAutoContinueTimer: TTimer;
143 FIsInitializingDebugger: Boolean;
144
145 // When a source file is not found, the user can choose one
146 // here are all choices stored
147 FUserSourceFiles: TStringList;
148
149 // when the debug output log is not open, store the debug log internally
150 FHiddenDebugOutputLog: TStringList;
151
152 FRunTimer: TTimer;
153 FAttachToID: String;
154
155 procedure SetDebugger(const ADebugger: TDebuggerIntf);
156
157 // Breakpoint routines
158 procedure CreateSourceMarkForBreakPoint(const ABreakpoint: TIDEBreakPoint;
159 ASrcEdit: TSourceEditor);
160 procedure GetSourceEditorForBreakPoint(const ABreakpoint: TIDEBreakPoint;
161 var ASrcEdit: TSourceEditor);
162
163 // Dialog routines
164 procedure DestroyDebugDialog(const ADialogType: TDebugDialogType);
165 procedure InitDebugOutputDlg;
166 procedure InitDebugEventsDlg;
167 procedure InitBreakPointDlg;
168 procedure InitWatchesDlg;
169 procedure InitThreadsDlg;
170 procedure InitPseudoTerminal;
171 procedure InitLocalsDlg;
172 procedure InitCallStackDlg;
173 procedure InitEvaluateDlg;
174 procedure InitRegistersDlg;
175 procedure InitAssemblerDlg;
176 procedure InitInspectDlg;
177 procedure InitHistoryDlg;
178
179 procedure FreeDebugger;
180 procedure ResetDebugger;
181
GetLaunchPathAndExenull182 function GetLaunchPathAndExe(out LaunchingCmdLine, LaunchingApplication,
183 LaunchingParams: String; PromptOnError: Boolean = True): Boolean;
184 protected
GetStatenull185 function GetState: TDBGState; override;
GetCommandsnull186 function GetCommands: TDBGCommands; override;
GetPseudoTerminalnull187 function GetPseudoTerminal: TPseudoTerminal; override;
GetDebuggerClassnull188 function GetDebuggerClass: TDebuggerClass;
189 {$IFDEF DBG_WITH_DEBUGGER_DEBUG}
GetDebuggernull190 function GetDebugger: TDebuggerIntf; override;
191 {$ENDIF}
GetCurrentDebuggerClassnull192 function GetCurrentDebuggerClass: TDebuggerClass; override; (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *)
AttachDebuggernull193 function AttachDebugger: TModalResult;
194 public
195 constructor Create(TheOwner: TComponent); override;
196 destructor Destroy; override;
197 procedure Reset; override;
198
199 procedure ConnectMainBarEvents; override;
200 procedure ConnectSourceNotebookEvents; override;
201 procedure SetupMainBarShortCuts; override;
202 procedure SetupSourceMenuShortCuts; override;
203 procedure UpdateButtonsAndMenuItems; override;
204 procedure UpdateToolStatus; override;
205 procedure EnvironmentOptsChanged; override;
206
207 procedure LoadProjectSpecificInfo(XMLConfig: TXMLConfig;
208 Merge: boolean); override;
209 procedure SaveProjectSpecificInfo(XMLConfig: TXMLConfig;
210 Flags: TProjectWriteFlags); override;
211 procedure DoRestoreDebuggerMarks(AnUnitInfo: TUnitInfo); override;
212 procedure ClearDebugOutputLog;
213 procedure ClearDebugEventsLog;
214
RequiredCompilerOptsnull215 function RequiredCompilerOpts(ATargetCPU, ATargetOS: String
216 ): TDebugCompilerRequirements; override;
InitDebuggernull217 function InitDebugger(AFlags: TDbgInitFlags = []): Boolean; override;
DoSetBreakkPointWarnIfNoDebuggernull218 function DoSetBreakkPointWarnIfNoDebugger: boolean;
219
DoPauseProjectnull220 function DoPauseProject: TModalResult; override;
DoShowExecutionPointnull221 function DoShowExecutionPoint: TModalResult; override;
DoStepIntoProjectnull222 function DoStepIntoProject: TModalResult; override;
DoStepOverProjectnull223 function DoStepOverProject: TModalResult; override;
DoStepIntoInstrProjectnull224 function DoStepIntoInstrProject: TModalResult; override;
DoStepOverInstrProjectnull225 function DoStepOverInstrProject: TModalResult; override;
DoStepOutProjectnull226 function DoStepOutProject: TModalResult; override;
DoStepToCursornull227 function DoStepToCursor: TModalResult; override;
DoRunToCursornull228 function DoRunToCursor: TModalResult; override;
DoStopProjectnull229 function DoStopProject: TModalResult; override;
230 procedure DoToggleCallStack; override;
231 procedure DoSendConsoleInput(AText: String); override;
232 procedure ProcessCommand(Command: word; var Handled: boolean); override;
233
234 //Some debuugers may do things like ProcessMessages while processing commands
235 //and that can cause side-effects
236 //The debugger may run it's queue either during UnLockCommandProcessing or later
237 procedure LockCommandProcessing; override;
238 procedure UnLockCommandProcessing; override;
239
240 function StartDebugging: TModalResult; override; // returns immediately
241 function RunDebugger: TModalResult; override; // waits till program ends
242 procedure EndDebugging; override;
243
244 procedure Attach(AProcessID: String); override;
245 function FillProcessList(AList: TRunningProcessInfoList): boolean; override;
246 procedure Detach; override;
247
248 function Evaluate(const AExpression: String; ACallback: TDBGEvaluateResultCallback;
249 EvalFlags: TDBGEvaluateFlags = []): Boolean; override;
250 function Modify(const AExpression, ANewValue: String): Boolean; override;
251
252 procedure EvaluateModify(const AExpression: String); override;
253 procedure Inspect(const AExpression: String); override;
254
255 function GetFullFilename(const AUnitinfo: TDebuggerUnitInfo; out Filename: string;
256 AskUserIfNotFound: Boolean): Boolean; override;
257 function GetFullFilename(var Filename: string; AskUserIfNotFound: Boolean): Boolean; override;
258
259 function DoCreateBreakPoint(const AFilename: string; ALine: integer;
260 WarnIfNoDebugger: boolean): TModalResult; override;
261 function DoCreateBreakPoint(const AFilename: string; ALine: integer;
262 WarnIfNoDebugger: boolean;
263 out ABrkPoint: TIDEBreakPoint;
264 AnUpdating: Boolean = False): TModalResult; override;
265 function DoCreateBreakPoint(const AnAddr: TDBGPtr;
266 WarnIfNoDebugger: boolean;
267 out ABrkPoint: TIDEBreakPoint;
268 AnUpdating: Boolean = False): TModalResult; override;
269
270 function DoDeleteBreakPoint(const AFilename: string;
271 ALine: integer): TModalResult; override;
272 function DoDeleteBreakPointAtMark(
273 const ASourceMark: TSourceMark): TModalResult; override;
274
275 function ShowBreakPointProperties(const ABreakpoint: TIDEBreakPoint): TModalresult; override;
276 function ShowWatchProperties(const AWatch: TCurrentWatch; AWatchExpression: String = ''): TModalresult; override;
277
278 // Dialog routines
279 procedure CreateDebugDialog(Sender: TObject; aFormName: string;
280 var AForm: TCustomForm; DoDisableAutoSizing: boolean); override;
281 procedure ViewDebugDialog(const ADialogType: TDebugDialogType; BringToFront: Boolean = true; Show: Boolean = true; DoDisableAutoSizing: boolean = false); override;
282 procedure ViewDisassembler(AnAddr: TDBGPtr;
283 BringToFront: Boolean = True; Show: Boolean = true;
284 DoDisableAutoSizing: boolean = false); override;
285 end;
286
287 function DBGDateTimeFormatter(const aValue: string): string;
288
289 implementation
290
291 var
292 DBG_LOCATION_INFO: PLazLoggerLogGroup;
293
294 function DBGDateTimeFormatter(const aValue: string): string;
295 var
296 FS: TFormatSettings;
297 MyDate: Extended;
298 begin
299 FillChar(FS{%H-}, SizeOf(TFormatSettings), 0);
300 FS.DecimalSeparator := '.';
301 if TryStrToFloat(aValue, MyDate, FS) then
302 begin
303 // it is important to know datetime for all TDate/TTime/TDateTime
304 if SameValue(Frac(MyDate), 0) then
305 Result := DateToStr(MyDate)
306 else
307 if SameValue(Int(MyDate), 0) then
308 Result := TimeToStr(MyDate)
309 else
310 Result := DateTimeToStr(MyDate);
311 end else
312 Result := aValue;
313 end;
314
315 type
316
317 { TManagedBreakPoint }
318
319 TManagedBreakPoint = class(TIDEBreakPoint)
320 private
321 FSourceMark: TSourceMark;
322 FCurrentDebugExeLine: Integer;
323 procedure OnSourceMarkBeforeFree(Sender: TObject);
324 procedure OnSourceMarkCreatePopupMenu(SenderMark: TSourceMark;
325 const AddMenuItem: TAddMenuItemProc);
326 procedure OnSourceMarkGetHint(SenderMark: TSourceMark; var Hint: string);
327 procedure OnSourceMarkPositionChanged(Sender: TObject);
328 procedure OnToggleEnableMenuItemClick(Sender: TObject);
329 procedure OnDeleteMenuItemClick(Sender: TObject);
330 procedure OnViewPropertiesMenuItemClick(Sender: TObject);
331 protected
332 procedure DoChanged; override;
333
334 procedure SetSourceMark(const AValue: TSourceMark);
335 procedure UpdateSourceMark;
336 procedure UpdateSourceMarkImage;
337 procedure UpdateSourceMarkLineColor;
338 function DebugExeLine: Integer; override; // If known, the line in the compiled exe
339 public
340 procedure CopySourcePositionToBreakPoint;
341 procedure SetLocation(const ASource: String; const ALine: Integer); override;
342 property SourceMark: TSourceMark read FSourceMark write SetSourceMark;
343 end;
344
345 { TManagedBreakPoints }
346
347 TManagedBreakPoints = class(TIDEBreakPoints)
348 private
349 FManager: TDebugManager;
350 protected
351 procedure NotifyAdd(const ABreakPoint: TIDEBreakPoint); override;
352 procedure NotifyRemove(const ABreakPoint: TIDEBreakPoint); override;
353 procedure Update(Item: TCollectionItem); override;
354 public
355 constructor Create(const AManager: TDebugManager);
356 end;
357
358 { TProjectExceptions }
359
360 TProjectExceptions = class(TIDEExceptions)
361 protected
362 procedure SetIgnoreAll(const AValue: Boolean); override;
363 procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
364 procedure Update(Item: TCollectionItem); override;
365 end;
366
367 { TDebugEventLogManager }
368
369 procedure TDebugEventLogManager.SetEventDialog(AValue: TDbgEventsForm);
370 begin
371 if FEventDialog = AValue then Exit;
372
373 If AValue = nil then begin
374 if FHiddenDebugEventsLog=nil then
375 FHiddenDebugEventsLog:=TStringList.Create;
376 FEventDialog.GetEvents(FHiddenDebugEventsLog);
377 end
378 else
379 if FHiddenDebugEventsLog <> nil then begin
380 AValue.SetEvents(FHiddenDebugEventsLog);
381 FreeAndNil(FHiddenDebugEventsLog);
382 end;
383
384 FEventDialog := AValue;
385 end;
386
FormatBreakPointAddressnull387 function TDebugEventLogManager.FormatBreakPointAddress(
388 const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec): String;
389 var
390 SrcName: String;
391 begin
392 SrcName := ALocation.SrcFullName;
393 if SrcName = '' then
394 SrcName := ALocation.SrcFile;
395
396 if SrcName <> '' then
397 Result := Format(dbgEventBreakAtAddressSourceLine,
398 [IntToHex(ALocation.Address, FTargetWidth), SrcName, ALocation.SrcLine])
399 else
400 if (ABreakpoint <> nil) and (ABreakPoint.Kind = bpkSource) then
401 Result := Format(dbgEventBreakAtAddressOriginSourceOriginLine,
402 [IntToHex(ALocation.Address, FTargetWidth), ABreakpoint.Source, ABreakpoint.Line])
403 else
404 Result := Format(dbgEventBreakAtAddress, [IntToHex(ALocation.Address,
405 FTargetWidth)]);
406 end;
407
408 procedure TDebugEventLogManager.DebuggerEvent(Sender: TObject;
409 const ACategory: TDBGEventCategory; const AEventType: TDBGEventType;
410 const AText: String);
411 var
412 Rec: TDBGEventRec;
413 begin
414 if EventDialog <> nil
415 then begin
416 EventDialog.AddEvent(ACategory, AEventType, AText)
417 end
418 else begin
419 // store it internally, and copy it to the dialog, when the user opens it
420 if FHiddenDebugEventsLog=nil
421 then FHiddenDebugEventsLog := TStringList.Create;
422 if EnvironmentOptions.DebuggerEventLogCheckLineLimit
423 then begin
424 while FHiddenDebugEventsLog.Count >= EnvironmentOptions.DebuggerEventLogLineLimit do
425 FHiddenDebugEventsLog.Delete(0);
426 end;
427 Rec.Category := Ord(ACategory);
428 Rec.EventType := Ord(AEventType);
429 FHiddenDebugEventsLog.AddObject(AText, TObject(Rec.Ptr));
430 end;
431 end;
432
433 procedure TDebugEventLogManager.LogCustomEvent(
434 const ACategory: TDBGEventCategory; const AEventType: TDBGEventType;
435 const AText: String);
436 begin
437 DebuggerEvent(nil, ACategory, AEventType, AText);
438 end;
439
440 procedure TDebugEventLogManager.LogEventBreakPointHit(
441 const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
442 var
443 Msg: String;
444 begin
445 if ABreakpoint = nil then
446 Msg := dbgEventBreakUnknownBreakPoint
447 else
448 case ABreakPoint.Kind of
449 bpkSource: Msg := dbgEventBreakSourceBreakPoint;
450 bpkAddress: Msg := dbgEventBreakAddressBreakPoint;
451 bpkData: Msg := dbgEventBreakWatchPoint; // should not be here, use LogEventWatchPointTriggered();
452 end;
453
454 LogCustomEvent(ecBreakpoint, etBreakpointHit,
455 Format(Msg, [FormatBreakPointAddress(ABreakpoint, ALocation)]));
456 end;
457
458 procedure TDebugEventLogManager.LogEventWatchPointTriggered(
459 const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec;
460 const AOldWatchedVal, ANewWatchedVal: String);
461 var
462 Msg, Loc: String;
463 begin
464 Loc := FormatBreakPointAddress(ABreakpoint, ALocation);
465 if ABreakpoint = nil then
466 Msg := Format(dbgEventUnknownWatchPointTriggered, [Loc, AOldWatchedVal, ANewWatchedVal])
467 else
468 case ABreakPoint.Kind of
469 bpkSource: Msg := Format(dbgEventBreakSourceBreakPoint , [Loc]); // should not be here
470 bpkAddress: Msg := Format(dbgEventBreakAddressBreakPoint, [Loc]); // should not be here
471 bpkData: Msg := Format(dbgEventWatchTriggered, [ABreakpoint.WatchData, Loc,
472 AOldWatchedVal, ANewWatchedVal]);
473 end;
474
475 LogCustomEvent(ecBreakpoint, etBreakpointHit, Msg );
476 end;
477
478 procedure TDebugEventLogManager.LogEventWatchPointScope(
479 const ABreakpoint: TDBGBreakPoint; const ALocation: TDBGLocationRec);
480 var
481 Msg, Loc: String;
482 begin
483 Loc := FormatBreakPointAddress(ABreakpoint, ALocation);
484 if ABreakpoint = nil then
485 Msg := Format(dbgEventUnknownWatchPointScopeEnded, [Loc])
486 else
487 case ABreakPoint.Kind of
488 bpkSource: Msg := Format(dbgEventBreakSourceBreakPoint , [Loc]); // should not be here
489 bpkAddress: Msg := Format(dbgEventBreakAddressBreakPoint, [Loc]); // should not be here
490 bpkData: Format(dbgEventWatchScopeEnded, [ABreakpoint.WatchData, Loc])
491 end;
492
493 LogCustomEvent(ecBreakpoint, etBreakpointHit, Msg );
494 end;
495
496 destructor TDebugEventLogManager.Destroy;
497 begin
498 FreeAndNil(FHiddenDebugEventsLog);
499 inherited Destroy;
500 end;
501
502 procedure TDebugEventLogManager.ClearDebugEventsLog;
503 begin
504 if EventDialog <> nil then
505 EventDialog.Clear;
506 FreeAndNil(FHiddenDebugEventsLog);
507 end;
508
509 { TProjectExceptions }
510
511 procedure TProjectExceptions.SetIgnoreAll(const AValue: Boolean);
512 begin
513 // Todo: move to Changed or Update, but they are called too often...
514 if (IgnoreAll <> AValue) and (Project1 <> nil) then
515 Project1.Modified := True;
516 inherited SetIgnoreAll(AValue);
517 end;
518
519 procedure TProjectExceptions.Notify(Item: TCollectionItem; Action: TCollectionNotification);
520 begin
521 inherited Notify(Item, Action);
522 if Project1 <> nil then
523 Project1.Modified := True;
524 end;
525
526 procedure TProjectExceptions.Update(Item: TCollectionItem);
527 begin
528 inherited Update(Item);
529 if Project1 <> nil then
530 Project1.Modified := True;
531 end;
532
533 { TManagedBreakPoints }
534
535 constructor TManagedBreakPoints.Create(const AManager: TDebugManager);
536 begin
537 FManager := AManager;
538 inherited Create(TManagedBreakPoint);
539 end;
540
541 procedure TManagedBreakPoints.NotifyAdd(const ABreakPoint: TIDEBreakPoint);
542 begin
543 {$ifdef VerboseDebugger}
544 debugln('TManagedBreakPoints.NotifyAdd A ',ABreakpoint.Source,' ',IntToStr(ABreakpoint.Line));
545 {$endif}
546 inherited;
547
548 FManager.CreateSourceMarkForBreakPoint(ABreakpoint,nil);
549 Project1.Modified := True;
550 end;
551
552 procedure TManagedBreakPoints.NotifyRemove(const ABreakPoint: TIDEBreakPoint);
553 begin
554 {$ifdef VerboseDebugger}
555 debugln(['TManagedBreakPoints.NotifyRemove A ',ABreakpoint.Source,' ',ABreakpoint.Line,' ',TManagedBreakPoint(ABreakpoint).SourceMark <> nil]);
556 {$endif}
557
558 inherited;
559 if FManager.FCurrentBreakpoint = ABreakPoint
560 then FManager.FCurrentBreakpoint := nil;
561
562 TManagedBreakPoint(ABreakpoint).SourceMark.Free;
563
564 if Project1 <> nil
565 then Project1.Modified := True;
566 end;
567
568 procedure TManagedBreakPoints.Update(Item: TCollectionItem);
569 begin
570 inherited Update(Item);
571 if (Project1 <> nil) and (Item is TIDEBreakPoint) and (TIDEBreakPoint(Item).UserModified)
572 then begin
573 Project1.Modified := True;
574 TIDEBreakPoint(Item).UserModified := False;
575 end;
576 end;
577
578
579 { TManagedBreakPoint }
580
581 procedure TManagedBreakPoint.SetSourceMark(const AValue: TSourceMark);
582 begin
583 if FSourceMark=AValue then exit;
584 if FSourceMark<>nil then begin
585 FSourceMark.RemoveAllHandlersForObject(Self);
586 FSourceMark.Data:=nil;
587 end;
588 FSourceMark:=AValue;
589 if FSourceMark<>nil then begin
590 FSourceMark.IncChangeLock;
591 FSourceMark.AddPositionChangedHandler(@OnSourceMarkPositionChanged);
592 FSourceMark.AddBeforeFreeHandler(@OnSourceMarkBeforeFree);
593 FSourceMark.Data:=Self;
594 FSourceMark.IsBreakPoint:=true;
595 FSourceMark.Line:=Line;
596 FSourceMark.Visible:=true;
597 FSourceMark.AddGetHintHandler(@OnSourceMarkGetHint);
598 FSourceMark.AddCreatePopupMenuHandler(@OnSourceMarkCreatePopupMenu);
599 UpdateSourceMark;
600 FSourceMark.DecChangeLock;
601 end;
602 end;
603
604 procedure TManagedBreakPoint.OnSourceMarkPositionChanged(Sender: TObject);
605 begin
606 CopySourcePositionToBreakPoint;
607 end;
608
609 procedure TManagedBreakPoint.OnToggleEnableMenuItemClick(Sender: TObject);
610 begin
611 Enabled:=not Enabled;
612 end;
613
614 procedure TManagedBreakPoint.OnDeleteMenuItemClick(Sender: TObject);
615 begin
616 ReleaseReference;
617 end;
618
619 procedure TManagedBreakPoint.OnViewPropertiesMenuItemClick(Sender: TObject);
620 begin
621 DebugBoss.ShowBreakPointProperties(Self);
622 end;
623
624 procedure TManagedBreakPoint.OnSourceMarkBeforeFree(Sender: TObject);
625 begin
626 SourceMark:=nil;
627 end;
628
629 procedure TManagedBreakPoint.OnSourceMarkGetHint(SenderMark: TSourceMark;
630 var Hint: string);
631 begin
632 Hint := GetBreakPointStateDescription(Self) + LineEnding +
633 Format('%s: %d' + LineEnding + '%s %s' + LineEnding + '%s: %s',
634 [lisHitCount, Hitcount,
635 lisAction, GetBreakPointActionsDescription(Self),
636 lisCondition, Expression]);
637 if SenderMark<>nil then ;
638 end;
639
640 procedure TManagedBreakPoint.OnSourceMarkCreatePopupMenu(
641 SenderMark: TSourceMark; const AddMenuItem: TAddMenuItemProc);
642 begin
643 if Enabled then
644 AddMenuItem(lisDisableBreakPoint, True, @OnToggleEnableMenuItemClick)
645 else
646 AddMenuItem(lisEnableBreakPoint, True, @OnToggleEnableMenuItemClick);
647 AddMenuItem(lisDeleteBreakPoint, True, @OnDeleteMenuItemClick);
648 AddMenuItem(lisViewBreakPointProperties, True, @OnViewPropertiesMenuItemClick);
649 if SenderMark<>nil then ;
650 end;
651
652 procedure TManagedBreakPoint.DoChanged;
653 begin
654 inherited DoChanged;
655 UpdateSourceMark;
656 end;
657
658 procedure TManagedBreakPoint.CopySourcePositionToBreakPoint;
659 begin
660 if FSourceMark=nil then exit;
661 SetLocation(Source,FSourceMark.Line);
662 end;
663
664 procedure TManagedBreakPoint.SetLocation(const ASource: String;
665 const ALine: Integer);
666 var
667 NewDebugExeLine: Integer;
668 begin
669 NewDebugExeLine := DebugExeLine;
670 if (Source = ASource) and (Line = ALine) and (FCurrentDebugExeLine = NewDebugExeLine)
671 then exit;
672 inherited SetLocation(ASource, ALine);
673 FCurrentDebugExeLine := NewDebugExeLine;
674 if Project1 <> nil
675 then Project1.Modified := True;
676 end;
677
678 procedure TManagedBreakPoint.UpdateSourceMarkImage;
679 var
680 Img: Integer;
681 begin
682 if SourceMark = nil then Exit;
683 case Valid of
684 vsValid:
685 if Enabled then
686 Img := SourceEditorMarks.ActiveBreakPointImg
687 else
688 Img := SourceEditorMarks.InactiveBreakPointImg;
689 vsInvalid:
690 if Enabled then
691 Img := SourceEditorMarks.InvalidBreakPointImg
692 else
693 Img := SourceEditorMarks.InvalidDisabledBreakPointImg;
694 vsPending:
695 if Enabled then
696 Img := SourceEditorMarks.PendingBreakPointImg
697 else
698 Img := SourceEditorMarks.InactiveBreakPointImg;
699 else
700 if Enabled then
701 Img := SourceEditorMarks.UnknownBreakPointImg
702 else
703 Img := SourceEditorMarks.UnknownDisabledBreakPointImg;
704 end;
705 SourceMark.ImageIndex := Img;
706 end;
707
708 procedure TManagedBreakPoint.UpdateSourceMarkLineColor;
709 var
710 aha: TAdditionalHilightAttribute;
711 begin
712 if SourceMark = nil then Exit;
713 aha := ahaNone;
714 case Valid of
715 vsValid:
716 if Enabled then
717 aha := ahaEnabledBreakpoint
718 else
719 aha := ahaDisabledBreakpoint;
720 vsInvalid:
721 if Enabled then
722 aha := ahaInvalidBreakpoint
723 else
724 aha := ahaDisabledBreakpoint;
725 else
726 if Enabled then
727 aha := ahaUnknownBreakpoint
728 else
729 aha := ahaDisabledBreakpoint;
730 end;
731 SourceMark.LineColorAttrib := aha;
732 end;
733
DebugExeLinenull734 function TManagedBreakPoint.DebugExeLine: Integer;
735 var
736 se: TSourceEditor;
737 begin
738 Result := Line;
739 if (FSourceMark <> nil) and (FSourceMark.SourceEditor <> nil) then
740 Result := TSourceEditor(FSourceMark.SourceEditor).SourceToDebugLine(Line)
741 else begin
742 se := SourceEditorManager.SourceEditorIntfWithFilename(Source);
743 if se <> nil
744 then Result := se.SourceToDebugLine(Line);
745 end;
746 end;
747
748 procedure TManagedBreakPoint.UpdateSourceMark;
749 begin
750 if SourceMark = nil then Exit;
751 SourceMark.IncChangeLock;
752 SourceMark.Line := Line;
753 UpdateSourceMarkImage;
754 UpdateSourceMarkLineColor;
755 SourceMark.DecChangeLock;
756 end;
757
758
759 // Helper function for TDebugManager.GetFullFilename.
760 function FindFullFilenameSrc(const AUnitinfo: TDebuggerUnitInfo): boolean;
761 var
762 SrcUnitName: String;
763 SrcInFilename: String;
764 SrcFilename: String;
765 Code: TCodeBuffer;
766 ProcDef: String;
767 CurCodeTool: TCodeTool;
768 CurCodeNode: TCodeTreeNode;
769 CodePos: TCodeXYPosition;
770 begin
771 Result:=false;
772 // search unit in project unit path
773 SrcUnitName := AUnitinfo.UnitName;
774 SrcInFilename := '';
775 with CodeToolBoss.DirectoryCachePool do
776 SrcFilename := FindUnitSourceInCompletePath('', SrcUnitName, SrcInFilename);
777 if SrcFilename='' then exit;
778 // load unit
779 Code := CodeToolBoss.LoadFile(SrcFilename,true,false);
780 if Code=nil then exit; // read error
781 // procedure declaration: classname.functionname
782 ProcDef := '';
783 if AUnitinfo.SrcClassName<>'' then
784 ProcDef := AUnitinfo.SrcClassName+'.';
785 ProcDef := ProcDef+AUnitinfo.FunctionName;
786 // search proc in unit
787 if not CodeToolBoss.FindProcDeclaration(Code,ProcDef,CurCodeTool,CurCodeNode,
788 [phpWithoutParamList,phpWithoutBrackets,phpWithoutClassKeyword,phpWithoutSemicolon])
789 then
790 exit;
791 // get file, line, column
792 if CurCodeNode.Desc=ctnProcedure then
793 CurCodeNode := CurCodeNode.FirstChild; // jump to Name instead of keyword 'procedure'
794 if not CurCodeTool.CleanPosToCaret(CurCodeNode.StartPos,CodePos) then
795 exit;
796 AUnitinfo.LocationFullFile := CodePos.Code.Filename;
797 AUnitinfo.SrcLine := CodePos.Y;
798 //DumpStack;
799 Result:=true;
800 end;
801
GetFullFilenamenull802 function TDebugManager.GetFullFilename(const AUnitinfo: TDebuggerUnitInfo;
803 out Filename: string; AskUserIfNotFound: Boolean): Boolean;
804
805 function ResolveFromDbg: Boolean;
806 begin
807 Filename := AUnitinfo.FileName;
808 Result := (Filename<>'') and GetFullFilename(Filename, False) and FileExistsUTF8(Filename);
809 if Result then Exit;
810 Filename := AUnitinfo.DbgFullName;
811 if Filename='' then
812 Exit(False);
813 Result := FileExistsUTF8(Filename);
814 if not Result then
815 Result := GetFullFilename(Filename, AskUserIfNotFound);
816 end;
817
818 begin
819 Result := False;
820 if Destroying or (AUnitinfo = nil) then exit;
821 Filename := AUnitinfo.LocationFullFile;
822 Result := Filename <> '';
823
824 if (dlfSearchByFunctionName in AUnitinfo.Flags) and (AUnitinfo.FunctionName<>'')
825 and FindFullFilenameSrc(AUnitinfo) then
826 exit;
827
828 case AUnitinfo.LocationType of
829 dltUnknown: Result := ResolveFromDbg;
830 dltUnresolvable: Result := False;
831 dltProject:
832 begin
833 Filename := TrimFilename(AUnitinfo.LocationName);
834 Filename := MainIDE.FindSourceFile(Filename, Project1.Directory,
835 [fsfSearchForProject, fsfUseIncludePaths, fsfUseDebugPath,
836 {fsfMapTempToVirtualFiles,} fsfSkipPackages]);
837 Result := Filename <> '';
838 if not Result then
839 Result := ResolveFromDbg;
840 end;
841 dltPackage: Result := ResolveFromDbg;
842 end;
843
844 if Result then
845 AUnitinfo.LocationFullFile := Filename
846 else begin
847 Filename := AUnitinfo.FileName;
848 if AskUserIfNotFound then
849 AUnitinfo.LocationType := dltUnresolvable;
850 end;
851 end;
852
GetFullFilenamenull853 function TDebugManager.GetFullFilename(var Filename: string; AskUserIfNotFound: Boolean): Boolean;
854 var
855 SrcFile, SrcFN, UserFilename: String;
856 n: Integer;
857 OpenDialog: TIDEOpenDialog;
858 AnUnitInfo: TLazProjectFile;
859 begin
860 Result := False;
861 if Destroying or (Filename = '') then exit;
862 (* The below currently does not work for unsaved projects *)
863 //Result := FilenameIsAbsolute(Filename);
864 //if Result then exit;
865
866 // TODO, check for virtual file, and flag it
867 // Project1.IsVirtual
868 // Left(Filename,1, xxx) = LazarusIDE.GetTestBuildDirectory
869
870 // some debuggers (e.g. gdb) sometimes returns linux path delims under windows
871 // => fix that
872 Filename := TrimFilename(Filename);
873 SrcFile := MainIDE.FindSourceFile(Filename, Project1.Directory,
874 [fsfSearchForProject, fsfUseIncludePaths, fsfUseDebugPath{,
875 fsfMapTempToVirtualFiles}]);
876 if (SrcFile <> '') and (not FilenameIsAbsolute(SrcFile)) and
877 (Project1.IsVirtual) and
878 FileExistsUTF8(AppendPathDelim(LazarusIDE.GetTestBuildDirectory)+SrcFile)
879 then
880 SrcFile := AppendPathDelim(LazarusIDE.GetTestBuildDirectory)+SrcFile;
881
882 if SrcFile = '' then
883 SrcFile := Filename;
884 SrcFN := ExtractFilenameOnly(SrcFile);
885 if not FilenameIsAbsolute(SrcFile) then
886 begin
887 // first attempt to get a longer name
888 // short file, look in the user list
889 for n := 0 to FUserSourceFiles.Count - 1 do
890 begin
891 UserFilename := FUserSourceFiles[n];
892 if (CompareFileNames(SrcFN, ExtractFilenameOnly(UserFilename)) = 0)
893 and FileExistsUTF8(UserFilename) then
894 begin
895 FUserSourceFiles.Move(n, 0); // move most recent first
896 SrcFile := UserFilename;
897 Break;
898 end;
899 end;
900 end;
901
902 if not FilenameIsAbsolute(SrcFile) then
903 begin
904 AnUnitInfo := Project1.FindFile(SrcFile, [pfsfOnlyEditorFiles]);
905 if AnUnitInfo <> nil then
906 begin
907 // the file is an unsaved file -> can not be extended
908 Result := True;
909 Filename := SrcFile;
910 Exit;
911 end;
912 end;
913
914 if ((not FilenameIsAbsolute(SrcFile)) or (not FileExistsUTF8(SrcFile)))
915 and AskUserIfNotFound then
916 begin
917
918 if IDEMessageDialog(lisFileNotFound,
919 Format(lisTheFileWasNotFoundDoYouWantToLocateItYourself, [SrcFile, LineEnding]),
920 mtConfirmation, [mbYes, mbNo]) <> mrYes
921 then Exit;
922
923 repeat
924 OpenDialog:=IDEOpenDialogClass.Create(nil);
925 try
926 InputHistories.ApplyFileDialogSettings(OpenDialog);
927 OpenDialog.Title:=lisOpenFile+' '+SrcFile;
928 OpenDialog.Options:=OpenDialog.Options+[ofFileMustExist];
929 OpenDialog.FileName := SrcFile;
930 if not OpenDialog.Execute then
931 exit;
932 SrcFile:=CleanAndExpandFilename(OpenDialog.FileName);
933 InputHistories.StoreFileDialogSettings(OpenDialog);
934 finally
935 OpenDialog.Free;
936 end;
937 until FilenameIsAbsolute(SrcFile) and FileExistsUTF8(SrcFile);
938
939 FUserSourceFiles.Insert(0, SrcFile);
940 end;
941
942 if (SrcFile<>'')
943 and ( (not FilenameIsAbsolute(SrcFile)) or FileExistsUTF8(SrcFile) )
944 then begin
945 Filename:=SrcFile;
946 Result:=True;
947 end;
948 end;
949
950 procedure TDebugManager.DebuggerConsoleOutput(Sender: TObject;
951 const AText: String);
952 begin
953 if not HasConsoleSupport then exit;;
954 if FDialogs[ddtPseudoTerminal] = nil
955 then ViewDebugDialog(ddtPseudoTerminal, False, False);
956 TPseudoConsoleDlg(FDialogs[ddtPseudoTerminal]).AddOutput(AText);
957 end;
958
DebuggerFeedbacknull959 function TDebugManager.DebuggerFeedback(Sender: TObject; const AText, AInfo: String;
960 AType: TDBGFeedbackType; AButtons: TDBGFeedbackResults): TDBGFeedbackResult;
961 begin
962 Result := ExecuteFeedbackDialog(AText, AInfo, AType, AButtons);
963 end;
964
965 procedure TDebugManager.DebuggerIdle(Sender: TObject);
966 begin
967 FSnapshots.DoDebuggerIdle;
968 end;
969
DoProjectClosenull970 function TDebugManager.DoProjectClose(Sender: TObject; AProject: TLazProject): TModalResult;
971 begin
972 if AProject<>Project1 then exit(mrCancel);
973 ResetDebugger;
974 Result := mrOK;
975 end;
976
977 procedure TDebugManager.DoProjectModified(Sender: TObject);
978 begin
979 if Project1 <> nil then
980 Project1.Modified := True;
981 end;
982
983 procedure TDebugManager.mnuAddBpAddress(Sender: TObject);
984 var
985 NewBreakpoint: TIDEBreakPoint;
986 begin
987 NewBreakpoint := BreakPoints.Add(0, True);
988 if ShowBreakPointProperties(NewBreakpoint) <> mrOk then
989 ReleaseRefAndNil(NewBreakpoint)
990 else
991 NewBreakpoint.EndUpdate;
992 end;
993
994 procedure TDebugManager.mnuAddBpSource(Sender: TObject);
995 var
996 NewBreakpoint: TIDEBreakPoint;
997 SrcEdit: TSourceEditor;
998 begin
999 SrcEdit := SourceEditorManager.GetActiveSE;
1000 if SrcEdit <> nil then
1001 NewBreakpoint := BreakPoints.Add(SrcEdit.FileName, SrcEdit.CurrentCursorYLine, True)
1002 else
1003 NewBreakpoint := BreakPoints.Add('', 0, True);
1004 if DebugBoss.ShowBreakPointProperties(NewBreakpoint) <> mrOk then
1005 ReleaseRefAndNil(NewBreakpoint)
1006 else
1007 NewBreakpoint.EndUpdate;
1008 end;
1009
1010 procedure TDebugManager.mnuAddBpData(Sender: TObject);
1011 var
1012 NewBreakpoint: TIDEBreakPoint;
1013 begin
1014 NewBreakpoint := BreakPoints.Add('', wpsGlobal, wpkWrite, True);
1015 if ShowBreakPointProperties(NewBreakpoint) = mrOk then begin
1016 NewBreakpoint.EndUpdate;
1017 ViewDebugDialog(ddtBreakpoints, False);
1018 end
1019 else
1020 ReleaseRefAndNil(NewBreakpoint);
1021 end;
1022
1023 procedure TDebugManager.mnuAddBpDataAtCursor(Sender: TObject);
1024 var
1025 SE: TSourceEditor;
1026 WatchVar: String;
1027 NewBreakpoint: TIDEBreakPoint;
1028 begin
1029 SE := SourceEditorManager.GetActiveSE;
1030
1031 if Assigned(SE) then
1032 begin
1033 if SE.SelectionAvailable then
1034 WatchVar := SE.Selection
1035 else
1036 WatchVar := SE.GetOperandAtCurrentCaret;
1037
1038 if (WatchVar <> '') and SE.EditorComponent.Focused then
1039 begin
1040 // TODO: find existing?
1041 NewBreakpoint := BreakPoints.Add(WatchVar, wpsGlobal, wpkWrite, True);
1042 if ShowBreakPointProperties(NewBreakpoint) = mrOk then begin
1043 NewBreakpoint.EndUpdate;
1044 ViewDebugDialog(ddtBreakpoints, False);
1045 end
1046 else
1047 NewBreakpoint.ReleaseReference;
1048 exit;
1049 end;
1050 end;
1051
1052 // watch was not added automatically => show a dialog
1053 mnuAddBpData(nil);
1054 end;
1055
1056 procedure TDebugManager.BreakAutoContinueTimer(Sender: TObject);
1057 begin
1058 FAutoContinueTimer.Enabled := False;
1059 FDebugger.Run;
1060 end;
1061
1062 procedure TDebugManager.OnRunTimer(Sender: TObject);
1063 begin
1064 FRunTimer.Enabled:=false;
1065 if dmsWaitForRun in FManagerStates then
1066 RunDebugger
1067 else
1068 if dmsWaitForAttach in FManagerStates then
1069 AttachDebugger;
1070 end;
1071
1072 procedure TDebugManager.DebuggerBreakPointHit(ADebugger: TDebuggerIntf;
1073 ABreakPoint: TBaseBreakPoint; var ACanContinue: Boolean);
1074 begin
1075 FCurrentBreakPoint := nil;
1076 if FBreakPoints = nil then Exit;
1077 if ABreakpoint = nil then Exit;
1078
1079 FCurrentBreakpoint := nil;
1080 if (ABreakPoint is TDBGBreakPoint) and (TDBGBreakPoint(ABreakPoint).Slave is TIDEBreakPoint) then
1081 FCurrentBreakpoint := TIDEBreakPoint(TDBGBreakPoint(ABreakPoint).Slave)
1082 else
1083 DebugLn('ERROR: Breakpoint does not have correct class, or IDE slave breakpoint');
1084 // TODO: remove / fallback to old behaviour
1085 if FCurrentBreakpoint = nil then
1086 FCurrentBreakPoint := FBreakPoints.Find(ABreakPoint.Source, ABreakPoint.Line);
1087 end;
1088
1089 procedure TDebugManager.mnuViewDebugDialogClick(Sender: TObject);
1090 var
1091 xCommand: Integer;
1092 begin
1093 if (Sender is TIDESpecialCommand) and (TIDESpecialCommand(Sender).Command<>nil) then
1094 xCommand := TIDESpecialCommand(Sender).Command.Command
1095 else
1096 if Sender is TIDECommand then
1097 xCommand := TIDECommand(Sender).Command
1098 else
1099 xCommand := -1;
1100
1101 case xCommand of
1102 ecToggleWatches : ViewDebugDialog(ddtWatches);
1103 ecToggleBreakPoints : ViewDebugDialog(ddtBreakpoints);
1104 ecToggleDebuggerOut : ViewDebugDialog(ddtOutput);
1105 ecToggleLocals : ViewDebugDialog(ddtLocals);
1106 ecToggleCallStack : ViewDebugDialog(ddtCallStack);
1107 ecToggleRegisters : ViewDebugDialog(ddtRegisters);
1108 ecToggleAssembler : ViewDebugDialog(ddtAssembler);
1109 ecToggleDebugEvents : ViewDebugDialog(ddtEvents);
1110 ecEvaluate : ViewDebugDialog(ddtEvaluate);
1111 ecInspect : ViewDebugDialog(ddtInspect);
1112 ecViewPseudoTerminal: ViewDebugDialog(ddtPseudoTerminal);
1113 ecViewThreads : ViewDebugDialog(ddtThreads);
1114 ecViewHistory : ViewDebugDialog(ddtHistory);
1115 else
1116 raise Exception.CreateFmt('IDE Internal error: TDebugManager.mnuViewDebugDialogClick, wrong command parameter %d.', [xCommand]);
1117 end;
1118 end;
1119
1120 procedure TDebugManager.mnuResetDebuggerClicked(Sender: TObject);
1121 begin
1122 ResetDebugger;
1123 end;
1124
1125 procedure TDebugManager.mnuAddWatchClicked(Sender: TObject);
1126 var
1127 SE: TSourceEditor;
1128 WatchVar: String;
1129 w: TCurrentWatch;
1130 begin
1131 SE := SourceEditorManager.GetActiveSE;
1132
1133 if Assigned(SE) then
1134 begin
1135 if SE.SelectionAvailable then
1136 WatchVar := SE.Selection
1137 else
1138 WatchVar := SE.GetOperandAtCurrentCaret;
1139 if (WatchVar <> '') and (SE.SourceNotebook.Active or SE.EditorComponent.Focused) then
1140 begin
1141 Watches.CurrentWatches.BeginUpdate;
1142 try
1143 w := Watches.CurrentWatches.Find(WatchVar);
1144 if w = nil
1145 then w := Watches.CurrentWatches.Add(WatchVar);
1146 if (w <> nil)
1147 then begin
1148 w.Enabled := True;
1149 if EnvironmentOptions.DebuggerAutoSetInstanceFromClass then
1150 w.EvaluateFlags := w.EvaluateFlags + [defClassAutoCast];
1151 ViewDebugDialog(ddtWatches, False);
1152 Exit;
1153 end;
1154 finally
1155 Watches.CurrentWatches.EndUpdate;
1156 end;
1157 end;
1158 end;
1159
1160 // watch was not added automatically => show a dialog
1161 if ShowWatchProperties(nil, '') = mrOK then
1162 ViewDebugDialog(ddtWatches, False);
1163 end;
1164
1165 //-----------------------------------------------------------------------------
1166 // Debugger events
1167 //-----------------------------------------------------------------------------
1168
1169 procedure TDebugManager.DebuggerException(Sender: TObject;
1170 const AExceptionType: TDBGExceptionType;
1171 const AExceptionClass: String;
1172 const AExceptionLocation: TDBGLocationRec;
1173 const AExceptionText: String;
1174 out AContinue: Boolean);
1175
1176 function GetTitle: String;
1177 begin
1178 Result := Project1.GetTitle;
1179 if Result = '' then
1180 Result := ExtractFileName(FDebugger.FileName);
1181 end;
1182
1183 const
1184 MAX_CLASSNAME_LEN = 256; // shortstring
1185 MAX_MSG_DISPLAY_LEN = 2048; // just sanity
1186 var
1187 ExpClassName, ExceptMsg: string;
1188 msg, SrcText: String;
1189 Ignore: Boolean;
1190 Editor: TSourceEditor;
1191 i: Integer;
1192 begin
1193 if Destroying then
1194 begin
1195 AContinue := True;
1196 Exit;
1197 end
1198 else
1199 AContinue := False;
1200
1201 ExpClassName := AExceptionClass;
1202 if Length(ExpClassName) > MAX_CLASSNAME_LEN then
1203 ExpClassName := copy(ExpClassName, 1, MAX_CLASSNAME_LEN) + '...';
1204
1205 if AExceptionText = ''
1206 then
1207 msg := Format(lisProjectSRaisedExceptionClassS,
1208 [GetTitle, ExpClassName])
1209 else begin
1210 ExceptMsg := AExceptionText;
1211 if Length(ExceptMsg) > MAX_MSG_DISPLAY_LEN then
1212 ExceptMsg := copy(ExceptMsg, 1, MAX_MSG_DISPLAY_LEN) + '...';
1213 // if AExceptionText is not a valid UTF8 string,
1214 // then assume it has the ansi encoding and convert it
1215 if FindInvalidUTF8Codepoint(pchar(ExceptMsg),length(ExceptMsg)) > 0 then
1216 ExceptMsg := AnsiToUtf8(ExceptMsg);
1217 msg := Format(lisProjectSRaisedExceptionClassSWithMessageSS,
1218 [GetTitle, ExpClassName, LineEnding, ExceptMsg]);
1219 end;
1220
1221 if AExceptionLocation.SrcFile <> '' then begin
1222 if AExceptionLocation.SrcLine <> 0 then begin
1223 SrcText := '';
1224 if (AExceptionLocation.SrcFullName <> '') then begin
1225 Editor := SourceEditorManager.SourceEditorIntfWithFilename(AExceptionLocation.SrcFullName);
1226 if Editor <> nil then begin
1227 try
1228 i := Editor.DebugToSourceLine(AExceptionLocation.SrcLine);
1229 if i > 0
1230 then SrcText := Trim(Editor.Lines[i-1]);
1231 except
1232 end;
1233 end;
1234 end;
1235 if SrcText <> '' then
1236 msg := msg + Format(lisProjectSRaisedExceptionInFileLineSrc,
1237 [LineEnding, AExceptionLocation.SrcFile, AExceptionLocation.SrcLine, SrcText])
1238 else
1239 msg := msg + Format(lisProjectSRaisedExceptionInFileLine,
1240 [LineEnding, AExceptionLocation.SrcFile, AExceptionLocation.SrcLine]);
1241 end
1242 else
1243 msg := msg + Format(lisProjectSRaisedExceptionInFileAddress,
1244 [LineEnding, AExceptionLocation.SrcFile, AExceptionLocation.Address]);
1245 end
1246 else if AExceptionLocation.Address <> 0 then begin
1247 msg := msg + Format(lisProjectSRaisedExceptionAtAddress,
1248 [LineEnding, AExceptionLocation.Address]);
1249 end;
1250
1251 if (AExceptionType in [deInternal, deRunError]) then begin
1252 AContinue := ExecuteExceptionDialog(msg, Ignore, AExceptionType in [deInternal, deRunError]) = mrCancel;
1253 if Ignore then begin
1254 Exceptions.AddIfNeeded(ExpClassName);
1255 Exceptions.Find(ExpClassName).Enabled := True;
1256 end;
1257 end
1258 else begin
1259 IDEMessageDialog(lisCCOErrorCaption, msg, mtError, [mbOk]);
1260 end;
1261 end;
1262
1263 procedure TDebugManager.DebuggerOutput(Sender: TObject; const AText: String);
1264 begin
1265 if Destroying then exit;
1266 if FDialogs[ddtOutput] <> nil then
1267 TDbgOutputForm(FDialogs[ddtOutput]).AddText(AText)
1268 else begin
1269 // store it internally, and copy it to the dialog, when the user opens it
1270 if fHiddenDebugOutputLog=nil then
1271 fHiddenDebugOutputLog:=TStringList.Create;
1272 fHiddenDebugOutputLog.Add(AText);
1273 while fHiddenDebugOutputLog.Count>100 do
1274 fHiddenDebugOutputLog.Delete(0);
1275 end;
1276 end;
1277
1278 procedure TDebugManager.DebuggerBeforeChangeState(ADebugger: TDebuggerIntf;
1279 AOldState: TDBGState);
1280 var
1281 DialogType: TDebugDialogType;
1282 begin
1283 if Destroying or (MainIDE=nil) or (MainIDE.ToolStatus=itExiting)
1284 then exit;
1285 if AOldState=dsNone then ;
1286 assert((ADebugger=FDebugger) and (ADebugger<>nil), 'TDebugManager.OnDebuggerChangeState');
1287
1288 FInStateChange := True;
1289 for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do
1290 if FDialogs[DialogType] <> nil then
1291 FDialogs[DialogType].BeginUpdate;
1292
1293 if FDebugger.State = dsInternalPause then exit; // set debug windows to ignore / no updating
1294 end;
1295
1296 procedure TDebugManager.DebuggerChangeState(ADebugger: TDebuggerIntf; OldState: TDBGState);
1297
1298 procedure UnlockDialogs;
1299 var
1300 DialogType: TDebugDialogType;
1301 begin
1302 if not FInStateChange then exit;
1303 FInStateChange := False;
1304 for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do
1305 if FDialogs[DialogType] <> nil then
1306 FDialogs[DialogType].EndUpdate;
1307 end;
1308
1309 //const
1310 // dsNone, dsIdle, dsStop, dsPause, dsInit, dsRun, dsError
1311 //STATENAME: array[TDBGState] of string = (
1312 // 'dsNone', 'dsIdle', 'dsStop', 'dsPause', 'dsInit', 'dsRun', 'dsError'
1313 //);
1314 var
1315 MsgResult: TModalResult;
1316 i: Integer;
1317 begin
1318 if Destroying or (MainIDE=nil) or (MainIDE.ToolStatus=itExiting)
1319 then begin
1320 UnlockDialogs;
1321 exit;
1322 end;
1323 assert((ADebugger=FDebugger) and (ADebugger<>nil), 'TDebugManager.OnDebuggerChangeState');
1324
1325 if (FDebugger.State in [dsRun])
1326 then FCurrentBreakpoint := nil;
1327
1328 if not((OldState = dsInternalPause) and (State = dsPause)) then begin
1329 // OldState=dsInternalPause means we already have a snapshot
1330 // Notify FSnapshots of new state (while dialogs still in updating)
1331 // TODO: Maybe move to TIDEBreakPoint.DoHit
1332 if (FCurrentBreakpoint <> nil) and (bpaTakeSnapshot in FCurrentBreakpoint.Actions) and
1333 (State in [dsPause, dsInternalPause])
1334 then begin
1335 FSnapshots.DoStateChange(OldState);
1336 FSnapshots.Current.AddToSnapshots;
1337 FSnapshots.DoDebuggerIdle(True);
1338 end
1339 else
1340 if FDebugger.State <> dsInternalPause
1341 then FSnapshots.DoStateChange(OldState);
1342 end;
1343
1344 UnlockDialogs;
1345
1346 if FDebugger.State = dsInternalPause
1347 then exit;
1348
1349 if FDebugger.State=dsError
1350 then begin
1351 Include(FManagerStates,dmsDebuggerObjectBroken);
1352 if dmsInitializingDebuggerObject in FManagerStates
1353 then Include(FManagerStates,dmsInitializingDebuggerObjectFailed);
1354 end;
1355
1356 //DebugLn('[TDebugManager.OnDebuggerChangeState] state: ', STATENAME[FDebugger.State]);
1357
1358 // All conmmands
1359 // -------------------
1360 // dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcStepOverInstrcution, dcStepIntoInstrcution,
1361 // dcStepTo, dcJumpto, dcBreak, dcWatch
1362 // -------------------
1363
1364 UpdateButtonsAndMenuItems;
1365 // Next may call ResetDebugger, then FDebugger is gone
1366 UpdateToolStatus;
1367
1368 FAutoContinueTimer.Enabled := false;
1369
1370 if FDebugger = nil then exit;
1371
1372 if (FDebugger.State in [dsRun])
1373 then begin
1374 // hide IDE during run
1375 if EnvironmentOptions.Desktop.HideIDEOnRun and (MainIDE.ToolStatus=itDebugger) and not FStepping
1376 then MainIDE.HideIDE;
1377
1378 if (FPrevShownWindow <> 0) and not FStepping then
1379 begin
1380 SetForegroundWindow(FPrevShownWindow);
1381 FPrevShownWindow := 0;
1382 end;
1383 end
1384 else
1385 if FDebugger.State <> dsInit then begin
1386 if (FCurrentBreakPoint <> nil) and (FCurrentBreakPoint.AutoContinueTime > 0) then
1387 begin
1388 FAutoContinueTimer.Enabled := True;
1389 FAutoContinueTimer.Interval := FCurrentBreakPoint.AutoContinueTime;
1390 end
1391 else if (OldState in [dsRun]) then
1392 begin
1393 if not FStepping then
1394 begin
1395 FPrevShownWindow := GetForegroundWindow;
1396 if EnvironmentOptions.Desktop.HideIDEOnRun then
1397 MainIDE.UnhideIDE;
1398 if not EnvironmentOptions.Desktop.SingleTaskBarButton and
1399 not EnvironmentOptions.Desktop.HideIDEOnRun then
1400 Application.BringToFront;
1401 end;
1402 end;
1403 end;
1404
1405 // unmark execution line
1406 if (not (FDebugger.State in [dsInit, dsPause])) and (SourceEditorManager <> nil)
1407 then
1408 SourceEditorManager.ClearExecutionLines;
1409
1410 if (FDebugger.State in [dsPause, dsInit]) and (SourceEditorManager <> nil)
1411 then
1412 SourceEditorManager.FillExecutionMarks;
1413
1414 if not (FDebugger.State in [dsRun, dsPause, dsInit]) and (SourceEditorManager <> nil)
1415 then begin
1416 SourceEditorManager.ClearExecutionMarks;
1417 // Refresh DebugExeLine
1418 for i := 0 to FBreakPoints.Count - 1 do
1419 FBreakPoints[i].SetLocation(FBreakPoints[i].Source, FBreakPoints[i].Line);
1420 end;
1421
1422 // update inspect
1423 // TODO: Move here from DebuggerCurrentLine / Only currently State change locks execution of gdb
1424 //if ( ((FDebugger.State in [dsPause]) and (OldState = dsRun)) or
1425 // (OldState in [dsPause]) ) and
1426 if (OldState in [dsPause]) and (FDialogs[ddtInspect] <> nil)
1427 then TIDEInspectDlg(FDialogs[ddtInspect]).UpdateData;
1428 if (OldState in [dsPause]) and (FDialogs[ddtEvaluate] <> nil)
1429 then TEvaluateDlg(FDialogs[ddtEvaluate]).UpdateData;
1430
1431 case FDebugger.State of
1432 dsError: begin
1433 {$ifdef VerboseDebugger}
1434 DebugLn('Ooops, the debugger entered the error state');
1435 {$endif}
1436 // shutting down lazarus may kill gdb, so we get an error
1437 if not Application.Terminated
1438 then FeedbackDlg.ExecuteFeedbackDialog
1439 (Format(lisDebuggerErrorOoopsTheDebuggerEnteredTheErrorState,
1440 [LineEnding+LineEnding, LineEnding, LineEnding+LineEnding])
1441 + LineEnding + LineEnding + FDebugger.ErrorStateMessage,
1442 FDebugger.ErrorStateInfo, ftError, [frStop]);
1443 end;
1444 dsStop: begin
1445 // TODO: TDebugger.SetFileName sets dsStop during startup (leading to OldState=dsIdle)
1446 FPrevShownWindow:=0;
1447 if (OldState<>dsIdle)
1448 then begin
1449 MainIDE.DoCallRunFinishedHandler;
1450 if not FDebugger.SkipStopMessage then begin
1451 if (FDebugger.ExitCode <> 0) and EnvironmentOptions.DebuggerShowExitCodeMessage then begin
1452 i := 4;
1453 if FDebugger.ExitCode > 65535 then
1454 i := 8;
1455 {$PUSH}{$R-}
1456 MsgResult:=IDEQuestionDialog(lisExecutionStopped,
1457 Format(lisExecutionStoppedExitCode, [LineEnding+'', FDebugger.ExitCode, IntToHex(FDebugger.ExitCode, i)]),
1458 mtInformation, [mrOK, lisMenuOk,
1459 mrYesToAll, lisDoNotShowThisMessageAgain], '');
1460 {$POP}
1461 if MsgResult=mrYesToAll then
1462 EnvironmentOptions.DebuggerShowExitCodeMessage:=false;
1463 end
1464 else
1465 if EnvironmentOptions.DebuggerShowStopMessage
1466 then begin
1467 MsgResult:=IDEQuestionDialog(lisExecutionStopped, lisExecutionStopped,
1468 mtInformation, [mrOK, lisMenuOk,
1469 mrYesToAll, lisDoNotShowThisMessageAgain], '');
1470 if MsgResult=mrYesToAll then
1471 EnvironmentOptions.DebuggerShowStopMessage:=false;
1472 end;
1473 end;
1474
1475 if EnvironmentOptions.DebuggerResetAfterRun or FDebugger.NeedReset then
1476 ResetDebugger
1477 else
1478 FDebugger.FileName := ''; // SetState(dsIdle) via ResetStateToIdle
1479
1480 if FDialogs[ddtAssembler] <> nil
1481 then begin
1482 TAssemblerDlg(FDialogs[ddtAssembler]).SetLocation(nil, 0);
1483 if FAsmWindowShouldAutoClose then
1484 TAssemblerDlg(FDialogs[ddtAssembler]).Close;
1485 end;
1486 end;
1487 end;
1488 dsInit: begin
1489 if FDialogs[ddtPseudoTerminal] <> nil then
1490 TPseudoConsoleDlg(FDialogs[ddtPseudoTerminal]).Clear;
1491 end;
1492 end;
1493 end;
1494
1495 procedure TDebugManager.DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
1496 // debugger paused program due to pause or error
1497 // -> show the current execution line in editor
1498 // if SrcLine < 1 then no source is available
1499
1500 function FileLocationToId(ALoc: TDBGLocationRec): string;
1501 begin
1502 Result := IntToStr(length(ALoc.SrcFile)) + ':' + ALoc.SrcFile + ':'
1503 + IntToStr(length(ALoc.SrcFullName)) + ':' + ALoc.SrcFullName;
1504 end;
1505
1506 var
1507 SrcFullName: String;
1508 NewSource: TCodeBuffer;
1509 Editor: TSourceEditor;
1510 SrcLine: Integer;
1511 c, i, TId: Integer;
1512 StackEntry: TIdeCallStackEntry;
1513 Flags: TJumpToCodePosFlags;
1514 CurrentSourceUnitInfo: TDebuggerUnitInfo;
1515 a: Boolean;
1516 begin
1517 if (Sender<>FDebugger) or (Sender=nil) then exit;
1518 if FDebugger.State = dsInternalPause then exit;
1519 if Destroying then exit;
1520
1521 FCurrentLocation := ALocation;
1522 SrcLine := ALocation.SrcLine;
1523 CurrentSourceUnitInfo := nil;
1524
1525 if (SrcLine < 1) and (SrcLine <> -2) // TODO: this should move to the debugger
1526 // SrcLine will be -2 after stepping (gdbmi)
1527 then begin
1528 // jump to the deepest stack frame with debugging info
1529 // TODO: Only below the frame supplied by debugger
1530 i:=0;
1531 TId := Threads.CurrentThreads.CurrentThreadId;
1532 c := CallStack.CurrentCallStackList.EntriesForThreads[TId].CountLimited(30);
1533 while (i < c) do
1534 begin
1535 StackEntry := CallStack.CurrentCallStackList.EntriesForThreads[TId].Entries[i];
1536 if StackEntry.Validity = ddsRequested then // not yet available
1537 break;
1538 if StackEntry.Line > 0
1539 then begin
1540 CurrentSourceUnitInfo := StackEntry.UnitInfo;
1541 CurrentSourceUnitInfo.AddReference;
1542 SrcLine := StackEntry.Line;
1543 StackEntry.MakeCurrent;
1544 Break;
1545 end;
1546 Inc(i);
1547 end;
1548 end
1549 else begin
1550 CurrentSourceUnitInfo := FUnitInfoProvider.GetUnitInfoFor(ALocation.SrcFile, ALocation.SrcFullName);
1551 CurrentSourceUnitInfo.AddReference;
1552 end;
1553
1554 // TODO: do in DebuggerChangeState / Only currently State change locks execution of gdb
1555 // Must be after stack frame selection (for inspect)
1556 if FDialogs[ddtAssembler] <> nil
1557 then TAssemblerDlg(FDialogs[ddtAssembler]).SetLocation(FDebugger, Alocation.Address);
1558 if (FDialogs[ddtInspect] <> nil)
1559 then TIDEInspectDlg(FDialogs[ddtInspect]).UpdateData;
1560 if (FDialogs[ddtEvaluate] <> nil)
1561 then TEvaluateDlg(FDialogs[ddtEvaluate]).UpdateData;
1562
1563 if (SrcLine > 0) and (CurrentSourceUnitInfo <> nil) and
1564 GetFullFilename(CurrentSourceUnitInfo, SrcFullName, True)
1565 then begin
1566 // Load the file
1567 NewSource := CodeToolBoss.LoadFile(SrcFullName, true, false);
1568 if NewSource = nil
1569 then begin
1570 if not (dlfLoadError in CurrentSourceUnitInfo.Flags) then begin
1571 IDEMessageDialog(lisDebugUnableToLoadFile,
1572 Format(lisDebugUnableToLoadFile2, [SrcFullName]),
1573 mtError,[mbCancel]);
1574 CurrentSourceUnitInfo.Flags := CurrentSourceUnitInfo.Flags + [dlfLoadError];
1575 end;
1576 SrcLine := -1;
1577 end;
1578 end
1579 else begin
1580 NewSource := Nil;
1581 SrcLine := -1;
1582 end;
1583
1584 ReleaseRefAndNil(CurrentSourceUnitInfo);
1585
1586 // clear old error and execution lines
1587 if SourceEditorManager <> nil
1588 then begin
1589 SourceEditorManager.ClearExecutionLines;
1590 SourceEditorManager.ClearErrorLines;
1591 end;
1592
1593 if SrcLine < 1
1594 then begin
1595 a := FAsmWindowShouldAutoClose or (FDialogs[ddtAssembler] = nil) or (not FDialogs[ddtAssembler].Visible);
1596 ViewDebugDialog(ddtAssembler);
1597 FAsmWindowShouldAutoClose := a and EnvironmentOptions.DebuggerAutoCloseAsm;
1598 exit;
1599 end;
1600 if (FDialogs[ddtAssembler] <> nil) and FAsmWindowShouldAutoClose then
1601 TAssemblerDlg(FDialogs[ddtAssembler]).Close;
1602
1603 Editor := nil;
1604 if SourceEditorManager <> nil
1605 then Editor := SourceEditorManager.SourceEditorIntfWithFilename(NewSource.Filename);
1606
1607 // jump editor to execution line
1608 Flags := [jfAddJumpPoint, jfSearchVirtualFullPath];
1609 if (FCurrentBreakPoint = nil) or (FCurrentBreakPoint.AutoContinueTime = 0)
1610 then include(Flags, jfFocusEditor);
1611 i := SrcLine;
1612 if (Editor <> nil) then
1613 i := Editor.DebugToSourceLine(i);
1614 if MainIDE.DoJumpToCodePosition(nil,nil,NewSource,1,i,-1,-1,-1,Flags)<>mrOk
1615 then exit;
1616
1617 // mark execution line
1618 if (Editor = nil) and (SourceEditorManager <> nil) then
1619 Editor := SourceEditorManager.ActiveEditor;
1620 if Editor <> nil
1621 then begin
1622 if not Editor.HasExecutionMarks then
1623 Editor.FillExecutionMarks;
1624 Editor.ExecutionLine := i;
1625 end;
1626 end;
1627
1628 //-----------------------------------------------------------------------------
1629 // Debugger dialog routines
1630 //-----------------------------------------------------------------------------
1631
1632 // Common handler
1633 // The tag of the destroyed form contains the form variable pointing to it
1634 procedure TDebugManager.DebugDialogDestroy(Sender: TObject);
1635 var
1636 DlgType: TDebugDialogType;
1637 begin
1638 for DlgType:=Low(TDebugDialogType) to High(TDebugDialogType) do begin
1639 if FDialogs[DlgType]<>Sender then continue;
1640 case DlgType of
1641 ddtOutput:
1642 begin
1643 if fHiddenDebugOutputLog=nil then
1644 fHiddenDebugOutputLog:=TStringList.Create;
1645 TDbgOutputForm(FDialogs[ddtOutput]).GetLogText(fHiddenDebugOutputLog);
1646 end;
1647 ddtEvents:
1648 begin
1649 FEventLogManager.EventDialog := nil;
1650 end;
1651 end;
1652 FDialogs[DlgType]:=nil;
1653 exit;
1654 end;
1655 RaiseGDBException('Invalid debug window '+Sender.ClassName);
1656 end;
1657
1658 procedure TDebugManager.ViewDebugDialog(const ADialogType: TDebugDialogType;
1659 BringToFront: Boolean; Show: Boolean; DoDisableAutoSizing: boolean);
1660 const
1661 DEBUGDIALOGCLASS: array[TDebugDialogType] of TDebuggerDlgClass = (
1662 TDbgOutputForm, TDbgEventsForm, TBreakPointsDlg, TWatchesDlg, TLocalsDlg,
1663 TCallStackDlg, TEvaluateDlg, TRegistersDlg, TAssemblerDlg, TIDEInspectDlg,
1664 TPseudoConsoleDlg, TThreadsDlg, THistoryDialog
1665 );
1666 var
1667 CurDialog: TDebuggerDlg;
1668 begin
1669 if Destroying then exit;
1670 if (ADialogType = ddtPseudoTerminal) and not HasConsoleSupport
1671 then exit;
1672 if ADialogType = ddtAssembler then
1673 FAsmWindowShouldAutoClose := False;
1674 if FDialogs[ADialogType] = nil
1675 then begin
1676 CurDialog := TDebuggerDlg(DEBUGDIALOGCLASS[ADialogType].NewInstance);
1677 if FInStateChange then CurDialog.BeginUpdate;
1678 CurDialog.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDebugManager.ViewDebugDialog'){$ENDIF};
1679 CurDialog.Create(Self);
1680 FDialogs[ADialogType]:=CurDialog;
1681 CurDialog.Name:= DebugDialogNames[ADialogType];
1682 CurDialog.Tag := Integer(ADialogType);
1683 CurDialog.OnDestroy := @DebugDialogDestroy;
1684 case ADialogType of
1685 ddtOutput: InitDebugOutputDlg;
1686 ddtEvents: InitDebugEventsDlg;
1687 ddtBreakpoints: InitBreakPointDlg;
1688 ddtWatches: InitWatchesDlg;
1689 ddtLocals: InitLocalsDlg;
1690 ddtRegisters: InitRegistersDlg;
1691 ddtCallStack: InitCallStackDlg;
1692 ddtEvaluate: InitEvaluateDlg;
1693 ddtAssembler: InitAssemblerDlg;
1694 ddtInspect: InitInspectDlg;
1695 ddtPseudoTerminal: InitPseudoTerminal;
1696 ddtThreads: InitThreadsDlg;
1697 ddtHistory: InitHistoryDlg;
1698 end;
1699 end
1700 else begin
1701 CurDialog:=FDialogs[ADialogType];
1702 CurDialog.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDebugManager.ViewDebugDialog'){$ENDIF};
1703 if (CurDialog is TBreakPointsDlg)
1704 then begin
1705 if (Project1<>nil) then
1706 TBreakPointsDlg(CurDialog).BaseDirectory:=Project1.Directory;
1707 end;
1708 if (CurDialog is TAssemblerDlg)
1709 then begin
1710 TAssemblerDlg(CurDialog).SetLocation(FDebugger, FCurrentLocation.Address);
1711 end;
1712 if (CurDialog is TIDEInspectDlg) and (SourceEditorManager.GetActiveSE <> nil)
1713 then begin
1714 if SourceEditorManager.GetActiveSE.SelectionAvailable then
1715 TIDEInspectDlg(CurDialog).Execute(SourceEditorManager.GetActiveSE.Selection)
1716 else
1717 TIDEInspectDlg(CurDialog).Execute(SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret);
1718 end;
1719 if (CurDialog is TEvaluateDlg) and (SourceEditorManager.GetActiveSE <> nil)
1720 then begin
1721 if SourceEditorManager.GetActiveSE.SelectionAvailable then
1722 TEvaluateDlg(CurDialog).Execute(SourceEditorManager.GetActiveSE.Selection)
1723 else
1724 TEvaluateDlg(CurDialog).Execute(SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret);
1725 end;
1726 end;
1727 if not DoDisableAutoSizing then
1728 CurDialog.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDebugManager.ViewDebugDialog'){$ENDIF};
1729 if Show then
1730 begin
1731 CurDialog.BeginUpdate;
1732 IDEWindowCreators.ShowForm(CurDialog,BringToFront,vmOnlyMoveOffScreenToVisible);
1733 CurDialog.EndUpdate;
1734 end;
1735 end;
1736
1737 procedure TDebugManager.ViewDisassembler(AnAddr: TDBGPtr; BringToFront: Boolean;
1738 Show: Boolean; DoDisableAutoSizing: boolean);
1739 begin
1740 ViewDebugDialog(ddtAssembler, BringToFront, Show, DoDisableAutoSizing);
1741 if FDialogs[ddtAssembler] <> nil
1742 then TAssemblerDlg(FDialogs[ddtAssembler]).SetLocation(FDebugger, FCurrentLocation.Address, AnAddr);
1743 end;
1744
1745 procedure TDebugManager.DestroyDebugDialog(const ADialogType: TDebugDialogType);
1746 begin
1747 if FDialogs[ADialogType] = nil then Exit;
1748 FDialogs[ADialogType].OnDestroy := nil;
1749 FDialogs[ADialogType].Free;
1750 FDialogs[ADialogType] := nil;
1751 end;
1752
1753 procedure TDebugManager.InitDebugOutputDlg;
1754 var
1755 TheDialog: TDbgOutputForm;
1756 begin
1757 TheDialog := TDbgOutputForm(FDialogs[ddtOutput]);
1758 if FHiddenDebugOutputLog <> nil
1759 then begin
1760 TheDialog.SetLogText(FHiddenDebugOutputLog);
1761 FreeAndNil(FHiddenDebugOutputLog);
1762 end;
1763 end;
1764
1765 procedure TDebugManager.InitDebugEventsDlg;
1766 var
1767 TheDialog: TDbgEventsForm;
1768 begin
1769 TheDialog := TDbgEventsForm(FDialogs[ddtEvents]);
1770 FEventLogManager.EventDialog := TheDialog;
1771 end;
1772
1773 procedure TDebugManager.InitBreakPointDlg;
1774 var
1775 TheDialog: TBreakPointsDlg;
1776 begin
1777 TheDialog:=TBreakPointsDlg(FDialogs[ddtBreakpoints]);
1778 if Project1 <> nil
1779 then TheDialog.BaseDirectory := Project1.Directory;
1780 TheDialog.BreakPoints := FBreakPoints;
1781 end;
1782
1783 procedure TDebugManager.InitWatchesDlg;
1784 var
1785 TheDialog: TWatchesDlg;
1786 begin
1787 TheDialog := TWatchesDlg(FDialogs[ddtWatches]);
1788 TheDialog.WatchesMonitor := FWatches;
1789 TheDialog.ThreadsMonitor := FThreads;
1790 TheDialog.CallStackMonitor := FCallStack;
1791 TheDialog.BreakPoints := FBreakPoints;
1792 TheDialog.SnapshotManager := FSnapshots;
1793 end;
1794
1795 procedure TDebugManager.InitThreadsDlg;
1796 var
1797 TheDialog: TThreadsDlg;
1798 begin
1799 TheDialog := TThreadsDlg(FDialogs[ddtThreads]);
1800 TheDialog.ThreadsMonitor := FThreads;
1801 TheDialog.SnapshotManager := FSnapshots;
1802 end;
1803
1804 procedure TDebugManager.InitPseudoTerminal;
1805 //var
1806 // TheDialog: TPseudoConsoleDlg;
1807 begin
1808 if not HasConsoleSupport then exit;
1809 //TheDialog := TPseudoConsoleDlg(FDialogs[ddtPseudoTerminal]);
1810 end;
1811
1812 procedure TDebugManager.InitLocalsDlg;
1813 var
1814 TheDialog: TLocalsDlg;
1815 begin
1816 TheDialog := TLocalsDlg(FDialogs[ddtLocals]);
1817 TheDialog.LocalsMonitor := FLocals;
1818 TheDialog.ThreadsMonitor := FThreads;
1819 TheDialog.CallStackMonitor := FCallStack;
1820 TheDialog.SnapshotManager := FSnapshots;
1821 end;
1822
1823 procedure TDebugManager.InitRegistersDlg;
1824 var
1825 TheDialog: TRegistersDlg;
1826 begin
1827 TheDialog := TRegistersDlg(FDialogs[ddtRegisters]);
1828 TheDialog.ThreadsMonitor := FThreads;
1829 TheDialog.CallStackMonitor := FCallStack;
1830 TheDialog.RegistersMonitor := FRegisters;
1831 end;
1832
1833 procedure TDebugManager.InitAssemblerDlg;
1834 var
1835 TheDialog: TAssemblerDlg;
1836 begin
1837 TheDialog := TAssemblerDlg(FDialogs[ddtAssembler]);
1838 TheDialog.BreakPoints := FBreakPoints;
1839 TheDialog.Disassembler := FDisassembler;
1840 TheDialog.DebugManager := Self;
1841 TheDialog.SetLocation(FDebugger, FCurrentLocation.Address);
1842 end;
1843
1844 procedure TDebugManager.InitInspectDlg;
1845 var
1846 TheDialog: TIDEInspectDlg;
1847 begin
1848 TheDialog := TIDEInspectDlg(FDialogs[ddtInspect]);
1849 if (SourceEditorManager.GetActiveSE = nil) then
1850 exit;
1851 if SourceEditorManager.GetActiveSE.SelectionAvailable then
1852 TheDialog.Execute(SourceEditorManager.GetActiveSE.Selection)
1853 else
1854 TheDialog.Execute(SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret);
1855 end;
1856
1857 procedure TDebugManager.InitHistoryDlg;
1858 var
1859 TheDialog: THistoryDialog;
1860 begin
1861 TheDialog := THistoryDialog(FDialogs[ddtHistory]);
1862 TheDialog.SnapshotManager := FSnapshots;
1863 end;
1864
1865 procedure TDebugManager.InitCallStackDlg;
1866 var
1867 TheDialog: TCallStackDlg;
1868 begin
1869 TheDialog := TCallStackDlg(FDialogs[ddtCallStack]);
1870 TheDialog.CallStackMonitor := FCallStack;
1871 TheDialog.BreakPoints := FBreakPoints;
1872 TheDialog.ThreadsMonitor := FThreads;
1873 TheDialog.SnapshotManager := FSnapshots;
1874 end;
1875
1876 procedure TDebugManager.InitEvaluateDlg;
1877 var
1878 TheDialog: TEvaluateDlg;
1879 begin
1880 TheDialog := TEvaluateDlg(FDialogs[ddtEvaluate]);
1881 if (SourceEditorManager.GetActiveSE = nil) then
1882 exit;
1883 if SourceEditorManager.GetActiveSE.SelectionAvailable
1884 then
1885 TheDialog.FindText := SourceEditorManager.GetActiveSE.Selection
1886 else
1887 TheDialog.FindText := SourceEditorManager.GetActiveSE.GetOperandAtCurrentCaret;
1888 end;
1889
1890 constructor TDebugManager.Create(TheOwner: TComponent);
1891 var
1892 DialogType: TDebugDialogType;
1893 begin
1894 FInStateChange := False;
1895 for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do
1896 FDialogs[DialogType] := nil;
1897
1898 FDebugger := nil;
1899 FUnitInfoProvider := TDebuggerUnitInfoProvider.Create;
1900 FBreakPoints := TManagedBreakPoints.Create(Self);
1901 FBreakPointGroups := TIDEBreakPointGroups.Create;
1902 FWatches := TIdeWatchesMonitor.Create;
1903 FThreads := TIdeThreadsMonitor.Create;
1904 FExceptions := TProjectExceptions.Create;
1905 FSignals := TIDESignals.Create;
1906 FLocals := TIdeLocalsMonitor.Create;
1907 FLineInfo := TIDELineInfo.Create;
1908 FCallStack := TIdeCallStackMonitor.Create;
1909 FDisassembler := TIDEDisassembler.Create;
1910 FRegisters := TIdeRegistersMonitor.Create;
1911
1912 FSnapshots := TSnapshotManager.Create;
1913 FSnapshots.Threads := FThreads;
1914 FSnapshots.CallStack := FCallStack;
1915 FSnapshots.Watches := FWatches;
1916 FSnapshots.Locals := FLocals;
1917 FSnapshots.UnitInfoProvider := FUnitInfoProvider;
1918
1919 FUserSourceFiles := TStringList.Create;
1920
1921 FAutoContinueTimer := TTimer.Create(Self);
1922 FAutoContinueTimer.Enabled := False;
1923 FAutoContinueTimer.OnTimer := @BreakAutoContinueTimer;
1924 FRunTimer := TTimer.Create(Self);
1925 FRunTimer.Interval := 1;
1926 FRunTimer.OnTimer := @OnRunTimer;
1927
1928 FWatches.OnModified := @DoProjectModified;
1929
1930 FIsInitializingDebugger:= False;
1931
1932 inherited Create(TheOwner);
1933
1934 LazarusIDE.AddHandlerOnProjectClose(@DoProjectClose);
1935
1936 RegisterValueFormatter(skSimple, 'TDate', @DBGDateTimeFormatter);
1937 RegisterValueFormatter(skFloat, 'TDate', @DBGDateTimeFormatter);
1938 RegisterValueFormatter(skSimple, 'TTime', @DBGDateTimeFormatter);
1939 RegisterValueFormatter(skFloat, 'TTime', @DBGDateTimeFormatter);
1940 RegisterValueFormatter(skSimple, 'TDateTime', @DBGDateTimeFormatter);
1941 RegisterValueFormatter(skFloat, 'TDateTime', @DBGDateTimeFormatter);
1942
1943 FEventLogManager := TDebugEventLogManager.Create;
1944 end;
1945
1946 destructor TDebugManager.Destroy;
1947 var
1948 DialogType: TDebugDialogType;
1949 begin
1950 FDestroying := true;
1951
1952 LazarusIDE.RemoveHandlerOnProjectClose(@DoProjectClose);
1953 FreeAndNil(FAutoContinueTimer);
1954
1955 for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do
1956 DestroyDebugDialog(DialogType);
1957
1958 SetDebugger(nil);
1959
1960 FreeAndNil(FEventLogManager);
1961 FreeAndNil(FSnapshots);
1962 FreeAndNil(FWatches);
1963 FreeAndNil(FThreads);
1964 FreeAndNil(FBreakPoints);
1965 FreeAndNil(FBreakPointGroups);
1966 FreeAndNil(FCallStack);
1967 FreeAndNil(FDisassembler);
1968 FreeAndNil(FExceptions);
1969 FreeAndNil(FSignals);
1970 FreeAndNil(FLocals);
1971 FreeAndNil(FLineInfo);
1972 FreeAndNil(FRegisters);
1973
1974 FreeAndNil(FUserSourceFiles);
1975 FreeAndNil(FHiddenDebugOutputLog);
1976 FreeAndNil(FUnitInfoProvider);
1977
1978 inherited Destroy;
1979 end;
1980
1981 procedure TDebugManager.Reset;
1982 begin
1983 FBreakPoints.Clear;
1984 FBreakPointGroups.Clear;
1985 FWatches.Clear;
1986 FThreads.Clear;
1987 FExceptions.Reset;
1988 FSignals.Reset;
1989 FUserSourceFiles.Clear;
1990 FUnitInfoProvider.Clear;
1991 end;
1992
1993 procedure TDebugManager.ConnectMainBarEvents;
1994 begin
1995 with MainIDEBar do begin
1996 itmViewWatches.OnClick := @mnuViewDebugDialogClick;
1997 itmViewWatches.Tag := Ord(ddtWatches);
1998 itmViewBreakPoints.OnClick := @mnuViewDebugDialogClick;
1999 itmViewBreakPoints.Tag := Ord(ddtBreakPoints);
2000 itmViewLocals.OnClick := @mnuViewDebugDialogClick;
2001 itmViewLocals.Tag := Ord(ddtLocals);
2002 itmViewRegisters.OnClick := @mnuViewDebugDialogClick;
2003 itmViewRegisters.Tag := Ord(ddtRegisters);
2004 itmViewCallStack.OnClick := @mnuViewDebugDialogClick;
2005 itmViewCallStack.Tag := Ord(ddtCallStack);
2006 itmViewThreads.OnClick := @mnuViewDebugDialogClick;
2007 itmViewThreads.Tag := Ord(ddtThreads);
2008 itmViewAssembler.OnClick := @mnuViewDebugDialogClick;
2009 itmViewAssembler.Tag := Ord(ddtAssembler);
2010 itmViewDebugOutput.OnClick := @mnuViewDebugDialogClick;
2011 itmViewDebugOutput.Tag := Ord(ddtOutput);
2012 itmViewDebugEvents.OnClick := @mnuViewDebugDialogClick;
2013 itmViewDebugEvents.Tag := Ord(ddtEvents);
2014 if itmViewPseudoTerminal <> nil then begin
2015 itmViewPseudoTerminal.OnClick := @mnuViewDebugDialogClick;
2016 itmViewPseudoTerminal.Tag := Ord(ddtPseudoTerminal);
2017 end;
2018 itmViewDbgHistory.OnClick := @mnuViewDebugDialogClick;
2019 itmViewDbgHistory.Tag := Ord(ddtHistory);
2020
2021 itmRunMenuResetDebugger.OnClick := @mnuResetDebuggerClicked;
2022
2023 itmRunMenuInspect.OnClick := @mnuViewDebugDialogClick;
2024 itmRunMenuInspect.Tag := Ord(ddtInspect);
2025 itmRunMenuEvaluate.OnClick := @mnuViewDebugDialogClick;
2026 itmRunMenuEvaluate.Tag := Ord(ddtEvaluate);
2027 itmRunMenuAddWatch.OnClick := @mnuAddWatchClicked;
2028
2029 itmRunMenuAddBpSource.OnClick := @mnuAddBpSource;
2030 itmRunMenuAddBpAddress.OnClick := @mnuAddBpAddress;
2031 itmRunMenuAddBpWatchPoint.OnClick := @mnuAddBpData;
2032
2033 // TODO: add capacibilities to DebuggerClass
2034 // and disable unsuported items
2035 end;
2036 end;
2037
2038 procedure TDebugManager.ConnectSourceNotebookEvents;
2039 begin
2040 SrcEditMenuAddWatchAtCursor.OnClick:=@mnuAddWatchClicked;
2041 SrcEditMenuAddWatchPointAtCursor.OnClick:=@mnuAddBpDataAtCursor;
2042 SrcEditMenuEvaluateModify.OnClick:=@mnuViewDebugDialogClick;
2043 SrcEditMenuEvaluateModify.Tag := Ord(ddtEvaluate);
2044 SrcEditMenuInspect.OnClick:=@mnuViewDebugDialogClick;
2045 SrcEditMenuInspect.Tag := Ord(ddtInspect);
2046 end;
2047
2048 function GetCommand(ACommand: word): TIDECommand;
2049 begin
2050 Result:=IDECommandList.FindIDECommand(ACommand);
2051 if Result<>nil then
2052 RegisterIDEButtonCommand(Result);
2053 end;
2054
2055 procedure TDebugManager.SetupMainBarShortCuts;
2056 begin
2057 with MainIDEBar do
2058 begin
2059 itmViewWatches.Command:=GetCommand(ecToggleWatches);
2060 itmViewBreakpoints.Command:=GetCommand(ecToggleBreakPoints);
2061 itmViewDebugOutput.Command:=GetCommand(ecToggleDebuggerOut);
2062 itmViewDebugEvents.Command:=GetCommand(ecToggleDebugEvents);
2063 itmViewLocals.Command:=GetCommand(ecToggleLocals);
2064 itmViewRegisters.Command:=GetCommand(ecToggleRegisters);
2065 itmViewCallStack.Command:=GetCommand(ecToggleCallStack);
2066 itmViewAssembler.Command:=GetCommand(ecToggleAssembler);
2067 itmViewThreads.Command:=GetCommand(ecViewThreads);
2068 if itmViewPseudoTerminal <> nil then
2069 itmViewPseudoTerminal.Command:=GetCommand(ecViewPseudoTerminal);
2070 itmViewDbgHistory.Command:=GetCommand(ecViewHistory);
2071
2072 itmRunMenuInspect.Command:=GetCommand(ecInspect);
2073 itmRunMenuEvaluate.Command:=GetCommand(ecEvaluate);
2074 itmRunMenuAddWatch.Command:=GetCommand(ecAddWatch);
2075 itmRunMenuAddBpSource.Command:=GetCommand(ecAddBpSource);
2076 itmRunMenuAddBpAddress.Command:=GetCommand(ecAddBpAddress);
2077 itmRunMenuAddBpWatchPoint.Command:=GetCommand(ecAddBpDataWatch);
2078 end;
2079 end;
2080
2081 procedure TDebugManager.SetupSourceMenuShortCuts;
2082 begin
2083 SrcEditMenuToggleBreakpoint.Command:=GetCommand(ecToggleBreakPoint);
2084 SrcEditMenuStepToCursor.Command:=GetCommand(ecStepToCursor);
2085 SrcEditMenuRunToCursor.Command:=GetCommand(ecRunToCursor);
2086 SrcEditMenuEvaluateModify.Command:=GetCommand(ecEvaluate);
2087 SrcEditMenuAddWatchAtCursor.Command:=GetCommand(ecAddWatch);
2088 SrcEditMenuAddWatchPointAtCursor.Command:=GetCommand(ecAddBpDataWatch);
2089 SrcEditMenuInspect.Command:=GetCommand(ecInspect);
2090 SrcEditMenuViewCallStack.Command:=GetCommand(ecToggleCallStack);
2091 end;
2092
2093 procedure TDebugManager.UpdateButtonsAndMenuItems;
2094 var
2095 DebuggerIsValid: boolean;
2096 CanRun: Boolean;
2097 SrcEdit: TSourceEditorInterface;
2098 AnUnitInfo: TUnitInfo;
2099 AvailCommands: TDBGCommands;
2100 CurState: TDBGState;
2101 begin
2102 if (MainIDE=nil) or (MainIDE.ToolStatus = itExiting) then exit;
2103
2104 if FDebugger <> nil then begin
2105 AvailCommands := FDebugger.Commands;
2106 CurState := FDebugger.State;
2107 if CurState = dsError then begin
2108 CurState := dsStop;
2109 AvailCommands := GetDebuggerClass.SupportedCommandsFor(dsStop);
2110 end;
2111 end
2112 else begin
2113 AvailCommands := GetDebuggerClass.SupportedCommandsFor(dsStop);
2114 CurState := dsStop;
2115 end;
2116 DebuggerIsValid:=(MainIDE.ToolStatus in [itNone, itDebugger]);
2117 MainIDE.GetCurrentUnitInfo(SrcEdit,AnUnitInfo);
2118 with MainIDEBar do begin
2119 // For 'run' and 'step' bypass 'idle', so we can set the filename later
2120 CanRun:=false;
2121 if (Project1<>nil) and DebuggerIsValid then
2122 CanRun:=( (AnUnitInfo<>nil) and (AnUnitInfo.RunFileIfActive) ) or
2123 ( ((Project1.CompilerOptions.ExecutableType=cetProgram) or
2124 ((Project1.RunParameterOptions.GetActiveMode<>nil) and (Project1.RunParameterOptions.GetActiveMode.HostApplicationFilename<>'')))
2125 and (pfRunnable in Project1.Flags)
2126 );
2127 // Run
2128 itmRunMenuRun.Enabled := CanRun and (dcRun in AvailCommands);
2129 // Pause
2130 itmRunMenuPause.Enabled := CanRun and ((dcPause in AvailCommands) or FAutoContinueTimer.Enabled);
2131 // Show execution point
2132 itmRunMenuShowExecutionPoint.Enabled := CanRun and (CurState = dsPause);
2133 // Step into
2134 itmRunMenuStepInto.Enabled := CanRun and (dcStepInto in AvailCommands);
2135 // Step over
2136 itmRunMenuStepOver.Enabled := CanRun and (dcStepOver in AvailCommands);
2137 // Step out
2138 itmRunMenuStepOut.Enabled := CanRun and (dcStepOut in AvailCommands) and (CurState = dsPause);
2139 // Step to cursor
2140 itmRunMenuStepToCursor.Enabled := CanRun and (dcStepTo in AvailCommands);
2141 // Run to cursor
2142 itmRunMenuRunToCursor.Enabled := CanRun and (dcRunTo in AvailCommands);
2143 // Stop
2144 itmRunMenuStop.Enabled := (CanRun and (MainIDE.ToolStatus = itDebugger) and
2145 (CurState in [dsPause, dsInternalPause, dsInit, dsRun, dsError])) or
2146 (MainIDE.ToolStatus = itBuilder);
2147
2148 //Attach / Detach
2149 itmRunMenuAttach.Enabled := DebuggerIsValid and (dcAttach in AvailCommands);
2150 itmRunMenuDetach.Enabled := DebuggerIsValid and (dcDetach in AvailCommands);
2151
2152 // Evaluate
2153 itmRunMenuEvaluate.Enabled := CanRun and (dcEvaluate in AvailCommands);
2154 // Evaluate / modify
2155 SrcEditMenuEvaluateModify.Enabled := CanRun and (dcEvaluate in AvailCommands);
2156 // Inspect
2157 SrcEditMenuInspect.Enabled := CanRun and (dcEvaluate in AvailCommands);
2158 itmRunMenuInspect.Enabled := CanRun and (dcEvaluate in AvailCommands);
2159 // Add watch
2160 itmRunMenuAddWatch.Enabled := True; // always allow to add a watch
2161
2162 // Add Breakpoint
2163 itmRunMenuAddBpSource.Enabled := True;
2164 itmRunMenuAddBpAddress.Enabled := True;
2165 itmRunMenuAddBpWatchPoint.Enabled := True;
2166
2167 // TODO: add capacibilities to DebuggerClass
2168 // menu view
2169 //itmViewRegisters.Enabled := DebuggerIsValid;
2170 //itmViewAssembler.Enabled := DebuggerIsValid;
2171 end;
2172 end;
2173
2174 procedure TDebugManager.UpdateToolStatus;
2175 const
2176 TOOLSTATEMAP: array[TDBGState] of TIDEToolStatus = (
2177 //dsNone, dsIdle, dsStop, dsPause, dsInternalPause, dsInit, dsRun, dsError, dsDestroying
2178 itNone, itNone, itNone, itDebugger, itDebugger, itDebugger, itDebugger, itNone, itNone
2179 );
2180 begin
2181 // Next may call ResetDebugger, then FDebugger is gone
2182 if MainIDE.ToolStatus in [itNone,itDebugger]
2183 then begin
2184 if FDebugger = nil then
2185 MainIDE.ToolStatus := itNone
2186 else
2187 MainIDE.ToolStatus := TOOLSTATEMAP[FDebugger.State];
2188 end;
2189 end;
2190
2191 procedure TDebugManager.EnvironmentOptsChanged;
2192 begin
2193 if FDebugger <> nil then begin
2194 if EnvironmentOptions.DebuggerAllowFunctionCalls then
2195 FDebugger.EnabledFeatures := FDebugger.EnabledFeatures + [dfEvalFunctionCalls]
2196 else
2197 FDebugger.EnabledFeatures := FDebugger.EnabledFeatures - [dfEvalFunctionCalls];
2198 end;
2199 end;
2200
2201 {------------------------------------------------------------------------------
2202 procedure TDebugManager.LoadProjectSpecificInfo(XMLConfig: TXMLConfig;
2203 Merge: boolean);
2204
2205 Called when the main project is loaded from the XMLConfig.
2206 ------------------------------------------------------------------------------}
2207 procedure TDebugManager.LoadProjectSpecificInfo(XMLConfig: TXMLConfig;
2208 Merge: boolean);
2209 begin
2210 if not Merge then
2211 begin
2212 FExceptions.LoadFromXMLConfig(XMLConfig,'Debugging/'+XMLExceptionsNode+'/');
2213 end;
2214 // keep it simple: just load from the session and don't merge
2215 FBreakPointGroups.LoadFromXMLConfig(XMLConfig,
2216 'Debugging/'+XMLBreakPointGroupsNode+'/');
2217 FBreakPoints.LoadFromXMLConfig(XMLConfig,'Debugging/'+XMLBreakPointsNode+'/',
2218 @Project1.ConvertFromLPIFilename,
2219 @FBreakPointGroups.GetGroupByName);
2220 FWatches.LoadFromXMLConfig(XMLConfig,'Debugging/'+XMLWatchesNode+'/');
2221 end;
2222
2223 {------------------------------------------------------------------------------
2224 procedure TDebugManager.SaveProjectSpecificInfo(XMLConfig: TXMLConfig;
2225 Flags: TProjectWriteFlags);
2226
2227 Called when the main project is saved to an XMLConfig.
2228 ------------------------------------------------------------------------------}
2229 procedure TDebugManager.SaveProjectSpecificInfo(XMLConfig: TXMLConfig;
2230 Flags: TProjectWriteFlags);
2231 begin
2232 if not (pwfSkipSeparateSessionInfo in Flags) then
2233 begin
2234 FBreakPointGroups.SaveToXMLConfig(XMLConfig,
2235 'Debugging/'+XMLBreakPointGroupsNode+'/', pwfCompatibilityMode in Flags);
2236 FBreakPoints.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLBreakPointsNode+'/',
2237 pwfCompatibilityMode in Flags, @Project1.ConvertToLPIFilename);
2238 FWatches.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLWatchesNode+'/', pwfCompatibilityMode in Flags);
2239 end;
2240 if not (pwfSkipProjectInfo in Flags) then
2241 begin
2242 // exceptions are not part of the project info (#0015256)
2243 FExceptions.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLExceptionsNode+'/', pwfCompatibilityMode in Flags);
2244 end;
2245 end;
2246
2247 procedure TDebugManager.DoRestoreDebuggerMarks(AnUnitInfo: TUnitInfo);
2248 var
2249 ASrcEdit: TSourceEditor;
2250 i: Integer;
2251 CurBreakPoint: TIDEBreakPoint;
2252 SrcFilename: String;
2253 begin
2254 if (AnUnitInfo.OpenEditorInfoCount = 0) or Destroying then exit;
2255 ASrcEdit := TSourceEditor(AnUnitInfo.OpenEditorInfo[0].EditorComponent);
2256 // set breakpoints for this unit
2257 SrcFilename:=AnUnitInfo.Filename;
2258 for i := 0 to FBreakpoints.Count-1 do
2259 begin
2260 CurBreakPoint := FBreakpoints[i];
2261 if CompareFileNames(CurBreakPoint.Source, SrcFilename) = 0 then
2262 CreateSourceMarkForBreakPoint(CurBreakPoint, ASrcEdit);
2263 end;
2264 end;
2265
2266 procedure TDebugManager.CreateSourceMarkForBreakPoint(
2267 const ABreakpoint: TIDEBreakPoint; ASrcEdit: TSourceEditor);
2268 var
2269 ManagedBreakPoint: TManagedBreakPoint;
2270 NewSrcMark: TSourceMark;
2271 begin
2272 if not (ABreakpoint is TManagedBreakPoint) then
2273 RaiseGDBException('TDebugManager.CreateSourceMarkForBreakPoint');
2274 ManagedBreakPoint:=TManagedBreakPoint(ABreakpoint);
2275
2276 if (ManagedBreakPoint.SourceMark<>nil) or Destroying then exit;
2277 if ASrcEdit=nil then
2278 GetSourceEditorForBreakPoint(ManagedBreakPoint,ASrcEdit);
2279 if ASrcEdit=nil then exit;
2280 NewSrcMark:=TSourceMark.Create(ASrcEdit, nil);
2281 ManagedBreakPoint.SourceMark:=NewSrcMark;
2282 SourceEditorMarks.Add(NewSrcMark);
2283 end;
2284
2285 procedure TDebugManager.GetSourceEditorForBreakPoint(
2286 const ABreakpoint: TIDEBreakPoint; var ASrcEdit: TSourceEditor);
2287 var
2288 Filename: String;
2289 begin
2290 Filename:=ABreakpoint.Source;
2291 if Filename<>'' then
2292 ASrcEdit:=SourceEditorManager.SourceEditorIntfWithFilename(ABreakpoint.Source)
2293 else
2294 ASrcEdit:=nil;
2295 end;
2296
2297 procedure TDebugManager.CreateDebugDialog(Sender: TObject; aFormName: string;
2298 var AForm: TCustomForm; DoDisableAutoSizing: boolean);
2299
ItIsnull2300 function ItIs(Prefix: string): boolean;
2301 begin
2302 Result:=SysUtils.CompareText(copy(aFormName,1,length(Prefix)),Prefix)=0;
2303 end;
2304
2305 var
2306 DlgType: TDebugDialogType;
2307 begin
2308 for DlgType:=Low(TDebugDialogType) to High(TDebugDialogType) do
2309 if ItIs(DebugDialogNames[DlgType]) then
2310 begin
2311 ViewDebugDialog(DlgType,false,false,DoDisableAutoSizing);
2312 AForm:=FDialogs[DlgType];
2313 exit;
2314 end;
2315 raise Exception.Create('TDebugManager.CreateDebugDialog invalid FormName "'+aFormName+'"');
2316 end;
2317
2318 procedure TDebugManager.ClearDebugOutputLog;
2319 begin
2320 if FDialogs[ddtOutput] <> nil then
2321 TDbgOutputForm(FDialogs[ddtOutput]).Clear
2322 else if fHiddenDebugOutputLog<>nil then
2323 fHiddenDebugOutputLog.Clear;
2324 end;
2325
2326 procedure TDebugManager.ClearDebugEventsLog;
2327 begin
2328 FEventLogManager.ClearDebugEventsLog;
2329 end;
2330
RequiredCompilerOptsnull2331 function TDebugManager.RequiredCompilerOpts(ATargetCPU, ATargetOS: String
2332 ): TDebugCompilerRequirements;
2333 begin
2334 if DebuggerClass = nil then
2335 exit([]);
2336 Result := DebuggerClass.RequiredCompilerOpts(ATargetCPU, ATargetOS);
2337 end;
2338
2339 //-----------------------------------------------------------------------------
2340 // Debugger routines
2341 //-----------------------------------------------------------------------------
2342
2343 procedure TDebugManager.FreeDebugger;
2344 var
2345 dbg: TDebuggerIntf;
2346 begin
2347 dbg := FDebugger;
2348 SetDebugger(nil);
2349 dbg.Release;
2350 FManagerStates := [];
2351 FIsInitializingDebugger:= False;
2352
2353 if MainIDE.ToolStatus = itDebugger
2354 then MainIDE.ToolStatus := itNone;
2355 end;
2356
2357 procedure TDebugManager.ResetDebugger;
2358 var
2359 OldState: TDBGState;
2360 begin
2361 OldState := State;
2362 if OldState = dsNone then Exit;
2363
2364 FDebugger.BeginReset;
2365 EndDebugging;
2366 // OnDebuggerChangeState(FDebugger, OldState);
2367 // InitDebugger;
2368 end;
2369
GetLaunchPathAndExenull2370 function TDebugManager.GetLaunchPathAndExe(out LaunchingCmdLine,
2371 LaunchingApplication, LaunchingParams: String; PromptOnError: Boolean
2372 ): Boolean;
2373
2374 procedure ClearPathAndExe;
2375 begin
2376 LaunchingApplication := '';
2377 LaunchingParams := '';
2378 LaunchingCmdLine := '';
2379 end;
2380
2381 var
2382 NewDebuggerClass: TDebuggerClass;
2383 begin
2384 Result := False;
2385 NewDebuggerClass := GetDebuggerClass;
2386 LaunchingCmdLine := BuildBoss.GetRunCommandLine;
2387 SplitCmdLine(LaunchingCmdLine, LaunchingApplication, LaunchingParams);
2388
2389 (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834
2390 Se Debugger.RequiresLocalExecutable
2391 *)
2392 if NewDebuggerClass.RequiresLocalExecutable then begin
2393
2394 if BuildBoss.GetProjectUsesAppBundle then
2395 begin
2396 // it is Application Bundle (darwin only)
2397
2398 if not DirectoryExistsUTF8(LaunchingApplication) then
2399 begin
2400 if not PromptOnError then
2401 ClearPathAndExe
2402 else begin
2403 BuildBoss.WriteDebug_RunCommandLine;
2404 if IDEMessageDialog(lisLaunchingApplicationInvalid,
2405 Format(lisTheLaunchingApplicationBundleDoesNotExists,
2406 [LaunchingApplication, LineEnding, LineEnding, LineEnding+LineEnding]),
2407 mtError, [mbYes, mbNo, mbCancel]) = mrYes then
2408 begin
2409 if not BuildBoss.CreateProjectApplicationBundle then Exit;
2410 end
2411 else
2412 Exit;
2413 end;
2414 end;
2415
2416 if (NewDebuggerClass = TProcessDebugger) and (LaunchingApplication <> '') then
2417 begin // use executable path inside Application Bundle (darwin only)
2418 LaunchingApplication := LaunchingApplication + '/Contents/MacOS/' +
2419 ExtractFileNameOnly(LaunchingApplication);
2420 end;
2421 end
2422 else
2423 if not FileIsExecutable(LaunchingApplication)
2424 then begin
2425 BuildBoss.WriteDebug_RunCommandLine;
2426 if not PromptOnError then
2427 ClearPathAndExe
2428 else begin
2429 IDEMessageDialog(lisLaunchingApplicationInvalid,
2430 Format(lisTheLaunchingApplicationDoesNotExistsOrIsNotExecuta,
2431 [LaunchingApplication, LineEnding, LineEnding+LineEnding]),
2432 mtError, [mbOK]);
2433 Exit;
2434 end;
2435 end;
2436
2437 // check if debugger needs an Exe and the exe is there
2438 if (NewDebuggerClass.NeedsExePath)
2439 and not FileIsExecutable(EnvironmentOptions.GetParsedDebuggerFilename(Project1))
2440 then begin
2441 if not PromptOnError then
2442 ClearPathAndExe
2443 else begin
2444 debugln(['Info: (lazarus) [TDebugManager.GetLaunchPathAndExe] EnvironmentOptions.DebuggerFilename="',EnvironmentOptions.DebuggerFilename,'"']);
2445 IDEMessageDialog(lisDebuggerInvalid,
2446 Format(lisTheDebuggerDoesNotExistsOrIsNotExecutableSeeEnviro,
2447 [EnvironmentOptions.DebuggerFilename(Project1), LineEnding, LineEnding+LineEnding]),
2448 mtError,[mbOK]);
2449 Exit;
2450 end;
2451 end;
2452
2453 end; // if NewDebuggerClass.RequiresLocalExecutable then
2454 Result := True;
2455 end;
2456
InitDebuggernull2457 function TDebugManager.InitDebugger(AFlags: TDbgInitFlags): Boolean;
2458 var
2459 LaunchingCmdLine, LaunchingApplication, LaunchingParams: String;
2460 NewWorkingDir: String;
2461 NewDebuggerClass: TDebuggerClass;
2462 begin
2463 {$ifdef VerboseDebugger}
2464 DebugLn('[TDebugManager.DoInitDebugger] A');
2465 {$endif}
2466
2467 Result := False;
2468 if FIsInitializingDebugger then begin
2469 DebugLn('[TDebugManager.DoInitDebugger] *** Re-Entered');
2470 exit;
2471 end;
2472
2473 if Destroying or (Project1 = nil) then Exit;
2474 if not(difInitForAttach in AFlags) then begin
2475 if (Project1.MainUnitID < 0) then Exit;
2476 if not GetLaunchPathAndExe(LaunchingCmdLine, LaunchingApplication, LaunchingParams) then
2477 exit;
2478 end
2479 else
2480 GetLaunchPathAndExe(LaunchingCmdLine, LaunchingApplication, LaunchingParams, False);
2481
2482 FUnitInfoProvider.Clear;
2483 FIsInitializingDebugger:= True;
2484 try
2485 NewDebuggerClass := GetDebuggerClass;
2486
2487 if (dmsDebuggerObjectBroken in FManagerStates)
2488 then begin
2489 FreeDebugger;
2490 FIsInitializingDebugger:= True; // been reset by FreeDebuger
2491 end;
2492
2493 // check if debugger is already created with the right type
2494 if (FDebugger <> nil)
2495 and (not (FDebugger.ClassType = NewDebuggerClass) // exact class match
2496 or (FDebugger.ExternalDebugger <> EnvironmentOptions.GetParsedDebuggerFilename(Project1))
2497 or (FDebugger.State in [dsError])
2498 )
2499 then begin
2500 // the current debugger is the wrong type -> free it
2501 FreeDebugger;
2502 FIsInitializingDebugger:= True; // been reset by FreeDebuger
2503 end;
2504
2505 // create debugger object
2506 if FDebugger = nil
2507 then SetDebugger(NewDebuggerClass.Create(EnvironmentOptions.GetParsedDebuggerFilename(Project1)));
2508
2509 if FDebugger = nil
2510 then begin
2511 // something went wrong
2512 Exit;
2513 end;
2514
2515 if (EnvironmentOptions.CurrentDebuggerPropertiesConfigEx(Project1) <> nil) and
2516 (EnvironmentOptions.CurrentDebuggerPropertiesConfigEx(Project1).DebuggerProperties <> nil)
2517 then
2518 FDebugger.GetProperties.Assign(EnvironmentOptions.CurrentDebuggerPropertiesConfigEx(Project1).DebuggerProperties);
2519
2520 ClearDebugOutputLog;
2521 if EnvironmentOptions.DebuggerEventLogClearOnRun then
2522 ClearDebugEventsLog;
2523
2524 //ensure to unset all evemts in SetDebugger()
2525 FDebugger.OnBreakPointHit := @DebuggerBreakPointHit;
2526 FDebugger.OnBeforeState := @DebuggerBeforeChangeState;
2527 FDebugger.OnState := @DebuggerChangeState;
2528 FDebugger.OnCurrent := @DebuggerCurrentLine;
2529 FDebugger.OnDbgOutput := @DebuggerOutput;
2530 FDebugger.OnDbgEvent := @FEventLogManager.DebuggerEvent;
2531 FDebugger.OnException := @DebuggerException;
2532 FDebugger.OnConsoleOutput := @DebuggerConsoleOutput;
2533 FDebugger.OnFeedback := @DebuggerFeedback;
2534 FDebugger.OnIdle := @DebuggerIdle;
2535 FDebugger.EventLogHandler := FEventLogManager;
2536
2537 FEventLogManager.TargetWidth := FDebugger.TargetWidth div 8;
2538
2539 if FDebugger.State = dsNone
2540 then begin
2541 Include(FManagerStates,dmsInitializingDebuggerObject);
2542 Exclude(FManagerStates,dmsInitializingDebuggerObjectFailed);
2543 // The following commands may call ProcessMessages, and FDebugger can be nil after each
2544 FDebugger.Init;
2545 Exclude(FManagerStates,dmsInitializingDebuggerObject);
2546 if (FDebugger = nil) or (dmsInitializingDebuggerObjectFailed in FManagerStates)
2547 then begin
2548 FreeDebugger;
2549 Exit;
2550 end;
2551 end;
2552
2553 if not(difInitForAttach in AFlags) then begin
2554 Project1.RunParameterOptions.AssignEnvironmentTo(FDebugger.Environment);
2555 if Project1.RunParameterOptions.GetActiveMode<>nil then
2556 NewWorkingDir:=Project1.RunParameterOptions.GetActiveMode.WorkingDirectory
2557 else
2558 NewWorkingDir:='';
2559 GlobalMacroList.SubstituteStr(NewWorkingDir);
2560 if NewDebuggerClass.RequiresLocalExecutable and (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *)
2561 (NewWorkingDir<>'') and (not DirectoryExistsUTF8(NewWorkingDir))
2562 then begin
2563 IDEMessageDialog(lisUnableToRun,
2564 Format(lisTheWorkingDirectoryDoesNotExistPleaseCheckTheWorki,
2565 [NewWorkingDir, LineEnding]),
2566 mtError,[mbCancel]);
2567 exit;
2568 end;
2569 if NewWorkingDir='' then begin
2570 NewWorkingDir:=ExtractFilePath(BuildBoss.GetProjectTargetFilename(Project1));
2571 if NewDebuggerClass.RequiresLocalExecutable and (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *)
2572 (NewWorkingDir<>'') and (not DirectoryExistsUTF8(NewWorkingDir))
2573 then begin
2574 IDEMessageDialog(lisUnableToRun,
2575 Format(lisTheDestinationDirectoryDoesNotExistPleaseCheckTheP,
2576 [NewWorkingDir, LineEnding]),
2577 mtError,[mbCancel]);
2578 exit;
2579 end;
2580 end;
2581
2582 // The following commands may call ProcessMessages, and FDebugger can be nil after each
2583
2584 if (FDebugger <> nil) and not NewDebuggerClass.RequiresLocalExecutable
2585 then FDebugger.WorkingDir:=NewWorkingDir;
2586 if (FDebugger <> nil) and NewDebuggerClass.RequiresLocalExecutable
2587 then FDebugger.WorkingDir:=CleanAndExpandDirectory(NewWorkingDir);
2588 // set filename after workingdir
2589 if FDebugger <> nil
2590 then FDebugger.FileName := LaunchingApplication;
2591 if FDebugger <> nil
2592 then FDebugger.Arguments := LaunchingParams;
2593 if FDebugger <> nil
2594 then FDebugger.ShowConsole := not Project1.CompilerOptions.Win32GraphicApp;
2595 end
2596 else begin
2597 // attach
2598 if (FDebugger <> nil) and (LaunchingApplication <> '')
2599 then FDebugger.FileName := LaunchingApplication;
2600 end;
2601
2602 // check if debugging needs restart
2603 // mwe: can this still happen ?
2604 if (FDebugger = nil) or (dmsDebuggerObjectBroken in FManagerStates)
2605 then begin
2606 FreeDebugger;
2607 Exit;
2608 end;
2609
2610 Result := True;
2611 finally
2612 // Since ProcessMessages has been called, debugger may have been reseted, even during initialization...
2613 if not FIsInitializingDebugger
2614 then begin
2615 Result := False;
2616 ResetDebugger;
2617 end;
2618 FIsInitializingDebugger:= False;
2619 end;
2620 {$ifdef VerboseDebugger}
2621 DebugLn('[TDebugManager.DoInitDebugger] END');
2622 {$endif}
2623 end;
2624
DoSetBreakkPointWarnIfNoDebuggernull2625 function TDebugManager.DoSetBreakkPointWarnIfNoDebugger: boolean;
2626 var
2627 DbgClass: TDebuggerClass;
2628 begin
2629 DbgClass:=EnvironmentOptions.CurrentDebuggerClass(Project1);
2630 if (DbgClass=nil)
2631 or (DbgClass.NeedsExePath
2632 and (not FileIsExecutableCached(EnvironmentOptions.GetParsedDebuggerFilename(Project1))))
2633 then begin
2634 if IDEQuestionDialog(lisDbgMangNoDebuggerSpecified,
2635 Format(lisDbgMangThereIsNoDebuggerSpecifiedSettingBreakpointsHaveNo,[LineEnding]),
2636 mtWarning, [mrCancel, mrIgnore, lisDbgMangSetTheBreakpointAnyway]) <> mrIgnore
2637 then
2638 exit(false);
2639 end;
2640 Result:=true;
2641 end;
2642
2643 // still part of main, should go here when processdebugger is finished
2644 //
TDebugManager.DoRunProjectnull2645 //function TDebugManager.DoRunProject: TModalResult;
2646
2647 function TDebugManager.DoPauseProject: TModalResult;
2648 begin
2649 Result := mrCancel;
2650 if (MainIDE.ToolStatus <> itDebugger)
2651 or (FDebugger = nil) or Destroying
2652 then Exit;
2653 FAutoContinueTimer.Enabled := False;
2654 FDebugger.Pause;
2655 Result := mrOk;
2656 end;
2657
DoShowExecutionPointnull2658 function TDebugManager.DoShowExecutionPoint: TModalResult;
2659 begin
2660 Result := mrCancel;
2661 if (MainIDE.ToolStatus <> itDebugger)
2662 or (FDebugger = nil) or Destroying
2663 then Exit;
2664
2665 DebuggerCurrentLine(FDebugger, FCurrentLocation);
2666 Result := mrOk;
2667 end;
2668
TDebugManager.DoStepIntoProjectnull2669 function TDebugManager.DoStepIntoProject: TModalResult;
2670 begin
2671 if (MainIDE.DoInitProjectRun <> mrOK)
2672 or (MainIDE.ToolStatus <> itDebugger)
2673 or (FDebugger = nil) or Destroying
2674 then begin
2675 Result := mrAbort;
2676 Exit;
2677 end;
2678
2679 FStepping:=True;
2680 FDebugger.StepInto;
2681 Result := mrOk;
2682 end;
2683
DoStepOverProjectnull2684 function TDebugManager.DoStepOverProject: TModalResult;
2685 begin
2686 if (MainIDE.DoInitProjectRun <> mrOK)
2687 or (MainIDE.ToolStatus <> itDebugger)
2688 or (FDebugger = nil) or Destroying
2689 then begin
2690 Result := mrAbort;
2691 Exit;
2692 end;
2693
2694 FStepping:=True;
2695 FDebugger.StepOver;
2696 Result := mrOk;
2697 end;
2698
TDebugManager.DoStepIntoInstrProjectnull2699 function TDebugManager.DoStepIntoInstrProject: TModalResult;
2700 begin
2701 if (MainIDE.DoInitProjectRun <> mrOK)
2702 or (MainIDE.ToolStatus <> itDebugger)
2703 or (FDebugger = nil) or Destroying
2704 then begin
2705 Result := mrAbort;
2706 Exit;
2707 end;
2708
2709 FStepping:=True;
2710 FDebugger.StepIntoInstr;
2711 Result := mrOk;
2712 // Todo: move to DebuggerChangeState (requires the last run-command-type to be avail)
2713 ViewDebugDialog(ddtAssembler);
2714 end;
2715
TDebugManager.DoStepOverInstrProjectnull2716 function TDebugManager.DoStepOverInstrProject: TModalResult;
2717 begin
2718 if (MainIDE.DoInitProjectRun <> mrOK)
2719 or (MainIDE.ToolStatus <> itDebugger)
2720 or (FDebugger = nil) or Destroying
2721 then begin
2722 Result := mrAbort;
2723 Exit;
2724 end;
2725
2726 FStepping:=True;
2727 FDebugger.StepOverInstr;
2728 Result := mrOk;
2729 // Todo: move to DebuggerChangeState (requires the last run-command-type to be avail)
2730 ViewDebugDialog(ddtAssembler);
2731 end;
2732
TDebugManager.DoStepOutProjectnull2733 function TDebugManager.DoStepOutProject: TModalResult;
2734 begin
2735 if (FDebugger = nil) or not(dcStepOut in FDebugger.Commands)
2736 then begin
2737 Result := mrAbort;
2738 Exit;
2739 end;
2740
2741 if (MainIDE.DoInitProjectRun <> mrOK)
2742 or (MainIDE.ToolStatus <> itDebugger)
2743 or (FDebugger = nil) or Destroying
2744 then begin
2745 Result := mrAbort;
2746 Exit;
2747 end;
2748
2749 FStepping:=True;
2750 FDebugger.StepOut;
2751 Result := mrOk;
2752 end;
2753
DoStopProjectnull2754 function TDebugManager.DoStopProject: TModalResult;
2755 begin
2756 Result := mrCancel;
2757
2758 FRunTimer.Enabled:=false;
2759 Exclude(FManagerStates,dmsWaitForRun);
2760 Exclude(FManagerStates,dmsWaitForAttach);
2761
2762 SourceEditorManager.ClearExecutionLines;
2763 if (MainIDE.ToolStatus=itDebugger) and (FDebugger<>nil) and (not Destroying)
2764 then begin
2765 FDebugger.Stop;
2766 end;
2767 if (dmsDebuggerObjectBroken in FManagerStates) then begin
2768 if (MainIDE.ToolStatus=itDebugger) then
2769 MainIDE.ToolStatus:=itNone;
2770 end;
2771
2772 FUnitInfoProvider.Clear; // Maybe keep locations? But clear "not found"/"not loadable" flags?
2773 Result := mrOk;
2774 end;
2775
2776 procedure TDebugManager.DoToggleCallStack;
2777 begin
2778 ViewDebugDialog(ddtCallStack);
2779 end;
2780
2781 procedure TDebugManager.DoSendConsoleInput(AText: String);
2782 begin
2783 if FDebugger <> nil then
2784 FDebugger.SendConsoleInput(AText);
2785 end;
2786
2787 procedure TDebugManager.ProcessCommand(Command: word; var Handled: boolean);
2788 begin
2789 //debugln('TDebugManager.ProcessCommand ',dbgs(Command));
2790 Handled := True;
2791 case Command of
2792 ecPause: DoPauseProject;
2793 ecStepInto: DoStepIntoProject;
2794 ecStepOver: DoStepOverProject;
2795 ecStepIntoInstr: DoStepIntoInstrProject;
2796 ecStepOverInstr: DoStepOverInstrProject;
2797 ecStepIntoContext: begin
2798 if (FDialogs[ddtAssembler] <> nil) and FDialogs[ddtAssembler].Active
2799 then DoStepIntoInstrProject
2800 else DoStepIntoProject;
2801 end;
2802 ecStepOverContext: begin
2803 if (FDialogs[ddtAssembler] <> nil) and FDialogs[ddtAssembler].Active
2804 then DoStepOverInstrProject
2805 else DoStepOverProject;
2806 end;
2807 ecStepOut: DoStepOutProject;
2808 ecStepToCursor: DoStepToCursor;
2809 ecRunToCursor: DoRunToCursor;
2810 ecStopProgram: DoStopProject;
2811 ecResetDebugger: ResetDebugger;
2812 ecToggleCallStack: DoToggleCallStack;
2813 ecEvaluate: ViewDebugDialog(ddtEvaluate);
2814 ecInspect: ViewDebugDialog(ddtInspect);
2815 ecToggleWatches: ViewDebugDialog(ddtWatches);
2816 ecToggleBreakPoints: ViewDebugDialog(ddtBreakpoints);
2817 ecToggleDebuggerOut: ViewDebugDialog(ddtOutput);
2818 ecToggleDebugEvents: ViewDebugDialog(ddtEvents);
2819 ecToggleLocals: ViewDebugDialog(ddtLocals);
2820 ecViewPseudoTerminal: ViewDebugDialog(ddtPseudoTerminal);
2821 ecViewThreads: ViewDebugDialog(ddtThreads);
2822 ecViewHistory: ViewDebugDialog(ddtHistory);
2823 else
2824 Handled := False;
2825 end;
2826 end;
2827
2828 procedure TDebugManager.LockCommandProcessing;
2829 begin
2830 if assigned(FDebugger)
2831 then FDebugger.LockCommandProcessing;
2832 end;
2833
2834 procedure TDebugManager.UnLockCommandProcessing;
2835 begin
2836 if assigned(FDebugger)
2837 then FDebugger.UnLockCommandProcessing;
2838 end;
2839
StartDebuggingnull2840 function TDebugManager.StartDebugging: TModalResult;
2841 begin
2842 {$ifdef VerboseDebugger}
2843 DebugLn('TDebugManager.StartDebugging A ',DbgS(FDebugger<>nil),' Destroying=',DbgS(Destroying));
2844 {$endif}
2845 Result:=mrCancel;
2846 if Destroying then exit;
2847 if FManagerStates*[dmsWaitForRun, dmsWaitForAttach] <> [] then exit;
2848 if (FDebugger <> nil) then
2849 begin
2850 // dmsRunning + dsPause => evaluating stack+watches after run
2851 if (dmsRunning in FManagerStates) then begin
2852 if (FDebugger.State = dsPause) then
2853 FDebugger.Run;
2854
2855 exit;
2856 end;
2857
2858 {$ifdef VerboseDebugger}
2859 DebugLn('TDebugManager.StartDebugging B ',FDebugger.ClassName);
2860 {$endif}
2861 // check if debugging needs restart
2862 if (dmsDebuggerObjectBroken in FManagerStates)
2863 and (MainIDE.ToolStatus=itDebugger) then begin
2864 MainIDE.ToolStatus:=itNone;
2865 Result:=mrCancel;
2866 exit;
2867 end;
2868 Include(FManagerStates,dmsWaitForRun);
2869 FRunTimer.Enabled:=true;
2870 Result:=mrOk;
2871 end;
2872 end;
2873
TDebugManager.RunDebuggernull2874 function TDebugManager.RunDebugger: TModalResult;
2875 begin
2876 {$ifdef VerboseDebugger}
2877 DebugLn('TDebugManager.RunDebugger A ',DbgS(FDebugger<>nil),' Destroying=',DbgS(Destroying));
2878 {$endif}
2879 Result:=mrCancel;
2880 if Destroying then exit;
2881 Exclude(FManagerStates,dmsWaitForRun);
2882 if dmsRunning in FManagerStates then exit;
2883 if MainIDE.ToolStatus<>itDebugger then exit;
2884 if (FDebugger <> nil) then
2885 begin
2886 {$ifdef VerboseDebugger}
2887 DebugLn('TDebugManager.RunDebugger B ',FDebugger.ClassName);
2888 {$endif}
2889 // check if debugging needs restart
2890 if (dmsDebuggerObjectBroken in FManagerStates)
2891 and (MainIDE.ToolStatus=itDebugger) then begin
2892 MainIDE.ToolStatus:=itNone;
2893 Result:=mrCancel;
2894 exit;
2895 end;
2896 Include(FManagerStates,dmsRunning);
2897 FStepping:=False;
2898 try
2899 FDebugger.Run;
2900 finally
2901 Exclude(FManagerStates,dmsRunning);
2902 end;
2903 Result:=mrOk;
2904 end;
2905 end;
2906
2907 procedure TDebugManager.EndDebugging;
2908 begin
2909 FRunTimer.Enabled:=false;
2910 Exclude(FManagerStates,dmsWaitForRun);
2911 Exclude(FManagerStates,dmsWaitForAttach);
2912 if FDebugger <> nil then FDebugger.Done;
2913 // if not already freed
2914 FreeDebugger;
2915 end;
2916
2917 procedure TDebugManager.Attach(AProcessID: String);
2918 begin
2919 if Destroying then exit;
2920 if FManagerStates*[dmsWaitForRun, dmsWaitForAttach, dmsRunning] <> [] then exit;
2921 if (FDebugger <> nil) then
2922 begin
2923 // check if debugging needs restart
2924 if (dmsDebuggerObjectBroken in FManagerStates)
2925 and (MainIDE.ToolStatus=itDebugger) then begin
2926 MainIDE.ToolStatus:=itNone;
2927 exit;
2928 end;
2929 FAttachToID := AProcessID;
2930 Include(FManagerStates,dmsWaitForAttach);
2931 FRunTimer.Enabled:=true;
2932 end;
2933 end;
2934
TDebugManager.FillProcessListnull2935 function TDebugManager.FillProcessList(AList: TRunningProcessInfoList): boolean;
2936 begin
2937 Result := (not Destroying)
2938 and (MainIDE.ToolStatus in [itDebugger, itNone])
2939 and (FDebugger <> nil)
2940 and FDebugger.GetProcessList(AList);
2941 end;
2942
2943 procedure TDebugManager.Detach;
2944 begin
2945 FRunTimer.Enabled:=false; Exclude(FManagerStates,dmsWaitForRun);
2946 Exclude(FManagerStates,dmsWaitForAttach);
2947
2948 SourceEditorManager.ClearExecutionLines;
2949 if (MainIDE.ToolStatus=itDebugger) and (FDebugger<>nil) and (not Destroying)
2950 then begin
2951 FDebugger.Detach;
2952 end;
2953 if (dmsDebuggerObjectBroken in FManagerStates) then begin
2954 if (MainIDE.ToolStatus=itDebugger) then
2955 MainIDE.ToolStatus:=itNone;
2956 end;
2957
2958 FUnitInfoProvider.Clear; // Maybe keep locations? But clear "not found"/"not loadable" flags?
2959 end;
2960
Evaluatenull2961 function TDebugManager.Evaluate(const AExpression: String;
2962 ACallback: TDBGEvaluateResultCallback; EvalFlags: TDBGEvaluateFlags): Boolean;
2963 begin
2964 Result := (not Destroying)
2965 and (MainIDE.ToolStatus = itDebugger)
2966 and (FDebugger <> nil)
2967 and (dcEvaluate in FDebugger.Commands)
2968 and FDebugger.Evaluate(AExpression, ACallback, EvalFlags);
2969 end;
2970
TDebugManager.Modifynull2971 function TDebugManager.Modify(const AExpression, ANewValue: String): Boolean;
2972 begin
2973 Result := (not Destroying)
2974 and (MainIDE.ToolStatus = itDebugger)
2975 and (FDebugger <> nil)
2976 and (dcModify in FDebugger.Commands)
2977 and FDebugger.Modify(AExpression, ANewValue);
2978 end;
2979
2980 procedure TDebugManager.EvaluateModify(const AExpression: String);
2981 begin
2982 if Destroying then Exit;
2983 ViewDebugDialog(ddtEvaluate);
2984 if FDialogs[ddtEvaluate] <> nil then
2985 TEvaluateDlg(FDialogs[ddtEvaluate]).FindText := AExpression;
2986 end;
2987
2988 procedure TDebugManager.Inspect(const AExpression: String);
2989 begin
2990 if Destroying then Exit;
2991 ViewDebugDialog(ddtInspect); // TODO: If not yet open, this will get Expression from SourceEdit, and trigger uneeded eval.
2992 if FDialogs[ddtInspect] <> nil then
2993 begin
2994 TIDEInspectDlg(FDialogs[ddtInspect]).Execute(AExpression);
2995 end;
2996 end;
2997
TDebugManager.DoCreateBreakPointnull2998 function TDebugManager.DoCreateBreakPoint(const AFilename: string;
2999 ALine: integer; WarnIfNoDebugger: boolean): TModalResult;
3000 var
3001 ABrkPoint: TIDEBreakPoint;
3002 begin
3003 Result := DoCreateBreakPoint(AFilename, ALine, WarnIfNoDebugger, ABrkPoint);
3004 end;
3005
TDebugManager.DoCreateBreakPointnull3006 function TDebugManager.DoCreateBreakPoint(const AFilename: string;
3007 ALine: integer; WarnIfNoDebugger: boolean; out ABrkPoint: TIDEBreakPoint;
3008 AnUpdating: Boolean): TModalResult;
3009 begin
3010 ABrkPoint := nil;
3011 if WarnIfNoDebugger and not DoSetBreakkPointWarnIfNoDebugger then
3012 exit(mrCancel);
3013
3014 ABrkPoint := FBreakPoints.Add(AFilename, ALine, AnUpdating);
3015 Result := mrOK;
3016 end;
3017
TDebugManager.DoCreateBreakPointnull3018 function TDebugManager.DoCreateBreakPoint(const AnAddr: TDBGPtr;
3019 WarnIfNoDebugger: boolean; out ABrkPoint: TIDEBreakPoint; AnUpdating: Boolean
3020 ): TModalResult;
3021 begin
3022 ABrkPoint := nil;
3023 if WarnIfNoDebugger and not DoSetBreakkPointWarnIfNoDebugger then
3024 exit(mrCancel);
3025
3026 ABrkPoint := FBreakPoints.Add(AnAddr, AnUpdating);
3027 Result := mrOK;
3028 end;
3029
DoDeleteBreakPointnull3030 function TDebugManager.DoDeleteBreakPoint(const AFilename: string;
3031 ALine: integer): TModalResult;
3032 var
3033 OldBreakPoint: TIDEBreakPoint;
3034 begin
3035 LockCommandProcessing;
3036 try
3037 OldBreakPoint:=FBreakPoints.Find(AFilename,ALine);
3038 if OldBreakPoint=nil then exit(mrOk);
3039 ReleaseRefAndNil(OldBreakPoint);
3040 Project1.Modified:=true;
3041 Result := mrOK;
3042 finally
3043 UnLockCommandProcessing;
3044 end;
3045 end;
3046
DoDeleteBreakPointAtMarknull3047 function TDebugManager.DoDeleteBreakPointAtMark(const ASourceMark: TSourceMark
3048 ): TModalResult;
3049 var
3050 OldBreakPoint: TIDEBreakPoint;
3051 begin
3052 LockCommandProcessing;
3053 try
3054 // consistency check
3055 if (ASourceMark=nil) or (not ASourceMark.IsBreakPoint)
3056 or (ASourceMark.Data=nil) or (not (ASourceMark.Data is TIDEBreakPoint)) then
3057 RaiseGDBException('TDebugManager.DoDeleteBreakPointAtMark');
3058
3059 {$ifdef VerboseDebugger}
3060 DebugLn('TDebugManager.DoDeleteBreakPointAtMark A ',ASourceMark.GetFilename,
3061 ' ',IntToStr(ASourceMark.Line));
3062 {$endif}
3063 OldBreakPoint:=TIDEBreakPoint(ASourceMark.Data);
3064 {$ifdef VerboseDebugger}
3065 DebugLn('TDebugManager.DoDeleteBreakPointAtMark B ',OldBreakPoint.ClassName,
3066 ' ',OldBreakPoint.Source,' ',IntToStr(OldBreakPoint.Line));
3067 {$endif}
3068 ReleaseRefAndNil(OldBreakPoint);
3069 Project1.Modified:=true;
3070 Result := mrOK;
3071 finally
3072 UnLockCommandProcessing;
3073 end;
3074 end;
3075
DoStepToCursornull3076 function TDebugManager.DoStepToCursor: TModalResult;
3077 var
3078 ActiveSrcEdit: TSourceEditorInterface;
3079 ActiveUnitInfo: TUnitInfo;
3080 UnitFilename: string;
3081 begin
3082 {$ifdef VerboseDebugger}
3083 DebugLn('TDebugManager.DoStepToCursor A');
3084 {$endif}
3085 if (FDebugger = nil) or not(dcStepTo in FDebugger.Commands)
3086 then begin
3087 Result := mrAbort;
3088 Exit;
3089 end;
3090
3091 if (MainIDE.DoInitProjectRun <> mrOK)
3092 or (MainIDE.ToolStatus <> itDebugger)
3093 or (FDebugger = nil) or Destroying
3094 then begin
3095 Result := mrAbort;
3096 Exit;
3097 end;
3098 {$ifdef VerboseDebugger}
3099 DebugLn('TDebugManager.DoStepToCursor B');
3100 {$endif}
3101
3102 Result := mrCancel;
3103
3104 MainIDE.GetCurrentUnitInfo(ActiveSrcEdit,ActiveUnitInfo);
3105 if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil)
3106 then begin
3107 IDEMessageDialog(lisRunToFailed, lisPleaseOpenAUnitBeforeRun, mtError,
3108 [mbCancel]);
3109 Result := mrCancel;
3110 Exit;
3111 end;
3112
3113 if not ActiveUnitInfo.Source.IsVirtual
3114 then UnitFilename:=ActiveUnitInfo.Filename
3115 else UnitFilename:=BuildBoss.GetTestUnitFilename(ActiveUnitInfo);
3116
3117 {$ifdef VerboseDebugger}
3118 DebugLn('TDebugManager.DoStepToCursor C');
3119 {$endif}
3120 FDebugger.StepTo(ExtractFilename(UnitFilename),
3121 TSourceEditor(ActiveSrcEdit).EditorComponent.CaretY);
3122
3123 {$ifdef VerboseDebugger}
3124 DebugLn('TDebugManager.DoStepToCursor D');
3125 {$endif}
3126 Result := mrOK;
3127 end;
3128
TDebugManager.DoRunToCursornull3129 function TDebugManager.DoRunToCursor: TModalResult;
3130 var
3131 ActiveSrcEdit: TSourceEditorInterface;
3132 ActiveUnitInfo: TUnitInfo;
3133 UnitFilename: string;
3134 begin
3135 if (MainIDE.DoInitProjectRun <> mrOK)
3136 or (MainIDE.ToolStatus <> itDebugger)
3137 or (FDebugger = nil) or Destroying
3138 then begin
3139 Result := mrAbort;
3140 Exit;
3141 end;
3142
3143 MainIDE.GetCurrentUnitInfo(ActiveSrcEdit,ActiveUnitInfo);
3144 if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil)
3145 then begin
3146 IDEMessageDialog(lisRunToFailed, lisPleaseOpenAUnitBeforeRun, mtError,
3147 [mbCancel]);
3148 Result := mrCancel;
3149 Exit;
3150 end;
3151
3152 if not ActiveUnitInfo.Source.IsVirtual
3153 then UnitFilename:=ActiveUnitInfo.Filename
3154 else UnitFilename:=BuildBoss.GetTestUnitFilename(ActiveUnitInfo);
3155
3156 FStepping:=True;
3157 FDebugger.RunTo(ExtractFilename(UnitFilename),
3158 TSourceEditor(ActiveSrcEdit).EditorComponent.CaretY);
3159
3160 Result := mrOK;
3161 end;
3162
GetStatenull3163 function TDebugManager.GetState: TDBGState;
3164 begin
3165 if FDebugger = nil
3166 then Result := dsNone
3167 else Result := FDebugger.State;
3168 end;
3169
TDebugManager.GetCommandsnull3170 function TDebugManager.GetCommands: TDBGCommands;
3171 begin
3172 if FDebugger = nil
3173 then Result := []
3174 else Result := FDebugger.Commands;
3175 end;
3176
TDebugManager.GetPseudoTerminalnull3177 function TDebugManager.GetPseudoTerminal: TPseudoTerminal;
3178 begin
3179 if FDebugger = nil then
3180 Result := nil
3181 else
3182 Result := FDebugger.PseudoTerminal;
3183 end;
3184
GetDebuggerClassnull3185 function TDebugManager.GetDebuggerClass: TDebuggerClass;
3186 begin
3187 Result := EnvironmentOptions.CurrentDebuggerClass(Project1);
3188 if Result = nil then
3189 Result := TProcessDebugger;
3190 end;
3191
3192 {$IFDEF DBG_WITH_DEBUGGER_DEBUG}
TDebugManager.GetDebuggernull3193 function TDebugManager.GetDebugger: TDebuggerIntf;
3194 begin
3195 Result := FDebugger;
3196 end;
3197 {$ENDIF}
3198
GetCurrentDebuggerClassnull3199 function TDebugManager.GetCurrentDebuggerClass: TDebuggerClass;
3200 begin
3201 Result := GetDebuggerClass;
3202 end;
3203
TDebugManager.AttachDebuggernull3204 function TDebugManager.AttachDebugger: TModalResult;
3205 begin
3206 Result:=mrCancel;
3207 if Destroying then exit;
3208 Exclude(FManagerStates,dmsWaitForAttach);
3209 if dmsRunning in FManagerStates then exit;
3210 if MainIDE.ToolStatus<>itDebugger then exit;
3211 if (FDebugger <> nil) then
3212 begin
3213 // check if debugging needs restart
3214 if (dmsDebuggerObjectBroken in FManagerStates)
3215 and (MainIDE.ToolStatus=itDebugger) then begin
3216 MainIDE.ToolStatus:=itNone;
3217 Result:=mrCancel;
3218 exit;
3219 end;
3220 Include(FManagerStates,dmsRunning);
3221 FStepping:=False;
3222 try
3223 FDebugger.Attach(FAttachToID);
3224 finally
3225 Exclude(FManagerStates,dmsRunning);
3226 end;
3227 Result:=mrOk;
3228 end;
3229 end;
3230
ShowBreakPointPropertiesnull3231 function TDebugManager.ShowBreakPointProperties(const ABreakpoint: TIDEBreakPoint): TModalresult;
3232 begin
3233 Result := TBreakPropertyDlg.Create(Self, ABreakpoint).ShowModal;
3234 end;
3235
TDebugManager.ShowWatchPropertiesnull3236 function TDebugManager.ShowWatchProperties(const AWatch: TCurrentWatch; AWatchExpression: String = ''): TModalresult;
3237 begin
3238 Result := TWatchPropertyDlg.Create(Self, AWatch, AWatchExpression).ShowModal;
3239 end;
3240
3241 procedure TDebugManager.SetDebugger(const ADebugger: TDebuggerIntf);
3242 begin
3243 if FDebugger = ADebugger then Exit;
3244
3245 FRunTimer.Enabled:=false;
3246 Exclude(FManagerStates,dmsWaitForRun);
3247 Exclude(FManagerStates,dmsWaitForAttach);
3248
3249 if FDebugger <> nil then begin
3250 FDebugger.OnBreakPointHit := nil;
3251 FDebugger.OnBeforeState := nil;
3252 FDebugger.OnState := nil;
3253 FDebugger.OnCurrent := nil;
3254 FDebugger.OnDbgOutput := nil;
3255 FDebugger.OnDbgEvent := nil;
3256 FDebugger.OnException := nil;
3257 FDebugger.OnConsoleOutput := nil;
3258 FDebugger.OnFeedback := nil;
3259 FDebugger.OnIdle := nil;
3260 FDebugger.Exceptions := nil;
3261 FDebugger.EventLogHandler := nil;
3262 end;
3263
3264 FDebugger := ADebugger;
3265 if FDebugger = nil
3266 then begin
3267 TManagedBreakpoints(FBreakpoints).Master := nil;
3268 FWatches.Supplier := nil;
3269 FThreads.Supplier := nil;
3270 FLocals.Supplier := nil;
3271 FLineInfo.Master := nil;
3272 FCallStack.Supplier := nil;
3273 FDisassembler.Master := nil;
3274 FSignals.Master := nil;
3275 FRegisters.Supplier := nil;
3276 FSnapshots.Debugger := nil;
3277 end
3278 else begin
3279 TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints;
3280 FWatches.Supplier := FDebugger.Watches;
3281 FThreads.Supplier := FDebugger.Threads;
3282 FThreads.UnitInfoProvider := FUnitInfoProvider;
3283 FLocals.Supplier := FDebugger.Locals;
3284 FLineInfo.Master := FDebugger.LineInfo;
3285 FCallStack.Supplier := FDebugger.CallStack;
3286 FCallStack.UnitInfoProvider := FUnitInfoProvider;
3287 FDisassembler.Master := FDebugger.Disassembler;
3288 FSignals.Master := FDebugger.Signals;
3289 FRegisters.Supplier := FDebugger.Registers;
3290 FSnapshots.Debugger := FDebugger;
3291
3292 FDebugger.Exceptions := FExceptions;
3293 end;
3294 end;
3295
3296 initialization
3297 DBG_LOCATION_INFO := DebugLogger.FindOrRegisterLogGroup('DBG_LOCATION_INFO' {$IFDEF DBG_LOCATION_INFO} , True {$ENDIF} );
3298 if DBG_LOCATION_INFO=nil then ;
3299
3300 end.
3301
3302
3303